The Trunk: MorphicExtras-tfel.172.mcz

Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.172.mcz

==================== Summary ====================

Name: MorphicExtras-tfel.172
Author: tfel
Time: 20 April 2016, 2:25:18.788021 pm
UUID: cd9fb2c0-84a9-ee4c-a244-98522b2ac822
Ancestors: MorphicExtras-mt.171

make postscript printing work again with current default fonts

=============== Diff against MorphicExtras-mt.171 ===============

Item was added:
+ ----- Method: PostscriptCanvas class>>fontsForDejaVuSans (in category 'font mapping') -----
+ fontsForDejaVuSans
+
+ | d |
+
+ "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16"
+ d := Dictionary new.
+ d
+ at: 0 put: #('Helvetica-Bold' 1.0);
+ at: 1 put: #('Helvetica-Bold' 1.0);
+ at: 2 put: #('Helvetica-Oblique' 1.0);
+ at: 3 put: #('Helvetica-BoldOblique' 1.0).
+ ^d!

Item was changed:
  ----- Method: PostscriptCanvas class>>initializeFontMap (in category 'font mapping') -----
  initializeFontMap
  "Initialize the dictionary mapping font names to substitutions for Postscript code generation."
  "PostscriptCanvas initializeFontMap"
  | f |
  FontMap := Dictionary new.
  FontMap
  at: 'NewYork' put: (f := self fontsForNewYork);
  at: 'Accuny' put: f;
 
  at: 'Helvetica' put: (f := self fontsForHelvetica);
  at: 'Accujen' put: f;
 
  at: 'Palatino' put: self fontsForPalatino;
 
  at: 'ComicBold' put: (f := self fontsForComicBold);
  at: 'Accuat' put: self fontsForAccuAt;
 
+ at: 'Bitmap DejaVu Sans' put: self fontsForDejaVuSans;
+
  at: 'ComicPlain' put: self fontsForComicPlain!

Item was changed:
  ----- Method: PostscriptCanvas class>>postscriptFontInfoForFont: (in category 'font mapping') -----
  postscriptFontInfoForFont: font
 
  | decoded decodedName keys match fontName |
 
  fontName := font textStyleName asString.
  decoded := TextStyle decodeStyleName: fontName.
  decodedName := decoded second.
  keys := self fontMap keys asArray sort: [ :a :b | a size > b size ].
-
  match := keys select: [ :k | decoded first = k or: [ fontName = k ] ].
  match do: [ :key | | subD desired mask |
  subD := self fontMap at: key.
  desired := font emphasis.
  mask := 31.
  [
  desired := desired bitAnd: mask.
  subD at: desired ifPresent: [ :answer | ^answer].
  mask := mask bitShift: -1.
  desired > 0
  ] whileTrue.
  ].
 
  "No explicit lookup found; try to convert the style name into the canonical Postscript name.
  This name will probably still be wrong."
 
  fontName := String streamContents: [ :s |
  s nextPutAll: decodedName.
  decoded third do: [ :nm | s nextPut: $-; nextPutAll: nm ].
 
  (font emphasis = 0 and: [ (decoded last includes: 0) not ])
  ifTrue: [ s nextPutAll:  '-Regular' ].
 
  (font emphasis = 1 and: [ (decoded first anyMask: 1) not ])
  ifTrue: [ s nextPutAll:  '-Bold' ].
 
  (font emphasis = 2 and: [ (decoded first anyMask: 2) not ])
  ifTrue: [ s nextPutAll:  '-Italic' ].
 
  (font emphasis = 3 and: [ (decoded first anyMask: 3) not ])
  ifTrue: [ s nextPutAll:  '-BoldItalic' ].
  ].
 
+ ^ {'(', fontName, ') cvn'. 1.0}
- ^ {fontName. 1.0}
  !

Item was changed:
  ----- Method: PostscriptCanvas>>image:at:sourceRect:rule: (in category 'private') -----
+ image: form at: aPoint sourceRect: sourceRect rule: rule
+ | aForm |
- image: aForm at: aPoint sourceRect: sourceRect rule: rule
  self preserveStateDuring:
  [:inner | inner translate: aPoint + self origin.
+ aForm := form depth <= 8 ifTrue: [form asFormOfDepth: 32] ifFalse: [form].
+ target write: ((aForm colorsUsed includes: Color transparent)
+ ifTrue: [| top f2 c2 offset |
+ "tfel: This was taken from SketchMorph, but is actually needed for all
+ forms that use transparency"
+ offset := currentTransformation ifNil: [0@0] ifNotNilDo: [:t | t offset].
+ top := self topLevelMorph.
+ f2 := Form extent: aForm extent depth: self depth.
+ c2 := f2 getCanvas.
+ c2 fillColor: Color white.
+ c2
+ translateBy: offset - self origin - aPoint
+ clippingTo: f2 boundingBox
+ during: [:c | top fullDrawOn: c].
+ f2]
+ ifFalse: [aForm])].
- target write: aForm]
  !

Item was removed:
- ----- Method: SketchMorph>>drawPostscriptOn: (in category '*MorphicExtras-*morphic-Postscript Canvases') -----
- drawPostscriptOn: aCanvas
-
- | top f2 c2 tfx clrs |
-
- tfx := self transformFrom: self world.
- tfx angle = 0.0 ifFalse: [^super drawPostscriptOn: aCanvas]. "can't do rotated yet"
- clrs := self rotatedForm colorsUsed.
- (clrs includes: Color transparent)
- ifFalse: [^super drawPostscriptOn: aCanvas]. "no need for this, then"
-
- "Smalltalk at: #Q put: OrderedCollection new"
- "Q add: {self. tfx. clrs}."
- "(self hasProperty: #BOB) ifTrue: [self halt]."
-
- top := aCanvas topLevelMorph.
- f2 := Form extent: self extent depth: self rotatedForm depth.
- c2 := f2 getCanvas.
- c2 fillColor: Color white.
- c2 translateBy: bounds origin negated clippingTo: f2 boundingBox during: [ :c |
- top fullDrawOn: c
- ].
- aCanvas paintImage: f2 at: bounds origin
-
- !