Initial upstream version 9.4.3upstream/9.4.3

1 files changed, 143 insertions, 0 deletions

diff --git a/ipl/gprocs/vgrid.icn b/ipl/gprocs/vgrid.icn
new file mode 100644
index 0000000..2bc2367
--- /dev/null
+++ b/ipl/gprocs/vgrid.icn
@@ -0,0 +1,143 @@
+############################################################################
+#
+#	File:     vgrid.icn
+#
+#	Subject:  Procedures for vidget grids
+#
+#	Author:   Jon Lipp
+#
+#	Date:     March 23, 1995
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#  Links:  vidgets
+#
+############################################################################
+
+link vidgets
+
+record Vgrid_rec(win, callback, id,  aw, ah, rows, cols, Hpos, Vpos, hpad, vpad,
+   ax, ay, uid, P, V)
+
+procedure Vgrid(params[])
+   local self, i, frame, x, y, ins
+   static procs
+
+   initial procs := Vstd(event_Vgrid, draw_Vgrid, outline_Vidget,
+      resize_Vgrid, inrange_Vpane, init_Vgrid)
+
+   if ins := Vinsert_check(params) then {
+      frame := pop(params); x := pop(params); y:= pop(params)
+      }
+   self := Vgrid_rec ! params[1:8|0]
+   Vwin_check(self.win, "Vgrid()")
+   if (\self.aw, not numeric(self.aw) ) then
+      _Vbomb("invalid aw parameter to Vgrid()")
+   if (\self.ah, not numeric(self.ah) ) then
+      _Vbomb("invalid ah parameter to Vgrid()")
+   if (\self.rows, not numeric(self.rows) ) then
+      _Vbomb("invalid rows parameter to Vgrid()")
+   if (\self.cols, not numeric(self.cols) ) then
+      _Vbomb("invalid cols parameter to Vgrid()")
+
+   self.V := procs
+   self.P := Vstd_pos()
+   self.uid := Vget_uid()
+ 
+   self.V.init(self)
+   if \ins then VInsert(frame, self, x, y)
+   return self
+end
+
+procedure init_Vgrid(self)
+   local p
+
+   self.Hpos := table()
+   self.Vpos := table()
+   /self.aw := 100
+   /self.ah := 100
+   /self.rows := 10
+   /self.cols := 10
+
+   p := \self.callback
+   self.callback := Vcoupler()
+   add_clients_Vinit(self.callback, p, self)
+   return self
+end
+
+procedure draw_Vgrid(self)
+   local i
+
+   # draw vertical lines
+   every i := 0 to self.cols do 
+      DrawLine(self.win, self.ax+self.Hpos[i], self.ay, 
+         self.ax+self.Hpos[i], self.ay+self.ah)
+
+   # draw horizontal lines.
+   every i := 0 to self.rows do 
+      DrawLine(self.win, self.ax, self.ay+self.Vpos[i], 
+         self.ax+self.aw, self.ay+self.Vpos[i])
+end
+
+procedure event_Vgrid(self, e)
+   local row, col
+
+   if \self.callback.locked then fail
+   col := VGetCol(self, &x)
+   row := VGetRow(self, &y)
+   return self.callback.V.set(self.callback, self, [row, col, e])
+end
+
+procedure resize_Vgrid(self, x, y, w, h)
+   local i
+
+   resize_Vidget(self, x, y, w, h)
+
+   self.hpad := 1 <= self.aw / real(self.cols) | 1
+   self.vpad := 1 <= self.ah / real(self.rows) | 1
+
+   every i := 0 to self.cols do
+      self.Hpos[i] := integer (i * self.hpad )
+      
+   every i := 0 to self.rows do 
+      self.Vpos[i] := integer(i * self.vpad )
+end
+
+procedure VFillGrid(self, row, col)
+
+   FillRectangle(self.win, self.ax+self.Hpos[col], self.ay+self.Vpos[row],
+      1 <= self.Hpos[col+1] - self.Hpos[col] | 1,
+      1 <= self.Vpos[row+1] - self.Vpos[row] | 1 )
+end
+
+procedure check_Vgrid(self, row, col)
+
+end
+
+procedure VEraseGrid(self, row, col)
+
+   EraseArea(self.win, self.ax+self.Hpos[col]+1, self.ay+self.Vpos[row]+1,
+      1 <= ( self.Hpos[col+1] - self.Hpos[col] - 1) | 1,
+      1 <= ( self.Vpos[row+1] - self.Vpos[row] - 1) | 1 )
+end
+
+procedure VGetRow(self, y)
+   local row
+
+   row := integer( (y - self.ay) / real(self.vpad) )
+   row := row < 0 | row > self.rows - 1
+   return row
+end
+
+procedure VGetCol(self, x)
+   local col
+
+   col := integer( (x - self.ax) / real(self.hpad) )
+   col := col < 0 | col > self.cols - 1
+   return col
+end
+