\
\  HersheyFont, based on Hershey.C, converted to Forth by Frank Buss 29/04/2007
\
\  Hershey.C
\  extracted from the hershey font
\
\  Charles Schwieters 6/14/99
\
\
\  font info:
\
\ Peter Holzmann, Octopus Enterprises
\ USPS: 19611 La Mar Court, Cupertino, CA 95014
\ UUCP: {hplabs!hpdsd,pyramid}!octopus!pete
\ Phone: 408/996-7746
\
\ This distribution is made possible through the collective encouragement
\ of the Usenet Font Consortium, a mailing list that sprang to life to get
\ this accomplished and that will now most likely disappear into the mists
\ of time... Thanks are especially due to Jim Hurt, who provided the packed
\ font data for the distribution, along with a lot of other help.
\
\ This file describes the Hershey Fonts in general, along with a description of
\ the other files in this distribution and a simple re-distribution restriction.
\
\ USE RESTRICTION:
\   This distribution of the Hershey Fonts may be used by anyone for
\   any purpose, commercial or otherwise, providing that:
\     1. The following acknowledgements must be distributed with
\       the font data:
\       - The Hershey Fonts were originally created by Dr.
\         A. V. Hershey while working at the U. S.
\         National Bureau of Standards.
\       - The format of the Font data in this distribution
\         was originally created by
\           James Hurt
\           Cognition, Inc.
\           900 Technology Park Drive
\           Billerica, MA 01821
\           (mit-eddie!ci-dandelion!hurt)
\     2. The font data in this distribution may be converted into
\       any other format *EXCEPT* the format distributed by
\       the U.S. NTIS (which organization holds the rights
\       to the distribution and use of the font data in that
\       particular format). Not that anybody would really
\       *want* to use their format... each point is described
\       in eight bytes as "xxx yyy:", where xxx and yyy are
\       the coordinate values as ASCII numbers.
\
\ *PLEASE* be reassured: The legal implications of NTIS' attempt to control
\ a particular form of the Hershey Fonts *are* troubling. HOWEVER: We have
\ been endlessly and repeatedly assured by NTIS that they do not care what
\ we do with our version of the font data, they do not want to know about it,
\ they understand that we are distributing this information all over the world,
\ etc etc etc... but because it isn't in their *exact* distribution format, they
\ just don't care!!! So go ahead and use the data with a clear conscience! (If
\ you feel bad about it, take a smaller deduction for something on your taxes
\ next week...)
\
\ The Hershey Fonts:
\   - are a set of more than 2000 glyph (symbol) descriptions in vector
\     ( <x,y> point-to-point ) format
\   - can be grouped as almost 20 'occidental' (english, greek,
\     cyrillic) fonts, 3 or more 'oriental' (Kanji, Hiragana,
\     and Katakana) fonts, and a few hundred miscellaneous
\     symbols (mathematical, musical, cartographic, etc etc)
\   - are suitable for typographic quality output on a vector device
\     (such as a plotter) when used at an appropriate scale.
\   - were digitized by Dr. A. V. Hershey while working for the U.S.
\     Government National Bureau of Standards (NBS).
\   - are in the public domain, with a few caveats:
\     - They are available from NTIS (National Technical Info.
\       Service) in a computer-readable from which is *not*
\       in the public domain. This format is described in
\       a hardcopy publication "Tables of Coordinates for
\       Hershey's Repertory of Occidental Type Fonts and
\       Graphic Symbols" available from NTIS for less than
\       $20 US (phone number +1 703 487 4763).
\     - NTIS does not care about and doesn't want to know about
\       what happens to Hershey Font data that is not
\       distributed in their exact format.
\     - This distribution is not in the NTIS format, and thus is
\       only subject to the simple restriction described
\       at the top of this file.
\

\ Exported words:
\
\ hershey-draw-char ( char -- )
\ hershey-draw-string ( addr u -- )
\
\
\ Exported value:
\
\ scale: scale value in 1/8 unit
\
\
\ Imported words:
\
\ move-to ( x y -- )
\ line-to ( x y -- )
\
\
\ Imported values:
\
\ x0, y0: current position


\ used for fixed-point scaling
8 constant fixed-point-scale
fixed-point-scale 2 / constant fixed-point-scale/2

\ fonts are drawed scale at size scale/fixed-point-scale
fixed-point-scale value scale

\ save ccc as a counted string
: glyph" ( "ccc<quote>" -- )
	[char] " parse dup c,
	here swap dup allot move
;

\ Hershey font data
create glyphs
glyph" JZ"
glyph" MWRFRT RRYQZR[SZRY"
glyph" JZNFNM RVFVM"
glyph" H]SBLb RYBRb RLOZO RKUYU"
glyph" H\PBP_ RTBT_ RYIWGTFPFMGKIKKLMMNOOUQWRXSYUYXWZT[P[MZKX"
glyph" F^[FI[ RNFPHPJOLMMKMIKIIJGLFNFPGSHVHYG[F RWTUUTWTYV[X[ZZ[X[VYTWT"
glyph" E_\O\N[MZMYNXPVUTXRZP[L[JZIYHWHUISJRQNRMSKSIRGPFNGMIMKNNPQUXWZY["
glyph" MWRHQGRFSGSIRKQL"
glyph" KYVBTDRGPKOPOTPYR]T`Vb"
glyph" KYNBPDRGTKUPUTTYR]P`Nb"
glyph" JZRLRX RMOWU RWOMU"
glyph" E_RIR[ RIR[R"
glyph" NVSWRXQWRVSWSYQ["
glyph" E_IR[R"
glyph" NVRVQWRXSWRV"
glyph" G][BIb"
glyph" H\QFNGLJKOKRLWNZQ[S[VZXWYRYOXJVGSFQF"
glyph" H\NJPISFS["
glyph" H\LKLJMHNGPFTFVGWHXJXLWNUQK[Y["
glyph" H\MFXFRNUNWOXPYSYUXXVZS[P[MZLYKW"
glyph" H\UFKTZT RUFU["
glyph" H\WFMFLOMNPMSMVNXPYSYUXXVZS[P[MZLYKW"
glyph" H\XIWGTFRFOGMJLOLTMXOZR[S[VZXXYUYTXQVOSNRNOOMQLT"
glyph" H\YFO[ RKFYF"
glyph" H\PFMGLILKMMONSOVPXRYTYWXYWZT[P[MZLYKWKTLRNPQOUNWMXKXIWGTFPF"
glyph" H\XMWPURRSQSNRLPKMKLLINGQFRFUGWIXMXRWWUZR[P[MZLX"
glyph" NVROQPRQSPRO RRVQWRXSWRV"
glyph" NVROQPRQSPRO RSWRXQWRVSWSYQ["
glyph" F^ZIJRZ["
glyph" E_IO[O RIU[U"
glyph" F^JIZRJ["
glyph" I[LKLJMHNGPFTFVGWHXJXLWNVORQRT RRYQZR[SZRY"
glyph" E`WNVLTKQKOLNMMPMSNUPVSVUUVS RQKOMNPNSOUPV RWKVSVUXVZV\T]Q]O\L[J"
glyph" I[RFJ[ RRFZ[ RMTWT"
glyph" G\KFK[ RKFTFWGXHYJYLXNWOTP RKPTPWQXRYTYWXYWZT[K["
glyph" H]ZKYIWGUFQFOGMILKKNKSLVMXOZQ[U[WZYXZV"
glyph" G\KFK[ RKFRFUGWIXKYNYSXVWXUZR[K["
glyph" H[LFL[ RLFYF RLPTP RL[Y["
glyph" HZLFL[ RLFYF RLPTP"
glyph" H]ZKYIWGUFQFOGMILKKNKSLVMXOZQ[U[WZYXZVZS RUSZS"
glyph" G]KFK[ RYFY[ RKPYP"
glyph" NVRFR["
glyph" JZVFVVUYTZR[P[NZMYLVLT"
glyph" G\KFK[ RYFKT RPOY["
glyph" HYLFL[ RL[X["
glyph" F^JFJ[ RJFR[ RZFR[ RZFZ["
glyph" G]KFK[ RKFY[ RYFY["
glyph" G]PFNGLIKKJNJSKVLXNZP[T[VZXXYVZSZNYKXIVGTFPF"
glyph" G\KFK[ RKFTFWGXHYJYMXOWPTQKQ"
glyph" G]PFNGLIKKJNJSKVLXNZP[T[VZXXYVZSZNYKXIVGTFPF RSWY]"
glyph" G\KFK[ RKFTFWGXHYJYLXNWOTPKP RRPY["
glyph" H\YIWGTFPFMGKIKKLMMNOOUQWRXSYUYXWZT[P[MZKX"
glyph" JZRFR[ RKFYF"
glyph" G]KFKULXNZQ[S[VZXXYUYF"
glyph" I[JFR[ RZFR["
glyph" F^HFM[ RRFM[ RRFW[ R\FW["
glyph" H\KFY[ RYFK["
glyph" I[JFRPR[ RZFRP"
glyph" H\YFK[ RKFYF RK[Y["
glyph" KYOBOb RPBPb ROBVB RObVb"
glyph" KYKFY^"
glyph" KYTBTb RUBUb RNBUB RNbUb"
glyph" JZRDJR RRDZR"
glyph" I[Ib[b"
glyph" NVSKQMQORPSORNQO"
glyph" I\XMX[ RXPVNTMQMONMPLSLUMXOZQ[T[VZXX"
glyph" H[LFL[ RLPNNPMSMUNWPXSXUWXUZS[P[NZLX"
glyph" I[XPVNTMQMONMPLSLUMXOZQ[T[VZXX"
glyph" I\XFX[ RXPVNTMQMONMPLSLUMXOZQ[T[VZXX"
glyph" I[LSXSXQWOVNTMQMONMPLSLUMXOZQ[T[VZXX"
glyph" MYWFUFSGRJR[ ROMVM"
glyph" I\XMX]W`VaTbQbOa RXPVNTMQMONMPLSLUMXOZQ[T[VZXX"
glyph" I\MFM[ RMQPNRMUMWNXQX["
glyph" NVQFRGSFREQF RRMR["
glyph" MWRFSGTFSERF RSMS^RaPbNb"
glyph" IZMFM[ RWMMW RQSX["
glyph" NVRFR["
glyph" CaGMG[ RGQJNLMOMQNRQR[ RRQUNWMZM\N]Q]["
glyph" I\MMM[ RMQPNRMUMWNXQX["
glyph" I\QMONMPLSLUMXOZQ[T[VZXXYUYSXPVNTMQM"
glyph" H[LMLb RLPNNPMSMUNWPXSXUWXUZS[P[NZLX"
glyph" I\XMXb RXPVNTMQMONMPLSLUMXOZQ[T[VZXX"
glyph" KXOMO[ ROSPPRNTMWM"
glyph" J[XPWNTMQMNNMPNRPSUTWUXWXXWZT[Q[NZMX"
glyph" MYRFRWSZU[W[ ROMVM"
glyph" I\MMMWNZP[S[UZXW RXMX["
glyph" JZLMR[ RXMR["
glyph" G]JMN[ RRMN[ RRMV[ RZMV["
glyph" J[MMX[ RXMM["
glyph" JZLMR[ RXMR[P_NaLbKb"
glyph" J[XMM[ RMMXM RM[X["
glyph" KYTBRCQDPFPHQJRKSMSOQQ RRCQEQGRISJTLTNSPORSTTVTXSZR[Q]Q_Ra RQSSU"
glyph" NVRBRb"
glyph" KYPBRCSDTFTHSJRKQMQOSQ RRCSESGRIQJPLPNQPURQTPVPXQZR[S]S_Ra RSSQU"
glyph" F^IUISJPLONOPPTSVTXTZS[Q RISJQLPNPPQTTVUXUZT[Q[O"
glyph" JZJFJ[K[KFLFL[M[MFNFN[O[OFPFP[Q[QFRFR[S[SFTFT[U[UFVFV[W[WFXFX[Y[YFZFZ["
0 c,

0 value number-of-glyphs

\ store all addresses of the glyphs as an array for faster access
: create-array ( first-glyph -- )
	>r
	begin r@ @ while
		r@ ,
		r> dup c@ + 1 chars + >r
		number-of-glyphs 1+ to number-of-glyphs
	repeat
	r>
;

create glyphs-array
glyphs create-array

\ current glyph
0 value glyph-address
0 value glyph-length
0 value glyph-index

\ current glyph chars
0 value char-x
0 value char-y

\ current position
0 value start-x
0 value start-y

\ scale x or y coordinate
: scale-length ( n -- n )
	scale * fixed-point-scale/2 + fixed-point-scale /
;

\ scale a point
: scale-point ( x y -- x' y' )
	scale-length swap scale-length swap
;

\ translate a point to current position
: translate-point ( x y -- x' y' )
	start-y + swap start-x + swap
;

\ scale and translate a point
: transform-point ( x y -- x' y' )
	scale-point translate-point
;

\ get next glyph instruction character
: next-glyph-char ( -- char )
	glyph-address glyph-index + c@
	glyph-index 1+ to glyph-index
;

\ read the next two glyph character instructions
: read-glyph-pair ( -- )
	next-glyph-char to char-x
	next-glyph-char to char-y
;

\ convert a glyph character to x or y coordinate
: char-2-length ( char -- n )
	[char] R -
;

\ convert glyph characters to a point
: next-point ( -- x y )
	char-x char-2-length
	char-y char-2-length
;

\ get glyph instruction string for a character
: char-2-glyph ( char -- addr u )
	32 -
	dup 0 < if drop 0 then
	dup number-of-glyphs >= if drop number-of-glyphs 1- then
	cell * glyphs-array + @ dup c@ swap 1 chars + swap
;

\ draw one character to the current position
\ and increment position
: hershey-draw-char ( char -- )
	char-2-glyph
	to glyph-length
	to glyph-address
	0 to glyph-index
	read-glyph-pair next-point
	scale-point swap ( glyph-width left-margin )
	x0 swap - to start-x
	y0 to start-y
	glyph-index glyph-length < if
		read-glyph-pair next-point
		transform-point move-to
		begin glyph-index glyph-length < while
			read-glyph-pair
			char-x bl = if
				read-glyph-pair next-point
				transform-point move-to
			else
				next-point
				transform-point line-to
			then
		repeat
	then
	start-x + to x0 ( glyph-width -- )
	start-y to y0
;

\ draw a string to the current position
\ and increment position
: hershey-draw-string ( addr u -- )
	dup 0 > if
		over + swap do i c@ hershey-draw-char loop
	else
		drop
	then
;