mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 14:09:59 +02:00
365 lines
8.6 KiB
ObjectPascal
365 lines
8.6 KiB
ObjectPascal
Program FontDemo;
|
|
{ FontDemo.pas, by Marco van de Voort (C) 2000-2001
|
|
|
|
Compiler: 1.0.5 or 1.1 after 20-01-2001
|
|
Target : FreeBSD 4.x+ with 16x8 font. 3.x untested (syscons driver)
|
|
|
|
Demonstrate font modification with the console driver "syscons".
|
|
This program doesn't work under X or over telnet.
|
|
|
|
The purpose of the program is to demonstrate the procedures that change the
|
|
font. The demonstration assume a 80x25 console. Framebuffer devices or 80x50
|
|
displays (80x50 use 8x8 fonts) require a trivial modification.
|
|
|
|
The example of mirroring is absurd, but is very visible, so good for
|
|
demonstration. The real use is to load the font, change a few characters
|
|
(linedrawing, (C) characters, force existance of umlaute or tremas for the
|
|
duration of the application.
|
|
|
|
Note that if you switch to a different vty while the font is mirrored, that
|
|
vty is also mirrored.
|
|
|
|
Root can restore the font via a network device with:
|
|
|
|
vidcontrol -f 8x16 "fontname in /usr/share/syscons/fonts" < /dev/ttyv1
|
|
|
|
The program saves the font, and will terminate and restore the font when
|
|
SIGUSR2 is received, unless -n is specified.
|
|
|
|
killall -USR2 fontdemo
|
|
|
|
}
|
|
|
|
|
|
Uses Console,{$ifdef ver1_0}Linux{$else}Baseunix{$endif},GetOpts;
|
|
|
|
{$ifdef ver1_0}
|
|
function fpnanosleep;
|
|
begin
|
|
nanosleep;
|
|
end;
|
|
{$endif}
|
|
|
|
procedure MirrorFont8(var Data;Count:longint); assembler;
|
|
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
|
|
|
|
asm
|
|
mov data,%esi
|
|
movl Count,%edx
|
|
.LLoop1: movb (%esi),%bl
|
|
movl $8,%ecx
|
|
.LLoop2: shr $1,%bl
|
|
rcl $1,%al
|
|
loop .LLoop2
|
|
movb %al,(%esi)
|
|
incl %esi
|
|
decl %edx
|
|
jne .LLoop1
|
|
end['EAX','EBX','ECX','EDX','ESI'];
|
|
|
|
|
|
procedure GoLeft(var Data;Count:longint;shcnt:longint); assembler;
|
|
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
|
|
|
|
asm
|
|
mov data,%esi
|
|
mov data,%edi
|
|
mov shcnt,%ecx
|
|
movl Count,%edx
|
|
xorl %eax,%eax
|
|
.LLoop1: lodsb
|
|
shl %cl,%eax
|
|
stosb
|
|
incl %esi
|
|
incl %edi
|
|
decl %edx
|
|
jne .LLoop1
|
|
end['EAX','EBX','ECX','EDX','ESI'];
|
|
|
|
procedure GoRight(var Data;Count:longint;shcnt:longint); assembler;
|
|
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
|
|
|
|
asm
|
|
mov data,%esi
|
|
mov data,%edi
|
|
mov shcnt,%ecx
|
|
movl Count,%edx
|
|
xor %eax,%eax
|
|
.LLoop1: lodsb
|
|
shr %cl,%eax
|
|
stosb
|
|
incl %esi
|
|
incl %edi
|
|
decl %edx
|
|
jne .LLoop1
|
|
end['EAX','EBX','ECX','EDX','ESI'];
|
|
|
|
procedure DoAlt(var Data;Count:longint;shcnt:longint;alt:integer); assembler;
|
|
{Mirrors on a bit level "Count" bytes in typeless variable "Data"}
|
|
|
|
asm
|
|
mov alt,%ecx
|
|
mov data,%esi
|
|
mov data,%edi
|
|
add %ecx,%esi
|
|
add %ecx,%edi
|
|
|
|
mov shcnt,%ecx
|
|
movl Count,%edx
|
|
xorl %eax,%eax
|
|
.LLoop1: lodsb
|
|
mov %edx,%ebx
|
|
and $1,%ebx
|
|
test %ebx,%ebx
|
|
je .Lgoleftalt1
|
|
shl %cl,%eax
|
|
jmp .Lgoleftalt2
|
|
.Lgoleftalt1:
|
|
shr %cl,%eax
|
|
.Lgoleftalt2:
|
|
stosb
|
|
incl %esi
|
|
incl %edi
|
|
decl %edx
|
|
jne .LLoop1
|
|
end['EAX','EBX','ECX','EDX','ESI'];
|
|
|
|
procedure stripbits (var Data;Count:longint); assembler;
|
|
{ "Compresses" a byte. 76543210 -> x764310x where x=0 (but 0 was already
|
|
used to indicate bit number :-)
|
|
|
|
Needed for a rotating effect. (Character rotating round vertical axis)
|
|
Does this for "Count" bytes in "Data".
|
|
}
|
|
|
|
asm
|
|
mov data,%esi
|
|
movl Count,%edx
|
|
.LLoop1: movb (%esi),%cl
|
|
and $219,%ecx
|
|
mov %ecx,%eax
|
|
mov %ecx,%ebx
|
|
and $24,%eax
|
|
and $3,%bl
|
|
shr $1,%al
|
|
or %bl,%al
|
|
shl $1,%al
|
|
mov %ecx,%ebx
|
|
and $192,%bl
|
|
shl $1,%al
|
|
or %bl,%al
|
|
shr $1,%al
|
|
movb %al,(%esi)
|
|
incl %esi
|
|
decl %edx
|
|
jne .LLoop1
|
|
end['EAX','EBX','ECX','EDX','ESI'];
|
|
|
|
procedure silloute (var Data;Count:longint); assembler;
|
|
{Iterates through "Count" bytes of "Data" and sets a byte to $48 if it is
|
|
not zero. If you would rotate a character round vertical axis through 90
|
|
degrees, this is about how it looks like}
|
|
|
|
asm
|
|
mov data,%esi
|
|
movl Count,%edx
|
|
.LLoop1: movb (%esi),%al
|
|
mov $48,%ecx
|
|
test %al,%al
|
|
je .Lfurther
|
|
mov %cl,%al
|
|
.Lfurther:
|
|
movb %al,(%esi)
|
|
incl %esi
|
|
decl %edx
|
|
jne .LLoop1
|
|
end['EAX','EBX','ECX','EDX','ESI'];
|
|
|
|
var Originalfont : Fnt16; {Font on startup, to be saved for restore}
|
|
StopIt : BOOLEAN; {Becomes TRUE when SIGUSR2 is received}
|
|
RestoreOnExit : Boolean; {Should font be restored on exit?}
|
|
|
|
procedure OkThatsEnough(sig:longint);cdecl;
|
|
|
|
begin
|
|
StopIt:=TRUE;
|
|
end;
|
|
|
|
procedure dorotate;
|
|
|
|
{ The animation order of the 5 distinctive states, -> 8 changes is one
|
|
rotation}
|
|
Type RotStatesType = array[0..7] of longint;
|
|
|
|
const RotStates : RotStatesType=(0,1,4,3,2,3,4,1);
|
|
|
|
{5 states:
|
|
- 0 is mirrored,
|
|
- 1 mirrored "compressed"
|
|
- 2 is normal,
|
|
- 3 normal "compressed",
|
|
- 4 "silloutte"}
|
|
|
|
var fnts : array[0..4] of fnt16;
|
|
I : Longint;
|
|
iin,oout: timespec;
|
|
|
|
begin
|
|
iin.tv_nsec:=250000000;
|
|
iin.tv_sec:=0;
|
|
fnts[2]:=OriginalFont;
|
|
fnts[0]:=fnts[2]; // Keep a copy.
|
|
MirrorFont8(fnts[0],sizeof(fnt16)); // Mirror every byte at bitlevel
|
|
fnts[1]:=fnts[0];
|
|
stripbits(fnts[1],sizeof(fnt16));
|
|
fnts[3]:=fnts[2];
|
|
stripbits(fnts[3],sizeof(fnt16));
|
|
fnts[4]:=fnts[2];
|
|
silloute(fnts[4],sizeof(fnt16));
|
|
i:=4;
|
|
Repeat
|
|
PIO_FONT8x16(0,fnts[RotStates[I and 7]]); // Activate the mirrored set
|
|
fpnanosleep(@iin,@oout);
|
|
inc(i);
|
|
until StopIt;
|
|
end;
|
|
|
|
procedure upanddown(Mini:BOOLEAN);
|
|
|
|
var
|
|
fnts : array[1..4] OF fnt16;
|
|
inn,outn : Timespec;
|
|
i : longint;
|
|
Mask : Longint;
|
|
|
|
begin
|
|
fnts[2]:=OriginalFont;
|
|
inn.tv_nsec:=50000000;
|
|
inn.tv_sec:=0;
|
|
fnts[4]:=fnts[2]; {Make three copies}
|
|
fnts[1]:=fnts[2];
|
|
fnts[3]:=fnts[2];
|
|
|
|
{Move one of them one byte up in memory. Font is one bit lower}
|
|
|
|
move (fnts[1],fnts[1].fnt8x16[1],SIZEOF(Fnt16)-1);
|
|
|
|
{Move another of them one byte down in memory. Font is one bit higher}
|
|
IF Mini THEN
|
|
Begin
|
|
Mask:=1;
|
|
move (fnts[2].fnt8x16[1],fnts[2],SIZEOF(Fnt16)-1);
|
|
end
|
|
else
|
|
begin
|
|
move (fnts[3].fnt8x16[1],fnts[3],SIZEOF(Fnt16)-1);
|
|
Mask:=3;
|
|
end;
|
|
|
|
Repeat
|
|
fpnanosleep(@inn,@outn);
|
|
pIO_FONT8x16(0,fnts[1 + (I and Mask)]);
|
|
inc(I);
|
|
until StopIt;
|
|
end;
|
|
|
|
procedure LeftAndRight;
|
|
|
|
var
|
|
fnts : array[1..4] OF fnt16;
|
|
inn,outn : Timespec;
|
|
i : longint;
|
|
Mask : Longint;
|
|
|
|
begin
|
|
fnts[2]:=OriginalFont;
|
|
inn.tv_nsec:=50000000;
|
|
inn.tv_sec:=0;
|
|
fnts[4]:=fnts[2]; {Make three copies}
|
|
fnts[1]:=fnts[2];
|
|
fnts[3]:=fnts[2];
|
|
|
|
{Move one of them one byte up in memory. Font is one bit lower}
|
|
|
|
Goright(Fnts[1],SIZEOF(FNT16),2);
|
|
GoLeft( Fnts[3],SIZEOF(FNT16),2);
|
|
Repeat
|
|
fpnanosleep(@inn,@outn);
|
|
pIO_FONT8x16(0,fnts[1 + (I and 3)]);
|
|
inc(I);
|
|
until StopIt;
|
|
end;
|
|
|
|
procedure doalternate;
|
|
|
|
var
|
|
fnts : array[0..5] OF fnt16;
|
|
inn,outn : Timespec;
|
|
i : longint;
|
|
Mask : Longint;
|
|
|
|
begin
|
|
fnts[2]:=OriginalFont;
|
|
inn.tv_nsec:=500000000;
|
|
inn.tv_sec:=0;
|
|
fnts[4]:=fnts[2]; {Make three copies}
|
|
fnts[1]:=fnts[2];
|
|
fnts[3]:=fnts[2];
|
|
|
|
{Move one of them one byte up in memory. Font is one bit lower}
|
|
doalt(fnts[1],SIZEOF(FNT16) div 2,2,1);
|
|
doalt(fnts[3],SIZEOF(FNT16) div 2,2,0);
|
|
Repeat
|
|
fpnanosleep(@inn,@outn);
|
|
writeln(1 + (I and 3));
|
|
pIO_FONT8x16(0,fnts[1 + (I and 3)]);
|
|
inc(I);
|
|
until StopIt;
|
|
end;
|
|
|
|
procedure JustMirror;
|
|
|
|
var fnt : Fnt16;
|
|
|
|
begin
|
|
fnt:=OriginalFont;
|
|
MirrorFont8(fnt,sizeof(fnt16));
|
|
pIO_FONT8x16(0,fnt);
|
|
IF RestoreOnExit THEN
|
|
Repeat
|
|
until StopIt;
|
|
end;
|
|
|
|
var DoThis : Longint;
|
|
|
|
c : Char;
|
|
begin
|
|
DoThis:=0;
|
|
RestoreOnExit := TRUE;
|
|
if PhysicalConsole(0) then // a vty?
|
|
begin
|
|
REPEAT
|
|
c:=GetOpt('n012345'); // Commandline processing
|
|
IF c IN ['0'..'5'] Then
|
|
DoThis:= ORD(c)-48;
|
|
IF c='n' THEN
|
|
RestoreOnExit:=FALSE;
|
|
UNTIL C=EndOfOptions;
|
|
|
|
StopIt:=false; // Turns true on signal USR2
|
|
GIO_FONT8x16(0,OriginalFont); // Get font from videocard.
|
|
fpSignal(SIGUSR2,@OkThatsEnough); // Install handler for sigusr2.
|
|
|
|
CASE DoThis OF // Call the font routines
|
|
0 : DoRotate;
|
|
1 : UpAndDown(TRUE);
|
|
2 : JustMirror;
|
|
3 : UpAndDown(FALSE);
|
|
4 : LeftAndRight;
|
|
5 : doAlternate;
|
|
END;
|
|
|
|
IF RestoreOnExit THEN // clean up if required.
|
|
PIO_FONT8x16(0,OriginalFont);
|
|
end;
|
|
end. |