gdiplus: Allow null-terminated strings in GdipDrawString.
[wine] / tools / winapi / output.pm
1 #
2 # Copyright 1999, 2000, 2001 Patrik Stridvall
3 #
4 # This library is free software; you can redistribute it and/or
5 # modify it under the terms of the GNU Lesser General Public
6 # License as published by the Free Software Foundation; either
7 # version 2.1 of the License, or (at your option) any later version.
8 #
9 # This library is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12 # Lesser General Public License for more details.
13 #
14 # You should have received a copy of the GNU Lesser General Public
15 # License along with this library; if not, write to the Free Software
16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
17 #
18
19 package output;
20
21 use strict;
22
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
24 require Exporter;
25
26 @ISA = qw(Exporter);
27 @EXPORT = qw();
28 @EXPORT_OK = qw($output);
29
30 use vars qw($output);
31
32 $output = '_output'->new;
33
34 package _output;
35
36 use strict;
37
38 my $stdout_isatty = -t STDOUT;
39 my $stderr_isatty = -t STDERR;
40
41 sub new($) {
42     my $proto = shift;
43     my $class = ref($proto) || $proto;
44     my $self  = {};
45     bless ($self, $class);
46
47     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
48     my $progress = \${$self->{PROGRESS}};
49     my $last_progress = \${$self->{LAST_PROGRESS}};
50     my $last_time = \${$self->{LAST_TIME}};
51     my $progress_count = \${$self->{PROGRESS_COUNT}};
52     my $prefix = \${$self->{PREFIX}};
53     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
54
55     $$progress_enabled = 1;
56     $$progress = "";
57     $$last_progress = "";
58     $$last_time = 0;
59     $$progress_count = 0;
60     $$prefix = undef;
61     $$prefix_callback = undef;
62
63     return $self;
64 }
65
66 sub DESTROY {
67     my $self = shift;
68
69     $self->hide_progress;
70 }
71
72 sub enable_progress($) {
73     my $self = shift;
74     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
75
76     $$progress_enabled = 1;
77 }
78
79 sub disable_progress($) {
80     my $self = shift;
81     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
82
83     $$progress_enabled = 0;
84 }
85
86 sub show_progress($) {
87     my $self = shift;
88     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
89     my $progress = ${$self->{PROGRESS}};
90     my $last_progress = \${$self->{LAST_PROGRESS}};
91     my $progress_count = \${$self->{PROGRESS_COUNT}};
92
93     $$progress_count++;
94
95     if($$progress_enabled) {
96         if($$progress_count > 0 && $$progress && $stderr_isatty) {
97             # If progress has more than $columns characters the xterm will
98             # scroll to the next line and our ^H characters will fail to
99             # erase it.
100             my $columns=$ENV{COLUMNS} || 80;
101             $progress = substr $progress,0,($columns-1);
102             print STDERR $progress;
103             $$last_progress = $progress;
104         }
105     }
106 }
107
108 sub hide_progress($)  {
109     my $self = shift;
110     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
111     my $progress = \${$self->{PROGRESS}};
112     my $last_progress = \${$self->{LAST_PROGRESS}};
113     my $progress_count = \${$self->{PROGRESS_COUNT}};
114
115     $$progress_count--;
116
117     if($$progress_enabled) {
118         if($$last_progress && $stderr_isatty) {
119             my $message="\b \b" x length($$last_progress);
120             print STDERR $message;
121             undef $$last_progress;
122         }
123     }
124 }
125
126 sub update_progress($) {
127     my $self = shift;
128     my $progress_enabled = \${$self->{PROGRESS_ENABLED}};
129     my $progress = ${$self->{PROGRESS}};
130     my $last_progress = \${$self->{LAST_PROGRESS}};
131
132     if($$progress_enabled) {
133         # If progress has more than $columns characters the xterm will
134         # scroll to the next line and our ^H characters will fail to
135         # erase it.
136         my $columns=$ENV{COLUMNS} || 80;
137         $progress = substr $progress,0,($columns-1);
138
139         my $prefix = "";
140         my $suffix = "";
141         if($$last_progress) {
142             $prefix = "\b" x length($$last_progress);
143
144             my $diff = length($$last_progress)-length($progress);
145             if($diff > 0) {
146                 $suffix = (" " x $diff) . ("\b" x $diff);
147             }
148         }
149         print STDERR $prefix, $progress, $suffix;
150         $$last_progress = $progress;
151     }
152 }
153
154 sub progress($$) {
155     my $self = shift;
156     my $progress = \${$self->{PROGRESS}};
157     my $last_time = \${$self->{LAST_TIME}};
158
159     my $new_progress = shift;
160     if(defined($new_progress)) {
161         if(!defined($$progress) || $new_progress ne $$progress) {
162             $$progress = $new_progress;
163
164             $self->update_progress;
165             $$last_time = 0;
166         }
167     } else {
168         return $$progress;
169     }
170 }
171
172 sub lazy_progress($$) {
173     my $self = shift;
174     my $progress = \${$self->{PROGRESS}};
175     my $last_time = \${$self->{LAST_TIME}};
176
177     $$progress = shift;
178
179     my $time = time();
180     if($time - $$last_time > 0) {
181         $self->update_progress;
182         $$last_time = $time;
183     }
184 }
185
186 sub prefix($$) {
187     my $self = shift;
188     my $prefix = \${$self->{PREFIX}};
189     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
190
191     my $new_prefix = shift;
192     if(defined($new_prefix)) {
193         if(!defined($$prefix) || $new_prefix ne $$prefix) {
194             $$prefix = $new_prefix;
195             $$prefix_callback = undef;
196         }
197     } else {
198         return $$prefix;
199     }
200 }
201
202 sub prefix_callback($) {
203     my $self = shift;
204
205     my $prefix = \${$self->{PREFIX}};
206     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
207
208     $$prefix = undef;
209     $$prefix_callback = shift;
210 }
211
212 sub write($$) {
213     my $self = shift;
214
215     my $message = shift;
216
217     my $prefix = \${$self->{PREFIX}};
218     my $prefix_callback = \${$self->{PREFIX_CALLBACK}};
219
220     $self->hide_progress if $stdout_isatty;
221     if(defined($$prefix)) {
222         print $$prefix . $message;
223     } elsif(defined($$prefix_callback)) {
224         print &{$$prefix_callback}() . $message;
225     } else {
226         print $message;
227     }
228     $self->show_progress if $stdout_isatty;
229 }
230
231 1;