summaryrefslogtreecommitdiff
path: root/ipl/gprocs/xcompat.icn
blob: f9aef408720227e1dc9d28bc6ba8e17d74c1a1a7 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
############################################################################
#
#	File:     xcompat.icn
#
#	Subject:  Procedures for compatibility with 8.10 graphics
#
#	Authors:  Gregg M. Townsend and Ralph E. Griswold
#
#	Date:     May 26, 1994
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This file provides compatible implementation of Icon 8.10 functions
#  that cannot be replaced with 9.0 functions via the simple renaming
#  done in xnames.icn.  The following procedures are provided:
#
#	XBind(w1, w2, ...)
#	XUnbind()
#	XWindowLabel(s)
#	XDrawArc(w,x,y,width,height,a1,a2,...),
#	XFillArc(w,x,y,width,height,a1,a2,...),
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################


procedure XBind(args[])
   local window

   if type(args[2]) == type(args[1]) == "window" then
      return Couple ! args		# two windows: couple them

   if type(args[1]) == "window" then { 	# one window: clone it
      window := pop(args)
      if /args[1] then
         pop(args)
      push(args, window)
      return Clone ! args
      }

   # no windows: create hidden canvas
   while /args[1] do			# remove leading null args
      pop(args)
   if type(args[1]) == "window" then	# remove possible arg2 window
      pop(args)
   while /args[-1] do			# remove trailing null args
      pull(args)
   put(args, "canvas=hidden")		# turn into open() call
   push(args, "x")
   push(args, "window")
   return open ! args
end


procedure XUnbind(args[])
   XUnbind := proc("XUnbind" | "XUncouple" | "Uncouple", 0)
   return XUnbind ! args
end


procedure XWindowLabel(win, s)
   if type(win) == "window" then
      WAttrib(win, "label=" || s)
   else
      WAttrib("label=" || win)
   return
end


procedure XDrawArc(args[])
   local a1, i
   static m

   initial m := -(2 * &pi) / (360 * 64)

   if type(args[1]) == "window" then
      a1 := 6
   else
      a1 := 5
   every i := a1 to *args by 6 do {
      args[i] *:= m
      args[i + 1] *:= m
      }
   return DrawArc ! args
end


procedure XFillArc(args[])
   local a1, i
   static m

   initial m := -(2 * &pi) / (360 * 64)

   if type(args[1]) == "window" then
      a1 := 6
   else
      a1 := 5
   every i := a1 to *args by 6 do {
      args[i] *:= m
      args[i + 1] *:= m
      }
   return FillArc ! args
end