summaryrefslogtreecommitdiff
path: root/ipl/gprogs/showtile.icn
blob: 339a6d170e2fd1142136acb4071ae04ddf375b85 (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
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
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
############################################################################
#
#	File:     showtile.icn
#
#	Subject:  Program to display tiles
#
#	Author:   Ralph E. Griswold
#
#	Date:     June 10, 1999
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#  This program displays pattern tiles given in standard input.
#
#  The options are:
#
#	-P	show pattern produced by tile; default show tile
#	-i s	create image files with prefix s
#	-a	run without waiting for event in window
#	-u	don't show on-screen images; implies -a
#	-p i	start with page i
#	-r i	number of rows, default 7 for -P, otherwise 10
#	-c i	number of columns, default 6 for -P, otherwise 12
#	-n s	number pages using s as a prefix
#	-w i	width of area for tile; default 48 unless -P
#	-h i	height of area for file; default 48 unless -P
#	-d	add date line
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################
#
#  Links:  options, patutils, xio, xutils, graphics, xcompat
#
############################################################################

link options
link patutils
link xio
link xutils
link graphics
link xcompat

procedure main(args)
   local x, y, w, h, pattern, count, page, opts, images, auto, unseen, foot
   local rows, cols, prefix, bfont, nfont, dims, areaw, areah, signal, poff
   local date, HGap, VGap, patterns

   opts := options(args, "Pi:aup+r+c+w+h+n:d")

   images := \opts["i"]
   auto := \opts["a"]
   auto := unseen := \opts["u"]
   page := (\opts["p"] - 1) | 0
   prefix := \opts["n"]
   if \opts["d"] then date := &dateline else date := ""
   foot := \prefix | \opts["d"]

   if \opts["P"] then {				# pattern mode
      patterns := 1
      HGap := 32				# gap between
      VGap := 32				# gap below
      areaw := 128				# pattern width
      areah := 64				# pattern height
      rows := \opts["r"] | 7
      cols := \opts["c"] | 6
      w := (areaw + HGap) * cols - HGap
      h := (areah + VGap) * rows
      if \foot then h +:= 20
      }
   else {					# image mode
      HGap := 16				# gap between
      VGap := 16				# gap below
      rows := \opts["r"] | 10
      cols := \opts["c"] | 12
      areaw := \opts["w"] | 48
      areah := \opts["h"] | 48
      w := (areaw + HGap) * cols + 1
      h := (areah + VGap) * rows + 1
      if \foot then h +:= 20			# space for page number
      }

   WOpen("width=" || w, "height=" || h, "canvas=hidden") |
      stop("*** cannot open window")
   if /unseen then WAttrib("canvas=normal")

   if \patterns then WAttrib("fillstyle=textured")

   bfont := "-misc-fixed-medium-r-normal--10-100-75-75-c-60-iso8859-1"
   nfont := "-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso8859-1"

   Font(bfont | "6x10" | "fixed")

   count := 0

#  Skip pages if requested.

   every 1 to (rows * cols) * page do {
      readpatt() | stop("*** premature end of file")
      count +:= 1
      }

#  Main processing loop.

   repeat {
      if \patterns then EraseArea()
      else grid(areaw + HGap, areah + VGap, cols, rows)

      x := y := 0

#  Do a page.

      every 1 to rows do {
         every 1 to cols do {
            pattern := readpatt() | break break break
            count +:= 1
            if \patterns then {
               Pattern(pattern) | {
                   write(&errout, "*** could not set pattern: ", pattern)
                   next
                   }
               FillRectangle(x, y, areaw, areah)
               GotoXY(x, y + areah + VGap / 3)
               WWrites(left(count || ":", 5))
               dims := tiledim(pattern)
               WWrites(left(dims.w || "x" || dims.h, 7))
               WWrites("d=", left(pdensity(pattern), 7))
               GotoXY(x, y + areah + VGap / 3 + 11)
               if *pattern > 20 then pattern := pattern[1+:18] || "..."
               WWrites(pattern)
               }
            else {
               poff := (HGap + areaw - tiledim(pattern).w) / 3
               DrawImage(x + poff, y + VGap / 2, pattern)
               WFlush()
               CenterString(x + poff * 2, y + areah + VGap / 3, count)
               }
            x +:= areaw + HGap
            }
         x := 0
         y +:= areah + VGap
         }

      page +:= 1
      if \foot then {
         GotoXY(0, h - 5)
         Font(nfont | "10x20" | "fixed")		# numbering font
         WWrites(\prefix || page)
         GotoXY(w - TextWidth(date), h - 5)
         WWrites(date)
         Font(bfont | "6x10" | "fixed")		# restore body font
         }
      if /auto & /unseen then signal := Event()
      WriteImage(\images || right(page, 2, "0") || ".gif")
      if signal === "q" then exit()
      }

   page +:= 1
   if \foot then {
      GotoXY(0, h - 5)
      Font(nfont | "10x20" | "fixed")			# numbering font
      WWrites(\prefix || page)
      GotoXY(w - TextWidth(date), h - 5)
      WWrites(date)
      }
   WriteImage(\images || right(page, 2, "0") || ".gif")
   if /auto then WDone()

end

#  Draw a grid for the tile mode

procedure grid(w, h, c, r)
   local wc, hr, x, y

   wc := w * c
   hr := h * r

   EraseArea()

   every x := 0 to wc by w do
      DrawLine(x, 0, x, hr)
   every y := 0 to hr by h do
      DrawLine(0, y, wc, y)

   return

end