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 / dsetup.icn < prev    next >
Text File  |  2001-05-02  |  8KB  |  294 lines
  1. ############################################################################
  2. #
  3. #    File:     dsetup.icn
  4. #
  5. #    Subject:  Procedures for creating dialog boxes
  6. #
  7. #    Authors:  Gregg M. Townsend and Ralph E. Griswold
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  dsetup(win, wlist) initializes a set of widgets according to
  18. #  a list of specifications created by the interface editor VIB.
  19. #
  20. #  win can be an existing window, or null.
  21. #
  22. #  wlist is a list of specifications; the first must be the Sizer and
  23. #  the last may be null.  Each specification is itself a list consisting
  24. #  of a specification string, a callback routine, and an optional list
  25. #  of additional specifications.  Specification strings vary by vidget
  26. #  type, but the general form is "ID:type:style:n:x,y,w,h:label".
  27. #
  28. #  dsetup() returns a table of values from the dialog, indexed by ID.
  29. #
  30. ############################################################################
  31. #
  32. #  Includes:  vdefns
  33. #
  34. ############################################################################
  35. #
  36. #  Links:  dialog, xio, xutils,
  37. #          vidgets, vslider, vmenu, vscroll, vtext, vbuttons, vradio
  38. #          vdialog
  39. #
  40. ############################################################################
  41.  
  42. $include "vdefns.icn"
  43.  
  44. link dialog
  45. link vdialog
  46. link vidgets
  47. link vslider
  48. link vmenu
  49. link vscroll
  50. link vtext
  51. link vbuttons
  52. link vradio
  53. link vsetup
  54.  
  55. record DL_rec(var, typ, sty, num, x, y, w, h, lbl, cbk, etc)
  56. record DL_state(dialog, list, deflabel)
  57.  
  58. global did_list, did_label
  59.  
  60. ## dsetup(win, wlist) -- set up vidgets and return table of handles
  61. #
  62. #  wlist is a list of vidget specs as constructed by vib (or uix).
  63.  
  64. procedure dsetup(win, wlist[])
  65.    local r, dialog, obj, num, wspec, alist
  66.  
  67.    if type(win) ~== "window" then
  68.       win := &window
  69.  
  70.    win := Clone(win, "fg=black", "linewidth=1", "linestyle=solid",
  71.       "fillstyle=solid", "drawop=copy")    # clone window with standard attribs
  72.    VSetFont(win)            # set standard VIB font
  73.    if ColorValue(Bg(win)) == ("65535,65535,65535" | "0,0,0") then
  74.       Bg(win, VBackground)        # change black or white bg to pale gray
  75.  
  76.    while /wlist[-1] do            # ignore trailing null elements
  77.       pull(wlist)
  78.    wspec := get(wlist)            # first spec gives wdow size
  79.  
  80.    r := DL_crack(wspec) | stop("dsetup: bad spec")
  81.  
  82.    did_list := []
  83.    did_label := &null
  84.  
  85.    dialog := Vdialog(win, 0, 0)        # create dialog frame
  86.    dialog.id := r.var
  87.    VInsert(dialog, Vmessage(win, ""),    # set dialog box dimensions
  88.       r.x + r.w - 1, r.y + r.h - WAttrib(win, "fheight") - 1)
  89.  
  90.    every r := DL_crack(!sort(wlist), &null) do {
  91.       DL_obj(win, dialog, r)            # insert other vidgets
  92.       }
  93.  
  94.    VFormat(dialog)                # create the dialog
  95.  
  96.    return DL_state(dialog, did_list, did_label)    # return state for dpopup()
  97.  
  98. end
  99.  
  100. procedure dpopup(win, dftbl, dstate)
  101.    local did_list, init_list, i
  102.  
  103.    if type(win) ~== "window" then {
  104.       win :=: dftbl
  105.       }
  106.  
  107.    /dftbl := table()
  108.    did_list := dstate.list
  109.  
  110.    init_list := list(*did_list)
  111.    every i := 1 to *did_list do
  112.       init_list[i] := \dftbl[did_list[i]]
  113.  
  114.    dialog_value := VOpenDialog(dstate.dialog, , dstate.dialog.id,
  115.       init_list, dstate.deflabel)
  116.  
  117.    every i := 1 to *did_list do
  118.       dftbl[did_list[i]] := dialog_value[i]
  119.  
  120.    dialog_value := dftbl
  121.  
  122.    return dialog_button
  123.  
  124. end
  125.  
  126. ## DL_crack(wspec, cbk) -- extract elements of spec and put into record
  127. #
  128. #  cbk is a default callback to use if the spec doesn't supply one.
  129.  
  130. procedure DL_crack(wspec, cbk)
  131.    local r, f
  132.  
  133.    r := DL_rec()
  134.    (get(wspec) | fail) ? { 
  135.       r.var := tab(upto(':')) | fail;  move(1)
  136.       r.typ := tab(upto(':')) | fail;  move(1)
  137.       r.sty := tab(upto(':')) | fail;  move(1)
  138.       r.num := tab(upto(':')) | fail;  move(1)
  139.       r.x := tab(upto(',')) | fail;  move(1)
  140.       r.y := tab(upto(',')) | fail;  move(1)
  141.       r.w := tab(upto(',')) | fail;  move(1)
  142.       r.h := tab(upto(':')) | fail;  move(1)
  143.       r.lbl := tab(0)
  144.       }
  145.    get(wspec)        # skip callback field
  146.    r.cbk := cbk        # always use parameter
  147.    r.etc := get(wspec)
  148.    return r
  149. end
  150.  
  151.  
  152. ## DL_obj(win, dialog, r) -- create vidget depending on type
  153.  
  154. procedure DL_obj(win, dialog, r)
  155.    local obj, gc, style, lo, hi, iv, args
  156.  
  157.    case r.typ of {
  158.       "Label" | "Message": {
  159.          obj := Vmessage(win, r.lbl)
  160.          VInsert(dialog, obj, r.x, r.y, r.w, r.h)
  161.          }
  162.       "Line": {
  163.          obj := Vline(win, r.x, r.y, r.w, r.h)
  164.          VInsert(dialog, obj, r.x, r.y, 1, 1) 
  165.          }
  166. #     "Rect": {   # doesn't work
  167. #        gc := Clone(win)
  168. #        if r.num == "" | r.num = 0 then
  169. #           r.num := &null
  170. #        obj := Vpane(gc, r.cbk, r.var, r.num)
  171. #        VInsert(dialog, obj, r.x, r.y, r.w, r.h)
  172. #        }
  173.       "Rect":  &null
  174.       "List":  &null
  175.       "Check": {
  176.          obj := Vcheckbox(win, r.cbk, r.var, r.w)
  177.          VInsert(dialog, obj, r.x, r.y, r.w, r.h)
  178.          }
  179.       "Button": {
  180.          style := case r.sty of {
  181.             "regular":    V_RECT
  182.             "regularno":V_RECT_NO
  183.             "check":    V_CHECK
  184.             "checkno":    V_CHECK_NO
  185.             "circle":    V_CIRCLE
  186.             "circleno":    V_CIRCLE_NO
  187.             "diamond":    V_DIAMOND
  188.             "diamondno":V_DIAMOND_NO
  189.             "xbox":    V_XBOX
  190.             "xboxno":    V_XBOX_NO
  191.             default:    V_RECT
  192.             }
  193.          if r.num == "1" then {        # toggle
  194.             put(did_list, r.var)
  195.             obj := Vtoggle(win, r.lbl, r.cbk, r.var, style, r.w, r.h)
  196.             VRegister(dialog, obj, r.x, r.y)
  197.             }
  198.          else {                # dismiss
  199.             obj := Vbutton(win, r.lbl, dialog_cb, V_OK, style, r.w, r.h)
  200.             VInsert(dialog, obj, r.x, r.y)
  201.             if r.num == "-1" then
  202.                did_label := r.lbl
  203.             }
  204.          }
  205.       "Choice": {
  206.          obj := Vradio_buttons(win, r.etc, r.cbk, r.var, V_DIAMOND_NO)
  207.          put(did_list, r.var)
  208.          VRegister(dialog, obj, r.x, r.y)
  209.          }
  210.       "Slider" | "Scrollbar" : {
  211.          r.lbl ? {
  212.             lo := numeric(tab(upto(',')))
  213.             move(1)
  214.             hi := numeric(tab(upto(',')))
  215.             move(1)
  216.             iv := numeric(tab(0))
  217.             }
  218.          if r.num == "" then
  219.             r.num := &null
  220.          obj := case (r.sty || r.typ) of {
  221.             "hSlider":
  222.                Vhoriz_slider(win, r.cbk, r.var, r.w, r.h, lo, hi, iv, r.num)
  223.             "vSlider":
  224.                Vvert_slider(win, r.cbk, r.var, r.h, r.w, hi, lo, iv, r.num)
  225.             "hScrollbar":
  226.                Vhoriz_scrollbar(win, r.cbk, r.var, r.w, r.h, lo, hi, , , r.num) 
  227.             "vScrollbar":
  228.                Vvert_scrollbar(win, r.cbk, r.var, r.h, r.w, hi, lo, , , r.num)
  229.             }
  230.          put(did_list, r.var)
  231.          VRegister(dialog, obj, r.x, r.y)
  232.          }
  233.       "Text": {
  234.          obj := Vtext(win, r.lbl, r.cbk, r.var, r.num)
  235.          put(did_list, r.var)
  236.          VRegister(dialog, obj, r.x, r.y)
  237.          }
  238. #     "Menu": {
  239. #        obj := Vmenu_bar(win, r.lbl, DL_submenu(win, r.etc, r.cbk))
  240. #        VInsert(dialog, obj, r.x, r.y)
  241. #        }
  242.       "Menu":  &null
  243.       default: {
  244.          stop("dsetup: unrecognized object: ", r.typ)
  245.          fail
  246.          }
  247.    }
  248.    return obj
  249. end
  250.  
  251.  
  252.  
  253. ## DL_submenu(win, lst, cbk) -- create submenu vidget
  254.  
  255. procedure DL_submenu(win, lst, cbk)
  256.    local a, c, lbl
  257.  
  258.    a := [win]
  259.    while *lst > 0 do {
  260.       put(a, get(lst))
  261.       if type(lst[1]) == "list" then
  262.          put(a, DL_submenu(win, get(lst), cbk))
  263.       else
  264.          put(a, cbk)
  265.       }
  266.    return Vsub_menu ! a
  267. end
  268.  
  269.  
  270.  
  271. ## dproto(proc, font, w, h) -- prototype a dialog box procedure built by vib
  272. #
  273. #  n.b. "font" is now ignored, although it was once significant.
  274.  
  275. procedure dproto(proc, font, w, h)
  276.    local win, s, l
  277.  
  278.    w <:= 150
  279.    h <:= 100
  280.    win := Window([], "canvas=hidden")
  281.    VSetFont(win)
  282.    repeat {
  283.       if write(image(proc), " returned ", image(proc(win))) then {
  284.          l := sort(dialog_value, 3)
  285.          while write("   dialog_value[\"", get(l), "\"] = ", image(get(l)))
  286.          }
  287.       else
  288.          write(image(proc), " failed")
  289.       if TextDialog(win,"Test prototype",,,,["Again","Quit"]) == "Quit" then
  290.          break
  291.       }
  292.    WClose(win)
  293. end
  294.