mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
* added
This commit is contained in:
parent
14197fb830
commit
0609943465
365
demo/freebsd/fontdemo.pas
Normal file
365
demo/freebsd/fontdemo.pas
Normal file
@ -0,0 +1,365 @@
|
||||
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.
|
Loading…
Reference in New Issue
Block a user