*#######################################################################
*               Program DFONT...Create Scientific Font
*
*                       Dr. David C. Wilcox
*                       DCW Industries, Inc.
*               5354 Palm Drive, La Canada, CA  91011
*                          818/790-3844
*
*                         March 21, 1986
*#######################################################################
boot	equ	00		*warm boot
list	equ	05		*send character to printer
pstring	equ	09		*send string to console
bell	equ	07		*ascii bel
lf	equ	10		*line feed
ff	equ	12		*form feed
cr	equ	13		*carriage return
esc	equ	27		*ascii escape
space	equ	32		*ascii space
bdos	equ	$0002		*bdos entry point
*#######################################################################
*
* Locate FCB (for portability)
*
	link	a6,#0		*mark stack frame
	move.l	8(a6),a0	*get base page address
	lea	$5c(a0),a6	*get address of FCB and save it in a6
*
* Send scientific font definition to printer
*
	movea.l	#scifont,a1
	jsr	lpsend
*
* Send "font-loaded" message to console
*
	move.l	#fontmsg,d1
	move.w	#pstring,d0
	trap	#bdos
*
* Check for sample <P>rint requested
*
	cmpi.b	#'P',1(a6)
	bne	quit
*
* Do a sample print
*
	movea.l	#line1,a1		*first line...regular font
	jsr	lpsend
	jsr	crlf
	movea.l	#sfont,a1
	jsr	lpsend
	movea.l	#line1,a1		*first line...new font
	jsr	lpsend
	movea.l	#efont,a1
	jsr	lpsend
	jsr	crlf
	jsr	crlf
*
	movea.l	#line2,a1		*second line...regular font
	jsr	lpsend
	jsr	crlf
	movea.l	#sfont,a1
	jsr	lpsend
	movea.l	#line2,a1		*second line...new font
	jsr	lpsend
	movea.l	#efont,a1
	jsr	lpsend
	jsr	crlf
	jsr	crlf
*
	movea.l	#line3,a1		*third line...regular font
	jsr	lpsend
	jsr	crlf
	movea.l	#sfont,a1
	jsr	lpsend
	movea.l	#line3,a1		*third line...new font
	jsr	lpsend
	movea.l	#efont,a1
	jsr	lpsend
	jsr	crlf
	jsr	crlf
*
	movea.l	#line4,a1		*fourth line...regular font
	jsr	lpsend
	jsr	crlf
	movea.l	#sfont,a1
	jsr	lpsend
	movea.l	#line4,a1		*fourth line...new font
	jsr	lpsend
	movea.l	#efont,a1
	jsr	lpsend
*
	move.w	#ff,d1			*page eject
	move.w	#list,d0
	trap	#bdos
*
* Return to CP/M
*
quit:
	move.w	#boot,d0		*and return to CP/M
	trap	#bdos
*
* Send string terminated by lf to printer
*
lpsend:	move.b	(a1)+,d1	*keep looping until a lf is found
	cmpi.b	#lf,d1		*(lf is safe...it's been avoided
	bne	sendit		*in defining the font)
	rts			*return when it's found
sendit:	move.w	#list,d0
	trap	#bdos
	bra	lpsend
*
* Send a carriage return/line feed pair to printer
*
crlf:	move.w	#cr,d1
	move.w	#list,d0
	trap	#bdos
	move.w	#lf,d1
	move.w	#list,d0
	trap	#bdos
	rts
*#######################################################################
*              Sample print strings and console message
*#######################################################################
efont:	dc.b	esc,'%',0,lf
sfont:	dc.b	esc,'%',1,lf
line1:	dc.b	'1234567890-=   !@#$%^&*()_+   ~\|',lf
line2:	dc.b	'qwertyuiop{}   QWERTYUIOP[]',lf
line3:	dc.b	'asdfghjkl;',39,'    ASDFGHJKL:"',lf
line4:	dc.b	'zxcvbnm,./     ZXCVBNM<>?',lf
fontmsg:dc.b	cr,lf,'SCIENTIFIC font now loaded...'
	dc.b	'DRAFT mode',cr,lf,'$'
*#######################################################################
*           Epson LQ-1500...draft mode font definition
*#######################################################################
scifont:
* Select draft mode
lq:	dc.b	esc,'x',0
* Copy ROM characters to RAM
romram:	dc.b	esc,':',0,0,0
* Redefine characters from " to $
init1:	dc.b	esc,'&',0,'"$'
* Define " = therefore symbol
thrfor:	dc.b	2,9,1
	dc.b	0,0,96,      0,0,0,       0,0,96,       3,0,0
	dc.b	0,0,0,       3,0,0,       0,0,96,       0,0,0
	dc.b	0,0,96
* Define # = twiddle
twid:	dc.b	2,9,1 
	dc.b	0,4,0,       0,16,0,      0,32,0,       0,16,0
	dc.b	0,4,0,       0,1,0,       0,0,128,      0,1,0
	dc.b	0,4,0
* Define $ = large integral
lint:	dc.b	2,9,1
	dc.b	0,0,6,       0,0,1,       0,0,4,        11,85,81
	dc.b	32,0,4,      139,85,80,   32,0,0,       128,0,0
	dc.b	80,0,0
* Redefine characters from & to '
init2:	dc.b	esc,'&',0,'&',39
* Define & = dagger
dagger:	dc.b	2,9,1
	dc.b	0,0,0,       4,0,0,       0,0,0,        4,0,0
	dc.b	170,170,0,   4,0,0,       0,0,0,        4,0,0
	dc.b	0,0,0
* Define ' = prime symbol
prime:	dc.b	2,9,1
	dc.b	0,0,0,       0,0,0,       0,0,0,        0,0,0
	dc.b	42,160,0,    0,0,0,       0,0,0,        0,0,0
	dc.b	0,0,0
* Redefine characters from , to ,
init3:	dc.b	esc,'&',0,',,'
* Define , = dot
dot:	dc.b	2,9,1
	dc.b	0,0,0,       0,0,0,       0,8,0,        0,20,0
	dc.b	0,42,0,      0,20,0,      0,8,0,        0,0,0
	dc.b	0,0,0
* Redefine characters from : to ;
init4:	dc.b	esc,'&',0,':;'
* Define : = summation sigma
sumsig:	dc.b	2,9,1
	dc.b	128,0,1,     32,0,4,      136,0,17,     2,0,64
	dc.b	128,129,1,   0,36,0,      128,24,1,     0,0,0
	dc.b	168,0,21
* Define ; = product pi
prodpi:	dc.b	2,9,1
	dc.b	128,0,0,     0,0,0,       170,173,85,   0,0,0
	dc.b	128,0,0,     0,0,0,       170,173,85,   0,0,0
	dc.b	128,0,0
* Redefine characters from ? to Z
init5:	dc.b	esc,'&',0,'?Z'
* Define ? = division sign
divide:	dc.b	2,9,1
	dc.b	0,16,0,      0,0,0,       0,16,0,       6,0,192
	dc.b	0,16,0,      6,0,192,     0,16,0,       0,0,0
	dc.b	0,16,0
* Define @ = copyright symbol
cpyrt:	dc.b	2,9,1
	dc.b	1,84,0,      4,1,0,       8,168,128,    17,4,64
	dc.b	2,2,0,       17,4,64,     8,136,128,    4,1,0
	dc.b	1,84,0
* Define A = subscript infinity
sinfin:	dc.b	2,9,1
	dc.b	0,0,224,     0,1,16,      0,2,8,        0,1,16
	dc.b	0,0,224,     0,1,16,      0,2,8,        0,1,16
	dc.b	0,0,224
* Define B = infinity
infin:	dc.b	1,9,2
	dc.b	0,56,0,      0,68,0,      0,130,0,      0,68,0
	dc.b	0,56,0,      0,68,0,      0,130,0,      0,68,0
	dc.b	0,56,0
* Define C = upper case psi
upsi:	dc.b	2,9,1
	dc.b	1,80,0,      0,4,0,       32,2,32,      0,0,0
	dc.b	42,86,160,   0,0,0,       32,2,32,      0,4,0
	dc.b	1,80,0
* Define D = curly d (partial derivative operator)
curlyd:	dc.b	1,9,2
	dc.b	16,0,0,      0,5,0,       4,16,64,      0,0,0
	dc.b	1,32,32,     0,0,0,       0,64,32,      0,32,64
	dc.b	0,11,0
* Define E = large left bracket
lbrack:	dc.b	2,9,1
	dc.b	0,0,0,       170,181,85,  0,0,0,        170,181,85
	dc.b	0,0,0,       160,0,5,     0,0,0,        160,0,5
	dc.b	0,0,0
* Define F = upper case phi
uphi:	dc.b	2,9,1
	dc.b	0,168,0,     2,2,0,       32,0,32,      4,1,0
	dc.b	42,170,160,  4,1,0,       32,0,32,      2,2,0
	dc.b	0,168,0
* Define G = upper case gamma
ugamma:	dc.b	1,9,2
	dc.b	42,170,160,  0,0,0,       32,0,0,       0,0,0
	dc.b	32,0,0,      0,0,0,       32,0,0,       0,0,0
	dc.b	42,0,0
* Define H = proportionality symbol
propor:	dc.b	1,9,2
	dc.b	0,56,0,      0,68,0,      0,130,0,      0,68,0
	dc.b	0,56,0,      0,68,0,      0,130,0,      0,0,0
	dc.b	0,130,0
* Define I = small integral
sint:	dc.b	2,9,2
	dc.b	0,0,12,      0,0,2,       0,0,1,        0,0,2
	dc.b	42,173,84,   64,0,0,      128,0,0,      64,0,0
	dc.b	48,0,0
* Define J = upper case theta
utheta:	dc.b	2,9,1
	dc.b	1,116,0,     4,1,0,       16,32,64,     0,0,0
	dc.b	32,32,32,    0,0,0,       16,32,64,     4,1,0
	dc.b	1,116,0
* Define K = right arrow
rarow:	dc.b	2,9,1
	dc.b	0,16,0,      0,0,0,       0,16,0,       0,0,0
	dc.b	1,17,0,      0,0,0,       0,84,0,       0,0,0
	dc.b	0,16,0
* Define L = upper case lambda
ulamda:	dc.b	2,9,1
	dc.b	0,2,160,     0,16,0,      0,128,0,      4,0,0
	dc.b	32,0,0,      4,0,0,       0,128,0,      0,16,0
	dc.b	0,2,160
* Define M = script l
lmix:	dc.b	2,9,1
	dc.b	0,0,0,       0,0,32,      11,72,128,    32,2,0
	dc.b	0,8,128,     32,32,32,    14,128,32,    0,0,0
	dc.b	0,0,0
* Define N = large right bracket
rbrack:	dc.b	2,9,1
	dc.b	0,0,0,       160,0,5,     0,0,0,        160,0,5
	dc.b	0,0,0,       170,181,85,  0,0,0,        170,181,85
	dc.b	0,0,0
* Define O = cross product
cross:	dc.b	2,9,1
	dc.b	0,0,0,       1,0,64,      0,65,0,       0,20,0
	dc.b	0,0,0,       0,20,0,      0,65,0,       1,0,64
	dc.b	0,0,0
* Define P = upper case pi
upi:	dc.b	1,9,2
	dc.b	32,0,0,      0,0,0,       42,170,160,   0,0,0
	dc.b	32,0,0,      0,0,0,       42,170,160,   0,0,0
	dc.b	32,0,0
* Define Q = upper case delta
udelta:	dc.b	2,9,1
	dc.b	0,2,160,     0,16,0,      0,128,32,     4,0,0
	dc.b	32,0,32,     4,0,0,       0,128,32,     0,16,0
	dc.b	0,2,160
* Define R = square root
root:	dc.b	2,9,1
	dc.b	0,0,128,     0,0,40,      0,0,2,        0,0,40
	dc.b	0,2,128,     0,40,0,      2,128,0,      40,0,0
	dc.b	128,0,0
* Define S = upper case sigma
usigma:	dc.b	1,9,2
	dc.b	32,0,32,     8,0,128,     34,2,32,      0,136,0
	dc.b	32,32,32,    0,0,0,       32,0,32,      0,0,0
	dc.b	42,2,160
* Define T = overbar
over:	dc.b	1,9,2
	dc.b	128,0,0,     0,0,0,       128,0,0,      0,0,0
	dc.b	128,0,0,     0,0,0,       128,0,0,      0,0,0
	dc.b	128,0,0
* Define U = upper case upsilon
uupsi:	dc.b	2,9,1
	dc.b	4,0,0,       8,0,0,       4,0,32,       2,0,0
	dc.b	0,170,160,   2,0,0,       4,0,32,       8,0,0
	dc.b	4,0,0
* Define V = approximately equal with a dot
eqdot:	dc.b	2,9,1
	dc.b	0,33,0,      0,0,0,       0,33,0,       12,0,0
	dc.b	0,33,0,      12,0,0,      0,33,0,       0,0,0
	dc.b	0,33,0
* Define W = upper case omega
uomega:	dc.b	1,9,2
	dc.b	2,160,32,    8,8,0,       32,2,160,     0,0,0
	dc.b	32,0,0,      0,0,0,       32,2,160,     8,8,0
	dc.b	2,160,32
* Define X = upper case xi
uexi:	dc.b	2,9,1
	dc.b	42,2,160,    0,0,0,       32,32,32,     0,0,0
	dc.b	32,32,32,    0,0,0,       32,32,32,     0,0,0
	dc.b	42,2,160
* Define Y = identically equal
eqidnt:	dc.b	2,9,1
	dc.b	4,33,0,      0,0,0,       4,33,0,       0,0,0
	dc.b	4,33,0,      0,0,0,       4,33,0,       0,0,0
	dc.b	4,33,0
* Define Z = subscript tau
stau:	dc.b	1,9,2
	dc.b	0,0,0,       0,32,0,      0,0,0,        0,42,176
	dc.b	0,0,8,       0,32,16,     0,16,0,       0,4,0
	dc.b	0,0,0
* Redefine characters from \ to \
init6:	dc.b	esc,'&',0,'\\'
* Define \ = vertical bar
vert:	dc.b	2,9,1
	dc.b	0,0,0,       0,0,0,       0,0,0,        0,0,0
	dc.b	170,173,85,  0,0,0,       0,0,0,        0,0,0
	dc.b	0,0,0
* Redefine characters from a to c
init7:	dc.b	esc,'&',0,'ac'
* Define a = lower case alpha
lalpha:	dc.b	2,9,1
	dc.b	0,42,128,    0,0,0,       0,128,32,     0,0,0
	dc.b	0,32,128,    0,0,0,       0,4,0,        0,32,128
	dc.b	0,128,32
* Define b = lower case beta
lbeta:	dc.b	2,9,1
	dc.b	0,0,0,       0,85,84,     2,0,128,      8,0,64
	dc.b	32,64,32,    0,0,0,       32,160,64,    14,20,128
	dc.b	0,0,0
* Define c = lower case psi
lpsi:	dc.b	2,9,1
	dc.b	1,80,0,      0,4,0,       0,2,0,        0,0,0
	dc.b	42,170,160,  0,0,0,       0,2,0,        0,4,0
	dc.b	1,80,0
* Redefine characters from e to z
init8:	dc.b	esc,'&',0,'ez'
* Define e = lower case epsilon
leps:	dc.b	2,9,1
	dc.b	0,21,0,      0,64,64,     0,4,0,        0,128,32
	dc.b	0,4,0,       0,128,32,    0,4,0,        0,128,32
	dc.b	0,0,0
* Define f = lower case phi
lphi:	dc.b	2,9,1
	dc.b	0,0,0,       0,168,0,     2,2,0,        0,0,0
	dc.b	42,170,160,  0,0,0,       2,2,0,        0,168,0
	dc.b	0,0,0
* Define g = lower case gamma
lgamma:	dc.b	2,9,1
	dc.b	0,128,0,     2,0,0,       4,0,0,        2,0,0
	dc.b	0,128,0,     0,106,160,   1,0,0,        4,0,0
	dc.b	0,0,0
* Define h = lower case eta
leta:	dc.b	2,9,1
	dc.b	0,0,0,       0,170,160,   0,16,0,       0,64,0
	dc.b	0,128,0,     0,64,0,      0,21,84,      0,0,0
	dc.b	0,0,0
* Define i = lower case iota
liota:	dc.b	2,9,1
	dc.b	0,0,0,       0,0,0,       0,0,0,        0,170,192
	dc.b	0,0,32,      0,0,192,     0,0,0,        0,0,0
	dc.b	0,0,0
* Define j = lower case theta
ltheta:	dc.b	2,9,1
	dc.b	0,0,0,       0,168,0,     4,1,0,        16,32,64
	dc.b	32,0,32,     16,32,64,    4,1,0,        0,168,0
	dc.b	0,0,0
* Define k = lower case kappa
lkappa:	dc.b	2,9,1
	dc.b	0,170,160,   0,4,0,       0,0,0,        0,17,0
	dc.b	0,0,0,       0,64,64,     0,0,0,        0,128,32
	dc.b	0,0,0
* Define l = lower case lambda
llamda:	dc.b	2,9,1
	dc.b	32,0,32,     0,1,0,       16,8,0,       4,32,0
	dc.b	0,128,0,     0,16,0,      0,2,0,        0,0,128
	dc.b	0,0,32
* Define m = lower case mu
lmu:	dc.b	2,9,1
	dc.b	1,85,84,     0,0,128,     0,0,64,       0,0,32
	dc.b	0,0,64,      0,0,128,     0,2,0,        1,85,160
	dc.b	0,0,0
* Define n = lower case nu
lnu:	dc.b	1,9,2
	dc.b	0,0,0,       0,128,0,     0,64,0,       0,32,0
	dc.b	0,8,0,       0,2,160,     0,0,64,       0,1,0
	dc.b	0,168,0
* Define o = lower case omicron
lomi:	dc.b	2,9,1
	dc.b	0,0,0,       0,21,0,      0,64,64,      0,0,0
	dc.b	0,128,32,    0,0,0,       0,64,64,      0,21,0
	dc.b	0,0,0
* Define p = lower case pi
lpi:	dc.b	2,9,1
	dc.b	0,128,0,     0,0,0,       0,170,160,    0,0,0
	dc.b	0,128,0,     0,0,0,       0,170,160,    0,0,0
	dc.b	0,128,0
* Define q = lower case delta
ldelta:	dc.b	2,9,1
	dc.b	0,0,0,       0,5,0,       14,144,64,    16,64,32
	dc.b	32,32,0,     16,16,32,    8,8,64,       0,2,128
	dc.b	0,0,0
* Define r = lower case rho
lrho:	dc.b	2,9,1
	dc.b	0,0,0,       0,21,84,     0,64,128,     0,128,32
	dc.b	0,0,0,       0,128,32,    0,64,64,      0,21,0
	dc.b	0,0,0
* Define s = lower case sigma
lsigma:	dc.b	2,9,1
	dc.b	0,14,0,      0,32,128,    0,128,64,     0,0,32
	dc.b	0,128,0,     0,32,32,     0,142,128,    0,0,0
	dc.b	0,128,0
* Define t = lower case tau
ltau:	dc.b	1,9,2
	dc.b	0,128,0,     0,0,0,       0,170,192,    0,0,32
	dc.b	0,128,64,    0,0,128,     0,128,0,      0,64,0
	dc.b	0,40,0
* Define u = lower case upsilon
lupsi:	dc.b	2,9,1
	dc.b	0,128,0,     0,64,0,      0,42,128,     0,0,32
	dc.b	0,0,0,       0,0,32,      0,128,128,    0,42,0
	dc.b	0,0,0
* Define v = gradient operator
lgrad:	dc.b	2,9,1
	dc.b	42,0,0,      0,64,0,      32,8,0,       0,1,0
	dc.b	32,0,32,     0,1,0,       32,8,0,       0,64,0
	dc.b	42,0,0
* Define w = lower case omega
lomega:	dc.b	2,9,1
	dc.b	0,21,0,      0,64,64,     0,128,32,     0,0,64
	dc.b	0,5,0,       0,0,64,      0,128,32,     0,64,64
	dc.b	0,21,0
* Define x = lower case xi
lexi:	dc.b	1,9,2
	dc.b	0,0,0,       0,0,0,       0,0,0,        1,69,0
	dc.b	34,40,128,   20,16,84,    8,0,32,       0,0,0
	dc.b	0,0,0
* Define y = lower case chi
lchi:	dc.b	1,9,2
	dc.b	2,0,0,       0,0,0,       2,0,32,       0,128,128
	dc.b	0,34,0,      0,8,0,       0,34,0,       0,128,128
	dc.b	2,0,32
* Define z = lower case zeta
lzeta:	dc.b	1,9,2
	dc.b	0,0,0,       0,0,0,       49,80,0,      74,4,0
	dc.b	4,1,40,      0,0,192,     4,0,0,        0,0,0
	dc.b	0,0,0
* Redefine characters from | to |
init9:	dc.b	esc,'&',0,'||'
* Define | = absolute value
labs:	dc.b	2,9,1
	dc.b	0,0,0,       0,0,0,       0,0,0,        0,0,0
	dc.b	42,170,160,  0,0,0,       0,0,0,        0,0,0
	dc.b	0,0,0
* End of redefinition tables
stop:	dc.b	bell,lf
*#######################################################################
	end