🚀 go-pugleaf

As promised, here is my routine for creating a reverse
video font. It allows you to create a reverse font in your prolog
from an existing Postscript font, and then use the reverse
font like any other font in your document.   At the end
of this is a short demo program that uses the routine.
You should delete that demo program if you just want the
font definition machinery.

Have fun with this.

========== cut here ======================================
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  reverse.ps
% 
% 18 Jan 1990
% Created by:
%  Bob Stayton
%  Technical Publications
%  The Santa Cruz Operation, Inc.
%  425 Encinal Street
%  Santa Cruz, CA  95060
%  (408) 425-7222
%  ...!uunet!sco!bobs
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This program creates a reversed font (white type on black
% background) from an existing Postscript font and prints
% an example.
%
% It defines one procedure: reversefont
% Its syntax is:
%
%         /oldfontname reversefont  ==> (reversed font dictionary)
%
%     where:   /oldfontname is the name of an existing Postscript font
%
%  It is typically used this way:
%
%    % Define the reversed font with name Reverse-Courier:
%        /Reverse-Courier /Courier reversefont definefont pop
%    % Set and scale the reverse font as the current font:
%        /Reverse-Courier findfont 12 scalefont setfont
%

/reversefont {			% procedure to make reverse font

/basefontname exch def		% stores the old name
/basefontdict basefontname findfont def  % gets the old font

/numentries basefontdict maxlength 20 add def   
basefontdict /UniqueID known not
	{ /numentries numentries 1 add def } if

/newfont numentries dict def	% defines the empty new font dictionary

   basefontdict					% copy it
	{ exch dup /FID ne			% except for FID
	   { exch newfont 3 1 roll put }
	   { pop pop }
	   ifelse
	} forall

% The following statement can be modified to give the new
% font an internal name other than "Reverse-Font".
% The internal name is not usually used by a Postscript
% program.  Rather, the name in the font dictionary
% established with definefont is used to call a font.
   newfont /FontName /Reverse-Font put		% new font name

/uniqueid 
	basefontdict dup
	/UniqueID known
	{ /UniqueID get 1 add }
	{ pop 1 }
	ifelse
	def

   newfont /UniqueID uniqueid put


newfont begin

/concatproc {				% concatenates the two
					% processes on the stack
	3 dict begin
	/proc2 exch cvlit def
	/proc1 exch cvlit def
	/newproc proc1 length proc2 length add
	   array def
	newproc 0 proc1 putinterval
	newproc proc1 length proc2 putinterval
	newproc cvx
	end
} def

/concatproc2 {				% concatenates a
					% string and process
	3 dict begin
	/proc2 exch cvlit def
	/proc1 exch cvlit def
	/newproc proc1 length proc2 length add
	   array def
	newproc 0 proc1 put
	newproc proc1 length proc2 putinterval
	newproc cvx
	end
} def

/temp 1 dict def
/box {			% stack: xwidth
	temp begin
	/cwidth exch def
  	0 ly moveto
  	cwidth 0  rlineto
  	0 uy ly sub rlineto
  	cwidth neg 0 rlineto
  	closepath
  	fill end } def

/str 1 string def
/intostring {			% stack: integer 
	str 0 3 -1 roll		% str 0 int
	put
	str			% returns a string
	} def

newfont /FontBBox get			% bounding box: [lx ly ux uy]
dup					% 2 copies of the array
dup					% 3 copies of the array
/uy exch 3 get def			% last number is upper-right y
/ux exch 2 get def			% next down is upper-right x
/ly exch 1 get def			% 2nd number is lower-left y

/FontType 3 def
/PaintType 3 def		% characters draw themselves

basefontdict setfont 
/Metrics 100 dict def
32 1 127 {
	dup
	Encoding exch get 	% stack: code /name
	dup			% stack: code /name /name
	/.notdef ne {		% stack: code /name true
		exch		% stack: /name code
		intostring		% stack: /name str
		stringwidth		% stack: /name x y
		pop	 		% stack: /name x
		% end
		1000 mul		% stack: /name 1000x
		newfont /Metrics get	% stack: /name 1000x Metrics
		3 1 roll		% stack: Metrics /name 1000x
		put } { pop pop } ifelse
	} for

/CharProcs 106 dict def
CharProcs begin
	32 1 127 { 
		/code exch def		% used to create proc
		/name Encoding code get def	% stack: nothing
		name /.notdef ne {    	% don't do for notdefs
		name 
		{ dup			 % proc called with integer
		Encoding exch get	% integer name
		Metrics exch get	 % integer xwidth
		  box			% box needs xwidth, leaves integer
		  0 0 moveto 1 setgray
		  basefontdict 1000 scalefont setfont
		  intostring
		  basefontdict /PaintType get 	% stroke or filled font?
		  0 eq				% 0 = filled font
		  {show} 			% if filled font
		  {40 setlinewidth false charpath stroke} % if stroked
		  ifelse
		  } def 
		  } if		% end "don't do for .notdef"
	} for
/.notdef { } def
end

/BuildChar {
	/char exch def		% integer
	/fontdict exch def	% font dictionary
	% /charname
	fontdict begin
	Encoding char get 	% name
	fontdict /Metrics get exch get 0  	% xwidth 0
	% 4 { pop } repeat
	setcharwidth
	char			% integer
	Encoding char get	% integer name
	CharProcs exch get	% integer {}
	exec
	end
} def

end		% end of newfont use
newfont 	% push the new font dictionary onto stack

} def				% end reversefont def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% These lines demonstrate reverse Times-Roman
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Define the reverse font:
   /Reverse-Times /Times-Roman reversefont definefont pop
% First show the regular font
   /Times-Roman findfont 12 scalefont setfont
   74 740 moveto (qwertyuiop][asdfghsdfjkl;'zxcvbnm,./) show
% Now show the reversed font
   /Reverse-Times findfont 12 scalefont setfont
   74 720 moveto (qwertyuiop][asdfghsdfjkl;'zxcvbnm,./) show

showpage
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% End of demo program
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%