home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gprocs / vtext.icn < prev    next >
Text File  |  2000-07-29  |  13KB  |  479 lines
  1. ############################################################################
  2. #
  3. #    File:     vtext.icn
  4. #
  5. #    Subject:  Procedures for textual vidgets
  6. #
  7. #    Authors:  Jon Lipp and Gregg M. Townsend
  8. #
  9. #    Date:     July 22, 1997
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  Vidgets defined in this file:
  18. #    Vtext
  19. #
  20. ############################################################################
  21. #
  22. #  Requires:  Version 9 graphics
  23. #
  24. ############################################################################
  25. #
  26. #  Includes:  keysyms
  27. #
  28. ############################################################################
  29. #
  30. #  Links:  vidgets
  31. #
  32. ############################################################################
  33.  
  34. link vidgets
  35.  
  36. $include "keysyms.icn"
  37.  
  38. $ifndef _X_WINDOW_SYSTEM
  39.    $define Key_KP_Up Key_Up
  40.    $define Key_KP_Down Key_Down
  41.    $define Key_KP_Left Key_Left
  42.    $define Key_KP_Right Key_Right
  43. $endif
  44.  
  45.  
  46. ############################################################################
  47. #  Vtext
  48. ############################################################################
  49.  
  50. record Vstd_text(draw_cursor, erase_cursor, draw_data, unblock, block,
  51.    DataPixelSize, MaxPixelSize, NumericData, CursorPos, DataLength,
  52.    OldCursorPos, CursorOn, ta, tb, dx, dy)
  53.  
  54. record Vtext_rec (win, s, callback, id, MaxChars, mask, data, uid,
  55.    ax, ay, aw, ah, T, P, V)
  56.  
  57. procedure Vtext(params[])
  58.    local frame, x, y, ins, self
  59.    static procs, type
  60.  
  61.    initial {
  62.        procs := Vstd(event_Vtext, draw_Vtext,
  63.           outline_Vtext, resize_Vtext, inrange_Vpane, init_Vtext,
  64.           couplerset_Vtext,,,,, set_value_Vtext)
  65.       type := proc("type", 0)        # protect attractive name
  66.       }
  67.  
  68.    if ins := Vinsert_check(params) then {
  69.       frame := pop(params); x := pop(params); y:= pop(params)
  70.       }
  71.    self := Vtext_rec ! params[1:7|0]
  72.    Vwin_check(self.win, "Vtext()")
  73.    if (\self.MaxChars, not numeric(self.MaxChars) ) then
  74.       _Vbomb("invalid size parameter to Vtext()")
  75.    if type(\self.mask) ~== "cset" then
  76.       _Vbomb("invalid mask parameter to Vtext()")
  77.    if type(\self.s) ~== "string" & not numeric(self.s) then
  78.       _Vbomb("invalid prompt passed to Vtext()")
  79.  
  80.    self.uid := Vget_uid()
  81.    self.V := procs
  82.    self.P := Vstd_pos()
  83.    self.T := Vstd_text(draw_cursor_Vtext, erase_cursor_Vtext,
  84.       draw_data_Vtext, unblock_Vtext, block_Vtext)
  85.    init_Vtext(self)
  86.  
  87.    if \ins then VInsert(frame, self, x, y)
  88.    return self
  89. end
  90.  
  91. #
  92. #  Initialization
  93. #
  94. procedure init_Vtext(self)
  95.    local p
  96.  
  97.    /self.s := ""
  98.    /self.MaxChars := 18
  99.    self.s ? if self.s := tab(find("\\=")) then ="\\=" & self.data := tab(0)
  100.    /self.data := ""
  101.    if *self.data > self.MaxChars then self.data := self.data[1:self.MaxChars]
  102.    self.T.DataLength := *self.data
  103.    self.T.MaxPixelSize := WAttrib(self.win, "fwidth")*self.MaxChars
  104. #   /self.T.MaxPixelSize := 250
  105.  
  106. ## check max length by pixel size.
  107. #   if TextWidth(self.win, self.data) > self.T.MaxPixelSize then {
  108. #      t := get_pos_Vtext(self, self.T.MaxPixelSize)
  109. #      self.data := self.data[1:t]
  110. #      }
  111. #   self.T.DataLength := *self.data
  112.    self.T.DataPixelSize := TextWidth(self.win, self.data)
  113.  
  114. ## size by characters - taken out.
  115.    /self.mask := &cset
  116.  
  117. ## initialize with cursor at end
  118.    self.T.ta := self.T.tb := self.T.CursorPos := self.T.DataLength + 1
  119.  
  120. ## initialize with all data blocked out (selected)
  121. #  self.T.ta := 1
  122. #  self.T.tb := self.T.CursorPos := self.T.DataLength + 1
  123.  
  124.    self.T.dx := TextWidth (self.win, self.s) + 6
  125.    self.aw := self.T.dx + self.T.MaxPixelSize + 4
  126.    self.ah := WAttrib(self.win, "fheight") + 6    # 4 for bevel, 2 for I-bar
  127.    self.T.dy := self.ah - 3 - WAttrib(self.win, "descent")
  128.  
  129.    p := \self.callback
  130.    self.callback := Vcoupler()
  131.    add_clients_Vinit(self.callback, p, self)
  132. end
  133.  
  134. #
  135. #  Reconfigure the text vidget.
  136. #
  137. procedure resize_Vtext(s, x, y, w, h)
  138.    s.T.dx := TextWidth (s.win, s.s) + 6
  139.    s.T.DataLength := *s.data
  140.    s.T.MaxPixelSize := WAttrib(s.win, "fwidth") * s.MaxChars
  141.    w := s.aw := s.T.dx + s.T.MaxPixelSize + 4
  142.    h := s.ah := WAttrib(s.win, "fheight") + 6
  143.    resize_Vidget(s, x, y, w, h)
  144. end
  145.  
  146. #
  147. #  Draw the prompt, the data, outline the data area, then draw
  148. #  the cursor if it was already on previous to calling this
  149. #  procedure (happens with dialog boxes and resize events).
  150. #
  151. procedure draw_Vtext(self)
  152.    local t
  153.  
  154.    t := self.T.CursorOn
  155.    self.T.CursorOn := &null
  156.    draw_prompt_Vtext(self)
  157.    draw_data_Vtext(self)
  158.    outline_Vtext(self)
  159.    if \t then draw_cursor_Vtext(self)
  160. end
  161.  
  162. #
  163. #  Outline the data field.
  164. #
  165. procedure outline_Vtext(self)
  166.  
  167.    BevelRectangle(self.win, self.ax+self.T.dx-4, self.ay,
  168.                   self.aw-(self.T.dx-4), self.ah, -2)
  169. end
  170.  
  171. #
  172. #  Draw the prompt.
  173. #
  174. procedure draw_prompt_Vtext(self)
  175.    GotoXY(self.win, self.ax, self.ay+self.T.dy)
  176.    writes(self.win, self.s)
  177.    return
  178. end
  179.  
  180. #
  181. #  Since the cursor is drawn in "reverse" mode, erase it only if it
  182. #  is "on" upon entering this procedure.
  183. #
  184. procedure erase_cursor_Vtext(self)
  185.    local ocx, cy
  186.  
  187.    if /self.T.CursorOn then fail
  188.    ocx :=  self.T.OldCursorPos
  189.  
  190. ## bracket cursor
  191.    WAttrib(self.win, "drawop=reverse", "linewidth=1")
  192.    DrawSegment(self.win, \ocx-2, self.ay+2, ocx+2, self.ay+2,
  193.              ocx, self.ay+3, ocx, self.ay+self.ah-4,
  194.              ocx-2, self.ay+self.ah-3, ocx+2, self.ay+self.ah-3)
  195.    WAttrib(self.win, "drawop=copy")
  196.    self.T.CursorOn := &null
  197. end
  198.  
  199. #
  200. #  Draw the cursor only if it was previously "off" at this location.
  201. #
  202. procedure draw_cursor_Vtext(self)
  203.    local ocx, cx, cy
  204.  
  205.    if \self.T.CursorOn then fail
  206.    cx := self.ax+self.T.dx + get_pixel_pos_Vtext(self, self.T.CursorPos) - 1
  207. ## bracket cursor
  208.    WAttrib(self.win, "drawop=reverse", "linewidth=1")
  209.    DrawSegment(self.win, cx-2, self.ay+2, cx+2, self.ay+2,
  210.              cx, self.ay+3, cx, self.ay+self.ah-4,
  211.              cx-2, self.ay+self.ah-3, cx+2, self.ay+self.ah-3)
  212.    WAttrib(self.win, "drawop=copy")
  213.    self.T.OldCursorPos := cx
  214.    self.T.CursorOn := 1
  215. end
  216.  
  217. #
  218. #  De-block the data (reset ta and tb to CursorPos).
  219. #
  220. procedure unblock_Vtext(self)
  221.    self.T.ta := self.T.CursorPos := self.T.tb
  222.    draw_data_Vtext(self)
  223. end
  224.  
  225. #
  226. #  Block (select) all the data
  227. #
  228. procedure block_Vtext(self)
  229.    self.T.ta := 1
  230.    self.T.tb := self.T.CursorPos := self.T.DataLength + 1
  231.    draw_data_Vtext(self)
  232.    if self.T.DataLength = 0 then
  233.       draw_cursor_Vtext(self)
  234. end
  235.  
  236. #
  237. #  Draw the data, reversing that text that lies between ta and tb
  238. #  fields.
  239. #
  240. procedure draw_data_Vtext(self)
  241.  
  242. #   if self.T.ta = self.T.tb then return
  243.    erase_cursor_Vtext(self)
  244.    GotoXY(self.win, self.ax+self.T.dx, self.ay+self.T.dy)
  245.    if self.T.ta <= self.T.tb then {
  246.       writes(self.win, self.data[1:self.T.ta])
  247.       WAttrib(self.win, "reverse=on")
  248.       writes(self.win, self.data[self.T.ta:self.T.tb])
  249.       WAttrib(self.win, "reverse=off")
  250.       writes(self.win, self.data[self.T.tb:0])
  251.    }
  252.    else {
  253.       writes(self.win, self.data[1:self.T.tb])
  254.       WAttrib(self.win, "reverse=on")
  255.       writes(self.win, self.data[self.T.tb:self.T.ta])
  256.       WAttrib(self.win, "reverse=off")
  257.       writes(self.win, self.data[self.T.ta:0])
  258.    }
  259.    EraseArea(self.win, self.ax+self.T.dx+self.T.DataPixelSize, self.ay+2,
  260.               self.aw-(self.T.dx +self.T.DataPixelSize+1), self.ah-4)
  261.    return
  262. end
  263.  
  264. #
  265. #  Wow.  Mouse events, block out text, key presses, enter, delete
  266. #  etcetera stuff.  Call callback if linefeed key or return key
  267. #  is pressed.
  268. #
  269. procedure event_Vtext(self, e, x, y)
  270.    static ota
  271.    local otb, rv
  272.  
  273.    if \self.callback.locked then fail
  274.    /x := &x; /y := &y
  275.    self.T.DataLength := *self.data
  276.    if e === (&lpress|&mpress|&rpress) then {
  277.       WAttrib(self.win, "pointer=xterm")
  278.       otb := self.T.ta := self.T.tb := self.T.CursorPos :=
  279.          get_pos_Vtext(self, &x-(self.ax+self.T.dx))
  280.       if otb = self.T.DataLength+1 & otb = \ota then
  281.          self.T.ta := 1
  282.       draw_data_Vtext(self)
  283.       draw_cursor_Vtext(self)
  284.       until e === (&lrelease|&mrelease|&rrelease) do {
  285.          self.T.tb := get_pos_Vtext(self, &x-(self.ax+self.T.dx))
  286.          if otb ~= self.T.tb then {
  287.             draw_data_Vtext(self)
  288.             self.T.CursorPos := self.T.tb
  289.             draw_cursor_Vtext(self)
  290.             otb := self.T.tb
  291.             }
  292.          e := Event(self.win)
  293.          }
  294.       rv := &null
  295.       WAttrib(self.win, "pointer=top left arrow")
  296.       } ## end mouse event loop
  297.    else if (not &meta) & (not (integer(e) < 0)) then  {
  298.       ## it's a keypress
  299.       if rv := case e of {
  300.          "\^b" | Key_Left | Key_KP_Left:    move_cursor_Vtext(self, -1)
  301.          "\^f" | Key_Right | Key_KP_Right:    move_cursor_Vtext(self, 1)
  302.          "\b" | "\d":                delete_left_Vtext(self)
  303.          "\^k" | "\^u" | "\^x":            delete_line_Vtext(self)
  304.      (&shift & "\t") | Key_Up | Key_KP_Up:  return V_PREVIOUS
  305.          "\t" | Key_Down | Key_KP_Down:        return V_NEXT
  306.          "\r" | "\l": {
  307.         self.callback.V.set(self.callback, self, self.data)
  308.         V_NEXT
  309.         }
  310.          default:                insert_char_Vtext(self, e)
  311.          }
  312.       then {
  313.          draw_data_Vtext(self)
  314.          draw_cursor_Vtext(self)
  315.          self.T.ta := self.T.tb := self.T.CursorPos
  316.          }
  317.       }
  318.    else
  319.       fail                # not our event
  320.  
  321.    ota := self.T.ta
  322.    return rv
  323. end
  324.  
  325. #  Move the cursor one way or another, determine if at bounds.
  326. #
  327. procedure move_cursor_Vtext(self, increment)
  328.    local t
  329.  
  330.    t := self.T.CursorPos + increment
  331.    if t < 1 | t > self.T.DataLength+1 then fail
  332.    self.T.ta := self.T.tb := self.T.CursorPos := t
  333.    return
  334. end
  335.  
  336. #
  337. #  Blank out the whole data field.
  338. #
  339. procedure delete_line_Vtext(self)
  340.  
  341.    self.data := ""
  342.    self.T.DataLength := *self.data
  343.    self.T.DataPixelSize := 0
  344.    self.T.ta := self.T.tb := self.T.CursorPos := 1
  345.    return
  346. end
  347.  
  348. #
  349. #  Get the character position based on mouse x coordinate.
  350. #
  351. procedure get_pos_Vtext(self, x)
  352.    local tp, c, i, j
  353.  
  354.    c := 1
  355.    i := j := 0
  356.    while i < x do {
  357.       j := i
  358.       i +:= TextWidth(self.win, self.data[c])
  359.       if (c +:= 1) > self.T.DataLength then break
  360.    }
  361.    if x <= ((i + j) / 2) then
  362.       c -:= 1                # less than halfway into the char
  363.    if i < x then tp := self.T.DataLength+1
  364.    else tp := (1 <= c) | 1
  365.    return tp
  366. end
  367.  
  368. #
  369. #  Get pixel position in data field based on character position.
  370. #
  371. procedure get_pixel_pos_Vtext(self, CursorPos)
  372.    local sum, i
  373.  
  374.    sum := 1
  375.    every i := 1 to CursorPos-1 do sum +:= TextWidth(self.win, self.data[i])
  376.    return sum
  377. end
  378.  
  379. #
  380. #  Insert a character; could replace blocked out text.  Check if
  381. #  insertion will go over bounds.
  382. #
  383. procedure insert_char_Vtext(self, c)
  384.  
  385.    c := c[1]
  386.  
  387.    if TextWidth(self.win, c) == 0 then
  388.       fail                # not displayable
  389.  
  390.    if (self.T.DataLength - abs(self.T.ta-self.T.tb) + 1) > self.MaxChars |
  391.       not (c ? any(self.mask)) then fail
  392.  
  393.    if self.T.ta ~= self.T.tb then
  394.       change_data_Vtext(self, c)
  395.    else
  396.       self.data := self.data[1:self.T.CursorPos] || c ||
  397.                    self.data[self.T.CursorPos:0]
  398.    self.T.DataLength := *self.data
  399.    self.T.DataPixelSize := TextWidth(self.win, self.data)
  400.    self.T.CursorPos +:= 1
  401.    return
  402. end
  403.  
  404. #
  405. #  Replace a character at current position.
  406. #
  407. procedure change_data_Vtext(self, c)
  408.    if self.T.tb < self.T.ta then {
  409.       self.data := self.data[1:self.T.tb] || (\c | "") ||
  410.                    self.data[self.T.ta:0]
  411.       self.T.ta := self.T.CursorPos := self.T.tb
  412.       }
  413.    else {
  414.       self.data := self.data[1:self.T.ta] || (\c | "") ||
  415.                    self.data[self.T.tb:0]
  416.       self.T.tb := self.T.CursorPos := self.T.ta
  417.       }
  418. end
  419.  
  420. #
  421. #  Delete the character to the left of the cursor.
  422. #
  423. procedure delete_left_Vtext(self)
  424.    if self.T.ta ~= self.T.tb then {
  425.       change_data_Vtext(self)
  426.       self.T.DataPixelSize := TextWidth(self.win, self.data)
  427.       return
  428.       }
  429.    else
  430.       if self.T.CursorPos > 1 then {
  431.          self.data := self.data[1:self.T.CursorPos-1] ||
  432.                       self.data[self.T.CursorPos:0]
  433.          self.T.DataPixelSize := TextWidth(self.win, self.data)
  434.          self.T.CursorPos -:= 1
  435.          return
  436.          }
  437. end
  438.  
  439. #
  440. #  Set the data field to value passed in.
  441. #  NOTE: doesn't pass it through mask right now.
  442. #  Call callback if value if different from internal coupler's
  443. #  value.
  444. #
  445. procedure couplerset_Vtext(self, caller, value)
  446.    local data
  447.  
  448.    data := string(\value) | ""
  449.    self.data := data
  450.    if *self.data > self.MaxChars then self.data := self.data[1:self.MaxChars]
  451.    self.T.DataLength := *self.data
  452.    self.T.DataPixelSize := TextWidth(self.win, self.data)
  453.  
  454. ## initialize with cursor at end
  455.    self.T.ta := self.T.tb := self.T.CursorPos := self.T.DataLength + 1
  456.  
  457. ## initialize with all data blocked out (selected)
  458. #  self.T.ta := 1
  459. #  self.T.tb := self.T.CursorPos := self.T.DataLength + 1
  460.  
  461.    draw_data_Vtext(self)
  462.  
  463.    if numeric(value) then {
  464.       if value = \self.T.NumericData then fail
  465.       self.T.NumericData := value
  466.       }
  467.    else if data === self.data then fail
  468.    self.callback.V.set(self.callback, caller, value)
  469. #   draw_cursor_Vtext(self)
  470. end
  471.  
  472. #
  473. #  Call couplerset to set value.
  474. #
  475. procedure set_value_Vtext(self, value)
  476.    couplerset_Vtext(self, , value)
  477.    return
  478. end
  479.