Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!mcsun!ukc!icdoc!qmw-cs!eliot From: eliot@cs.qmw.ac.uk (Eliot Miranda) Newsgroups: comp.lang.smalltalk Subject: Re: format of X font files Message-ID: <2659@sequent.cs.qmw.ac.uk> Date: 16 Aug 90 11:39:14 GMT References: <646@argosy.UUCP> Reply-To: eliot@cs.qmw.ac.uk (Eliot Miranda) Organization: Computer Science Dept, QMW, University of London, UK. Lines: 264 "Here's some code to experiment with for creating Smalltalk StrikeFonts from X BDF files" 'From BrouHaHa Smalltalk-80, Version 2.3.1 of 30 January 1989 on 8 January 1990 at 2:30:38 pm'! !PositionableStream methodsFor: 'accessing'! upToAny: aCollection "Answer a subcollection from position to the occurrence (if any, not inclusive) of any element in aCollection. If not there, answer everything." | newStream element | newStream _ WriteStream on: (collection species new: 64). [self atEnd or: [aCollection includes: (element _ self next)]] whileFalse: [newStream nextPut: element]. ^newStream contents! ! !TextStyle methodsFor: 'accessing'! outputMedium: aSymbol "Set the outputMedium for this style -- currently only Display" outputMedium _ aSymbol. lineGrid == nil ifTrue: [lineGrid _ DefaultLineGrid]. baseline == nil ifTrue: [baseline _ DefaultBaseline]"! ! !TextStyle methodsFor: 'private'! newFontArray: anArray fontArray _ anArray. lineGrid _ (fontArray inject: 0 into: [:h :f| h max: f height]). baseline _ (fontArray inject: 0 into: [:h :f| h max: f ascent]) - 1. alignment _ 0. firstIndent _ 0. restIndent _ 0. rightIndent _ 0. outputMedium _ #Display. tabsArray _ DefaultTabsArray. marginTabsArray _ DefaultMarginTabsArray "Currently there is no supporting protocol for changing these arrays. If an editor wishes to implement margin setting, then a copy of the default should be stored as these instance variables."! ! !TextStyle class methodsFor: 'instance creation'! createBDFStyle: fileNames named: styleName | array | array _ fileNames asArray collect: [:fn| | fs sf | (fs _ FileStream oldFileNamed: fn) readOnly. sf _ StrikeFont fromBDFFile: fs. fs close. sf]. "Add a copy of the fonts on the end with underlined emphasis" array _ array, (array collect: [:f| f copy emphasis: 4. "underlined"]). self styleNamed: styleName asSymbol put: (self fontArray: array) "TextStyle createBDFStyle: ( #( 'timR18' 'timB18' 'timI18' 'helvR18' 'helvB18' 'helvO18' 'timR24' 'timB24' 'timI24' 'helvR24' 'helvB24' 'helvO24' ) collect: [:n| '/nfs/whistle/pub/X.V11R3/core.src/fonts/bdf/75dpi/', n, '.bdf']) named: #BDFLarge" "TextStyle createBDFStyle: ( #( 'courR10' 'courB10' 'courO10' 'courR12' 'courB12' 'courO12' 'courR14' 'courB14' 'courO14' 'courR18' 'courB18' 'courO18' ) collect: [:n| '/nfs/whistle/pub/X.V11R3/core.src/fonts/bdf/75dpi/', n, '.bdf']) named: #BDFFixed. 1 to: 12 do: [:n| | font | font _ (TextStyle styleNamed: #BDFFixed) fontAt: n. font fixPitch scrunch. n > 3 ifTrue: [font scrunch]]"! ! !Document methodsFor: 'Smalltalk compatibility'! getFontLike: familySizeFace "Map a strike font to an abstract type family." | family | family _ familySizeFace at: 1. (#('TIMES' 'TIMESROMAN' 'SERIF') includes: family) ifTrue: [^#Serif]. (#('HELVETICA' 'SANSERIF' 'SANS-SERIF') includes: family) ifTrue: [^#SanSerif]. (#('FIXED' 'ICON' 'COURIER') includes: family) ifTrue: [^#FixedPitch]. self error: 'don''t know how to handle this font yet!!'! ! !Character methodsFor: 'accessing'! digitValue "Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 otherwise. This is used to parse literal numbers of radix 2-36." value <= $9 asciiValue ifTrue: [^value - $0 asciiValue]. value >= $A asciiValue ifTrue: [ value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10]. value >= $a asciiValue ifTrue: [ value <= $z asciiValue ifTrue: [^value - $a asciiValue + 10]]]. ^-1! ! !StrikeFont methodsFor: 'private'! setFromBDFFile: stream "Create a StrikeFont from an X11 style Bitmap Distribution Format file. See /usr/X11/core.src/doc/bdf/bdf.mss" | token space cr separators blitter byteStripe glyph min max bold italic | bold _ italic _ false. stopConditions _ Array new: 258 withAll: #characterNotInFont. xTable _ Array new: 258 withAll: 0. minAscii _ 0. maxAscii _ 255. min _ 256. max _ -1. maxWidth _ 0. byteStripe _ Form extent: 1024@1. byteStripe bits: (ByteArray new: 1024 / 8). glyph _ Form extent: 0@0. blitter _ BitBlt destForm: glyph sourceForm: byteStripe halftoneForm: nil combinationRule: Form over destOrigin: 0@0 sourceOrigin: 0@0 extent: 0@1 clipRect: (0@0 extent: 0@0). space _ Character space. cr _ Character cr. separators _ Array with: space with: cr. [stream atEnd] whileFalse: [ token _ stream upToAny: separators. token = 'STARTPROPERTIES' ifTrue: [ [ stream skip: -1; skipTo: cr. token _ stream upToAny: separators. token = 'FONT_ASCENT' ifTrue: [ascent _ Integer readFrom: stream]. token = 'FONT_DESCENT' ifTrue: [descent _ Integer readFrom: stream]. token = 'FAMILY_NAME' ifTrue: [stream skipTo: $". name _ stream upTo: $"]. token = 'WEIGHT_NAME' ifTrue: [stream skipTo: $". bold _ stream peek = $B]. token = 'SLANT' ifTrue: [stream skipTo: $". italic _ stream peek == $I or: [stream peek == $O]]. token = 'PIXEL_SIZE' ifTrue: [name _ name, (stream upToAny: separators)]. token ~= 'ENDPROPERTIES'] whileTrue. glyphs _ Form extent: 0@ascent + descent. blitter clipHeight: ascent + descent]. token = 'STARTCHAR' ifTrue: [ | ascii charWidth w h ox oy bytes | stream skip: -1; skipTo: cr. ((token _ stream upToAny: separators) = 'ENCODING' and: [(ascii _ Integer readFrom: stream) > 0]) ifTrue: [ ascii < min ifTrue: [min _ ascii]. ascii > max ifTrue: [max _ ascii]. stopConditions at: ascii + 1 put: nil. [ stream skip: -1; skipTo: cr. token _ stream upToAny: separators. token = 'DWIDTH' ifTrue: [charWidth _ Integer readFrom: stream]. token = 'BBX' ifTrue: [ w _ Integer readFrom: stream. stream skip: 1. h _ Integer readFrom: stream. stream skip: 1. ox _ Integer readFrom: stream. stream skip: 1. oy _ Integer readFrom: stream. glyph extent: (w + 1 max: charWidth) @ glyphs height; white. maxWidth < glyph width ifTrue: [maxWidth _ glyph width]. blitter width: w; clipWidth: w]. token = 'BITMAP' ifTrue: [ stream skip: -1; skipTo: cr. 0 to: h - 1 do: [:y| | line | line _ stream upTo: cr. 1 to: line size by: 2 do: [:i| byteStripe bits at: i + 1 / 2 put: (line at: i) digitValue * 16 + (line at: i + 1) digitValue]. blitter destY: ascent - h - oy + y; copyBits]. glyph display. self characterFormAt: (Character value: ascii) put: glyph. ascii = 171 ifTrue: [ self characterFormAt: $_ put: glyph]]. token ~= 'ENDCHAR'] whileTrue]]. stream skip: -1; skipTo: cr]. emphasis _ strikeLength _ xOffset _ 0. raster _ glyphs raster. superscript _ ascent - descent // 3. subscript _ descent - ascent // 3. minAscii _ min. maxAscii _ max. bold ifTrue: [name _ name, 'b']. italic ifTrue: [name _ name, 'i']! ! !StrikeFont class methodsFor: 'instance creation'! fromBDFFile: stream ^self new setFromBDFFile: stream! ! !CharacterScanner methodsFor: 'scanning'! characterNotInFont "All fonts have an illegal character to be used when a character is not within the font's legal range. When characters out of ranged are encountered in scanning text, then this special character indicates the appropriate behavior. The character is usually treated as a unary message understood by a subclass of CharacterScanner." | illegalAsciiString saveIndex stopCondition | saveIndex _ lastIndex. illegalAsciiString _ String with: (font maxAscii + 1 min: 255) asCharacter. (self isMemberOf: CompositionScanner) not ifTrue: [ stopCondition _ self scanCharactersFrom: 1 to: 1 in: illegalAsciiString rightX: rightMargin stopConditions: stopConditions displaying: self doesDisplaying] ifFalse: [ stopCondition _ self scanCharactersFrom: 1 to: 1 in: illegalAsciiString rightX: rightMargin stopConditions: stopConditions displaying: self doesDisplaying]. lastIndex _ saveIndex + 1. stopCondition ~= (stopConditions at: EndOfRun) ifTrue: [^self perform: stopCondition] ifFalse: [lastIndex = runStopIndex ifTrue: [^self perform: (stopConditions at: EndOfRun)]. ^false]! ! !ExternalStream methodsFor: 'nonhomogeneous accessing'! nextSigned "Answer the next byte from the receiver as a signed byte." | value | self atEnd ifTrue: [^false]. ^(value _ self next asInteger) > 127 ifTrue: [256 + value negated] ifFalse: [value]! ! !CharacterBlockScanner methodsFor: 'scanning'! characterNotInFont "This does not handle character selection nicely, i.e., illegal characters are a little tricky to select. Since the end of a run or line is subverted here by actually having the scanner scan a different string in order to manage the illegal character, things are not in an absolutely correct state for the character location code. If this becomes too odious in use, logic will be added to accurately manage the situation." lastCharacterExtent _ (font widthOf: (font maxAscii + 1 min: 255) asCharacter) @ textStyle lineGrid. ^super characterNotInFont! ! -- Eliot Miranda email: eliot@cs.qmw.ac.uk Dept of Computer Science Tel: 071 975 5220 (+44 71 975 5220) Queen Mary Westfield College ARPA: eliot%cs.qmw.ac.uk@nsfnet-relay.ac.uk Mile End Road UUCP: eliot@qmw-cs.uucp LONDON E1 4NS