Initial revision
authorclaus
Wed, 24 Aug 1994 01:44:22 +0200
changeset 19 79ab6bc98651
parent 18 4560fcdc40df
child 20 bf516dd2433b
Initial revision
MCLEntry.st
MultiColListEntry.st
TabSpec.st
TabulatorSpecification.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MCLEntry.st	Wed Aug 24 01:44:22 1994 +0200
@@ -0,0 +1,184 @@
+'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:03 pm'!
+
+Object subclass:#MultiColListEntry
+         instanceVariableNames:'strings tabSpec'
+         classVariableNames:''
+         poolDictionaries:''
+         category:'Views-Support'
+!
+
+!MultiColListEntry methodsFor:'accessing'!
+
+colAt:index put:aString
+    strings isNil ifTrue:[
+        strings := OrderedCollection new:index
+    ].
+    strings grow:index.
+    strings at:index put:aString
+
+
+
+!
+
+tabulatorSpecification:aTabSpec
+    tabSpec := aTabSpec
+
+
+! !
+
+!MultiColListEntry methodsFor:'converting'!
+
+asString
+    |s tab|
+
+    s := ''.
+    tab := Character tab asString.
+    1 to:strings size do:[:subStringIndex |
+        s := s , (strings at:subStringIndex).
+        subStringIndex == strings size ifFalse:[
+            s := s , tab
+        ]
+    ].
+
+    ^ s
+! !
+
+!MultiColListEntry methodsFor:'drawing'!
+
+displayOn:aGC x:x y:y
+    |xPos subString tabPos w prevString|
+
+    xPos := x.
+    prevString := ''.
+    1 to:strings size do:[:index |
+        subString := strings at:index.
+
+        "
+         find next tab
+        "
+        tabPos := tabSpec positionOfTab:index forString:subString on:aGC.
+        tabPos isNil ifTrue:[
+            "
+             no tab - just continue where we are ...
+            "
+            xPos := xPos + (aGC font widthOf:prevString).
+        ] ifFalse:[
+            xPos := tabPos + x.
+        ].
+        aGC displayString:subString x:xPos y:y.
+        prevString := subString.
+    ].
+
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     tabs := TabulatorSpecification new.
+     tabs unit:#inch.
+     tabs positions:#(0 3 6).
+     tabs align:#(left #left #left).
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'hello'.
+     e colAt:2 put:'hallo'.
+     e colAt:3 put:'salut'.
+     e tabulatorSpecification:tabs.
+     myList add:e.
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'good morning'.
+     e colAt:2 put:'guten Morgen'.
+     e colAt:3 put:'bon jour'.
+     e tabulatorSpecification:tabs.
+     myList add:e.
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'good bye'.
+     e colAt:2 put:'auf Wiedersehen'.
+     e colAt:3 put:'au revoir '.
+     e tabulatorSpecification:tabs.
+     myList add:e.
+
+     v := ListView new.
+     v setList:myList expandTabs:false.
+     v open
+    "
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     tabs := TabulatorSpecification new.
+     tabs unit:#cm.
+     tabs positions:#(1 3 5).
+     tabs align:#(#right #center #left).
+
+     1 to:100 do:[:i|
+         e := MultiColListEntry new.
+         e colAt:1 put:i printString.
+         e colAt:2 put:i squared printString.
+         e colAt:3 put:i sqrt  printString.
+         e tabulatorSpecification:tabs.
+         myList add:e.
+     ].
+     v := ScrollableView for:ListView.
+     v setList:myList expandTabs:false.
+     v open
+    "
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     tabs := TabulatorSpecification new.
+     tabs unit:#cm.
+     tabs positions:#(1 3 6 9 12).
+     tabs align:#(#right #decimal #decimal #decimal #decimal).
+
+     1 to:100 do:[:i|
+         e := MultiColListEntry new.
+         e colAt:1 put:i printString.
+         e colAt:2 put:i log printString.
+         e colAt:3 put:i sqrt  printString.
+         e colAt:4 put:i sin  printString.
+         e colAt:5 put:i cos  printString.
+         e tabulatorSpecification:tabs.
+         myList add:e.
+     ].
+     v := ScrollableView for:ListView.
+     v setList:myList expandTabs:false.
+     v open
+    "
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'2'.
+     e colAt:2 put:'3.5'.
+     e colAt:3 put:'4'.
+     e colAt:4 put:'6'.
+     e colAt:5 put:'8'.
+     e colAt:6 put:'10'.
+     e colAt:7 put:'12'.
+     e tabPositions:#(0 2 3.5 4 6 8 10 12); tabUnit:#inch.
+     myList add:e.
+
+     v := ScrollableView for:ListView.
+     v setList:myList expandTabs:false.
+     v open
+    "
+
+
+
+
+
+
+
+
+
+
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MultiColListEntry.st	Wed Aug 24 01:44:22 1994 +0200
@@ -0,0 +1,184 @@
+'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:03 pm'!
+
+Object subclass:#MultiColListEntry
+         instanceVariableNames:'strings tabSpec'
+         classVariableNames:''
+         poolDictionaries:''
+         category:'Views-Support'
+!
+
+!MultiColListEntry methodsFor:'accessing'!
+
+colAt:index put:aString
+    strings isNil ifTrue:[
+        strings := OrderedCollection new:index
+    ].
+    strings grow:index.
+    strings at:index put:aString
+
+
+
+!
+
+tabulatorSpecification:aTabSpec
+    tabSpec := aTabSpec
+
+
+! !
+
+!MultiColListEntry methodsFor:'converting'!
+
+asString
+    |s tab|
+
+    s := ''.
+    tab := Character tab asString.
+    1 to:strings size do:[:subStringIndex |
+        s := s , (strings at:subStringIndex).
+        subStringIndex == strings size ifFalse:[
+            s := s , tab
+        ]
+    ].
+
+    ^ s
+! !
+
+!MultiColListEntry methodsFor:'drawing'!
+
+displayOn:aGC x:x y:y
+    |xPos subString tabPos w prevString|
+
+    xPos := x.
+    prevString := ''.
+    1 to:strings size do:[:index |
+        subString := strings at:index.
+
+        "
+         find next tab
+        "
+        tabPos := tabSpec positionOfTab:index forString:subString on:aGC.
+        tabPos isNil ifTrue:[
+            "
+             no tab - just continue where we are ...
+            "
+            xPos := xPos + (aGC font widthOf:prevString).
+        ] ifFalse:[
+            xPos := tabPos + x.
+        ].
+        aGC displayString:subString x:xPos y:y.
+        prevString := subString.
+    ].
+
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     tabs := TabulatorSpecification new.
+     tabs unit:#inch.
+     tabs positions:#(0 3 6).
+     tabs align:#(left #left #left).
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'hello'.
+     e colAt:2 put:'hallo'.
+     e colAt:3 put:'salut'.
+     e tabulatorSpecification:tabs.
+     myList add:e.
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'good morning'.
+     e colAt:2 put:'guten Morgen'.
+     e colAt:3 put:'bon jour'.
+     e tabulatorSpecification:tabs.
+     myList add:e.
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'good bye'.
+     e colAt:2 put:'auf Wiedersehen'.
+     e colAt:3 put:'au revoir '.
+     e tabulatorSpecification:tabs.
+     myList add:e.
+
+     v := ListView new.
+     v setList:myList expandTabs:false.
+     v open
+    "
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     tabs := TabulatorSpecification new.
+     tabs unit:#cm.
+     tabs positions:#(1 3 5).
+     tabs align:#(#right #center #left).
+
+     1 to:100 do:[:i|
+         e := MultiColListEntry new.
+         e colAt:1 put:i printString.
+         e colAt:2 put:i squared printString.
+         e colAt:3 put:i sqrt  printString.
+         e tabulatorSpecification:tabs.
+         myList add:e.
+     ].
+     v := ScrollableView for:ListView.
+     v setList:myList expandTabs:false.
+     v open
+    "
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     tabs := TabulatorSpecification new.
+     tabs unit:#cm.
+     tabs positions:#(1 3 6 9 12).
+     tabs align:#(#right #decimal #decimal #decimal #decimal).
+
+     1 to:100 do:[:i|
+         e := MultiColListEntry new.
+         e colAt:1 put:i printString.
+         e colAt:2 put:i log printString.
+         e colAt:3 put:i sqrt  printString.
+         e colAt:4 put:i sin  printString.
+         e colAt:5 put:i cos  printString.
+         e tabulatorSpecification:tabs.
+         myList add:e.
+     ].
+     v := ScrollableView for:ListView.
+     v setList:myList expandTabs:false.
+     v open
+    "
+    "
+     |v e myList tabs|
+
+     myList := OrderedCollection new.
+
+     e := MultiColListEntry new.
+     e colAt:1 put:'2'.
+     e colAt:2 put:'3.5'.
+     e colAt:3 put:'4'.
+     e colAt:4 put:'6'.
+     e colAt:5 put:'8'.
+     e colAt:6 put:'10'.
+     e colAt:7 put:'12'.
+     e tabPositions:#(0 2 3.5 4 6 8 10 12); tabUnit:#inch.
+     myList add:e.
+
+     v := ScrollableView for:ListView.
+     v setList:myList expandTabs:false.
+     v open
+    "
+
+
+
+
+
+
+
+
+
+
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/TabSpec.st	Wed Aug 24 01:44:22 1994 +0200
@@ -0,0 +1,119 @@
+'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:09 pm'!
+
+Object subclass:#TabulatorSpecification
+	 instanceVariableNames:'tabUnit tabPositions tabTypes'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Views-Support'
+!
+
+!TabulatorSpecification methodsFor:'queries'!
+
+pixelsPerUnitOn:aGC
+    "
+     return the number of device pixels one unit of my tabs
+     takes on aGC
+    "
+    tabUnit isNil ifTrue:[
+        tabUnit := #col
+    ].
+    tabUnit == #col ifTrue:[
+        ^ aGC font width
+    ].
+    tabUnit == #inch ifTrue:[
+        ^ aGC device horizontalPixelPerInch
+    ].
+    tabUnit == #mm ifTrue:[
+        ^ aGC device horizontalPixelPerMillimeter
+    ].
+    tabUnit == #cm ifTrue:[
+        ^ aGC device horizontalPixelPerMillimeter * 10
+    ].
+    "
+     assume pixels
+    "
+    ^ 1.
+!
+
+positionOfTab:index on:aGC
+    |unit pos|
+
+    tabPositions isNil ifTrue:[^ nil].
+
+    unit := self pixelsPerUnitOn:aGC.
+    pos := ((tabPositions at:index) * unit).
+    ^ pos
+!
+
+positionOfTab:index forString:aString on:aGC
+    |pos type idx left|
+
+    pos := self positionOfTab:index on:aGC.
+    pos isNil ifTrue:[^ nil].
+
+    tabTypes notNil ifTrue:[
+        (tabTypes isMemberOf:Symbol) ifTrue:[
+            type := tabTypes
+        ] ifFalse:[
+            type := tabTypes at:(index).
+        ].
+    ] ifFalse:[
+        type := #left
+    ].
+
+    type == #right ifTrue:[
+        ^ pos - (aGC font widthOf:aString).
+    ].
+    type == #center ifTrue:[
+        ^ pos - ((aGC font widthOf:aString) // 2).
+    ].
+    type == #decimal ifTrue:[
+        idx := aString indexOf:$..
+        idx == 0 ifTrue:[
+             ^ pos - (aGC font widthOf:aString).
+        ].
+        left := aString copyTo:(idx-1).
+        ^ pos - (aGC font widthOf:left).
+    ].
+    "default is left"
+    ^ pos
+
+! !
+
+!TabulatorSpecification methodsFor:'accessing'!
+
+unit:aSymbol
+    "allowed are: #inch, #mm, #cm, #pixel and #col"
+
+    tabUnit := aSymbol
+!
+
+unit
+    ^ tabUnit
+!
+
+align:types
+    "
+     an array of tab-types; each one is
+        #left
+        #right
+        #center
+        #decimal
+     or a symbol which gives align of all tabs
+
+    "
+    tabTypes := types
+!
+
+align
+    ^ tabTypes
+!
+
+positions:tabs
+    tabPositions := tabs
+!
+
+positions
+    ^ tabPositions
+! !
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/TabulatorSpecification.st	Wed Aug 24 01:44:22 1994 +0200
@@ -0,0 +1,119 @@
+'From Smalltalk/X, Version:2.10.3 on 12-aug-1994 at 10:44:09 pm'!
+
+Object subclass:#TabulatorSpecification
+	 instanceVariableNames:'tabUnit tabPositions tabTypes'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Views-Support'
+!
+
+!TabulatorSpecification methodsFor:'queries'!
+
+pixelsPerUnitOn:aGC
+    "
+     return the number of device pixels one unit of my tabs
+     takes on aGC
+    "
+    tabUnit isNil ifTrue:[
+        tabUnit := #col
+    ].
+    tabUnit == #col ifTrue:[
+        ^ aGC font width
+    ].
+    tabUnit == #inch ifTrue:[
+        ^ aGC device horizontalPixelPerInch
+    ].
+    tabUnit == #mm ifTrue:[
+        ^ aGC device horizontalPixelPerMillimeter
+    ].
+    tabUnit == #cm ifTrue:[
+        ^ aGC device horizontalPixelPerMillimeter * 10
+    ].
+    "
+     assume pixels
+    "
+    ^ 1.
+!
+
+positionOfTab:index on:aGC
+    |unit pos|
+
+    tabPositions isNil ifTrue:[^ nil].
+
+    unit := self pixelsPerUnitOn:aGC.
+    pos := ((tabPositions at:index) * unit).
+    ^ pos
+!
+
+positionOfTab:index forString:aString on:aGC
+    |pos type idx left|
+
+    pos := self positionOfTab:index on:aGC.
+    pos isNil ifTrue:[^ nil].
+
+    tabTypes notNil ifTrue:[
+        (tabTypes isMemberOf:Symbol) ifTrue:[
+            type := tabTypes
+        ] ifFalse:[
+            type := tabTypes at:(index).
+        ].
+    ] ifFalse:[
+        type := #left
+    ].
+
+    type == #right ifTrue:[
+        ^ pos - (aGC font widthOf:aString).
+    ].
+    type == #center ifTrue:[
+        ^ pos - ((aGC font widthOf:aString) // 2).
+    ].
+    type == #decimal ifTrue:[
+        idx := aString indexOf:$..
+        idx == 0 ifTrue:[
+             ^ pos - (aGC font widthOf:aString).
+        ].
+        left := aString copyTo:(idx-1).
+        ^ pos - (aGC font widthOf:left).
+    ].
+    "default is left"
+    ^ pos
+
+! !
+
+!TabulatorSpecification methodsFor:'accessing'!
+
+unit:aSymbol
+    "allowed are: #inch, #mm, #cm, #pixel and #col"
+
+    tabUnit := aSymbol
+!
+
+unit
+    ^ tabUnit
+!
+
+align:types
+    "
+     an array of tab-types; each one is
+        #left
+        #right
+        #center
+        #decimal
+     or a symbol which gives align of all tabs
+
+    "
+    tabTypes := types
+!
+
+align
+    ^ tabTypes
+!
+
+positions:tabs
+    tabPositions := tabs
+!
+
+positions
+    ^ tabPositions
+! !
+