english
version "1.0"
identify "wxyz"

# Copyright (c) 1998-1999 by Wayne C. Gramlich.
# All rights reserved.
#
# Permission to use, copy, modify, distribute, and sell this software
# for any purpose is hereby granted without fee provided that the above
# copyright notice and this permission are retained.  The author makes
# no representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

module swit_group

#: This module supports groups of items in a SWIT canvas.


#: {item_group} procedures:

procedure clone@item_group
    takes
	master_group item_group
	parent item_group
	uid unsigned
    returns item_group

    #: This procedure will create and return a clone of {master_group}
    #, that is a member of the {parent} {item_group} with a unique
    #, identifier of {uid}.


procedure create@item_group
    takes
	parent item_group
	uid unsigned
    returns item_group

    #: This procedure will create and return a {item_group} object that
    #, is in {parent} group.  This procedure is for internal use only --
    #, use {group_create}@{item_group} instead or fetch the top level
    #, group via {canvas}.{group}().


procedure delete@item_group
    takes
	group item_group
    returns_nothing

    #: This procedure will cause {group} to be removed from the display.


procedure destroy@item_group
    takes
	group item_group
    returns_nothing

    #: This procedure will destroy {group}.  It is not to be called by
    #, application programs.  It is to be called by the clone tree
    #, updating algorithm only!  Use {delete}@{item_group}() instead.

    #format@format1[address](debug_stream,
    #  "destroy@item_group(0x%x%) returns\n\", group.address)



procedure gif_create@item_group
    takes
	parent item_group
	x integer
	y integer
	data string
    returns item_gif

    #: This procedure will create and return a new {item_gif} object
    #, that is part of {parent} at ({x1}, {y1}) with a data value of {data}.


procedure group_create@item_group
    takes
	parent item_group
    returns item_group

    #: This procedure will create and return an {item_group} object
    #, whose parent {item_group} is {parent}.


procedure increment@item_group
    takes
	group item_group
    returns_nothing

    #: This procedure will increment the modification count for
    #, {group} and its parents.

    #, We have extra logic to figure out if we are the top-most group
    #, and, if so, increment the corresponding {canvas}.


procedure children_increment@item_group
    takes
	group item_group
    returns_nothing

    #: This procedure will increment the modification count for
    #, {group} and its children nodes.


procedure insert@item_group
    takes
	group item_group
	new_item item
    returns_nothing

    #: This procedure will insert {new_item} into {group}.


procedure is_master_get@item_group
    takes
	group item_group
    returns logical

    #: This procedure will return {true} if {group} is a member of the
    #, master clone and {false} otherwise.


procedure item_remove@item_group
    takes
	group item_group
	item_to_remove item
    returns_nothing

    #: This procedure will remove {item_to_remove} from {group}.

    #format@format3[address, address, unsigned](debug_stream,
    #  "item_remove@item_group(0x%x%, 0x%x%) size=%d% returns\n\",
    #  group.address, item_to_remove.address, items.size)



procedure level_increment@item_group
    takes
	group item_group
    returns_nothing

    #: This procedure will increment the level modification count for
    #, {group} and its parents.


procedure level_index_find@item_group
    takes
	search_level item_level
    returns unsigned

    #: This procedure will find index of {search_level} in its
    #, parent {item_group}.


procedure level_find@item_group
    takes
	group item_group
    returns item_level

    #: This procedure will find the {item_level} that corresponds to
    #, {group} in its parent.


procedure level_get@item_group
    takes
	group item_group
    returns unsigned

    #: Returns the relative level of {group} in its {item_group}.


procedure level_set@item_group
    takes
	group item_group
	new_level unsigned
    returns_nothing

    #: This procedure will set the level of {group} to {new_level}.


procedure level_uid_find_and_delete@item_group
    takes
	group item_group
	uid unsigned
    returns_nothing

    #: This procedure will search through the various item levels in
    #, {group} and delete {uid} if it is present.


procedure level_update@item_group
    takes
	master_group item_group
	clone_group item_group
    returns_nothing

    #: This procedure will ensure that each {item} in {clone_group}
    #, corresponds to a corresponding {item} in {master_group} and
    #, it is up-to-date.

    #format@format2[address, address](debug_stream,
    #  "level_update@item_group(master=0x%x% clone=0x%x%) returns\n\",
    #  master_group.address, clone_group.address)



procedure line_create@item_group
    takes
	parent item_group
	x1 integer
	y1 integer
	x2 integer
	y2 integer
    returns item_line

    #: This procedure will create and return a new {item_line} object
    #, that is part of {parent} with end-points that are at ({x1}, {y1})
    #, and ({x2}, {y2}).


procedure parent_get@item_group
    takes
	item_group item_group
    returns item_group

    #: This procddure will reutrn the parent of {item_group}.


procedure rectangle_create@item_group
    takes
	parent item_group
	x integer
	y integer
	width unsigned
	height unsigned
    returns item_rectangle

    #: This procedure will create and return a new {item_rectangle} object
    #, that is part of {parent} with end-points that are at ({x}, {y})
    #, and ({x} + {width}, {y} + {height}).


procedure root_create@item_group
    takes
	canvas canvas
	uid unsigned
    returns item_group

    #: This procedure will create and return a root (i.e. top-level}
    #, {item_group} for {canvas} with a unique identifier of {uid}.


procedure text_create@item_group
    takes
	parent item_group
	x integer
	y integer
	value string
    returns item_text

    #: This procedure will create and return a new {item_text} object
    #, that is part of {parent} at ({x1}, {y1}) with a text value of {value}.


procedure tags_append@item_group
    takes
	parent item_group
	uid unsigned
	tags vector[string]
	tcl_command tcl_command
    returns_nothing

    #: This procedure will append a ' -tags "..."' option to {tcl_command}.


procedure uid_delete@item_group
    takes
	group item_group
	level_number unsigned
	uid unsigned
    returns_nothing

    #: This procedure will delete {uid} from {level_number} for {group}.


procedure uid_insert@item_group
    takes
	group item_group
	level_number unsigned
	uid unsigned
    returns_nothing

    #: This procedure will insert {uid} into {level_number} for {group}.


procedure uid_lower_search@item_group
    takes
	search_level item_level
    returns unsigned

    #: This procedure will search for the uid of the lowest item in
    #, the item stack that is above the highest item in {search_level}.
    #, {search_level}.{parent} must be {parent}


procedure uid_move@item_group
    takes
	group item_group
	uid unsigned
	old_level_number unsigned
	new_level_number unsigned
    returns_nothing

    #: This procedure will move {uid} from {old_level_number} to
    #, {new_level_number} in the {item_level} list inside of {group}.


procedure uid_next@item_group
    takes
	group item_group
    returns unsigned

    #: This procedure will create and return a unique identifier
    #, from {group}.


procedure uid_raise_search@item_group
    takes
	search_level item_level
    returns unsigned

    #: This procedure will search for the uid of the highest {uid}
    #, that is below {search_level}.


procedure update@item_group
    takes
	master_group item_group
	clone_group item_group
    returns_nothing

    #: This procedure will ensure that each {item} in {clone_group}
    #, corresponds to a corresponding {item} in {master_group} and
    #, it is up-to-date.


procedure x_get@item_group
    takes
	group item_group
    returns integer

    #: This procedure will return the relative X coordinate of {group}
    #, relative to its parent.


procedure x_set@item_group
    takes
	group item_group
	x integer
    returns_nothing

    #: This procedure will set the relative X coordinate of {group}
    #, relative to its parent.


procedure y_get@item_group
    takes
	group item_group
    returns integer

    #: This procedure will return the relative Y coordinate of {group}
    #, relative to its parent.


procedure y_set@item_group
    takes
	group item_group
	y integer
    returns_nothing

    #: This procedure will set the relative Y coordinate of {group}
    #, relative to its parent.


#: {item_level} procedures:

# The {item_level} data structure is used to keep track of the
#, layering of {item}'s in a {item_group}.
#,
#, Basically, each {item_group} contains a list of {item_level}'s and
#, each {item_level} contains a list of unique identifiers.  Several
#, invariants are maintained -- 1) every {item} within a given
#, {item_group} has its associated unique identifier on exactly one
#, unique identifier list on of of the {item_group}'s {item_level}
#, objects, 2) the {item_level} list for an {item_group} is kept
#, sorted by ascending level number, and 3) the unique identifier
#, list for an {item_level} is kept sorted in ascending order.
#,
#, SWIT will keep the items within an {item_group} stacked so that
#, items with higher level numbers are on top of items with lower
#, level numbers.  In addition, for items that have the same level
#, number, the items are stacked such that the items with the greater
#, unique identifiers are on top of the ones with the lower unique
#, identifiers; this seems to correspond more naturally to what
#, the user expects (i.e. newer items are put on top of older items.)
#,
#, Since {item_group}'s can be recursive members of other {item_group}'s,
#, it is possible to move all of the items in the transitive closure
#, of an {item_group} and its children around in the stacking order.
#, This is accomplished by ensuring that every item is tagged with
#, its own unique identifier (i.e. `T#') and the unique identifier of
#, each {item_group} it is a member of (i.e. `T#'.)  Thus, an entire
#, group of items can be moved en mass by specifying the G# for the
#, group in the Tk canvas raise/lower command.
#, 
#, When the level of an item is changed, its unique identifier is
#, deleted from the {item_level} it is on and and it is inserted
#, inserted into the unique identifier list for the new level.
#, If an {item_level} does not exist for the new level, one is
#, created.  When an {item_level} list is emptied, I do not bother
#, to delete it since it is quite likely that it will be reintroduced
#, later.
#,
#, The exact stacking order for each item in a canvas can logically
#, be obtained by performing an in order tree walk starting from the
#, root {item_group} in the canvas, with one twist, the unique
#, identifiers for each {item_level} are traversed from highest
#, to lowest.
#,
#, When it is time to move an item, it is necessary to find
#, both the item that immediately preceeds it and the one that
#, immediately follows it.  Then the item is raised above the
#, preceeding item and lowered below the following item to
#, ensure that it is in exactly the position in the stack.
#, There is no Tcl/Tk command that says `force the item to
#, be right here in the stack.'  Hence, the use of a raise/lower
#, command pair to perform the operation.  The task of finding
#, immediately preceeding and following items the stack requires
#, recursive tree walking from a given item -- the code for doing
#, this is not very transparent.

procedure clone@item_level
    takes
	master_level item_level
	parent item_group
	level_number unsigned
    returns item_level

    #: This procedure will create and return a clone of {master_level}
    #, that is a member of the {parent} {item_level} with a level of
    #, {level_number}.


procedure create@item_level
    takes
	parent item_group
	level_number unsigned
    returns item_level

    #: This procedure will create and return a {item_level} object that
    #, is in {parent} level.  This procedure is for internal use only.


procedure destroy@item_level
    takes
	level item_level
    returns_nothing

    #: This procedure will destroy {level}.


procedure increment@item_level
    takes
	level item_level
    returns_nothing

    #: This procedure will increment the modificatin count for {level}.


procedure uid_adjust@item_level
    takes
	level item_level
	uid unsigned
	index unsigned
    returns_nothing

    #: This procedure will do all of the hard work of actually
    #, generating the Tcl/Tk command that moves {uid} into {level}
    #, at {index}.

    #, raise/lower it relative to:

    #format@format3[address, unsigned, unsigned](debug_stream,
    #  "uid_adjust@item_level(0x%x%, %d%, %d%) returns\n\",
    #  level.address, uid, index)




procedure uid_delete@item_level
    takes
	level item_level
	old_uid unsigned
    returns logical

    #: This procedure will delete {old_uid} from {level}.  {true}@{logical}
    #, is returned if {old_uid} is found and deleted; otherwise, {false}
    #, is returned


procedure uid_insert@item_level
    takes
	level item_level
	new_uid unsigned
    returns_nothing

    #: This procedure will insert {new_uid} into {level}.


procedure uid_is_in@item_level
    takes
	level item_level
	target_uid unsigned
    returns logical

    #: This procedure will return {true}@{logical} if {target_uid} is
    #, in {level} and {false} otherwise.


procedure uid_lower_search@item_level
    takes
	level item_level
    returns unsigned

    #: This procedure will return uid in {level} of the lowest
    #, item in the item stack.  If there are no items in {level},
    #, 0 is returned.

    #, identifier.


procedure uid_raise_search@item_level
    takes
	level item_level
    returns unsigned

    #: This procedure will return uid in {level} of the highest
    #, item in the item stack.  If there are no items in {level},
    #, 0 is returned.

    #, identifier.


procedure update@item_level
    takes
	master_level item_level
	clone_level item_level
    returns_nothing

    #: This procedure will update {clone_level} to be a copy of {master_level}.