← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to demo/freebsd/fontdemo.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
demo/freebsd/fontdemo.pas
 
1
Program FontDemo;
 
2
{ FontDemo.pas, by Marco van de Voort (C) 2000-2001
 
3
 
 
4
Compiler: 1.0.5 or 1.1 after 20-01-2001
 
5
Target  : FreeBSD 4.x+ with 16x8 font. 3.x untested  (syscons driver)
 
6
 
 
7
Demonstrate font modification with the console driver "syscons".
 
8
This program doesn't work under X or over telnet.
 
9
 
 
10
The purpose of the program is to demonstrate the procedures that change the
 
11
font. The demonstration assume a 80x25 console. Framebuffer devices or 80x50
 
12
displays (80x50 use 8x8 fonts) require a trivial modification.
 
13
 
 
14
The example of mirroring is absurd, but is very visible, so good for
 
15
demonstration. The real use is to load the font, change a few characters
 
16
(linedrawing, (C) characters, force existance of umlaute or tremas for the
 
17
duration of the application.
 
18
 
 
19
Note that if you switch to a different vty while the font is mirrored, that
 
20
vty is also mirrored.
 
21
 
 
22
Root can restore the font via a network device with:
 
23
 
 
24
vidcontrol -f 8x16 "fontname in /usr/share/syscons/fonts"   < /dev/ttyv1
 
25
 
 
26
The program saves the font, and will terminate and restore the font when
 
27
SIGUSR2 is received, unless -n is specified.
 
28
 
 
29
killall -USR2 fontdemo
 
30
 
 
31
}
 
32
 
 
33
 
 
34
Uses Console,{$ifdef ver1_0}Linux{$else}Baseunix{$endif},GetOpts;
 
35
 
 
36
{$ifdef ver1_0}
 
37
 function fpnanosleep;
 
38
 begin
 
39
   nanosleep;
 
40
 end;
 
41
{$endif}
 
42
 
 
43
procedure MirrorFont8(var Data;Count:longint); assembler;
 
44
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
 
45
 
 
46
asm
 
47
         mov data,%esi
 
48
         movl Count,%edx
 
49
.LLoop1: movb (%esi),%bl
 
50
         movl $8,%ecx
 
51
.LLoop2: shr  $1,%bl
 
52
         rcl  $1,%al
 
53
         loop .LLoop2
 
54
         movb %al,(%esi)
 
55
         incl %esi
 
56
         decl %edx
 
57
         jne .LLoop1
 
58
end['EAX','EBX','ECX','EDX','ESI'];
 
59
 
 
60
 
 
61
procedure GoLeft(var Data;Count:longint;shcnt:longint); assembler;
 
62
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
 
63
 
 
64
asm
 
65
         mov data,%esi
 
66
         mov data,%edi
 
67
         mov shcnt,%ecx
 
68
         movl Count,%edx
 
69
         xorl %eax,%eax
 
70
.LLoop1: lodsb
 
71
         shl  %cl,%eax
 
72
         stosb
 
73
         incl %esi
 
74
         incl %edi
 
75
         decl %edx
 
76
         jne .LLoop1
 
77
end['EAX','EBX','ECX','EDX','ESI'];
 
78
 
 
79
procedure GoRight(var Data;Count:longint;shcnt:longint); assembler;
 
80
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
 
81
 
 
82
asm
 
83
         mov data,%esi
 
84
         mov data,%edi
 
85
         mov shcnt,%ecx
 
86
         movl Count,%edx
 
87
         xor %eax,%eax
 
88
.LLoop1: lodsb
 
89
         shr  %cl,%eax
 
90
         stosb
 
91
         incl %esi
 
92
         incl %edi
 
93
         decl %edx
 
94
         jne .LLoop1
 
95
end['EAX','EBX','ECX','EDX','ESI'];
 
96
 
 
97
procedure DoAlt(var Data;Count:longint;shcnt:longint;alt:integer); assembler;
 
98
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
 
99
 
 
100
asm
 
101
         mov alt,%ecx
 
102
         mov data,%esi
 
103
         mov data,%edi
 
104
         add %ecx,%esi
 
105
         add %ecx,%edi
 
106
 
 
107
         mov shcnt,%ecx
 
108
         movl Count,%edx
 
109
         xorl %eax,%eax
 
110
.LLoop1: lodsb
 
111
         mov %edx,%ebx
 
112
         and  $1,%ebx
 
113
         test %ebx,%ebx
 
114
         je   .Lgoleftalt1
 
115
         shl  %cl,%eax
 
116
         jmp  .Lgoleftalt2
 
117
.Lgoleftalt1:
 
118
         shr  %cl,%eax
 
119
.Lgoleftalt2:
 
120
         stosb
 
121
         incl %esi
 
122
         incl %edi
 
123
         decl %edx
 
124
         jne .LLoop1
 
125
end['EAX','EBX','ECX','EDX','ESI'];
 
126
 
 
127
procedure stripbits (var Data;Count:longint); assembler;
 
128
{ "Compresses" a byte. 76543210 -> x764310x where x=0 (but 0 was already
 
129
used to indicate bit number :-)
 
130
 
 
131
Needed for a rotating effect. (Character rotating round vertical axis)
 
132
Does this for "Count" bytes in "Data".
 
133
}
 
134
 
 
135
asm
 
136
         mov data,%esi
 
137
         movl Count,%edx
 
138
.LLoop1: movb (%esi),%cl
 
139
         and  $219,%ecx
 
140
         mov  %ecx,%eax
 
141
         mov  %ecx,%ebx
 
142
         and  $24,%eax
 
143
         and  $3,%bl
 
144
         shr  $1,%al
 
145
         or   %bl,%al
 
146
         shl  $1,%al
 
147
         mov  %ecx,%ebx
 
148
         and  $192,%bl
 
149
         shl  $1,%al
 
150
         or   %bl,%al
 
151
         shr  $1,%al
 
152
         movb %al,(%esi)
 
153
         incl %esi
 
154
         decl %edx
 
155
         jne .LLoop1
 
156
end['EAX','EBX','ECX','EDX','ESI'];
 
157
 
 
158
procedure silloute (var Data;Count:longint); assembler;
 
159
{Iterates through "Count" bytes of "Data" and sets a byte to $48 if it is
 
160
not zero. If you would rotate a character round vertical axis through 90
 
161
degrees, this is about how it looks like}
 
162
 
 
163
asm
 
164
         mov data,%esi
 
165
         movl Count,%edx
 
166
.LLoop1: movb (%esi),%al
 
167
         mov  $48,%ecx
 
168
         test %al,%al
 
169
         je   .Lfurther
 
170
         mov  %cl,%al
 
171
.Lfurther:
 
172
         movb %al,(%esi)
 
173
         incl %esi
 
174
         decl %edx
 
175
         jne .LLoop1
 
176
end['EAX','EBX','ECX','EDX','ESI'];
 
177
 
 
178
var Originalfont : Fnt16;         {Font on startup, to be saved for restore}
 
179
    StopIt       : BOOLEAN;       {Becomes TRUE when SIGUSR2 is received}
 
180
    RestoreOnExit : Boolean;      {Should font be restored on exit?}
 
181
 
 
182
procedure OkThatsEnough(sig:longint);cdecl;
 
183
 
 
184
begin
 
185
 StopIt:=TRUE;
 
186
end;
 
187
 
 
188
procedure dorotate;
 
189
 
 
190
{ The animation order of the 5 distinctive states, -> 8 changes is one
 
191
rotation}
 
192
Type RotStatesType   = array[0..7] of longint;
 
193
 
 
194
const RotStates : RotStatesType=(0,1,4,3,2,3,4,1);
 
195
 
 
196
{5 states:
 
197
- 0 is mirrored,
 
198
- 1  mirrored "compressed"
 
199
- 2 is normal,
 
200
- 3 normal "compressed",
 
201
- 4 "silloutte"}
 
202
 
 
203
var fnts    : array[0..4] of fnt16;
 
204
    I       : Longint;
 
205
    iin,oout: timespec;
 
206
 
 
207
begin
 
208
   iin.tv_nsec:=250000000;
 
209
   iin.tv_sec:=0;
 
210
   fnts[2]:=OriginalFont;
 
211
   fnts[0]:=fnts[2];                    // Keep a copy.
 
212
   MirrorFont8(fnts[0],sizeof(fnt16));  // Mirror every byte at bitlevel
 
213
   fnts[1]:=fnts[0];
 
214
   stripbits(fnts[1],sizeof(fnt16));
 
215
   fnts[3]:=fnts[2];
 
216
   stripbits(fnts[3],sizeof(fnt16));
 
217
   fnts[4]:=fnts[2];
 
218
   silloute(fnts[4],sizeof(fnt16));
 
219
   i:=4;
 
220
   Repeat
 
221
     PIO_FONT8x16(0,fnts[RotStates[I and 7]]);          // Activate the mirrored set
 
222
     fpnanosleep(@iin,@oout);
 
223
     inc(i);
 
224
   until StopIt;
 
225
 end;
 
226
 
 
227
procedure upanddown(Mini:BOOLEAN);
 
228
 
 
229
var
 
230
    fnts      : array[1..4] OF fnt16;
 
231
    inn,outn  : Timespec;
 
232
    i         : longint;
 
233
    Mask      : Longint;
 
234
 
 
235
begin
 
236
   fnts[2]:=OriginalFont;
 
237
   inn.tv_nsec:=50000000;
 
238
   inn.tv_sec:=0;
 
239
   fnts[4]:=fnts[2];   {Make three copies}
 
240
   fnts[1]:=fnts[2];
 
241
   fnts[3]:=fnts[2];
 
242
 
 
243
   {Move one of them one byte up in memory. Font is one bit lower}
 
244
 
 
245
   move (fnts[1],fnts[1].fnt8x16[1],SIZEOF(Fnt16)-1);
 
246
 
 
247
   {Move another of them one byte down in memory. Font is one bit higher}
 
248
   IF Mini THEN
 
249
    Begin
 
250
     Mask:=1;
 
251
     move (fnts[2].fnt8x16[1],fnts[2],SIZEOF(Fnt16)-1);
 
252
    end
 
253
   else
 
254
    begin
 
255
     move (fnts[3].fnt8x16[1],fnts[3],SIZEOF(Fnt16)-1);
 
256
     Mask:=3;
 
257
    end;
 
258
 
 
259
   Repeat
 
260
     fpnanosleep(@inn,@outn);
 
261
     pIO_FONT8x16(0,fnts[1 + (I and Mask)]);
 
262
     inc(I);
 
263
   until StopIt;
 
264
end;
 
265
 
 
266
procedure LeftAndRight;
 
267
 
 
268
var
 
269
    fnts      : array[1..4] OF fnt16;
 
270
    inn,outn  : Timespec;
 
271
    i         : longint;
 
272
    Mask      : Longint;
 
273
 
 
274
begin
 
275
   fnts[2]:=OriginalFont;
 
276
   inn.tv_nsec:=50000000;
 
277
   inn.tv_sec:=0;
 
278
   fnts[4]:=fnts[2];   {Make three copies}
 
279
   fnts[1]:=fnts[2];
 
280
   fnts[3]:=fnts[2];
 
281
 
 
282
   {Move one of them one byte up in memory. Font is one bit lower}
 
283
 
 
284
   Goright(Fnts[1],SIZEOF(FNT16),2);
 
285
   GoLeft( Fnts[3],SIZEOF(FNT16),2);
 
286
   Repeat
 
287
     fpnanosleep(@inn,@outn);
 
288
     pIO_FONT8x16(0,fnts[1 + (I and 3)]);
 
289
     inc(I);
 
290
   until StopIt;
 
291
end;
 
292
 
 
293
procedure doalternate;
 
294
 
 
295
var
 
296
    fnts      : array[0..5] OF fnt16;
 
297
    inn,outn  : Timespec;
 
298
    i         : longint;
 
299
    Mask      : Longint;
 
300
 
 
301
begin
 
302
   fnts[2]:=OriginalFont;
 
303
   inn.tv_nsec:=500000000;
 
304
   inn.tv_sec:=0;
 
305
   fnts[4]:=fnts[2];   {Make three copies}
 
306
   fnts[1]:=fnts[2];
 
307
   fnts[3]:=fnts[2];
 
308
 
 
309
   {Move one of them one byte up in memory. Font is one bit lower}
 
310
   doalt(fnts[1],SIZEOF(FNT16) div 2,2,1);
 
311
   doalt(fnts[3],SIZEOF(FNT16) div 2,2,0);
 
312
   Repeat
 
313
     fpnanosleep(@inn,@outn);
 
314
     writeln(1 + (I and 3));
 
315
     pIO_FONT8x16(0,fnts[1 + (I and 3)]);
 
316
     inc(I);
 
317
   until StopIt;
 
318
end;
 
319
 
 
320
procedure JustMirror;
 
321
 
 
322
var fnt : Fnt16;
 
323
 
 
324
begin
 
325
  fnt:=OriginalFont;
 
326
  MirrorFont8(fnt,sizeof(fnt16));
 
327
  pIO_FONT8x16(0,fnt);
 
328
  IF RestoreOnExit THEN
 
329
  Repeat
 
330
  until StopIt;
 
331
end;
 
332
 
 
333
var DoThis        : Longint;
 
334
 
 
335
    c             : Char;
 
336
begin
 
337
 DoThis:=0;
 
338
 RestoreOnExit := TRUE;
 
339
 if PhysicalConsole(0) then             // a vty?
 
340
  begin
 
341
   REPEAT
 
342
    c:=GetOpt('n012345');                       // Commandline processing
 
343
    IF c IN ['0'..'5'] Then
 
344
     DoThis:= ORD(c)-48;
 
345
    IF c='n' THEN
 
346
     RestoreOnExit:=FALSE;
 
347
   UNTIL C=EndOfOptions;
 
348
 
 
349
   StopIt:=false;                       // Turns true on signal USR2
 
350
   GIO_FONT8x16(0,OriginalFont);        // Get font from videocard.
 
351
   fpSignal(SIGUSR2,@OkThatsEnough);    // Install handler for sigusr2.
 
352
 
 
353
   CASE DoThis OF                       // Call the font routines
 
354
    0 : DoRotate;
 
355
    1 : UpAndDown(TRUE);
 
356
    2 : JustMirror;
 
357
    3 : UpAndDown(FALSE);
 
358
    4 : LeftAndRight;
 
359
    5 : doAlternate;
 
360
    END;
 
361
 
 
362
   IF RestoreOnExit THEN                // clean up if required.
 
363
    PIO_FONT8x16(0,OriginalFont);
 
364
  end;
 
365
end.
 
 
b'\\ No newline at end of file'