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
111
112
113
114
115
116
117
|
############################################################################
#
# File: lindcomp.icn
#
# Subject: Program to compile 0L-systems
#
# Author: Ralph E. Griswold
#
# Date: August 13, 1995
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This program converts a 0L-system to an Icon program, which when
# executed, produces the corresponding drawing.
#
############################################################################
#
# See also: linden.icn
#
############################################################################
global procs
procedure main()
local line, sym, new, keyword, value, axiom, gener, angle, length
local replace
procs := table() # table of procedures to generate
gener := 4 # defaults
length := 5
angle := 90.0
while line := read() do
line ? {
if sym := tab(find("->")) then {
move(2)
replace := tab(0)
procs[sym] := replace
}
else if keyword := tab(find(":")) then {
move(1)
value := tab(0)
case keyword of {
"axiom": axiom := value
"gener": gener := integer(value) |
stop("*** invalid generation specification")
"angle": angle := real(value) |
stop("*** invalid angle: ", line)
"length": length := integer(value) |
stop("*** invalid length: ", line)
"name": &null # ignore name
default: stop("*** invalid keyword: ", line)
}
}
else stop("*** invalid specification: ", line)
}
# Write heading and main procedure
write("link turtle")
write()
write("$define Generations ", gener)
write("$define Angle ", angle)
write("$define Length ", length)
write()
write("procedure main()")
gencode(axiom, "Generations")
write("end")
write()
# Produce drawing procedures.
every sym := key(procs) do
genproc(sym, procs[sym])
end
procedure gencode(replace, arg)
local sym
every sym := !replace do {
case sym of {
"+": write(" TRight(Angle) # +")
"-": write(" TLeft(Angle) # -")
"[": write(" TSave() # [")
"]": write(" TRestore() # ]")
default: if \procs[sym]
then write(" ", sym, "(", arg, ") # ", sym)
}
}
return
end
procedure genproc(name, replace)
write("procedure ", name, "(gener)")
write(" if gener > 0 then {")
gencode(replace, "gener - 1")
write(" }")
case name of {
"F": write(" else TDraw(Length) # F")
"f": write(" else TSkip(Length) # f")
}
write(" return")
write("end")
write()
return
end
|
