home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
CPM68K
/
MSUTILS.LBR
/
DFONT.SQ
/
DFONT.S
Wrap
Text File
|
2000-06-30
|
15KB
|
478 lines
*#######################################################################
* 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