"Change Set: BDFFontReader-nop Date: 11 February 2001 Author: Jay Carlson I am a conversion utility for reading X11 Bitmap Distribution Format fonts. My code is derived from the multilingual Squeak changeset written by OHSHIMA Yoshiki (ohshima@is.titech.ac.jp), although all support for fonts with more than 256 glyphs has been ripped out. See http://www.is.titech.ac.jp/~ohshima/squeak/squeak-multilingual-e.html . My class methods contain tools for fetching BDF source files from a well-known archive site, batch conversion to Squeak's .sf2 format, and installation of these fonts as TextStyles. Also, the legal notices for the standard 75dpi fonts I process this way are included as 'x11FontLegalNotices'. Tested against 2.8 and initial 3.0."! CrLfFileStream subclass: #BDFFontReader instanceVariableNames: 'properties ' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Text'! !BDFFontReader commentStamp: '' prior: 0! I am a conversion utility for reading X11 Bitmap Distribution Format fonts. My code is derived from the multilingual Squeak changeset written by OHSHIMA Yoshiki (ohshima@is.titech.ac.jp), although all support for fonts with more than 256 glyphs has been ripped out. See http://www.is.titech.ac.jp/~ohshima/squeak/squeak-multilingual-e.html . My class methods contain tools for fetching BDF source files from a well-known archive site, batch conversion to Squeak's .sf2 format, and installation of these fonts as TextStyles. Also, the legal notices for the standard 75dpi fonts I process this way are included as "x11FontLegalNotices'.! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:45'! errorFileFormat self error: 'malformed bdf format'! ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:46'! errorUnsupported self error: 'unsupported bdf'! ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:43'! getLine ^self upTo: Character cr.! ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:44'! initialize properties _ Dictionary new.! ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/23/2000 18:58'! read | xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx array width blt lastAscii pointSize ret dwidth cell cellBlt | form _ encoding _ bbx _ nil. self initialize. self readAttributes. height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2). ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first. descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first. pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10. maxWidth _ 0. minAscii _ 9999. strikeWidth _ 0. maxAscii _ 0. charsNum _ Integer readFromString: (properties at: #CHARS) first. chars _ Set new: charsNum. 1 to: charsNum do: [:i | array _ self readOneCharacter. form _ array at: 1. encoding _ array at: 2. bbx _ array at: 3. dwidth _ array at: 4. "form isNil ifFalse: [form morphEdit]." "self halt." form ifNotNil: [ dwidth _ dwidth - 1. width _ dwidth max: (bbx at: 1). maxWidth _ maxWidth max: width. minAscii _ minAscii min: encoding. maxAscii _ maxAscii max: encoding. strikeWidth _ strikeWidth + width. chars add: array. ]. ]. chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)]. charsNum _ chars size. "undefined encodings make this different" xTable _ (Array new: 258) atAllPut: 0. glyphs _ Form extent: strikeWidth@height. blt _ BitBlt toForm: glyphs. lastAscii _ 0. 1 to: charsNum do: [:i | | unspliceArray | unspliceArray _ chars at: i. form _ unspliceArray at: 1. encoding _ unspliceArray at: 2. bbx _ unspliceArray at: 3. dwidth _ (unspliceArray at: 4). width _ dwidth max: (bbx at: 1). lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]. "I should be able to do all of this in one blit, but I'm too confused. Create a Form of the proper size for this glyph, render the BDF bitmap into it, then stamp it into the StrikeFont glyphs form." cell _ Form extent: width@height. cellBlt _ BitBlt toForm: cell. cellBlt copy: ((bbx at: 3)@((ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form. blt copyForm: cell to: (xTable at: encoding+1)@0 rule: Form over. "blt copy: (( ((xTable at: encoding+1)+(bbx at: 3))@(ascent - (bbx at: 2) - (bbx at: 4))) extent: (bbx at: 1)@(bbx at: 2)) from: 0@0 in: form." xTable at: encoding+2 put: (xTable at: encoding+1)+(width). lastAscii _ encoding. ]. ret _ Array new: 8. ret at: 1 put: xTable. ret at: 2 put: glyphs. ret at: 3 put: minAscii. ret at: 4 put: maxAscii. ret at: 5 put: maxWidth. ret at: 6 put: ascent. ret at: 7 put: descent. ret at: 8 put: pointSize. ^ret. " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}"! ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/18/2000 19:44'! readAttributes | str a | "I don't handle double-quotes correctly, but it works" self reset. [self atEnd] whileFalse: [ str _ self getLine. (str beginsWith: 'STARTCHAR') ifTrue: [self skip: (0 - str size - 1). ^self]. a _ str substrings. properties at: a first asSymbol put: a allButFirst. ]. self error: 'file seems corrupted'.! ! !BDFFontReader methodsFor: 'as yet unclassified' stamp: 'nop 1/22/2000 23:33'! readOneCharacter | str a encoding bbx form bits hi low pos char dwidth | ((str _ self getLine) beginsWith: 'STARTCHAR') ifFalse: [self errorFileFormat]. char _ str substrings second. ((str _ self getLine) beginsWith: 'ENCODING') ifFalse: [self errorFileFormat]. encoding _ Integer readFromString: str substrings second. (self getLine beginsWith: 'SWIDTH') ifFalse: [self errorFileFormat]. ((str _ self getLine) beginsWith: 'DWIDTH') ifFalse: [self errorFileFormat]. dwidth _ Integer readFromString: str substrings second. ((str _ self getLine) beginsWith: 'BBX') ifFalse: [self errorFileFormat]. a _ str substrings. bbx _ (2 to: 5) collect: [:i | Integer readFromString: (a at: i)]. ((str _ self getLine) beginsWith: 'ATTRIBUTES') ifTrue: [str _ self getLine]. (str beginsWith: 'BITMAP') ifFalse: [self errorFileFormat]. form _ Form extent: (bbx at: 1)@(bbx at: 2). bits _ form bits. pos _ 0. 1 to: (bbx at: 2) do: [:t | 1 to: (((bbx at: 1) - 1) // 8 + 1) do: [:i | hi _ (('0123456789ABCDEF' indexOf: (self next asUppercase)) - 1) bitShift: 4. low _ ('0123456789ABCDEF' indexOf: (self next asUppercase)) - 1. bits byteAt: (pos+i) put: (hi+low). ]. self next ~= Character cr ifTrue: [self errorFileFormat]. pos _ pos + ((((bbx at: 1) + 31) // 32) * 4). ]. (self getLine beginsWith: 'ENDCHAR') ifFalse: [self errorFileFormat]. encoding < 0 ifTrue: [^{nil. nil. nil. nil}]. ^{form. encoding. bbx. dwidth}. ! ! !BDFFontReader class methodsFor: 'file creation' stamp: 'nop 1/23/2000 19:00'! convertFilesNamed: fileName toFamilyNamed: familyName inDirectoryNamed: dirName "BDFFontReader convertFilesNamed: 'helvR' toFamilyNamed: 'Helvetica' inDirectoryNamed: '' " "This utility converts X11 BDF font files to Squeak .sf2 StrikeFont files." "For this utility to work as is, the BDF files must be named 'familyNN.bdf', and must reside in the directory named by dirName (use '' for the current directory). The output StrikeFont files will be named familyNN.sf2, and will be placed in the current directory." | f allFontNames sizeChars dir | "Check for matching file names." dir _ dirName isEmpty ifTrue: [FileDirectory default] ifFalse: [FileDirectory default directoryNamed: dirName]. allFontNames _ dir fileNamesMatching: fileName , '##.bdf'. allFontNames isEmpty ifTrue: [^ self error: 'No files found like ' , fileName , 'NN.bdf']. Utilities informUserDuring: [:info | allFontNames do: [:fname | info value: 'Converting ', familyName, ' BDF file ', fname, ' to SF2 format'. sizeChars _ (fname copyFrom: fileName size + 1 to: fname size) copyUpTo: $. . f _ StrikeFont new readBDFFromFile: (dir fullNameFor: fname) name: familyName, sizeChars. f writeAsStrike2named: familyName, sizeChars, '.sf2'. ]. ]! ! !BDFFontReader class methodsFor: 'resource download' stamp: 'nop 1/23/2000 18:43'! convertX11FontsToStrike2 "BDFFontReader convertX11FontsToStrike2" "Given a set of standard X11 BDF font files (probably downloaded via BDFFontReader downloadFonts), produce .sf2 format fonts. The source and destination directory is the current directory." "Charter currently tickles a bug in the BDF parser. Skip it for now." "self convertFilesNamed: 'charR' toFamilyNamed: 'Charter' inDirectoryNamed: ''." self convertFilesNamed: 'courR' toFamilyNamed: 'Courier' inDirectoryNamed: ''. self convertFilesNamed: 'helvR' toFamilyNamed: 'Helvetica' inDirectoryNamed: ''. self convertFilesNamed: 'lubR' toFamilyNamed: 'LucidaBright' inDirectoryNamed: ''. self convertFilesNamed: 'luRS' toFamilyNamed: 'Lucida' inDirectoryNamed: ''. self convertFilesNamed: 'lutRS' toFamilyNamed: 'LucidaTypewriter' inDirectoryNamed: ''. self convertFilesNamed: 'ncenR' toFamilyNamed: 'NewCenturySchoolbook' inDirectoryNamed: ''. self convertFilesNamed: 'timR' toFamilyNamed: 'TimesRoman' inDirectoryNamed: ''.! ! !BDFFontReader class methodsFor: 'resource download' stamp: 'nop 2/11/2001 00:24'! downloadFonts "BDFFontReader downloadFonts" "Download a standard set of BDF sources from x.org. The combined size of these source files is around 1.2M; after conversion to .sf2 format they may be deleted." | heads tails filenames baseUrl basePath newUrl newPath document f | heads _ #( 'charR' 'courR' 'helvR' 'lubR' 'luRS' 'lutRS' 'ncenR' 'timR' ). tails _ #( '08' '10' '12' '14' '18' '24'). filenames _ OrderedCollection new. heads do: [:head | filenames addAll: (tails collect: [:tail | head , tail , '.bdf']) ]. baseUrl _ Url absoluteFromText: 'http://ftp.x.org/pub/R6.4/xc/fonts/bdf/75dpi/'. basePath _ baseUrl path. filenames do: [:filename | newUrl _ baseUrl clone. newPath _ OrderedCollection newFrom: basePath. newPath addLast: filename. newUrl path: newPath. Utilities informUser: 'Fetching ' , filename during: [document _ newUrl retrieveContents]. f _ CrLfFileStream newFileNamed: filename. f nextPutAll: document content. f close. ]. ! ! !BDFFontReader class methodsFor: 'resource download' stamp: 'nop 1/23/2000 18:44'! installX11Fonts "BDFFontReader installX11Fonts" "Installs previously-converted .sf2 fonts into the TextConstants dictionary. This makes them available as TextStyles everywhere in the image." | families fontArray textStyle | families _ #( 'Courier' 'Helvetica' 'LucidaBright' 'Lucida' 'LucidaTypewriter' 'NewCenturySchoolbook' 'TimesRoman' ). families do: [:family | fontArray _ StrikeFont readStrikeFont2Family: family. textStyle _ TextStyle fontArray: fontArray. TextConstants at: family asSymbol put: textStyle. ]. ! ! !BDFFontReader class methodsFor: 'documentation' stamp: 'nop 2/11/2001 00:22'! gettingAndInstallingTheFonts "Download the 1.3M of BDF font source files from x.org: BDFFontReader downloadFonts. Convert them to .sf2 StrikeFont files: BDFFontReader convertX11FontsToStrike2. Install them into the system as TextStyles: BDFFontReader installX11Fonts. Read the legal notices in 'BDFFontReader x11FontLegalNotices' before redistributing images containing these fonts."! ! !BDFFontReader class methodsFor: 'documentation' stamp: 'nop 1/23/2000 18:30'! x11FontLegalNotices ^ 'The X11 BDF fonts contain copyright and license information as comments in the font source code. For the font family files "cour" (Courier), "helv" (Helvetica), "ncen" (New Century Schoolbook), and "tim" (Times Roman) the notice reads: COMMENT Copyright 1984-1989, 1994 Adobe Systems Incorporated. COMMENT Copyright 1988, 1994 Digital Equipment Corporation. COMMENT COMMENT Adobe is a trademark of Adobe Systems Incorporated which may be COMMENT registered in certain jurisdictions. COMMENT Permission to use these trademarks is hereby granted only in COMMENT association with the images described in this file. COMMENT COMMENT Permission to use, copy, modify, distribute and sell this software COMMENT and its documentation for any purpose and without fee is hereby COMMENT granted, provided that the above copyright notices appear in all COMMENT copies and that both those copyright notices and this permission COMMENT notice appear in supporting documentation, and that the names of COMMENT Adobe Systems and Digital Equipment Corporation not be used in COMMENT advertising or publicity pertaining to distribution of the software COMMENT without specific, written prior permission. Adobe Systems and COMMENT Digital Equipment Corporation make no representations about the COMMENT suitability of this software for any purpose. It is provided "as COMMENT is" without express or implied warranty. For the font family files "char" (Charter), the notice reads: COMMENT Copyright 1988 Bitstream, Inc., Cambridge, Massachusetts, USA COMMENT Bitstream and Charter are registered trademarks of Bitstream, Inc. COMMENT COMMENT The names "Bitstream" and "Charter" are registered trademarks of COMMENT Bitstream, Inc. Permission to use these trademarks is hereby COMMENT granted only in association with the images described in this file. COMMENT COMMENT Permission to use, copy, modify, and distribute this software and COMMENT its documentation for any purpose and without fee is hereby COMMENT granted, provided that the above copyright notice appear in all COMMENT copies and that both that copyright notice and this permission COMMENT notice appear in supporting documentation, and that the name of COMMENT Bitstream not be used in advertising or publicity pertaining to COMMENT distribution of the software without specific, written prior COMMENT permission. Bitstream makes no representations about the COMMENT suitability of this software for any purpose. It is provided "as COMMENT is" without express or implied warranty. COMMENT COMMENT BITSTREAM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, COMMENT INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN COMMENT NO EVENT SHALL BITSTREAM BE LIABLE FOR ANY SPECIAL, INDIRECT OR COMMENT CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS COMMENT OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, COMMENT NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN COMMENT CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. For the font family files "lu" (Lucida), "lub" (Lucida Bright), and "lut" (Lucida Typewriter), the notice reads: COMMENT (c) Copyright Bigelow & Holmes 1986, 1985. Lucida is a registered COMMENT trademark of Bigelow & Holmes. See LEGAL NOTICE file for terms COMMENT of the license. The LEGAL NOTICE contains: This is the LEGAL NOTICE pertaining to the Lucida fonts from Bigelow & Holmes: NOTICE TO USER: The source code, including the glyphs or icons forming a par of the OPEN LOOK TM Graphic User Interface, on this tape and in these files is copyrighted under U.S. and international laws. Sun Microsystems, Inc. of Mountain View, California owns the copyright and has design patents pending on many of the icons. AT&T is the owner of the OPEN LOOK trademark associated with the materials on this tape. Users and possessors of this source code are hereby granted a nonexclusive, royalty-free copyright and design patent license to use this code in individual and commercial software. A royalty-free, nonexclusive trademark license to refer to the code and output as "OPEN LOOK" compatible is available from AT&T if, and only if, the appearance of the icons or glyphs is not changed in any manner except as absolutely necessary to accommodate the standard resolution of the screen or other output device, the code and output is not changed except as authorized herein, and the code and output is validated by AT&T. Bigelow & Holmes is the owner of the Lucida (R) trademark for the fonts and bit-mapped images associated with the materials on this tape. Users are granted a royalty-free, nonexclusive license to use the trademark only to identify the fonts and bit-mapped images if, and only if, the fonts and bit-mapped images are not modified in any way by the user. Any use of this source code must include, in the user documentation and internal comments to the code, notices to the end user as follows: (c) Copyright 1989 Sun Microsystems, Inc. Sun design patents pending in the U.S. and foreign countries. OPEN LOOK is a trademark of AT&T. Used by written permission of the owners. (c) Copyright Bigelow & Holmes 1986, 1985. Lucida is a registered trademark of Bigelow & Holmes. Permission to use the Lucida trademark is hereby granted only in association with the images and fonts described in this file. SUN MICROSYSTEMS, INC., AT&T, AND BIGELOW & HOLMES MAKE NO REPRESENTATIONS ABOUT THE SUITABILITY OF THIS SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC., AT&T AND BIGELOW & HOLMES, SEVERALLY AND INDIVIDUALLY, DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOURCE CODE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL SUN MICROSYSTEMS, INC., AT&T OR BIGELOW & HOLMES BE LIABLE FOR ANY SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOURCE CODE. '. ! ! !StrikeFont methodsFor: 'file in/out' stamp: 'nop 2/11/2001 00:22'! readBDFFromFile: fileName name: aString "This builds a StrikeFont instance by reading the X11 Binary Distribution Format font source file. See the BDFFontReader class comment." "StrikeFont new readBDFFromFile: 'helvR12' name: 'Helvetica12'." | fontReader a | fontReader _ BDFFontReader oldFileNamed: fileName. a _ fontReader read. fontReader close. "{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize} _ fontReader read." xTable _ a at: 1. glyphs _ a at: 2. minAscii _ a at: 3. "See CharacterScanner>>characterNotInFont. maxAscii+1 must be a legal Character." maxAscii _ (a at: 4) min: 254. maxWidth _ a at: 5. ascent _ a at: 6. descent _ a at: 7. pointSize _ a at: 8. name _ aString. type _ 0. "no one see this" superscript _ ascent - descent // 3. subscript _ descent - ascent // 3. emphasis _ 0. self reset.! ! !StrikeFont class methodsFor: 'instance creation' stamp: 'nop 1/23/2000 19:21'! newFromBDFFile: aFileName name: aString "StrikeFont newFromBDFFile: 'helvR12.bdf' name: 'Helvetica12'" "Read a font from disk in the X11 Bitmap Distribution Format." | n | n _ self new. n readBDFFromFile: aFileName name: aString. ^n. "TextConstants at: #Helvetica put: (TextStyle fontArray: {StrikeFont newFromBDFFile: 'helvR12.bdf' name: 'Helvetica12'})" "TextConstants at: #Lucida put: (TextStyle fontArray: {StrikeFont newFromBDFFile: 'luRS12.bdf' name: 'Lucida'})" "TextStyle default fontAt: 5 put: (StrikeFont new readFromStrike2: 'helv12.sf2')." ! ! !StrikeFont class methodsFor: 'examples' stamp: 'nop 2/11/2001 13:35'! readStrikeFont2Family: familyName "StrikeFont readStrikeFont2Family: 'Lucida'" "This utility reads all available .sf2 StrikeFont files for a given family from the current directory. It returns an Array, sorted by size, suitable for handing to TextStyle newFontArray: ." "For this utility to work as is, the .sf2 files must be named 'familyNN.sf2'." | fileNames strikeFonts fontArray | fileNames _ FileDirectory default fileNamesMatching: familyName , '##.sf2'. strikeFonts _ fileNames collect: [:fname | StrikeFont new readFromStrike2: fname]. strikeFonts do: [ :font | font reset ]. strikeFonts _ strikeFonts asSortedCollection: [:a :b | a height < b height]. fontArray _ strikeFonts asArray. ^ fontArray "TextConstants at: #Lucida put: (TextStyle fontArray: (StrikeFont readStrikeFont2Family: 'Lucida'))."! ! !BDFFontReader class reorganize! ('file creation' convertFilesNamed:toFamilyNamed:inDirectoryNamed:) ('resource download' convertX11FontsToStrike2 downloadFonts installX11Fonts) ('documentation' gettingAndInstallingTheFonts x11FontLegalNotices) !