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
|
############################################################################
#
# File: rawimage.icn
#
# Subject: Procedures to write and read images in raw format
#
# Author: Ralph E. Griswold
#
# Date: May 2, 2001
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# These procedures write and read raw image files. The format of a raw
# image file is:
#
# width,height
# <palette entries with 2 hex digits, a blank, and a color specification>
# <blank line>
# <image data consisting of pairs of hext digits in row-primary order>
#
# These procedures are slow and should only be used when the image file
# formats that Icon can read and write are not sufficient.
#
############################################################################
#
# Links: wopen
#
############################################################################
#
# Requires: Version 9 graphics and co-expressions
#
############################################################################
link wopen
$define LineLen 64
procedure WriteRaw(win, x, y, w, h)
local nextid, palette, line, c, temp, tempname
if type(win) ~== "window" then {
win :=: x :=: y :=: w :=: h
win := &window
}
/w := WAttrib(win, "width")
/h := WAttrib(win, "height")
/x := 0
/y := 0
tempname := "/tmp/reg." || map("mmhhss", "mm:hh:ss", &clock)
temp := open(tempname, "w") | stop("*** cannot open temporary file")
line := ""
palette := table()
nextid := create !"0123456789abcdef" || !"0123456789abcdef"
every c := Pixel(win, x, y, w, h) do {
/palette[c] := @nextid
line ||:= palette[c]
line ?:= {
write(temp, move(LineLen)) & tab(0)
}
}
write(temp, "" ~== line)
write(w, ",", h)
palette := sort(palette, 4)
while c := get(palette) do
write(get(palette), " ", c)
write() # separator
close(temp)
temp := open(tempname) | stop("*** cannot find temporary file")
while writes(reads(temp, 10000)) # copy image data
close(temp)
remove(tempname)
return
end
procedure ReadRaw(win, s, x, y)
local input, palette, c, temp, size, width, height, line
if type(win) ~== "window" then {
win :=: s :=: x :=: y
win := &window
}
input := open(s) | stop("*** cannot read raw image file")
temp := WOpen("size=" || (size := read(input)), "canvas=hidden") |
stop("*** malformed raw image file")
size ? {
width := integer(tab(upto(','))) &
move(1) &
height := integer(tab(0)) | stop("invalid raw image header")
}
palette := table()
while line := read(input) do
line ? {
palette[move(2) | break] := (move(1), tab(0))
}
x := y := 0
repeat {
line := read(input) | break
line ? {
while c := move(2) do {
Fg(temp, palette[c]) | stop("***invalid color: ", c)
DrawPoint(temp, x, y)
x +:= 1
if x = width then {
x := 0
y +:= 1
}
}
}
}
CopyArea(temp, win, 0, 0, width, height, x, y)
return
end
|
