File: ait-label.lisp

package info (click to toggle)
libpostscriptbarcode 20140312-2
  • links: PTS, VCS
  • area: main
  • in suites: buster, jessie, jessie-kfreebsd, stretch
  • size: 1,768 kB
  • ctags: 65
  • sloc: perl: 192; makefile: 180; sh: 107; lisp: 92; java: 49
file content (221 lines) | stat: -rw-r--r-- 5,872 bytes parent folder | download
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
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
;;;
;;; Barcode generator for AIT tapes
;;;
;;;
;;; Copyright (C) 2005 by Greg Menke, gregm-news@toadmail.com
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; http://www.gnu.org/licenses/gpl.html
;;;
;;;
;;;
;;; Uses the Pure Postscript Barcode Generator:
;;;   http://www.terryburton.co.uk/barcodewriter/
;;;
;;;
;;;
;;; This script can be run by most any Common Lisp implementation.
;;; Unless you have one installed already, CLISP is generally the
;;; most broadly available and quickest to install.  CLISP is available
;;; an binary and source forms at 
;;;
;;; http://clisp.cons.org/
;;;
;;;
;;; To run the script using CLISP, invoke the following in the same
;;; directory where the Pure Postscript files were extracted.
;;;
;;; clisp -q ait-tape.lisp | lp
;;;
;;; This assumes 'lp' has a default printer that accepts postscript,
;;; modify as required to direct the output properly.
;;;


(defstruct pagedef 
  (pane-rows) 
  (pane-cols) 
  (pane-width)
  (pane-height)
  (pane-inside-horizontal)
  (pane-inside-vertical)
  (left-pane-offset)
  (top-pane-offset)
  (pane-divider-width)
  (pane-divider-height))


;;;
;;; postscript points are 1/72"
;;;
(defparameter %DPI%	72)


(defun make-barcode-coordinates (pdef)
  (let* ((bc-coords             nil) 
	 (bc-width		(* %WIDTH-PER-CODE%  %DPI%))
	 (bc-height		(* %HEIGHT-PER-CODE% %DPI%))

	 (pane-width		(* (pagedef-pane-width pdef)  %DPI%))
	 (pane-height		(* (pagedef-pane-height pdef) %DPI%))

	 (pane-inside-hor	(* (pagedef-pane-inside-horizontal pdef) %DPI%))
	 (pane-inside-vert      (* (pagedef-pane-inside-vertical pdef)   %DPI%))

	 (pane-offset-x		(* (pagedef-left-pane-offset pdef) %DPI%))
	 (pane-offset-y		(* (pagedef-top-pane-offset pdef)  %DPI%))
	   
	 (pane-divider-width	(* (pagedef-pane-divider-width pdef)  %DPI%))
	 (pane-divider-height	(* (pagedef-pane-divider-height pdef) %DPI%)) )
				
				
    (let ((bcodes-per-pane-horiz	(floor (/ pane-width  (+ bc-width  (* pane-inside-hor 2)))) )
	  (bcodes-per-pane-vert		(floor (/ pane-height (+ bc-height (* pane-inside-vert 2)))) ) )


      (loop for pcol from 0 below (pagedef-pane-cols pdef)
	    for basex = (+ pane-offset-x (* pcol pane-width) (* pcol pane-divider-width))
	    do

	    (loop for prow from 0 below (pagedef-pane-rows pdef)
		  for basey = (+ pane-offset-y (* prow pane-height) (* prow pane-divider-height))
		  do

		  (loop for bcol from 0 below bcodes-per-pane-horiz
			for barcodex = (+ basex (* bcol bc-width) pane-inside-hor)
			do
			(loop for brow from 0 below bcodes-per-pane-vert
			      for barcodey = (+ basey (* brow bc-height) pane-inside-vert bc-height)
			      do

			      (push (list (floor barcodex) (floor barcodey)) 
				    bc-coords) )))) )

    (coerce (reverse bc-coords) 'vector) ))










(defun print-strings ( slist )
  "Print each postscript string to standard-output, terminating with newlines"
    (loop for e in slist
	  do
	  (cond ((typep e 'cons)
		 (print-strings e))
		 
		(t
		 (format *standard-output* "~A~%" e)) ) ))








(defun bcode (bcode pagedef startval endval &optional (opts ""))
  "Create the barcode postscript strings, then print them"

  (let* ((prolog-strings	'("%!PS-Adobe-2.0"))

	 (template-strings	(with-open-file (str "barcode.ps" 
						     :direction :input 
						     :if-does-not-exist :error)
				   ;; skip file text till we hit BEGIN TEMPLATE
				   (loop for l = (read-line str nil nil)
					 while (and l 
						    (not (search "% --BEGIN TEMPLATE--" l))) )
				   ;; now inside template
				   (loop for l = (read-line str nil nil)
					 while (and l 
						    (not (search "% --END TEMPLATE--" l)))
					 collect l)) )


	 (content-opts		(concatenate 'string 
					     opts
					     (format nil " height=~D " %BOPT-HEIGHT%)) )


	 (content-strings	(loop with bc-coords = (make-barcode-coordinates pagedef)

				      for i from startval upto endval
				      for j from 0 below (length bc-coords)

				      collect (list "gsave"

						    (destructuring-bind (x y) (svref bc-coords j)
						       (format nil "~D ~D translate" x y))

						    (format nil 
							    "0 0 moveto (~A) (~A) ~A barcode" 
							    (format nil "~6,'0D" i)
							    content-opts 
							    bcode)

						    "grestore")) )

	 (epilog-strings        '("showpage")) )
    ;;
    ;; now accumulate the strings and print them in order
    ;;
    (print-strings (append prolog-strings
			   template-strings
			   content-strings
			   epilog-strings)) ))






;;;
;;; Parameters in inches
;;;

(defparameter %WIDTH-PER-CODE%		2.250 )
(defparameter %HEIGHT-PER-CODE%		0.375 )
(defparameter %BOPT-HEIGHT%		0.24 )




;;;
;;; Page definitions, in inches
;;;
(defparameter %avery-6873%    (make-pagedef :pane-rows  4              :pane-cols 2
					    :pane-width 3.75           :pane-height 2.00
					    :pane-inside-horizontal 0.062
					    :pane-inside-vertical   0.062
					    :left-pane-offset 0.375    :top-pane-offset 1.125
					    :pane-divider-width 0.250  :pane-divider-height 0.250))



;;;
;;; Adjust parameters of this call to select the barcode format,
;;; text numbers and text options
;;;

(bcode "code39" %avery-6873% 10 40 "includetext includecheck")
    
;;; eof