blob: bf8de7366a05f6432d9c71e238b77fa98e0ab736 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
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
|
% 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
% Allocate and define a new color.
%
% ( palette ) ==> ( color )
%
/newcolor {
colorbits 8 le {
newcolor.count .undef eq { /newcolor.count 0 def } if
max_image_colors newcolor.count add
dup rot setpalette
/newcolor.count newcolor.count 1 add def
} if
def
} 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
% 800 600 16 findmode setmode not { false .end } if
640 480 8 findmode setmode not { false .end } if
"test.pcx" findfile
setimage loadpalette
/max_image_colors image.colors def
/black 0x000000 newcolor
/white 0xffffff newcolor
white settextmodecolor
0 0 moveto 0 0 image.size image
/mouse xxx def
"16x16.fnt" findfile setfont
mouse .undef eq {
white setcolor
0 0 moveto "no mouse" show
trace
} if
{
black setcolor
0 0 moveto 100 60 fillrect
white setcolor
0 0 moveto
mouse getdword 16 shl 16 shr "x: " show number.print
0 20 moveto
mouse getdword 16 shr "y: " show number.print
0 40 moveto
mouse 4 add getdword 7 and
"b: " show
dup 1 and { "l" show } if
dup 2 and { "r" show } if
dup 4 and { "m" show } if
pop
100000 usleep
} loop
|
