--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MenuButt.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,53 @@
+"
+ COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Button subclass:#MenuButton
+ instanceVariableNames:'enterAction'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+MenuButton comment:'
+
+COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+these objects implement the special buttons used for pull-down-menu-bars.
+they highlight on enter events (while pressed) and perform their
+action on release
+
+@(#)MenuButt.st 3.1 92/08/23
+written spring/summer 89 by claus
+'!
+
+!MenuButton methodsFor:'initialization'!
+
+initEvents
+ super initEvents.
+ self enableEnterEvents
+! !
+
+!MenuButton methodsFor:'accessing'!
+
+enterAction:aBlock
+ enterAction := aBlock
+! !
+
+!MenuButton methodsFor:'events'!
+
+pointerEnter:state x:x y:y
+ (state bitTest:(device bitButton1)) ifTrue:[
+ self turnOn.
+ enterAction notNil ifTrue:[enterAction value]
+ ]
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MenuButton.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,53 @@
+"
+ COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Button subclass:#MenuButton
+ instanceVariableNames:'enterAction'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+MenuButton comment:'
+
+COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+these objects implement the special buttons used for pull-down-menu-bars.
+they highlight on enter events (while pressed) and perform their
+action on release
+
+@(#)MenuButt.st 3.1 92/08/23
+written spring/summer 89 by claus
+'!
+
+!MenuButton methodsFor:'initialization'!
+
+initEvents
+ super initEvents.
+ self enableEnterEvents
+! !
+
+!MenuButton methodsFor:'accessing'!
+
+enterAction:aBlock
+ enterAction := aBlock
+! !
+
+!MenuButton methodsFor:'events'!
+
+pointerEnter:state x:x y:y
+ (state bitTest:(device bitButton1)) ifTrue:[
+ self turnOn.
+ enterAction notNil ifTrue:[enterAction value]
+ ]
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MotionButton.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,48 @@
+"
+ COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Button subclass:#MotionButton
+ instanceVariableNames:'oldBorderWidth'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+MotionButton comment:'
+
+COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+a motionButton highlights itself whenever the cursor
+walks into it ...
+
+@(#)MtnButt.st 3.1 92/08/23
+written spring/summer 89 by claus
+'!
+
+!MotionButton methodsFor:'initialization'!
+
+initEvents
+ super initEvents.
+ self enableEnterLeaveEvents
+! !
+
+!MotionButton methodsFor:'events'!
+
+pointerEnter:state x:x y:y
+ oldBorderWidth := self borderWidth.
+ self borderWidth:(oldBorderWidth * 2)
+!
+
+pointerLeave:state
+ self borderWidth:oldBorderWidth
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MtnButt.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,48 @@
+"
+ COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Button subclass:#MotionButton
+ instanceVariableNames:'oldBorderWidth'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+MotionButton comment:'
+
+COPYRIGHT (c) 1989/90/91 by Claus Gittinger
+ All Rights Reserved
+
+a motionButton highlights itself whenever the cursor
+walks into it ...
+
+@(#)MtnButt.st 3.1 92/08/23
+written spring/summer 89 by claus
+'!
+
+!MotionButton methodsFor:'initialization'!
+
+initEvents
+ super initEvents.
+ self enableEnterLeaveEvents
+! !
+
+!MotionButton methodsFor:'events'!
+
+pointerEnter:state x:x y:y
+ oldBorderWidth := self borderWidth.
+ self borderWidth:(oldBorderWidth * 2)
+!
+
+pointerLeave:state
+ self borderWidth:oldBorderWidth
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Ruler.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,209 @@
+"
+ COPYRIGHT (c) 1991-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+View subclass:#Ruler
+ instanceVariableNames:'fgColor metric paperWidth paperHeight'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+Ruler comment:'
+
+COPYRIGHT (c) 1991-93 by Claus Gittinger
+ All Rights Reserved
+
+a Ruler for page layout.
+
+%W% %E%
+
+written oct 91 by claus
+'!
+
+!Ruler methodsFor:'accessing'!
+
+metric:aSymbol
+ "set the metric"
+
+ metric := aSymbol.
+ shown ifTrue:[
+ self redraw
+ ]
+! !
+
+!Ruler methodsFor:'redrawing'!
+
+redraw
+ "redraw scale"
+
+ |x pixelPerMM pixelPerInch mod pos shortLen veryShortLen longLen charY
+ top paperWidthMM paperWidthPixel|
+
+ self fill:viewBackground.
+
+ paperWidthPixel := (self inchToPixel:paperWidth) rounded.
+ (width > paperWidthPixel) ifTrue:[
+ self paint:(Color darkGrey).
+ self fillRectangleX:paperWidthPixel y:0
+ width:(width - paperWidthPixel) height:height.
+ self paint:fgColor.
+ self displayLineFromX:paperWidthPixel y:0
+ toX:paperWidthPixel y:height
+ ].
+
+ self paint:fgColor.
+
+ top := height - font height - font ascent.
+ longLen := font height.
+ shortLen := longLen // 2.
+ charY := top + (font ascent) + shortLen.
+ mod := 1.
+
+ (metric == #mm) ifTrue:[
+ "centimeter - long blibs every centimeter; short ones every half"
+
+ paperWidthMM := self inchToMillimeter:paperWidth.
+ pixelPerMM := self millimeterToPixel:1.
+ pos := 5.
+ x := (pixelPerMM * pos) rounded.
+ self displayString:'cm' x:3 y:charY.
+ [(x < width) and:[pos <= paperWidthMM]] whileTrue:[
+ (mod == 1) ifTrue:[
+ self displayLineFromX:x y:top
+ toX:x y:(top + shortLen)
+ ] ifFalse:[
+ self displayLineFromX:x y:top
+ toX:x y:(top + longLen).
+ self displayString:(pos // 10) asInteger printString
+ x:(x + 3)
+ y:charY
+ ].
+ mod := (mod + 1) \\ 2.
+ pos := pos + 5.
+ x := (pixelPerMM * pos) rounded
+ ]
+ ].
+ (metric == #inch) ifTrue:[
+ "inches - long blibs every inch; short ones every half; very
+ short ones every quarter"
+
+ pixelPerInch := self inchToPixel:1.
+ pos := 0.25.
+ x := (pixelPerInch * pos) rounded.
+ veryShortLen := longLen // 4.
+ self displayString:'inch' x:3 y:charY.
+ [(x < width) and:[pos <= paperWidth]] whileTrue:[
+ (mod == 0) ifTrue:[
+ self displayLineFromX:x y:top
+ toX:x y:(top + longLen).
+ self displayString:pos asInteger printString
+ x:(x + 3)
+ y:charY
+ ] ifFalse:[
+ (mod == 2) ifTrue:[
+ self displayLineFromX:x y:top
+ toX:x y:(top + shortLen)
+ ] ifFalse:[
+ self displayLineFromX:x y:top
+ toX:x y:(top + veryShortLen)
+ ]
+ ].
+ mod := (mod + 1) \\ 4.
+ pos := pos + 0.25.
+ x := (pixelPerInch * pos) rounded
+ ]
+ ].
+ self redrawEdges
+! !
+
+!Ruler methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ fgColor := Black.
+ self height:(font height + font descent + font descent).
+ (Language == #english) ifTrue:[
+ metric := #inch
+ ] ifFalse:[
+ metric := #mm
+ ].
+ paperWidth := 8.5.
+ paperHeight := 11
+
+ "Ruler new realize"
+! !
+
+!Ruler methodsFor:'metric conversions'!
+
+inchToMillimeter:inches
+ "convert inches to mm"
+
+ ^ inches * 25.4
+!
+
+inchToPixel:inches
+ "convert inches to screen pixels"
+
+ ^ inches * self horizontalPixelPerInch
+!
+
+inchToTwip:inches
+ "convert inches to twips"
+
+ ^ inches * 1440
+
+!
+
+millimeterToPixel:mm
+ "convert mms to screen pixels"
+
+ ^ mm * self horizontalPixelPerMillimeter
+
+!
+
+millimeterToInch:mm
+ "convert mm to inches"
+
+ ^ mm / 25.4
+!
+
+pointToTwip:points
+ "convert points to twips"
+
+ ^ points * 20
+!
+
+twipToInch:twips
+ "convert twips to inches"
+
+ ^ twips / 1440.0
+!
+
+pixelToInch:pixels
+ "convert pixels to inches"
+
+ ^ pixels / self horizontalPixelPerInch
+!
+
+twipToPixel:twips
+ "convert twips to screen pixels"
+
+ ^ (twips / 1440.0) * self horizontalPixelPerInch
+
+!
+
+twipToPoint:twips
+ "convert twips to points"
+
+ ^ twips / 20.0
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Slider.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,137 @@
+"
+ COPYRIGHT (c) 1992-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Scroller subclass:#Slider
+ instanceVariableNames:'sliderHeight'
+ classVariableNames: ''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+Slider comment:'
+
+COPYRIGHT (c) 1992-93 by Claus Gittinger
+ All Rights Reserved
+
+this class implements sliders - which are simply scrollers
+with a constant thumbHeight and a sligthly different way of
+drawing.
+
+Instance variables:
+
+%W% %E%
+
+written summer 92 by claus
+'!
+
+!Slider methodsFor:'initialization'!
+
+initialize
+ sliderHeight := (self verticalPixelPerMillimeter:10) rounded.
+ super initialize.
+ thumbHeight := 0
+! !
+
+!Slider methodsFor:'accessing'!
+
+thumbHeight
+ "redefined since a slider has no height - just origin"
+
+ ^ nil
+! !
+
+!Slider methodsFor:'private'!
+
+absFromPercent:percent
+ "given a percentage, compute number of pixels"
+
+ ^ ((percent * (height - sliderHeight - (margin * 2))) / 100) rounded
+!
+
+percentFromAbs:absValue
+ "given a number of pixels, compute percentage"
+
+ |val|
+
+ val := absValue / (height - sliderHeight - (margin * 2)) * 100.
+ val < 0 ifTrue:[^ 0].
+ val > 100 ifTrue:[^ 100].
+ ^ val
+!
+
+computeThumbFrame
+ "redefined, since the thumb-height stays constant"
+
+ |nh nw ny nx|
+
+ thumbHeight := 0.
+ ny := (self absFromPercent:thumbOrigin) + margin.
+ nh := sliderHeight.
+ self is3D ifTrue:[
+ nx := margin.
+ nw := width - (2 * margin)
+ ] ifFalse:[
+ nx := inset.
+ nw := width - (inset * 2)
+ ].
+ "
+ do not create new Rectangle if its the same anyway
+ "
+ thumbFrame notNil ifTrue:[
+ (ny == thumbFrame top) ifTrue:[
+ (nx == thumbFrame left) ifTrue:[
+ (nh == thumbFrame height) ifTrue:[
+ (nw == thumbFrame width) ifTrue:[ ^ self]
+ ]
+ ]
+ ]
+ ].
+ thumbFrame := Rectangle left:nx top:ny width:nw height:nh
+! !
+
+!Slider methodsFor:'drawing'!
+
+drawThumb
+ "draw the thumb"
+
+ |markX markY l t w h sep|
+
+ l := thumbFrame left.
+ t := thumbFrame top.
+ w := thumbFrame width.
+ h := thumbFrame height.
+ sep := thumbLevel.
+ self paint:thumbColor.
+ self fillRectangleX:l y:t width:w height:h.
+
+ markX := l + sep.
+ markY := t + ((h - 2) // 2).
+
+ self is3D ifTrue:[
+ self drawEdgesForX:l y:t width:w height:h level:thumbLevel
+ shadow:thumbShadowColor light:thumbLightColor
+ halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor.
+
+ self paint:thumbShadowColor.
+ self displayLineFromX:markX y:markY toX:(w - sep) y:markY.
+ markY := markY + 1.
+ self paint:thumbLightColor.
+ self displayLineFromX:markX y:markY toX:(w - sep) y:markY
+ ] ifFalse:[
+ self paint:thumbFrameColor.
+ self drawRectangle:thumbFrame.
+ self paint:Black.
+ self displayLineFromX:markX y:markY toX:(w - sep + 1) y:markY.
+ markY := markY + 1.
+ self displayLineFromX:markX y:markY toX:(w - sep + 1) y:markY
+ ]
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TextBox.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,106 @@
+"
+ COPYRIGHT (c) 1992-93 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+EnterBox subclass:#TextBox
+ instanceVariableNames:'textView'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+TextBox comment:'
+
+COPYRIGHT (c) 1992-93 by Claus Gittinger
+ All Rights Reserved
+
+this class implements a pop-up box to enter some text
+with 2 buttons; one to cancel, another to start some action
+
+%W% %E%
+written Mai 92 by claus
+'!
+
+!TextBox class methodsFor:'defaults'!
+
+defaultExtent
+ ^ (Display pixelPerMillimeter * (120 @ 90)) rounded
+! !
+
+!TextBox methodsFor:'initialization'!
+
+initialize
+ |space2 space3 innerWidth|
+
+ super initialize.
+
+ space2 := 2 * ViewSpacing.
+ space3 := 3 * ViewSpacing.
+
+ "kludge: preset extent to something useful since other subviews
+ depend on it (extent blocks are not evaluated until view is realized)
+ - avoid visible resizing when realized the first time"
+
+ innerWidth := width - space2.
+
+ textView := ScrollableView for:EditTextView in:self.
+ textView origin:(ViewSpacing @ (space2 + labelField height))
+ extent:(innerWidth @ (height - ViewSpacing -
+ labelField height - ViewSpacing -
+ buttonPanel height - space3) ).
+ textView origin:[ViewSpacing @ (space2 + labelField height)]
+ extent:[(width - space2) @ (height - ViewSpacing -
+ labelField height - ViewSpacing -
+ buttonPanel height - space3) ].
+
+ self keyboardHandler:textView
+
+ "TextBox new showAtPointer"
+! !
+
+!TextBox methodsFor:'private'!
+
+resize
+ "resize myself to make everything visible"
+
+ |wWanted hWanted wPanel|
+
+ wWanted := labelField width + ViewSpacing + ViewSpacing.
+ (wWanted > width) ifFalse:[
+ wWanted := width
+ ].
+ wPanel := ViewSpacing * 3.
+ buttonPanel subViews do:[:aView |
+ wPanel := wPanel + aView width + ViewSpacing
+ ].
+ wPanel > wWanted ifTrue:[
+ wWanted := wPanel
+ ].
+ hWanted := ViewSpacing + labelField height +
+ ViewSpacing + textView height +
+ (ViewSpacing * 6) + buttonPanel height +
+ ViewSpacing.
+ self extent:(wWanted @ hWanted)
+! !
+
+!TextBox methodsFor:'accessing'!
+
+initialText:aString
+ "define the initial text in the enterfield"
+
+ textView contents:aString
+!
+
+contents
+ "return my contents"
+
+ ^ textView contents
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/TextRuler.st Fri Jul 16 11:44:30 1993 +0200
@@ -0,0 +1,384 @@
+"
+ COPYRIGHT (c) 1991/92 by Claus Gittinger
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+Ruler subclass:#TextRuler
+ instanceVariableNames:'leftMargin rightMargin tabStops tabTypes'
+ classVariableNames:'leftAlignForm rightAlignForm
+ alignForm centerForm leftMarginForm
+ rightMarginForm leftTabForm rightTabForm
+ centerTabForm
+ decimalTabForm currentTabType moving'
+ poolDictionaries:''
+ category:'Views-Interactors'
+!
+
+TextRuler comment:'
+
+COPYRIGHT (c) 1991/92 by Claus Gittinger
+ All Rights Reserved
+
+a Ruler for page layout showing tabs., margins etc.
+
+@(#)TextRuler.st 3.1 92/08/23
+written oct 91 by claus
+'!
+
+!TextRuler class methodsFor:'defaults'!
+
+alignForm
+ "return the form displayed in the align-button"
+
+ alignForm isNil ifTrue:[
+ alignForm := Form fromFile:'align.bit' resolution:100
+ ].
+ ^ alignForm
+!
+
+centerForm
+ "return the form displayed in the center-button"
+
+ centerForm isNil ifTrue:[
+ centerForm := Form fromFile:'center.bit' resolution:100
+ ].
+ ^ centerForm
+!
+
+leftAlignForm
+ "return the form displayed in the leftAlign-button"
+
+ leftAlignForm isNil ifTrue:[
+ leftAlignForm := Form fromFile:'leftAlign.bit' resolution:100
+ ].
+ ^ leftAlignForm
+!
+
+rightAlignForm
+ "return the form displayed in the rightAlign-button"
+
+ rightAlignForm isNil ifTrue:[
+ rightAlignForm := Form fromFile:'rightAlign.bit' resolution:100
+ ].
+ ^ rightAlignForm
+!
+
+rightTabForm
+ "return the form displayed in the rightTab-button"
+
+ rightTabForm isNil ifTrue:[
+ rightTabForm := Form fromFile:'rightTab.bit' resolution:100
+ ].
+ ^ rightTabForm
+!
+
+leftTabForm
+ "return the form displayed in the leftTab-button"
+
+ leftTabForm isNil ifTrue:[
+ leftTabForm := Form fromFile:'leftTab.bit' resolution:100
+ ].
+ ^ leftTabForm
+!
+
+centerTabForm
+ "return the form displayed in the centerTab-button"
+
+ centerTabForm isNil ifTrue:[
+ centerTabForm := Form fromFile:'centerTab.bit' resolution:100
+ ].
+ ^ centerTabForm
+!
+
+decimalTabForm
+ "return the form displayed in the decimalTab-button"
+
+ decimalTabForm isNil ifTrue:[
+ decimalTabForm := Form fromFile:'decimalTab.bit' resolution:100
+ ].
+ ^ decimalTabForm
+!
+
+leftMarginForm
+ "return the form displayed for the left margin marker"
+
+ leftMarginForm isNil ifTrue:[
+ leftMarginForm := Form fromFile:'leftMargin.bit' resolution:100
+ ].
+ ^ leftMarginForm
+!
+
+rightMarginForm
+ "return the form displayed for the right margin marker"
+
+ rightMarginForm isNil ifTrue:[
+ rightMarginForm := Form fromFile:'rightMarg.bit' resolution:100
+ ].
+ ^ rightMarginForm
+! !
+
+!TextRuler methodsFor:'initializing'!
+
+initialize
+ |leftAlignToggle alignToggle centerToggle rightAlignToggle
+ leftTabButton centerTabButton rightTabButton decimalTabButton
+ lineSpacingField panel1 panel2 panel3 scaleHeight h group|
+
+ super initialize.
+
+ scaleHeight := (font height) * 2.
+ self height:(scaleHeight * 3).
+
+ h := self class leftAlignForm height.
+ panel1 := HorizontalPanelView
+ origin:(0.0 @ 0.0)
+ extent:[(width // 3) @ (h*2) "(height - scaleHeight)"]
+ in:self.
+ panel1 borderWidth:0.
+ panel1 layout:#left.
+
+ panel2 := HorizontalPanelView
+ origin:[(width // 3) @ margin]
+ extent:[(width // 3) @ (h*2) "(height - scaleHeight)"]
+ in:self.
+ panel2 borderWidth:0.
+ panel2 layout:#center.
+
+ panel3 := HorizontalPanelView
+ origin:[(width // 3 * 2) @ margin]
+ extent:[((width // 3)-margin) @ (h*2) "(height - scaleHeight)"]
+ in:self.
+ panel3 borderWidth:0.
+ panel3 layout:#right.
+
+ leftAlignToggle := RadioButton form:(self class leftAlignForm)
+ action:[self leftAlign]
+ in:panel1.
+ alignToggle := RadioButton form:(self class alignForm)
+ action:[self align]
+ in:panel1.
+ centerToggle := RadioButton form:(self class centerForm)
+ action:[self center]
+ in:panel1.
+ rightAlignToggle := RadioButton form:(self class rightAlignForm)
+ action:[self rightAlign]
+ in:panel1.
+ group := RadioButtonGroup new.
+ group add:leftAlignToggle.
+ group add:alignToggle.
+ group add:centerToggle.
+ group add:rightAlignToggle.
+
+ leftTabButton := Button form:(self class leftTabForm)
+ action:[self leftTab]
+ in:panel2.
+ centerTabButton := Button form:(self class centerTabForm)
+ action:[self centerTab]
+ in:panel2.
+ rightTabButton := Button form:(self class rightTabForm)
+ action:[self rightTab]
+ in:panel2.
+ decimalTabButton := Button form:(self class decimalTabForm)
+ action:[self decimalTab]
+ in:panel2.
+
+ lineSpacingField := EditField in:panel3.
+
+
+ leftMargin := 0.25.
+ rightMargin := 8.25
+
+ "TextRuler new realize"
+!
+
+initEvents
+ super initEvents.
+ self enableButtonEvents.
+ self enableButtonMotionEvents
+
+! !
+
+!TextRuler methodsFor:'user interaction'!
+
+leftAlign
+ ^ self
+!
+
+rightAlign
+ ^ self
+!
+
+align
+ ^ self
+!
+
+center
+ ^ self
+!
+
+leftTab
+ ^ self
+!
+
+rightTab
+ ^ self
+!
+
+centerTab
+ ^ self
+!
+
+decimalTab
+ ^ self
+!
+
+buttonPress:button x:x y:y
+ "position a tab or start moving a ruler"
+
+ |mpos|
+
+ mpos := self inchToPixel:leftMargin.
+ (((mpos - 4) <= x) and:[x <= (mpos + 4)]) ifTrue:[
+ "start moving left margin"
+ moving := #left.
+ ^ self
+ ].
+ mpos := self inchToPixel:rightMargin.
+ (((mpos - 4) <= x) and:[x <= (mpos + 4)]) ifTrue:[
+ "start moving right margin"
+ moving := #right.
+ ^ self
+ ].
+
+ ^ self
+!
+
+buttonMotion:state x:x y:y
+ "position a tab or start moving a ruler"
+
+ |mpos|
+
+ moving notNil ifTrue:[
+ self clearMargin:moving.
+ mpos := self pixelToInch:x.
+ (mpos < 0) ifTrue:[
+ mpos := 0
+ ].
+ (mpos > paperWidth) ifTrue:[
+ mpos := paperWidth
+ ].
+ (moving == #left) ifTrue:[
+ leftMargin := mpos
+ ].
+ (moving == #right) ifTrue:[
+ rightMargin := mpos
+ ].
+ self drawMargin:moving
+ ]
+!
+
+buttonRelease:button x:x y:y
+ "position a tab or start moving a ruler"
+
+ moving := nil
+! !
+
+!TextRuler methodsFor:'redrawing'!
+
+clearMargin:which
+ "clear margin"
+
+ |x top form|
+
+ self paint:viewBackground.
+ self background:viewBackground.
+
+ top := height - (font height) - (font ascent).
+
+ (which == #left) ifTrue:[
+ x := (self inchToPixel:leftMargin) rounded.
+ form := self class leftMarginForm
+ ].
+ (which == #right) ifTrue:[
+ x := (self inchToPixel:rightMargin) rounded.
+ form := self class rightMarginForm
+ ].
+
+ self drawOpaqueForm:form x:(x - (form width // 2))
+!
+
+drawMargin:which
+ "clear margin"
+
+ |x top form|
+
+ self paint:fgColor.
+ self background:viewBackground.
+
+ top := height - (font height) - (font ascent).
+
+ (which == #left) ifTrue:[
+ x := (self inchToPixel:leftMargin) rounded.
+ form := self class leftMarginForm
+ ].
+ (which == #right) ifTrue:[
+ x := (self inchToPixel:rightMargin) rounded.
+ form := self class rightMarginForm
+ ].
+
+ self drawOpaqueForm:form x:(x - (form width // 2))
+!
+
+redraw
+ "redraw margin & tab marks"
+
+ |x top form tab type|
+
+ super redraw.
+
+ self paint:fgColor.
+ self background:viewBackground.
+
+ top := height - (font height) - (font ascent).
+
+ x := (self inchToPixel:leftMargin) rounded.
+ form := self class leftMarginForm.
+ self drawOpaqueForm:form x:(x - (form width // 2))
+ y:(top - form height).
+ x := (self inchToPixel:rightMargin) rounded.
+ form := self class rightMarginForm.
+ self drawOpaqueForm:form x:(x - (form width // 2))
+ y:(top - form height).
+
+ tabStops notNil ifTrue:[
+ 1 to:tabStops size do:[:tabNr |
+ tab := tabStops at:tabNr.
+ type := tabTypes at:tabNr.
+ x := (self inchToPixel:tab) rounded.
+ (type == #left) ifTrue:[
+ form := self class leftTabForm
+ ] ifFalse:[
+ (type == #right) ifTrue:[
+ form := self class rightTabForm
+ ] ifFalse:[
+ (type == #center) ifTrue:[
+ form := self class centerTabForm
+ ] ifFalse:[
+ (type == #decimal) ifTrue:[
+ form := self class decimalTabForm
+ ]
+ ]
+ ]
+ ].
+ self drawOpaqueForm:form x:(x - (form width // 2))
+ y:(top - form height)
+ ]
+ ]
+! !