-
Notifications
You must be signed in to change notification settings - Fork 12
171 lines (157 loc) · 4.73 KB
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
@program cmd-@image
1 99999 d
1 i
$include $lib/match
$def IMAGE_PACKAGE "dns-org-fuzzball-image"
: list-imagers[ -- ]
0 var! count
preempt
descr IMAGE_PACKAGE mcp_supports
0.0 > if
{ }list var! names
{ }list var! targrefs
{ }list var! urls
me @ location contents
begin
dup while
dup room? if next continue then
count @ 1 + dup count ! 150 <= while
dup "_/image" getpropstr dup if
urls @ array_appenditem urls !
dup targrefs @ array_appenditem targrefs !
dup name names @ array_appenditem names !
else
pop
then
next
repeat pop
descr IMAGE_PACKAGE "viewable"
{
"names" names @
"refs" targrefs @
"urls" urls @
}dict
mcp_send
else
"(@imaged objects)" tell
me @ location contents
begin
dup while
dup room? if next continue then
count @ 1 + dup count ! 50 > if
"(Too many objects in this room. Skipping the remainder.)"
tell break
then
dup "_/image" getpropstr if
dup name tell
then
next
repeat pop
"(Done.)" tell
then
;
: cmd-@image[ str:cmdline -- ]
cmdline @ tolower "#help" stringcmp not if
{
"@Image ver. 2.0 Copyright 7/10/1994 by Revar"
"-------------------------------------------------------------------"
"@image <object> To see where to find a gif of the object"
"@image <obj>=<URL> To specify where one can find a gif of "
" that object. The URL is the WWW URL "
" format for specifying where on the net"
" a file is. "
"@image <obj>=clear To clear the image reference. "
"-------------------------------------------------------------------"
"URLs have the following format: type://machine.name/path/file"
"If I wanted to show that people can find an image of Revar on"
"www.belfry.com, via the web, I'd just do:"
" @image Revar=https://www.belfry.com/pics/revar-cw3.jpg"
" "
"Those of you who have used the web should find URLs familiar."
}tell
exit
then
cmdline @ not if
list-imagers
exit
then
cmdline @ "=" split strip
var! newurl
strip
dup not if
"Usage: @image <object> or @image <object>=<URL>" tell
pop exit
then
noisy_match
var! targref
targref @ not if
exit
then
newurl @ not if
cmdline @ "=" instr if
( @image <object>= )
"me" match targref @ controls not if
"Permission denied." tell
exit
then
targref @ "_/image" "" 0 addprop
"Image unset." tell
exit
then
( @image <object> )
targref @ "_/image" getpropstr
" " "\r" subst
var! currurl
currurl @ not if
"No image available." tell
exit
then
descr IMAGE_PACKAGE mcp_supports
0.0 > if
descr IMAGE_PACKAGE "view"
{
"name" targref @ name
"ref" targref @
"url" currurl @
}dict
mcp_send
else
"(@image) " currurl @ strcat tell
then
else
( @image <object>=<URL> )
"me" match targref @ controls not if
"Permission denied." tell
exit
then
newurl @ "://" split strip swap strip
dup "file" stringcmp
over "http" stringcmp and
over "ftp" stringcmp and
over "https" stringcmp and if
pop pop
"Unknown URL service type. The acceptable types are ftp, http, https, and file." tell
"Example: https://www.belfry.com/pics/revar-cw3.jpg" tell
exit
then
"://" strcat swap
"/" split swap
dup "*[^-:%.a-z0-9_]*" smatch if
"Invalid character in machine name. Valid chars are a-z, 0-9, _, period, colon, and -." tell
pop pop pop exit
then
"/" strcat swap
strcat strcat
targref @ "_/image" rot 0 addprop
"Image set." tell
then
;
.
c
q
@register #me cmd-@image=tmp/prog1
@set $tmp/prog1=3
@set $tmp/prog1=V
@action @image;@imag;@ima;@im=#0=tmp/exit1
@link $tmp/exit1=$tmp/prog1
@register #me =tmp