![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to image.icn CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / lib|
Return to image.icn CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / lib |
1.1 root 1: # IMAGE(2)
2: #
3: # Generalized image of Icon object
4: #
5: # Ralph E. Griswold
6: #
7: # Last modified 5/11/83
8: #
9:
10: procedure Image(x,done)
11: /done := table()
12: if match("record ",image(x)) then return rimage(x,done)
13: else return case type(x) of {
14: "list": limage(x,done)
15: "table": timage(x,done)
16: default: image(x)
17: }
18: end
19:
20: # list image
21: #
22: procedure limage(a,done)
23: static i
24: local s, tag
25: initial i := 0
26: if \done[a] then return done[a]
27: done[a] := tag := "L" || (i +:= 1)
28: if *a = 0 then s := tag || ":[]" else {
29: s := tag || ":["
30: every s ||:= Image(!a,done) || ","
31: s[-1] := "]"
32: }
33: return s
34: end
35:
36: # record image
37: #
38: procedure rimage(x,done)
39: static i
40: local s, tag
41: initial i := 0
42: s := image(x)
43: # might be record constructor
44: if match("record constructor ",s) then return s
45: if \done[x] then return done[x]
46: done[x] := tag := "R" || (i +:= 1)
47: s ?:= (="record " & (":" || (tab(upto('(') + 1))))
48: if *x = 0 then s := tag || s || ")" else {
49: s := tag || s
50: every s ||:= Image(!x,done) || ","
51: s[-1] := ")"
52: }
53: return s
54: end
55:
56: # table image
57: #
58: procedure timage(t,done)
59: static i
60: local s, tag, a, a1
61: initial i := 0
62: if \done[t] then return done[t]
63: done[t] := tag := "T" || (i +:= 1)
64: if *t = 0 then s := tag || ":[]" else {
65: a := sort(t)
66: s := tag || ":["
67: every a1 := !a do
68: s ||:= Image(a1[1],done) || "->" || Image(a1[2],done) || ","
69: s[-1] := "]"
70: }
71: return s
72: end
73:
74: global indent
75:
76: procedure Imagex(x,done)
77: initial indent := ""
78: /done := table()
79: if match("record ",image(x)) then return indent || rimagex(x,done)
80: else return case type(x) of {
81: "list": indent || limagex(x,done)
82: "table": indent || timagex(x,done)
83: default: indent || image(x)
84: }
85: end
86:
87: # list image
88: #
89: procedure limagex(a,done)
90: static i
91: local s, tag
92: initial i := 0
93: if \done[a] then return done[a]
94: done[a] := tag := "L" || (i +:= 1)
95: if *a = 0 then s := tag || ":[]" else {
96: indent ||:= " "
97: s := tag || ":["
98: every s ||:= "\n" || Image(!a,done)
99: }
100: s ||:= "\n" || indent || "]"
101: indent := indent[1:-3]
102: return s
103: end
104:
105: # record image
106: #
107: procedure rimagex(x,done)
108: static i
109: local s, tag
110: initial i := 0
111: s := image(x)
112: # might be record constructor
113: if match("record constructor ",s) then return s
114: if \done[x] then return done[x]
115: done[x] := tag := "R" || (i +:= 1)
116: s ?:= (="record " & (":" || (tab(upto('(') + 1))))
117: if *x = 0 then s := tag || s || ")" else {
118: indent ||:= " "
119: s := tag || s
120: every s ||:= "\n" || Image(!x,done)
121: }
122: s ||:= "\n" || indent || ")"
123: indent := indent[1:-3]
124: return s
125: end
126:
127: # table image
128: #
129: procedure timagex(t,done)
130: static i
131: local s, tag, a, a1
132: initial i := 0
133: if \done[t] then return done[t]
134: done[t] := tag := "T" || (i +:= 1)
135: if *t = 0 then s := tag || ":{}" else {
136: indent ||:= " "
137: a := sort(t)
138: s := tag || ":{"
139: every a1 := !a do
140: s ||:= "\n" || Image(a1[1],done) || "\n" || indent || "---" ||
141: "\n" || Image(a1[2],done) || "\n" || indent || "------"
142: }
143: s ||:= "\n" || indent || "]"
144: indent := indent[1:-3]
145: return s
146: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.