############################################################################
#
# File: gui.icn
#
# Subject: Set of classes for GUI objects in Unicon
#
# Authors: Robert Parlett, Clint Jeffery, Susie Jeffery
#
# Date: 16 January, 2001
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This file provides an implementation of several common GUI
# objects. See the documentation supplied for full details.
#
############################################################################
#
# Links: graphics, enqueue
#
############################################################################
link graphics, enqueue
$include "keysyms.icn"
$include "guiconst.icn"
$include "posix.icn"
$define SB_SIZE 22
record undo_rec(undo_type, undo_list, undo_x, undo_y, undoend_x, undoend_y, redo_type, redo_list, redo_x, redo_y, redoend_x, redoend_y)
$include "_ticker.icn"
$include "dispatcher.icn"
##
#
# An instance of this class is used to represent an event.
#
class _Event(
event, # The Icon event
component, # The Component producing the event
code # The integer code number for different event types.
)
##
# Returns the Icon event associated with the event.
#
method get_event()
return self.event
end
method set_event(x)
return self.event := x
end
##
# Returns an additional field to distinguish between different
# types of event generated by the same component. For
# example, a TextField produces a code of zero when return is
# pressed, and a code of one when the contents are changed.
#
method get_code()
return self.code
end
method set_code(x)
return self.code := x
end
##
# Returns the component associated with the event. This may
# be a subclass of either Component or a MenuComponent.
#
method get_component()
return self.component
end
method set_component(x)
return self.component := x
end
end
##
#
# This is the parent class of a dialog window.
#
class _Dialog : Container(
win, # The dialog's window.
is_open, # Flag indicates whether window is open
owning_dialog,
child_dialogs,
focus, # Component with current focus
unique_flag, # Flag indicates whether in unique processing mode
re_process_flag, # Flag indicates whether to distribute last
# Icon event during unique mode
buffer_win, # Buffer window for double buffering
min_width, # Minimum size of window.
min_height, #
click_count, # Variables controlling multiple clicks
double_click_delay,
repeat_delay, # Repeat event delays
repeat_rate,
prev_x,
prev_y,
prev_time,
prev_event,
is_blocked_flag,
resize_attrib
)
method is_shaded()
return \self.is_shaded_flag
end
method is_unshaded()
return /self.is_shaded_flag
end
method is_hidden()
fail
end
method is_unhidden()
return
end
method block()
self.is_blocked_flag := 1
self.resize_attrib := WAttrib(self.win, "resize")
WAttrib(self.win, "resize=off")
end
method unblock()
self.is_blocked_flag := &null
WAttrib(self.win, "resize=" || self.resize_attrib)
end
##
# Returns the number of mouse clicks that have occurred consecutively,
# with each click in the sequence being less than {double_click_delay}
# milliseconds apart. That variable is by default 500 milliseconds,
# but it may be configured with {set_double_click_delay().}
#
method get_click_count()
return self.click_count
end
method get_x_reference()
return 0
end
method get_y_reference()
return 0
end
method get_w_reference()
return WAttrib(self.win, "width")
end
method get_h_reference()
return WAttrib(self.win, "height")
end
method get_cwin_reference()
return self.win
end
method get_visible_reference()
fail
end
##
# This is a variation on the conventional modal and modeless
# methods. The dialog is opened, input to other windows is not blocked, but
# the call does not return until the window is closed.
# @param d The parent dialog, if specified, is blocked until
# @ the window is closed.
#
method show_child(d)
self$show()
dispatcher$add(self)
if \d then {
insert(d.child_dialogs, self)
self.owning_dialog := d
d$block()
dispatcher$message_loop(self)
d$unblock()
} else
dispatcher$message_loop(self)
end
##
# Displays the dialog as a modeless dialog. This
# means that window events are processed by this dialog
# and other open dialogs concurrently. The call to
# {show_modeless()} opens the dialog and returns immediately.
#
# @param d This optional parameter specifies the parent dialog.
# @ When a parent dialog is closed, its child dialogs are automatically closed.
#
method show_modeless(d)
self$show()
if \gui::dispatcher then gui::dispatcher.add(self) else
dispatcher$add(self)
if \d then {
insert(d.child_dialogs, self)
self.owning_dialog := d
self.is_blocked_flag := d.is_blocked_flag
}
end
##
# Displays the dialog as a modal dialog. In other
# words, window events to any other open dialogs are blocked
# until the dialog is closed. This method doesn't return
# until the dialog is closed.
# @param d The parent dialog. It will not normally be
# @ needed.
#
method show_modal(d)
local l
self$show()
if \d then {
insert(d.child_dialogs, self)
self.owning_dialog := d
}
l := dispatcher$list_unblocked()
every (!l)$block()
dispatcher$add(self)
dispatcher$message_loop(self)
every x := !l do {
if x.win ~=== x.buffer_win then
x$unblock()
}
end
method get_cbwin_reference()
return self.buffer_win
end
##
# Returns the Icon window associated with the dialog.
#
method get_win()
return self.win
end
method resize_win(w, h)
WAttrib(self.win, "size=" || w || "," || h)
Enqueue(self.win, &resize)
end
method Open()
local attr
attr := ["inputmask=c"] ||| self.attribs
self.win := (WOpen ! attr) | error("couldn't open window")
self.buffer_win := (WOpen ! (["canvas=hidden"] ||| self.attribs)) | error("couldn't open buffer window")
return
end
method Close()
WClose(self.buffer_win)
return WClose(self.win)
end
##
# Sets the minimum dimensions for a window. The user will not
# be able to resize the window below this size.
#
method set_min_size(w, h)
self.min_width := w
self.min_height := h
return
end
method get_buffer_win()
return self.buffer_win
end
method set_unique(c)
/self.unique_flag := c | stop("internal error")
return
end
method clear_unique(x)
self.re_process_flag := x
self.unique_flag := &null
return
end
##
# Sets keyboard focus to the given component. This method
# should only be invoked after the dialog has been displayed.
# To give a component the initial keyboard focus,
# invoke this method from within {init_dialog()}
#
method set_focus(c)
if \self.focus === c then
return
(\self.focus)$lost_focus()
self.focus := c
self.focus$got_focus()
return
end
##
# Clear the keyboard focus.
#
method clear_focus()
(\self.focus)$lost_focus()
self.focus := &null
return
end
#
# Display all components
#
method display(buffer_flag)
if \buffer_flag then {
EraseArea(buffer_win, 0, 0, get_w_reference(), get_h_reference())
self$Container.display(1)
CopyArea(buffer_win, win, 0, 0, get_w_reference(), get_h_reference(), 0, 0)
} else {
EraseArea(win, 0, 0, get_w_reference(), get_h_reference())
self$Container.display()
}
end
method init_dialog()
end
##
# This empty method may be overridden to add components to the
# dialog. Alternatively, components may be added in the
# dialog's {initially} method.
#
method component_setup()
end
##
# This empty method may be overridden. It is invoked just
# before the dialog window is closed.
#
method end_dialog()
end
method show()
self$component_setup()
self$Open()
self$final_setup(self, self)
self$resize()
self$firstly()
self.is_open := 1
self$display()
self$init_dialog()
end
method dispose(was_closed)
self$end_dialog()
every (!child_dialogs)$dispose(was_closed)
self$finally(was_closed)
if /was_closed then
self$Close()
self.is_open := &null
dispatcher$del(self)
delete((\owning_dialog).child_dialogs, self)
end
method process_event(e)
local res, found, c, wrap, nw, nh, t
if integer(e) = -11 then {
dispose(1)
}
if integer(e) = (&lpress | &rpress | &mpress) then {
t := dispatcher$curr_time_of_day()
if e = \prev_event & prev_x = &x & prev_y = &y & (t - prev_time < double_click_delay) then
click_count +:= 1
else
click_count := 1
prev_event := e
prev_time := t
prev_x := &x
prev_y := &y
}
if e === &resize then {
# delay(25) # merge redundant resize events
while Pending(self.win)[1] === e do {
e := Event(self.win)
# delay(50)
}
nw := &x
nh := &y
#
# Don't allow size to fall below minimum.
#
if nw <:= \self.min_width then
WAttrib(self.win, "width=" || nw)
if nh <:= \self.min_height then
WAttrib(self.win, "height=" || nh)
#
# Resize buffer canvas
#
WAttrib(self.buffer_win, "width=" || nw)
WAttrib(self.buffer_win, "height=" || nh)
EraseArea(self.win, 0, 0, nw, nh)
self$resize()
self$display()
}
if e === (&ldrag | &rdrag | &mdrag) then {
while *Pending(self.win) > 0 & Pending(self.win)[1] === e do {
e := Event(self.win)
}
}
every E := (\self.unique_flag)$handle_event(e) do {
self$dialog_event(E)
if /self.is_open then
return
}
if /self.unique_flag & /self.re_process_flag then {
if integer(e) = (&lpress | &rpress | &mpress) then {
if c := self$in_region() then
self$set_focus(c)
else
self$clear_focus()
}
every E := self$handle_event(e) | _Event(e) do {
self$dialog_event(E)
if /self.is_open then
return
}
if (string(e) == "\t") &
(/self.focus | /self.focus.keeps_tabs) then {
res := found := wrap := &null
every c := self$generate_components() do {
if c === self.focus then
found := 1
else {
if c$accepts_tab_focus() then {
if /found then
/wrap := c
else {
res := c
break
}
}
}
}
self$set_focus(\res | \wrap)
} else if integer(e) = \Shift_Tab then {
res := &null
every c := self$generate_components() do {
if c === self.focus then {
if \res then
break
} else {
if c$accepts_tab_focus() then
res := c
}
}
self$set_focus(\res)
}
}
self.re_process_flag := &null
return
end
##
# This method must be over-ridden in the subclass. It is the
# method which is invoked when an event occurs.
# @param e The instance of the {_Event} class to be processed.
#
method dialog_event(e)
error("dialog_event() must be overridden in subclass")
end
##
# Set the delay in milliseconds between double clicks. The
# default is 500 milliseconds
#
method set_double_click_delay(i)
return self.double_click_delay := i
end
##
# Set the delay in milliseconds between an initial repeating event
# and the start of repeat events. The
# default is 500 milliseconds
#
method set_repeat_delay(i)
return self.repeat_delay := i
end
##
# Set the delay in milliseconds between repeating events.
# The default is 100 milliseconds
#
method set_repeat_rate(i)
return self.repeat_rate := i
end
method handle_notify(e)
self$dialog_event(e)
end
initially
self$Container.initially()
self.attribs := ["bg=pale gray"]
self.child_dialogs := set([])
self.double_click_delay := 500
self.repeat_delay := 500
self.repeat_rate := 100
end
#
# Abstract parent of Component and MenuComponent
#
class MetaComponent()
method set_fields(L)
every s := !L do {
s ? {
(attr := tab(find("="))) &
="=" &
(val := tab(0))
}
if find(",", val) then {
vals := []
val ? {
while put(vals, tab(find(","))) do move(1)
put(vals, tab(0))
}
self.__m["set_" || attr] ! (push(vals, self))
}
else
self.__m["set_" || attr] (self, val)
}
end
end
$include "component.icn"
#
# This class acts as a container for other components. The
# component itself is not displayable.
#
# A {_Dialog} instance is a sub-class of this class.
#
class Container : Component(
components
)
method get_x_reference()
return self.parent_Component$get_x_reference()
end
method get_y_reference()
return self.parent_Component$get_y_reference()
end
method get_w_reference()
return self.parent_Component$get_w_reference()
end
method get_h_reference()
return self.parent_Component$get_h_reference()
end
method get_cwin_reference()
return self.parent_Component$get_cwin_reference()
end
method get_cbwin_reference()
return self.parent_Component$get_cbwin_reference()
end
method get_visible_reference()
return self.parent_Component$get_visible_reference()
end
method generate_components()
suspend (!self.components)$generate_components()
end
method generate_all_components()
suspend (!self.components)$generate_all_components() | self
end
##
# Add the {Component} to the {Container}.
# @param c The {Component} to add.
#
method add(c)
put(self.components, c)
end
##
# Set the list of {Components} in this {Container}.
# @param x The list of {Components}.
#
method set_components(x)
return self.components := x
end
##
# Get the list of {Components} in this {Container}.
# @return The list of {Components}
#
method get_components()
return self.components
end
method display(buffer_flag)
every (!self.components)$display(buffer_flag)
return
end
method firstly()
every (!self.components)$firstly()
return
end
method final_setup(x, y)
self.parent_Dialog := x
self.parent_Component := y
every (!self.components)$final_setup(x, self)
return
end
method finally(was_closed)
stop_ticker()
every (!self.components)$finally(was_closed)
return
end
method resize()
if string(x_spec) & \y_spec & \w_spec & \h_spec then
self$Component.resize()
every (!self.components)$resize()
return
end
method handle_event(e)
local c
every c := !self.components do {
if /c.is_shaded_flag then
suspend c$handle_event(e)
if \self.parent_Dialog.unique_flag then
break
}
end
method in_region()
return (!self.components)$in_region()
end
initially(argv[])
self$Component.initially()
self.components := []
if *argv > 0 then set_fields(argv)
end
##
# This is similar to a Container, except that the object
# itself is a capable of display. A {VisibleContainer} should not
# be instantiated itself; rather one of its subclasses should be
# instantiated.
#
class VisibleContainer : Component(
components
)
method generate_components()
suspend (!self.components)$generate_components() | self
end
method generate_all_components()
suspend (!self.components)$generate_all_components() | self
end
method in_region()
return (!self.components)$in_region() | self$Component.in_region()
end
method resize()
self$Component.resize()
every (!self.components)$resize()
end
##
# Add the {Component} to the {Container}.
# @param c The {Component} to add.
#
method add(c)
put(self.components, c)
end
##
# Set the list of {Components} in this {Container}.
# @param x The list of {Components}.
#
method set_components(x)
return self.components := x
end
##
# Get the list of {Components} in this {Container}.
# @return The list of {Components}
#
method get_components()
return self.components
end
method firstly()
self$Component.firstly()
every (!self.components)$firstly()
return
end
method final_setup(x, y)
self$Component.final_setup(x, y)
every (!self.components)$final_setup(x, self)
return
end
method finally()
self$Component.finally()
every (!self.components)$finally()
return
end
initially(argv[])
self$Component.initially()
self.components := []
if *argv > 0 then set_fields(argv)
end
$include "_panel.icn"
# a panel on which a background attribute should work
# The parameter "buffer_flag" just tells it whether to draw directly into the
# visible window, or to use its non-visible buffer window instead (this is
# used for double-buffering).
class FillPanel : Panel()
method display(buffer_flag)
EraseRectangle(if /buffer_flag then self.cwin else self.cbwin,
self.x, self.y, self.w, self.h)
self.Panel.display(buffer_flag)
end
end
$include "toggle.icn"
$include "sizer.icn"
$include "_button.icn"
$include "checkbox.icn"
$include "textbutton.icn"
$include "iconbutton.icn"
$include "toggletextbutton.icn"
$include "toggleiconbutton.icn"
$include "icon.icn"
$include "label.icn"
global ImageCache
procedure CacheImage(win,x,y,w,h,filename)
static zoomed
/cache := table()
/zoomed := table()
/ (cache[filename]) := open(filename,"g",
"canvas=hidden","image="||filename) |
stop("can't open ", image(filename))
wc := cache[filename]
if WAttrib(wc, "width") = w & WAttrib(wc,"height") = h then
return CopyArea(wc, win, , , , , x, y)
# otherwise, we have to zoom
wc := cache[filename]
/ (zoomed[filename]) := table()
if / (zoomed[filename][w||","||h]) :=
open(filename,"g","size="||w||","||h, "canvas=hidden") then {
Zoom(wc, zoomed[filename][w||","||h],
0,0,WAttrib(wc,"width"),WAttrib(wc,"height"),0,0,w,h)
}
zc := zoomed[filename][w||","||h]
CopyArea(zc, win, 0, 0, w, h, x, y)
end
$include "_image.icn"
$include "textfield.icn"
$include "border.icn"
$include "checkboxgroup.icn"
$include "scrollbar.icn"
$include "scrollarea.icn"
$include "_node.icn"
$include "_tree.icn"
$include "textlist.icn"
$include "editabletextlist.icn"
$include "dropdown.icn"
$include "_list.icn"
$include "editlist.icn"
$include "menubutton.icn"
$include "popupmenu.icn"
$include "menubar.icn"
##
# This class is an {_Event} with an extra code. Its use is internal to
# the menu system.
#
class MenuEvent : _Event(
menu_code
)
##
# Return the additional code.
#
method get_menu_code()
return self.menu_code
end
end
$include "menucomponent.icn"
$include "submenu.icn"
$include "_menu.icn"
$include "textmenuitem.icn"
$include "checkboxmenuitem.icn"
$include "menuseparator.icn"
$include "tablecolumn.icn"
$include "_table.icn"
$include "buttongroup.icn"
$define X_PADDING_INC 5
$include "tabitem.icn"
$include "tabset.icn"
$include "overlayitem.icn"
$include "overlayset.icn"
$include "toolbar.icn"
procedure EraseRectangle(W, x, y, w, h)
if x < 0 then {
w +:= x
x := 0
}
return EraseArea(W, x, y, w, h)
end
procedure Rectangle(W, x, y, w, h)
return DrawRectangle(W, x, y, w - 1, h - 1)
end
#
# Draw a raised rectangle.
#
procedure DrawRaisedRectangle(W, x, y, w, h, i)
BevelRectangle(W, x, y, w, h, i)
end
#
# Draw a sunken rectangle.
#
procedure DrawSunkenRectangle(W, x, y, w, h, i)
BevelRectangle(W, x, y, w, h, i)
end
procedure FilterRectangle(W, x, y, w, h)
$ifdef _MS_WINDOWS_NT
cw := Clone(W, "fillstyle=masked", "drawop=reverse", "pattern=verydark")
FillRectangle(cw, x, y, w, h)
$else
cw := Clone(W, "fillstyle=masked", "reverse=on", "pattern=waves")
FillRectangle(cw, x, y, w, h)
$endif
Uncouple(cw)
end
procedure left_string(win, x, y, s)
y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2
return DrawString(win, x, y, s)
end
procedure left_stringr(win, x, y, s)
local rv
y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2
Fg(win, "black")
rv := DrawString(win, x, y, s)
return rv
end
procedure left_stringg(win, x, y, s)
y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2
oldfg := Fg(win)
oldbg := Bg(win)
WAttrib(win, "fg=red")
WAttrib(win, "bg=gray")
rv := DrawString(win, x, y, s)
Fg(win, oldfg)
Bg(win, oldbg)
return rv
end
procedure center_string(win, x, y, s)
x -:= TextWidth(win, s) / 2
y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2
return DrawString(win, x, y, s)
end
procedure right_string(win, x, y, s)
x -:= TextWidth(win, s)
y +:= (WAttrib(win, "ascent") - WAttrib(win, "descent")) / 2
return DrawString(win, x, y, s)
end
procedure object_class_name(o)
image(o) ? {
="record "
return tab(find("__")) | "?"
}
end
procedure img_width(s)
return s ? integer(tab(upto(',')))
end
procedure img_height(s)
local w
s ? {
w := integer(tab(upto(',')))
move(1)
tab(upto(','))
move(1)
return *tab(0) / (0 ~= \w)
}
end
procedure img_style(s)
return case s of {
"box_up" :
"11,g2,_
11111111111_
11111111110_
11~~~~~~~00_
11~~~~~~~00_
11~~~~~~~00_
11~~~~~~~00_
11~~~~~~~00_
11~~~~~~~00_
11~~~~~~~00_
11000000000_
10000000000_
"
"box_down" :
"11,g2,_
00000000001_
00000000011_
00000000011_
00000000011_
00000000011_
00000000011_
00000000011_
00000000011_
00000000011_
01111111111_
11111111111_
"
"diamond_up" :
"11,g5,_
~~~~~4~~~~~_
~~~~444~~~~_
~~~44~44~~~_
~~44~~~44~~_
~44~~~~~44~_
44~~~~~~~44_
~00~~~~~00~_
~~00~~~00~~_
~~~00~00~~~_
~~~~000~~~~_
~~~~~0~~~~~_
"
"diamond_down" :
"11,g5,_
~~~~~0~~~~~_
~~~~000~~~~_
~~~00000~~~_
~~0000000~~_
~000000000~_
00000000000_
~440000044~_
~~4400044~~_
~~~44044~~~_
~~~~444~~~~_
~~~~~4~~~~~_
"
"arrow_up" :
"11,c1,_
~~~~~0~~~~~_
~~~~000~~~~_
~~~00000~~~_
~~0000000~~_
~000000000~_
00000000000_
"
"arrow_down" :
"11,c1,_
00000000000_
~000000000~_
~~0000000~~_
~~~00000~~~_
~~~~000~~~~_
~~~~~0~~~~~_
"
"arrow_left" :
"9,c1,_
~~~~~~~~0_
~~~~~~000_
~~~~00000_
~~0000000_
000000000_
~~0000000_
~~~~00000_
~~~~~~000_
~~~~~~~~0_
"
"arrow_right" : "9,c1,_
0~~~~~~~~_
000~~~~~~_
00000~~~~_
0000000~~_
000000000_
0000000~~_
00000~~~~_
000~~~~~~_
0~~~~~~~~_
"
"closed_folder" : "16,c1,_
~~~~~~~~~~~~~~~~_
~~~~0000~~~~~~~~_
~~~0;;;;0~~~~~~~_
~~0;;;;;;0~~~~~~_
~0000000000000~~_
~0;;;;;;;;;;;0~~_
~0;;;;;;;;;;;0~~_
~0;;;;;;;;;;;0~~_
~0;;;;;;;;;;;0~~_
~0;;;;;;;;;;;0~~_
~0;;;;;;;;;;;0~~_
~0;;;;;;;;;;;0~~_
~0000000000000~~_
~~~~~~~~~~~~~~~~_
"
"open_folder" : "16,c1,_
~~~~~~~~~~~~~~~~_
~~~0000~~~~~~~~~_
~~0DDDD0~~~~~~~~_
~0DDDDDD0~~~~~~~_
0000000000000~~~_
02D2D2D2D2D20~~~_
0D2D000000000000_
02D0DDDDDDDDDDD0_
0D20DDDDDDDDDD0~_
020DDDDDDDDDDD0~_
0D0DDDDDDDDDDD0~_
00DDDDDDDDDD00~~_
0000000000000~~~_
~~~~~~~~~~~~~~~~_
"
"file" : "16,c1,_
~~~~~~~~~~~~~~~~_
~~~0000000~~~~~~_
~~~06666600~~~~~_
~~~0606060~0~~~~_
~~~0666660000~~~_
~~~0600606660~~~_
~~~0666666660~~~_
~~~0600600060~~~_
~~~0666666660~~~_
~~~0600060660~~~_
~~~0666666660~~~_
~~~0666666660~~~_
~~~0000000000~~~_
~~~~~~~~~~~~~~~~_
"
"plus" : "9,g2,_
000000000_
0~~~~~~~0_
0~~~0~~~0_
0~~~0~~~0_
0~00000~0_
0~~~0~~~0_
0~~~0~~~0_
0~~~~~~~0_
000000000_
"
"minus" : "9,g2,_
000000000_
0~~~~~~~0_
0~~~~~~~0_
0~~~~~~~0_
0~00000~0_
0~~~~~~~0_
0~~~~~~~0_
0~~~~~~~0_
000000000_
"
default : stop("unknown image style")
}
end
procedure set_CheckBoxes_by_flag(i, checkboxes)
j := 1
every c := !checkboxes do {
if iand(i, j) ~= 0 then
c$toggle_is_checked()
j *:= 2
}
end
procedure get_CheckBoxes_by_flag(checkboxes)
i := 1
j := 0
every c := !checkboxes do {
if c$is_checked() then
j +:= i
i *:= 2
}
return j
end
This page produced by UniDoc on 2021/04/15 @ 23:59:44.