summaryrefslogtreecommitdiff
path: root/ipl/gprogs/ddextend.icn
blob: 61f590e77a2d4969923a00913f8bac45b6f95ff4 (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
############################################################################
#
#	File:     ddextend.icn
#
#	Subject:  Program to extend pattern to a minimum size
#
#	Author:   Ralph E. Griswold
#
#	Date:     June 11, 2002
#
############################################################################
#
#  This file is in the public domain.
#
############################################################################
#
#  This program reads a drawdown from standard input in the form of
#  rows of zeros and ones, in which ones indicate places where the
#  warp thread is on top and zeros where the weft thread is on top.
#  It also accepts a BLP as input.
#
#  At present, the minimum size is 16, built in.  This should be changed
#  to a value that could be specified as an option.
#
#  It outputs a BLP.
#
############################################################################
#
#  Links:  patutils, patxform
#
############################################################################

link patutils
link patxform

$define Minimum 16

procedure main()
   local line, rows, q, r, new_rows

   rows := []

   line := read() | stop("empty file")

   if upto("#", line) then rows := pat2rows(line)
   else {
      rows := [line]
      while put(rows, read())	# read in row pattern
      }

   while put(rows, read())

   # extend width if necessary

   if *rows[1] < Minimum then {
      q := Minimum / *rows[1]
      r := Minimum % *rows[1]
      if r ~= 0 then q +:= 1		# extension factor
      new_rows := copy(rows)
      every 2 to q do
         new_rows := pcaten(new_rows, rows, "h") 
      rows := new_rows
      }

   # extend height if necessary

   if *rows < Minimum then {
      q := Minimum / *rows
      r := Minimum % *rows
      if r ~= 0 then q +:= 1		# extension factor
      new_rows := copy(rows)
      every 2 to q do
         new_rows := pcaten(new_rows, rows, "v") 
      rows := new_rows
      }

   write(rows2pat(rows))


end