[squeak-dev] Dynamic essay project MorphLayoutArticle on Bob's SuperSwiki?

David T. Lewis lewis at mail.msen.com
Fri May 4 00:03:59 UTC 2018


On Thu, May 03, 2018 at 09:30:10AM -0300, Edgar J. De Cleene wrote:
> As I have a huge collection of old stuff, here I attach which clases was in
> 3.2 and was ripped or changed later
> In the past my idea is to have some  on web like we made for 3.10
> 
> http://ftp.squeak.org/Experiments/3dot8/
> http://ftp.squeak.org/Experiments/3dot9/
> http://ftp.squeak.org/Experiments/3dot10/
> 
> Later I extent this in my
> http://squeakros.org/4dot4
> http://squeakros.org/4dot5
> The idea is with a recursive dnu mechanisms you go back from XdotY until you
> found the class.

This is a really interesting idea.

Backward compatibility is a hard problem to solve, but it is a really
interesting challenge. I love being able to explore old Squeak images
and projects, it is like having a reference library for ideas and experiments.

Dave


> 
> Today I open my first FunSqueak3.10, never published and was able to load
> the  
> MorphLayoutArticle.019.pr
> 
> In FunSqueak 4.2, 4.3 and 4.6 fails and using Karl ImageSegmentLoading.3.cs
> also fail.
> Some with Cog, maybe ?
> 
> 
> On 30/04/2018, 15:17, "karl ramberg" <karlramberg at gmail.com> wrote:
> 
> > This change set make the project ALMOST load in a 32 bit 6.0 Squeak image.
> > But there are some conversion issues I have not figured out.
> 

> 'From Squeak3.2gamma of 15 January 2002 [latest update: #4743] on 3 May 2018 at 8:21:55 am'!
ScrollPane subclass: #AlansTextPlusMorph
	instanceVariableNames: 'theTextMorph thePasteUp '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-GeeMail'!
!AlansTextPlusMorph commentStamp: '<historical>' prior: 0!
The code is here, but the class you really want to use is GeeMailMorph (nicer name).!


!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:50'!
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	self addGeeMailMenuItemsTo: aCustomMenu.! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:49'!
addGeeMailMenuItemsTo: menu

	self flag: #convertToBook.	"<-- no longer used"
	menu 
		addUpdating: #showPageBreaksString action: #togglePageBreaks;
		addUpdating: #keepScrollbarString action: #toggleKeepScrollbar;
		addLine;
		add: 'Print...' action: #printPSToFile;
		addLine.
	thePasteUp allTextPlusMorphs size = 1 ifTrue: [
		menu add: 'make 1-column book' selector: #makeBookStyle: argument: 1.
		menu add: 'make 2-column book' selector: #makeBookStyle: argument: 2.
		menu add: 'make 3-column book' selector: #makeBookStyle: argument: 3.
		menu add: 'make 4-column book' selector: #makeBookStyle: argument: 4.
	] ifFalse: [
		menu add: 'make a galley of me' action: #makeGalleyStyle.
	].
	^menu! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 10/30/2000 15:06'!
adjustPasteUpSize

	| newBottom |

	thePasteUp ifNil: [^self].
	newBottom _ thePasteUp bottom max: thePasteUp boundingBoxOfSubmorphs bottom + 20.
	thePasteUp height: (newBottom - thePasteUp top max: self height).
	thePasteUp width: (thePasteUp width max: scroller innerBounds width - 5).! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:42'!
allTextPlusMorphs

	^thePasteUp allTextPlusMorphs! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 10/3/2000 12:03'!
convertToBook

	GeeBookMorph new 
		geeMail: thePasteUp;
		rebuildPages;
		openInWorld! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/5/2001 23:19'!
doLayoutIn: layoutBounds
	"layout has changed. update scroll deltas or whatever else"

	self adjustPasteUpSize.
	scroller ifNotNil: [self setScrollDeltas].
	super doLayoutIn: layoutBounds.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'JW 2/21/2001 22:54'!
extraScrollRange
	^ bounds height
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:50'!
getMenu: shiftKeyState

	| menu |

	self flag: #convertToBook.	"<-- no longer used"

	menu _ MenuMorph new defaultTarget: self.
	self addGeeMailMenuItemsTo: menu.
	^menu! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:33'!
handlesMouseDown: evt

	^evt yellowButtonPressed ! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:57'!
hideScrollBar

	self keepScrollBarAlways ifTrue: [^self].
	^super hideScrollBar! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/2/2001 14:11'!
initialize

	super initialize.
	color _ Color white.
	thePasteUp _ TextPlusPasteUpMorph new borderWidth: 0; color: color.
	scroller addMorph: thePasteUp.
	self position: 100 at 100.
	self extent: Display extent // 3.
	self useRoundedCorners.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:57'!
keepScrollBarAlways

	^self valueOfProperty: #keepScrollBarAlways ifAbsent: [false]! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:59'!
keepScrollbarString

	^self keepScrollBarAlways ifTrue: ['<on>scrollbar stays up'] ifFalse: ['<off>scrollbar stays up']! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 12/5/2001 11:15'!
makeBookStyle: nColumns

	| all totalWidth second columnWidth currY prev columnHeight currX currColumn pageBreakRectangles r rm columnGap pageGap starter |

	pageBreakRectangles _ OrderedCollection new.
	all _ thePasteUp allTextPlusMorphs.
	all size = 1 ifFalse: [^self].
	Cursor wait show.
	starter _ prev _ all first.
	totalWidth _ self width - 16.
	columnGap _ 32.
	pageGap _ 16.
	columnWidth _ totalWidth - (columnGap * (nColumns - 1)) // nColumns.
	columnHeight _ self height - 12.
	currY _ 4.
	currX _ 4.
	currColumn _ 1.
	prev
		position: currX at currY;
		width: columnWidth.
	[
		second _ prev makeSuccessorMorph.
		thePasteUp addMorphBack: second.
		prev 
			setProperty: #autoFitContents toValue: false;
			height: columnHeight.
		(currColumn _ currColumn + 1) <= nColumns ifTrue: [
			currX _ currX + columnWidth + columnGap.
		] ifFalse: [
			r _ 4@(prev bottom + 4) corner: (self right - 4 @ (prev bottom + pageGap - 4)).
			rm _ RectangleMorph new bounds: r; color: (Color gray alpha: 0.3); borderWidth: 0.
			pageBreakRectangles add: rm beSticky.
			thePasteUp addMorphBack: rm.
			currColumn _ 1.
			currX _ 4.
			currY _ prev bottom + pageGap.
		].
		second 
			autoFit: true;
			position: currX at currY;
			width: columnWidth.
		prev recomposeChain.		"was commented"
		prev _ second.
		prev height > columnHeight
	] whileTrue.
	prev autoFit: true.
	thePasteUp height: (prev bottom + 20 - self top).
	self layoutChanged.
	self setProperty: #pageBreakRectangles toValue: pageBreakRectangles.
	thePasteUp allTextPlusMorphs do: [ :each |
		each repositionAnchoredMorphs
	].
	Cursor normal show.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 11/30/2001 12:12'!
makeGalleyStyle

	| all first theRest |

	(self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]) do: [ :each |
		each delete
	].
	self removeProperty: #pageBreakRectangles.
	all _ thePasteUp allTextPlusMorphs.
	first _ all select: [ :x | x predecessor isNil].
	first size = 1 ifFalse: [^self].
	Cursor wait show.
	first _ first first.
	theRest _ all reject: [ :x | x predecessor isNil].
	theRest do: [ :each | each delete].
	first autoFit: true.
	first width: self width - 8.
	first recomposeChain.
	first repositionAnchoredMorphs.
	Cursor normal show.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'ar 10/6/2000 16:36'!
mouseUp: evt inMorph: aMorph

	evt hand grabMorph: aMorph	"old instances may have a handler we no longer use"! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/7/2001 13:25'!
pageRectanglesForPrinting

	| pageBreaks prevBottom pageRects r |

	pageBreaks _ self valueOfProperty: #pageBreakRectangles ifAbsent: [^nil].
	prevBottom _ 0.
	pageRects _ pageBreaks collect: [ :each |
		r _ 0 at prevBottom corner: self width @ each top.
		prevBottom _ each bottom.
		r
	].
	pageRects add: (0 at prevBottom corner: self width @ thePasteUp bottom).
	^pageRects! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/7/2001 12:20'!
printPSToFile

	thePasteUp printer
		geeMail: self;
		doPages! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 16:16'!
scrollBarValue: scrollValue

	| newPt pageBreaks topOfPage |

	scroller hasSubmorphs ifFalse: [^ self].
	newPt _ -3 @ (self leftoverScrollRange * scrollValue).

	pageBreaks _ self valueOfProperty: #pageBreakRectangles ifAbsent: [#()].
	pageBreaks isEmpty ifTrue: [
		^scroller offset: newPt.
	].
	topOfPage _ pageBreaks inject: (0 at 0 corner: 0 at 0) into: [ :closest :each |
		(each bottom - newPt y) abs < (closest bottom - newPt y) abs ifTrue: [
			each 
		] ifFalse: [
			closest 
		].
	].
	topOfPage ifNotNil: [
		newPt _ newPt x @ topOfPage bottom.
		scrollBar value: newPt y / self leftoverScrollRange.
	].
	scroller offset: newPt.! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/4/2001 09:21'!
scrollSelectionIntoView: event alignTop: alignTop inTextMorph: tm
	"Scroll my text into view if necessary and return true, else return false"

	| selRects delta selRect rectToTest transform cpHere |

	selRects _ tm paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest _ selRects first merge: selRects last.
	transform _ scroller transformFrom: self.
	(event notNil and: [event isMouse and: [event anyButtonPressed]]) ifTrue:  "Check for autoscroll"
		[cpHere _ transform localPointToGlobal: event cursorPoint.
		cpHere y <= self top
			ifTrue: [rectToTest _ selRects first topLeft extent: 2 at 2]
			ifFalse: [cpHere y >= self bottom
					ifTrue: [rectToTest _ selRects last bottomRight extent: 2 at 2]
					ifFalse: [^ false]]].
	selRect _ transform localBoundsToGlobal: rectToTest.
	selRect height > bounds height
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	alignTop ifTrue: [
		self scrollBy: 0@(bounds top - selRect top).
		^ true
	].
	selRect bottom > bounds bottom ifTrue: [
		self scrollBy: 0@(bounds bottom - selRect bottom - 30).
		^ true
	].
	(delta _ selRect amountToTranslateWithin: self bounds) y ~= 0 ifTrue: [
		"Scroll end of selection into view if necessary"
		self scrollBy: 0 at delta y.
		^ true].
	^ false! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 13:06'!
scrollToPage: pageNumber

	| rects oneRect |

	rects _ self valueOfProperty: #pageBreakRectangles ifAbsent: [#()].
	oneRect _ rects at: pageNumber - 1 ifAbsent: [0 at 0 extent: 0 at 0].
	self scrollToYAbsolute: oneRect bottom.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 13:01'!
scrollToYAbsolute: yValue

	| transform transformedPoint |

	transform _ scroller transformFrom: self.
	transformedPoint _ transform localPointToGlobal: 0 at yValue.

	self scrollBy: 0@(bounds top - transformedPoint y).
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/20/2001 17:10'!
showPageBreaksString

	^(thePasteUp ifNil: [^'???']) showPageBreaksString! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:58'!
toggleKeepScrollbar

	self setProperty: #keepScrollBarAlways toValue: self keepScrollBarAlways not! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/20/2001 17:12'!
togglePageBreaks

	(thePasteUp ifNil: [^self]) togglePageBreaks! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 9/7/2000 11:42'!
wantsDroppedMorph: aMorph event: evt
	"Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. The default implementation returns false.
NOTE: the event is assumed to be in global (world) coordinates."

	^false! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 9/6/2000 16:25'!
wantsSlot

	^false! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AlansTextPlusMorph class
	instanceVariableNames: ''!

!AlansTextPlusMorph class methodsFor: 'as yet unclassified' stamp: 'RAA 9/10/2000 12:52'!
includeInNewMorphMenu

	^ false		"to encourage the use of GeeMail instead"! !
> 'From Squeak3.2gamma of 15 January 2002 [latest update: #4743] on 3 May 2018 at 8:33:49 am'!
TextAnchor subclass: #TextAnchorPlus
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-GeeMail'!

!TextAnchorPlus methodsFor: 'as yet unclassified' stamp: 'ar 12/31/2001 02:22'!
emphasizeScanner: scanner

	anchoredMorph ifNil: [^self].
	(anchoredMorph owner isKindOf: TextPlusPasteUpMorph) ifFalse: [^anchoredMorph _ nil].
	"follwing has been removed - there was no implementation for it"
	"scanner setYFor: anchoredMorph"

! !
> 'From Squeak3.2gamma of 15 January 2002 [latest update: #4743] on 3 May 2018 at 8:40:41 am'!
ClassCategoryReader subclass: #RenamedClassSourceReader
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Kernel-Classes'!

!RenamedClassSourceReader methodsFor: 'as yet unclassified' stamp: 'RAA 6/22/2000 15:14'!
scanFrom: aStream

	self flag: #bob. 	"should this ever happen?"
	self halt.! !

!RenamedClassSourceReader methodsFor: 'as yet unclassified' stamp: 'RAA 6/22/2000 16:28'!
scanFromNoCompile: aStream

	self flag: #bob. 	"should this ever happen?"
	self halt.! !

!RenamedClassSourceReader methodsFor: 'as yet unclassified' stamp: 'RAA 6/22/2000 16:35'!
scanFromNoCompile: aStream forSegment: anImageSegment
	"Just move the source code for the methods from aStream."
	| methodText d |

	[
		(methodText _ aStream nextChunkText) size > 0
	] whileTrue: [
		(SourceFiles at: 2) ifNotNil: [
			d _ Dictionary new.
			d
				at: #oldClassName put: class;		"may be 'Player1' or 'Player1 class'"
				at: #methodText put: methodText;
				at: #changeStamp put: changeStamp;
				at: #category put: category.
			anImageSegment acceptSingleMethodSource: d.
		]
	]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

RenamedClassSourceReader class
	instanceVariableNames: ''!

!RenamedClassSourceReader class methodsFor: 'as yet unclassified' stamp: 'RAA 6/22/2000 15:35'!
formerClassName: formerClassName methodsFor: aCategory stamp: aString

	^self new
		setClass: formerClassName 
		category: aCategory 
		changeStamp: aString! !

!RenamedClassSourceReader class methodsFor: 'as yet unclassified' stamp: 'RAA 6/22/2000 15:18'!
scanner

	^self new! !
> 



More information about the Squeak-dev mailing list