summaryrefslogtreecommitdiff
path: root/ipl/gprocs/dialog.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/gprocs/dialog.icn')
-rw-r--r--ipl/gprocs/dialog.icn735
1 files changed, 735 insertions, 0 deletions
diff --git a/ipl/gprocs/dialog.icn b/ipl/gprocs/dialog.icn
new file mode 100644
index 0000000..d10648c
--- /dev/null
+++ b/ipl/gprocs/dialog.icn
@@ -0,0 +1,735 @@
+############################################################################
+#
+# File: dialog.icn
+#
+# Subject: Procedures for dialogs
+#
+# Authors: Ralph E. Griswold and Gregg M. Townsend
+#
+# Date: December 14, 1999
+#
+############################################################################
+#
+# This file is in the public domain.
+#
+############################################################################
+#
+# This file contains several procedures for posting dialog boxes:
+#
+# AskDialog() -- TextDialog() with only caption and "No" instead of "Cancel"
+# Notice(win, captions) -- notice dialog (a simple text dialog)
+# TextDialog(win, captions, labels, defaults...) -- text dialog
+# ToggleDialog(win, captions, labels, defaults...) -- toggle dialog
+# SelectDialog(win, captions, labels, defaults...) -- selection dialog
+# SaveDialog(win, caption, filename, len) -- save file dialog
+# OpenDialog(win, caption, filename, len) -- open file dialog
+# ColorDialog(win, captions, refcolor, callback, id) -- color dialog
+#
+# In all cases, the first or only caption is used as a dialog box ID,
+# used to remember the dialog box location when it is closed. A later
+# posting using the same ID places the new box at the same location.
+#
+############################################################################
+#
+# ColorDialog(win, captions, color, callback, id) -- display color dialog
+#
+# captions list of dialog box captions; default is ["Select color:"]
+# color reference color setting; none displayed if not supplied
+# callback procedure to call when the setting is changed
+# id arbitrary value passed to callback
+#
+# ColorDialog displays a dialog window with R/G/B and H/S/V sliders for
+# color selection. When the "Okay" or "Cancel" button is pressed,
+# ColorDialog returns the button name, with the ColorValue of the final
+# settings stored in the global variable dialog_value.
+#
+# If a callback procedure is specified, callback(id, k) is called whenever
+# the settings are changed; k is the ColorValue of the settings.
+#
+############################################################################
+#
+# Popup(x, y, w, h, proc, args...) creates a subwindow of the specified
+# size, calls proc(args), and awaits its success or failure. Then, the
+# overlaid area is restored and the result of proc is produced. &window,
+# as seen by proc, is a new binding of win in which dx, dy, and clipping
+# have been set. The usable area begins at (0,0); its size is
+# (WAttrib(win, "clipw"), WAttrib(win, "cliph")). Defaults are:
+# x, y positioned to center the subwindow
+# w, h 250, 150
+# proc Event
+#
+############################################################################
+#
+# Requires: Version 9 graphics
+#
+############################################################################
+#
+# Links: graphics, vbuttons, vdialog, vradio, vslider, vidgets
+#
+############################################################################
+
+link graphics
+link vbuttons
+link vdialog
+link vradio
+link vslider
+link vidgets
+
+$include "vdefns.icn"
+
+global dialog_button
+global dialog_value
+
+$define ButtonWidth 50 # minimum button width
+$define ButtonHeight 30 # button height
+$define FieldWidth 10 # default field width
+$define OpenWidth 50 # default field width for Open/SaveDialog
+
+$define XOff 0 # offset for text vidgets
+$define XOffButton 85 # initial x offset for buttons
+$define XOffIncr 15 # space between buttons
+
+procedure Dialog(win, captions, labels, defaults, widths, buttons, index)
+ Dialog := TextDialog
+ return Dialog(win, captions, labels, defaults, widths, buttons, index)
+end
+
+procedure AskDialog(win, caption)
+
+ return TextDialog(win, caption, , , , , ["Okay", "No"])
+
+end
+
+procedure TextDialog( #: text dialog
+ win, captions, labels, defaults, widths, buttons, index
+ )
+ local maxl, lead, pad, default_button, i, maxw, cwidth, id, label_width
+ local button, maxb, dialog, x, y, button_space, default_width, box_id
+ local temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(win) ~== "window" then {
+ win :=: captions :=: labels :=: defaults :=: widths :=: buttons :=:
+ index
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ /captions := []
+ /labels := []
+ /defaults := []
+ /widths := []
+ /buttons := ["Okay", "Cancel"]
+ /index := 1
+
+ if type(captions) ~== "list" then captions := [captions]
+ if type(labels) ~== "list" then labels := [labels]
+ if type(defaults) ~== "list" then defaults := [defaults]
+ if type(widths) ~== "list" then widths := [widths]
+ if type(buttons) ~== "list" then buttons := [buttons]
+
+ default_button := buttons[index] # null if out of bounds
+ default_width := widths[-1] | FieldWidth
+
+ maxl := 0
+ every maxl <:= *(labels | defaults | widths)
+ until *labels = maxl do put(labels, labels[-1] | "")
+ until *defaults = maxl do put(defaults, defaults[-1] | "")
+ until *widths = maxl do put(widths, widths[-1] | 10)
+
+ id := 0
+
+ label_width := 0
+ every label_width <:= TextWidth(win, !labels)
+ if label_width > 0 then label_width +:= 15
+
+ maxb := 0
+ every maxb <:= TextWidth(win, !buttons)
+ maxb +:= 10
+ maxb <:= ButtonWidth
+
+ lead := WAttrib(win, "leading")
+ pad := 2 * lead
+ cwidth := WAttrib(win, "fwidth")
+
+ dialog := Vdialog(win, pad, pad)
+
+ maxw := 0
+ every maxw <:= TextWidth(win, !captions)
+
+ y := -lead
+
+ every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+ every i := 1 to maxl do {
+ y +:= pad
+ if *labels[i] > 0 then
+ VInsert(dialog, Vmessage(win, labels[i]), 0, y)
+ VRegister(dialog, Vtext(win, "", , id +:= 1,
+ widths[i]), label_width, y)
+ maxw <:= label_width + widths[i] * cwidth
+ }
+
+ y +:= (3 * pad) / 2
+
+ button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+ maxw <:= button_space
+
+ x := ((maxw - button_space) / 2)
+
+ every button := !buttons do {
+ VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+ ButtonHeight), x, y)
+ x +:= maxb + XOffIncr
+ }
+
+ VFormat(dialog)
+
+ box_id := captions[1] | "TextDialog"
+ dialog_value := VOpenDialog(dialog, , box_id, defaults, default_button)
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure ToggleDialog( #: toggle dialog
+ win, captions, labels, defaults, buttons, index
+ )
+ local maxl, lead, pad, default_button, i, maxw, cwidth, id, label_width
+ local button, maxb, dialog, x, y, button_space, default_width, box_id
+ local temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(win) ~== "window" then {
+ win :=: captions :=: labels :=: defaults :=: buttons :=: index
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ /captions := []
+ /labels := []
+ /defaults := []
+ /buttons := ["Okay", "Cancel"]
+ /index := 1
+
+ if type(captions) ~== "list" then captions := [captions]
+ if type(labels) ~== "list" then labels := [labels]
+ if type(defaults) ~== "list" then defaults := [defaults]
+ if type(buttons) ~== "list" then buttons := [buttons]
+
+ default_button := buttons[index] # null if out of bounds
+
+ maxl := 0
+ every maxl <:= *(labels | defaults)
+ every maxl <:= *labels
+ until *labels = maxl do put(labels, labels[-1] | "")
+ until *defaults = maxl do put(defaults, defaults[-1] | &null)
+
+ id := 0
+
+ label_width := 0
+ every label_width <:= TextWidth(win, !labels)
+ if label_width > 0 then label_width +:= 30
+
+ maxb := 0
+ every maxb <:= TextWidth(win, !buttons)
+ maxb +:= 10
+ maxb <:= ButtonWidth
+
+ lead := WAttrib(win, "leading")
+ pad := 2 * lead
+ cwidth := WAttrib(win, "fwidth")
+
+ dialog := Vdialog(win, pad, pad)
+
+ maxw := 0
+ every maxw <:= TextWidth(win, !captions)
+
+ y := -lead
+
+ every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+ every i := 1 to maxl do {
+ y +:= pad
+ VRegister(dialog, Vtoggle(win, labels[i], , id +:= 1, V_CHECK_NO,
+ label_width), 0, y)
+ maxw <:= label_width
+ }
+
+ y +:= (3 * pad) / 2
+
+ button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+ maxw <:= button_space
+
+ x := ((maxw - button_space) / 2)
+
+ every button := !buttons do {
+ VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+ ButtonHeight), x, y)
+ x +:= maxb + XOffIncr
+ }
+
+ VFormat(dialog)
+
+ box_id := captions[1] | "ToggleDialog"
+ dialog_value := VOpenDialog(dialog, , box_id, defaults, default_button)
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure SelectDialog( #: selection dialog
+ win, captions, labels, deflt, buttons, index
+ )
+ local maxl, lead, pad, default_button, i, maxw, cwidth, label_width
+ local button, maxb, dialog, x, y, button_space, box_id
+ local temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(win) ~== "window" then {
+ win :=: captions :=: labels :=: deflt :=: buttons :=: index
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ /captions := []
+ /labels := []
+ /buttons := ["Okay", "Cancel"]
+ /index := 1
+
+ if type(captions) ~== "list" then captions := [captions]
+ if type(labels) ~== "list" then labels := [labels]
+ if type(buttons) ~== "list" then buttons := [buttons]
+
+ default_button := buttons[index] # null if out of bounds
+
+ maxl := 0
+ every maxl <:= *labels
+ until *labels = maxl do put(labels, labels[-1] | "")
+
+ label_width := 0
+ every label_width <:= TextWidth(win, !labels)
+ if label_width > 0 then label_width +:= 15
+
+ maxb := 0
+ every maxb <:= TextWidth(win, !buttons)
+ maxb +:= 10
+ maxb <:= ButtonWidth
+
+ lead := WAttrib(win, "leading")
+ pad := 2 * lead
+ cwidth := WAttrib(win, "fwidth")
+
+ dialog := Vdialog(win, pad, pad)
+
+ maxw := 0
+ every maxw <:= TextWidth(win, !captions)
+
+ y := -lead
+
+ every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+ y +:= 2 * lead
+ VRegister(dialog, Vvert_radio_buttons(win, labels, , 1, V_DIAMOND_NO), 0, y)
+
+ y +:= integer(0.83 * (pad * (*labels - 1)) + 1.5 * pad)
+
+ button_space := maxb * *buttons + XOffIncr * (*buttons - 1)
+ maxw <:= button_space
+
+ x := ((maxw - button_space) / 2)
+
+ every button := !buttons do {
+ VInsert(dialog, Vbutton(win, button, dialog_cb, V_OK, , maxb,
+ ButtonHeight), x, y)
+ x +:= maxb + XOffIncr
+ }
+
+ VFormat(dialog)
+
+ box_id := captions[1] | "ToggleDialog"
+ dialog_value := VOpenDialog(dialog, , box_id, [deflt], default_button)[1]
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure Notice(captions[]) #: notice dialog
+ local win, temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(captions[1]) == "window" then
+ win := get(captions)
+ else {
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ TextDialog(win, captions, , , , "Okay")
+
+ dialog_value := &null
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure SaveDialog(win, caption, filename, len) #: save dialog
+ local temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(win) ~== "window" then {
+ win :=: caption :=: filename :=: len
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ /caption := "Save:"
+ /filename := ""
+ /len := OpenWidth
+
+ TextDialog(win, caption, , filename, len, ["Yes", "No", "Cancel"])
+
+ dialog_value := dialog_value[1]
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure OpenDialog(win, caption, filename, len) #: open dialog
+ local temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(win) ~== "window" then {
+ win :=: caption :=: filename :=: len
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ /caption := "Open:"
+ /filename := ""
+ /len := OpenWidth
+
+ TextDialog(win, caption, , filename, len)
+
+ dialog_value := dialog_value[1]
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure dialog_cb(vidget, s)
+
+ dialog_button := vidget.s
+
+ return
+
+end
+
+# ColorDialog(win, captions, color, callback, id) -- display color dialog
+
+record cdl_rec(rect, orgcolor, refcolor, mutable, callback, id,
+ r, g, b, h, s, v, rv, gv, bv, hv, sv, vv, fg, fillargs, dialog, nc)
+
+global cdl_data # data for current color dialog
+
+$define PickerWidth 300 # overall color picker width
+$define SliderHeight 200 # height of a slider
+$define SliderWidth 15 # width of one slider
+$define SliderPad 5 # distance between sliders
+$define MaxStaticCol 200 # maximum colors before recycling
+
+procedure ColorDialog( #: color dialog
+ win, captions, refcolor, callback, id
+ )
+ local x1, x2, dx, y, bw, lead, pad, dialog, box_id, temp_win
+ static type
+
+ initial type := proc("type", 0) # protect attractive name
+
+ if type(win) ~== "window" then {
+ win :=: captions :=: refcolor :=: callback :=: id
+ win := &window
+ /win := temp_win := WOpen("canvas=hidden", "bg=" || VBackground)
+ }
+
+ /captions := "Select color:"
+ if type(captions) ~== "list" then captions := [captions]
+
+ cdl_data := cdl_rec()
+ cdl_data.callback := callback
+ cdl_data.id := id
+ cdl_data.refcolor := refcolor
+ cdl_data.orgcolor := ColorValue(win, \refcolor | Fg(win) | "gray")
+
+ cdl_data.orgcolor ? {
+ cdl_data.r := integer(tab(many(&digits)))
+ move(1)
+ cdl_data.g := integer(tab(many(&digits)))
+ move(1)
+ cdl_data.b := integer(tab(many(&digits)))
+ }
+ HSV(cdl_data.orgcolor) ? {
+ cdl_data.h := integer(tab(many(&digits)))
+ move(1)
+ cdl_data.s := integer(tab(many(&digits)))
+ move(1)
+ cdl_data.v := integer(tab(many(&digits)))
+ }
+
+ lead := WAttrib(win, "leading")
+ pad := 2 * lead
+
+ y := -lead
+
+ dialog := Vdialog(win, pad, pad, cdl_init)
+ every VInsert(dialog, Vmessage(win, !captions), 0, y +:= lead)
+
+ dx := SliderWidth + SliderPad
+ x1 := 0 - dx
+ x2 := PickerWidth + SliderPad
+ y +:= pad
+
+ cdl_data.dialog := dialog
+ cdl_data.rv := cdl_slider(dialog, "r", x1 +:= dx, y, 0, 65535, cdl_data.r)
+ cdl_data.gv := cdl_slider(dialog, "g", x1 +:= dx, y, 0, 65535, cdl_data.g)
+ cdl_data.bv := cdl_slider(dialog, "b", x1 +:= dx, y, 0, 65535, cdl_data.b)
+ cdl_data.vv := cdl_slider(dialog, "v", x2 -:= dx, y, 0, 100, cdl_data.v)
+ cdl_data.sv := cdl_slider(dialog, "s", x2 -:= dx, y, 0, 100, cdl_data.s)
+ cdl_data.hv := cdl_slider(dialog, "h", x2 -:= dx, y, 0, 360, cdl_data.h)
+
+ x1 +:= dx + SliderPad
+ x2 -:= 2 * SliderPad
+ cdl_data.rect := Vpane(win, , , "sunken",
+ x2 - x1, SliderHeight - 3 * lead - SliderPad)
+ VInsert(dialog, cdl_data.rect, x1, y)
+
+ y +:= SliderHeight + pad
+ bw := TextWidth(win, "Cancel") + 10
+ VInsert(dialog, Vbutton(win, "Okay", cdl_exit, V_OK, ,
+ bw, ButtonHeight), PickerWidth / 2 - bw - 10, y)
+ VInsert(dialog, Vbutton(win, "Cancel", cdl_exit, V_OK, ,
+ bw, ButtonHeight), PickerWidth / 2 + 10, y)
+
+ VFormat(dialog)
+ box_id := captions[1] | "ColorDialog"
+ VOpenDialog(dialog, , box_id, , "Okay")
+
+ dialog_value := cdl_data.r || "," || cdl_data.g || "," || cdl_data.b
+
+ WClose(\temp_win)
+
+ return dialog_button
+
+end
+
+procedure cdl_slider(dialog, id, x, y, low, high, init) # place a slider
+ local v
+
+ v := Vvert_slider(dialog.win, cdl_setval, id,
+ SliderHeight, SliderWidth, low, high, init)
+ VInsert(dialog, v, x, y)
+ return v
+end
+
+procedure cdl_init() # initialize non-vidget part of dialog
+ local r
+
+ r := cdl_data.rect
+ cdl_data.fg := Fg(r.win)
+ cdl_data.fillargs := [r.win, r.ux, r.uy, r.uw, r.uh]
+ if cdl_data.mutable := NewColor(cdl_data.rect.win, cdl_data.orgcolor) then {
+ Fg(r.win, cdl_data.mutable)
+ FillRectangle ! cdl_data.fillargs
+ }
+ else
+ cdl_data.nc := 0
+ if Fg(r.win, \cdl_data.refcolor) then {
+ cdl_data.fillargs[-1] -:= r.uh / 8
+ FillRectangle(r.win, r.ux, r.uy + r.uh, r.uw, -r.uh / 8)
+ }
+ Fg(r.win, cdl_data.fg)
+ cdl_sethsv()
+ return
+end
+
+procedure cdl_exit(vidget, s) # save position and button name on exit
+ dialog_button := vidget.s
+ FreeColor(cdl_data.rect.win, \cdl_data.mutable)
+ EraseArea(cdl_data.rect.win)
+ return
+end
+
+procedure cdl_setval(v, x) # set value in response to slider motion
+ static recurse
+
+ if /recurse then { # if not a recursive call
+ recurse := 1 # note to prevent recursion
+ case v.id of {
+ "r": { cdl_data.r := x; cdl_sethsv(); }
+ "g": { cdl_data.g := x; cdl_sethsv(); }
+ "b": { cdl_data.b := x; cdl_sethsv(); }
+ "h": { cdl_data.h := x; cdl_setrgb(); }
+ "s": { cdl_data.s := x; cdl_setrgb(); }
+ "v": { cdl_data.v := x; cdl_setrgb(); }
+ }
+ recurse := &null
+ }
+ return
+end
+
+procedure cdl_sethsv() # set h/s/v values from r/g/b
+ local c
+
+ HSV(c := cdl_data.r || "," || cdl_data.g || "," || cdl_data.b) ? {
+ VSetState(cdl_data.hv, cdl_data.h := integer(tab(many(&digits))))
+ move(1)
+ VSetState(cdl_data.sv, cdl_data.s := integer(tab(many(&digits))))
+ move(1)
+ VSetState(cdl_data.vv, cdl_data.v := integer(tab(many(&digits))))
+ }
+ cdl_setcolor(c)
+ return
+end
+
+procedure cdl_setrgb() # set r/g/b values from h/s/v
+ local c
+
+ (c := HSVValue(cdl_data.h || "/" || cdl_data.s || "/" || cdl_data.v)) ? {
+ VSetState(cdl_data.rv, cdl_data.r := integer(tab(many(&digits))))
+ move(1)
+ VSetState(cdl_data.gv, cdl_data.g := integer(tab(many(&digits))))
+ move(1)
+ VSetState(cdl_data.bv, cdl_data.b := integer(tab(many(&digits))))
+ }
+ cdl_setcolor(c)
+ return
+end
+
+procedure cdl_setcolor(c) # display new color and invoke callback
+ local r, win, x1, x2, y, dy
+
+ r := cdl_data.rect
+ win := r.win
+ if \cdl_data.mutable then
+ Color(win, cdl_data.mutable, c) # set the mutable color
+ else {
+ if ((cdl_data.nc +:= 1) > MaxStaticCol) | (not Fg(win, c)) then {
+ EraseArea(win) # free allocated colors
+ VDraw(cdl_data.dialog) # redraw vidget
+ if Fg(r.win, \cdl_data.refcolor) then # redraw reference color
+ FillRectangle(r.win, r.ux, r.uy + r.uh, r.uw, -r.uh / 8)
+ Fg(win, c) # set new foreground
+ cdl_data.nc := 1
+ }
+ FillRectangle ! cdl_data.fillargs
+ Fg(win, cdl_data.fg)
+ }
+
+ x1 := cdl_data.rect.ax
+ x2 := x1 + cdl_data.rect.aw
+ y := cdl_data.rect.ay + cdl_data.rect.ah + SliderPad
+ dy := WAttrib(win, "leading")
+
+ EraseArea(win, x1, y, x2 - x1, 3 * dy) # erase and redraw text area
+ y +:= WAttrib(win, "ascent")
+ x2 -:= TextWidth(win, "h: 360")
+
+ DrawString(win, x1, y, "r: " || right(cdl_data.r, 5))
+ DrawString(win, x2, y, "h: " || right(cdl_data.h, 3))
+ y +:= dy
+ DrawString(win, x1, y, "g: " || right(cdl_data.g, 5))
+ DrawString(win, x2, y, "s: " || right(cdl_data.s, 3))
+ y +:= dy
+ DrawString(win, x1, y, "b: " || right(cdl_data.b, 5))
+ DrawString(win, x2, y, "v: " || right(cdl_data.v, 3))
+
+ (\cdl_data.callback)(cdl_data.id, c) # invoke user callback, if any
+ return
+end
+
+# Popup(win, x, y, w, h, proc, args[])
+
+$define BorderWidth 4
+$define ShadowWidth 4
+
+procedure Popup(args[]) #: create popup subwindow
+ local win, x, y, w, h, xx, yy, ww, hh, dx, dy, s, proc, retv, ampwin, save
+
+ # Get parameters.
+ PushWin(args)
+ win := get(args)
+ x := get(args); integer(x) | runerr(101, \x)
+ y := get(args); integer(y) | runerr(101, \y)
+ w := \get(args) | 250; integer(w) | runerr(101, w)
+ h := \get(args) | 150; integer(h) | runerr(101, h)
+ proc := \get(args) | Event
+
+ # Handle defaults
+ dx := WAttrib(win, "dx")
+ dy := WAttrib(win, "dy")
+ w >:= WAttrib(win, "width") # limit to size of full win
+ h >:= WAttrib(win, "height")
+ /x := (WAttrib(win, "width") - w) / 2 - dx # center the subwindow
+ /y := (WAttrib(win, "height") - h) / 2 - dy
+
+ # Adjust subwindow configuration parameters.
+ xx := x - BorderWidth
+ yy := y - BorderWidth
+ ww := w + 2 * BorderWidth + ShadowWidth
+ hh := h + 2 * BorderWidth + ShadowWidth
+
+ # Save original window contents.
+ save := ScratchCanvas(ww, hh, "__Popup__") |
+ stop("can't get ScratchCanvas in Popup()")
+ CopyArea(win, save, xx, yy, ww, hh)
+
+ # Save &window and create subwindow.
+ ampwin := &window
+ &window := Clone(win) | stop("can't Clone in Popup()")
+ WAttrib("drawop=copy", "fillstyle=solid", "linestyle=solid", "linewidth=1",
+ "dx=" || (dx + x), "dy=" || (dy + y))
+ DrawRectangle(-BorderWidth, -BorderWidth, ww-ShadowWidth-1, hh-ShadowWidth-1)
+ BevelRectangle(-BorderWidth + 1, -BorderWidth + 1,
+ ww - ShadowWidth - 2, hh - ShadowWidth - 2, BorderWidth)
+ FillRectangle(-BorderWidth + ShadowWidth, h + BorderWidth,
+ ww - ShadowWidth, ShadowWidth)
+ FillRectangle(w + BorderWidth, -BorderWidth + ShadowWidth,
+ ShadowWidth, hh - ShadowWidth)
+ Clip(0, 0, w, h)
+ EraseArea()
+
+ # Flush any previously entered events on the window
+ while *Pending(win) > 0 do
+ Event(win)
+
+ # Call proc; save result, if any, or use args as flag if none.
+ retv := (proc ! args) | args
+
+ # Restore window and return result. Use &window to ensure drawop=copy.
+ Clip(-BorderWidth, -BorderWidth, ww, hh)
+ CopyArea(save, &window, 0, 0, ww, hh, -BorderWidth, -BorderWidth)
+ EraseArea(save)
+ &window := ampwin
+ return args ~=== retv
+end
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-20 01:24:14 +0000