diff options
Diffstat (limited to 'ipl/gprocs/vpane.icn')
-rw-r--r-- | ipl/gprocs/vpane.icn | 167 |
1 files changed, 167 insertions, 0 deletions
diff --git a/ipl/gprocs/vpane.icn b/ipl/gprocs/vpane.icn new file mode 100644 index 0000000..6257a83 --- /dev/null +++ b/ipl/gprocs/vpane.icn @@ -0,0 +1,167 @@ +############################################################################ +# +# File: vpane.icn +# +# Subject: Procedures for vidget panes +# +# Author: Jon Lipp +# +# Date: March 23, 1995 +# +############################################################################ +# +# This file is in the public domain. +# +############################################################################ +# +# Vidgets defined in this file: +# Vpane +# +############################################################################ +# +# Links: vidgets +# +############################################################################ + +link vidgets + +############################################################################ +# pane - a simple region on the window +############################################################################ + +record Vpane_rec(win, callback, id, style, aw, ah, ax, ay, + uw, uh, ux, uy, uid, P, V) + +procedure Vpane(params[]) + local self, frame, x, y, ins + static procs + + initial procs := Vstd(event_Vpane, draw_Vpane, outline_Vpane, + resize_Vpane, inrange_Vpane, init_Vpane, + couplerset_Vpane) + + if ins := Vinsert_check(params) then { + frame := pop(params); x := pop(params); y:= pop(params) + } + self := Vpane_rec ! params[1:7|0] + Vwin_check(self.win, "Vpane()") + if (\self.aw, not numeric(self.aw) ) then + _Vbomb("invalid aw parameter to Vpane()") + if (\self.ah, not numeric(self.ah) ) then + _Vbomb("invalid ah parameter to Vpane()") + + /self.style := "invisible" + if integer(self.style) then + if self.style > 0 then + self.style := "grooved" + else + self.style := "invisible" + + self.uid := Vget_uid() + self.V := procs + self.P := Vstd_pos() + + if \ins then VInsert(frame, self, x, y) + return self +end + +# +# check if (x, y) lie within the bounds of a vidget. +# +procedure inrange_Vpane(self, x, y) + if (/self.ax | /self.ay | /self.aw | /self.ah) then + _Vbomb("VResize() not invoked on this vidget") + return self.ax <= \x < self.ax + self.aw & self.ay <= \y < self.ay + self.ah +end + +# +# Set the absolute position and size fields of a vidget. +# +procedure resize_Vidget(self, x, y, w, h) + self.ax := \x + self.ay := \y + self.aw := \w + self.ah := \h +end + +# +# Set the absolute position and size fields of a Pane vidget. +# +procedure resize_Vpane(self, x, y, w, h) + local border + + resize_Vidget(self, x, y, w, h) + if self.style == "invisible" then + border := 0 + else + border := 2 + self.ux := self.ax + border + self.uy := self.ay + border + self.uw := self.aw - 2 * border + self.uh := self.ah - 2 * border +end + +# +# Draw the outline of an arbitrary vidget +# +procedure outline_Vidget(self) + GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah) +end + +# +# Draw the outline of a Vpane vidget +# +procedure outline_Vpane(self) + case self.style of { + "sunken": BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah,-2) + "grooved": GrooveRectangle(self.win, self.ax, self.ay, self.aw, self.ah) + "raised": BevelRectangle(self.win, self.ax, self.ay, self.aw, self.ah) + } +end + +# At the very least, tell a Vpane to outline itself. +# +procedure draw_Vpane(self) + self.V.outline(self) +end + +# +# If the Vpane has a callback, call (or set) it; otherwise, reject the event. +# +procedure event_Vpane(self, e, x, y) + local cb + static type + + initial type := proc("type", 0) # protect attractive name + + cb := self.callback + /x := &x + /y := &y + if type(\cb) == "procedure" then # procedure + return cb(self, e, x, y) | &null + if find("coupler",type(\cb)) then { # coupler + if \self.callback.locked then fail + return cb.V.set(cb, self) | &null + } + fail # reject +end + +# +# If the vidget with this procedure as its couplerset is notified by +# a coupler, nothing will happen. +# +procedure couplerset_Vpane(self) +end + +# +# Release the resources associated with the binding on a window. +# +procedure destruct_Vpane(self) + Uncouple(self.win) +end + +# +# No init for Vpane. +# +procedure init_Vpane(self) +end |