[ENH] Automatically Make Arrows In Strike Fonts

Steven Swerling sps2000 at mail.com
Fri Feb 20 17:24:14 UTC 2004


A little changeset that finds the underscore and caret characters in a 
StrikeFont and overwrites them with graphic assign and return arrows. 
Only works for strike fonts. To use it get a hold of a font, then call 
"makeArrows" on it's textStyle. Eg.,

In 3.6, try:
   TextStyle default makeArrows.
In 3.7, try:
   Preferences standardCodeFont textStyle makeArrows.

Then open a new browser and browse to some method with _ and ^ 
characters, and see if you like it.

It's only useful if you occasionally import StrikeFonts into your image.

There is no way to undo the change to the font, so make sure you like 
the look of the font changes before saving your image.

It's a noop on TTC fonts.
-------------- next part --------------
'From Squeak3.4beta of ''1 December 2002'' [latest update: #5138] on 15 October 2003 at 5:42:21 pm'!
"Change Set:		MakeArrows-sps
Date:			15 October 2003
Author:			Steven Swerling

Adds a couple of methods to StrikeFont, #makeAssignArrow and #makeReturnArrow. These methods replace the underscore (_) and caret (^) characters with graphic arrows, sized to fit the given StrikeFont. Also adds TextStyle>>makeArrows, which creates arrows for every font in a given family (if they are StrikeFonts). 

Only works on StrikeFont (on TTC fonts, it's a noop). Only useful if you occasionally import StrikeFonts into your image.

In 3.6, try this:
  TextStyle default makeArrows.
In 3.7, try this:
  Preferences standardCodeFont textStyle makeArrows.
"!


!StrikeFont methodsFor: 'make arrows' stamp: 'sps 10/15/2003 17:06'!
makeAssignArrow
"Replace the underline character with an arrow for this font"

	| arrowForm arrowCanvas arrowY arrowLeft arrowRight arrowHeadLength |

	arrowForm _ (self characterFormAt: $_) copy.
	arrowCanvas _ arrowForm getCanvas.
	arrowCanvas fillColor: Color white.
	arrowY _ arrowForm height // 2.
	arrowLeft _ 0. 
	arrowRight _ arrowForm width - 2.
	arrowHeadLength _ (arrowRight - arrowLeft) * 2 // 5.
	"Draw the lines"
	arrowCanvas line: (arrowLeft at arrowY) to: (arrowRight at arrowY) color: Color black.
	arrowCanvas 
		line: (arrowLeft at arrowY) 
		to: ((arrowLeft + arrowHeadLength)@(arrowY - arrowHeadLength)) 
		color: Color black.
	arrowCanvas 
		line: (arrowLeft at arrowY) 
		to: ((arrowLeft + arrowHeadLength)@(arrowY + arrowHeadLength)) 
		color: Color black.

	"Replace the glyph"
	self characterFormAt: $_ put: arrowForm.

! !

!StrikeFont methodsFor: 'make arrows' stamp: 'sps 10/15/2003 17:06'!
makeReturnArrow
"Replace the caret character with an arrow"

	| arrowForm arrowCanvas arrowHeadLength arrowX arrowTop arrowBottom |

	arrowForm _ (self characterFormAt: $^) copy.
	arrowCanvas _ arrowForm getCanvas.
	arrowCanvas fillColor: Color white.

	arrowHeadLength _ ((arrowForm width - 2)// 2).
	arrowX _ (arrowHeadLength max: (arrowForm width // 2)).
	arrowTop _ arrowForm height // 4. 
	arrowBottom _ (arrowTop + (arrowForm width * 4 // 5 )).
	arrowBottom _ (arrowBottom min: arrowForm height) max: (arrowForm height * 2 // 3).

	"Draw the lines"
	arrowCanvas line: (arrowX at arrowTop) to: (arrowX at arrowBottom) color: Color black.
	arrowCanvas 
		line: (arrowX at arrowTop) 
		to: ((arrowX - arrowHeadLength)@(arrowTop + arrowHeadLength)) 
		color: Color black.
	arrowCanvas 
		line: (arrowX at arrowTop) 
		to: ((arrowX + arrowHeadLength)@(arrowTop + arrowHeadLength)) 
		color: Color black.

	"Replace the glyph"
	self characterFormAt: $^ put: arrowForm.

! !


!TextStyle methodsFor: 'make arrows' stamp: 'sps 10/15/2003 17:09'!
makeArrows
"
TextStyle default makeArrows.
"
	fontArray do: [ :font |
		(font isKindOf: StrikeFont) ifTrue:[ 
			font 
				makeAssignArrow; 
				makeReturnArrow.
		]
	].
! !



More information about the Squeak-dev mailing list