1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
% bool values
/true 0 0 eq def
/false 0 0 ne def
% type values
/t_none 0 def
/t_int 1 def
/t_unsigned 2 def
/t_bool 3 def
/t_string 4 def
/t_code 5 def
/t_ret 6 def
/t_prim 7 def
/t_sec 8 def
/t_dict_idx 9 def
/t_array 10 def
/t_end 11 def
/t_ptr 12 def
/.value { t_int settype } def
/.undef 0 t_none settype def
/.end 0 t_end settype def
% Convert object to pointer.
%
% ( obj ) ==> ( ptr )
%
/cvp { t_ptr settype } def
/cvs { t_string settype } def
% ( size ) ==> ( string )
/string {
1 add malloc cvs
} def
% ( obj_1 ... obj_n string_1 string_2 ) ==> ( )
%
/sprintf {
dup cvp length exch snprintf
} def
% ( number ) ==> ( )
%
/number.print {
32 string
exch over
"%d" exch sprintf
dup show
free
} def
% Allocate and define a new color.
%
% ( palette ) ==> ( color )
%
/newcolor {
colorbits 8 le {
newcolor.count .undef eq { /newcolor.count 0 def } if
newcolor.count
dup rot setpalette
/newcolor.count newcolor.count 1 add def
} if
def
} def
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
% ( color0 color1 width height ) ==> ( )
/drawborder {
currentpoint /db.y0 exch def /db.x0 exch def
/db.y1 exch 1 sub db.y0 add def
/db.x1 exch 1 sub db.x0 add def
/db.col1 exch def
/db.col0 exch def
db.x0 db.y1 moveto
db.col0 setcolor
db.x0 db.y0 lineto db.x1 db.y0 lineto
db.col1 setcolor
db.x1 db.y1 lineto db.x0 db.y1 lineto
} def
640 480 8 findmode setmode not { false .end } if
"16x16.fnt" findfile setfont
% "sky.jpg" findfile setimage
% 0 0 moveto 0 0 image.size image
/black 0x000000 newcolor
/white 0xffffff newcolor
/gray 0x808080 newcolor
/blue 0x0000c0 newcolor
/green 0x00c000 newcolor
/red 0xf00000 newcolor
/yellow 0xe0e000 newcolor
/x 300 def
/y 100 def
/w 90 def
/h 50 def
/msg 200 string def
{
blue setcolor
0 0 moveto screen.size fillrect
h w y x "x %d, y %d, w %d, h %d" msg sprintf
0 0 moveto white setcolor msg show
x 1 sub y 1 sub moveto white white w 2 add h 2 add drawborder
green setcolor
x y moveto w h fillrect
x 1 add y 1 add moveto yellow yellow w 2 sub h 2 sub drawborder
x y moveto w h savescreen /s0 exch def
x 1 sub y 1 sub 200 add moveto red red w 2 add h 2 add drawborder
x y 200 add moveto s0 restorescreen
trace
/w w 1 sub def
} loop
|
