1/* psmlib.psm -- utilites for writing PostScript code with the help of
2 *   cpp, the C preprocessor
3 * compiled by pts@fazekas.hu at Fri Sep 20 23:38:32 CEST 2002
4 */
5
6#if USE_A85D
7#else
8  #if USE_HEXD
9  #else
10    #define USE_BINARY 1
11  #endif
12#endif
13
14#if USE_INDEXED2
15  #define USE_PALETTE 1
16#else
17  #if USE_TRANSPARENT8
18    #define USE_PALETTE 1
19  #endif
20#endif
21
22#if USE_NO_BIND
23  #define BIND_DEF def
24#else
25  #define BIND_DEF bind def
26#endif
27
28
29#if NDEBUG
30  #define DEBUG(msg)
31  #define ASSERT_TRUE_POP(str) pop
32  #define ASSERT_FALSE_POP(str) pop
33  #define ASSERT_TRUE(what,str)
34  #define ASSERT_INT()
35  #define INT_EQ eq
36  #define INT_NE ne
37  #define INT_LE le
38  #define INT_GT gt
39  #define INT_LT lt
40  #define BOOL_BIN(op,message) op
41  #define INT_BIN(op,message) op
42  #define DEBUGFORCE(msg)
43  #define ASSERT_STACK(list,message)
44#else
45  /-str /stringtype def
46  /-aryb /stringtype def % byte array
47  /-ary /arraytype def
48  /-int /integertype def
49  /-bool /booleantype def
50  /-dict /dicttype def
51  /handleerror.orig /handleerror load def
52  /handleerror {
53    (%stderr) (w) file
54    dup (!!!Fatal: GS error: ) writestring
55    dup $error /errorname get write==only
56    dup ( in ) writestring
57    dup $error /command get write==only
58    dup ( at ) writestring
59    dup $error /position get write==only
60    dup (.\n) writestring
61    flushfile flush
62    handleerror.orig
63    quit
64  }bind def
65  #define ASSERT_TRUE_POP(str) not{ str InternalError }if
66  #define ASSERT_FALSE_POP(str) { str InternalError }if
67  #define ASSERT_TRUE(what,str) what not{ str InternalError }if
68  #define ASSERT_INT(str) dup type/integertype ne{str InternalError}if
69  #define ASSERT_BOOL(str) dup type/booleantype ne{str InternalError}if
70  /DumpStack { % - DumpStack -
71    (Stack: ) print % from bottom to top
72    count 1 sub -1 0{
73      index
74      dup type /stringtype eq {pop ()}if
75      ===only
76      ( ) print
77    } for
78    (.\n) print
79  }bind def
80
81  /TypeStack { % <list> TypeStack <bool>
82    dup length count 2 sub eq {
83      true exch count 2 add 1 index length 1 sub 0 exch 1 exch
84      % Stack: ... true ary count(...)+5 0 1 ary.length-1
85      {
86        % Stack: ... true ary count* i
87        2 index exch get 2 copy exch
88        % Stack: ... true ary count* ary[i] ary[i] count*
89        index type
90        % Stack: ... true ary count* ary[i] ary[i] stackitem.type
91        ne{
92          pop pop pop pop
93          % Stack: ...
94          false 0 0
95          exit
96        }if
97        pop 1 sub
98        % Stack: ... true ary count*-1
99      } for
100      % Stack: ... true|false ary count*
101      pop pop
102    }{
103      pop false
104    }ifelse
105    ASSERT_BOOL((TypeStack-bool))
106  }bind def
107  /InternalError { % <str> FatalError -
108    (%stderr) (w) file dup dup
109      (Internal muZCat Error: ) writestring
110      2 index writestring
111      dup (.\n) writestring
112      flushfile
113      pop
114    quit
115  }bind def
116  /Stderr (%stderr) (w) file def
117  #ifdef DEBUGMSG
118    #define DEBUG(msg) msg Stderr exch writestring Stderr flushfile
119  #else
120    #define DEBUG(msg)
121  #endif
122  #define DEBUGFORCE(msg) msg Stderr exch writestring Stderr flushfile
123  #define INT_EQ ASSERT_INT((eq2int)) exch ASSERT_INT((eq1int)) exch eq
124  #define INT_NE ASSERT_INT((ne2int)) exch ASSERT_INT((ne1int)) exch ne
125  #define INT_LE ASSERT_INT((le2int)) exch ASSERT_INT((le1int)) exch le
126  #define INT_GT ASSERT_INT((gt2int)) exch ASSERT_INT((gt1int)) exch gt
127  #define INT_LT ASSERT_INT((lt2int)) exch ASSERT_INT((lt1int)) exch lt
128  #define BOOL_BIN(op,message) ASSERT_BOOL(message) exch ASSERT_BOOL(message) exch op
129  #define INT_BIN(op,message)   ASSERT_INT(message) exch  ASSERT_INT(message) exch op
130  #define ASSERT_STACK(list,message) TYPE_STACK(list) not{ DumpStack (assert stack: ) message concatstrings InternalError }if
131  #define TYPE_STACK(list) [ list ] TypeStack
132#endif
133
134/* at Sat Sep 21 19:07:59 CEST 2002 */
135#if USE_DEBUG2
136  #define DEBUG2(x) x
137#else
138  #define DEBUG2(x)
139#endif
140
141/* revised, A85D/read_eod at Sun Sep 22 00:27:13 CEST 2002 */
142/* Sample usage:
143 * { TE_read(===)  % action to do with normal char
144 *   #if !USE_NO_EOF
145 *   { TE_read_pop exit } ifelse  % action to do on EOF
146 *   #endif
147 * } loop
148 */
149#if USE_A85D
150  #define TE_read_eod a85_getc ASSERT_TRUE(dup 511 eq,(EOD expected)) pop
151  #define TE_init /xS 32 def  /xD 0 def  /xC 0 def
152  #if USE_NO_EOF
153    #define TE_read(true_action) a85_getc true_action
154    #define PSM_A85_GETC \
155      {27 xS ge{exit}if STDIN read pop \
156      dup 122 eq{/xS 27 def/xD 0 def/xC 0 def}{dup 117 gt{ \
157      STDIN read{pop}if/xS 54 xS sub def}{dup 33 ge{xS 32 eq{dup/xC exch def/xD -1670420001 def}{dup 117 sub{1 85 \
158      7225 614125}xS 28 sub get mul xD add/xD exch def}ifelse/xS xS 1 sub def}if}ifelse}ifelse pop}loop xS 22 eq{511}{xC \
159      1868977 mul xD add xS 24 and neg bitshift 23 xS lt{xC 3 mul add}if 255 and/xS xS 3 eq{32}{xS 7 mod 3 \
160      eq{22}{xS 8 sub}ifelse}ifelse def}ifelse
161    /** TE_readstring(str) <substr> */
162    #define TE_readstring(str) dup length 1 sub 0 exch 1 exch{a85_getc 3 copy put pop pop}for
163  #else
164    #define TE_read(true_action) a85_getc dup 256 INT_LT { true_action }
165    #define TE_read_pop pop
166    /* #define TE_read_eod TE_read() { ASSERT_TRUE(false,(EOD expected)) } ifelse */
167    #define PSM_A85_GETC \
168      {27 xS ge{exit}if STDIN read not{511}if \
169      dup 122 eq{/xS 27 def/xD 0 def/xC 0 def}{dup 117 gt{ \
170      STDIN read{pop}if/xS 54 xS sub def}{dup 33 ge{xS 32 eq{dup/xC exch def/xD -1670420001 def}{dup 117 sub{1 85 \
171      7225 614125}xS 28 sub get mul xD add/xD exch def}ifelse/xS xS 1 sub def}if}ifelse}ifelse pop}loop xS 22 eq{511}{xC \
172      1868977 mul xD add xS 24 and neg bitshift 23 xS lt{xC 3 mul add}if 255 and/xS xS 3 eq{32}{xS 7 mod 3 \
173      eq{22}{xS 8 sub}ifelse}ifelse def}ifelse
174  #endif
175#endif
176#if USE_HEXD
177  #define TE_init
178  #if USE_NO_EOF
179    #define TE_read(true_action) STDIN C readhexstring pop 0 get true_action
180    #define TE_read_eod STDIN read pop pop /* read '>' */
181    #define TE_readstring(str) STDIN str readhexstring pop
182  #else
183    #error PostScript op readhexstring cannot detect EOD!
184    #define TE_read(true_action) STDIN C readhexstring { 0 get true_action }
185    #define TE_read_pop
186    #define TE_read_eod
187  #endif
188#endif
189#if USE_BINARY
190  #define TE_init
191  #define TE_read_eod
192  #if USE_NO_EOF
193    #define TE_read(true_action) STDIN read pop true_action
194    #define TE_readstring(str) STDIN str readstring pop
195  #else
196    #define TE_read(true_action) STDIN read { true_action }
197    #define TE_read_pop
198  #endif
199#endif
200