## drawpane.pkg
#
# Here we provide a drawing area designed
# to be used with textpane.pkg.
#
src/lib/x-kit/widget/edit/textpane.pkg# Compiled by:
#
src/lib/x-kit/widget/xkit-widget.sublib# This package gets used in:
#
#
stipulate
include package threadkit; # threadkit is from
src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg include package geometry2d; # geometry2d is from
src/lib/std/2d/geometry2d.pkg #
package chr = char; # char is from
src/lib/std/char.pkg package evt = gui_event_types; # gui_event_types is from
src/lib/x-kit/widget/gui/gui-event-types.pkg package g2p = gadget_to_pixmap; # gadget_to_pixmap is from
src/lib/x-kit/widget/theme/gadget-to-pixmap.pkg package gd = gui_displaylist; # gui_displaylist is from
src/lib/x-kit/widget/theme/gui-displaylist.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 wti = widget_theme_imp; # widget_theme_imp is from
src/lib/x-kit/widget/xkit/theme/widget/default/widget-theme-imp.pkg package wit = widget_imp_types; # widget_imp_types is from
src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp-types.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 wi = widget_imp; # widget_imp is from
src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.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 mtx = rw_matrix; # rw_matrix is from
src/lib/std/src/rw-matrix.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from
src/lib/prettyprint/big/src/standard-prettyprinter.pkg package gtg = guiboss_to_guishim; # guiboss_to_guishim is from
src/lib/x-kit/widget/theme/guiboss-to-guishim.pkg package d2p = drawpane_to_textpane; # drawpane_to_textpane is from
src/lib/x-kit/widget/edit/drawpane-to-textpane.pkg package m2d = mode_to_drawpane; # mode_to_drawpane is from
src/lib/x-kit/widget/edit/mode-to-drawpane.pkg package p2d = textpane_to_drawpane; # textpane_to_drawpane is from
src/lib/x-kit/widget/edit/textpane-to-drawpane.pkg package tpt = textpane_types; # textpane_types is from
src/lib/x-kit/widget/edit/textpane-types.pkg package mt = millboss_types; # millboss_types is from
src/lib/x-kit/widget/edit/millboss-types.pkg package g2d = geometry2d; # geometry2d is from
src/lib/std/2d/geometry2d.pkg package dpt = drawpane_types; # drawpane_types is from
src/lib/x-kit/widget/edit/drawpane-types.pkgDummy1 = dpt::Foo; # XXX SUCKO DELETEME. This is a quick hack to make sure the package compiles during early development of it.
nb = log::note_on_stderr; # log is from
src/lib/std/src/log.pkgherein
package drawpane
: Drawpane # Drawpane is from
src/lib/x-kit/widget/edit/drawpane.api {
include package drawpane_types;
#
Option = PIXELS_SQUARE Int
#
| PIXELS_HIGH_MIN Int
| PIXELS_WIDE_MIN Int
#
| PIXELS_HIGH_CUT Float
| PIXELS_WIDE_CUT Float
#
| INITIALLY_ACTIVE Bool
#
| BODY_COLOR rgb::Rgb
| BODY_COLOR_WITH_MOUSEFOCUS rgb::Rgb
| BODY_COLOR_WHEN_ON rgb::Rgb
| BODY_COLOR_WHEN_ON_WITH_MOUSEFOCUS rgb::Rgb
#
| ID Id
| DOC String
#
| STATE p2d::Linestate
# What to display in drawpane.
#
| FONT_SIZE Int
# Show any text in this pointsize. Default is 12.
| FONTS List(String)
# Override theme font: Font to use for text label, e.g. "-*-courier-bold-r-*-*-20-*-*-*-*-*-*-*". We'll use the first font in list which is found on X server, else "9x15" (which X guarantees to have).
#
| ROMAN
# Show any text in plain font from widget-theme. This is the default.
| ITALIC
# Show any text in italic font from widget-theme.
| BOLD
# Show any text in bold font from widget-theme. NB: Text is either bold or italic, not both.
#
| STATEWATCHER (p2d::Linestate -> Void)
# Widget's current state will be sent to these fns each time state changes.
#
| PORTWATCHER (Null_Or(Textpane_To_Lineditor) -> Void)
# Widget's app port will be sent to these fns at widget startup.
| SITEWATCHER (Null_Or((Id,g2d::Box)) -> Void)
# Widget's site in window coordinates will be sent to these fns each time it changes.
; # To help prevent deadlock, watcher fns should be fast and nonblocking, typically just setting a var or entering something into a mailqueue.
fun process_options
( options: List(Option),
#
{ body_color,
body_color_with_mousefocus,
body_color_when_on,
body_color_when_on_with_mousefocus,
#
drawpane_id,
widget_doc,
#
state,
#
fonts,
font_weight,
font_size,
#
initially_active,
#
pixels_high_min,
pixels_high_cut,
widget_options,
#
# portwatchers,
statewatchers,
sitewatchers
}
)
=
{ my_body_color = REF body_color;
my_body_color_with_mousefocus = REF body_color_with_mousefocus;
my_body_color_when_on = REF body_color_when_on;
my_body_color_when_on_with_mousefocus = REF body_color_when_on_with_mousefocus;
#
my_drawpane_id = REF drawpane_id;
my_widget_doc = REF widget_doc;
#
my_state = REF state;
#
my_fonts = REF fonts;
my_font_weight = REF font_weight;
my_font_size = REF font_size;
#
my_initially_active = REF initially_active;
#
my_pixels_high_min = REF pixels_high_min;
my_pixels_high_cut = REF pixels_high_cut;
my_widget_options = REF widget_options;
#
# my_portwatchers = REF portwatchers;
my_statewatchers = REF statewatchers;
my_sitewatchers = REF sitewatchers;
#
apply do_option options
where
fun do_option (INITIALLY_ACTIVE b) => my_initially_active := b;
#
do_option (BODY_COLOR c) => my_body_color := THE c;
do_option (BODY_COLOR_WITH_MOUSEFOCUS c) => my_body_color_with_mousefocus := THE c;
do_option (BODY_COLOR_WHEN_ON c) => my_body_color_when_on := THE c;
do_option (BODY_COLOR_WHEN_ON_WITH_MOUSEFOCUS c) => my_body_color_when_on_with_mousefocus := THE c;
#
do_option (ID i) => my_drawpane_id := THE i;
do_option (DOC d) => my_widget_doc := d;
#
do_option (STATE t) => my_state := t;
#
do_option (FONTS t) => my_fonts := t;
#
do_option (ROMAN ) => my_font_weight := THE wt::ROMAN_FONT;
do_option (ITALIC ) => my_font_weight := THE wt::ITALIC_FONT;
do_option (BOLD ) => my_font_weight := THE wt::BOLD_FONT;
#
do_option (FONT_SIZE i) => my_font_size := THE i;
#
# do_option (PORTWATCHER c) => my_portwatchers := c ! *my_portwatchers;
do_option (STATEWATCHER c) => my_statewatchers := c ! *my_statewatchers;
do_option (SITEWATCHER c) => my_sitewatchers := c ! *my_sitewatchers;
#
#
do_option (PIXELS_HIGH_MIN i) => my_pixels_high_min := i;
do_option (PIXELS_WIDE_MIN i) => my_widget_options := (wi::PIXELS_WIDE_MIN i) ! *my_widget_options;
#
do_option (PIXELS_HIGH_CUT f) => my_pixels_high_cut := f;
do_option (PIXELS_WIDE_CUT f) => my_widget_options := (wi::PIXELS_WIDE_CUT f) ! *my_widget_options;
#
do_option (PIXELS_SQUARE i) => my_widget_options := (wi::PIXELS_HIGH_MIN i)
! (wi::PIXELS_WIDE_MIN i)
! (wi::PIXELS_HIGH_CUT 0.0)
! (wi::PIXELS_WIDE_CUT 0.0)
! *my_widget_options;
end;
end;
{ body_color => *my_body_color,
body_color_with_mousefocus => *my_body_color_with_mousefocus,
body_color_when_on => *my_body_color_when_on,
body_color_when_on_with_mousefocus => *my_body_color_when_on_with_mousefocus,
#
drawpane_id => *my_drawpane_id,
widget_doc => *my_widget_doc,
#
state => *my_state,
#
fonts => *my_fonts,
font_weight => *my_font_weight,
font_size => *my_font_size,
#
initially_active => *my_initially_active,
#
pixels_high_min => *my_pixels_high_min,
pixels_high_cut => *my_pixels_high_cut,
widget_options => *my_widget_options,
#
# portwatchers => *my_portwatchers,
statewatchers => *my_statewatchers,
#
sitewatchers => *my_sitewatchers
};
};
fun with # PUBLIC. The point of the 'with' name is that GUI coders can write 'drawpane::with { this => that, foo => bar, ... }.'
{ textpane_id: Id, # The textpane to which we belong. Caller provides this so we can register outself with it via millboss_imp.
options: List(Option)
}
=
{
#######################################
# Top of per-imp state variable section
#
drawpane_to_textpane__global = REF (NULL: Null_Or(d2p::Drawpane_To_Textpane));
widget_to_guiboss__global = REF (NULL: Null_Or( { widget_to_guiboss: gt::Widget_To_Guiboss, drawpane_id: Id }));
stateref = REF { selected => NULL, # Part of line to show with (typically) greenish background -- selected region. (Part may be overwritten by the cursor.)
cursor_at => p2d::NO_CURSOR, # Does cursor appear at start or end of 'selected' part -- or neither?
text => "",
prompt => "",
screencol0 => 0,
background => rgb::white
};
bogus_site
=
{ col => -1, wide => -1,
row => -1, high => -1
}: g2d::Box;
last_known_site
=
REF bogus_site;
button_active
=
REF TRUE;
# Caches to handle the situation where events to be forwarded
# arrive before the drawpane_to_textpane forwarding port:
#
startup_fn_relay_cache = REF ([]: List( wit::Startup_Fn_Arg ));
shutdown_fn_relay_cache = REF ([]: List( wit::Shutdown_Fn_Arg ));
initialize_gadget_fn_relay_cache = REF ([]: List( wit::Initialize_Gadget_Fn_Arg ));
redraw_request_fn_relay_cache = REF ([]: List( wit::Redraw_Request_Fn_Arg ));
mouse_click_fn_relay_cache = REF ([]: List( wit::Mouse_Click_Fn_Arg ));
mouse_drag_fn_relay_cache = REF ([]: List( wit::Mouse_Drag_Fn_Arg ));
mouse_transit_fn_relay_cache = REF ([]: List( wit::Mouse_Transit_Fn_Arg ));
#
#######################################
#################################################################################################################################################################
# Note that all of the *_fn_relay fns will only be called by widget-imp.pkg, so we'll already be executing in our own microthread -- no need for 'do' stuff here.
#################################################################################################################################################################
fun startup_fn_relay (a: wit::Startup_Fn_Arg)
=
{ startup_fn_relay_cache := a ! *startup_fn_relay_cache; # We'll forward this to textpane once textpane registers a drawpane_to_textpane port with us.
#
(mt::get__mill_to_millboss "drawpane::startup_fn") # Find our port to
src/lib/x-kit/widget/edit/millboss-imp.pkg ->
mt::MILL_TO_MILLBOSS mb;
mb.mail_pane (textpane_id, mode_and_textpane_to_drawpane__crypt) # Register our textpane_to_drawpane and mode_to_drawpane ports with our textpane.pkg instance.
where
fun note__drawpane_to_textpane
(
drawpane_to_textpane: d2p::Drawpane_To_Textpane
)
=
{ drawpane_to_textpane__global := THE drawpane_to_textpane; # Note port to our textpane.pkg instance.
# Forward any/all cached messages which arrived
# before drawpane_to_textpane.
# NB: To be totally anal we should ensure that message order is preserved here, which would mean merging all the *_cache.
# I don't actually expect to see anything but a single startup_arg cached in practice, so I'm not sweating this. -- 2015-08-30 CrT
apply do_startup (reverse *startup_fn_relay_cache)
where
fun do_startup (a: wit::Startup_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.startup_fn a;
end;
apply do_initialize_gadget (reverse *initialize_gadget_fn_relay_cache)
where
fun do_initialize_gadget (a: wit::Initialize_Gadget_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.initialize_gadget_fn a;
end;
apply do_redraw_request (reverse *redraw_request_fn_relay_cache)
where
fun do_redraw_request (a: wit::Redraw_Request_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.redraw_request_fn a;
end;
apply do_mouse_click (reverse *mouse_click_fn_relay_cache)
where
fun do_mouse_click (a: wit::Mouse_Click_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.mouse_click_fn a;
end;
apply do_mouse_drag (reverse *mouse_drag_fn_relay_cache)
where
fun do_mouse_drag (a: wit::Mouse_Drag_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.mouse_drag_fn a;
end;
apply do_mouse_transit (reverse *mouse_transit_fn_relay_cache)
where
fun do_mouse_transit (a: wit::Mouse_Transit_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.mouse_transit_fn a;
end;
apply do_shutdown (reverse *shutdown_fn_relay_cache)
where
fun do_shutdown (a: wit::Shutdown_Fn_Arg)
=
drawpane_to_textpane.drawpane_relays.shutdown_fn a;
end;
};
mode_to_drawpane
=
{ drawpane_id => a.id,
textpane_id
};
textpane_to_drawpane
=
{ drawpane_id => a.id,
textpane_id,
#
note__drawpane_to_textpane
}: p2d::Textpane_To_Drawpane;
mode_and_textpane_to_drawpane__crypt
=
{ id => issue_unique_id (),
type => "millboss_types::TEXTPANE_TO_DRAWPANE__CRYPT",
info => "Initialization from drawpane.pkg for textpane.pkg.",
data => mt::MODE_AND_TEXTPANE_TO_DRAWPANE__CRYPT (textpane_to_drawpane, mode_to_drawpane)
};
end;
};
fun shutdown_fn_relay (a: wit::Shutdown_Fn_Arg)
=
case *drawpane_to_textpane__global
#
THE d2t => d2t.drawpane_relays.shutdown_fn a;
#
NULL => shutdown_fn_relay_cache := a ! *shutdown_fn_relay_cache;
esac;
fun initialize_gadget_fn_relay (a: wit::Initialize_Gadget_Fn_Arg)
=
case *drawpane_to_textpane__global
#
THE d2t => d2t.drawpane_relays.initialize_gadget_fn a;
#
NULL => initialize_gadget_fn_relay_cache := a ! *initialize_gadget_fn_relay_cache;
esac;
fun redraw_request_fn_relay (a: wit::Redraw_Request_Fn_Arg)
=
case *drawpane_to_textpane__global
#
THE d2t => d2t.drawpane_relays.redraw_request_fn a;
#
NULL => redraw_request_fn_relay_cache := a ! *redraw_request_fn_relay_cache;
esac;
fun mouse_click_fn_relay (a: wit::Mouse_Click_Fn_Arg)
=
case *drawpane_to_textpane__global
#
THE d2t => d2t.drawpane_relays.mouse_click_fn a;
#
NULL => mouse_click_fn_relay_cache := a ! *mouse_click_fn_relay_cache;
esac;
fun mouse_drag_fn_relay (a: wit::Mouse_Drag_Fn_Arg)
=
case *drawpane_to_textpane__global
#
THE d2t => d2t.drawpane_relays.mouse_drag_fn a;
#
NULL => mouse_drag_fn_relay_cache := a ! *mouse_drag_fn_relay_cache;
esac;
fun mouse_transit_fn_relay (a: wit::Mouse_Transit_Fn_Arg)
=
case *drawpane_to_textpane__global
#
THE d2t => d2t.drawpane_relays.mouse_transit_fn a;
#
NULL => mouse_transit_fn_relay_cache := a ! *mouse_transit_fn_relay_cache;
esac;
#
(process_options
(
options,
#
{ body_color => NULL,
body_color_with_mousefocus => NULL,
body_color_when_on => NULL,
body_color_when_on_with_mousefocus => NULL,
#
drawpane_id => NULL,
widget_doc => "<drawpane>",
#
state => *stateref,
#
fonts => [],
font_weight => (THE wt::BOLD_FONT: Null_Or(wt::Font_Weight)),
font_size => (NULL: Null_Or(Int)),
#
initially_active => *button_active,
#
pixels_high_min => 0, # Setting this to 16 resulted in an infinite loop of vertical site expansion in textpane.pkg. So currently we leave the driving to textpane.pkg.
pixels_high_cut => 1.0, # So main drawpanes will evenly divide up all space left after modeline has taken its fixed allotment.
widget_options => [],
#
# portwatchers => [],
statewatchers => [],
sitewatchers => []
}
) )
->
{ # These values are globally visible to the subsequenc fns, which can lock them in as needed.
body_color,
body_color_with_mousefocus,
body_color_when_on,
body_color_when_on_with_mousefocus,
#
drawpane_id,
widget_doc,
#
state,
#
fonts,
font_weight,
font_size,
#
initially_active,
#
pixels_high_min,
pixels_high_cut,
widget_options,
#
# portwatchers,
statewatchers,
sitewatchers
};
stateref := state;
button_active := initially_active;
fun note_changed_gadget_activity (is_active: Bool)
=
case (*widget_to_guiboss__global)
#
THE { widget_to_guiboss, drawpane_id } => widget_to_guiboss.g.note_changed_gadget_activity { id => drawpane_id, is_active };
NULL => ();
esac;
fun needs_redraw_gadget_request ()
=
case (*widget_to_guiboss__global)
#
THE { widget_to_guiboss, drawpane_id } => widget_to_guiboss.g.needs_redraw_gadget_request(drawpane_id);
NULL => ();
esac;
fun note_site
(arg as
{ drawpane_id: Id,
site: g2d::Box
}
)
=
if(*last_known_site != site)
last_known_site := site;
#
apply tell_watcher sitewatchers
where
fun tell_watcher sitewatcher
=
sitewatcher (THE (drawpane_id,site));
end;
fi;
fun notify_statewatchers ()
=
apply tell_watcher statewatchers
where
fun tell_watcher statewatcher
=
statewatcher *stateref;
end;
fun note_state (state: p2d::Linestate)
=
if(*stateref != state)
#
# Blinking the cursor seemed like a great idea, but in practice
# it means no feedback on cursor position half the time, which
# slows down fast typing, so I've commented it out. (Note that
# emacs doesn't blink its cursor either.)
#
# fun flip_blink (wa: gt::Wakeup_Arg)
# =
# { cursoronref := not *cursoronref;
# #
# needs_redraw_gadget_request ();
# };
#
# case (*widget_to_guiboss__global) # Turn cursorblink-driving wakeme call on or off as necessary.
# #
# (THE { widget_to_guiboss, drawpane_id })
# =>
# case ((*stateref).cursor, state.cursor)
# #
# (THE _, THE _) => (); # Cursorblink was on, still on, nothing to do here.
# (NULL , NULL ) => (); # Cursorblink was off, still off, nothing to do here.
#
# (THE _, NULL ) # Cursorblink was on, need to turn it off.
# =>
# widget_to_guiboss.g.wake_me
# {
# id => drawpane_id,
# options => [ gt::EVERY_N_FRAMES (NULL ) ]
# };
#
# (NULL, THE _) # Cursorblink was off, need to turn it on.
# =>
# widget_to_guiboss.g.wake_me
# {
# id => drawpane_id,
# options => [ gt::EVERY_N_FRAMES (THE (40, flip_blink)) ]
# };
# esac;
#
# _ => (); # We don't expect this to happen. Should probably log an error or warning if it does...
# esac;
stateref := state;
needs_redraw_gadget_request ();
notify_statewatchers ();
fi;
#
# End of state variable section
###############################
###############################
# Top of widget hook fn section
#
# These fns get called by widget_imp logic, ultimately # widget_imp is from
src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg # in response to user mouseclicks and keypresses etc:
#
# End of widget hook fn section
###############################
widget_options
=
case drawpane_id
#
THE id => (wi::ID id) ! widget_options; #
NULL => widget_options;
esac;
widget_options
=
[ wi::STARTUP_FN startup_fn_relay, #
wi::SHUTDOWN_FN shutdown_fn_relay,
wi::INITIALIZE_GADGET_FN initialize_gadget_fn_relay,
wi::REDRAW_REQUEST_FN redraw_request_fn_relay,
wi::MOUSE_CLICK_FN mouse_click_fn_relay,
wi::MOUSE_TRANSIT_FN mouse_transit_fn_relay,
# Inherited these from screenline.pkg: Do we need them?
wi::PIXELS_HIGH_MIN pixels_high_min,
wi::PIXELS_HIGH_CUT pixels_high_cut,
wi::DOC widget_doc
]
@
widget_options
;
make_widget_fn = wi::make_widget_start_fn widget_options;
gt::WIDGET make_widget_fn; # So caller can write guiplan = gt::ROW [ button::with [...], button::with [...], ... ];
}; # PUBLIC
};
end;