IN: gadgets
USING: help gadgets-text opengl generic kernel strings ;

HELP: origin
{ $var-description "Within the dynamic extent of " { $link draw-world } ", holds the co-ordinate system origin for the gadget currently being drawn." }
{ $see-also translate draw-gadget } ;

HELP: rect
{ $class-description "A rectangle with the following slots:"
    { $list
        { { $link rect-loc } " - the top-left corner of the rectangle as an x/y pair" }
        { { $link rect-dim } " - the dimensions of the rectangle as a width/height pair" }
    }
}
{ $see-also <rect> <extent-rect> } ;

HELP: <rect> ( loc dim -- rect )
{ $values { "loc" "a pair of integers" } { "dim" "a pair of integers" } { "rect" "a new " { $link rect } } }
{ $description "Creates a new rectangle with the specified top-left location and dimensions." } ;

HELP: set-rect-dim ( dim rect -- )
{ $values { "dim" "a pair of integers" } { "rect" rect } }
{ $description "Modifies the dimensions of a rectangle. To resize a gadget, use " { $link set-gadget-dim } " or " { $link set-layout-dim } " instead." }
{ $side-effects "rect" } ;

HELP: rect-bounds
{ $values { "rect" rect } { "loc" "a pair of integers" } { "dim" "a pair of integers" } }
{ $description "Outputs the location and dimensions of a rectangle." }
{ $see-also rect-extent } ;

HELP: <extent-rect> ( loc ext -- rect )
{ $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } { "rect" "a new " { $link rect } } }
{ $description "Creates a new rectangle with the specified top-left and bottom-right corner locations." } ;

HELP: rect-extent
{ $values { "rect" rect } { "loc" "a pair of integers" } { "ext" "a pair of integers" } }
{ $description "Outputs the location of the top-left and bottom-right corners of a rectangle." }
{ $see-also rect-bounds } ;

HELP: offset-rect
{ $values { "rect" rect } { "loc" "a pair of integers" } { "newrect" "a new " { $link rect } } }
{ $description "Creates a new rectangle with the same dimensions, and top-left corner translated by " { $snippet "loc" } "." } ;

HELP: rect-intersect
{ $values { "rect1" rect } { "rect2" rect } { "newrect" "a new " { $link rect } } }
{ $description "Computes the intersection of two rectangles." } ;

HELP: intersects?
{ $values { "rect/point" "a " { $link rect } " or a pair of integers" } { "rect" rect } { "?" "a boolean" } }
{ $description "Tests if two rectangles (or a point and a rectangle, respectively) have a non-empty intersection." } ;

HELP: gadget
{ $class-description "An object which displays itself on the screen and acts on user input gestures. Gadgets have the following slots:"
    { $list
        { { $link gadget-pref-dim } " - a cached value for " { $link pref-dim } "; do not read or write this slot directly." }
        { { $link gadget-parent } " - the gadget containing this one, or " { $link f } " if this gadget is not part of the visible gadget hierarchy." }
        { { $link gadget-children } " - a vector of child gadgets. Do not modify this vector directly, instead use " { $link add-gadget } ", " { $link add-gadgets } ", " { $link unparent } " or " { $link clear-gadget } "." }
        { { $link gadget-orientation } " - one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } ". This slot is used by layout gadgets such as " { $link pack } "." }
        { { $link gadget-state } " - stores the layout state of the gadget. Do not read or write this slot directly, instead call " { $link relayout } " and " { $link relayout-1 } " if the gadget needs to be relayout." }
        { { $link gadget-visible? } " - a boolean indicating if the gadget should display and receive user input." }
        { { $link gadget-root? } " - if set to " { $link t } ", layout changes in this gadget will not propagate to the gadget's parent." }
        { { $link gadget-clipped? } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
        { { $link gadget-grafted? } " - if set to " { $link t } ", the gadget is parented in a native window. Do not write this slot directly, instead add gadgets to visible gadgets or use " { $link open-window } " to display gadgets in new windows on the screen." }
        { { $link gadget-interior } " - an object whose class implements the " { $link draw-interior } " generic word." }
        { { $link gadget-boundary } " - an object whose class implements the " { $link draw-boundary } " generic word." }
    }
"Gadgets delegate to " { $link rect } " instances holding their location and dimensions." }
{ $notes
"Other classes may delegate to " { $link gadget } " in order to re-implement generic words such as " { $link draw-gadget* } " and " { $link user-input* } ", or to define gestures with " { $link set-gestures } " or " { $link define-commands } "." }
{ $warning
"When setting a tuple's delegate to be a gadget, " { $link set-gadget-delegate } " should be used instead of " { $link set-delegate } "." } ;

HELP: gadget-child
{ $values { "gadget" gadget } { "child" gadget } }
{ $description "Outputs the first child of the gadget. Typically this word is used with gadgets which are known to have an only child." } ;

HELP: nth-gadget
{ $values { "n" "a non-negative integer" } { "gadget" gadget } { "child" gadget } }
{ $description "Outputs the " { $snippet "n" } "th child of the gadget." }
{ $errors "Throws an error if " { $snippet "n" } " is negative or greater than or equal to the number of children." } ;

HELP: <zero-rect>
{ $values { "rect" "a new " { $link rect } } }
{ $description "Creates a rectangle located at the origin with zero dimensions." } ;

HELP: <gadget>
{ $values { "gadget" "a new " { $link gadget } } }
{ $description "Creates a new gadget." }
{ $see-also delegate>gadget } ;

HELP: delegate>gadget
{ $values { "tuple" tuple } }
{ $description "Sets the tuple's delegate to a new " { $link gadget } "." }
{ $examples
    "This word is used in tuple constructors. For example:"
    { $code
        "USING: gadgets ;"
        "TUPLE: fancy-gadget ;"
        "C: fancy-gadget dup delegate>gadget ;"
    }
    "Now new methods can be defined to specialize various generic words on the " { $snippet "fancy-gadget" } " class, such as " { $link pref-dim* } ", " { $link layout* } ", " { $link draw-gadget* } ", and so on."
}
{ $side-effects "tuple" }
{ $see-also <gadget> set-gadget-delegate } ;

HELP: relative-loc
{ $values { "fromgadget" gadget } { "togadget" gadget } { "loc" "a pair of integers" } }
{ $description
    "Outputs the location of the top-left corner of " { $snippet "togadget" } " relative to the co-ordinate system of " { $snippet "fromgadget" } "."
}
{ $errors
    "Throws an error if " { $snippet "togadget" } " is not contained in a child of " { $snippet "fromgadget" } "."
} ;

HELP: user-input*
{ $values { "str" string } { "gadget" gadget } { "?" "a boolean" } }
{ $contract "Handle free-form textual input while the gadget has keyboard focus." } ;

HELP: children-on
{ $values { "rect/point" "a " { $link rect } " or a pair of integers" } { "gadget" gadget } { "seq" "a sequence of gadgets" } }
{ $contract "Outputs a sequence of gadgets which potentially intersect the rectangle or contain the point, respectively." }
{ $notes "This does not have to be an accurate intersection test, and simply returning " { $link gadget-children } " is a valid implementation. However, an accurate intersection test reduces the amount of work done when drawing this gadget if it is partially clipped and not all children are visible." } ;

HELP: pick-up
{ $values { "point" "a pair of integers" } { "gadget" gadget } { "child/f" "a " { $link gadget } " or " { $link f } } }
{ $description "Outputs the child at the given location in " { $snippet "gadget" } ", or " { $link f } " if the point is outside the bounds of " { $snippet "gadget" } "." } ;

HELP: max-dim
{ $values { "dims" "a sequence of pairs of integers" } { "dim" "a pair of integers" } }
{ $description "Outputs the smallest dimensions of a rectangle which can fit all the dimensions in the sequence." }
{ $see-also pref-dims dim-sum } ;

HELP: each-child
{ $values { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( child -- )" } } }
{ $description "Applies the quotation to each child of the gadget." } ;

HELP: each-child-with
{ $values { "obj" object } { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( obj child -- )" } } }
{ $description "Variant of " { $link each-child } " which pushes a retained object on each invocation of the quotation." } ;

HELP: set-gadget-delegate
{ $values { "gadget" gadget } { "tuple" tuple } }
{ $description "Sets the delegate of " { $snippet "tuple" } " to " { $snippet "gadget" } ". This is like " { $link set-delegate } ", except that to ensure correct behavior, the parent of each child of " { $snippet "gadget" } " is changed to " { $snippet "tuple" } "." }
{ $notes "This word should be used instead of " { $link set-delegate } " when setting a tuple's delegate to a gadget." } ;

HELP: gadget-selection?
{ $values { "gadget" gadget } { "?" "a boolean" } }
{ $contract "Outputs if the gadget has an active text selection; if so, the selected text can be obtained with a call to " { $link gadget-selection } "." }
{ $examples "The " { $link editor } " gadget implements the selection protocol." } ;

HELP: gadget-selection
{ $values { "gadget" gadget } { "string/f" "a " { $link string } " or " { $link f } } }
{ $contract "Outputs the gadget's text selection, or " { $link f } " if nothing is selected." }
{ $examples "The " { $link editor } " gadget implements the selection protocol." } ;

HELP: timer-gadget
{ $class-description "A gadget equipped with a timer which can be switched on and off by calling " { $link start-timer-gadget } " and " { $link stop-timer-gadget } ". The timer fires every 200 milliseconds." }
{ $notes "More precise control over timer behavior can be achieved by using the timer words directly, instead of this class; see " { $link "timers" } "." } ;

HELP: <timer-gadget>
{ $values { "gadget" gadget } { "newgadget" "a new " { $link gadget } } }
{ $description "Creates a new " { $link timer-gadget } " which delegates to the given gadget." }
{ $see-also start-timer-gadget stop-timer-gadget } ;

HELP: start-timer-gadget
{ $values { "gadget" timer-gadget } { "quot" "a quotation with stack effect " { $snippet "( gadget -- )" } } }
{ $description "Starts a timer which calls " { $snippet "quot" } " until a subsequent call to " { $link stop-timer-gadget } "." } ;

HELP: stop-timer-gadget
{ $values { "gadget" timer-gadget } }
{ $description "Stops a timer started by a previous call to " { $link start-timer-gadget } "." } ;