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 / xcompat.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  111 lines
  1. ############################################################################
  2. #
  3. #    File:     xcompat.icn
  4. #
  5. #    Subject:  Procedures for compatibility with 8.10 graphics
  6. #
  7. #    Authors:  Gregg M. Townsend and Ralph E. Griswold
  8. #
  9. #    Date:     May 26, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This file provides compatible implementation of Icon 8.10 functions
  18. #  that cannot be replaced with 9.0 functions via the simple renaming
  19. #  done in xnames.icn.  The following procedures are provided:
  20. #
  21. #    XBind(w1, w2, ...)
  22. #    XUnbind()
  23. #    XWindowLabel(s)
  24. #    XDrawArc(w,x,y,width,height,a1,a2,...),
  25. #    XFillArc(w,x,y,width,height,a1,a2,...),
  26. #
  27. ############################################################################
  28. #
  29. #  Requires:  Version 9 graphics
  30. #
  31. ############################################################################
  32.  
  33.  
  34. procedure XBind(args[])
  35.    local window
  36.  
  37.    if type(args[2]) == type(args[1]) == "window" then
  38.       return Couple ! args        # two windows: couple them
  39.  
  40.    if type(args[1]) == "window" then {     # one window: clone it
  41.       window := pop(args)
  42.       if /args[1] then
  43.          pop(args)
  44.       push(args, window)
  45.       return Clone ! args
  46.       }
  47.  
  48.    # no windows: create hidden canvas
  49.    while /args[1] do            # remove leading null args
  50.       pop(args)
  51.    if type(args[1]) == "window" then    # remove possible arg2 window
  52.       pop(args)
  53.    while /args[-1] do            # remove trailing null args
  54.       pull(args)
  55.    put(args, "canvas=hidden")        # turn into open() call
  56.    push(args, "x")
  57.    push(args, "window")
  58.    return open ! args
  59. end
  60.  
  61.  
  62. procedure XUnbind(args[])
  63.    XUnbind := proc("XUnbind" | "XUncouple" | "Uncouple", 0)
  64.    return XUnbind ! args
  65. end
  66.  
  67.  
  68. procedure XWindowLabel(win, s)
  69.    if type(win) == "window" then
  70.       WAttrib(win, "label=" || s)
  71.    else
  72.       WAttrib("label=" || win)
  73.    return
  74. end
  75.  
  76.  
  77. procedure XDrawArc(args[])
  78.    local a1, i
  79.    static m
  80.  
  81.    initial m := -(2 * &pi) / (360 * 64)
  82.  
  83.    if type(args[1]) == "window" then
  84.       a1 := 6
  85.    else
  86.       a1 := 5
  87.    every i := a1 to *args by 6 do {
  88.       args[i] *:= m
  89.       args[i + 1] *:= m
  90.       }
  91.    return DrawArc ! args
  92. end
  93.  
  94.  
  95. procedure XFillArc(args[])
  96.    local a1, i
  97.    static m
  98.  
  99.    initial m := -(2 * &pi) / (360 * 64)
  100.  
  101.    if type(args[1]) == "window" then
  102.       a1 := 6
  103.    else
  104.       a1 := 5
  105.    every i := a1 to *args by 6 do {
  106.       args[i] *:= m
  107.       args[i + 1] *:= m
  108.       }
  109.    return FillArc ! args
  110. end
  111.