1if not modules then modules = { } end modules [ ' m-escrito ' ] = {
2 version = 1 . 001 ,
3 comment = " companion to m-escrito.mkiv " ,
4 author = " Taco Hoekwater (BitText) and Hans Hagen (PRAGMA-ADE) " ,
5 license = " see below and context related readme files "
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
69local type , unpack , tonumber , tostring , next = type , unpack , tonumber , tostring , next
70
71local format = string . format
72local gmatch = string . gmatch
73local match = string . match
74local sub = string . sub
75local char = string . char
76local byte = string . byte
77
78local insert = table . insert
79local remove = table . remove
80local concat = table . concat
81local reverse = table . reverse
82
83local abs = math . abs
84local ceil = math . ceil
85local floor = math . floor
86local sin = math . sin
87local cos = math . cos
88local rad = math . rad
89local sqrt = math . sqrt
90local atan2 = math . atan2
91local tan = math . tan
92local deg = math . deg
93local pow = math . pow
94local log = math . log
95local log10 = math . log10
96local random = math . random
97local setranseed = math . randomseed
98
99local bitand = bit32 . band
100local bitor = bit32 . bor
101local bitxor = bit32 . bxor
102local bitrshift = bit32 . rshift
103local bitlshift = bit32 . lshift
104
105local lpegmatch = lpeg . match
106local Ct , Cc , Cs , Cp , C , R , S , P , V = lpeg . Ct , lpeg . Cc , lpeg . Cs , lpeg . Cp , lpeg . C , lpeg . R , lpeg . S , lpeg . P , lpeg . V
107
108local formatters = string . formatters
109local setmetatableindex = table . setmetatableindex
110
111
112
113
114
115
116escrito = { }
117
118
119local initializers = { }
120local devices = { }
121local specials
122
123local DEBUG = false
124local INITDEBUG = false
125local MAX_INT = 0x7FFFFFFF
126
127initializers [ # initializers + 1 ] = function ( reset )
128 if reset then
129 specials = nil
130 else
131 specials = { }
132 end
133end
134
135local devicename
136local device
137
138
139
140
141
142
143
144
145
146
147
148local VM
149
150initializers [ # initializers + 1 ] = function ( )
151 VM = { }
152end
153
154local directvm = false
155
156local add_VM , get_VM
157
158if directvm then
159
160 add_VM = function ( a )
161 return a
162 end
163 get_VM = function ( i )
164 return i
165 end
166
167else
168
169 add_VM = function ( a )
170 local n = # VM + 1
171 VM [ n ] = a
172 return n
173 end
174
175 get_VM = function ( i )
176 return VM [ i ]
177 end
178
179end
180
181
182
183local execstack
184local execstackptr
185local do_exec
186local next_object
187local stopped
188
189initializers [ # initializers + 1 ] = function ( )
190 execstack = { }
191 execstackptr = 0
192 stopped = false
193end
194
195local function pop_execstack ( )
196 if execstackptr > 0 then
197 local value = execstack [ execstackptr ]
198 execstackptr = execstackptr - 1
199 return value
200 else
201 return nil
202 end
203end
204
205local function push_execstack ( v )
206 execstackptr = execstackptr + 1
207 execstack [ execstackptr ] = v
208end
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263local opstack
264local opstackptr
265
266local b_true = { ' boolean ' , ' unlimited ' , ' literal ' , true }
267local b_false = { ' boolean ' , ' unlimited ' , ' literal ' , false }
268
269initializers [ # initializers + 1 ] = function ( )
270 opstack = { }
271 opstackptr = 0
272end
273
274local function pop_opstack ( )
275 if opstackptr > 0 then
276 local value = opstack [ opstackptr ]
277 opstackptr = opstackptr - 1
278 return value
279 else
280 return nil
281 end
282end
283
284local function push_opstack ( v )
285 opstackptr = opstackptr + 1
286 opstack [ opstackptr ] = v
287end
288
289local function check_opstack ( n )
290 return opstackptr > = n
291end
292
293local function get_opstack ( )
294 if opstackptr > 0 then
295 return opstack [ opstackptr ]
296 else
297 return nil
298 end
299end
300
301
302
303local function copy_opstack ( )
304 local t = { }
305 for n = 1 , opstackptr do
306 local sn = opstack [ n ]
307 t [ n ] = { unpack ( sn ) }
308 end
309 return t
310end
311
312local function set_opstack ( new )
313 opstackptr = # new
314 opstack = new
315end
316
317
318
319local dictstack
320local dictstackptr
321
322initializers [ # initializers + 1 ] = function ( )
323 dictstack = { }
324 dictstackptr = 0
325end
326
327
328
329local function lookup ( name )
330 for n = dictstackptr , 1 , -1 do
331 local found = get_VM ( dictstack [ n ] )
332 if found then
333 local dict = found . dict
334 if dict then
335 local d = dict [ name ]
336 if d then
337 return d , n
338 end
339 end
340 end
341 end
342 return nil
343end
344
345
346
347
348
349
350
351
352local gsstate
353
354initializers [ # initializers + 1 ] = function ( reset )
355 if reset then
356 gsstate = nil
357 else
358 gsstate = {
359 matrix = { 1 , 0 , 0 , 1 , 0 , 0 } ,
360 color = {
361 gray = 0 ,
362 hsb = { } ,
363 rgb = { } ,
364 cmyk = { } ,
365 type = " gray "
366 } ,
367 position = { } ,
368 path = { } ,
369 clip = { } ,
370 font = nil ,
371 linewidth = 1 ,
372 linecap = 0 ,
373 linejoin = 0 ,
374 screen = nil ,
375 transfer = nil ,
376 flatness = 0 ,
377 miterlimit = 10 ,
378 dashpattern = { } ,
379 dashoffset = 0 ,
380 }
381 end
382end
383
384local function copy_gsstate ( )
385 local old = gsstate
386 local position = old . position
387 local matrix = old . matrix
388 local color = old . color
389 local rgb = color . rgb
390 local cmyk = color . cmyk
391 local hsb = color . hsb
392 return {
393 matrix = { matrix [ 1 ] , matrix [ 2 ] , matrix [ 3 ] , matrix [ 4 ] , matrix [ 5 ] , matrix [ 6 ] } ,
394 color = {
395 type = color . type ,
396 gray = color . gray ,
397 hsb = { hsb [ 1 ] , hsb [ 2 ] , hsb [ 3 ] } ,
398 rgb = { rgb [ 1 ] , rgb [ 2 ] , rgb [ 3 ] } ,
399 cmyk = { cmyk [ 1 ] , cmyk [ 2 ] , cmyk [ 3 ] , cmyk [ 4 ] } ,
400 } ,
401 position = { position [ 1 ] , position [ 2 ] } ,
402 path = { unpack ( old . path ) } ,
403 clip = { unpack ( old . clip ) } ,
404 font = old . font ,
405 linewidth = old . linewidth ,
406 linecap = old . linecap ,
407 linejoin = old . linejoin ,
408 screen = old . screen ,
409 transfer = nil ,
410 flatness = old . flatness ,
411 miterlimit = old . miterlimit ,
412 dashpattern = { } ,
413 dashoffset = 0 ,
414 }
415end
416
417
418
419
420
421local gsstack
422local gsstackptr
423
424initializers [ # initializers + 1 ] = function ( reset )
425 if reset then
426 gsstack = nil
427 gsstackptr = nil
428 else
429 gsstack = { }
430 gsstackptr = 0
431 end
432end
433
434local function push_gsstack ( v )
435 gsstackptr = gsstackptr + 1
436 gsstack [ gsstackptr ] = v
437end
438
439local function pop_gsstack ( )
440 if gsstackptr > 0 then
441 local v = gsstack [ gsstackptr ]
442 gsstackptr = gsstackptr - 1
443 return v
444 end
445end
446
447
448
449local currentpage
450
451initializers [ # initializers + 1 ] = function ( reset )
452 if reset then
453 currentpage = nil
454 else
455 currentpage = { }
456 end
457end
458
459
460
461
462
463
464local errordict
465local dicterror
466
467
468
469local function lookup_error ( name )
470 local dict = get_VM ( errordict ) . dict
471 return dict and dict [ name ]
472end
473
474
475
476local report = logs . reporter ( " escrito " )
477
478local function ps_error ( a )
479
480 return false , a
481end
482
483
484
485
486
487
488
489
490
491
492
493
494
495local operators = { }
496
497
498
499
500
501function operators . pop ( )
502 local a = pop_opstack ( )
503 if not a then
504 return ps_error ( ' stackunderflow ' )
505 end
506 return true
507end
508
509function operators . exch ( )
510 if opstackptr < 2 then
511 return ps_error ( ' stackunderflow ' )
512 end
513 local prv = opstackptr - 1
514 opstack [ opstackptr ] , opstack [ prv ] = opstack [ prv ] , opstack [ opstackptr ]
515 return true
516end
517
518function operators . dup ( )
519 if opstackptr < 1 then
520 return ps_error ( ' stackunderflow ' )
521 end
522 local nxt = opstackptr + 1
523 opstack [ nxt ] = opstack [ opstackptr ]
524 opstackptr = nxt
525 return true
526end
527
528function operators . copy ( )
529 local a = pop_opstack ( )
530 if not a then
531 return ps_error ( ' stackunderflow ' )
532 end
533 local ta = a [ 1 ]
534 if ta = = ' integer ' then
535 local va = a [ 4 ]
536 if va < 0 then
537 return ps_error ( ' typecheck ' )
538 end
539 local thestack = opstackptr
540 if va > thestack then
541 return ps_error ( ' stackunderflow ' )
542 end
543
544 local n = thestack - va + 1
545 while n < = thestack do
546 local b = opstack [ n ]
547 local tb = b [ 1 ]
548 if tb = = ' array ' or tb = = ' string ' or tb = = ' dict ' or tb = = ' font ' then
549 b = { tb , b [ 2 ] , b [ 3 ] , add_VM ( get_VM ( b [ 4 ] ) ) , b [ 5 ] , b [ 6 ] , b [ 7 ] }
550 end
551 push_opstack ( b )
552 n = n + 1
553 end
554 elseif ta = = ' dict ' then
555 local b = a
556 local a = pop_opstack ( )
557 if not a then
558 return ps_error ( ' stackunderflow ' )
559 end
560 if a [ 1 ] ~ = ' dict ' then
561 return ps_error ( ' typecheck ' )
562 end
563 local thedict = get_VM ( b [ 4 ] )
564 local tobecopied = get_VM ( a [ 4 ] )
565 if thedict . maxsize < tobecopied . size then
566 return ps_error ( ' rangecheck ' )
567 end
568 if thedict . size ~ = 0 then
569 return ps_error ( ' typecheck ' )
570 end
571 local access = thedict . access
572 if access = = ' read-only ' or access = = ' noaccess ' then
573 return ps_error ( ' invalidaccess ' )
574 end
575 local dict = { }
576 for k , v in next , tobecopied . dict do
577 dict [ k ] = v
578 end
579 thedict . access = tobecopied . access
580 thedict . size = tobecopied . size
581 thedict . dict = dict
582 b = { b [ 1 ] , b [ 2 ] , b [ 3 ] , add_VM ( thedict ) }
583 push_opstack ( b )
584 elseif ta = = ' array ' then
585 local b = a
586 local a = pop_opstack ( )
587 if not a then
588 return ps_error ( ' stackunderflow ' )
589 end
590 if a [ 1 ] ~ = ' array ' then
591 return ps_error ( ' typecheck ' )
592 end
593 if b [ 6 ] < a [ 6 ] then
594 return ps_error ( ' rangecheck ' )
595 end
596 local access = b [ 2 ]
597 if access = = ' read-only ' or access = = ' noaccess ' then
598 return ps_error ( ' invalidaccess ' )
599 end
600 local array = { }
601 local thearray = get_VM ( b [ 4 ] )
602 local tobecopied = get_VM ( a [ 4 ] )
603 for k , v in next , tobecopied do
604 array [ k ] = v
605 end
606 b = { b [ 1 ] , b [ 2 ] , b [ 3 ] , add_VM ( array ) , a [ 5 ] , a [ 6 ] , a [ 7 ] }
607 push_opstack ( b )
608 elseif ta = = ' string ' then
609 local b = a
610 local a = pop_opstack ( )
611 if not a then
612 return ps_error ( ' stackunderflow ' )
613 end
614 if a [ 1 ] ~ = ' string ' then
615 return ps_error ( ' typecheck ' )
616 end
617 if b [ 6 ] < a [ 6 ] then
618 return ps_error ( ' rangecheck ' )
619 end
620 local access = b [ 2 ]
621 if access = = ' read-only ' or access = = ' noaccess ' then
622 return ps_error ( ' invalidaccess ' )
623 end
624 local thestring = get_VM ( b [ 4 ] )
625 local repl = get_VM ( a [ 4 ] )
626 VM [ b [ 4 ] ] = repl . . sub ( thestring , # repl + 1 , -1 )
627 b = { b [ 1 ] , b [ 2 ] , b [ 3 ] , add_VM ( repl ) , a [ 5 ] , b [ 6 ] }
628 push_opstack ( b )
629 else
630 return ps_error ( ' typecheck ' )
631 end
632 return true
633end
634
635function operators . index ( )
636 local a = pop_opstack ( )
637 if not a then
638 return ps_error ( ' stackunderflow ' )
639 end
640 local ta = a [ 1 ]
641 if not ta = = ' integer ' then
642 return ps_error ( ' typecheck ' )
643 end
644 local n = a [ 4 ]
645 if n < 0 then
646 return ps_error ( ' rangecheck ' )
647 end
648 if n > = opstackptr then
649 return ps_error ( ' stackunderflow ' )
650 end
651 push_opstack ( opstack [ opstackptr - n ] )
652 return true
653end
654
655function operators . roll ( )
656 local b = pop_opstack ( )
657 local a = pop_opstack ( )
658 if not a then
659 return ps_error ( ' stackunderflow ' )
660 end
661 if b [ 1 ] ~ = ' integer ' then
662 return ps_error ( ' typecheck ' )
663 end
664 if a [ 1 ] ~ = ' integer ' then
665 return ps_error ( ' typecheck ' )
666 end
667 local stackcount = a [ 4 ]
668 if stackcount < 0 then
669 return ps_error ( ' rangecheck ' )
670 end
671 if stackcount > opstackptr then
672 return ps_error ( ' stackunderflow ' )
673 end
674 local rollcount = b [ 4 ]
675 if rollcount = = 0 then
676 return true
677 end
678 if rollcount > 0 then
679
680 while rollcount > 0 do
681 local oldtop = opstack [ opstackptr ]
682 local n = 0
683 while n < stackcount do
684 opstack [ opstackptr - n ] = opstack [ opstackptr - n -1 ]
685 n = n + 1
686 end
687 opstack [ opstackptr - ( stackcount -1 ) ] = oldtop
688 rollcount = rollcount - 1
689 end
690 else
691
692 while rollcount < 0 do
693 local oldbot = opstack [ opstackptr - stackcount + 1 ]
694 local n = stackcount - 1
695 while n > 0 do
696 opstack [ opstackptr - n ] = opstack [ opstackptr - n + 1 ]
697 n = n - 1
698 end
699 opstack [ opstackptr ] = oldbot
700 rollcount = rollcount + 1
701 end
702 end
703 return true
704end
705
706function operators . clear ( )
707 opstack = { }
708 opstackptr = 0
709 return true
710end
711
712function operators . count ( )
713 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , opstackptr }
714 return true
715end
716
717function operators . mark ( )
718 push_opstack { ' mark ' , ' unlimited ' , ' literal ' , null }
719end
720
721operators . beginarray = operators . mark
722
723function operators . cleartomark ( )
724 while opstackptr > 0 do
725 local val = pop_opstack ( )
726 if not val then
727 return ps_error ( ' unmatchedmark ' )
728 end
729 if val [ 1 ] = = ' mark ' then
730 return true
731 end
732 end
733 return ps_error ( ' unmatchedmark ' )
734end
735
736function operators . counttomark ( )
737 local v = 0
738 for n = opstackptr , 1 , -1 do
739 if opstack [ n ] [ 1 ] = = ' mark ' then
740 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , v }
741 return true
742 end
743 v = v + 1
744 end
745 return ps_error ( ' unmatchedmark ' )
746end
747
748
749
750
751
752
753function operators . add ( )
754 local b = pop_opstack ( )
755 local a = pop_opstack ( )
756 if not a then
757 return ps_error ( ' stackunderflow ' )
758 end
759 local ta , tb = a [ 1 ] , b [ 1 ]
760 if not ( tb = = ' real ' or tb = = ' integer ' ) then
761 return ps_error ( ' typecheck ' )
762 end
763 if not ( ta = = ' real ' or ta = = ' integer ' ) then
764 return ps_error ( ' typecheck ' )
765 end
766 local c = a [ 4 ] + b [ 4 ]
767 push_opstack {
768 ( ta = = ' real ' or tb = = ' real ' or c > MAX_INT ) and " real " or " integer " ,
769 ' unlimited ' , ' literal ' , c
770 }
771 return true
772end
773
774function operators . sub ( )
775 local b = pop_opstack ( )
776 local a = pop_opstack ( )
777 if not a then
778 return ps_error ( ' stackunderflow ' )
779 end
780 local ta , tb = a [ 1 ] , b [ 1 ]
781 if not ( tb = = ' real ' or tb = = ' integer ' ) then
782 return ps_error ( ' typecheck ' )
783 end
784 if not ( ta = = ' real ' or ta = = ' integer ' ) then
785 return ps_error ( ' typecheck ' )
786 end
787 local c = a [ 4 ] - b [ 4 ]
788 push_opstack {
789 ( ta = = ' real ' or tb = = ' real ' or c > MAX_INT ) and " real " or " integer " ,
790 ' unlimited ' , ' literal ' , c
791 }
792 return true
793end
794
795function operators . div ( )
796 local b = pop_opstack ( )
797 local a = pop_opstack ( )
798 if not a then
799 return ps_error ( ' stackunderflow ' )
800 end
801 local ta , tb = a [ 1 ] , b [ 1 ]
802 if not ( tb = = ' real ' or tb = = ' integer ' ) then
803 return ps_error ( ' typecheck ' )
804 end
805 if not ( ta = = ' real ' or ta = = ' integer ' ) then
806 return ps_error ( ' typecheck ' )
807 end
808 local va , vb = a [ 4 ] , b [ 4 ]
809 if vb = = 0 then
810 return ps_error ( ' undefinedresult ' )
811 end
812 push_opstack { ' real ' , ' unlimited ' , ' literal ' , va / vb }
813 return true
814end
815
816function operators . idiv ( )
817 local b = pop_opstack ( )
818 local a = pop_opstack ( )
819 if not a then
820 return ps_error ( ' stackunderflow ' )
821 end
822 local ta , tb = a [ 1 ] , b [ 1 ]
823 if tb ~ = ' integer ' then
824 return ps_error ( ' typecheck ' )
825 end
826 if ta ~ = ' integer ' then
827 return ps_error ( ' typecheck ' )
828 end
829 local va , vb = a [ 4 ] , b [ 4 ]
830 if vb = = 0 then
831 return ps_error ( ' undefinedresult ' )
832 end
833 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , floor ( va / vb ) }
834 return true
835end
836
837function operators . mod ( )
838 local b = pop_opstack ( )
839 local a = pop_opstack ( )
840 if not a then
841 return ps_error ( ' stackunderflow ' )
842 end
843 local ta , tb = a [ 1 ] , b [ 1 ]
844 if tb ~ = ' integer ' then
845 return ps_error ( ' typecheck ' )
846 end
847 if ta ~ = ' integer ' then
848 return ps_error ( ' typecheck ' )
849 end
850 local va , vb = a [ 4 ] , b [ 4 ]
851 if vb = = 0 then
852 return ps_error ( ' undefinedresult ' )
853 end
854 local neg = false
855 local v
856 if va < 0 then
857 v = - va
858 neg = true
859 else
860 v = va
861 end
862 local c = v % abs ( vb )
863 if neg then
864 c = - c
865 end
866 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , c }
867 return true
868end
869
870function operators . mul ( )
871 local b = pop_opstack ( )
872 local a = pop_opstack ( )
873 if not a then
874 return ps_error ( ' stackunderflow ' )
875 end
876 local ta , tb = a [ 1 ] , b [ 1 ]
877 if not ( tb = = ' real ' or tb = = ' integer ' ) then
878 return ps_error ( ' typecheck ' )
879 end
880 if not ( ta = = ' real ' or ta = = ' integer ' ) then
881 return ps_error ( ' typecheck ' )
882 end
883 local c = a [ 4 ] * b [ 4 ]
884 push_opstack {
885 ( ta = = ' real ' or tb = = ' real ' or abs ( c ) > MAX_INT ) and ' real ' or ' integer ' ,
886 ' unlimited ' , ' literal ' , c
887 }
888 return true
889end
890
891function operators . abs ( )
892 local a = pop_opstack ( )
893 if not a then
894 return ps_error ( ' stackunderflow ' )
895 end
896 local ta = a [ 1 ]
897 if not ( ta = = ' real ' or ta = = ' integer ' ) then
898 return ps_error ( ' typecheck ' )
899 end
900 local v = a [ 4 ]
901 local c = abs ( v )
902 push_opstack {
903 ( ta = = ' real ' or v = = - ( MAX_INT + 1 ) ) and ' real ' or ' integer ' ,
904 ' unlimited ' , ' literal ' , c
905 }
906 return true
907end
908
909function operators . neg ( )
910 local a = pop_opstack ( )
911 if not a then
912 return ps_error ( ' stackunderflow ' )
913 end
914 local ta = a [ 1 ]
915 if not ( ta = = ' real ' or ta = = ' integer ' ) then
916 return ps_error ( ' typecheck ' )
917 end
918 local v = a [ 4 ]
919 push_opstack {
920 ( ta = = ' real ' or v = = - ( MAX_INT + 1 ) ) and ' real ' or ' integer ' ,
921 ' unlimited ' , ' literal ' , - v
922 }
923 return true
924end
925
926function operators . ceiling ( )
927 local a = pop_opstack ( )
928 if not a then
929 return ps_error ( ' stackunderflow ' )
930 end
931 local ta = a [ 1 ]
932 if not ( ta = = ' real ' or ta = = ' integer ' ) then
933 return ps_error ( ' typecheck ' )
934 end
935 local c = ceil ( a [ 4 ] )
936 push_opstack { ta , ' unlimited ' , ' literal ' , c }
937 return true
938end
939
940function operators . floor ( )
941 local a = pop_opstack ( )
942 if not a then
943 return ps_error ( ' stackunderflow ' )
944 end
945 local ta = a [ 1 ]
946 if not ( ta = = ' real ' or ta = = ' integer ' ) then
947 return ps_error ( ' typecheck ' )
948 end
949 local c = floor ( a [ 4 ] )
950 push_opstack { ta , ' unlimited ' , ' literal ' , c }
951 return true
952end
953
954function operators . round ( )
955 local a = pop_opstack ( )
956 if not a then
957 return ps_error ( ' stackunderflow ' )
958 end
959 local ta = a [ 1 ]
960 if not ( ta = = ' real ' or ta = = ' integer ' ) then
961 return ps_error ( ' typecheck ' )
962 end
963 local c = floor ( a [ 4 ] + 0 . 5 )
964 push_opstack { ta , ' unlimited ' , ' literal ' , c }
965 return true
966end
967
968function operators . truncate ( )
969 local a = pop_opstack ( )
970 if not a then
971 return ps_error ( ' stackunderflow ' )
972 end
973 local ta = a [ 1 ]
974 if not ( ta = = ' real ' or ta = = ' integer ' ) then
975 return ps_error ( ' typecheck ' )
976 end
977 local v = a [ 4 ]
978 local c = v < 0 and - floor ( - v ) or floor ( v )
979 push_opstack { ta , ' unlimited ' , ' literal ' , c }
980 return true
981end
982
983function operators . sqrt ( )
984 local a = pop_opstack ( )
985 if not a then
986 return ps_error ( ' stackunderflow ' )
987 end
988 local ta = a [ 1 ]
989 if not ( ta = = ' real ' or ta = = ' integer ' ) then
990 return ps_error ( ' typecheck ' )
991 end
992 local v = a [ 4 ]
993 if v < 0 then
994 return ps_error ( ' rangecheck ' )
995 end
996 local c = sqrt ( v )
997 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
998 return true
999end
1000
1001function operators . atan ( )
1002 local b = pop_opstack ( )
1003 local a = pop_opstack ( )
1004 if not a then
1005 return ps_error ( ' stackunderflow ' )
1006 end
1007 local ta , tb = a [ 1 ] , b [ 1 ]
1008 if not ( tb = = ' real ' or tb = = ' integer ' ) then
1009 return ps_error ( ' typecheck ' )
1010 end
1011 if not ( ta = = ' real ' or ta = = ' integer ' ) then
1012 return ps_error ( ' typecheck ' )
1013 end
1014 local va , vb = a [ 4 ] , b [ 4 ]
1015 if va = = 0 and vb = = 0 then
1016 return ps_error ( ' undefinedresult ' )
1017 end
1018 local c = deg ( atan2 ( rad ( va ) , rad ( vb ) ) )
1019 if c < 0 then
1020 c = c + 360
1021 end
1022 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
1023 return true
1024end
1025
1026function operators . sin ( )
1027 local a = pop_opstack ( )
1028 if not a then
1029 return ps_error ( ' stackunderflow ' )
1030 end
1031 local ta = a [ 1 ]
1032 if not ( ta = = ' real ' or ta = = ' integer ' ) then
1033 return ps_error ( ' typecheck ' )
1034 end
1035 local c = sin ( rad ( a [ 4 ] ) )
1036
1037 if abs ( c ) < 1.0e-16 then
1038 c = 0
1039 end
1040 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
1041 return true
1042end
1043
1044function operators . cos ( )
1045 local a = pop_opstack ( )
1046 if not a then
1047 return ps_error ( ' stackunderflow ' )
1048 end
1049 local ta = a [ 1 ]
1050 if not ( ta = = ' real ' or ta = = ' integer ' ) then
1051 return ps_error ( ' typecheck ' )
1052 end
1053 local c = cos ( rad ( a [ 4 ] ) )
1054
1055 if abs ( c ) < 1.0e-16 then
1056 c = 0
1057 end
1058 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
1059 return true
1060end
1061
1062function operators . exp ( )
1063 local b = pop_opstack ( )
1064 local a = pop_opstack ( )
1065 if not a then
1066 return ps_error ( ' stackunderflow ' )
1067 end
1068 local ta , tb = a [ 1 ] , b [ 1 ]
1069 if not ( ta = = ' real ' or ta = = ' integer ' ) then
1070 return ps_error ( ' typecheck ' )
1071 end
1072 if not ( tb = = ' real ' or tb = = ' integer ' ) then
1073 return ps_error ( ' typecheck ' )
1074 end
1075 local va , vb = a [ 4 ] , b [ 4 ]
1076 if va < 0 and floor ( vb ) ~ = vb then
1077 return ps_error ( ' undefinedresult ' )
1078 end
1079 local c = pow ( va , vb )
1080 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
1081 return true
1082end
1083
1084function operators . ln ( )
1085 local a = pop_opstack ( )
1086 if not a then
1087 return ps_error ( ' stackunderflow ' )
1088 end
1089 local ta = a [ 1 ]
1090 if not ( ta = = ' real ' or ta = = ' integer ' ) then
1091 return ps_error ( ' typecheck ' )
1092 end
1093 local v = a [ 4 ]
1094 if v < = 0 then
1095 return ps_error ( ' undefinedresult ' )
1096 end
1097 local c = log ( v )
1098 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
1099 return true
1100end
1101
1102function operators . log ( )
1103 local a = pop_opstack ( )
1104 if not a then
1105 return ps_error ( ' stackunderflow ' )
1106 end
1107 local ta = a [ 1 ]
1108 if not ( ta = = ' real ' or ta = = ' integer ' ) then
1109 return ps_error ( ' typecheck ' )
1110 end
1111 local v = a [ 4 ]
1112 if v < = 0 then
1113 return ps_error ( ' undefinedresult ' )
1114 end
1115 local c = log10 ( v )
1116 push_opstack { ' real ' , ' unlimited ' , ' literal ' , c }
1117 return true
1118end
1119
1120escrito . randomseed = os . time ( )
1121
1122
1123
1124function operators . rand ( )
1125 local c = random ( MAX_INT ) - 1
1126 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , c }
1127 return true
1128end
1129
1130function operators . srand ( )
1131 local a = pop_opstack ( )
1132 if not a then
1133 return ps_error ( ' stackunderflow ' )
1134 end
1135 local ta = a [ 1 ]
1136 if ta ~ = ' integer ' then
1137 return ps_error ( ' typecheck ' )
1138 end
1139 escrito . randomseed = a [ 4 ]
1140 setranseed ( escrito . randomseed )
1141 return true
1142end
1143
1144function operators . rrand ( )
1145 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , escrito . randomseed }
1146 return true
1147end
1148
1149
1150
1151
1152
1153function operators . array ( )
1154 local a = pop_opstack ( )
1155 if not a then
1156 return ps_error ( ' stackunderflow ' )
1157 end
1158 local t = a [ 1 ]
1159 local v = a [ 4 ]
1160 if t ~ = ' integer ' then
1161 return ps_error ( ' typecheck ' )
1162 end
1163 if v < 0 then
1164 return ps_error ( ' rangecheck ' )
1165 end
1166 local array = { }
1167 for i = 1 , v do
1168 array [ n ] = { ' null ' , ' unlimited ' , ' literal ' , true }
1169 end
1170 push_opstack { ' array ' , ' unlimited ' , ' literal ' , add_VM ( array ) , 0 , v , ' d ' }
1171end
1172
1173function operators . endarray ( )
1174 local n = opstackptr
1175 while n > 0 do
1176 if opstack [ n ] [ 1 ] = = ' mark ' then
1177 break
1178 end
1179 n = n - 1
1180 end
1181 if n = = 0 then
1182 return ps_error ( ' unmatchedmark ' )
1183 end
1184 local top = opstackptr
1185 local i = opstackptr - n
1186 local array = { }
1187 while i > 0 do
1188 array [ i ] = pop_opstack ( )
1189 i = i - 1
1190 end
1191 pop_opstack ( )
1192 push_opstack { ' array ' , ' unlimited ' , ' literal ' , add_VM ( array ) , # array , # array , ' d ' }
1193end
1194
1195function operators . length ( )
1196 local a = pop_opstack ( )
1197 if not a then
1198 return ps_error ( ' stackunderflow ' )
1199 end
1200 local access = a [ 2 ]
1201 if access = = " noaccess " or access = = " executeonly " then
1202 return ps_error ( ' invalidaccess ' )
1203 end
1204 local ta = a [ 1 ]
1205 local va = a [ 4 ]
1206 if ta = = " dict " or ta = = " font " then
1207 va = get_VM ( va ) . size
1208 elseif ta = = " array " or ta = = " string " then
1209 va = get_VM ( va )
1210 va = # va
1211 else
1212 return ps_error ( ' typecheck ' )
1213 end
1214 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , va }
1215 return true
1216end
1217
1218function operators . get ( )
1219 local b = pop_opstack ( )
1220 local a = pop_opstack ( )
1221 if not a then
1222 return ps_error ( ' stackunderflow ' )
1223 end
1224 local access = a [ 2 ]
1225 if access = = " noaccess " or access = = " execute-only " then
1226 return ps_error ( ' invalidaccess ' )
1227 end
1228 local ta = a [ 1 ]
1229 local va = a [ 4 ]
1230 if ta = = " dict " then
1231 local dict = get_VM ( va )
1232 local key = b
1233 local tb = b [ 1 ]
1234 local vb = b [ 4 ]
1235 if tb = = " string " or tb = = " name " then
1236 key = get_VM ( vb )
1237 end
1238 local ddk = dict . dict [ key ]
1239 if ddk then
1240 push_opstack ( ddk )
1241 else
1242 return ps_error ( ' undefined ' )
1243 end
1244 elseif ta = = " array " then
1245 local tb = b [ 1 ]
1246 local vb = b [ 4 ]
1247 if tb ~ = ' integer ' then
1248 return ps_error ( ' typecheck ' )
1249 end
1250 if vb < 0 or vb > = a [ 6 ] then
1251 return ps_error ( ' rangecheck ' )
1252 end
1253 local array = get_VM ( va )
1254 local index = vb + 1
1255 push_opstack ( array [ index ] )
1256 elseif ta = = " string " then
1257 local tb = b [ 1 ]
1258 local vb = b [ 4 ]
1259 if tb ~ = ' integer ' then
1260 return ps_error ( ' typecheck ' )
1261 end
1262 if vb < 0 or vb > = a [ 6 ] then
1263 return ps_error ( ' rangecheck ' )
1264 end
1265 local thestring = get_VM ( va )
1266 local index = vb + 1
1267 local c = sub ( thestring , index , index )
1268 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , byte ( c ) }
1269 else
1270 return ps_error ( ' typecheck ' )
1271 end
1272 return true
1273end
1274
1275function operators . put ( )
1276 local c = pop_opstack ( )
1277 local b = pop_opstack ( )
1278 local a = pop_opstack ( )
1279 if not a then
1280 return ps_error ( ' stackunderflow ' )
1281 end
1282 local ta = a [ 1 ]
1283 if ta = = " dict " then
1284 local dict = get_VM ( a [ 4 ] )
1285 if dict . access ~ = ' unlimited ' then
1286 return ps_error ( ' invalidaccess ' )
1287 end
1288 local key = b
1289 local bt = b [ 1 ]
1290 if bt = = " string " or bt = = " name " then
1291 key = get_VM ( b [ 4 ] )
1292 end
1293 local dd = dict . dict
1294 local ds = dict . size
1295 local ddk = dd [ key ]
1296 if not ddk and ( ds = = dict . maxsize ) then
1297 return ps_error ( ' dictfull ' )
1298 end
1299 if c [ 1 ] = = ' array ' then
1300 c [ 7 ] = ' i '
1301 end
1302 if not ddk then
1303 dict . size = ds + 1
1304 end
1305 dd [ key ] = c
1306 elseif ta = = " array " then
1307 if a [ 2 ] ~ = ' unlimited ' then
1308 return ps_error ( ' invalidaccess ' )
1309 end
1310 if b [ 1 ] ~ = ' integer ' then
1311 return ps_error ( ' typecheck ' )
1312 end
1313 local va , vb = a [ 4 ] , b [ 4 ]
1314 if vb < 0 or vb > = a [ 6 ] then
1315 return ps_error ( ' rangecheck ' )
1316 end
1317 local vm = VM [ va ]
1318 local vi = bv + 1
1319 if vm [ vi ] [ 1 ] = = ' null ' then
1320 a [ 5 ] = a [ 5 ] + 1
1321 end
1322 vm [ vi ] = c
1323 elseif ta = = " string " then
1324 if a [ 2 ] ~ = ' unlimited ' then
1325 return ps_error ( ' invalidaccess ' )
1326 end
1327 if b [ 1 ] ~ = ' integer ' then
1328 return ps_error ( ' typecheck ' )
1329 end
1330 if c [ 1 ] ~ = ' integer ' then
1331 return ps_error ( ' typecheck ' )
1332 end
1333 local va , vb , vc = a [ 4 ] , b [ 4 ] , c [ 4 ]
1334 if vb < 0 or vb > = a [ 6 ] then
1335 return ps_error ( ' rangecheck ' )
1336 end
1337 if vc < 0 or vc > 255 then
1338 return ps_error ( ' rangecheck ' )
1339 end
1340 local thestring = get_VM ( va )
1341 VM [ va ] = sub ( thestring , 1 , vb ) . . char ( vc ) . . sub ( thestring , vb + 2 )
1342 else
1343 return ps_error ( ' typecheck ' )
1344 end
1345 return true
1346end
1347
1348function operators . getinterval ( )
1349 local c = pop_opstack ( )
1350 local b = pop_opstack ( )
1351 local a = pop_opstack ( )
1352 if not a then
1353 return ps_error ( ' stackunderflow ' )
1354 end
1355 local ta , tb , tc = a [ 1 ] , b [ 1 ] , c [ 1 ]
1356 local aa , ab , ac = a [ 2 ] , b [ 2 ] , c [ 2 ]
1357 local va , vb , vc = a [ 4 ] , b [ 4 ] , c [ 4 ]
1358 if ta ~ = " array " and ta ~ = ' string ' then
1359 return ps_error ( ' typecheck ' )
1360 end
1361 if tb ~ = ' integer ' or tc ~ = ' integer ' then
1362 return ps_error ( ' typecheck ' )
1363 end
1364 if aa = = " execute-only " or aa = = ' noaccess ' then
1365 return ps_error ( ' invalidaccess ' )
1366 end
1367 if vb < 0 or vc < 0 or vb + vc > = a [ 6 ] then
1368 return ps_error ( ' rangecheck ' )
1369 end
1370
1371
1372 if ta = = ' array ' then
1373 local array = get_VM ( va )
1374 local subarray = { }
1375 local index = 1
1376 while index < = vc do
1377 subarray [ index ] = array [ index + vb ]
1378 index = index + 1
1379 end
1380 push_opstack { ' array ' , aa , a [ 3 ] , add_VM ( subarray ) , vc , vc , ' d ' }
1381 else
1382 local thestring = get_VM ( va )
1383 local newstring = sub ( thestring , vb + 1 , vb + vc )
1384 push_opstack { ' string ' , aa , a [ 3 ] , add_VM ( newstring ) , vc , vc }
1385 end
1386 return true
1387end
1388
1389function operators . putinterval ( )
1390 local c = pop_opstack ( )
1391 local b = pop_opstack ( )
1392 local a = pop_opstack ( )
1393 if not a then
1394 return ps_error ( ' stackunderflow ' )
1395 end
1396 local ta , tb , tc = a [ 1 ] , b [ 1 ] , c [ 1 ]
1397 local aa , ab , ac = a [ 2 ] , b [ 2 ] , c [ 2 ]
1398 local va , vb , vc = a [ 4 ] , b [ 4 ] , c [ 4 ]
1399 if ta ~ = " array " and ta ~ = ' string ' then
1400 return ps_error ( ' typecheck ' )
1401 end
1402 if tc ~ = " array " and tc ~ = ' string ' then
1403 return ps_error ( ' typecheck ' )
1404 end
1405 if ta ~ = tc then
1406 return ps_error ( ' typecheck ' )
1407 end
1408 if aa ~ = " unlimited " then
1409 return ps_error ( ' invalidaccess ' )
1410 end
1411 if tb ~ = ' integer ' then
1412 return ps_error ( ' typecheck ' )
1413 end
1414 if vb < 0 or vb + c [ 6 ] > = a [ 6 ] then
1415 return ps_error ( ' rangecheck ' )
1416 end
1417 if ta = = ' array ' then
1418 local newarr = get_VM ( vc )
1419 local oldarr = get_VM ( va )
1420 local index = 1
1421 local lastindex = c [ 6 ]
1422 local step = a [ 5 ]
1423 while index < = lastindex do
1424 if oldarr [ vb + index ] [ 1 ] = = ' null ' then
1425 a [ 5 ] = a [ 5 ] + 1
1426
1427 end
1428 oldarr [ vb + index ] = newarr [ index ]
1429 index = index + 1
1430 end
1431 else
1432 local thestring = get_VM ( va )
1433 VM [ va ] = sub ( thestring , 1 , vb ) . . get_VM ( vc ) . . sub ( thestring , vb + c [ 6 ] + 1 )
1434 end
1435 return true
1436end
1437
1438function operators . aload ( )
1439 local a = pop_opstack ( )
1440 if not a then
1441 return ps_error ( ' stackunderflow ' )
1442 end
1443 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1444 if ta ~ = " array " then
1445 return ps_error ( ' typecheck ' )
1446 end
1447 if aa = = " execute-only " or aa = = ' noaccess ' then
1448 return ps_error ( ' invalidaccess ' )
1449 end
1450 local array = get_VM ( va )
1451 for i = 1 , # array do
1452 push_opstack ( array [ i ] )
1453 end
1454 push_opstack ( a )
1455 return true
1456end
1457
1458function operators . astore ( )
1459 local a = pop_opstack ( )
1460 if not a then
1461 return ps_error ( ' stackunderflow ' )
1462 end
1463 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1464 if ta ~ = " array " then
1465 return ps_error ( ' typecheck ' )
1466 end
1467 if aa = = " execute-only " or aa = = ' noaccess ' then
1468 return ps_error ( ' invalidaccess ' )
1469 end
1470 local array = get_VM ( va )
1471 local count = a [ 6 ]
1472 for i = 1 , count do
1473 local v = pop_opstack ( )
1474 if not v then
1475 return ps_error ( ' stackunderflow ' )
1476 end
1477 array [ i ] = v
1478 end
1479 a [ 5 ] = a [ 5 ] + count
1480 push_opstack ( a )
1481 return true
1482end
1483
1484function operators . forall ( )
1485 local b = pop_opstack ( )
1486 local a = pop_opstack ( )
1487 if not a then
1488 return ps_error ( ' stackunderflow ' )
1489 end
1490 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1491 local tb , ab , vb = b [ 1 ] , b [ 2 ] , b [ 4 ]
1492 if not tb = = " array " and b [ 3 ] = = ' executable ' then
1493 return ps_error ( ' typecheck ' )
1494 end
1495 if tb = = ' noaccess ' then
1496 return ps_error ( ' invalidaccess ' )
1497 end
1498 if not ( ta = = " array " or ta = = ' dict ' or ta = = ' string ' or ta = = " font " ) then
1499 return ps_error ( ' typecheck ' )
1500 end
1501 if aa = = " execute-only " or aa = = ' noaccess ' then
1502 return ps_error ( ' invalidaccess ' )
1503 end
1504 push_execstack { ' .exit ' , ' unlimited ' , ' literal ' , false }
1505 local curstack = execstackptr
1506 if ta = = ' array ' then
1507 if a [ 6 ] = = 0 then
1508 return true
1509 end
1510 b [ 7 ] = ' i '
1511 local thearray = get_VM ( va )
1512 for i = 1 , # thearray do
1513 if stopped then
1514 stopped = false
1515 return false
1516 end
1517 push_opstack ( thearray [ i ] )
1518 b [ 5 ] = 1
1519 push_execstack ( b )
1520 while curstack < = execstackptr do
1521 do_exec ( )
1522 end
1523 end
1524 local entry = execstack [ execstackptr ]
1525 if entry [ 1 ] = = ' .exit ' and antry [ 4 ] = = true then
1526 pop_execstack ( )
1527 return true
1528 end
1529 elseif ta = = ' dict ' or ta = = ' font ' then
1530 local thedict = get_VM ( va )
1531 if thedict . size = = 0 then
1532 return true
1533 end
1534 b [ 7 ] = ' i '
1535 local thedict = get_VM ( va )
1536 for k , v in next , thedict . dict do
1537 if stopped then
1538 stopped = false
1539 return false
1540 end
1541 if type ( k ) = = " string " then
1542 push_opstack { ' name ' , ' unlimited ' , ' literal ' , add_VM ( k ) }
1543 else
1544 push_opstack ( k )
1545 end
1546 push_opstack ( v )
1547 b [ 5 ] = 1
1548 push_execstack ( b )
1549 while curstack < execstackptr do
1550 do_exec ( )
1551 end
1552 local entry = execstack [ execstackptr ]
1553 if entry [ 1 ] = = ' .exit ' and antry [ 4 ] = = true then
1554 pop_execstack ( )
1555 return true
1556 end
1557 end
1558 else
1559 if a [ 6 ] = = 0 then
1560 return true
1561 end
1562 b [ 7 ] = ' i '
1563 local thestring = get_VM ( va )
1564 for v in gmatch ( thestring , " . " ) do
1565 if stopped then
1566 stopped = false
1567 return false
1568 end
1569 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , byte ( v ) }
1570 b [ 5 ] = 1
1571 push_execstack ( b )
1572 while curstack < execstackptr do
1573 do_exec ( )
1574 end
1575 local entry = execstack [ execstackptr ]
1576 if entry [ 1 ] = = ' .exit ' and antry [ 4 ] = = true then
1577 pop_execstack ( )
1578 return true ;
1579 end
1580 end
1581 end
1582 return true
1583end
1584
1585
1586
1587
1588
1589
1590function operators . dict ( )
1591 local a = pop_opstack ( )
1592 if not a then
1593 return ps_error ( ' stackunderflow ' )
1594 end
1595 if not a [ 1 ] = = ' integer ' then
1596 return ps_error ( ' typecheck ' )
1597 end
1598 local s = a [ 4 ]
1599 if s < 0 then
1600 return ps_error ( ' rangecheck ' )
1601 end
1602 if s = = 0 then
1603 s = MAX_INT
1604 end
1605 push_opstack {
1606 ' dict ' ,
1607 ' unlimited ' ,
1608 ' literal ' ,
1609 add_VM {
1610 access = ' unlimited ' ,
1611 size = 0 ,
1612 maxsize = s ,
1613 dict = { } ,
1614 }
1615 }
1616end
1617
1618function operators . maxlength ( )
1619 local a = pop_opstack ( )
1620 if not a then
1621 return ps_error ( ' stackunderflow ' )
1622 end
1623 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1624 if ta ~ = ' dict ' then
1625 return ps_error ( ' typecheck ' )
1626 end
1627 if aa = = ' execute-only ' or aa = = ' noaccess ' then
1628 return ps_error ( ' invalidaccess ' )
1629 end
1630 local thedict = get_VM ( va )
1631 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , thedict . maxsize }
1632end
1633
1634function operators . begin ( )
1635 local a = pop_opstack ( )
1636 if not a then
1637 return ps_error ( ' stackunderflow ' )
1638 end
1639 if a [ 1 ] ~ = ' dict ' then
1640 return ps_error ( ' typecheck ' )
1641 end
1642 dictstackptr = dictstackptr + 1
1643 dictstack [ dictstackptr ] = a [ 4 ]
1644end
1645
1646operators [ " end " ] = function ( )
1647 if dictstackptr < 3 then
1648 return ps_error ( ' dictstackunderflow ' )
1649 end
1650 dictstack [ dictstackptr ] = nil
1651 dictstackptr = dictstackptr - 1
1652end
1653
1654function operators . def ( )
1655 local b = pop_opstack ( )
1656 local a = pop_opstack ( )
1657 if not a then
1658 return ps_error ( ' stackunderflow ' )
1659 end
1660 if not ( a [ 1 ] = = ' name ' and a [ 3 ] = = ' literal ' ) then
1661 return ps_error ( ' typecheck ' )
1662 end
1663 if b [ 1 ] = = ' array ' then
1664 b [ 7 ] = ' i '
1665 end
1666 local thedict = get_VM ( dictstack [ dictstackptr ] )
1667 if not thedict . dict [ get_VM ( a [ 4 ] ) ] then
1668 if thedict . size = = thedict . maxsize then
1669
1670 end
1671 thedict . size = thedict . size + 1
1672 end
1673 thedict . dict [ get_VM ( a [ 4 ] ) ] = b
1674 return true
1675end
1676
1677
1678
1679function operators . load ( )
1680 local a = pop_opstack ( )
1681 if not a then
1682 return ps_error ( ' stackunderflow ' )
1683 end
1684 local aa = a [ 2 ]
1685 if aa = = ' noaccess ' or aa = = ' execute-only ' then
1686 return ps_error ( ' invalidaccess ' )
1687 end
1688 local v = lookup ( get_VM ( a [ 4 ] ) )
1689 if not v then
1690 return ps_error ( ' undefined ' )
1691 end
1692 push_opstack ( v )
1693end
1694
1695function operators . store ( )
1696 local b = pop_opstack ( )
1697 local a = pop_opstack ( )
1698 if not a then
1699 return ps_error ( ' stackunderflow ' )
1700 end
1701 if not ( a [ 1 ] = = ' name ' and a [ 3 ] = = ' literal ' ) then
1702 return ps_error ( ' typecheck ' )
1703 end
1704 if b [ 7 ] = = ' array ' then
1705 b [ 7 ] = ' i '
1706 end
1707 local val , dictloc = lookup ( a [ 4 ] )
1708 if val then
1709 local thedict = get_VM ( dictstack [ dictloc ] )
1710 if thedict . access = = ' execute-only ' or thedict . access = = ' noaccess ' then
1711 return ps_error ( ' invalidaccess ' )
1712 end
1713 thedict . dict [ a [ 4 ] ] = b
1714 else
1715 local thedict = get_VM ( dictstack [ dictstackptr ] )
1716 local access = thedict . access
1717 local size = thedict . size
1718 if access = = ' execute-only ' or access = = ' noaccess ' then
1719 return ps_error ( ' invalidaccess ' )
1720 end
1721 if size = = thedict . maxsize then
1722 return ps_error ( ' dictfull ' )
1723 end
1724 thedict . size = size + 1
1725 thedict . dict [ a [ 4 ] ] = b
1726 end
1727 return true
1728end
1729
1730function operators . known ( )
1731 local b = pop_opstack ( )
1732 local a = pop_opstack ( )
1733 if not a then
1734 return ps_error ( ' stackunderflow ' )
1735 end
1736 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1737 local tb , vb = b [ 1 ] , b [ 4 ]
1738 if ta ~ = ' dict ' then
1739 return ps_error ( ' typecheck ' )
1740 end
1741 if not ( tb = = ' name ' or tb = = ' operator ' ) then
1742 return ps_error ( ' typecheck ' )
1743 end
1744 if aa = = ' noaccess ' or aa = = ' execute-only ' then
1745 return ps_error ( ' invalidaccess ' )
1746 end
1747 local thedict = get_VM ( va )
1748 push_opstack { ' boolean ' , ' unlimited ' , ' literal ' , thedict . dict [ vb ] and true or false }
1749 return true
1750end
1751
1752function operators . where ( )
1753 local a = pop_opstack ( )
1754 if not a then
1755 return ps_error ( ' stackunderflow ' )
1756 end
1757 if not ( a [ 1 ] = = ' name ' and a [ 3 ] = = ' literal ' ) then
1758 return ps_error ( ' typecheck ' )
1759 end
1760 local val , dictloc = lookup ( get_VM ( a [ 4 ] ) )
1761 local thedict = dictloc and get_VM ( dictstack [ dictloc ] )
1762 if val then
1763 if thedict . access = = ' execute-only ' or thedict . access = = ' noaccess ' then
1764 return ps_error ( ' invalidaccess ' )
1765 end
1766 push_opstack { ' dict ' , ' unlimited ' , ' literal ' , dictstack [ dictloc ] }
1767 push_opstack { ' boolean ' , ' unlimited ' , ' literal ' , true }
1768 else
1769 push_opstack { ' boolean ' , ' unlimited ' , ' literal ' , false }
1770 end
1771 return true
1772end
1773
1774function operators . currentdict ( )
1775 push_opstack { ' dict ' , ' unlimited ' , ' literal ' , dictstack [ dictstackptr ] }
1776 return true
1777end
1778
1779function operators . countdictstack ( )
1780 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , dictstackptr }
1781 return true
1782end
1783
1784function operators . dictstack ( )
1785 local a = pop_opstack ( )
1786 if not a then
1787 return ps_error ( ' stackunderflow ' )
1788 end
1789 if not a [ 1 ] = = ' array ' then
1790 return ps_error ( ' typecheck ' )
1791 end
1792 if not a [ 2 ] = = ' unlimited ' then
1793 return ps_error ( ' invalidaccess ' )
1794 end
1795 if a [ 6 ] < dictstackptr then
1796 return ps_error ( ' rangecheck ' )
1797 end
1798 local thearray = get_VM ( a [ 4 ] )
1799 local subarray = { }
1800 for i = 1 , dictstackptr do
1801 thearray [ n ] = { ' dict ' , ' unlimited ' , ' literal ' , dictstack [ i ] }
1802 subarray [ n ] = thearray [ i ]
1803 end
1804 a [ 5 ] = a [ 5 ] + dictstackptr
1805 push_opstack { ' array ' , ' unlimited ' , ' literal ' , add_VM ( subarray ) , dictstackptr , dictstackptr , ' ' }
1806 return true
1807end
1808
1809
1810
1811
1812
1813
1814function operators . string ( )
1815 local a = pop_opstack ( )
1816 if not a then
1817 return ps_error ( ' stackunderflow ' )
1818 end
1819 local ta , va = a [ 1 ] , a [ 4 ]
1820 if ta ~ = ' integer ' then
1821 return ps_error ( ' typecheck ' )
1822 end
1823 if va < 0 then
1824 return ps_error ( ' rangecheck ' )
1825 end
1826 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( ' ' ) , 1 , va }
1827end
1828
1829function operators . anchorsearch ( )
1830 local b = pop_opstack ( )
1831 local a = pop_opstack ( )
1832 if not a then
1833 return ps_error ( ' stackunderflow ' )
1834 end
1835 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1836 local tb , ab , vb = b [ 1 ] , b [ 2 ] , b [ 4 ]
1837 if not ta ~ = ' string ' then
1838 return ps_error ( ' typecheck ' )
1839 end
1840 if tb ~ = ' string ' then
1841 return ps_error ( ' typecheck ' )
1842 end
1843 if aa = = ' noaccess ' or aa = = ' execute-only ' then
1844 return ps_error ( ' invalidaccess ' )
1845 end
1846 if ab = = ' noaccess ' or ab = = ' execute-only ' then
1847 return ps_error ( ' invalidaccess ' )
1848 end
1849 local thestring = get_VM ( va )
1850 local thesearch = get_VM ( vb )
1851 local prefix = sub ( thestring , 1 , # thesearch )
1852 if prefix = = thesearch then
1853 if aa = = ' read-only ' then
1854 return ps_error ( ' invalidaccess ' )
1855 end
1856 local post = sub ( thestring , # thesearch + 1 )
1857 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( post ) , 1 , # post }
1858 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( prefix ) , 1 , # prefix }
1859 push_opstack ( b_true )
1860 else
1861 push_opstack ( a )
1862 push_opstack ( b_false )
1863 end
1864 return true
1865end
1866
1867function operators . search ( )
1868 local b = pop_opstack ( )
1869 local a = pop_opstack ( )
1870 if not a then
1871 return ps_error ( ' stackunderflow ' )
1872 end
1873 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1874 local tb , ab , vb = b [ 1 ] , b [ 2 ] , b [ 4 ]
1875 if not ta ~ = ' string ' then
1876 return ps_error ( ' typecheck ' )
1877 end
1878 if tb ~ = ' string ' then
1879 return ps_error ( ' typecheck ' )
1880 end
1881 if aa = = ' noaccess ' or aa = = ' execute-only ' then
1882 return ps_error ( ' invalidaccess ' )
1883 end
1884 if ab = = ' noaccess ' or ab = = ' execute-only ' then
1885 return ps_error ( ' invalidaccess ' )
1886 end
1887 local thestring = get_VM ( a [ 4 ] )
1888 local thesearch = get_VM ( b [ 4 ] )
1889
1890 local n = 1
1891 local match
1892 while n + # thesearch -1 < = # thestring do
1893 match = sub ( thestring , n , n + # thesearch -1 )
1894 if match = = thesearch then
1895 break
1896 end
1897 n = n + 1
1898 end
1899 if match = = thesearch then
1900 if aa = = ' read-only ' then
1901 return ps_error ( ' invalidaccess ' )
1902 end
1903 local prefix = sub ( thestring , 1 , n -1 )
1904 local post = sub ( thestring , # thesearch + n )
1905 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( post ) , 1 , # post }
1906 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( thesearch ) , 1 , # thesearch }
1907 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( prefix ) , 1 , # prefix }
1908 push_opstack ( b_true )
1909 else
1910 push_opstack ( a )
1911 push_opstack ( b_false )
1912 end
1913 return true
1914end
1915
1916function operators . token ( )
1917 local a = pop_opstack ( )
1918 if not a then
1919 return ps_error ( ' stackunderflow ' )
1920 end
1921 local ta , aa , va = a [ 1 ] , a [ 2 ] , a [ 4 ]
1922 if not ( ta = = ' string ' or ta = = ' file ' ) then
1923 return ps_error ( ' typecheck ' )
1924 end
1925 if aa ~ = ' unlimited ' then
1926 return ps_error ( ' invalidaccess ' )
1927 end
1928
1929 if ta = = ' string ' then
1930 local top = execstackptr
1931 push_execstack { ' .token ' , ' unlimited ' , ' literal ' , false }
1932 push_execstack { a [ 1 ] , a [ 2 ] , ' executable ' , va , 1 , a [ 6 ] }
1933 local v , err = next_object ( )
1934 if not v then
1935 pop_execstack ( )
1936 pop_execstack ( )
1937 push_opstack ( b_false )
1938 else
1939 local q = pop_execstack ( )
1940 if execstack [ execstackptr ] [ 1 ] = = ' .token ' then
1941 pop_execstack ( )
1942 end
1943 local tq , vq = q [ 1 ] , q [ 4 ]
1944 if tq = = ' string ' and vq ~ = va then
1945 push_execstack ( q )
1946 end
1947 local thestring , substring
1948 if vq ~ = va then
1949 thestring = " "
1950 substring = " "
1951 else
1952 thestring = get_VM ( vq )
1953 substring = sub ( thestring , q [ 5 ] or 0 )
1954 end
1955 push_opstack { ta , aa , a [ 3 ] , add_VM ( substring ) , 1 , # substring }
1956 push_opstack ( v )
1957 push_opstack ( b_true )
1958 end
1959 else
1960 if a [ 7 ] ~ = ' r ' then
1961 return ps_error ( ' invalidaccess ' )
1962 end
1963 push_execstack { ' .token ' , ' unlimited ' , ' literal ' , false }
1964 push_execstack { ' file ' , ' unlimited ' , ' executable ' , va , a [ 5 ] , a [ 6 ] , a [ 7 ] , a [ 8 ] }
1965 local v , err = next_object ( )
1966 if not v then
1967 pop_execstack ( )
1968 pop_execstack ( )
1969 push_opstack ( b_false )
1970 else
1971 local q = pop_execstack ( )
1972 a [ 5 ] = q [ 5 ]
1973 if execstack [ execstackptr ] [ 1 ] = = ' .token ' then
1974 pop_execstack ( )
1975 end
1976 push_opstack ( v )
1977 push_opstack ( b_true )
1978 end
1979 end
1980 return true
1981end
1982
1983
1984
1985
1986
1987local function both ( )
1988 local b = pop_opstack ( )
1989 local a = pop_opstack ( )
1990 if not a then
1991 return ps_error ( ' stackunderflow ' )
1992 end
1993 local ta , aa = a [ 1 ] , a [ 2 ]
1994 local tb , ab = b [ 1 ] , b [ 2 ]
1995 if aa = = ' noaccess ' or aa = = ' execute-only ' then
1996 return ps_error ( ' invalidaccess ' )
1997 end
1998 if ab = = ' noaccess ' or ab = = ' execute-only ' then
1999 return ps_error ( ' invalidaccess ' )
2000 end
2001 if ( ta = = ' dict ' and tb = = ' dict ' ) or ( ta = = ' array ' and tb = = ' array ' ) then
2002 return true , a [ 4 ] , b [ 4 ]
2003 elseif ( ( ta = = ' string ' or ta = = ' name ' ) and ( tb = = ' string ' or tb = = ' name ' ) ) then
2004 local astr = get_VM ( a [ 4 ] )
2005 local bstr = get_VM ( b [ 4 ] )
2006 return true , astr , bstr
2007 elseif ( ( ta = = ' integer ' or ta = = ' real ' ) and ( tb = = ' integer ' or tb = = ' real ' ) ) or ( ta = = tb ) then
2008 return true , a [ 4 ] , b [ 4 ]
2009 else
2010 return ps_error ( ' typecheck ' )
2011 end
2012 return true
2013end
2014
2015function operators . eq ( )
2016 local ok , a , b = both ( )
2017 if ok then
2018 push_opstack ( a = = b and b_true or b_false )
2019 return true
2020 else
2021 return a
2022 end
2023end
2024
2025function operators . ne ( )
2026 local ok , a , b = both ( )
2027 if ok then
2028 push_opstack ( a ~ = b and b_true or b_false )
2029 return true
2030 else
2031 return a
2032 end
2033end
2034
2035local function both ( )
2036 local b = pop_opstack ( )
2037 local a = pop_opstack ( )
2038 if not a then
2039 return ps_error ( ' stackunderflow ' )
2040 end
2041 local aa , ab = a [ 2 ] , b [ 2 ]
2042 if aa = = ' noaccess ' or aa = = ' execute-only ' then
2043 return ps_error ( ' invalidaccess ' )
2044 end
2045 if ab = = ' noaccess ' or ab = = ' execute-only ' then
2046 return ps_error ( ' invalidaccess ' )
2047 end
2048 local ta , tb = a [ 1 ] , b [ 1 ]
2049 local va , vb = a [ 4 ] , b [ 4 ]
2050 if ( ta = = ' real ' or ta = = ' integer ' ) and ( tb = = ' real ' or tb = = ' integer ' ) then
2051 return true , va , vb
2052 elseif ta = = ' string ' and tb = = ' string ' then
2053 local va = get_VM ( va )
2054 local vb = get_VM ( vb )
2055 return true , va , vb
2056 else
2057 return ps_error ( ' typecheck ' )
2058 end
2059end
2060
2061function operators . ge ( )
2062 local ok , a , b = both ( )
2063 if ok then
2064 push_opstack ( a > = b and b_true or b_false )
2065 return true
2066 else
2067 return a
2068 end
2069end
2070
2071function operators . gt ( )
2072 local ok , a , b = both ( )
2073 if ok then
2074 push_opstack ( a > b and b_true or b_false )
2075 return true
2076 else
2077 return a
2078 end
2079end
2080
2081function operators . le ( )
2082 local ok , a , b = both ( )
2083 if ok then
2084 push_opstack ( a < = b and b_true or b_false )
2085 return true
2086 else
2087 return a
2088 end
2089end
2090
2091function operators . lt ( )
2092 local ok , a , b = both ( )
2093 if ok then
2094 push_opstack ( a < b and b_true or b_false )
2095 return true
2096 else
2097 return a
2098 end
2099end
2100
2101local function both ( )
2102 local b = pop_opstack ( )
2103 local a = pop_opstack ( )
2104 if not a then
2105 return ps_error ( ' stackunderflow ' )
2106 end
2107 local aa , ab = a [ 2 ] , b [ 2 ]
2108 if aa = = ' noaccess ' or aa = = ' execute-only ' then
2109 return ps_error ( ' invalidaccess ' )
2110 end
2111 if ab = = ' noaccess ' or ab = = ' execute-only ' then
2112 return ps_error ( ' invalidaccess ' )
2113 end
2114 local ta , tb = a [ 1 ] , b [ 1 ]
2115 local va , vb = a [ 4 ] , b [ 4 ]
2116 if ta = = ' boolean ' and tb = = ' boolean ' then
2117 return ta , va , vb
2118 elseif ta = = ' integer ' and tb = = ' integer ' then
2119 return ta , va , vb
2120 else
2121 return ps_error ( ' typecheck ' )
2122 end
2123end
2124
2125operators [ " and " ] = function ( )
2126 local ok , a , b = both ( )
2127 if ok = = ' boolean ' then
2128 push_opstack ( ( a [ 1 ] and b [ 1 ] ) and b_true or b_false )
2129 return true
2130 elseif ok = = ' integer ' then
2131 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , bitand ( a [ 1 ] , b [ 1 ] ) }
2132 return true
2133 else
2134 return a
2135 end
2136end
2137
2138operators [ " or " ] = function ( )
2139 local ok , a , b = both ( )
2140 if ok = = ' boolean ' then
2141 push_opstack ( ( a [ 1 ] or b [ 1 ] ) and b_true or b_false )
2142 return true
2143 elseif ok = = ' integer ' then
2144 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , bitor ( a [ 1 ] , b [ 1 ] ) }
2145 return true
2146 else
2147 return a
2148 end
2149end
2150
2151function operators . xor ( )
2152 local ok , a , b = both ( )
2153 if ok = = ' boolean ' then
2154 push_opstack ( ( a [ 1 ] ~ = b [ 1 ] ) and b_true or b_false )
2155 return true
2156 elseif ok = = ' integer ' then
2157 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , bitxor ( a [ 1 ] , b [ 1 ] ) }
2158 return true
2159 else
2160 return a
2161 end
2162end
2163
2164operators [ " not " ] = function ( )
2165 local a = pop_opstack ( )
2166 if not a then
2167 return ps_error ( ' stackunderflow ' )
2168 end
2169 local aa = a [ 2 ]
2170 local ta = a [ 1 ]
2171 if aa = = ' noaccess ' or aa = = ' execute-only ' then
2172 return ps_error ( ' invalidaccess ' )
2173 end
2174 if ta = = ' boolean ' then
2175 push_opstack ( ( not a [ 4 ] ) and b_true or b_false )
2176 elseif ta = = ' integer ' then
2177 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , - a [ 4 ] - 1 }
2178 else
2179 return ps_error ( ' typecheck ' )
2180 end
2181 return true
2182end
2183
2184function operators . bitshift ( )
2185 local b = pop_opstack ( )
2186 local a = pop_opstack ( )
2187 if not a then
2188 return ps_error ( ' stackunderflow ' )
2189 end
2190 local aa , ab = a [ 2 ] , b [ 2 ]
2191 local ta , tb = a [ 1 ] , b [ 1 ]
2192 local va , vb = a [ 4 ] , b [ 4 ]
2193 if aa = = ' noaccess ' or aa = = ' execute-only ' then
2194 return ps_error ( ' invalidaccess ' )
2195 end
2196 if ab = = ' noaccess ' or ab = = ' execute-only ' then
2197 return ps_error ( ' invalidaccess ' )
2198 end
2199 if not ( ta = = ' integer ' and tb = = ' integer ' ) then
2200 return ps_error ( ' typecheck ' )
2201 end
2202 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , bitrshift ( va , vb < 0 and - vb or vb ) }
2203 return true
2204end
2205
2206
2207
2208
2209
2210
2211function operators . exec ( )
2212 local a = pop_opstack ( )
2213 if not a then
2214 return ps_error ( ' stackunderflow ' )
2215 end
2216 if a [ 1 ] = = ' array ' then
2217 a [ 7 ] = ' i '
2218 a [ 5 ] = 1
2219 end
2220 push_execstack ( a )
2221 return true
2222end
2223
2224operators [ " if " ] = function ( )
2225 local b = pop_opstack ( )
2226 local a = pop_opstack ( )
2227 if not a then
2228 return ps_error ( ' stackunderflow ' )
2229 end
2230 if a [ 1 ] ~ = ' boolean ' then
2231 return ps_error ( ' typecheck ' )
2232 end
2233 if b [ 1 ] ~ = ' array ' then
2234 return ps_error ( ' typecheck ' )
2235 end
2236 if a [ 4 ] = = true then
2237 b [ 7 ] = ' i '
2238 b [ 5 ] = 1
2239 push_execstack ( b )
2240 end
2241 return true
2242end
2243
2244function operators . ifelse ( )
2245 local c = pop_opstack ( )
2246 local b = pop_opstack ( )
2247 local a = pop_opstack ( )
2248 if not a then
2249 return ps_error ( ' stackunderflow ' )
2250 end
2251 if a [ 1 ] ~ = ' boolean ' then
2252 return ps_error ( ' typecheck ' )
2253 end
2254 if b [ 1 ] ~ = ' array ' then
2255 return ps_error ( ' typecheck ' )
2256 end
2257 if c [ 1 ] ~ = ' array ' then
2258 return ps_error ( ' typecheck ' )
2259 end
2260 if a [ 4 ] = = true then
2261 b [ 5 ] = 1
2262 b [ 7 ] = ' i '
2263 push_execstack ( b )
2264 else
2265 c [ 5 ] = 1
2266 c [ 7 ] = ' i '
2267 push_execstack ( c )
2268 end
2269 return true
2270end
2271
2272operators [ " for " ] = function ( )
2273 local d = pop_opstack ( )
2274 local c = pop_opstack ( )
2275 local b = pop_opstack ( )
2276 local a = pop_opstack ( )
2277 local ta , tb , tc , td = a [ 1 ] , b [ 1 ] , c [ 1 ] , d [ 1 ]
2278 if not a then
2279 return ps_error ( ' stackunderflow ' )
2280 end
2281 if not ( ta = = ' integer ' or ta = = ' real ' ) then
2282 return ps_error ( ' typecheck ' )
2283 end
2284 if not ( tb = = ' integer ' or tb = = ' real ' ) then
2285 return ps_error ( ' typecheck ' )
2286 end
2287 if not ( tc = = ' integer ' or tc = = ' real ' ) then
2288 return ps_error ( ' typecheck ' )
2289 end
2290 if not ( td = = ' array ' and d [ 3 ] = = ' executable ' ) then
2291 return ps_error ( ' typecheck ' )
2292 end
2293 local initial = a [ 4 ]
2294 local increment = b [ 4 ]
2295 local limit = c [ 4 ]
2296 if initial = = limit then
2297 return true
2298 end
2299 push_execstack { ' .exit ' , ' unlimited ' , ' literal ' , false }
2300 local curstack = execstackptr
2301 local tokentype = ( a [ 1 ] = = ' real ' or b [ 1 ] = = ' real ' or c [ 1 ] = = ' real ' ) and ' real ' or ' integer '
2302 d [ 7 ] = ' i '
2303 local first , last
2304 if increment > = 0 then
2305 first , last = initial , limit
2306 else
2307 first , last = limit , limit
2308 end
2309 for control = first , last , increment do
2310 if stopped then
2311 stopped = false
2312 return false
2313 end
2314 push_opstack { tokentype , ' unlimited ' , ' literal ' , control }
2315 d [ 5 ] = 1
2316 push_execstack ( d )
2317 while curstack < execstackptr do
2318 do_exec ( )
2319 end
2320 local entry = execstack [ execstackptr ]
2321 if entry [ 1 ] = = ' .exit ' and entry [ 4 ] = = true then
2322 pop_execstack ( )
2323 return true ;
2324 end
2325 end
2326 return true
2327end
2328
2329operators [ " repeat " ] = function ( )
2330 local b = pop_opstack ( )
2331 local a = pop_opstack ( )
2332 if not a then
2333 return ps_error ( ' stackunderflow ' )
2334 end
2335 if a [ 1 ] ~ = ' integer ' then
2336 return ps_error ( ' typecheck ' )
2337 end
2338 if a [ 4 ] < 0 then
2339 return ps_error ( ' rangecheck ' )
2340 end
2341 if not ( b [ 1 ] = = ' array ' and b [ 3 ] = = ' executable ' ) then
2342 return ps_error ( ' typecheck ' )
2343 end
2344 local limit = a [ 4 ]
2345 if limit = = 0 then
2346 return true
2347 end
2348 push_execstack { ' .exit ' , ' unlimited ' , ' literal ' , false }
2349 local curstack = execstackptr
2350 b [ 7 ] = ' i '
2351 local control = 0
2352 while control < limit do
2353 if stopped then
2354 stopped = false
2355 return false
2356 end
2357 b [ 5 ] = 1
2358 push_execstack ( b )
2359 while curstack < execstackptr do
2360 do_exec ( )
2361 end
2362 local entry = execstack [ execstackptr ]
2363 if entry [ 1 ] = = ' .exit ' and entry [ 4 ] = = true then
2364 pop_execstack ( )
2365 return true ;
2366 end
2367 control = control + 1
2368 end
2369 return true
2370end
2371
2372function operators . loop ( )
2373 local a = pop_opstack ( )
2374 if not a then
2375 return ps_error ( ' stackunderflow ' )
2376 end
2377 if not ( a [ 1 ] = = ' array ' and a [ 3 ] = = ' executable ' ) then
2378 return ps_error ( ' typecheck ' )
2379 end
2380 push_execstack { ' .exit ' , ' unlimited ' , ' literal ' , false }
2381 local curstack = execstackptr
2382 a [ 7 ] = ' i '
2383 while true do
2384 if stopped then
2385 stopped = false
2386 return false
2387 end
2388 a [ 5 ] = 1
2389 push_execstack ( a )
2390 while curstack < execstackptr do
2391 do_exec ( )
2392 end
2393 if execstackptr > 0 then
2394 local entry = execstack [ execstackptr ]
2395 if entry [ 1 ] = = ' .exit ' and entry [ 4 ] = = true then
2396 pop_execstack ( )
2397 return true
2398 end
2399 end
2400 end
2401 return true
2402end
2403
2404function operators . exit ( )
2405 local v = pop_execstack ( )
2406 while v do
2407 local tv = val [ 1 ]
2408 if tv = = ' .exit ' then
2409 push_execstack { ' .exit ' , ' unlimited ' , ' literal ' , true }
2410 return true
2411 elseif tv = = ' .stopped ' or tv = = ' .run ' then
2412 push_execstack ( v )
2413 return ps_error ( ' invalidexit ' )
2414 end
2415 v = pop_execstack ( )
2416 end
2417 report ( " exit without context, quitting " )
2418 push_execstack { ' operator ' , ' unlimited ' , ' executable ' , operators . quit , " quit " }
2419 return true
2420end
2421
2422function operators . stop ( )
2423 local v = pop_execstack ( )
2424 while v do
2425 if val [ 1 ] = = ' .stopped ' then
2426 stopped = true
2427 push_opstack { ' boolean ' , ' unlimited ' , ' executable ' , true }
2428 return true
2429 end
2430 v = pop_execstack ( )
2431 end
2432 report ( " stop without context, quitting " )
2433 push_execstack { ' operator ' , ' unlimited ' , ' executable ' , operators . quit , " quit " }
2434 return true
2435end
2436
2437function operators . stopped ( )
2438 local a = pop_opstack ( )
2439 if not a then
2440 return ps_error ( ' stackunderflow ' )
2441 end
2442
2443 push_execstack { ' .stopped ' , ' unlimited ' , ' literal ' , false }
2444 a [ 3 ] = ' executable '
2445 if a [ 1 ] = = ' array ' then
2446 a [ 7 ] = ' i '
2447 a [ 5 ] = 1
2448 end
2449 push_execstack ( a )
2450 return true
2451end
2452
2453function operators . countexecstack ( )
2454 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , execstackptr }
2455 return true
2456end
2457
2458function operators . execstack ( )
2459 local a = pop_opstack ( )
2460 if not a then
2461 return ps_error ( ' stackunderflow ' )
2462 end
2463 if not a [ 1 ] = = ' array ' then
2464 return ps_error ( ' typecheck ' )
2465 end
2466 if not a [ 2 ] = = ' unlimited ' then
2467 return ps_error ( ' invalidaccess ' )
2468 end
2469 if a [ 6 ] < execstackptr then
2470 return ps_error ( ' rangecheck ' )
2471 end
2472 local thearray = get_VM ( a [ 4 ] )
2473 local subarray = { }
2474 for n = 1 , execstackptr do
2475
2476
2477 local v = execstack [ n ]
2478 thearray [ n ] = v
2479 subarray [ n ] = v
2480 a [ 5 ] = a [ 5 ] + 1
2481 end
2482 push_opstack { ' array ' , ' unlimited ' , ' literal ' , add_VM ( subarray ) , execstackptr , execstackptr , " " }
2483 return true
2484end
2485
2486
2487
2488
2489function operators . quit ( )
2490 while execstackptr > = 0 do
2491 execstack [ execstackptr ] = nil
2492 execstackptr = execstackptr - 1
2493 end
2494 return true
2495end
2496
2497
2498
2499function operators . start ( )
2500 return true
2501end
2502
2503
2504
2505
2506
2507
2508function operators . type ( )
2509 local a = pop_opstack ( )
2510 if not a then
2511 return ps_error ( ' stackunderflow ' )
2512 end
2513 push_opstack { " name " , " unlimited " , " executable " , add_VM ( a [ 1 ] . . " type " ) }
2514 return true
2515end
2516
2517function operators . cvlit ( )
2518 local a = get_opstack ( )
2519 if not a then
2520 return ps_error ( ' stackunderflow ' )
2521 end
2522 a [ 3 ] = ' literal '
2523 return true
2524end
2525
2526function operators . cvx ( )
2527 local a = get_opstack ( )
2528 if not a then
2529 return ps_error ( ' stackunderflow ' )
2530 end
2531 a [ 3 ] = ' executable '
2532 return true
2533end
2534
2535function operators . xcheck ( )
2536 local a = pop_opstack ( )
2537 if not a then
2538 return ps_error ( ' stackunderflow ' )
2539 end
2540 push_opstack ( ( a [ 3 ] = = ' executable ' ) and b_true or b_false )
2541 return true
2542end
2543
2544function operators . executeonly ( )
2545 local a = pop_opstack ( )
2546 if not a then
2547 return ps_error ( ' stackunderflow ' )
2548 end
2549 local ta = a [ 1 ]
2550 if ta = = ' string ' or ta = = ' file ' or ta = = ' array ' then
2551 if a [ 2 ] = = ' noaccess ' then
2552 return ps_error ( ' invalidaccess ' )
2553 end
2554 a [ 2 ] = ' execute-only '
2555 else
2556 return ps_error ( ' typecheck ' )
2557 end
2558 push_opstack ( a )
2559 return true
2560end
2561
2562function operators . noaccess ( )
2563 local a = pop_opstack ( )
2564 if not a then
2565 return ps_error ( ' stackunderflow ' )
2566 end
2567 local ta = a [ 1 ]
2568 if ta = = ' string ' or ta = = ' file ' or ta = = ' array ' then
2569 if a [ 2 ] = = ' noaccess ' then
2570 return ps_error ( ' invalidaccess ' )
2571 end
2572 a [ 2 ] = ' noaccess '
2573 elseif ta = = " dict " then
2574 local thedict = get_VM ( a [ 4 ] )
2575 if thedict . access = = ' noaccess ' then
2576 return ps_error ( ' invalidaccess ' )
2577 end
2578 thedict . access = ' noaccess '
2579 else
2580 return ps_error ( ' typecheck ' )
2581 end
2582 push_opstack ( a )
2583 return true
2584end
2585
2586function operators . readonly ( )
2587 local a = pop_opstack ( )
2588 if not a then
2589 return ps_error ( ' stackunderflow ' )
2590 end
2591 local ta = a [ 1 ]
2592 if ta = = ' string ' or ta = = ' file ' or ta = = ' array ' then
2593 local aa = a [ 2 ]
2594 if aa = = ' noaccess ' or aa = = ' execute-only ' then
2595 return ps_error ( ' invalidaccess ' )
2596 end
2597 a [ 2 ] = ' read-only '
2598 elseif ta = = ' dict ' then
2599 local thedict = get_VM ( a [ 4 ] )
2600 local access = thedict . access
2601 if access = = ' noaccess ' or access = = ' execute-only ' then
2602 return ps_error ( ' invalidaccess ' )
2603 end
2604 thedict . access = ' read-only '
2605 else
2606 return ps_error ( ' typecheck ' )
2607 end
2608 push_opstack ( a )
2609 return true
2610end
2611
2612function operators . rcheck ( )
2613 local a = pop_opstack ( )
2614 if not a then
2615 return ps_error ( ' stackunderflow ' )
2616 end
2617 local ta = a [ 1 ]
2618 local aa
2619 if ta = = ' string ' or ta = = ' file ' or ta = = ' array ' then
2620 aa = a [ 2 ]
2621 elseif ta = = ' dict ' then
2622 aa = get_VM ( a [ 4 ] ) . access
2623 else
2624 return ps_error ( ' typecheck ' )
2625 end
2626 push_opstack ( ( aa = = ' unlimited ' or aa = = ' read-only ' ) and p_true or p_false )
2627 return true
2628end
2629
2630function operators . wcheck ( )
2631 local a = pop_opstack ( )
2632 if not a then
2633 return ps_error ( ' stackunderflow ' )
2634 end
2635 local ta = a [ 1 ]
2636 local aa
2637 if ta = = ' string ' or ta = = ' file ' or ta = = ' array ' then
2638 aa = a [ 2 ]
2639 elseif ta = = ' dict ' then
2640 local thedict = get_VM ( a [ 4 ] )
2641 aa = thedict . access
2642 else
2643 return ps_error ( ' typecheck ' )
2644 end
2645 push_opstack ( ( aa = = ' unlimited ' ) and p_true or p_false )
2646 return true
2647end
2648
2649function operators . cvi ( )
2650 local a = pop_opstack ( )
2651 if not a then
2652 return ps_error ( ' stackunderflow ' )
2653 end
2654 local ta = a [ 1 ]
2655 if ta = = ' string ' then
2656 push_opstack ( a )
2657 local ret , err = operators . token ( )
2658 if not ret then
2659 return ret , err
2660 end
2661 local b = pop_opstack ( )
2662 if b [ 4 ] = = false then
2663 return ps_error ( ' syntaxerror ' )
2664 end
2665 a = pop_opstack ( )
2666 pop_opstack ( )
2667 ta = a [ 1 ]
2668 end
2669 local aa = a [ 2 ]
2670 if not ( aa = = ' unlimited ' or aa = = ' read-only ' ) then
2671 return ps_error ( ' invalidaccess ' )
2672 end
2673 if ta = = ' integer ' then
2674 push_opstack ( a )
2675 elseif ta = = ' real ' then
2676 local va = a [ 4 ]
2677 local c = va < 0 and - floor ( - va ) or floor ( ava )
2678 if abs ( c ) > MAX_INT then
2679 return ps_error ( ' rangecheck ' )
2680 end
2681 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , c }
2682 else
2683 return ps_error ( ' typecheck ' )
2684 end
2685 return true
2686end
2687
2688function operators . cvn ( )
2689 local a = pop_opstack ( )
2690 if not a then
2691 return ps_error ( ' stackunderflow ' )
2692 end
2693 local ta , aa = a [ 1 ] , a [ 2 ]
2694 local ta = a [ 1 ]
2695 if ta ~ = ' string ' then
2696 return ps_error ( ' typecheck ' )
2697 end
2698 if aa = = ' execute-only ' or aa = = ' noaccess ' then
2699 return ps_error ( ' invalidaccess ' )
2700 end
2701 push_opstack { ' name ' , aa , a [ 3 ] , add_VM ( get_VM ( a [ 4 ] ) ) }
2702 return true
2703end
2704
2705function operators . cvr ( )
2706 local a = pop_opstack ( )
2707 if not a then
2708 return ps_error ( ' stackunderflow ' )
2709 end
2710 local ta = a [ 1 ]
2711 if ta = = ' string ' then
2712 push_opstack ( a )
2713 local ret , err = operators . token ( )
2714 if not ret then
2715 return ret , err
2716 end
2717 local b = pop_opstack ( )
2718 if b [ 4 ] = = false then
2719 return ps_error ( ' syntaxerror ' )
2720 end
2721 a = pop_opstack ( )
2722 pop_opstack ( )
2723 ta = a [ 1 ]
2724 end
2725 local aa = a [ 2 ]
2726 if not ( aa = = ' unlimited ' or aa = = ' read-only ' ) then
2727 return ps_error ( ' invalidaccess ' )
2728 end
2729 if ta = = ' integer ' then
2730 push_opstack { ' real ' , ' unlimited ' , ' literal ' , a [ 4 ] }
2731 elseif ta = = ' real ' then
2732 push_opstack ( a )
2733 else
2734 return ps_error ( ' typecheck ' )
2735 end
2736 return true
2737end
2738
2739do
2740
2741 local byte0 = byte ( ' 0 ' )
2742 local byteA = byte ( ' A ' ) - 10
2743
2744 function operators . cvrs ( )
2745 local c = pop_opstack ( )
2746 local b = pop_opstack ( )
2747 local a = pop_opstack ( )
2748 if not a then
2749 return ps_error ( ' stackunderflow ' )
2750 end
2751 local ta , tb , tc = a [ 1 ] , b [ 1 ] , c [ 1 ]
2752 if not ( ta = = ' integer ' or ta = = ' real ' ) then
2753 return ps_error ( ' typecheck ' )
2754 end
2755 if not tb = = ' integer ' then
2756 return ps_error ( ' typecheck ' )
2757 end
2758 if not tc = = ' string ' then
2759 return ps_error ( ' typecheck ' )
2760 end
2761 if not c [ 2 ] = = ' unlimited ' then
2762 return ps_error ( ' invalidaccess ' )
2763 end
2764 local va , vb , vc = a [ 4 ] , b [ 4 ] , c [ 4 ]
2765 if ( vb < 2 or vb > 36 ) then
2766 return ps_error ( ' rangecheck ' )
2767 end
2768 if ta = = ' real ' then
2769 push_opstack ( a )
2770 local ret , err = operators . cvi ( )
2771 if ret then
2772 return ret , err
2773 end
2774 a = pop_opstack ( )
2775 end
2776
2777 local decimal = va
2778 local str = { }
2779 local n = 0
2780 while decimal > 0 do
2781 local digit = decimal % vb
2782 n = n + 1
2783 str [ n ] = digit < 10 and char ( digit + byte0 ) or char ( digit + byteA )
2784 decimal = floor ( decimal / vb )
2785 end
2786 if n > c [ 6 ] then
2787 return ps_error ( ' rangecheck ' )
2788 end
2789 str = concat ( reverse ( str ) )
2790 local thestring = get_VM ( vc )
2791 VM [ va ] = str . . sub ( thestring , n + 1 , -1 )
2792 push_opstack { c [ 1 ] , c [ 2 ] , c [ 3 ] , add_VM ( repl ) , n , n }
2793 return true
2794 end
2795
2796end
2797
2798function operators . cvs ( )
2799 local b = pop_opstack ( )
2800 local a = pop_opstack ( )
2801 if not 4 then
2802 return ps_error ( ' stackunderflow ' )
2803 end
2804 local ta , tb = a [ 1 ] , b [ 1 ]
2805 local ab = b [ 2 ]
2806 if not tb = = ' string ' then
2807 return ps_error ( ' typecheck ' )
2808 end
2809 if not ab = = ' unlimited ' then
2810 return ps_error ( ' invalidaccess ' )
2811 end
2812 local va , vb = a [ 4 ] , b [ 4 ]
2813 if ta = = ' real ' then
2814 if floor ( va ) = = va then
2815 va = tostring ( va ) . . ' .0 '
2816 else
2817 va = tostring ( va )
2818 end
2819 elseif ta = = ' integer ' then
2820 va = tostring ( va )
2821 elseif ta = = ' string ' or ta = = ' name ' then
2822 va = get_VM ( va )
2823 elseif ta = = ' operator ' then
2824 va = a [ 5 ]
2825 elseif ta = = ' boolean ' then
2826 va = tostring ( va )
2827 else
2828 va = " --nostringval-- "
2829 end
2830 local n = # va
2831 if n > b [ 6 ] then
2832 return ps_error ( ' rangecheck ' )
2833 end
2834 local thestring = get_VM ( vb )
2835 VM [ vb ] = va . . sub ( thestring , n + 1 , -1 )
2836 push_opstack { tb , ab , b [ 3 ] , add_VM ( va ) , n , n }
2837 return true
2838end
2839
2840
2841
2842
2843
2844
2845
2846function operators . file ( )
2847 local b = pop_opstack ( )
2848 local a = pop_opstack ( )
2849 if not a then
2850 return ps_error ( ' stackunderflow ' )
2851 end
2852 if b [ 1 ] ~ = ' string ' then
2853 return ps_error ( ' typecheck ' )
2854 end
2855 if a [ 1 ] ~ = ' string ' then
2856 return ps_error ( ' typecheck ' )
2857 end
2858 local fmode = get_VM ( b [ 4 ] )
2859 local fname = get_VM ( a [ 4 ] )
2860
2861 if fmode ~ = " r " and fmode ~ = " w " and fmode ~ = " a " then
2862 return ps_error ( ' typecheck ' )
2863 end
2864 if fname = = " %stdin " then
2865
2866 if fmode ~ = " r " then
2867 return ps_error ( ' invalidfileaccess ' )
2868 end
2869 push_opstack { ' file ' , ' unlimited ' , ' literal ' , 0 , 0 , 0 , fmode , io . stdin }
2870 elseif fname = = " %stdout " then
2871
2872 if fmode = = " r " then
2873 return ps_error ( ' invalidfileaccess ' )
2874 end
2875 push_opstack { ' file ' , ' unlimited ' , ' literal ' , 0 , 0 , 0 , fmode , io . stdout }
2876 elseif fname = = " %stderr " then
2877
2878 if fmode = = " r " then
2879 return ps_error ( ' invalidfileaccess ' )
2880 end
2881 push_opstack { ' file ' , ' unlimited ' , ' literal ' , 0 , 0 , 0 , fmode , io . stderr }
2882 elseif fname = = " %statementedit " or fname = = " %lineedit " then
2883 return ps_error ( ' invalidfileaccess ' )
2884 else
2885
2886 local myfile , error = io . open ( fname , fmode )
2887 if not myfile then
2888 return ps_error ( ' undefinedfilename ' )
2889 end
2890 if fmode = = ' r ' then
2891 l = myfile : read ( " *a " )
2892 if not l then
2893 return ps_error ( ' invalidfileaccess ' )
2894 end
2895
2896 push_opstack { ' file ' , ' unlimited ' , ' literal ' , add_VM ( l ) , 1 , # l , fmode , myfile }
2897 else
2898 push_opstack { ' file ' , ' unlimited ' , ' literal ' , 0 , 0 , 0 , fmode , myfile }
2899 end
2900 end
2901 return true
2902end
2903
2904function operators . read ( )
2905 local a = pop_opstack ( )
2906 if not a then
2907 return ps_error ( ' stackunderflow ' )
2908 end
2909 if a [ 1 ] ~ = ' file ' then
2910 return ps_error ( ' typecheck ' )
2911 end
2912 if a [ 7 ] ~ = ' r ' then
2913 return ps_error ( ' invalidaccess ' )
2914 end
2915 local b
2916 local v = a [ 4 ]
2917 local f = a [ 8 ]
2918 if v > 0 then
2919 local thestr = get_VM ( v )
2920 local n = a [ 5 ]
2921 if n < a [ 6 ] then
2922 byte = sub ( thestr , n , n + 1 )
2923
2924 end
2925 else
2926 b = f : read ( 1 )
2927 end
2928 if b then
2929 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , byte ( b ) }
2930 push_opstack ( p_true )
2931 else
2932 f : close ( )
2933 push_opstack ( p_false )
2934 end
2935 return true
2936end
2937
2938function operators . write ( )
2939 local b = pop_opstack ( )
2940 local a = pop_opstack ( )
2941 if not a then
2942 return ps_error ( ' stackunderflow ' )
2943 end
2944 if b [ 1 ] ~ = ' integer ' then
2945 return ps_error ( ' typecheck ' )
2946 end
2947 if a [ 1 ] ~ = ' file ' then
2948 return ps_error ( ' typecheck ' )
2949 end
2950 if a [ 7 ] = = ' r ' then
2951 return ps_error ( ' ioerror ' )
2952 end
2953 a [ 8 ] : write ( char ( b [ 4 ] % 256 ) )
2954 return true
2955end
2956
2957function operators . writestring ( )
2958 local b = pop_opstack ( )
2959 local a = pop_opstack ( )
2960 if not a then
2961 return ps_error ( ' stackunderflow ' )
2962 end
2963 if b [ 1 ] ~ = ' string ' then
2964 return ps_error ( ' typecheck ' )
2965 end
2966 if a [ 1 ] ~ = ' file ' then
2967 return ps_error ( ' typecheck ' )
2968 end
2969 if a [ 7 ] = = ' r ' then
2970 return ps_error ( ' ioerror ' )
2971 end
2972 a [ 8 ] : write ( get_VM ( b [ 4 ] ) )
2973 return true
2974end
2975
2976function operators . writehexstring ( )
2977 local b = pop_opstack ( )
2978 local a = pop_opstack ( )
2979 if not a then
2980 return ps_error ( ' stackunderflow ' )
2981 end
2982 if b [ 1 ] ~ = ' string ' then
2983 return ps_error ( ' typecheck ' )
2984 end
2985 if a [ 1 ] ~ = ' file ' then
2986 return ps_error ( ' typecheck ' )
2987 end
2988 if a [ 7 ] = = ' r ' then
2989 return ps_error ( ' ioerror ' )
2990 end
2991 local f = a [ 8 ]
2992 local s = get_VM ( b [ 4 ] )
2993 for w in gmatch ( s , " . " ) do
2994 f : write ( format ( " %x " , byte ( w ) ) )
2995 end
2996 return true
2997end
2998
2999do
3000
3001 local function get_string_line ( a )
3002 local str = get_VM ( a [ 4 ] )
3003 local start = a [ 5 ]
3004 local theend = a [ 6 ]
3005 if start = = theend then
3006 return nil
3007 end
3008 str = match ( str , " [\n\r]*([^\n\r]*) " , start )
3009 a [ 5 ] = a [ 5 ] + # str + 1
3010 return str
3011 end
3012
3013 local function get_hexstring_line ( a , b )
3014 local thestring = get_VM ( a [ 4 ] )
3015 local start , theend = a [ 5 ] , a [ 6 ]
3016 if start = = theend then
3017 return nil
3018 end
3019 local prefix , result , n = nil , { } , 0
3020 local nmax = b [ 6 ]
3021 while start < theend do
3022 local b = sub ( thestring , start , start )
3023 if not b then
3024 break
3025 end
3026 local hexbyte = tonumber ( b , 16 )
3027 if not hexbyte then
3028
3029 elseif prefix then
3030 n = n + 1
3031 result [ n ] = char ( prefix * 16 + hexbyte )
3032 if n = = nmax then
3033 break
3034 else
3035 prefix = nil
3036 end
3037 else
3038 prefix = hexbyte
3039 end
3040 start = start + 1
3041 end
3042 a [ 5 ] = start + 1
3043 return concat ( result )
3044 end
3045
3046 function operators . readline ( )
3047 local b = pop_opstack ( )
3048 local a = pop_opstack ( )
3049 if not a then
3050 return ps_error ( ' stackunderflow ' )
3051 end
3052 if a [ 1 ] ~ = ' file ' then
3053 return ps_error ( ' typecheck ' )
3054 end
3055 if a [ 7 ] ~ = ' r ' then
3056 return ps_error ( ' invalidaccess ' )
3057 end
3058 local va = a [ 4 ]
3059 if va > 0 then
3060 va = get_string_line ( a )
3061 else
3062 va = a [ 8 ] : read ( ' *l ' )
3063 end
3064 if not va then
3065 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( ' ' ) , 0 , 0 }
3066 push_opstack ( p_false )
3067 else
3068 local n = # va
3069 if n > b [ 6 ] then
3070 return ps_error ( ' rangecheck ' )
3071 end
3072 local thestring = get_VM ( b [ 4 ] )
3073 VM [ b [ 4 ] ] = va . . sub ( thestring , # va + 1 , -1 )
3074 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( va ) , n , n }
3075 push_opstack ( p_true )
3076 end
3077 return true
3078 end
3079
3080 function operators . readhexstring ( )
3081 local b = pop_opstack ( )
3082 local a = pop_opstack ( )
3083 if not a then
3084 return ps_error ( ' stackunderflow ' )
3085 end
3086 local ta = a [ 1 ]
3087 if not ( ta = = ' string ' or ta = = ' file ' ) then
3088 return ps_error ( ' typecheck ' )
3089 end
3090 local thefile = a [ 8 ]
3091 local va = a [ 4 ]
3092 if va > 0 then
3093 va = get_hexstring_line ( a , b )
3094 else
3095 local prefix , result , n = nil , { } , 0
3096
3097 while true do
3098 local b = thefile : read ( 1 )
3099 if not b then
3100 break
3101 end
3102 local hexbyte = tonumber ( b , 16 )
3103 local nmax = b [ 6 ]
3104 if not hexbyte then
3105
3106 elseif prefix then
3107 n = n + 1
3108 result [ n ] = char ( prefix * 16 + hexbyte )
3109 if n = = nmax then
3110 break
3111 else
3112 prefix = nil
3113 end
3114 else
3115 prefix = hexbyte
3116 end
3117 end
3118 va = concat ( result )
3119 end
3120 local thestring = get_VM ( b [ 4 ] )
3121 local n = # va
3122 VM [ b [ 4 ] ] = repl . . sub ( thestring , n + 1 , -1 )
3123 push_opstack { b [ 1 ] , b [ 2 ] , b [ 3 ] , add_VM ( va ) , n , n }
3124 push_opstack ( ( n = = b [ 6 ] ) and p_true or p_false )
3125 return true
3126 end
3127
3128end
3129
3130function operators . flush ( )
3131 io . flush ( )
3132 return true
3133end
3134
3135function operators . bytesavailable ( )
3136 local a = pop_opstack ( )
3137 if not a then
3138 return ps_error ( ' stackunderflow ' )
3139 end
3140 if a [ 1 ] ~ = ' file ' then
3141 return ps_error ( ' typecheck ' )
3142 end
3143 if a [ 7 ] ~ = ' r ' then
3144 return ps_error ( ' typecheck ' )
3145 end
3146 local waiting = ( a [ 4 ] > 0 ) and ( a [ 6 ] - a [ 5 ] + 1 ) or -1
3147 push_opstack { " integer " , " unlimited " , " literal " , waiting }
3148 return true
3149end
3150
3151
3152
3153function operators . resetfile ( )
3154 local a = pop_opstack ( )
3155 if not a then
3156 return ps_error ( ' stackunderflow ' )
3157 end
3158 if a [ 1 ] ~ = ' file ' then
3159 return ps_error ( ' typecheck ' )
3160 end
3161 return true
3162end
3163
3164function operators . flushfile ( )
3165 local a = pop_opstack ( )
3166 if not a then
3167 return ps_error ( ' stackunderflow ' )
3168 end
3169 if a [ 1 ] ~ = ' file ' then
3170 return ps_error ( ' typecheck ' )
3171 end
3172 if a [ 4 ] > 0 then
3173 a [ 5 ] = a [ 6 ]
3174 else
3175 a [ 8 ] : flush ( )
3176 end
3177 return true
3178end
3179
3180function operators . closefile ( )
3181 local a = pop_opstack ( )
3182 if not a then
3183 return ps_error ( ' stackunderflow ' )
3184 end
3185 if a [ 1 ] ~ = ' file ' then
3186 return ps_error ( ' typecheck ' )
3187 end
3188 if a [ 7 ] = = ' r ' then
3189 a [ 5 ] = a [ 6 ]
3190 else
3191 push_opstack ( a )
3192 operators . flushfile ( )
3193 end
3194 a [ 8 ] : close ( )
3195 return true
3196end
3197
3198function operators . status ( )
3199 local a = pop_opstack ( )
3200 if not a then
3201 return ps_error ( ' stackunderflow ' )
3202 end
3203 if a [ 1 ] ~ = ' file ' then
3204 return ps_error ( ' typecheck ' )
3205 end
3206 local state = io . type ( a [ 8 ] )
3207 push_opstack { " boolean " , ' unlimited ' , ' literal ' , not state or state = = " closed file " }
3208 return true
3209end
3210
3211function operators . run ( )
3212 push_opstack { " string " , " unlimited " , " literal " , add_VM ( " r " ) , 1 , 1 }
3213 local ret , err = operators . file ( )
3214 if not ret then
3215 return ret , err
3216 end
3217 ret , err = operators . cvx ( )
3218 if not ret then
3219 return ret , err
3220 end
3221 local a = pop_opstack ( )
3222 push_execstack { " .run " , " unlimited " , " literal " , false }
3223 local curstack = execstackptr
3224 local thefile = a [ 8 ]
3225 push_execstack ( a )
3226 while curstack < execstackptr do
3227 do_exec ( )
3228 end
3229 local state = io . type ( thefile )
3230 if not state or state = = " closed file " then
3231
3232 else
3233 thefile : close ( )
3234 end
3235 if execstackptr > 0 then
3236 local entry = execstack [ execstackptr ]
3237 if entry [ 1 ] = = ' .run ' and entry [ 4 ] = = true then
3238 pop_execstack ( )
3239 end
3240 end
3241 return true
3242end
3243
3244function operators . currentfile ( )
3245 local n = execstackptr
3246 while n > = 0 do
3247 local entry = execstack [ n ]
3248 if entry [ 1 ] = = ' file ' and entry [ 7 ] = = ' r ' then
3249 push_opstack ( entry )
3250 return true
3251 end
3252 n = n - 1
3253 end
3254 push_opstack { ' file ' , ' unlimited ' , ' executable ' , add_VM ( ' ' ) , 0 , 0 , ' r ' , stdin }
3255 return true
3256end
3257
3258function operators . print ( )
3259 local a = pop_opstack ( )
3260 if not a then return
3261 ps_error ( ' stackunderflow ' )
3262 end
3263 if a [ 1 ] ~ = ' string ' then
3264 return ps_error ( ' typecheck ' )
3265 end
3266 report ( get_VM ( a [ 4 ] ) )
3267end
3268
3269
3270
3271
3272
3273
3274
3275do
3276
3277 local pattern = Cs (
3278 Cc ( " ( " )
3279 * (
3280 P ( " \n " ) / " \\n "
3281 + P ( " \r " ) / " \\r "
3282 + P ( " ( " ) / " \\( "
3283 + P ( " ) " ) / " \\) "
3284 + P ( " \\ " ) / " \\\\ "
3285 + P ( " \b " ) / " \\b "
3286 + P ( " \t " ) / " \\t "
3287 + P ( " \f " ) / " \\f "
3288 + R ( " \000\032 " , " \127\255 " ) / tonumber / formatters [ " \\%03o " ]
3289 + P ( 1 )
3290 ) ^ 0
3291 * Cc ( " ) " )
3292 )
3293
3294
3295
3296 local function do_operator_equal ( a )
3297 local ta , va = a [ 1 ] , a [ 4 ]
3298 if ta = = ' real ' then
3299 if floor ( va ) = = va then
3300 return tostring ( va . . ' .0 ' )
3301 else
3302 return tostring ( va )
3303 end
3304 elseif ta = = ' integer ' then
3305 return tostring ( va )
3306 elseif ta = = ' string ' then
3307 return lpegmatch ( pattern , get_VM ( va ) )
3308 elseif ta = = ' boolean ' then
3309 return tostring ( va )
3310 elseif ta = = ' operator ' then
3311 return ' -- ' . . a [ 5 ] . . ' -- '
3312 elseif ta = = ' name ' then
3313 if a [ 3 ] = = ' literal ' then
3314 return ' / ' . . get_VM ( va )
3315 else
3316 return get_VM ( va )
3317 end
3318 elseif ta = = ' array ' then
3319 va = get_VM ( va )
3320 local isexec = a [ 3 ] = = ' executable '
3321 local result = { isexec and " { " or " [ " }
3322 local n = 1
3323 for i = 1 , # va do
3324 n = n + 1
3325 result [ n ] = do_operator_equal ( va [ i ] )
3326 end
3327 result [ n + 1 ] = isexec and " } " or " ] "
3328 return concat ( result , " " )
3329 elseif ta = = ' null ' then
3330 return ' null '
3331 elseif ta = = ' dict ' then
3332 return ' -dicttype- '
3333 elseif ta = = ' save ' then
3334 return ' -savetype- '
3335 elseif ta = = ' mark ' then
3336 return ' -marktype- '
3337 elseif ta = = ' file ' then
3338 return ' -filetype- '
3339 elseif ta = = ' font ' then
3340 return ' -fonttype- '
3341 end
3342 end
3343
3344 function operators . equal ( )
3345 local a = pop_opstack ( )
3346 if not a then
3347 return ps_error ( ' stackunderflow ' )
3348 end
3349 report ( do_operator_equal ( a ) )
3350 return true
3351 end
3352
3353end
3354
3355local function commonstack ( seperator )
3356 for n = 1 , opstackptr do
3357 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( seperator ) , 1 , 1 }
3358 push_opstack ( opstack [ n ] )
3359 push_execstack { ' operator ' , ' unlimited ' , ' executable ' , operators . print , ' print ' }
3360 push_execstack { ' operator ' , ' unlimited ' , ' executable ' , operators . equal , ' == ' }
3361 end
3362 return true
3363end
3364
3365function operators . pstack ( )
3366 return commonstack ( " \n " )
3367end
3368
3369function operators . stack ( )
3370 return commonstack ( " " )
3371end
3372
3373
3374
3375function operators . echo ( )
3376 local a = pop_opstack ( )
3377 if not a then
3378 return ps_error ( ' stackunderflow ' )
3379 end
3380 if a [ 1 ] ~ = ' boolean ' then
3381 return ps_error ( ' typecheck ' )
3382 end
3383 return true
3384end
3385
3386
3387
3388
3389
3390
3391
3392
3393local savelevel = 0
3394
3395initializers [ # initializers + 1 ] = function ( reset )
3396 savelevel = 0
3397end
3398
3399function operators . save ( )
3400 local saved_VM = { }
3401
3402 for k1 = 1 , # VM do
3403 local v1 = VM [ k1 ]
3404 if type ( v1 ) = = " table " then
3405 local t1 = { }
3406 saved_VM [ k1 ] = t1
3407
3408 for k2 = 1 , # v1 do
3409 local v2 = v1 [ k2 ]
3410 if type ( v2 ) = = " table " then
3411 local t2 = { }
3412 t1 [ k2 ] = t2
3413
3414 for k3 = 1 , # v2 do
3415 local v3 = v2 [ k3 ]
3416 t2 [ k3 ] = v3
3417 end
3418 else
3419 t1 [ k2 ] = v2
3420 end
3421 end
3422 else
3423 saved_VM [ k1 ] = v1
3424 end
3425 end
3426 push_gsstack { ' save ' , copy_gsstate ( ) }
3427 savelevel = savelevel + 1
3428 push_opstack { ' save ' , ' unlimited ' , ' executable ' , add_VM ( saved_VM ) }
3429end
3430
3431function operators . save ( )
3432 local saved_VM = table . copy ( VM )
3433 push_gsstack { ' save ' , copy_gsstate ( ) }
3434 savelevel = savelevel + 1
3435 push_opstack { ' save ' , ' unlimited ' , ' executable ' , add_VM ( saved_VM ) }
3436end
3437
3438do
3439
3440 local function validstack ( stack , index , saved_VM )
3441
3442
3443 for i = index , 1 , -1 do
3444 local v = stack [ i ]
3445 if type ( v ) = = " table " then
3446 local tv = v [ 1 ]
3447 if tv = = " save " or tv = = " string " or tv = = " array " or tv = = " dict " or tv = = " name " or tv = = " file " then
3448
3449 if v [ 4 ] > # saved_VM then
3450 return false
3451 end
3452 end
3453 end
3454 i = i - 1
3455 end
3456 return true
3457 end
3458
3459 function operators . restore ( )
3460 local a = pop_opstack ( )
3461 if not a then
3462 return ps_error ( ' stackunderflow ' )
3463 end
3464 if a [ 1 ] ~ = ' save ' then
3465 return ps_error ( ' typecheck ' )
3466 end
3467 if a [ 4 ] = = 0 or savelevel = = 0 then
3468 return ps_error ( ' invalidrestore ' )
3469 end
3470 local saved_VM = get_VM ( a [ 4 ] )
3471 if directvm then
3472 else
3473 if not validstack ( execstack , execstackptr , saved_VM ) then
3474 return ps_error ( ' invalidrestore ' )
3475 end
3476 if not validstack ( dictstack , dictstackptr , saved_VM ) then
3477 return ps_error ( ' invalidrestore ' )
3478 end
3479 if not validstack ( opstack , opstackptr , saved_VM ) then
3480 return ps_error ( ' invalidrestore ' )
3481 end
3482 end
3483 while gsstackptr > 0 do
3484 local g = gsstack [ gsstackptr ]
3485 gsstackptr = gsstackptr - 1
3486 if g [ 1 ] = = " save " then
3487 gsstate = g [ 2 ]
3488 return
3489 end
3490 end
3491 a [ 4 ] = 0
3492 savelevel = savelevel - 1
3493 VM = saved_VM
3494 end
3495
3496end
3497
3498function operators . vmstatus ( )
3499 local n = 0
3500 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , savelevel }
3501 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , n }
3502 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , n }
3503 return true
3504end
3505
3506
3507
3508
3509
3510
3511
3512local function bind ( )
3513 local a = pop_opstack ( )
3514 if not a then
3515 return true
3516 end
3517 if not a [ 1 ] = = ' array ' then
3518 return ps_error ( ' typecheck ' )
3519 end
3520 local proc = get_VM ( a [ 4 ] )
3521 for i = 1 , # proc do
3522 local v = proc [ i ]
3523 local t = v [ 1 ]
3524 if t = = ' name ' then
3525 if v [ 3 ] = = ' executable ' then
3526 local op = lookup ( get_VM ( v [ 4 ] ) )
3527 if op and op [ 1 ] = = ' operator ' then
3528 proc [ i ] = op
3529 end
3530 end
3531 elseif t = = ' array ' then
3532 if v [ 2 ] = = ' unlimited ' then
3533 push_opstack ( v )
3534 bind ( )
3535 pop_opstack ( )
3536 proc [ i ] [ 2 ] = ' read-only '
3537 end
3538 end
3539 end
3540 push_opstack ( a )
3541end
3542
3543operators . bind = bind
3544
3545function operators . null ( )
3546 push_opstack { ' null ' , ' unlimited ' , ' literal ' }
3547 return true
3548end
3549
3550function operators . usertime ( )
3551 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , floor ( os . clock ( ) * 1000 ) }
3552 return true
3553end
3554
3555function operators . version ( )
3556 push_opstack { ' string ' , ' unlimited ' , ' literal ' , add_VM ( ' 23.0 ' ) }
3557 return true
3558end
3559
3560
3561
3562
3563
3564
3565
3566
3567function operators . gsave ( )
3568 push_gsstack { ' gsave ' , copy_gsstate ( ) }
3569 currentpage [ # currentpage + 1 ] = {
3570 type = ' gsave ' ,
3571 }
3572 return true
3573end
3574
3575function operators . grestore ( )
3576 if gsstackptr > 0 then
3577 local g = gsstack [ gsstackptr ]
3578 if g [ 1 ] = = " gsave " then
3579 gsstackptr = gsstackptr - 1
3580 gsstate = g [ 2 ]
3581 end
3582 end
3583 currentpage [ # currentpage + 1 ] = {
3584 type = ' grestore ' ,
3585 }
3586 return true
3587end
3588
3589function operators . grestoreall ( )
3590 for i = gsstackptr , 1 , -1 do
3591 local g = gsstack [ i ]
3592 if g [ 1 ] = = " save " then
3593 gsstate = g [ 2 ]
3594 gsstackptr = i
3595 return true
3596 end
3597 end
3598 gsstackptr = 0
3599 return true
3600end
3601
3602function operators . initgraphics ( )
3603 local newstate = copy_gsstate ( )
3604 newstate . matrix = { 1 , 0 , 0 , 1 , 0 , 0 }
3605 newstate . color = { gray = 0 , hsb = { } , rgb = { } , cmyk = { } , type = " gray " }
3606 newstate . position = { }
3607 newstate . path = { }
3608 newstate . linewidth = 1
3609 newstate . linecap = 0
3610 newstate . linejoin = 0
3611 newstate . miterlimit = 10
3612 newstate . dashpattern = { }
3613 newstate . dashoffset = 0
3614 gsstate = newstate
3615 device . initgraphics ( )
3616 operators . initclip ( )
3617 return true
3618end
3619
3620function operators . setlinewidth ( )
3621 local a = pop_opstack ( )
3622 if not a then
3623 return ps_error ( ' stackunderflow ' )
3624 end
3625 local t = a [ 1 ]
3626 if not ( t = = ' integer ' or t = = ' real ' ) then
3627 return ps_error ( ' typecheck ' )
3628 end
3629 gsstate . linewidth = a [ 4 ]
3630 return true
3631end
3632
3633function operators . currentlinewidth ( )
3634 local w = gsstate . linewidth
3635 push_opstack {
3636 ( abs ( w ) > MAX_INT or floor ( w ) ~ = w ) and ' real ' or ' integer ' ,
3637 ' unlimited ' ,
3638 ' literal ' ,
3639 w ,
3640 }
3641 return true
3642end
3643
3644function operators . setlinecap ( )
3645 local a = pop_opstack ( )
3646 if not a then
3647 return ps_error ( ' stackunderflow ' )
3648 end
3649 if a [ 1 ] ~ = ' integer ' then
3650 return ps_error ( ' typecheck ' )
3651 end
3652 local c = a [ 4 ]
3653 if c > 2 or c < 0 then
3654 return ps_error ( ' rangecheck ' )
3655 end
3656 gsstate . linecap = c
3657 return true
3658end
3659
3660function operators . currentlinecap ( )
3661 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , gsstate . linecap }
3662 return true
3663end
3664
3665function operators . setlinejoin ( )
3666 local a = pop_opstack ( )
3667 if not a then
3668 return ps_error ( ' stackunderflow ' )
3669 end
3670 if a [ 1 ] ~ = ' integer ' then
3671 return ps_error ( ' typecheck ' )
3672 end
3673 local j = a [ 4 ]
3674 if j > 2 or j < 0 then
3675 return ps_error ( ' rangecheck ' )
3676 end
3677 gsstate . linejoin = j
3678 return true
3679end
3680
3681function operators . currentlinejoin ( )
3682 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , gsstate . linejoin }
3683 return true
3684end
3685
3686function operators . setmiterlimit ( )
3687 local a = pop_opstack ( )
3688 if not a then
3689 return ps_error ( ' stackunderflow ' )
3690 end
3691 local t = a [ 1 ]
3692 if not ( t = = ' integer ' or t = = ' real ' ) then
3693 return ps_error ( ' typecheck ' )
3694 end
3695 local m = a [ 4 ]
3696 if m < 1 then
3697 return ps_error ( ' rangecheck ' )
3698 end
3699 gsstate . miterlimit = m
3700 return true
3701end
3702
3703function operators . currentmiterlimit ( )
3704 local w = gsstate . miterlimit
3705 push_opstack {
3706 ( abs ( w ) > MAX_INT or floor ( w ) ~ = w ) and ' real ' or ' integer ' ,
3707 ' unlimited ' ,
3708 ' literal ' ,
3709 w
3710 }
3711 return true
3712end
3713
3714function operators . setdash ( )
3715 local b = pop_opstack ( )
3716 local a = pop_opstack ( )
3717 if not a then
3718 return ps_error ( ' stackunderflow ' )
3719 end
3720 local ta , tb = a [ 1 ] , b [ 1 ]
3721 if ta ~ = ' array ' then
3722 return ps_error ( ' typecheck ' )
3723 end
3724 if not ( tb = = ' integer ' or tb = = ' real ' ) then
3725 return ps_error ( ' typecheck ' )
3726 end
3727 local pattern = { }
3728 local total = 0
3729 local thearray = get_VM ( a [ 4 ] )
3730 for i = 1 , # thearray do
3731 local a = thearray [ i ]
3732 local ta , va = a [ 1 ] , a [ 4 ]
3733 if ta ~ = " integer " then
3734 return ps_error ( ' typecheck ' )
3735 end
3736 if va < 0 then
3737 return ps_error ( ' limitcheck ' )
3738 end
3739 total = total + va
3740 pattern [ # pattern + 1 ] = va
3741 end
3742 if # pattern > 0 and total = = 0 then
3743 return ps_error ( ' limitcheck ' )
3744 end
3745 gsstate . dashpattern = pattern
3746 gsstate . dashoffset = b [ 4 ]
3747 return true
3748end
3749
3750function operators . currentdash ( )
3751 local thearray = gsstate . dashpattern
3752 local pattern = { }
3753 for i = 1 , # thearray do
3754 pattern [ i ] = { ' integer ' , ' unlimited ' , ' literal ' , thearray [ i ] }
3755 end
3756 push_opstack { ' array ' , ' unlimited ' , ' literal ' , add_VM ( pattern ) , # pattern , # pattern }
3757 local w = gsstate . dashoffset
3758 push_opstack {
3759 ( abs ( w ) > MAX_INT or floor ( w ) ~ = w ) and ' real ' or ' integer ' , ' unlimited ' , ' literal ' , w
3760 }
3761 return true
3762end
3763
3764function operators . setflat ( )
3765 local a = pop_opstack ( )
3766 if not a then
3767 return ps_error ( ' stackunderflow ' )
3768 end
3769 local ta , va = a [ 1 ] , a [ 4 ]
3770 if not ( ta = = ' integer ' or ta = = ' real ' ) then
3771 return ps_error ( ' typecheck ' )
3772 end
3773 gsstate . flatness = va
3774 return true
3775end
3776
3777function operators . currentflat ( )
3778 local w = gsstate . flatness
3779 push_opstack {
3780 ( abs ( w ) > MAX_INT or floor ( w ) ~ = w ) and ' real ' or ' integer ' , ' unlimited ' , ' literal ' , w
3781 }
3782 return true
3783end
3784
3785
3786
3787
3788
3789
3790do
3791
3792 local function rgb_to_gray ( r , g , b )
3793 return 0 . 30 * r + 0 . 59 * g + 0 . 11 * b
3794 end
3795
3796 local function cmyk_to_gray ( c , m , y , k )
3797 return 0 . 30 * ( 1 . 0 - min ( 1 . 0 , c + k ) ) + 0 . 59 * ( 1 . 0 - min ( 1 . 0 , m + k ) ) + 0 . 11 * ( 1 . 0 - min ( 1 . 0 , y + k ) )
3798 end
3799
3800 local function cmyk_to_rgb ( c , m , y , k )
3801 return 1 . 0 - min ( 1 . 0 , c + k ) , 1 . 0 - min ( 1 . 0 , m + k ) , 1 . 0 - min ( 1 . 0 , y + k )
3802 end
3803
3804 local function rgb_to_hsv ( r , g , b )
3805 local offset , maximum , other_1 , other_2
3806 if r > = g and r > = b then
3807 offset , maximum , other_1 , other_2 = 0 , r , g , b
3808 elseif g > = r and g > = b then
3809 offset , maximum , other_1 , other_2 = 2 , g , b , r
3810 else
3811 offset , maximum , other_1 , other_2 = 4 , b , r , g
3812 end
3813 if maximum = = 0 then
3814 return 0 , 0 , 0
3815 end
3816 local minimum = other_1 < other_2 and other_1 or other_2
3817 if maximum = = minimum then
3818 return 0 , 0 , maximum
3819 end
3820 local delta = maximum - minimum
3821 return ( offset + ( other_1 - other_2 ) / delta ) / 6 , delta / maximum , maximum
3822 end
3823
3824 local function gray_to_hsv ( col )
3825 return 0 , 0 , col
3826 end
3827
3828 local function gray_to_rgb ( col )
3829 return 1 - col , 1 - col , 1 - col
3830 end
3831
3832 local function gray_to_cmyk ( col )
3833 return 0 , 0 , 0 , col
3834 end
3835
3836 local function hsv_to_rgb ( h , s , v )
3837 local hi = floor ( h * 6 . 0 ) % 6
3838 local f = ( h * 6 ) - floor ( h * 6 )
3839 local p = v * ( 1 - s )
3840 local q = v * ( 1 - f * s )
3841 local t = v * ( 1 - ( 1 - f ) * s )
3842 if hi = = 0 then
3843 return v , t , p
3844 elseif hi = = 1 then
3845 return q , v , p
3846 elseif hi = = 2 then
3847 return p , v , t
3848 elseif hi = = 3 then
3849 return p , q , v
3850 elseif hi = = 4 then
3851 return t , p , v
3852 elseif hi = = 5 then
3853 return v , p , q
3854 end
3855 end
3856
3857 local function hsv_to_gray ( h , s , v )
3858 return rgb_to_gray ( hsv_to_rgb ( h , s , v ) )
3859 end
3860
3861
3862
3863 function operators . setgray ( )
3864 local g = pop_opstack ( )
3865 if not g then
3866 return ps_error ( ' stackunderflow ' )
3867 end
3868 local gt = g [ 1 ]
3869 if not ( gt = = ' integer ' or gt = = ' real ' ) then
3870 return ps_error ( ' typecheck ' )
3871 end
3872 local gv = g [ 4 ]
3873 local color = gsstate . color
3874 color . type = " gray "
3875 color . gray = ( gv < 0 and 0 ) or ( gv > 1 and 1 ) or gv
3876 return true
3877 end
3878
3879 function operators . currentgray ( )
3880 local color = gsstate . color
3881 local t = color . type
3882 local s
3883 if t = = " gray " then
3884 s = color . gray
3885 elseif t = = " rgb " then
3886 local col = color . rgb
3887 s = rgb_to_gray ( col [ 1 ] , col [ 2 ] , col [ 3 ] )
3888 elseif t = = " cmyk " then
3889 local col = cmyk
3890 s = cmyk_to_gray ( col [ 1 ] , col [ 2 ] , col [ 3 ] , col [ 4 ] )
3891 else
3892 local col = color . hsb
3893 s = hsv_to_gray ( col [ 1 ] , col [ 2 ] , col [ 3 ] )
3894 end
3895 push_opstack { ( s = = 0 or s = = 1 ) and ' integer ' or ' real ' , ' unlimited ' , ' literal ' , s }
3896 return true
3897 end
3898
3899 function operators . sethsbcolor ( )
3900 local b = pop_opstack ( )
3901 local s = pop_opstack ( )
3902 local h = pop_opstack ( )
3903 if not h then
3904 return ps_error ( ' stackunderflow ' )
3905 end
3906 local ht , st , bt = h [ 1 ] , s [ 1 ] , b [ 1 ]
3907 if not ( ht = = ' integer ' or ht = = ' real ' ) then
3908 return ps_error ( ' typecheck ' )
3909 end
3910 if not ( st = = ' integer ' or st = = ' real ' ) then
3911 return ps_error ( ' typecheck ' )
3912 end
3913 if not ( bt = = ' integer ' or bt = = ' real ' ) then
3914 return ps_error ( ' typecheck ' )
3915 end
3916 local hv , sv , bv = h [ 4 ] , s [ 4 ] , b [ 4 ]
3917 local color = gsstate . color
3918 color . type = " hsb "
3919 color . hsb = {
3920 ( hv < 0 and 0 ) or ( hv > 1 and 1 ) or hv ,
3921 ( sv < 0 and 0 ) or ( sv > 1 and 1 ) or sv ,
3922 ( bv < 0 and 0 ) or ( bv > 1 and 1 ) or bv ,
3923 }
3924 return true
3925 end
3926
3927 function operators . currenthsbcolor ( )
3928 local color = gsstate . color
3929 local t = color . type
3930 local h , s , b
3931 if t = = " gray " then
3932 h , s , b = gray_to_hsv ( color . gray )
3933 elseif t = = " rgb " then
3934 local col = color . rgb
3935 h , s , b = rgb_to_hsv ( col [ 1 ] , col [ 2 ] , col [ 3 ] )
3936 elseif t = = " cmyk " then
3937 local col = color . cmyk
3938 h , s , b = cmyk_to_hsv ( col [ 1 ] , col [ 2 ] , col [ 3 ] , col [ 4 ] )
3939 else
3940 local col = color . hsb
3941 h , s , b = col [ 1 ] , col [ 2 ] , col [ 3 ]
3942 end
3943 push_opstack { ( h = = 0 or h = = 1 ) and ' integer ' or ' real ' , ' unlimited ' , ' literal ' , h }
3944 push_opstack { ( s = = 0 or s = = 1 ) and ' integer ' or ' real ' , ' unlimited ' , ' literal ' , s }
3945 push_opstack { ( b = = 0 or b = = 1 ) and ' integer ' or ' real ' , ' unlimited ' , ' literal ' , b }
3946 return true
3947 end
3948
3949 function operators . setrgbcolor ( )
3950 local b = pop_opstack ( )
3951 local g = pop_opstack ( )
3952 local r = pop_opstack ( )
3953 if not r then
3954 return ps_error ( ' stackunderflow ' )
3955 end
3956 local rt , gt , bt = r [ 1 ] , g [ 1 ] , b [ 1 ]
3957 if not ( rt = = ' integer ' or rt = = ' real ' ) then
3958 return ps_error ( ' typecheck ' )
3959 end
3960 if not ( gt = = ' integer ' or gt = = ' real ' ) then
3961 return ps_error ( ' typecheck ' )
3962 end
3963 if not ( bt = = ' integer ' or bt = = ' real ' ) then
3964 return ps_error ( ' typecheck ' )
3965 end
3966 local rv , gv , bv = r [ 4 ] , g [ 4 ] , b [ 4 ]
3967 local color = gsstate . color
3968 color . type = " rgb "
3969 color . rgb = {
3970 ( rv < 0 and 0 ) or ( rv > 1 and 1 ) or rv ,
3971 ( gv < 0 and 0 ) or ( gv > 1 and 1 ) or gv ,
3972 ( bv < 0 and 0 ) or ( bv > 1 and 1 ) or bv ,
3973 }
3974 return true
3975 end
3976
3977 function operators . currentrgbcolor ( )
3978 local color = gsstate . color
3979 local t = color . type
3980 local r , g , b
3981 if t = = " gray " then
3982 r , g , b = gray_to_rgb ( color . gray )
3983 elseif t = = " rgb " then
3984 local col = color . rgb
3985 r , g , b = col [ 1 ] , col [ 2 ] , col [ 3 ]
3986 elseif t = = " cmyk " then
3987 r , g , b = cmyk_to_rgb ( color . cmyk )
3988 else
3989 local col = color . hsb
3990 r , g , b = hsv_to_rgb ( col [ 1 ] , col [ 2 ] , col [ 3 ] )
3991 end
3992 push_opstack { ( r = = 0 or r = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , r }
3993 push_opstack { ( g = = 0 or g = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , g }
3994 push_opstack { ( b = = 0 or b = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , b }
3995 return true
3996 end
3997
3998 function operators . setcmykcolor ( )
3999 local k = pop_opstack ( )
4000 local y = pop_opstack ( )
4001 local m = pop_opstack ( )
4002 local c = pop_opstack ( )
4003 if not c then
4004 return ps_error ( ' stackunderflow ' )
4005 end
4006 local ct , mt , yt , kt = c [ 1 ] , m [ 1 ] , y [ 1 ] , k [ 1 ]
4007 if not ( ct = = ' integer ' or ct = = ' real ' ) then
4008 return ps_error ( ' typecheck ' )
4009 end
4010 if not ( mt = = ' integer ' or mt = = ' real ' ) then
4011 return ps_error ( ' typecheck ' )
4012 end
4013 if not ( yt = = ' integer ' or yt = = ' real ' ) then
4014 return ps_error ( ' typecheck ' )
4015 end
4016 if not ( kt = = ' integer ' or kt = = ' real ' ) then
4017 return ps_error ( ' typecheck ' )
4018 end
4019 local cv , mv , yv , kv = c [ 4 ] , m [ 4 ] , y [ 4 ] , k [ 4 ]
4020 local color = gsstate . color
4021 color . type = " cmyk "
4022 color . cmyk = {
4023 ( cv < 0 and 0 ) or ( cv > 1 and 1 ) or cv ,
4024 ( mv < 0 and 0 ) or ( mv > 1 and 1 ) or mv ,
4025 ( yv < 0 and 0 ) or ( yv > 1 and 1 ) or yv ,
4026 ( kv < 0 and 0 ) or ( kv > 1 and 1 ) or kv ,
4027 }
4028 return true
4029 end
4030
4031 function operators . currentcmykcolor ( )
4032 local color = gsstate . color
4033 local t = color . type
4034 local c , m , y , k
4035 if t = = " gray " then
4036 c , m , y , k = gray_to_cmyk ( color . gray )
4037 elseif t = = " rgb " then
4038 c , m , y , k = rgb_to_cmyk ( color . rgb )
4039 elseif t = = " cmyk " then
4040 local col = color . cmyk
4041 c , m , y , k = col [ 1 ] , col [ 2 ] , col [ 3 ] , col [ 4 ]
4042 else
4043 local col = color . hsb
4044 c , m , y , k = hsv_to_cmyk ( col [ 1 ] , col [ 2 ] , col [ 3 ] )
4045 end
4046 push_opstack { ( c = = 0 or c = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , c }
4047 push_opstack { ( m = = 0 or m = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , m }
4048 push_opstack { ( y = = 0 or y = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , y }
4049 push_opstack { ( k = = 0 or k = = 1 ) and " integer " or " real " , ' unlimited ' , ' literal ' , k }
4050 return true
4051 end
4052
4053end
4054
4055function operators . setscreen ( )
4056 local c = pop_opstack ( )
4057 local b = pop_opstack ( )
4058 local a = pop_opstack ( )
4059 if not a then
4060 return ps_error ( ' stackunderflow ' )
4061 end
4062 local ta , tb , tc , ac = a [ 1 ] , b [ 1 ] , c [ 1 ] , c [ 3 ]
4063 if not ( tc = = ' array ' and ac = = ' executable ' ) then
4064 return ps_error ( ' typecheck ' )
4065 end
4066 if not ( tb = = ' real ' or tb = = ' integer ' ) then
4067 return ps_error ( ' typecheck ' )
4068 end
4069 if not ( ta = = ' real ' or ta = = ' integer ' ) then
4070 return ps_error ( ' typecheck ' )
4071 end
4072 local va , vb , vc = a [ 4 ] , b [ 4 ] , c [ 4 ]
4073 if vb < 0 or vb > 360 then
4074 return ps_error ( ' rangecheck ' )
4075 end
4076 if va < 0 then
4077 return ps_error ( ' rangecheck ' )
4078 end
4079 gsstate . screen = { va , vb , vc }
4080 return true
4081end
4082
4083function operators . currentscreen ( )
4084 local w
4085 if not gsstate . screen then
4086 local popper = { ' operator ' , ' unlimited ' , ' executable ' , operators . pop , ' pop ' }
4087 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , 1 }
4088 push_opstack { ' integer ' , ' unlimited ' , ' literal ' , 0 }
4089 push_opstack { ' array ' , ' unlimited ' , ' executable ' , add_VM { popper } , 1 , 1 , ' d ' }
4090 else
4091 local w1 = gsstate . screen [ 1 ]
4092 local w2 = gsstate . screen [ 2 ]
4093 local w3 = gsstate . screen [ 3 ]
4094 push_opstack {
4095 ( abs ( w ) > MAX_INT or floor ( w1 ) ~ = w1 ) and ' real ' or ' integer ' , ' unlimited ' , ' literal ' , w1
4096 }
4097 push_opstack {
4098 ( abs ( w ) > MAX_INT or floor ( w2 ) ~ = w2 ) and ' real ' or ' integer ' , ' unlimited ' , ' literal ' , w2
4099 }
4100 local thearray = get_VM ( w3 )
4101 push_opstack { ' array ' , ' unlimited ' , ' executable ' , w3 , 1 , # thearray , ' d ' }
4102 end
4103 return true
4104end
4105
4106function operators . settransfer ( )
4107 local a = pop_opstack ( )
4108 if not a then
4109 return ps_error ( ' stackunderflow ' )
4110 end
4111 if not ( a [ 1 ] = = ' array ' and a [ 3 ] = = ' executable ' ) then
4112 return ps_error ( ' typecheck ' )
4113 end
4114 local va = a [ 4 ]
4115 if va < 0 then
4116 return ps_error ( ' rangecheck ' )
4117 end
4118 gsstate . transfer = va
4119 return true
4120end
4121
4122function operators . currenttransfer ( )
4123 local transfer = gsstate . transfer
4124 if not transfer then
4125 push_opstack { ' array ' , ' unlimited ' , ' executable ' , add_VM { } , 0 , 0 , ' d ' }
4126 else
4127 local thearray = get_VM ( transfer )
4128 push_opstack { ' array ' , ' unlimited ' , ' executable ' , transfer , 1 , # thearray , ' d ' }
4129 end
4130 return true
4131end
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141function operators . matrix ( )
4142 local matrix = {
4143 { ' real ' , ' unlimited ' , ' literal ' , 1 } ,
4144 { ' real ' , ' unlimited ' , ' literal ' , 0 } ,
4145 { ' real ' , ' unlimited ' , ' literal ' , 0 } ,
4146 { ' real ' , ' unlimited ' , ' literal ' , 1 } ,
4147 { ' real ' , ' unlimited ' , ' literal ' , 0 } ,
4148 { ' real ' , ' unlimited ' , ' literal ' , 0 } ,
4149 }
4150 push_opstack { ' array ' , ' unlimited ' , ' literal ' , add_VM ( matrix ) , 6 , 6 }
4151 return true
4152end
4153
4154function operators . initmatrix ( )
4155 gsstate . matrix = { 1 , 0 , 0 , 1 , 0 , 0 }
4156 return true
4157end
4158
4159function operators . identmatrix ( )
4160 local a = pop_opstack ( )
4161 if not a then return
4162 ps_error ( ' stackunderflow ' )
4163 end
4164 if a [ 1 ] ~ = ' array ' then
4165 return ps_error ( ' typecheck ' )
4166 end
4167 if a [ 6 ] < 6 then
4168 return ps_error ( ' rangecheck ' )
4169 end
4170 local m = VM [ a [ 4 ] ]
4171 m [ 1 ] = { ' real ' , ' unlimited ' , ' literal ' , 1 }
4172 m [ 2 ] = { ' real ' , ' unlimited ' , ' literal ' , 0 }
4173 m [ 3 ] = { ' real ' , ' unlimited ' , ' literal ' , 0 }
4174 m [ 4 ] = { ' real ' , ' unlimited ' , ' literal ' , 1 }
4175 m [ 5 ] = { ' real ' , ' unlimited ' , ' literal ' , 0 }
4176 m [ 6 ] = { ' real ' , ' unlimited ' , ' literal ' , 0 }
4177 a [ 5 ] = 6
4178 push_opstack ( a )
4179 return true
4180end
4181
4182operators . defaultmatrix = operators . identmatrix
4183
4184function operators . currentmatrix ( )
4185 local a = pop_opstack ( )
4186 if not a then
4187 return ps_error ( ' stackunderflow ' )
4188 end
4189 if a [ 1 ] ~ = ' array ' then
4190 return ps_error ( ' typecheck ' )
4191 end
4192 if a [ 6 ] < 6 then
4193 return ps_error ( ' rangecheck ' )
4194 end
4195 local thearray = get_VM ( a [ 4 ] )
4196 local matrix = gsstate . matrix
4197 for i = 1 , 6 do
4198 thearray [ i ] = { ' real ' , ' unlimited ' , ' literal ' , matrix [ i ] }
4199 end
4200 push_opstack { ' array ' , ' unlimited ' , ' literal ' , a [ 4 ] , 6 , 6 }
4201 return true
4202end
4203
4204function operators . setmatrix ( )
4205 local a = pop_opstack ( )
4206 if not a then
4207 return ps_error ( ' stackunderflow ' )
4208 end
4209 if a [ 1 ] ~ = ' array ' then
4210 return ps_error ( ' typecheck ' )
4211 end
4212 if a [ 6 ] ~ = 6 then
4213 return ps_error ( ' rangecheck ' )
4214 end
4215 local thearray = get_VM ( a [ 4 ] )
4216 local matrix = gsstate . matrix
4217 for i = 1 , # thearray do
4218 local a = thearray [ i ]
4219 local ta , tv = a [ 1 ] , a [ 4 ]
4220 if not ( ta = = ' real ' or ta = = ' integer ' ) then
4221 return ps_error ( ' typecheck ' )
4222 end
4223 if i > 6 then
4224 return ps_error ( ' rangecheck ' )
4225 end
4226 matrix [ i ] = tv
4227 end
4228 return true
4229end
4230
4231local function do_transform ( matrix , a , b )
4232 local x = matrix [ 1 ] * a + matrix [ 3 ] * b + matrix [ 5 ]
4233 local y = matrix [ 2 ] * a + matrix [ 4 ] * b + matrix [ 6 ]
4234 return x , y
4235end
4236
4237local function do_itransform ( matrix , a , b )
4238 local m1 = matrix [ 1 ]
4239 local m4 = matrix [ 4 ]
4240 if m1 = = 0 or m4 = = 0 then
4241 return nil
4242 end
4243 local x = ( a - matrix [ 5 ] - matrix [ 3 ] * b ) / m1
4244 local y = ( b - matrix [ 6 ] - matrix [ 2 ] * a ) / m4
4245 return x , y
4246end
4247
4248local function do_concat ( a , b )
4249 local a1 , a2 , a3 , a4 , a5 , a6 = a [ 1 ] , a [ 2 ] , a [ 3 ] , a [ 4 ] , a [ 5 ] , a [ 6 ]
4250 local b1 , b2 , b3 , b4 , b5 , b6 = b [ 1 ] , b [ 2 ] , b [ 3 ] , b [ 4 ] , b [ 5 ] , b [ 6 ]
4251 local c1 = a1 * b1 + a2 * b3
4252 local c2 = a1 * b2 + a2 * b4
4253 local c3 = a1 * b3 + a3 * b4
4254 local c4 = a3 * b2 + a4 * b4
4255 local c5 = a5 * b1 + a6 * b3 + b5
4256 local c6 = a5 * b2 + a6 * b4 + b6
4257
4258 return {
4259 abs ( c1 ) < 1.0e-16 and 0 or c1 ,
4260 abs ( c2 ) < 1.0e-16 and 0 or c2 ,
4261 abs ( c3 ) < 1.0e-16 and 0 or c3 ,
4262 abs ( c4 ) < 1.0e-16 and 0 or c4 ,
4263 abs ( c5 ) < 1.0e-16 and 0 or c5 ,
4264 abs ( c6 ) < 1.0e-16 and 0 or c6 ,
4265 }
4266end
4267
4268local function do_inverse ( a )
4269 local a1 , a2 , a3 , a4 , a5 , a6 = a [ 1 ] , a [ 2 ] , a [ 3 ] , a [ 4 ] , a [ 5 ] , a [ 6 ]
4270 local det = a1 * a4 - a3 * a2
4271 if det = = 0 then
4272 return nil
4273 end
4274 local c1 = a4 / det
4275 local c3 = - a3 / det
4276 local c2 = - a2 / det
4277 local c4 = a1 / det
4278 local c5 = ( a3 * a6 - a5 * a4 ) / det
4279 local c6 = ( a5 * a2 - a1 * a6 ) / det
4280 return {
4281 abs ( c1 ) < 1.0e-16 and 0 or c1 ,
4282 abs ( c2 ) < 1.0e-16 and 0 or c2 ,
4283 abs ( c3 ) < 1.0e-16 and 0 or c3 ,
4284 abs ( c4 ) < 1.0e-16 and 0 or c4 ,
4285 abs ( c5 ) < 1.0e-16 and 0 or c5 ,
4286 abs ( c6 ) < 1.0e-16 and 0 or c6 ,
4287 }
4288end
4289
4290function operators . translate ( )
4291 local a = pop_opstack ( )
4292 if not a then
4293 return ps_error ( ' stackunderflow ' )
4294 end
4295 if a [ 1 ] = = ' array ' then
4296 if a [ 6 ] ~ = 6 then
4297 return ps_error ( ' typecheck ' )
4298 end
4299 local tf = a
4300 local a = pop_opstack ( )
4301 local b = pop_opstack ( )
4302 if not b then
4303 return ps_error ( ' stackunderflow ' )
4304 end
4305 local ta , tb = a [ 1 ] , b [ 1 ]
4306 if not ( ta = = ' real ' or ta = = ' integer ' ) then
4307 return ps_error ( ' typecheck ' )
4308 end
4309 if not ( tb = = ' real ' or tb = = ' integer ' ) then
4310 return ps_error ( ' typecheck ' )
4311 end
4312 local m = VM [ tf [ 4 ] ]
4313 local old = { m [ 1 ] [ 4 ] , m [ 2 ] [ 4 ] , m [ 3 ] [ 4 ] , m [ 4 ] [ 4 ] , m [ 5 ] [ 4 ] , m [ 6 ] [ 4 ] }
4314 local c = do_concat ( old , { 1 , 0 , 0 , 1 , b [ 4 ] , a [ 4 ] } )
4315 for i = 1 , 6 do
4316 m [ i ] = { ' real ' , ' unlimited ' , ' literal ' , c [ i ] }
4317 end
4318 tf [ 5 ] = 6
4319 push_opstack ( tf )
4320 else
4321 local b = pop_opstack ( )
4322 local ta = a [ 1 ]
4323 local tb = b [ 1 ]
4324 if not ( ta = = ' real ' or ta = = ' integer ' ) then
4325 return ps_error ( ' typecheck ' )
4326 end
4327 if not ( tb = = ' real ' or tb = = ' integer ' ) then
4328 return ps_error ( ' typecheck ' )
4329 end
4330 gsstate . matrix = do_concat ( gsstate . matrix , { 1 , 0 , 0 , 1 , b [ 4 ] , a [ 4 ] } )
4331 end
4332 return true
4333end
4334
4335function operators . scale ( )
4336 local a = pop_opstack ( )
4337 if not a then
4338 return ps_error ( ' stackunderflow ' )
4339 end
4340 local ta = a [ 1 ]
4341 if ta = = ' array ' then
4342 local tf = a
4343 if a [ 6 ] ~ = 6 then
4344 return ps_error ( ' typecheck ' )
4345 end
4346 local a = pop_opstack ( )
4347 local b = pop_opstack ( )
4348 if not b then
4349 return ps_error ( ' stackunderflow ' )
4350 end
4351 local ta , tb = a [ 1 ] , b [ 1 ]
4352 if not ( ta = = ' real ' or ta = = ' integer ' ) then
4353 return ps_error ( ' typecheck ' )
4354 end
4355 if not ( tb = = ' real ' or tb = = ' integer ' ) then
4356 return ps_error ( ' typecheck ' )
4357 end
4358 local v = VM [ tf [ 4 ] ]
4359 local c = do_concat (
4360 { v [ 1 ] [ 4 ] , v [ 2 ] [ 4 ] , v [ 3 ] [ 4 ] , v [ 4 ] [ 4 ] , v [ 5 ] [ 4 ] , v [ 6 ] [ 4 ] } ,
4361 { b [ 4 ] , 0 , 0 , a [ 4 ] , 0 , 0 }
4362 )
4363 for i = 1 , 6 do
4364 v [ i ] = { ' real ' , ' unlimited ' , ' literal ' , c [ i ] }
4365 end
4366 tf [ 5 ] = 6
4367 push_opstack ( tf )
4368 else
4369 local b = pop_opstack ( )
4370 if not b then
4371 return ps_error ( ' stackunderflow ' )
4372 end
4373 local ta , tb = a [ 1 ] , b [ 1 ]
4374 if not ( ta = = ' real ' or ta = = ' integer ' ) then
4375 return ps_error ( ' typecheck ' )
4376 end
4377 if not ( tb = = ' real ' or tb = = ' integer ' ) then
4378 return ps_error ( ' typecheck ' )
4379 end
4380 gsstate . matrix = do_concat ( gsstate . matrix , { b [ 4 ] , 0 , 0 , a [ 4 ] , 0 , 0 } )
4381 end
4382 return true
4383end
4384
4385function operators . concat ( )
4386 local a = pop_opstack ( )
4387 if not a then
4388 return ps_error ( ' stackunderflow ' )
4389 end
4390 if a [ 1 ] ~ = " array " then
4391 return ps_error ( ' typecheck ' )
4392 end
4393 if a [ 6 ] ~ = 6 then
4394 return ps_error ( ' typecheck ' )
4395 end
4396 local thearray = get_VM ( a [ 4 ] )
4397 local l = { }
4398 for i = 1 , # thearray do
4399 local v = thearray [ i ]
4400 local t = v [ 1 ]
4401 if not ( t = = ' real ' or t = = ' integer ' ) then
4402 return ps_error ( ' typecheck ' )
4403 end
4404 l [ i ] = v [ 4 ]
4405 end
4406 gsstate . matrix = do_concat ( gsstate . matrix , l )
4407 return true
4408end
4409
4410function operators . concatmatrix ( )
4411 local tf = pop_opstack ( )
4412 local b = pop_opstack ( )
4413 local a = pop_opstack ( )
4414 if not a then
4415 return ps_error ( ' stackunderflow ' )
4416 end
4417 if tf [ 1 ] ~ = " array " then return ps_error ( ' typecheck ' ) end
4418 if b [ 1 ] ~ = " array " then return ps_error ( ' typecheck ' ) end
4419 if a [ 1 ] ~ = " array " then return ps_error ( ' typecheck ' ) end
4420 if tf [ 6 ] ~ = 6 then return ps_error ( ' typecheck ' ) end
4421 if b [ 6 ] ~ = 6 then return ps_error ( ' typecheck ' ) end
4422 if a [ 6 ] ~ = 6 then return ps_error ( ' typecheck ' ) end
4423 local al = { }
4424 local thearray = get_VM ( a [ 4 ] )
4425 for i = 1 , # thearray do
4426 local v = thearray [ i ]
4427 local tv = v [ 1 ]
4428 if not ( tv = = ' real ' or tv = = ' integer ' ) then
4429 return ps_error ( ' typecheck ' )
4430 end
4431 al [ i ] = v [ 4 ]
4432 end
4433 local bl = { }
4434 local thearray = get_VM ( b [ 4 ] )
4435 for i = 1 , # thearray do
4436 local v = thearray [ i ]
4437 local tv = v [ 1 ]
4438 if not ( tv = = ' real ' or tv = = ' integer ' ) then
4439 return ps_error ( ' typecheck ' )
4440 end
4441 bl [ i ] = v [ 4 ]
4442 end
4443 local c = do_concat ( al , bl )
4444 local m = VM [ tf [ 4 ] ]
4445 for i = 1 , 6 do
4446 m [ i ] = { ' real ' , ' unlimited ' , ' literal ' , c [ i ] }
4447 end
4448 tf [ 5 ] = 6
4449 push_opstack ( tf )
4450 return true
4451end
4452
4453function operators . rotate ( )
4454 local a = pop_opstack ( )
4455 if not a then
4456 return ps_error ( ' stackunderflow ' )
4457 end
4458 local ta = a [ 1 ]
4459 if ta = = ' array ' then
4460 local tf
4461 if a [ 6 ] ~ = 6 then
4462 return ps_error ( ' typecheck ' )
4463 end
4464 tf = a
4465 a = pop_opstack ( )
4466 if not a then
4467 return ps_error ( ' stackunderflow ' )
4468 end
4469 if not ( a [ 1 ] = = ' real ' or a [ 1 ] = = ' integer ' ) then
4470 return ps_error ( ' typecheck ' )
4471 end
4472 local m = VM [ tf [ 4 ] ]
4473 local old = { m [ 1 ] [ 4 ] , m [ 2 ] [ 4 ] , m [ 3 ] [ 4 ] , m [ 4 ] [ 4 ] , m [ 5 ] [ 4 ] , m [ 6 ] [ 4 ] }
4474 local av = a [ 4 ]
4475 local c = do_concat ( old , { cos ( rad ( av ) ) , sin ( rad ( av ) ) , - sin ( rad ( av ) ) , cos ( rad ( av ) ) , 0 , 0 } )
4476 for i = 1 , 6 do
4477 m [ i ] = { ' real ' , ' unlimited ' , ' literal ' , c [ i ] }
4478 end
4479 push_opstack ( tf )
4480 elseif ta = = ' real ' or ta = = ' integer ' then
4481 local av = a [ 4 ]
4482 gsstate . matrix = do_concat ( gsstate . matrix , { cos ( rad ( av ) ) , sin ( rad ( av ) ) , - sin ( rad ( av ) ) , cos ( rad ( av ) ) , 0 , 0 } )
4483 else
4484 return ps_error ( ' typecheck ' )
4485 end
4486 return true
4487end
4488
4489function operators . transform ( )
4490 local a = pop_opstack ( )
4491 local b = pop_opstack ( )
4492 if not b then
4493 ps_error ( ' stackunderflow ' )
4494 end
4495 local tf
4496 if a [ 1 ] = = ' array ' then
4497 if a [ 6 ] ~ = 6 then
4498 return ps_error ( ' typecheck ' )
4499 end
4500 local thearray = get_VM ( a [ 4 ] )
4501 tf = { }
4502 for i = 1 , # thearray do
4503 local v = thearray [ i ]
4504 local v1 = v [ 1 ]
4505 if not ( v1 = = ' real ' or v1 = = ' integer ' ) then
4506 return ps_error ( ' typecheck ' )
4507 end
4508 tf [ i ] = v [ 4 ]
4509 end
4510 a = pop_opstack ( )
4511 if not a then
4512 return ps_error ( ' stackunderflow ' )
4513 end
4514 else
4515 tf = gsstate . matrix
4516 end
4517 local a1 = a [ 1 ]
4518 local b1 = b [ 1 ]
4519 if not ( a1 = = ' real ' or a1 = = ' integer ' ) then
4520 return ps_error ( ' typecheck ' )
4521 end
4522 if not ( b1 = = ' real ' or b1 = = ' integer ' ) then
4523 return ps_error ( ' typecheck ' )
4524 end
4525 local x , y = do_transform ( tf , b [ 4 ] , a [ 4 ] ) ;
4526 push_opstack { ' real ' , ' unlimited ' , ' literal ' , x }
4527 push_opstack { ' real ' , ' unlimited ' , ' literal ' , y }
4528 return true
4529end
4530
4531local function commontransform ( )
4532 local a = pop_opstack ( )
4533 if not a then
4534 return ps_error ( ' stackunderflow ' )
4535 end
4536 local tf
4537 if a [ |