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.