[Pkg] Squeak3.11 Contributions: MorphicBooks-kph.1.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Tue Jan 13 20:25:16 UTC 2009
A new version of MorphicBooks was added to project Squeak3.11 Contributions:
http://www.squeaksource.com/311/MorphicBooks-kph.1.mcz
==================== Summary ====================
Name: MorphicBooks-kph.1
Author: test
Time: 13 January 2009, 8:25:12 pm
UUID: 74927989-64fc-4fd4-b070-dc3c8e565033
Ancestors:
==================== Snapshot ====================
SystemOrganization addCategory: #MorphicBooks!
SketchMorph subclass: #BookPageThumbnailMorph
instanceVariableNames: 'page pageNumber bookMorph flipOnClick'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
!BookPageThumbnailMorph commentStamp: '<historical>' prior: 0!
A small picture representing a page of a BookMorph here or somewhere else. When clicked, make that book turn to the page and do a visual effect and a noise.
page either the morph of the page, or a url
pageNumber
bookMorph either the book, or a url
flipOnClick!
----- Method: BookPageThumbnailMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
aCustomMenu addLine.
aCustomMenu add: 'make a flex morph' translated selector: #makeFlexMorphFor: argument: aHandMorph.
flipOnClick
ifTrue: [aCustomMenu add: 'disable bookmark action' translated action: #toggleBookmark]
ifFalse: [aCustomMenu add: 'enable bookmark action' translated action: #toggleBookmark].
(bookMorph isKindOf: BookMorph)
ifTrue:
[aCustomMenu add: 'set page sound' translated action: #setPageSound:.
aCustomMenu add: 'set page visual' translated action: #setPageVisual:]
!
----- Method: BookPageThumbnailMorph>>bookMorph (in category 'as yet unclassified') -----
bookMorph
^bookMorph!
----- Method: BookPageThumbnailMorph>>computeThumbnail (in category 'as yet unclassified') -----
computeThumbnail
| f scale |
self objectsInMemory.
f _ page imageForm.
scale _ (self height / f height). "keep height invariant"
"(Sensor shiftPressed) ifTrue: [scale _ scale * 1.4]."
self form: (f magnify: f boundingBox by: scale at scale smoothing: 2).
!
----- Method: BookPageThumbnailMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color lightGray!
----- Method: BookPageThumbnailMorph>>doPageFlip (in category 'as yet unclassified') -----
doPageFlip
"Flip to this page"
self objectsInMemory.
bookMorph ifNil: [^ self].
bookMorph goToPageMorph: page
transitionSpec: (self valueOfProperty: #transitionSpec).
(owner isKindOf: PasteUpMorph) ifTrue:
[owner cursor: (owner submorphs indexOf: self ifAbsent: [1])]!
----- Method: BookPageThumbnailMorph>>handlesMouseDown: (in category 'event handling') -----
handlesMouseDown: event
^ event shiftPressed or: [flipOnClick and: [event controlKeyPressed not]]!
----- Method: BookPageThumbnailMorph>>inBook: (in category 'as yet unclassified') -----
inBook: book
bookMorph _ book!
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
| f |
super initialize.
""
flipOnClick _ false.
f _ Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
----- Method: BookPageThumbnailMorph>>makeFlexMorphFor: (in category 'as yet unclassified') -----
makeFlexMorphFor: aHand
aHand grabMorph: (FlexMorph new originalMorph: page)!
----- Method: BookPageThumbnailMorph>>mouseDown: (in category 'event handling') -----
mouseDown: event
"turn the book to that page"
"May need to lie to it so mouseUp won't go to menu that may come up during fetch of a page in doPageFlip. (Is this really true? --tk)"
self doPageFlip.
!
----- Method: BookPageThumbnailMorph>>objectForDataStream: (in category 'fileIn/Out') -----
objectForDataStream: refStrm
"I am about to be written on an object file. It would be bad to write a whole BookMorph out. Store a string that is the url of the book or page in my inst var."
| clone bookUrl bb stem ind |
(bookMorph isString) & (page isString) ifTrue: [
^ super objectForDataStream: refStrm].
(bookMorph isNil) & (page isString) ifTrue: [
^ super objectForDataStream: refStrm].
(bookMorph isNil) & (page url notNil) ifTrue: [
^ super objectForDataStream: refStrm].
(bookMorph isNil) & (page url isNil) ifTrue: [
self error: 'page should already have a url' translated.
"find page's book, and remember it"
"bookMorph _ "].
clone _ self clone.
(bookUrl _ bookMorph url)
ifNil: [bookUrl _ self valueOfProperty: #futureUrl].
bookUrl
ifNil: [ bb _ RectangleMorph new. "write out a dummy"
bb bounds: bounds.
refStrm replace: self with: bb.
^ bb]
ifNotNil: [clone instVarNamed: 'bookMorph' put: bookUrl].
page url ifNil: [
"Need to assign a url to a page that will be written later.
It might have bookmarks too. Don't want to recurse deeply.
Have that page write out a dummy morph to save its url on the server."
stem _ SqueakPage stemUrl: bookUrl.
ind _ bookMorph pages identityIndexOf: page.
page reserveUrl: stem,(ind printString),'.sp'].
clone instVarNamed: 'page' put: page url.
refStrm replace: self with: clone.
^ clone!
----- Method: BookPageThumbnailMorph>>objectsInMemory (in category 'fileIn/Out') -----
objectsInMemory
"See if page or bookMorph need to be brought in from a server."
| bookUrl bk wld try |
bookMorph ifNil: ["fetch the page"
page isString ifFalse: [^ self]. "a morph"
try _ (SqueakPageCache atURL: page) fetchContents.
try ifNotNil: [page _ try].
^ self].
bookMorph isString ifTrue: [
bookUrl _ bookMorph.
(wld _ self world) ifNil: [wld _ Smalltalk currentWorld].
bk _ BookMorph isInWorld: wld withUrl: bookUrl.
bk == #conflict ifTrue: [
^ self inform: 'This book is already open in some other project' translated].
bk == #out ifTrue: [
(bk _ BookMorph new fromURL: bookUrl) ifNil: [^ self]].
bookMorph _ bk].
page isString ifTrue: [
page _ (bookMorph pages detect: [:pg | pg url = page]
ifNone: [bookMorph pages first])].
!
----- Method: BookPageThumbnailMorph>>page (in category 'as yet unclassified') -----
page
^ page
!
----- Method: BookPageThumbnailMorph>>page: (in category 'as yet unclassified') -----
page: aMorph
page _ aMorph.
self computeThumbnail.
self setNameTo: aMorph externalName.
page fullReleaseCachedState.
!
----- Method: BookPageThumbnailMorph>>pageMorph:inBook: (in category 'as yet unclassified') -----
pageMorph: pageMorph inBook: book
page _ pageMorph.
bookMorph _ book!
----- Method: BookPageThumbnailMorph>>pageNumber:inBook: (in category 'as yet unclassified') -----
pageNumber: n inBook: b
pageNumber _ n.
bookMorph _ b!
----- Method: BookPageThumbnailMorph>>setPageSound: (in category 'as yet unclassified') -----
setPageSound: event
^ bookMorph menuPageSoundFor: self event: event!
----- Method: BookPageThumbnailMorph>>setPageVisual: (in category 'as yet unclassified') -----
setPageVisual: event
^ bookMorph menuPageVisualFor: self event: event!
----- Method: BookPageThumbnailMorph>>smaller (in category 'as yet unclassified') -----
smaller
self form: (self form copy: (0 at 0 extent: self form extent//2)).
!
----- Method: BookPageThumbnailMorph>>toggleBookmark (in category 'as yet unclassified') -----
toggleBookmark
"Enable or disable sensitivity as a bookmark
enabled means that a normal click will cause a pageFlip
disabled means this morph can be picked up normally by the hand."
flipOnClick _ flipOnClick not!
----- Method: BookPageThumbnailMorph>>veryDeepFixupWith: (in category 'copying') -----
veryDeepFixupWith: deepCopier
"If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
super veryDeepFixupWith: deepCopier.
page _ deepCopier references at: page ifAbsent: [page].
bookMorph _ deepCopier references at: bookMorph ifAbsent: [bookMorph].
!
----- Method: BookPageThumbnailMorph>>veryDeepInner: (in category 'copying') -----
veryDeepInner: deepCopier
"Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
super veryDeepInner: deepCopier.
"page _ page. Weakly copied"
pageNumber _ pageNumber veryDeepCopyWith: deepCopier.
"bookMorph _ bookMorph. All weakly copied"
flipOnClick _ flipOnClick veryDeepCopyWith: deepCopier. !
SketchMorph subclass: #FlexMorph
instanceVariableNames: 'originalMorph borderWidth borderColor'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
----- Method: FlexMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"super addCustomMenuItems: aCustomMenu hand: aHandMorph."
aCustomMenu addLine.
aCustomMenu add: 'update from original' translated action: #updateFromOriginal.
aCustomMenu addList: {
{'border color...' translated. #changeBorderColor:}.
{'border width...' translated. #changeBorderWidth:}.
}.
aCustomMenu addLine.
!
----- Method: FlexMorph>>borderColor: (in category 'accessing') -----
borderColor: aColor
borderColor _ aColor.
self updateFromOriginal!
----- Method: FlexMorph>>borderWidth: (in category 'accessing') -----
borderWidth: width
borderWidth _ width asPoint.
self updateFromOriginal!
----- Method: FlexMorph>>changeBorderColor: (in category 'as yet unclassified') -----
changeBorderColor: evt
| aHand |
aHand _ evt ifNotNil: [evt hand] ifNil: [self primaryHand].
self changeColorTarget: self selector: #borderColor: originalColor: self borderColor hand: aHand.!
----- Method: FlexMorph>>changeBorderWidth: (in category 'as yet unclassified') -----
changeBorderWidth: evt
| handle origin aHand |
aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand].
origin _ aHand position.
handle _ HandleMorph new forEachPointDo:
[:newPoint | handle removeAllMorphs.
handle addMorph:
(LineMorph from: origin to: newPoint color: Color black width: 1).
self borderWidth: (newPoint - origin) r asInteger // 5].
aHand attachMorph: handle.
handle startStepping!
----- Method: FlexMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
originalForm _ nil. "Aggressively uncache the originalForm"
^ super drawOn: aCanvas!
----- Method: FlexMorph>>extent: (in category 'geometry') -----
extent: newExtent
self loadOriginalForm. "make sure it's not nil"
^ super extent: newExtent!
----- Method: FlexMorph>>form (in category 'accessing') -----
form
self loadOriginalForm. "make sure it's not nil"
^ super form!
----- Method: FlexMorph>>generateRotatedForm (in category 'drawing') -----
generateRotatedForm
self loadOriginalForm. "make sure it's not nil"
^ super generateRotatedForm!
----- Method: FlexMorph>>initialize (in category 'initialization') -----
initialize
super initialize.
borderWidth _ 2 at 2.
borderColor _ Color black.!
----- Method: FlexMorph>>layoutChanged (in category 'layout') -----
layoutChanged
self loadOriginalForm. "make sure it's not nil"
^ super layoutChanged!
----- Method: FlexMorph>>loadOriginalForm (in category 'as yet unclassified') -----
loadOriginalForm
originalForm ifNil: [self updateFromOriginal].
!
----- Method: FlexMorph>>originalMorph (in category 'as yet unclassified') -----
originalMorph
^ originalMorph!
----- Method: FlexMorph>>originalMorph: (in category 'as yet unclassified') -----
originalMorph: aMorph
originalMorph _ aMorph.
scalePoint _ 0.25 at 0.25.
self updateFromOriginal.!
----- Method: FlexMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
"Clear cache of rotated, scaled Form."
originalForm _ Form extent: 10 at 10. "So super hibernate won't have to work hard
but won't crash either."
super releaseCachedState.
rotatedForm _ nil.
originalForm _ nil.!
----- Method: FlexMorph>>updateFromOriginal (in category 'as yet unclassified') -----
updateFromOriginal
| intermediateForm |
intermediateForm _ originalMorph imageForm offset: 0 at 0.
intermediateForm border: intermediateForm boundingBox
widthRectangle: (borderWidth corner: borderWidth+1)
rule: Form over fillColor: borderColor.
self form: intermediateForm.
originalMorph fullReleaseCachedState!
SketchMorph subclass: #MorphThumbnail
instanceVariableNames: 'morphRepresented'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
!MorphThumbnail commentStamp: '<historical>' prior: 0!
A morph whose appearance is a thumbnail of some other morph.!
----- Method: MorphThumbnail>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
aCustomMenu add: 'reveal original morph' translated action: #revealOriginal.
aCustomMenu add: 'grab original morph' translated action: #grabOriginal.
!
----- Method: MorphThumbnail>>computeThumbnail (in category 'as yet unclassified') -----
computeThumbnail
"Assumption on entry:
The receiver's width represents the maximum width allowable.
The receiver's height represents the exact height desired."
| f scaleX scaleY |
f _ morphRepresented imageForm.
morphRepresented fullReleaseCachedState.
scaleY _ self height / f height. "keep height invariant"
scaleX _ ((morphRepresented width * scaleY) <= self width)
ifTrue:
[scaleY] "the usual case; same scale factor, to preserve aspect ratio"
ifFalse:
[self width / f width].
self form: (f magnify: f boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
----- Method: MorphThumbnail>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color lightGray!
----- Method: MorphThumbnail>>grabOriginal (in category 'as yet unclassified') -----
grabOriginal
self primaryHand attachMorph: morphRepresented!
----- Method: MorphThumbnail>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
| f |
super initialize.
""
f _ Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
----- Method: MorphThumbnail>>innocuousName (in category 'naming') -----
innocuousName
^ morphRepresented isNil
ifTrue: [super innocuousName]
ifFalse: [morphRepresented innocuousName]!
----- Method: MorphThumbnail>>isPartsDonor (in category 'parts bin') -----
isPartsDonor
"answer whether the receiver is PartsDonor"
^ self partRepresented isPartsDonor!
----- Method: MorphThumbnail>>isPartsDonor: (in category 'parts bin') -----
isPartsDonor: aBoolean
"change the receiver's isPartDonor property"
self partRepresented isPartsDonor: aBoolean!
----- Method: MorphThumbnail>>morphRepresented (in category 'thumbnail') -----
morphRepresented
^ morphRepresented
!
----- Method: MorphThumbnail>>morphRepresented: (in category 'as yet unclassified') -----
morphRepresented: aMorph
morphRepresented _ aMorph.
self computeThumbnail.
!
----- Method: MorphThumbnail>>partRepresented (in category 'parts bin') -----
partRepresented
^self morphRepresented!
----- Method: MorphThumbnail>>representativeNoTallerThan:norWiderThan:thumbnailHeight: (in category 'thumbnail') -----
representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight
"Return a morph representing the receiver but which is no taller than aHeight. If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth"
(self height <= maxHeight and: [self width <= maxWidth]) ifTrue: [^ self].
^ MorphThumbnail new
extent: maxWidth @ (thumbnailHeight min: self height);
morphRepresented: morphRepresented!
----- Method: MorphThumbnail>>revealOriginal (in category 'as yet unclassified') -----
revealOriginal
((owner isKindOf: PasteUpMorph) and: [owner alwaysShowThumbnail])
ifTrue: [^Beeper beep].
morphRepresented owner isNil
ifTrue: [^owner replaceSubmorph: self by: morphRepresented].
Beeper beep!
----- Method: MorphThumbnail>>smaller (in category 'as yet unclassified') -----
smaller
self form: (self form copy: (0 at 0 extent: self form extent // 2))!
----- Method: MorphThumbnail>>veryDeepFixupWith: (in category 'copying') -----
veryDeepFixupWith: deepCopier
"If target and arguments fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
super veryDeepFixupWith: deepCopier.
morphRepresented _ deepCopier references at: morphRepresented
ifAbsent: [morphRepresented].!
----- Method: MorphThumbnail>>veryDeepInner: (in category 'copying') -----
veryDeepInner: deepCopier
"Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
super veryDeepInner: deepCopier.
morphRepresented _ morphRepresented. "Weakly copied"!
Morph subclass: #KedamaMorph
instanceVariableNames: 'dimensions wrapX wrapY pixelsPerPatch patchesToDisplay patchVarDisplayForm lastTurtleID turtleCount turtlesDict turtlesDictSemaphore turtlesToDisplay magnifiedDisplayForm autoChanged topEdgeMode bottomEdgeMode leftEdgeMode rightEdgeMode topEdgeModeMnemonic bottomEdgeModeMnemonic leftEdgeModeMnemonic rightEdgeModeMnemonic'
classVariableNames: 'RandomSeed'
poolDictionaries: ''
category: 'MorphicBooks'!
!KedamaMorph commentStamp: 'yo 6/18/2004 18:29' prior: 0!
A tile-scriptable variant of StarSqueak.
!
----- Method: KedamaMorph class>>additionsToViewerCategories (in category 'class initialization') -----
additionsToViewerCategories
"Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."
^ #(
(kedama (
(command addToPatchDisplayList: 'add patch to display list' Patch)
(command removeAllFromPatchDisplayList 'clear the patch display list')
(slot patchDisplayList 'patches to display' String readOnly Player getPatchesList unused unused)
(command addToTurtleDisplayList: 'add turtle to display list' Player)
(command removeAllFromTurtleDisplayList 'clear the turtle display list')
(slot turtleDisplayList 'turtles to display' String readOnly Player getTurtlesList unused unused)
(slot pixelsPerPatch 'the display scale' Number readWrite Player getPixelsPerPatch Player setPixelsPerPatch:)
(slot color 'The color of the object' Color readWrite Player getColor Player setColor:)
"(command makeTurtlesMap 'Internally create the map of turtles')"
(slot leftEdgeMode 'the mode of left edge' EdgeMode readWrite Player getLeftEdgeMode Player setLeftEdgeMode:)
(slot rightEdgeMode 'the mode of right edge' EdgeMode readWrite Player getRightEdgeMode Player setRightEdgeMode:)
(slot topEdgeMode 'the mode of top edge' EdgeMode readWrite Player getTopEdgeMode Player setTopEdgeMode:)
(slot bottomEdgeMode 'the mode of bottom edge' EdgeMode readWrite Player getBottomEdgeMode Player setBottomEdgeMode:)
))
).
!
----- Method: KedamaMorph class>>cleanUp (in category 'class initialization') -----
cleanUp
"
self cleanUp
"
self allInstancesDo: [:e | e cleanUp].
!
----- Method: KedamaMorph class>>defaultDimensions (in category 'class initialization') -----
defaultDimensions
"Answer the dimensions of this StarSqueak simulation. Subclasses can override this method to define their own world size."
^ 100 at 100.
!
----- Method: KedamaMorph class>>defaultNameStemForInstances (in category 'class initialization') -----
defaultNameStemForInstances
^ 'KedamaWorld' translated.
!
----- Method: KedamaMorph class>>degreesToRadians: (in category 'global primitive backup') -----
degreesToRadians: degrees
| deg q headingRadians |
deg := 90.0 - degrees.
q := (deg / 360.0) asInteger.
deg < 0.0 ifTrue: [q := q - 1].
headingRadians := (deg - (q * 360.0)) * 0.0174532925199433.
^ headingRadians.
!
----- Method: KedamaMorph class>>descriptionForPartsBin (in category 'class initialization') -----
descriptionForPartsBin
^ self partName: 'KedamaWorld'
categories: #('Kedama')
documentation: 'A tile scriptable particle system' translated!
----- Method: KedamaMorph class>>initialize (in category 'class initialization') -----
initialize
"Kedama initialize"
RandomSeed := 17.
!
----- Method: KedamaMorph class>>newSet (in category 'class initialization') -----
newSet
| k p t s w |
k := self new.
p := k assuredPlayer getPatch costume renderedMorph.
t := k assuredPlayer newTurtleForSet.
s := SelectionMorph new.
w := PasteUpMorph new.
w extent: 400 at 400.
p position: 275 at 50.
t position: 300 at 175.
k position: 25 at 25.
w addMorph: k.
w addMorph: t.
w addMorph: p.
w addMorph: s.
s bounds: w bounds.
s selectSubmorphsOf: w.
^ s.
!
----- Method: KedamaMorph class>>radiansToDegrees: (in category 'global primitive backup') -----
radiansToDegrees: radians
| degrees deg |
degrees := radians / 0.0174532925199433.
deg := 90.0 - degrees.
deg > 0.0 ifFalse: [deg := deg + 360.0].
^ deg.
!
----- Method: KedamaMorph class>>scalarXAt:xArray:headingArray:value:destWidth:leftEdgeMode:rightEdgeMode: (in category 'global primitive backup') -----
scalarXAt: index xArray: xArray headingArray: headingArray value: val destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode
| newX headingRadians |
newX := val.
newX < 0.0 ifTrue: [
leftEdgeMode = 1 ifTrue: [
"wrap"
newX := newX + destWidth.
].
leftEdgeMode = 2 ifTrue: [
"stick"
newX := 0.0.
].
leftEdgeMode = 3 ifTrue: [
"bounce"
newX := 0.0 - newX.
headingRadians := headingArray at: index.
headingRadians < 3.141592653589793
ifTrue: [headingArray at: index put: 3.141592653589793 - headingRadians]
ifFalse: [headingArray at: index put: 9.42477796076938 - headingRadians].
].
].
newX >= destWidth ifTrue: [
rightEdgeMode = 1 ifTrue: [
newX := newX - destWidth.
].
rightEdgeMode = 2 ifTrue: [
newX := destWidth - 0.000001.
].
rightEdgeMode = 3 ifTrue: [
newX := (destWidth - 0.000001) - (newX - destWidth).
headingRadians := headingArray at: index.
headingRadians < 3.141592653589793
ifTrue: [headingArray at: index put: (3.141592653589793 - headingRadians)]
ifFalse: [headingArray at: index put: (9.42477796076938 - headingRadians)].
]
].
xArray at: index put: newX.
!
----- Method: KedamaMorph class>>scalarYAt:yArray:headingArray:value:destHeight:topEdgeMode:bottomEdgeMode: (in category 'global primitive backup') -----
scalarYAt: index yArray: yArray headingArray: headingArray value: val destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
| newY |
newY := val.
newY < 0.0 ifTrue: [
topEdgeMode = 1 ifTrue: [
"wrap"
newY := newY + destHeight.
].
topEdgeMode = 2 ifTrue: [
"stick"
newY := 0.0.
].
topEdgeMode = 3 ifTrue: [
"bounce"
newY := 0.0 - newY.
headingArray at: index put: (6.283185307179586 - (headingArray at: index)).
].
].
newY >= destHeight ifTrue: [
bottomEdgeMode = 1 ifTrue: [
newY := newY - destHeight.
].
bottomEdgeMode = 2 ifTrue: [
newY := destHeight - 0.000001.
].
bottomEdgeMode = 3 ifTrue: [
newY := (destHeight - 0.000001) - (newY - destHeight).
headingArray at: index put: (6.283185307179586 - (headingArray at: index)).
]
].
yArray at: index put: newY.
!
----- Method: KedamaMorph>>acceptDroppingMorph:event: (in category 'event handling') -----
acceptDroppingMorph: morphToDrop event: evt
| f turtle |
(morphToDrop renderedMorph isKindOf: SketchMorph) ifFalse: [
^morphToDrop rejectDropMorphEvent: evt.
].
f := morphToDrop renderedMorph rotatedForm.
f := f magnify: f boundingBox by: (1.0 / self pixelsPerPatch asFloat) smoothing: 1.
turtle := self player newTurtleSilently.
turtle createTurtlesAsIn: f originAt: ((morphToDrop topLeft - self topLeft) / self pixelsPerPatch asFloat) asIntegerPoint.
"turtle isGroup: true."
turtle color: (self dominantColorWithoutTransparent: f).
!
----- Method: KedamaMorph>>addToPatchDisplayList: (in category 'setup') -----
addToPatchDisplayList: p
| a |
a := patchesToDisplay copyWithout: p.
patchesToDisplay := a copyWith: p.
!
----- Method: KedamaMorph>>addToTurtleDisplayList: (in category 'setup') -----
addToTurtleDisplayList: p
| a |
(p isKindOf: KedamaExamplerPlayer) ifFalse: [^ self].
a := turtlesToDisplay copyWithout: p.
turtlesToDisplay := a copyWith: p.
!
----- Method: KedamaMorph>>allSubmorphNamesDo: (in category 'submorphs-accessing') -----
allSubmorphNamesDo: aBlock
super allSubmorphNamesDo: aBlock.
aBlock value: self player getPatch externalName.
!
----- Method: KedamaMorph>>areasRemainingToFill: (in category 'drawing') -----
areasRemainingToFill: aRectangle
"Drawing optimization. Since I completely fill my bounds with opaque pixels, this method tells Morphic that it isn't necessary to draw any morphs covered by me."
^ aRectangle areasOutside: self bounds
!
----- Method: KedamaMorph>>bottomEdgeMode (in category 'accessing') -----
bottomEdgeMode
^ bottomEdgeMode.
!
----- Method: KedamaMorph>>bottomEdgeMode: (in category 'accessing') -----
bottomEdgeMode: aSymbol
bottomEdgeMode := aSymbol asSymbol.
bottomEdgeMode == #wrap ifTrue: [
bottomEdgeModeMnemonic := 1.
^ self
].
bottomEdgeMode == #stick ifTrue: [
bottomEdgeModeMnemonic := 2.
^ self
].
(bottomEdgeMode == #bounce or: [bottomEdgeMode == #bouncing]) ifTrue: [
bottomEdgeModeMnemonic := 3.
^ self
].
!
----- Method: KedamaMorph>>bottomEdgeModeMnemonic (in category 'accessing') -----
bottomEdgeModeMnemonic
^ bottomEdgeModeMnemonic.
!
----- Method: KedamaMorph>>calcTurtlesCount (in category 'turtles') -----
calcTurtlesCount
turtleCount := 0.
turtlesDict do: [:a | turtleCount := turtleCount + a size].
SmalltalkImage current vmParameterAt: 5 put: ((turtleCount * 3) min: 16000 max: 4000).
SmalltalkImage current vmParameterAt: 6 put: ((turtleCount * 6) min: 32000 max: 8000).
!
----- Method: KedamaMorph>>categoriesForViewer (in category 'etoys') -----
categoriesForViewer
"Answer a list of symbols representing the categories to offer in the viewer, in order"
^ super categoriesForViewer.
"
| aList |
aList := OrderedCollection new.
aList addAllFirstUnlessAlreadyPresent: (self class additionsToViewerCategories collect:
[:categorySpec | categorySpec first]).
^ aList
"!
----- Method: KedamaMorph>>cleanUp (in category 'setup') -----
cleanUp
self extension actorState: nil.
self extension player: nil.
self initializeTurtlesDict.
!
----- Method: KedamaMorph>>clearAll (in category 'setup') -----
clearAll
"Reset this StarSqueak world. All patch variables are cleared, all turtles are removed, and all demons are turned off."
patchVarDisplayForm := Form extent: dimensions depth: 32.
self initializePatch.
self recreateMagnifiedDisplayForm.
self initializeTurtlesDict.
turtleCount := 0.
lastTurtleID := 0.
self color: Color black.
!
----- Method: KedamaMorph>>colorAt: (in category 'accessing') -----
colorAt: aLocalPoint
| pix |
pix := patchVarDisplayForm pixelValueAt: (aLocalPoint // pixelsPerPatch) asIntegerPoint.
^ Color colorFromPixelValue: (pix bitOr: 16rFF000000) depth: 32.
!
----- Method: KedamaMorph>>delete (in category 'deleting') -----
delete
| c |
super delete.
turtlesDict keysDo: [:k |
self deleteAllTurtlesOfExampler: k.
c := k costume.
c ifNotNil: [c renderedMorph delete].
].
!
----- Method: KedamaMorph>>deleteAllTurtlesOfExampler: (in category 'turtles') -----
deleteAllTurtlesOfExampler: examplerPlayer
turtlesDict removeKey: examplerPlayer ifAbsent: [].
self removeFromTurtleDisplayList: examplerPlayer.
self calcTurtlesCount.
!
----- Method: KedamaMorph>>deleteTurtleID:of: (in category 'turtles') -----
deleteTurtleID: who of: examplerPlayer
"Delete the given turtle from this world."
| array |
array := examplerPlayer turtles.
array ifNil: [^ self].
turtlesDictSemaphore critical: [
array deleteTurtleID: who.
].
self calcTurtlesCount.
examplerPlayer costume renderedMorph privateTurtleCount: array size.
"examplerPlayer allOpenViewers do: [:v | v resetWhoIfNecessary]."
!
----- Method: KedamaMorph>>dimensions (in category 'accessing') -----
dimensions
^ dimensions
!
----- Method: KedamaMorph>>display (in category 'drawing') -----
display
"Display this world on the Display. Used for debugging."
| c |
c := FormCanvas extent: (dimensions * pixelsPerPatch) depth: 32.
c := c copyOffset: bounds origin negated.
self drawOn: c.
c form display.
!
----- Method: KedamaMorph>>dominantColorWithoutTransparent: (in category 'event handling') -----
dominantColorWithoutTransparent: aForm
| tally max maxi |
aForm depth > 16 ifTrue:
[^self dominantColorWithoutTransparent: (aForm asFormOfDepth: 16)].
tally := aForm tallyPixelValues.
max := maxi := 0.
tally withIndexDo: [:n :i | n > max ifTrue: [ i ~= 1 ifTrue: [max := n. maxi := i]]].
^ Color colorFromPixelValue: maxi - 1 depth: aForm depth
!
----- Method: KedamaMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
"Display this StarSqueak world."
| result |
"Time millisecondClockValue printString displayAt: 0 at 0."
self player ifNil: [^ aCanvas fillRectangle: (self bounds) color: self color].
patchVarDisplayForm fillColor: self color.
patchesToDisplay do: [:p |
p displayPatchVariableOn: patchVarDisplayForm.
].
self drawTurtlesOnForm: patchVarDisplayForm.
pixelsPerPatch = 1 ifTrue: [
aCanvas drawImage: patchVarDisplayForm at: bounds origin.
] ifFalse: [
result := self zoom: patchVarDisplayForm into: magnifiedDisplayForm factor: pixelsPerPatch.
result ifNil: [
aCanvas warpImage: patchVarDisplayForm transform: (MatrixTransform2x3 withScale: pixelsPerPatch) at: self innerBounds origin.
] ifNotNil: [
aCanvas drawImage: magnifiedDisplayForm at: bounds origin.
]
].
autoChanged ifTrue: [self changed].
!
----- Method: KedamaMorph>>drawTurtlesOnForm: (in category 'drawing') -----
drawTurtlesOnForm: aForm
turtlesToDisplay do: [:exampler |
(self isVisible: exampler) ifTrue: [
turtlesDictSemaphore critical: [
exampler turtles drawOn: aForm.
].
].
].
!
----- Method: KedamaMorph>>extent: (in category 'geometry') -----
extent: aPoint
"Do nothing; my extent is determined by my StarSqueak world dimensions and pixelsPerPatch."
!
----- Method: KedamaMorph>>hasNoTurtleBreed (in category 'utils') -----
hasNoTurtleBreed
^ turtlesDict isEmpty.
!
----- Method: KedamaMorph>>initialize (in category 'initialization') -----
initialize
super initialize.
dimensions := self class defaultDimensions. "dimensions of this StarSqueak world in patches"
wrapX := dimensions x asFloat.
wrapY := dimensions y asFloat.
pixelsPerPatch := 2.
super extent: dimensions * pixelsPerPatch.
self assuredPlayer assureUniClass.
self clearAll. "be sure this is done once in case setup fails to do it"
autoChanged := true.
self leftEdgeMode: #wrap.
self rightEdgeMode: #wrap.
self topEdgeMode: #wrap.
self bottomEdgeMode: #wrap.
turtlesDictSemaphore := Semaphore forMutualExclusion.
!
----- Method: KedamaMorph>>initializePatch (in category 'initialization') -----
initializePatch
| f |
f := self player addPatchVarNamed: #patch.
patchesToDisplay := Array new: 0.
self addToPatchDisplayList: f.
^ f.
!
----- Method: KedamaMorph>>initializeTurtlesDict (in category 'initialization') -----
initializeTurtlesDict
turtlesDict := IdentityDictionary new.
turtlesToDisplay := Array new.
!
----- Method: KedamaMorph>>isVisible: (in category 'private') -----
isVisible: examplerPlayer
| turtleMorph |
turtleMorph := examplerPlayer costume.
turtleMorph visible ifFalse: [^ false].
turtleMorph owner isRenderer ifFalse: [^ true].
^ turtleMorph owner visible.
!
----- Method: KedamaMorph>>lastWhoOf: (in category 'turtles') -----
lastWhoOf: exampler
| turtles |
turtles := turtlesDict at: exampler ifAbsent: [nil].
^ (turtles arrays first) at: turtles arrays first size.
!
----- Method: KedamaMorph>>leftEdgeMode (in category 'accessing') -----
leftEdgeMode
^ leftEdgeMode.
!
----- Method: KedamaMorph>>leftEdgeMode: (in category 'accessing') -----
leftEdgeMode: aSymbol
leftEdgeMode := aSymbol asSymbol.
leftEdgeMode == #wrap ifTrue: [
leftEdgeModeMnemonic := 1.
^ self
].
leftEdgeMode == #stick ifTrue: [
leftEdgeModeMnemonic := 2.
^ self
].
(leftEdgeMode == #bounce or: [leftEdgeMode == #bouncing]) ifTrue: [
leftEdgeModeMnemonic := 3.
^ self
].
!
----- Method: KedamaMorph>>leftEdgeModeMnemonic (in category 'accessing') -----
leftEdgeModeMnemonic
^ leftEdgeModeMnemonic.
!
----- Method: KedamaMorph>>makePrototypeOfExampler: (in category 'turtles') -----
makePrototypeOfExampler: examplerPlayer
^ self makePrototypeOfExampler: examplerPlayer color: nil.
!
----- Method: KedamaMorph>>makePrototypeOfExampler:color: (in category 'turtles') -----
makePrototypeOfExampler: examplerPlayer color: cPixel
| array inst info |
array := examplerPlayer turtles.
info := array info.
array size > 0 ifTrue: [
inst := array makePrototypeFromFirstInstance.
cPixel ifNotNil: [inst at: (info at: #color) put: cPixel].
^ inst.
].
inst := Array new: array instSize.
info associationsDo: [:assoc |
inst at: (assoc value) put: (examplerPlayer perform: (Utilities getterSelectorFor: assoc key)).
].
cPixel ifNotNil: [inst at: (info at: #color) put: cPixel] ifNil: [inst at: (info at: #color) put: ((examplerPlayer getColor pixelValueForDepth: 32) bitAnd: 16rFFFFFF)].
inst at: (info at: #visible) put: ((inst at: (info at: #visible)) ifTrue: [1] ifFalse: [0]).
^ inst.
!
----- Method: KedamaMorph>>makeReplicatedTurtles:examplerPlayer:color:ofPrototype:randomize: (in category 'turtles') -----
makeReplicatedTurtles: count examplerPlayer: tp color: c ofPrototype: prototype randomize: randomizeFlag
| array inst |
array := tp turtles.
inst := prototype ifNil: [self makePrototypeOfExampler: tp color: c].
turtlesDictSemaphore critical: [
array addTurtlesCount: count ofPrototype: inst for: self randomize: randomizeFlag.
].
self calcTurtlesCount.
self changed.
!
----- Method: KedamaMorph>>makeTurtles:examplerPlayer:color:ofPrototype:turtles:randomize: (in category 'turtles') -----
makeTurtles: count examplerPlayer: tp color: c ofPrototype: prototype turtles: turtles randomize: randomizeFlag
| array inst |
array := tp turtles.
(turtlesDict keys includes: tp) ifFalse: [
self addToTurtleDisplayList: tp.
turtlesDict at: tp put: (array := turtles).
].
inst := prototype ifNil: [self makePrototypeOfExampler: tp color: c].
turtlesDictSemaphore critical: [array setTurtlesCount: count prototype: inst for: self randomize: randomizeFlag].
self calcTurtlesCount.
self changed.
!
----- Method: KedamaMorph>>makeTurtlesAtPositionsIn:examplerPlayer:ofPrototype: (in category 'turtles') -----
makeTurtlesAtPositionsIn: positionAndColorArray examplerPlayer: tp ofPrototype: prototype
| array inst |
array := tp turtles.
inst := prototype ifNil: [self makePrototypeOfExampler: tp].
turtlesDictSemaphore critical: [array addTurtlesCount: positionAndColorArray first size ofPrototype: inst for: self positionAndColorArray: positionAndColorArray].
self calcTurtlesCount.
self changed.
!
----- Method: KedamaMorph>>nextTurtleID (in category 'turtles') -----
nextTurtleID
^ lastTurtleID := lastTurtleID + 1.
!
----- Method: KedamaMorph>>offerCostumeViewerMenu: (in category 'menu') -----
offerCostumeViewerMenu: aMenu
aMenu add: 'add a new patch variable' translated action: #newPatch.
aMenu balloonTextForLastItem: 'Add a new patch variable' translated.
aMenu add: 'add a new breed of turtle' translated action: #newTurtle.
aMenu balloonTextForLastItem: 'Add a new turtle' translated.
aMenu addLine.
!
----- Method: KedamaMorph>>patchesToDisplayAsString (in category 'drawing') -----
patchesToDisplayAsString
^ String streamContents: [:strm |
strm nextPutAll: '#('.
patchesToDisplay do: [:p |
strm nextPutAll: p externalName.
strm nextPut: Character space.
].
strm nextPutAll: ')'.
].
!
----- Method: KedamaMorph>>pixelsPerPatch (in category 'accessing') -----
pixelsPerPatch
^ pixelsPerPatch
!
----- Method: KedamaMorph>>pixelsPerPatch: (in category 'accessing') -----
pixelsPerPatch: anInteger
"Set the width of one patch in pixels. Larger numbers scale up this StarSqueak world, but numbers larger than 2 or 3 result in a blocky look. The useful range is 1 to 10."
pixelsPerPatch := (anInteger rounded max: 1) min: 10.
super extent: dimensions * pixelsPerPatch.
self recreateMagnifiedDisplayForm
!
----- Method: KedamaMorph>>primSetRandomSeed: (in category 'private-primitives') -----
primSetRandomSeed: seed
<primitive: 'kedamaSetRandomSeed' module: 'KedamaPlugin'>
^ nil.
!
----- Method: KedamaMorph>>primZoom:into:srcWidth:height:multX:y: (in category 'private-primitives') -----
primZoom: src into: dst srcWidth: sWidth height: sHeight multX: xFactor y: yFactor
<primitive: 'zoomBitmap' module: 'KedamaPlugin'>
"^ KedamaSqueakPlugin doPrimitive: #zoomBitmap."
^ nil.
!
----- Method: KedamaMorph>>random: (in category 'utils') -----
random: range
"Answer a random integer between 0 and range."
| r val |
<primitive: 'randomRange' module: 'KedamaPlugin'>
r := range < 0 ifTrue: [range negated] ifFalse: [range].
RandomSeed := ((RandomSeed * 1309) + 13849) bitAnd: 65535.
val := (RandomSeed * (r + 1)) >> 16.
^ range < 0 ifTrue: [val negated] ifFalse: [^ val].
!
----- Method: KedamaMorph>>recreateMagnifiedDisplayForm (in category 'private') -----
recreateMagnifiedDisplayForm
magnifiedDisplayForm := Form extent: self dimensions * pixelsPerPatch depth: 32.
self changed.
!
----- Method: KedamaMorph>>removeAllFromPatchDisplayList (in category 'drawing') -----
removeAllFromPatchDisplayList
patchesToDisplay := #().
!
----- Method: KedamaMorph>>removeAllFromTurtleDisplayList (in category 'drawing') -----
removeAllFromTurtleDisplayList
turtlesToDisplay := #().
!
----- Method: KedamaMorph>>removeFromTurtleDisplayList: (in category 'turtles') -----
removeFromTurtleDisplayList: examplerPlayer
turtlesToDisplay := turtlesToDisplay copyWithout: examplerPlayer.
!
----- Method: KedamaMorph>>rightEdgeMode (in category 'accessing') -----
rightEdgeMode
^ rightEdgeMode.
!
----- Method: KedamaMorph>>rightEdgeMode: (in category 'accessing') -----
rightEdgeMode: aSymbol
rightEdgeMode := aSymbol asSymbol.
rightEdgeMode == #wrap ifTrue: [
rightEdgeModeMnemonic := 1.
^ self
].
rightEdgeMode == #stick ifTrue: [
rightEdgeModeMnemonic := 2.
^ self
].
(rightEdgeMode == #bounce or: [rightEdgeMode == #bouncing]) ifTrue: [
rightEdgeModeMnemonic := 3.
^ self
].
!
----- Method: KedamaMorph>>rightEdgeModeMnemonic (in category 'accessing') -----
rightEdgeModeMnemonic
^ rightEdgeModeMnemonic.
!
----- Method: KedamaMorph>>setScale (in category 'menu') -----
setScale
| reply |
reply := FillInTheBlank
request: 'Set the number of pixels per patch (a number between 1 and 10)?'
initialAnswer: pixelsPerPatch printString.
reply isEmpty ifTrue: [^ self].
self pixelsPerPatch: reply asNumber.
!
----- Method: KedamaMorph>>setTurtlesCount:examplerPlayer:color: (in category 'turtles') -----
setTurtlesCount: count examplerPlayer: tp color: cPixel
| prototype |
prototype := self makePrototypeOfExampler: tp color: cPixel.
turtlesDictSemaphore critical: [(tp turtles) setTurtlesCount: count prototype: prototype for: self randomize: true].
self calcTurtlesCount.
!
----- Method: KedamaMorph>>setup (in category 'setup') -----
setup
"Subclasses should override this to setup the initial conditions of this StarSqueak world. The method should start with 'self clearAll'."
self clearAll.
!
----- Method: KedamaMorph>>topEdgeMode (in category 'accessing') -----
topEdgeMode
^ topEdgeMode.
!
----- Method: KedamaMorph>>topEdgeMode: (in category 'accessing') -----
topEdgeMode: aSymbol
topEdgeMode := aSymbol asSymbol.
topEdgeMode == #wrap ifTrue: [
topEdgeModeMnemonic := 1.
^ self
].
topEdgeMode == #stick ifTrue: [
topEdgeModeMnemonic := 2.
^ self
].
(topEdgeMode == #bounce or: [topEdgeMode == #bouncing]) ifTrue: [
topEdgeModeMnemonic := 3.
^ self
].
!
----- Method: KedamaMorph>>topEdgeModeMnemonic (in category 'accessing') -----
topEdgeModeMnemonic
^ topEdgeModeMnemonic.
!
----- Method: KedamaMorph>>turtleCount (in category 'etoys') -----
turtleCount
^ turtleCount.
!
----- Method: KedamaMorph>>turtlesCountOf: (in category 'turtles') -----
turtlesCountOf: exampler
| array |
array := exampler turtles.
array ifNil: [^ 0].
^ array size.
!
----- Method: KedamaMorph>>turtlesToDisplayAsString (in category 'drawing') -----
turtlesToDisplayAsString
^ String streamContents: [:strm |
strm nextPutAll: '#('.
turtlesToDisplay do: [:p |
strm nextPutAll: p externalName.
strm nextPut: Character space.
].
strm nextPutAll: ')'.
].
!
----- Method: KedamaMorph>>wantsDroppedMorph:event: (in category 'event handling') -----
wantsDroppedMorph: aMorph event: anEvent
^ aMorph isMemberOf: SketchMorph.
!
----- Method: KedamaMorph>>wrapX (in category 'accessing') -----
wrapX
^ wrapX.
!
----- Method: KedamaMorph>>wrapY (in category 'accessing') -----
wrapY
^ wrapY.
!
----- Method: KedamaMorph>>zoom:into:factor: (in category 'private') -----
zoom: src into: dst factor: f
src unhibernate.
dst unhibernate.
^ self primZoom: src bits into: dst bits srcWidth: src width height: src height multX: f y: f.
!
AlignmentMorph subclass: #BookPageSorterMorph
instanceVariableNames: 'book pageHolder'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
----- Method: BookPageSorterMorph>>acceptSort (in category 'as yet unclassified') -----
acceptSort
book acceptSortedContentsFrom: pageHolder.
self delete.
!
----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
| bb r aButton str |
r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
bb _ SimpleButtonMorph new target: self; borderColor: Color black.
r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
bb _ SimpleButtonMorph new target: self; borderColor: Color black.
r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
r addTransparentSpacerOfSize: 8 @ 0.
r addMorphBack: (self wrapperFor: (aButton _ UpdatingThreePhaseButtonMorph checkBox)).
aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
str _ StringMorph contents: 'Parts bin' translated.
r addMorphBack: (self wrapperFor: str lock).
self addMorphFront: r.
!
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
| innerBounds |
book _ aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width at pageHolder fullBounds height.
innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
----- Method: BookPageSorterMorph>>changeExtent: (in category 'as yet unclassified') -----
changeExtent: aPoint
self extent: aPoint.
pageHolder extent: self extent - self borderWidth!
----- Method: BookPageSorterMorph>>closeButtonOnly (in category 'as yet unclassified') -----
closeButtonOnly
"Replace my default control panel with one that has only a close button."
| b r |
self firstSubmorph delete. "remove old control panel"
b _ SimpleButtonMorph new target: self; borderColor: Color black.
r _ AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
r wrapCentering: #topLeft.
r addMorphBack: (b label: 'Close' translated; actionSelector: #delete).
self addMorphFront: r.
!
----- Method: BookPageSorterMorph>>columnWith: (in category 'as yet unclassified') -----
columnWith: aMorph
^AlignmentMorph newColumn
color: Color transparent;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
wrapCentering: #center;
cellPositioning: #topCenter;
layoutInset: 1;
addMorph: aMorph
!
----- Method: BookPageSorterMorph>>defaultBorderWidth (in category 'initialization') -----
defaultBorderWidth
"answer the default border width for the receiver"
^ 2!
----- Method: BookPageSorterMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color lightGray!
----- Method: BookPageSorterMorph>>getPartsBinStatus (in category 'as yet unclassified') -----
getPartsBinStatus
^pageHolder isPartsBin!
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
----- Method: BookPageSorterMorph>>pageHolder (in category 'as yet unclassified') -----
pageHolder
^ pageHolder
!
----- Method: BookPageSorterMorph>>rowWith: (in category 'as yet unclassified') -----
rowWith: aMorph
^AlignmentMorph newColumn
color: Color transparent;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
wrapCentering: #center;
cellPositioning: #topCenter;
layoutInset: 1;
addMorph: aMorph
!
----- Method: BookPageSorterMorph>>togglePartsBinStatus (in category 'as yet unclassified') -----
togglePartsBinStatus
pageHolder isPartsBin: pageHolder isPartsBin not!
----- Method: BookPageSorterMorph>>veryDeepFixupWith: (in category 'copying') -----
veryDeepFixupWith: deepCopier
"If fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals."
super veryDeepFixupWith: deepCopier.
book _ deepCopier references at: book ifAbsent: [book].
!
----- Method: BookPageSorterMorph>>veryDeepInner: (in category 'copying') -----
veryDeepInner: deepCopier
"Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment."
super veryDeepInner: deepCopier.
"book _ book. Weakly copied"
pageHolder _ pageHolder veryDeepCopyWith: deepCopier.!
----- Method: BookPageSorterMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') -----
wantsToBeDroppedInto: aMorph
"Return true if it's okay to drop the receiver into aMorph"
^aMorph isWorldMorph "only into worlds"!
----- Method: BookPageSorterMorph>>wrapperFor: (in category 'as yet unclassified') -----
wrapperFor: aMorph
^self columnWith: (self rowWith: aMorph)
!
AlignmentMorph subclass: #BooklikeMorph
instanceVariableNames: 'pageSize newPagePrototype'
classVariableNames: 'PageFlipSoundOn'
poolDictionaries: ''
category: 'MorphicBooks'!
!BooklikeMorph commentStamp: '<historical>' prior: 0!
A common superclass for BookMorph and WebBookMorph!
BooklikeMorph subclass: #BookMorph
instanceVariableNames: 'pages currentPage'
classVariableNames: 'VersionNames VersionTimes MethodHolders'
poolDictionaries: ''
category: 'MorphicBooks'!
!BookMorph commentStamp: '<historical>' prior: 0!
A collection of pages, each of which is a place to put morphs. Allows one or another page to show; orchestrates the page transitions; offers control panel for navigating among pages and for adding and deleting pages.
To write a book out to the disk or to a file server, decide what folder it goes in. Construct a url to a typical page:
file://myDisk/folder/myBook1.sp
or
ftp://aServer/folder/myBook1.sp
Choose "send all pages to server" from the book's menu (press the <> part of the controls). Choose "use page numbers". Paste in the url.
To load an existing book, find its ".bo" file in the file list browser. Choose "load as book".
To load an existing book from its url, execute:
¦(URLMorph grabURL: 'ftp://aServer/folder/myBook1.sp') book: true.
Multiple people may modify a book. If other people may have changed a book you have on your screen, choose "reload all from server".
Add or modify a page, and choose "send this page to server".
The polite thing to do is to reload before changing a book. Then write one or all pages soon after making your changes. If you store a stale book, it will wipe out changes that other people made in the mean time.
Pages may be linked to each other. To create a named link to a new page, type the name of the page in a text area in a page. Select it and do Cmd-6. Choose 'link to'. A new page of that name will be added at the back of the book. Clicking on the blue text flips to that page.
To create a link to an existing page, first name the page. Go to that page and Cmd-click on it. The name of the page is below the page. Click in it and backspace and type. Return to the page you are linking from. Type the name. Cmd-6, 'link to'.
Text search: Search for a set of fragments. allStrings collects text of fields. Turn to page with all fragments on it and highlight the first one. Save the container and offset in properties: #searchContainer, #searchOffset, #searchKey. Search again from there. Clear those at each page turn, or change of search key.
[rules about book indexes and pages: Index and pages must live in the same directory. They have the same file prefix, followed by .bo for the index or 4.sp for a page (or x4.sp). When a book is moved to a new directory, the load routine gets the new urls for all pages and saves those in the index. Book stores index url in property #url.
Allow mulitple indexes (books) on the same shared set of pages. If book has a url in same directory as pages, allow them to have different prefixes.
save all pages first time, save one page first time, fromRemoteStream: (first time)
save all pages normal , save one page normal, reload
where I check if same dir]
URLMorph holds url of both page and book.!
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
book _ self new markAsPartsDonor.
book removeEverything; pageSize: 360 at 228; color: (Color gray: 0.9).
book borderWidth: 1; borderColor: Color black.
book beSticky.
book showPageControls; insertPage.
^ book!
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
^ self partName: 'Book'
categories: #('Presentation')
documentation: 'Multi-page structures'!
----- Method: BookMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
fileReaderServicesForFile: fullName suffix: suffix
^(suffix = 'bo') | (suffix = '*')
ifTrue: [ Array with: self serviceLoadAsBook]
ifFalse: [#()]
!
----- Method: BookMorph class>>grabURL: (in category 'url') -----
grabURL: aURLString
"Create a BookMorph for this url and put it in the hand."
| book |
book _ self new fromURL: aURLString.
"If this book is already in, we will steal the pages out of it!!!!!!!!"
book goToPage: 1. "install it"
HandMorph attach: book!
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
FileList registerFileReader: self.
self registerInFlapsRegistry. !
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
urls _ OrderedCollection new.
bks _ OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
short _ (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
----- Method: BookMorph class>>makeBookOfProjects:named: (in category 'booksAsProjects') -----
makeBookOfProjects: aListOfProjects named: aString
"
BookMorph makeBookOfProjects: (Project allProjects select: [ :each | each world isMorph])
"
| book pvm page |
book _ self new.
book setProperty: #transitionSpec toValue: {'silence'. #none. #none}.
aListOfProjects do: [ :each |
pvm _ ProjectViewMorph on: each.
page _ PasteUpMorph new addMorph: pvm; extent: pvm extent.
book insertPage: page pageSize: page extent
].
book goToPage: 1.
book deletePageBasic.
book setProperty: #nameOfThreadOfProjects toValue: aString.
book removeProperty: #transitionSpec.
book openInWorld!
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
"Answer a button that will take the user to the next page of its enclosing book"
| aButton |
aButton _ SimpleButtonMorph new.
aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
aButton setNameTo: 'next'.
^ aButton!
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
aFileStream _ FileStream oldFileNamed: fullName.
book _ BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
"Answer a button that will take the user to the previous page of its enclosing book"
| aButton |
aButton _ SimpleButtonMorph new.
aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
label: 'load as book'
selector: #openFromFile:
description: 'open as bookmorph'!
----- Method: BookMorph class>>services (in category 'fileIn/Out') -----
services
^ Array with: self serviceLoadAsBook!
----- Method: BookMorph class>>unload (in category 'initialize-release') -----
unload
"Unload the receiver from global registries"
self environment
at: #FileList
ifPresent: [:cl | cl unregisterFileReader: self].
self environment
at: #Flaps
ifPresent: [:cl | cl unregisterQuadsWithReceiver: self]!
----- Method: BookMorph>>abandon (in category 'submorphs-add/remove') -----
abandon
"Like delete, but we really intend not to use this morph again. Make the page cache release the page object."
| pg |
self delete.
pages do: [:aPage |
(pg _ aPage sqkPage) ifNotNil: [
pg contentsMorph == aPage ifTrue: [
pg contentsMorph: nil]]].!
----- Method: BookMorph>>acceptDroppingMorph:event: (in category 'layout') -----
acceptDroppingMorph: aMorph event: evt
"Allow the user to add submorphs just by dropping them on this morph."
(currentPage allMorphs includes: aMorph)
ifFalse: [currentPage addMorph: aMorph]!
----- Method: BookMorph>>acceptSortedContentsFrom: (in category 'sorting') -----
acceptSortedContentsFrom: aHolder
"Update my page list from the given page sorter."
| goodPages rejects toAdd sqPage |
goodPages := OrderedCollection new.
rejects := OrderedCollection new.
aHolder submorphs doWithIndex:
[:m :i |
toAdd := nil.
(m isKindOf: PasteUpMorph) ifTrue: [toAdd := m].
(m isKindOf: BookPageThumbnailMorph)
ifTrue:
[toAdd := m page.
m bookMorph == self
ifFalse:
["borrowed from another book. preserve the original"
toAdd := toAdd veryDeepCopy.
"since we came from elsewhere, cached strings are wrong"
self removeProperty: #allTextUrls.
self removeProperty: #allText]].
toAdd isString
ifTrue:
["a url"
toAdd := pages detect: [:aPage | aPage url = toAdd] ifNone: [toAdd]].
toAdd isString
ifTrue:
[sqPage := SqueakPageCache atURL: toAdd.
toAdd := sqPage contentsMorph
ifNil: [sqPage copyForSaving "a MorphObjectOut"]
ifNotNil: [sqPage contentsMorph]].
toAdd ifNil: [rejects add: m] ifNotNil: [goodPages add: toAdd]].
self newPages: goodPages.
goodPages isEmpty ifTrue: [self insertPage].
rejects notEmpty
ifTrue:
[self
inform: rejects size printString , ' objects vanished in this process.']!
----- Method: BookMorph>>addBookMenuItemsTo:hand: (in category 'menu') -----
addBookMenuItemsTo: aMenu hand: aHandMorph
| controlsShowing subMenu |
subMenu _ MenuMorph new defaultTarget: self.
subMenu add: 'previous page' translated action: #previousPage.
subMenu add: 'next page' translated action: #nextPage.
subMenu add: 'goto page' translated action: #goToPage.
subMenu add: 'insert a page' translated action: #insertPage.
subMenu add: 'delete this page' translated action: #deletePage.
controlsShowing _ self hasSubmorphWithProperty: #pageControl.
controlsShowing
ifTrue:
[subMenu add: 'hide page controls' translated action: #hidePageControls.
subMenu add: 'fewer page controls' translated action: #fewerPageControls]
ifFalse:
[subMenu add: 'show page controls' translated action: #showPageControls].
self isInFullScreenMode ifTrue: [
subMenu add: 'exit full screen' translated action: #exitFullScreen.
] ifFalse: [
subMenu add: 'show full screen' translated action: #goFullScreen.
].
subMenu addLine.
subMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:.
subMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:.
subMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:.
subMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
subMenu addLine.
subMenu add: 'sort pages' translated action: #sortPages:.
subMenu add: 'uncache page sorter' translated action: #uncachePageSorter.
(self hasProperty: #dontWrapAtEnd)
ifTrue: [subMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true]
ifFalse: [subMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
subMenu addLine.
subMenu add: 'search for text' translated action: #textSearch.
(aHandMorph pasteBuffer class isKindOf: PasteUpMorph class) ifTrue:
[subMenu add: 'paste book page' translated action: #pasteBookPage].
subMenu add: 'send all pages to server' translated action: #savePagesOnURL.
subMenu add: 'send this page to server' translated action: #saveOneOnURL.
subMenu add: 'reload all from server' translated action: #reload.
subMenu add: 'copy page url to clipboard' translated action: #copyUrl.
subMenu add: 'keep in one file' translated action: #keepTogether.
subMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype.
newPagePrototype ifNotNil:
[subMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: 'book...' translated subMenu: subMenu
!
----- Method: BookMorph>>adjustCurrentPageForFullScreen (in category 'other') -----
adjustCurrentPageForFullScreen
"Adjust current page to conform to whether or not I am in full-screen mode. Also, enforce uniform page size constraint if appropriate"
self isInFullScreenMode
ifTrue:
[(currentPage hasProperty: #sizeWhenNotFullScreen) ifFalse:
[currentPage setProperty: #sizeWhenNotFullScreen toValue: currentPage extent].
currentPage extent: Display extent]
ifFalse:
[(currentPage hasProperty: #sizeWhenNotFullScreen) ifTrue:
[currentPage extent: (currentPage valueOfProperty: #sizeWhenNotFullScreen).
currentPage removeProperty: #sizeWhenNotFullScreen].
self uniformPageSize ifNotNilDo:
[:anExtent | currentPage extent: anExtent]].
(self valueOfProperty: #floatingPageControls) ifNotNilDo:
[:pc | pc isInWorld ifFalse: [pc openInWorld]]!
----- Method: BookMorph>>allNonSubmorphMorphs (in category 'submorphs-accessing') -----
allNonSubmorphMorphs
"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy. Especially the non-showing pages in BookMorphs. (As needed, make a variant of this that brings in all pages that are not in memory.)"
| coll |
coll _ OrderedCollection new.
pages do: [:pg |
pg isInMemory ifTrue: [
pg == currentPage ifFalse: [coll add: pg]]].
^ coll!
----- Method: BookMorph>>allowSubmorphExtraction (in category 'dropping/grabbing') -----
allowSubmorphExtraction
^ false!
----- Method: BookMorph>>asPostscript (in category 'Postscript Canvases') -----
asPostscript
^self asPostscriptPrintJob.
!
----- Method: BookMorph>>bookmarkForThisPage (in category 'menu') -----
bookmarkForThisPage
"If this book exists on a server, make the reference via a URL"
| bb url um |
(url _ self url) ifNil: [
bb _ SimpleButtonMorph new target: self.
bb actionSelector: #goToPageMorph:fromBookmark:.
bb label: 'Bookmark' translated.
bb arguments: (Array with: currentPage with: bb).
self primaryHand attachMorph: bb.
^ bb].
currentPage url ifNil: [currentPage saveOnURLbasic].
um _ URLMorph newForURL: currentPage url.
um setURL: currentPage url page: currentPage sqkPage.
(SqueakPage stemUrl: url) = (SqueakPage stemUrl: currentPage url)
ifTrue: [um book: true]
ifFalse: [um book: url]. "remember which book"
um isBookmark: true; label: 'Bookmark' translated.
um borderWidth: 1; borderColor: #raised.
um color: (Color r: 0.4 g: 0.8 b: 0.6).
self primaryHand attachMorph: um.
^ um!
----- Method: BookMorph>>buildFloatingPageControls (in category 'navigation') -----
buildFloatingPageControls
| pageControls |
pageControls _ self makePageControlsFrom: self fullControlSpecs.
pageControls borderWidth: 0; layoutInset: 4.
pageControls setProperty: #pageControl toValue: true.
pageControls setNameTo: 'Page Controls'.
pageControls color: Color yellow.
^FloatingBookControlsMorph new addMorph: pageControls.
!
----- Method: BookMorph>>buildThreadOfProjects (in category 'menu') -----
buildThreadOfProjects
| thisPVM projectNames threadName |
projectNames _ pages collect: [ :each |
(thisPVM _ each findA: ProjectViewMorph) ifNil: [
nil
] ifNotNil: [
{thisPVM project name}.
].
].
projectNames _ projectNames reject: [ :each | each isNil].
threadName _ FillInTheBlank
request: 'Please name this thread.' translated
initialAnswer: (
self valueOfProperty: #nameOfThreadOfProjects ifAbsent: ['Projects on Parade' translated]
).
threadName isEmptyOrNil ifTrue: [^self].
InternalThreadNavigationMorph
know: projectNames as: threadName;
openThreadNamed: threadName atIndex: nil.
!
----- Method: BookMorph>>cardsOrPages (in category 'accessing') -----
cardsOrPages
"The turnable and printable entities"
^ pages!
----- Method: BookMorph>>chooseAndRevertToVersion (in category 'scripting') -----
chooseAndRevertToVersion
| time which |
"Let the user choose an older version for all code in MethodMorphs in this book. Run through that code and revert each one to that time."
self methodHolders. "find them in me"
self methodHolderVersions.
which _ PopUpMenu withCaption:
'Put all scripts in this book back
the way they were at this time:'
chooseFrom: #('leave as is'), VersionNames.
which <= 1 ifTrue: [^ self].
time _ VersionTimes at: which-1.
self revertToCheckpoint: time.!
----- Method: BookMorph>>copyUrl (in category 'menu') -----
copyUrl
"Copy this page's url to the clipboard"
| str |
str _ currentPage url ifNil: [str _ 'Page does not have a url. Send page to server first.' translated].
Clipboard clipboardText: str asText.
!
----- Method: BookMorph>>currentPage (in category 'accessing') -----
currentPage
(submorphs includes: currentPage) ifFalse: [currentPage _ nil].
^ currentPage!
----- Method: BookMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color white!
----- Method: BookMorph>>defaultNameStemForNewPages (in category 'insert and delete') -----
defaultNameStemForNewPages
"Answer a stem onto which to build default names for fresh pages"
^ 'page'
!
----- Method: BookMorph>>defersHaloOnClickTo: (in category 'halos and balloon help') -----
defersHaloOnClickTo: aSubMorph
"If a cmd-click on aSubMorph would make it a preferred recipient of the halo, answer true"
^ currentPage notNil and:
[aSubMorph hasOwner: currentPage]
!
----- Method: BookMorph>>deletePage (in category 'insert and delete') -----
deletePage
| message |
message _
'Are you certain that you
want to delete this page and
everything that is on it? ' translated.
(self confirm: message) ifTrue:
[self deletePageBasic].
!
----- Method: BookMorph>>deletePageBasic (in category 'insert and delete') -----
deletePageBasic
| thisPage |
thisPage _ self pageNumberOf: currentPage.
pages remove: currentPage.
currentPage delete.
currentPage _ nil.
pages isEmpty ifTrue: [^ self insertPage].
self goToPage: (thisPage min: pages size)
!
----- Method: BookMorph>>exitFullScreen (in category 'other') -----
exitFullScreen
| floater |
self isInFullScreenMode ifFalse: [^self].
self setProperty: #fullScreenMode toValue: false.
floater _ self valueOfProperty: #floatingPageControls ifAbsent: [nil].
floater ifNotNil: [
floater delete.
self removeProperty: #floatingPageControls.
].
self position: 0 at 0.
self adjustCurrentPageForFullScreen.
!
----- Method: BookMorph>>findText: (in category 'menu') -----
findText: wants
"Turn to the next page that has all of the strings mentioned on it. Highlight where it is found. allText and allTextUrls have been set. Case insensitive search.
Resuming a search. If container's text is still in the list and secondary keys are still in the page, (1) search rest of that container. (2) search rest of containers on that page (3) pages till end of book, (4) from page 1 to this page again."
"Later sort wants so longest key is first"
| allText good thisWord here fromHereOn startToHere oldContainer oldIndex otherKeys strings |
allText _ self valueOfProperty: #allText ifAbsent: [#()].
here _ pages identityIndexOf: currentPage ifAbsent: [1].
fromHereOn _ here+1 to: pages size.
startToHere _ 1 to: here. "repeat this page"
(self valueOfProperty: #searchKey ifAbsent: [#()]) = wants ifTrue: [
"does page have all the other keys? No highlight if found!!"
otherKeys _ wants allButFirst.
strings _ allText at: here.
good _ true.
otherKeys do: [:searchString | "each key"
good ifTrue: [thisWord _ false.
strings do: [:longString |
(longString findString: searchString startingAt: 1
caseSensitive: false) > 0 ifTrue: [
thisWord _ true]].
good _ thisWord]].
good ifTrue: ["all are on this page. Look in rest for string again."
oldContainer _ self valueOfProperty: #searchContainer.
oldIndex _ self valueOfProperty: #searchOffset.
(self findText: (OrderedCollection with: wants first) inStrings: strings
startAt: oldIndex+1 container: oldContainer
pageNum: here) ifTrue: [
self setProperty: #searchKey toValue: wants.
^ true]]]
ifFalse: [fromHereOn _ here to: pages size]. "do search this page"
"other pages"
allText ifNotEmpty: [
fromHereOn do: [:pageNum |
(self findText: wants inStrings: (allText at: pageNum) startAt: 1 container: nil
pageNum: pageNum)
ifTrue: [^ true]].
startToHere do: [:pageNum |
(self findText: wants inStrings: (allText at: pageNum) startAt: 1 container: nil
pageNum: pageNum)
ifTrue: [^ true]]].
"if fail"
self setProperty: #searchContainer toValue: nil.
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
^ false!
----- Method: BookMorph>>findText:inStrings:startAt:container:pageNum: (in category 'menu') -----
findText: keys inStrings: rawStrings startAt: startIndex container: oldContainer pageNum: pageNum
"Call once to search a page of the book. Return true if found and highlight the text. oldContainer should be NIL.
(oldContainer is only non-nil when (1) doing a 'search again' and (2) the page is in memory and (3) keys has just one element. oldContainer is a TextMorph.)"
| good thisWord index insideOf place container start wasIn strings old |
good := true.
start := startIndex.
strings := oldContainer ifNil:
["normal case"
rawStrings]
ifNotNil:
[(pages at: pageNum) isInMemory
ifFalse: [rawStrings]
ifTrue: [(pages at: pageNum) allStringsAfter: oldContainer]].
keys do:
[:searchString |
"each key"
good
ifTrue:
[thisWord := false.
strings do:
[:longString |
(index := longString
findString: searchString
startingAt: start
caseSensitive: false) > 0
ifTrue:
[thisWord not & (searchString == keys first)
ifTrue:
[insideOf := longString.
place := index].
thisWord := true].
start := 1]. "only first key on first container"
good := thisWord]].
good
ifTrue:
["all are on this page"
wasIn := (pages at: pageNum) isInMemory.
self goToPage: pageNum.
wasIn
ifFalse:
["search again, on the real current text. Know page is in."
^self
findText: keys
inStrings: ((pages at: pageNum) allStringsAfter: nil)
startAt: startIndex
container: oldContainer
pageNum: pageNum "recompute"]].
(old := self valueOfProperty: #searchContainer) ifNotNil:
[(old respondsTo: #editor)
ifTrue:
[old editor selectFrom: 1 to: 0. "trying to remove the previous selection!!"
old changed]].
good
ifTrue:
["have the exact string object"
(container := oldContainer) ifNil:
[container := self
highlightText: keys first
at: place
in: insideOf]
ifNotNil:
[container userString == insideOf
ifFalse:
[container := self
highlightText: keys first
at: place
in: insideOf]
ifTrue:
[(container isTextMorph)
ifTrue:
[container editor selectFrom: place to: keys first size - 1 + place.
container changed]]].
self setProperty: #searchContainer toValue: container.
self setProperty: #searchOffset toValue: place.
self setProperty: #searchKey toValue: keys. "override later"
ActiveHand newKeyboardFocus: container.
^true].
^false!
----- Method: BookMorph>>forgetURLs (in category 'menu') -----
forgetURLs
"About to save these objects in a new place. Forget where stored now. Must bring in all pages we don't have."
| pg |
pages do: [:aPage |
aPage yourself. "bring it into memory"
(pg _ aPage valueOfProperty: #SqueakPage) ifNotNil: [
SqueakPageCache removeURL: pg url.
pg contentsMorph setProperty: #SqueakPage toValue: nil]].
self setProperty: #url toValue: nil.!
----- Method: BookMorph>>fromRemoteStream: (in category 'initialization') -----
fromRemoteStream: strm
"Make a book from an index and a bunch of pages on a server. NOT showing any page!! Index and pages must live in the same directory. If the book has moved, save the current correct urls for each of the pages. Self must already have a url stored in property #url."
| remote dict bookUrl oldStem stem oldUrl endPart |
remote := strm fileInObjectAndCode.
bookUrl := (SqueakPage new)
url: (self valueOfProperty: #url);
url.
"expand a relative url"
oldStem := SqueakPage stemUrl: (remote second) url.
oldStem := oldStem copyUpToLast: $/.
stem := SqueakPage stemUrl: bookUrl.
stem := stem copyUpToLast: $/.
oldStem = stem
ifFalse:
["Book is in new directory, fix page urls"
2 to: remote size
do:
[:ii |
oldUrl := (remote at: ii) url.
endPart := oldUrl copyFrom: oldStem size + 1 to: oldUrl size.
(remote at: ii) url: stem , endPart]].
self initialize.
pages := OrderedCollection new.
2 to: remote size do: [:ii | pages add: (remote at: ii)].
currentPage
fullReleaseCachedState;
delete. "the blank one"
currentPage := remote second.
dict := remote first.
self setProperty: #modTime toValue: (dict at: #modTime).
dict at: #allText
ifPresent: [:val | self setProperty: #allText toValue: val].
dict at: #allTextUrls
ifPresent: [:val | self setProperty: #allTextUrls toValue: val].
#(#color #borderWidth #borderColor #pageSize)
with: #(#color: #borderWidth: #borderColor: #pageSize:)
do: [:key :sel | dict at: key ifPresent: [:val | self perform: sel with: val]].
^self!
----- Method: BookMorph>>fromURL: (in category 'initialization') -----
fromURL: url
"Make a book from an index and a bunch of pages on a server. NOT showing any page!!"
| strm |
Cursor wait showWhile: [
strm _ (ServerFile new fullPath: url) asStream].
strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil].
self setProperty: #url toValue: url.
self fromRemoteStream: strm.
^ self!
----- Method: BookMorph>>fullDrawPostscriptOn: (in category 'Postscript Canvases') -----
fullDrawPostscriptOn:aCanvas
^aCanvas fullDrawBookMorph:self.
!
----- Method: BookMorph>>getAllText (in category 'menu') -----
getAllText
"Collect the text for each page. Just point at strings so don't have to recopy them. Parallel array of urls for ID of pages.
allText = Array (pages size) of arrays (fields in it) of strings of text.
allTextUrls = Array (pages size) of urls or page numbers.
For any page that is out, text data came from .bo file on server.
Is rewritten when one or all pages are stored."
| oldUrls oldStringLists allText allTextUrls aUrl which |
oldUrls _ self valueOfProperty: #allTextUrls ifAbsent: [#()].
oldStringLists _ self valueOfProperty: #allText ifAbsent: [#()].
allText _ pages collect: [:pg | OrderedCollection new].
allTextUrls _ Array new: pages size.
pages doWithIndex: [:aPage :ind | aUrl _ aPage url. aPage isInMemory
ifTrue: [(allText at: ind) addAll: (aPage allStringsAfter: nil).
aUrl ifNil: [aUrl _ ind].
allTextUrls at: ind put: aUrl]
ifFalse: ["Order of pages on server may be different. (later keep up to date?)"
which _ oldUrls indexOf: aUrl.
allTextUrls at: ind put: aUrl.
which = 0 ifFalse: [allText at: ind put: (oldStringLists at: which)]]].
self setProperty: #allText toValue: allText.
self setProperty: #allTextUrls toValue: allTextUrls.
^ allText!
----- Method: BookMorph>>getStemUrl (in category 'menu') -----
getStemUrl
"Try to find the old place where this book was stored. Confirm with the
user. Else ask for new place."
| initial pg url knownURL |
knownURL _ false.
initial _ ''.
(pg _ currentPage valueOfProperty: #SqueakPage)
ifNotNil: [pg contentsMorph == currentPage
ifTrue: [initial _ pg url.
knownURL _ true]].
"If this page has a url"
pages
doWithIndex: [:aPage :ind | initial isEmpty
ifTrue: [aPage isInMemory
ifTrue: [(pg _ aPage valueOfProperty: #SqueakPage)
ifNotNil: [initial _ pg url]]]].
"any page with a url"
initial isEmpty
ifTrue: [initial _ ServerDirectory defaultStemUrl , '1.sp'].
"A new legal place"
url _ knownURL
ifTrue: [initial]
ifFalse: [FillInTheBlank request: 'url of the place to store a typical page in this book.
Must begin with file:// or ftp://' translated initialAnswer: initial].
^ SqueakPage stemUrl: url!
----- Method: BookMorph>>goFullScreen (in category 'other') -----
goFullScreen
| floater |
self isInFullScreenMode ifTrue: [^self].
self setProperty: #fullScreenMode toValue: true.
self position: (currentPage topLeft - self topLeft) negated.
self adjustCurrentPageForFullScreen.
floater _ self buildFloatingPageControls.
self setProperty: #floatingPageControls toValue: floater.
floater openInWorld.
!
----- Method: BookMorph>>goToPage (in category 'menu') -----
goToPage
| pageNum |
pageNum _ FillInTheBlank request: 'Page?' translated initialAnswer: '0'.
pageNum isEmptyOrNil ifTrue: [^true].
self goToPage: pageNum asNumber.
!
----- Method: BookMorph>>goToPage: (in category 'navigation') -----
goToPage: pageNumber
^ self goToPage: pageNumber transitionSpec: nil!
----- Method: BookMorph>>goToPage:transitionSpec: (in category 'navigation') -----
goToPage: pageNumber transitionSpec: transitionSpec
| pageMorph |
pages isEmpty ifTrue: [^ self].
pageMorph _ (self hasProperty: #dontWrapAtEnd)
ifTrue: [pages atPin: pageNumber]
ifFalse: [pages atWrap: pageNumber].
^ self goToPageMorph: pageMorph transitionSpec: transitionSpec!
----- Method: BookMorph>>goToPage:transitionSpec:runTransitionScripts: (in category 'navigation') -----
goToPage: pageNumber transitionSpec: transitionSpec runTransitionScripts: aBoolean
"Go the the given page number; use the transitionSpec supplied, and if the boolean parameter is true, run opening and closing scripts as appropriate"
| pageMorph |
pages isEmpty ifTrue: [^ self].
pageMorph _ (self hasProperty: #dontWrapAtEnd)
ifTrue: [pages atPin: pageNumber]
ifFalse: [pages atWrap: pageNumber].
^ self goToPageMorph: pageMorph transitionSpec: transitionSpec runTransitionScripts: aBoolean!
----- Method: BookMorph>>goToPageMorph: (in category 'navigation') -----
goToPageMorph: aMorph
"Set the given morph as the current page; run closing and opening scripts as appropriate"
self goToPageMorph: aMorph runTransitionScripts: true!
----- Method: BookMorph>>goToPageMorph:fromBookmark: (in category 'navigation') -----
goToPageMorph: aMorph fromBookmark: aBookmark
"This protocol enables sensitivity to a transitionSpec on the bookmark"
self goToPageMorph: aMorph
transitionSpec: (aBookmark valueOfProperty: #transitionSpec).
!
----- Method: BookMorph>>goToPageMorph:runTransitionScripts: (in category 'navigation') -----
goToPageMorph: aMorph runTransitionScripts: aBoolean
"Set the given morph as the current page. If the boolean parameter is true, then opening and closing scripts will be run"
self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil runTransitionScripts: aBoolean
!
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
currentPage sqkPage computeThumbnail "just store it"]!
----- Method: BookMorph>>goToPageMorph:transitionSpec:runTransitionScripts: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec runTransitionScripts: aBoolean
"Install the given page as the new current page; use the given transition spec, and if the boolean parameter is true, run closing and opening scripts on the outgoing and incoming players"
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
aBoolean
ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts]].
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
aBoolean
ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts]].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
currentPage sqkPage computeThumbnail "just store it"]!
----- Method: BookMorph>>goToPageUrl: (in category 'navigation') -----
goToPageUrl: aUrl
| pp short |
pp := pages detect: [:pg | pg url = aUrl] ifNone: [nil].
pp ifNil:
[short := (aUrl findTokens: '/') last.
pp := pages detect:
[:pg |
pg url ifNil: [false] ifNotNil: [(pg url findTokens: '/') last = short] "it moved"]
ifNone: [pages first]].
self goToPageMorph: pp!
----- Method: BookMorph>>goto: (in category 'navigation') -----
goto: aPlayer
self goToPageMorph: aPlayer costume!
----- Method: BookMorph>>highlightText:at:in: (in category 'menu') -----
highlightText: stringToHilite at: index in: insideOf
"Find the container with this text and highlight it. May not be able to do it for stringMorphs."
"Find the container with that text"
| container |
self
allMorphsDo: [:sub | insideOf == sub userString ifTrue: [container := sub]].
container ifNil:
[self
allMorphsDo: [:sub | insideOf = sub userString ifTrue: [container := sub]]]. "any match"
container ifNil: [^nil].
"Order it highlighted"
(container isTextMorph)
ifTrue:
[container editor selectFrom: index to: stringToHilite size - 1 + index].
container changed.
^container!
----- Method: BookMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self setInitialState.
pages _ OrderedCollection new.
self showPageControls.
self class
turnOffSoundWhile: [self insertPage]!
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
self initialize.
self removeEverything; pageSize: 360 at 228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
----- Method: BookMorph>>insertPage:pageSize: (in category 'insert and delete') -----
insertPage: aPage pageSize: aPageSize
^ self insertPage: aPage pageSize: aPageSize atIndex: (pages size + 1)!
----- Method: BookMorph>>insertPage:pageSize:atIndex: (in category 'insert and delete') -----
insertPage: aPage pageSize: aPageSize atIndex: anIndex
| sz predecessor |
sz := aPageSize
ifNil: [currentPage isNil ifTrue: [pageSize] ifFalse: [currentPage extent]]
ifNotNil: [aPageSize].
aPage extent: sz.
(pages isEmpty | anIndex isNil or: [anIndex > pages size])
ifTrue: [pages add: aPage]
ifFalse:
[anIndex <= 1
ifTrue: [pages addFirst: aPage]
ifFalse:
[predecessor := anIndex isNil
ifTrue: [currentPage]
ifFalse: [pages at: anIndex].
self pages add: aPage after: predecessor]].
self goToPageMorph: aPage!
----- Method: BookMorph>>insertPageColored: (in category 'insert and delete') -----
insertPageColored: aColor
"Insert a new page for the receiver, using the given color as its background color"
| sz newPage bw bc |
bc := currentPage isNil
ifTrue:
[sz := pageSize.
bw := 0.
Color blue muchLighter]
ifFalse:
[sz := currentPage extent.
bw := currentPage borderWidth.
currentPage borderColor].
newPagePrototype ifNil:
[newPage := (PasteUpMorph new)
extent: sz;
color: aColor.
newPage
borderWidth: bw;
borderColor: bc]
ifNotNil: [Cursor wait showWhile: [newPage := newPagePrototype veryDeepCopy]].
newPage setNameTo: self defaultNameStemForNewPages.
newPage vResizeToFit: false.
pages isEmpty
ifTrue: [pages add: (currentPage := newPage)]
ifFalse: [pages add: newPage after: currentPage].
self nextPage!
----- Method: BookMorph>>insertPageLabel:morphs: (in category 'insert and delete') -----
insertPageLabel: labelString morphs: morphList
| m c labelAllowance |
self insertPage.
labelString ifNotNil:
[m _ (TextMorph new extent: currentPage width at 20; contents: labelString).
m lock.
m position: currentPage position + (((currentPage width - m width) // 2) @ 5).
currentPage addMorph: m.
labelAllowance _ 40]
ifNil:
[labelAllowance _ 0].
"use a column to align the given morphs, then add them to the page"
c _ AlignmentMorph newColumn wrapCentering: #center; cellPositioning: #topCenter.
c addAllMorphs: morphList.
c position: currentPage position + (0 @ labelAllowance).
currentPage addAllMorphs: morphList.
^ currentPage
!
----- Method: BookMorph>>insertPageMorphInCorrectSpot: (in category 'navigation') -----
insertPageMorphInCorrectSpot: aPageMorph
self addMorphBack: (currentPage _ aPageMorph).
!
----- Method: BookMorph>>insertPageSilentlyAtEnd (in category 'insert and delete') -----
insertPageSilentlyAtEnd
"Create a new page at the end of the book. Do not turn to it."
| sz newPage bw bc cc |
cc := currentPage isNil
ifTrue:
[sz := pageSize.
bw := 0.
bc := Color blue muchLighter.
color]
ifFalse:
[sz := currentPage extent.
bw := currentPage borderWidth.
bc := currentPage borderColor.
currentPage color].
newPagePrototype ifNil:
[newPage := (PasteUpMorph new)
extent: sz;
color: cc.
newPage
borderWidth: bw;
borderColor: bc]
ifNotNil: [Cursor wait showWhile: [newPage := newPagePrototype veryDeepCopy]].
newPage setNameTo: self defaultNameStemForNewPages.
newPage vResizeToFit: false.
pages isEmpty
ifTrue: [pages add: (currentPage := newPage) "had been none"]
ifFalse: [pages add: newPage after: pages last].
^newPage!
----- Method: BookMorph>>installRollBackButtons (in category 'scripting') -----
installRollBackButtons
| all |
"In each script in me, put a versions button it the upper right."
all _ IdentitySet new.
self allMorphsAndBookPagesInto: all.
all _ all select: [:mm | mm class = MethodMorph].
all do: [:mm | mm installRollBackButtons: self].!
----- Method: BookMorph>>invokeBookMenu (in category 'menu') -----
invokeBookMenu
"Invoke the book's control panel menu."
| aMenu |
aMenu _ MenuMorph new defaultTarget: self.
aMenu addTitle: 'Book' translated.
Preferences noviceMode
ifFalse:[aMenu addStayUpItem].
aMenu add: 'find...' translated action: #textSearch.
aMenu add: 'go to page...' translated action: #goToPage.
aMenu addLine.
aMenu addList: {
{'sort pages' translated. #sortPages}.
{'uncache page sorter' translated. #uncachePageSorter}}.
(self hasProperty: #dontWrapAtEnd)
ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true]
ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
aMenu addList: {
{'make bookmark' translated. #bookmarkForThisPage}.
{'make thumbnail' translated. #thumbnailForThisPage}}.
aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls.
aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen.
aMenu addLine.
aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:.
aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:.
aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:.
aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
aMenu addLine.
(self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue:
[aMenu add: 'paste book page' translated action: #pasteBookPage].
aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype.
newPagePrototype ifNotNil: [
aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated
action: #toggleDragNDrop.
aMenu add: 'make all pages this size' translated action: #makeUniformPageSize.
aMenu
addUpdating: #keepingUniformPageSizeString
target: self
action: #toggleMaintainUniformPageSize.
aMenu addLine.
aMenu add: 'send all pages to server' translated action: #savePagesOnURL.
aMenu add: 'send this page to server' translated action: #saveOneOnURL.
aMenu add: 'reload all from server' translated action: #reload.
aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
aMenu add: 'keep in one file' translated action: #keepTogether.
aMenu addLine.
aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook.
aMenu add: 'background color for all pages...' translated action: #setPageColor.
aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects.
aMenu popUpEvent: self world activeHand lastEvent in: self world
!
----- Method: BookMorph>>isInFullScreenMode (in category 'other') -----
isInFullScreenMode
^self valueOfProperty: #fullScreenMode ifAbsent: [false]!
----- Method: BookMorph>>keepTogether (in category 'menu') -----
keepTogether
"Mark this book so that each page will not go into a separate file. Do this when pages share referenes to a common Player. Don't want many copies of that Player when bring in. Do not write pages of book out. Write the PasteUpMorph that the entire book lives in."
self setProperty: #keepTogether toValue: true.!
----- Method: BookMorph>>keepingUniformPageSizeString (in category 'uniform page size') -----
keepingUniformPageSizeString
"Answer a string characterizing whether I am currently maintaining uniform page size"
^ (self maintainsUniformPageSize
ifTrue: ['<yes>']
ifFalse: ['<no>']), 'keep all pages the same size' translated!
----- Method: BookMorph>>lastPage (in category 'navigation') -----
lastPage
self goToPage: pages size
!
----- Method: BookMorph>>loadImagesIntoBook (in category 'menu') -----
loadImagesIntoBook
"PowerPoint stores GIF presentations as individual slides named Slide1, Slide2, etc.
Load these into the book. mjg 9/99"
| directory filenumber form newpage |
directory := ((StandardFileMenu oldFileFrom: FileDirectory default)
ifNil: [^nil]) directory.
directory isNil ifTrue: [^nil].
"Start loading 'em up!!"
filenumber := 1.
[directory fileExists: 'Slide' , filenumber asString] whileTrue:
[Transcript
show: 'Slide' , filenumber asString;
cr.
Smalltalk bytesLeft < 1000000
ifTrue:
["Make some room"
(self valueOfProperty: #url) isNil
ifTrue: [self savePagesOnURL]
ifFalse: [self saveAsNumberedURLs]].
form := Form
fromFileNamed: (directory fullNameFor: 'Slide' , filenumber asString).
newpage := PasteUpMorph new extent: form extent.
newpage addMorph: (World drawingClass withForm: form).
self pages addLast: newpage.
filenumber := filenumber + 1].
"After adding all, delete the first page."
self goToPage: 1.
self deletePageBasic.
"Save the book"
(self valueOfProperty: #url) isNil
ifTrue: [self savePagesOnURL]
ifFalse: [self saveAsNumberedURLs]!
----- Method: BookMorph>>maintainsUniformPageSize (in category 'uniform page size') -----
maintainsUniformPageSize
"Answer whether I am currently set up to maintain uniform page size"
^ self uniformPageSize notNil!
----- Method: BookMorph>>maintainsUniformPageSize: (in category 'uniform page size') -----
maintainsUniformPageSize: aBoolean
"Set the property governing whether I maintain uniform page size"
aBoolean
ifFalse:
[self removeProperty: #uniformPageSize]
ifTrue:
[self setProperty: #uniformPageSize toValue: currentPage extent]!
----- Method: BookMorph>>makeMinimalControlsWithColor:title: (in category 'other') -----
makeMinimalControlsWithColor: aColor title: aString
| aButton aColumn aRow but |
aButton _ SimpleButtonMorph new target: self; borderColor: Color black;
color: aColor; borderWidth: 0.
aColumn _ AlignmentMorph newColumn.
aColumn color: aButton color; borderWidth: 0; layoutInset: 0.
aColumn hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
aRow _ AlignmentMorph newRow.
aRow color: aButton color; borderWidth: 0; layoutInset: 0.
aRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
aRow addTransparentSpacerOfSize: 40 at 0.
aRow addMorphBack: (but _ aButton label: ' < ' ; actionSelector: #previousPage).
"copy is OK, since we just made it and it can't own any Players"
but setBalloonText: 'Go to previous page'.
aRow addTransparentSpacerOfSize: 82 at 0.
aRow addMorphBack: (StringMorph contents: aString) lock.
aRow addTransparentSpacerOfSize: 82 at 0.
aButton _ SimpleButtonMorph new target: self; borderColor: Color black;
color: aColor; borderWidth: 0.
aRow addMorphBack: (but _ aButton label: ' > ' ; actionSelector: #nextPage).
but setBalloonText: 'Go to next page'.
aRow addTransparentSpacerOfSize: 40 at 0.
aColumn addMorphBack: aRow.
aColumn setNameTo: 'Page Controls'.
^ aColumn!
----- Method: BookMorph>>makeUniformPageSize (in category 'menu') -----
makeUniformPageSize
"Make all pages be of the same size as the current page."
currentPage ifNil: [^ Beeper beep].
self resizePagesTo: currentPage extent.
newPagePrototype ifNotNil:
[newPagePrototype extent: currentPage extent]!
----- Method: BookMorph>>menuPageSoundFor:event: (in category 'menu') -----
menuPageSoundFor: target event: evt
| tSpec menu |
tSpec _ self transitionSpecFor: target.
menu _ (MenuMorph entitled: 'Choose a sound
(it is now ' translated, tSpec first translated, ')') defaultTarget: target.
SoundService default sampledSoundChoices do:
[:soundName |
menu add: soundName translated target: target
selector: #setProperty:toValue:
argumentList: (Array with: #transitionSpec
with: (tSpec copy at: 1 put: soundName; yourself))].
menu popUpEvent: evt in: self world!
----- Method: BookMorph>>menuPageSoundForAll: (in category 'menu') -----
menuPageSoundForAll: evt
^ self menuPageSoundFor: self event: evt!
----- Method: BookMorph>>menuPageSoundForThisPage: (in category 'menu') -----
menuPageSoundForThisPage: evt
currentPage ifNotNil:
[^ self menuPageSoundFor: currentPage event: evt]!
----- Method: BookMorph>>menuPageVisualFor:event: (in category 'menu') -----
menuPageVisualFor: target event: evt
| tSpec menu subMenu directionChoices |
tSpec _ self transitionSpecFor: target.
menu _ (MenuMorph entitled: ('Choose an effect
(it is now {1})' translated format:{tSpec second asString translated})) defaultTarget: target.
TransitionMorph allEffects do:
[:effect |
directionChoices _ TransitionMorph directionsForEffect: effect.
directionChoices isEmpty
ifTrue: [menu add: effect asString translated target: target
selector: #setProperty:toValue:
argumentList: (Array with: #transitionSpec
with: (Array with: tSpec first with: effect with: #none))]
ifFalse: [subMenu _ MenuMorph new.
directionChoices do:
[:dir |
subMenu add: dir asString translated target: target
selector: #setProperty:toValue:
argumentList: (Array with: #transitionSpec
with: (Array with: tSpec first with: effect with: dir))].
menu add: effect asString translated subMenu: subMenu]].
menu popUpEvent: evt in: self world!
----- Method: BookMorph>>menuPageVisualForAll: (in category 'menu') -----
menuPageVisualForAll: evt
^ self menuPageVisualFor: self event: evt!
----- Method: BookMorph>>menuPageVisualForThisPage: (in category 'menu') -----
menuPageVisualForThisPage: evt
currentPage ifNotNil:
[^ self menuPageVisualFor: currentPage event: evt]!
----- Method: BookMorph>>methodHolderVersions (in category 'scripting') -----
methodHolderVersions
| arrayOfVersions vTimes strings |
"Create lists of times of older versions of all code in MethodMorphs in this book."
arrayOfVersions _ MethodHolders collect: [:mh |
mh versions]. "equality, hash for MethodHolders?"
vTimes _ SortedCollection new.
arrayOfVersions do: [:versionBrowser |
versionBrowser changeList do: [:cr |
(strings _ cr stamp findTokens: ' ') size > 2 ifTrue: [
vTimes add: strings second asDate asSeconds +
strings third asTime asSeconds]]].
VersionTimes _ Time condenseBunches: vTimes.
VersionNames _ Time namesForTimes: VersionTimes.
!
----- Method: BookMorph>>methodHolders (in category 'scripting') -----
methodHolders
| all |
"search for all scripts that are in MethodHolders. These are the ones that have versions."
all _ IdentitySet new.
self allMorphsAndBookPagesInto: all.
all _ all select: [:mm | mm class = MethodMorph].
MethodHolders _ all asArray collect: [:mm | mm model].
!
----- Method: BookMorph>>morphsForPageSorter (in category 'sorting') -----
morphsForPageSorter
| i thumbnails |
'Assembling thumbnail images...'
displayProgressAt: self cursorPoint
from: 0 to: pages size
during:
[:bar | i _ 0.
thumbnails _ pages collect:
[:p | bar value: (i_ i+1).
pages size > 40
ifTrue: [p smallThumbnailForPageSorter inBook: self]
ifFalse: [p thumbnailForPageSorter inBook: self]]].
^ thumbnails!
----- Method: BookMorph>>newPages: (in category 'initialization') -----
newPages: pageList
"Replace all my pages with the given list of BookPageMorphs. After this call, currentPage may be invalid."
pages _ pages species new.
pages addAll: pageList!
----- Method: BookMorph>>newPages:currentIndex: (in category 'initialization') -----
newPages: pageList currentIndex: index
"Replace all my pages with the given list of BookPageMorphs. Make the current page be the page with the given index."
pages _ pages species new.
pages addAll: pageList.
pages isEmpty ifTrue: [^ self insertPage].
self goToPage: index.
!
----- Method: BookMorph>>nextPage (in category 'navigation') -----
nextPage
currentPage isNil ifTrue: [^self goToPage: 1].
self goToPage: (self pageNumberOf: currentPage) + 1!
----- Method: BookMorph>>pageControlsVisible (in category 'menu') -----
pageControlsVisible
^ self hasSubmorphWithProperty: #pageControl!
----- Method: BookMorph>>pageNamed: (in category 'accessing') -----
pageNamed: aName
^ pages detect: [:p | p knownName = aName] ifNone: [nil]!
----- Method: BookMorph>>pageNumber (in category 'navigation') -----
pageNumber
^ self pageNumberOf: currentPage!
----- Method: BookMorph>>pageNumberOf: (in category 'accessing') -----
pageNumberOf: aMorph
"Modified so that if the page IS in memory, other pages don't have to be brought in. (This method may wrongly say a page is not here if pages has a tombstone (MorphObjectOut) and that tombstone would resolve to an object already in this image. This is an unlikely case, and callers just have to tolerate it.)"
^ pages identityIndexOf: aMorph ifAbsent: [0]
!
----- Method: BookMorph>>pages (in category 'accessing') -----
pages
^ pages
!
----- Method: BookMorph>>pages: (in category 'accessing') -----
pages: aMorphList
pages _ aMorphList asOrderedCollection.
"It is tempting to force the first page to be the current page. But then, two pages might be shown at once!! Just trust the copying mechanism and let currentPage be copied correctly. --Ted."!
----- Method: BookMorph>>pagesHandledAutomatically (in category 'printing') -----
pagesHandledAutomatically
^true!
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
| aPage |
aPage _ self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
----- Method: BookMorph>>previousPage (in category 'navigation') -----
previousPage
currentPage isNil ifTrue: [^self goToPage: 1].
self goToPage: (self pageNumberOf: currentPage) - 1!
----- Method: BookMorph>>printPSToFile (in category 'menus') -----
printPSToFile
"Ask the user for a filename and print this morph as postscript."
| fileName rotateFlag |
fileName _ ('MyBook') translated asFileName.
fileName _ FillInTheBlank request: 'File name? (".ps" will be added to end)' translated
initialAnswer: fileName.
fileName isEmpty ifTrue: [^ Beeper beep].
(fileName endsWith: '.ps') ifFalse: [fileName _ fileName,'.ps'].
rotateFlag _ ((PopUpMenu labels:
'portrait (tall)
landscape (wide)' translated)
startUpWithCaption: 'Choose orientation...' translated) = 2.
(FileStream newFileNamed: fileName asFileName)
nextPutAll: (DSCPostscriptCanvas morphAsPostscript: self rotated: rotateFlag); close.
!
----- Method: BookMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
"Release the cached state of all my pages."
super releaseCachedState.
self removeProperty: #allText. "the cache for text search"
pages do: [:page |
page == currentPage ifFalse: [page fullReleaseCachedState]].
!
----- Method: BookMorph>>reload (in category 'menu') -----
reload
"Fetch the pages of this book from the server again. For all pages that have not been modified, keep current ones. Use new pages. For each, look up in cache, if time there is equal to time of new, and its in, use the current morph.
Later do fancy things when a page has changed here, and also on the server."
| url onServer onPgs sq which |
(url _ self valueOfProperty: #url) ifNil: ["for .bo index file"
url _ FillInTheBlank
request: 'url of the place where this book''s index is stored.
Must begin with file:// or ftp://' translated
initialAnswer: (self getStemUrl, '.bo').
url notEmpty ifTrue: [self setProperty: #url toValue: url]
ifFalse: [^ self]].
onServer _ self class new fromURL: url.
"Later: test book times?"
onPgs _ onServer pages collect: [:out |
sq _ SqueakPageCache pageCache at: out url ifAbsent: [nil].
(sq notNil and: [sq contentsMorph isInMemory])
ifTrue: [((out sqkPage lastChangeTime > sq lastChangeTime) or:
[sq contentsMorph isNil])
ifTrue: [SqueakPageCache atURL: out url put: out sqkPage.
out]
ifFalse: [sq contentsMorph]]
ifFalse: [SqueakPageCache atURL: out url put: out sqkPage.
out]].
which _ (onPgs findFirst: [:pg | pg url = currentPage url]) max: 1.
self newPages: onPgs currentIndex: which.
"later stay at current page"
self setProperty: #modTime toValue: (onServer valueOfProperty: #modTime).
self setProperty: #allText toValue: (onServer valueOfProperty: #allText).
self setProperty: #allTextUrls toValue: (onServer valueOfProperty: #allTextUrls).
!
----- Method: BookMorph>>removeEverything (in category 'initialization') -----
removeEverything
currentPage _ nil.
pages _ OrderedCollection new.
self removeAllMorphs!
----- Method: BookMorph>>reserveUrls (in category 'menu') -----
reserveUrls
"Save a dummy version of the book first, assign all pages URLs, write dummy files to reserve the url, and write the index. Good when I have pages with interpointing bookmarks."
| stem |
(stem := self getStemUrl) isEmpty ifTrue: [^self].
pages doWithIndex:
[:pg :ind |
"does write the current page too"
pg url ifNil: [pg reserveUrl: stem , ind printString , '.sp']]
"self saveIndexOnURL."!
----- Method: BookMorph>>reserveUrlsIfNeeded (in category 'menu') -----
reserveUrlsIfNeeded
"See if this book needs to pre-allocate urls. Harmless if have urls already. Actually writes dummy files to reserve names."
| baddies bad2 |
pages size > 25 ifTrue: [^ self reserveUrls].
baddies _ BookPageThumbnailMorph withAllSubclasses.
bad2 _ FlexMorph withAllSubclasses.
pages do: [:aPage |
aPage allMorphsDo: [:mm |
(baddies includes: mm class) ifTrue: [^ self reserveUrls].
(bad2 includes: mm class) ifTrue: [
mm originalMorph class == aPage class ifTrue: [
^ self reserveUrls]]]].
!
----- Method: BookMorph>>resizePagesTo: (in category 'other') -----
resizePagesTo: anExtent
pages do:
[:aPage | aPage extent: anExtent]!
----- Method: BookMorph>>revertToCheckpoint: (in category 'scripting') -----
revertToCheckpoint: secsSince1901
| cngRecord |
"Put all scripts (that appear in MethodPanes) back to the way they were at an earlier time."
MethodHolders do: [:mh |
cngRecord _ mh versions versionFrom: secsSince1901.
cngRecord ifNotNil: [
(cngRecord stamp: Utilities changeStamp) fileIn]].
"does not delete method if no earlier version"
!
----- Method: BookMorph>>saveAsNumberedURLs (in category 'menu') -----
saveAsNumberedURLs
"Write out all pages in this book that are not showing, onto a server. The local disk could be the server. For any page that does not have a SqueakPage and a url already, name that page file by its page number. Any pages that are already totally out will stay that way."
| stem list firstTime |
firstTime := (self valueOfProperty: #url) isNil.
stem := self getStemUrl. "user must approve"
stem isEmpty ifTrue: [^self].
firstTime ifTrue: [self setProperty: #futureUrl toValue: stem , '.bo'].
self reserveUrlsIfNeeded.
pages doWithIndex:
[:aPage :ind |
"does write the current page too"
aPage isInMemory
ifTrue:
["not out now"
aPage presenter ifNotNil: [aPage presenter flushPlayerListCache].
aPage saveOnURL: stem , ind printString , '.sp']].
list := pages collect: [:aPage | aPage sqkPage prePurge].
"knows not to purge the current page"
list := (list select: [:each | each notNil]) asArray.
"do bulk become:"
(list collect: [:each | each contentsMorph])
elementsExchangeIdentityWith: (list
collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]).
self saveIndexOnURL.
self presenter ifNotNil: [self presenter flushPlayerListCache].
firstTime
ifTrue:
["Put a thumbnail into the hand"
URLMorph grabForBook: self.
self setProperty: #futureUrl toValue: nil "clean up"]!
----- Method: BookMorph>>saveIndexOfOnly: (in category 'menu') -----
saveIndexOfOnly: aPage
"Modify the index of this book on a server. Read the index, modify the entry for just this page, and write back. See saveIndexOnURL. (page file names must be unique even if they live in different directories.)"
| mine sf remoteFile strm remote pageURL num pre index after dict allText allTextUrls fName |
mine _ self valueOfProperty: #url.
mine ifNil: [^ self saveIndexOnURL].
Cursor wait showWhile: [strm _ (ServerFile new fullPath: mine)].
strm ifNil: [^ self saveIndexOnURL].
strm isString ifTrue: [^ self saveIndexOnURL].
strm exists ifFalse: [^ self saveIndexOnURL]. "write whole thing if missing"
strm _ strm asStream.
strm isString ifTrue: [^ self saveIndexOnURL].
remote _ strm fileInObjectAndCode.
dict _ remote first.
allText _ dict at: #allText ifAbsent: [nil]. "remote, not local"
allTextUrls _ dict at: #allTextUrls ifAbsent: [nil].
allText size + 1 ~= remote size ifTrue: [self error: '.bo size mismatch. Please tell Ted what you just did to this book.' translated].
(pageURL _ aPage url) ifNil: [self error: 'just had one!!' translated].
fName _ pageURL copyAfterLast: $/.
2 to: remote size do: [:ii |
((remote at: ii) url findString: fName startingAt: 1
caseSensitive: false) > 0 ifTrue: [index _ ii]. "fast"
(remote at: ii) xxxReset].
index ifNil: ["new page, what existing page does it follow?"
num _ self pageNumberOf: aPage.
1 to: num-1 do: [:ii | (pages at: ii) url ifNotNil: [pre _ (pages at: ii) url]].
pre ifNil: [after _ remote size+1]
ifNotNil: ["look for it on disk, put me after"
pre _ pre copyAfterLast: $/.
2 to: remote size do: [:ii |
((remote at: ii) url findString: pre startingAt: 1
caseSensitive: false) > 0 ifTrue: [after _ ii+1]].
after ifNil: [after _ remote size+1]].
remote _ remote copyReplaceFrom: after to: after-1 with: #(1).
allText ifNotNil: [
dict at: #allText put: (allText copyReplaceFrom: after-1 to: after-2 with: #(())).
dict at: #allTextUrls put: (allTextUrls copyReplaceFrom: after-1 to: after-2 with: #(()))].
index _ after].
remote at: index put: (aPage sqkPage copyForSaving).
(dict at: #modTime ifAbsent: [0]) < Time totalSeconds ifTrue:
[dict at: #modTime put: Time totalSeconds].
allText ifNotNil: [
(dict at: #allText) at: index-1 put: (aPage allStringsAfter: nil).
(dict at: #allTextUrls) at: index-1 put: pageURL].
sf _ ServerDirectory new fullPath: mine.
Cursor wait showWhile: [
remoteFile _ sf fileNamed: mine.
remoteFile fileOutClass: nil andObject: remote.
"remoteFile close"].
!
----- Method: BookMorph>>saveIndexOnURL (in category 'menu') -----
saveIndexOnURL
"Make up an index to the pages of this book, with thumbnails, and store it on the server. (aDictionary, aMorphObjectOut, aMorphObjectOut, aMorphObjectOut). The last part corresponds exactly to what pages looks like when they are all out. Each holds onto a SqueakPage, which holds a url and a thumbnail."
| dict list mine sf remoteFile urlList |
pages isEmpty ifTrue: [^self].
dict := Dictionary new.
dict at: #modTime put: Time totalSeconds.
"self getAllText MUST have been called at start of this operation."
dict at: #allText put: (self valueOfProperty: #allText).
#(#color #borderWidth #borderColor #pageSize)
do: [:sel | dict at: sel put: (self perform: sel)].
self reserveUrlsIfNeeded. "should already be done"
list := pages copy. "paste dict on front below"
"Fix up the entries, should already be done"
list doWithIndex:
[:out :ind |
out isInMemory
ifTrue:
[(out valueOfProperty: #SqueakPage) ifNil: [out saveOnURLbasic].
list at: ind put: out sqkPage copyForSaving]].
urlList := list collect: [:ppg | ppg url].
self setProperty: #allTextUrls toValue: urlList.
dict at: #allTextUrls put: urlList.
list := (Array with: dict) , list.
mine := self valueOfProperty: #url.
mine ifNil:
[mine := self getStemUrl , '.bo'.
self setProperty: #url toValue: mine].
sf := ServerDirectory new fullPath: mine.
Cursor wait showWhile:
[remoteFile := sf fileNamed: mine.
remoteFile dataIsValid.
remoteFile fileOutClass: nil andObject: list
"remoteFile close"]!
----- Method: BookMorph>>saveOnUrlPage: (in category 'menu') -----
saveOnUrlPage: pageMorph
"Write out this single page in this book onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)"
| stem ind response rand newPlace dir |
(self valueOfProperty: #keepTogether) ifNotNil: [
self inform: 'This book is marked ''keep in one file''.
Several pages use a common Player.
Save the owner of the book instead.' translated.
^ self].
"Don't give the chance to put in a different place. Assume named by number"
((self valueOfProperty: #url) isNil and: [pages first url notNil]) ifTrue: [
response _ (PopUpMenu labels: 'Old book
New book sharing old pages' translated)
startUpWithCaption: 'Modify the old book, or make a new
book sharing its pages?' translated.
response = 2 ifTrue: [
"Make up new url for .bo file and confirm with user." "Mark as shared"
[rand _ String new: 4.
1 to: rand size do: [:ii |
rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)].
(newPlace _ self getStemUrl) isEmpty ifTrue: [^ self].
newPlace _ (newPlace copyUpToLast: $/), '/BK', rand, '.bo'.
dir _ ServerFile new fullPath: newPlace.
(dir includesKey: dir fileName)] whileTrue. "keep doing until a new file"
self setProperty: #url toValue: newPlace].
response = 0 ifTrue: [^ self]].
stem _ self getStemUrl. "user must approve"
stem isEmpty ifTrue: [^ self].
ind _ pages identityIndexOf: pageMorph ifAbsent: [self error: 'where is the page?' translated].
pageMorph isInMemory ifTrue: ["not out now"
pageMorph saveOnURL: stem,(ind printString),'.sp'].
self saveIndexOfOnly: pageMorph.!
----- Method: BookMorph>>saveOneOnURL (in category 'menu') -----
saveOneOnURL
"Write out this single page onto a server. See savePagesOnURL. (Don't compute the texts, only this page's is written.)"
^ self saveOnUrlPage: currentPage!
----- Method: BookMorph>>savePagesOnURL (in category 'menu') -----
savePagesOnURL
"Write out all pages in this book onto a server. For any page that does not have a SqueakPage and a url already, ask the user for one. Give the option of naming all page files by page number. Any pages that are not in memory will stay that way. The local disk could be the server."
| response list firstTime newPlace rand dir bookUrl |
(self valueOfProperty: #keepTogether) ifNotNil: [
self inform: 'This book is marked ''keep in one file''.
Several pages use a common Player.
Save the owner of the book instead.' translated.
^ self].
self getAllText. "stored with index later"
response _ (PopUpMenu labels: 'Use page numbers
Type in file names
Save in a new place (using page numbers)
Save in a new place (typing names)
Save new book sharing old pages' translated)
startUpWithCaption: 'Each page will be a file on the server.
Do you want to page numbers be the names of the files?
or name each one yourself?' translated.
response = 1 ifTrue: [self saveAsNumberedURLs. ^ self].
response = 3 ifTrue: [self forgetURLs; saveAsNumberedURLs. ^ self].
response = 4 ifTrue: [self forgetURLs].
response = 5 ifTrue: [
"Make up new url for .bo file and confirm with user." "Mark as shared"
[rand _ String new: 4.
1 to: rand size do: [:ii |
rand at: ii put: ('bdfghklmnpqrstvwz' at: 17 atRandom)].
(newPlace _ self getStemUrl) isEmpty ifTrue: [^ self].
newPlace _ (newPlace copyUpToLast: $/), '/BK', rand, '.bo'.
dir _ ServerFile new fullPath: newPlace.
(dir includesKey: dir fileName)] whileTrue. "keep doing until a new file"
self setProperty: #url toValue: newPlace.
self saveAsNumberedURLs.
bookUrl _ self valueOfProperty: #url.
(SqueakPage stemUrl: bookUrl) =
(SqueakPage stemUrl: currentPage url) ifTrue: [
bookUrl _ true]. "not a shared book"
(URLMorph grabURL: currentPage url) book: bookUrl.
^ self].
response = 0 ifTrue: [^ self].
"self reserveUrlsIfNeeded. Need two passes here -- name on one, write on second"
pages do: [:aPage | "does write the current page too"
aPage isInMemory ifTrue: ["not out now"
aPage presenter ifNotNil: [aPage presenter flushPlayerListCache].
aPage saveOnURLbasic.
]]. "ask user if no url"
list _ pages collect: [:aPage | aPage sqkPage prePurge].
"knows not to purge the current page"
list _ (list select: [:each | each notNil]) asArray.
"do bulk become:"
(list collect: [:each | each contentsMorph])
elementsExchangeIdentityWith:
(list collect: [:spg | MorphObjectOut new xxxSetUrl: spg url page: spg]).
firstTime _ (self valueOfProperty: #url) isNil.
self saveIndexOnURL.
self presenter ifNotNil: [self presenter flushPlayerListCache].
firstTime ifTrue: ["Put a thumbnail into the hand"
URLMorph grabForBook: self.
self setProperty: #futureUrl toValue: nil]. "clean up"
!
----- Method: BookMorph>>setAllPagesColor: (in category 'accessing') -----
setAllPagesColor: aColor
"Set the color of all the pages to a new color"
self pages do: [:page | page color: aColor].!
----- Method: BookMorph>>setExtentFromHalo: (in category 'other') -----
setExtentFromHalo: anExtent
"The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed. For a BookMorph, we assume any resizing attempt is a request that the book-page currently being viewed be resized accoringly; this will typically not affect unseen book pages, though there is a command that can be issued to harmonize all book-page sizes, and also an option to set that will maintain all pages at the same size no matter what."
currentPage isInWorld
ifFalse: "doubtful case mostly"
[super setExtentFromHalo: anExtent]
ifTrue:
[currentPage width: anExtent x.
currentPage height: (anExtent y - (self innerBounds height - currentPage height)).
self maintainsUniformPageSize ifTrue:
[self setProperty: #uniformPageSize toValue: currentPage extent]]!
----- Method: BookMorph>>setInitialState (in category 'initialization') -----
setInitialState
self listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 5.
pageSize _ 160 @ 300.
self enableDragNDrop!
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
[newPagePrototype _ currentPage veryDeepCopy].
!
----- Method: BookMorph>>setPageColor (in category 'menu') -----
setPageColor
"Get a color from the user, then set all the pages to that color"
self currentPage ifNil: [^ self].
ColorPickerMorph new
choseModalityFromPreference;
sourceHand: self activeHand;
target: self;
selector: #setAllPagesColor:;
originalColor: self currentPage color;
putUpFor: self near: self fullBoundsInWorld!
----- Method: BookMorph>>setWrapPages: (in category 'navigation') -----
setWrapPages: doWrap
doWrap
ifTrue: [self removeProperty: #dontWrapAtEnd]
ifFalse: [self setProperty: #dontWrapAtEnd toValue: true].
!
----- Method: BookMorph>>showMoreControls (in category 'navigation') -----
showMoreControls
self currentEvent shiftPressed
ifTrue:
[self hidePageControls]
ifFalse:
[self showPageControls: self fullControlSpecs]!
----- Method: BookMorph>>sortPages (in category 'menu commands') -----
sortPages
currentPage ifNotNil: [currentPage updateCachedThumbnail].
^ super sortPages!
----- Method: BookMorph>>sortPages: (in category 'sorting') -----
sortPages: evt
^ self sortPages!
----- Method: BookMorph>>textSearch (in category 'menu') -----
textSearch
"search the text on all pages of this book"
| wanted wants list str |
list _ self valueOfProperty: #searchKey ifAbsent: [#()].
str _ String streamContents: [:strm |
list do: [:each | strm nextPutAll: each; space]].
wanted _ FillInTheBlank request: 'words to search for. Order is not important.
Beginnings of words are OK.' translated
initialAnswer: str.
wants _ wanted findTokens: Character separators.
wants isEmpty ifTrue: [^ self].
self getAllText. "save in allText, allTextUrls"
^ self findText: wants "goes to the page and highlights the text"!
----- Method: BookMorph>>textSearch: (in category 'menu') -----
textSearch: stringWithKeys
"search the text on all pages of this book"
| wants |
wants := stringWithKeys findTokens: Character separators.
wants isEmpty ifTrue: [^self].
self getAllText. "save in allText, allTextUrls"
^self findText: wants "goes to the page and highlights the text"!
----- Method: BookMorph>>thumbnailForThisPage (in category 'menu') -----
thumbnailForThisPage
self primaryHand attachMorph:
(currentPage thumbnailForPageSorter pageMorph: currentPage inBook: self)
!
----- Method: BookMorph>>toggleFullScreen (in category 'menu') -----
toggleFullScreen
self isInFullScreenMode
ifTrue: [self exitFullScreen]
ifFalse: [self goFullScreen]!
----- Method: BookMorph>>toggleMaintainUniformPageSize (in category 'uniform page size') -----
toggleMaintainUniformPageSize
"Toggle whether or not the receiver should maintain uniform page size"
self maintainsUniformPageSize: self maintainsUniformPageSize not!
----- Method: BookMorph>>toggleShowingOfPageControls (in category 'menu') -----
toggleShowingOfPageControls
self pageControlsVisible
ifTrue: [self hidePageControls]
ifFalse: [self showPageControls]!
----- Method: BookMorph>>transitionSpecFor: (in category 'navigation') -----
transitionSpecFor: aMorph
^ aMorph valueOfProperty: #transitionSpec " check for special propety"
ifAbsent: [Array with: 'camera' " ... otherwise this is the default"
with: #none
with: #none]!
----- Method: BookMorph>>uncachePageSorter (in category 'menu') -----
uncachePageSorter
pages do: [:aPage | aPage removeProperty: #cachedThumbnail].!
----- Method: BookMorph>>uniformPageSize (in category 'uniform page size') -----
uniformPageSize
"Answer the uniform page size to maintain, or nil if the option is not set"
^ self valueOfProperty: #uniformPageSize ifAbsent: [nil]!
----- Method: BookMorph>>updateReferencesUsing: (in category 'copying') -----
updateReferencesUsing: aDictionary
super updateReferencesUsing: aDictionary.
pages do: [:page |
page allMorphsDo: [:m | m updateReferencesUsing: aDictionary]].
!
----- Method: BookMorph>>userString (in category 'accessing') -----
userString
"Do I have a text string to be searched on?"
| list |
self getAllText.
list _ OrderedCollection new.
(self valueOfProperty: #allText ifAbsent: #()) do: [:aList |
list addAll: aList].
^ list!
----- Method: BookMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
(currentPage bounds containsPoint: (self pointFromWorld: evt cursorPoint)) ifFalse: [^ false].
^ super wantsDroppedMorph: aMorph event: evt!
BookMorph subclass: #StoryboardBookMorph
instanceVariableNames: 'alansSliders panAndTiltFactor zoomFactor zoomController'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
!StoryboardBookMorph commentStamp: '<historical>' prior: 0!
A BookMorph variant whose pages are instances of ZoomAndScrollMorph. I have a control area where the user may pan, tilt and zoom over the image shown in the page.
- drag up and down to zoom in and out
- drag left and right to pan
- shift-drag up and down to tilt.!
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
^ self partName: 'Storyboard'
categories: #('Presentation')
documentation: 'A storyboard authoring tool'!
----- Method: StoryboardBookMorph>>changeTiltFactor: (in category 'as yet unclassified') -----
changeTiltFactor: x
currentPage changeTiltFactor: x.
panAndTiltFactor _ x.
!
----- Method: StoryboardBookMorph>>changeZoomFactor: (in category 'as yet unclassified') -----
changeZoomFactor: x
currentPage changeZoomFactor: x.
zoomFactor _ x.!
----- Method: StoryboardBookMorph>>getTiltFactor (in category 'as yet unclassified') -----
getTiltFactor
^panAndTiltFactor ifNil: [panAndTiltFactor _ 0.5].!
----- Method: StoryboardBookMorph>>getZoomFactor (in category 'as yet unclassified') -----
getZoomFactor
^zoomFactor ifNil: [zoomFactor _ 0.5]!
----- Method: StoryboardBookMorph>>initialize (in category 'initialization') -----
initialize
newPagePrototype _ ZoomAndScrollMorph new extent: Display extent // 3.
zoomController _ ZoomAndScrollControllerMorph new
setBalloonText: 'Drag in here to zoom, tilt and pan the page above'.
super initialize.
self addMorphBack: zoomController.
alansSliders _ {
{#changeTiltFactor: . #getTiltFactor . 'Pan and tilt sensitivity'}.
{#changeZoomFactor: . #getZoomFactor . 'Zoom sensitivity'}.
} collect: [ :sData |
{
SimpleSliderMorph new
extent: 150 at 10;
color: Color orange;
sliderColor: Color gray;
target: self;
actionSelector: sData first;
setBalloonText: sData third;
adjustToValue: (self perform: sData second).
sData second
}
].
alansSliders do: [ :each | self addMorphBack: each first]
!
----- Method: StoryboardBookMorph>>insertPageMorphInCorrectSpot: (in category 'navigation') -----
insertPageMorphInCorrectSpot: aPageMorph
"Insert the page morph at the correct spot"
| place |
place _ submorphs size > 1 ifTrue: [submorphs second] ifFalse: [submorphs first].
"Old architecture had a tiny spacer morph as the second morph; now architecture does not"
self addMorph: (currentPage _ aPageMorph) behind: place.
self changeTiltFactor: self getTiltFactor.
self changeZoomFactor: self getZoomFactor.
zoomController target: currentPage.
!
----- Method: StoryboardBookMorph>>offsetX (in category 'as yet unclassified') -----
offsetX
^currentPage offsetX!
----- Method: StoryboardBookMorph>>offsetX: (in category 'as yet unclassified') -----
offsetX: aNumber
currentPage offsetX: aNumber!
----- Method: StoryboardBookMorph>>offsetY (in category 'as yet unclassified') -----
offsetY
^currentPage offsetY!
----- Method: StoryboardBookMorph>>offsetY: (in category 'as yet unclassified') -----
offsetY: aNumber
currentPage offsetY: aNumber!
----- Method: StoryboardBookMorph>>scale (in category 'as yet unclassified') -----
scale
^currentPage scale!
----- Method: StoryboardBookMorph>>scale: (in category 'as yet unclassified') -----
scale: aValue
currentPage scale: aValue!
----- Method: BooklikeMorph class>>initialize (in category 'class initialization') -----
initialize
"BooklikeMorph initialize"
PageFlipSoundOn _ true
!
----- Method: BooklikeMorph class>>turnOffSoundWhile: (in category 'as yet unclassified') -----
turnOffSoundWhile: aBlock
"Turn off page flip sound during the given block."
| old |
old _ PageFlipSoundOn.
PageFlipSoundOn _ false.
aBlock value.
PageFlipSoundOn _ old!
----- Method: BooklikeMorph>>addBookMenuItemsTo:hand: (in category 'misc') -----
addBookMenuItemsTo: aCustomMenu hand: aHandMorph
(self hasSubmorphWithProperty: #pageControl)
ifTrue: [aCustomMenu add: 'hide page controls' translated action: #hidePageControls]
ifFalse: [aCustomMenu add: 'show page controls' translated action: #showPageControls]!
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
----- Method: BooklikeMorph>>addPageControlMorph: (in category 'page controls') -----
addPageControlMorph: aMorph
"Add the morph provided as a page control, at the appropriate place"
aMorph setProperty: #pageControl toValue: true.
self addMorph: aMorph asElementNumber: self indexForPageControls!
----- Method: BooklikeMorph>>clearNewPagePrototype (in category 'menu commands') -----
clearNewPagePrototype
newPagePrototype _ nil
!
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage _ self currentPage) ifNil: [^ self].
(aPlayer _ aPage player) ifNotNil:
[aBlock value: aPlayer]!
----- Method: BooklikeMorph>>fewerPageControls (in category 'page controls') -----
fewerPageControls
self currentEvent shiftPressed
ifTrue:
[self hidePageControls]
ifFalse:
[self showPageControls: self shortControlSpecs]!
----- Method: BooklikeMorph>>firstPage (in category 'menu commands') -----
firstPage
self goToPage: 1!
----- Method: BooklikeMorph>>fullControlSpecs (in category 'page controls') -----
fullControlSpecs
^ {
#spacer.
#variableSpacer.
{'-'. #deletePage. 'Delete this page' translated}.
#spacer.
{'«'. #firstPage. 'First page' translated}.
#spacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
{'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
{ '»'. #lastPage. 'Final page' translated}.
#spacer.
{'+'. #insertPage. 'Add a new page after this one' translated}.
#variableSpacer.
{'³'. #fewerPageControls. 'Fewer controls' translated}
}
!
----- Method: BooklikeMorph>>hidePageControls (in category 'page controls') -----
hidePageControls
"Delete all submorphs answering to the property #pageControl"
self deleteSubmorphsWithProperty: #pageControl!
----- Method: BooklikeMorph>>indexForPageControls (in category 'page controls') -----
indexForPageControls
"Answer which submorph should hold the page controls"
^ (submorphs size > 0 and: [submorphs first hasProperty: #header])
ifTrue: [2]
ifFalse: [1]!
----- Method: BooklikeMorph>>insertPage (in category 'menu commands') -----
insertPage
self insertPageColored: self color!
----- Method: BooklikeMorph>>makePageControlsFrom: (in category 'page controls') -----
makePageControlsFrom: controlSpecs
"From the controlSpecs, create a set of page control and return them -- this method does *not* add the controls to the receiver."
| c col row b lastGuy |
c _ (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker].
col _ AlignmentMorph newColumn.
col color: c; borderWidth: 0; layoutInset: 0.
col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5 at 5.
row _ AlignmentMorph newRow.
row color: c; borderWidth: 0; layoutInset: 0.
row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5 at 5.
controlSpecs do: [:spec |
spec == #spacer
ifTrue:
[row addTransparentSpacerOfSize: (10 @ 0)]
ifFalse:
[spec == #variableSpacer
ifTrue:
[row addMorphBack: AlignmentMorph newVariableTransparentSpacer]
ifFalse:
[b _ SimpleButtonMorph new target: self; borderWidth: 1;
borderColor: Color veryLightGray; color: c.
b label: spec first;
actionSelector: spec second;
borderWidth: 0;
setBalloonText: spec third.
row addMorphBack: b.
(((lastGuy _ spec last asLowercase) includesSubString: 'menu') or:
[lastGuy includesSubString: 'designations'])
ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown"
col addMorphBack: row.
^ col!
----- Method: BooklikeMorph>>move (in category 'misc') -----
move
(owner isWorldMorph and:[self isSticky not]) ifTrue: [self activeHand grabMorph: self]!
----- Method: BooklikeMorph>>pageSize (in category 'misc') -----
pageSize
^ pageSize
!
----- Method: BooklikeMorph>>pageSize: (in category 'misc') -----
pageSize: aPoint
pageSize _ aPoint!
----- Method: BooklikeMorph>>playPageFlipSound: (in category 'misc') -----
playPageFlipSound: soundName
self presenter ifNil: [^ self]. "Avoid failures when called too early"
PageFlipSoundOn "mechanism to suppress sounds at init time"
ifTrue: [self playSoundNamed: soundName].
!
----- Method: BooklikeMorph>>setEventHandlerForPageControls: (in category 'page controls') -----
setEventHandlerForPageControls: controls
"Set the controls' event handler if appropriate. Default is to let the tool be dragged by the controls"
controls eventHandler: (EventHandler new on: #mouseDown send: #move to: self)!
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
{'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
{'³'. #showMoreControls. 'More controls' translated}
}
!
----- Method: BooklikeMorph>>showPageControls (in category 'page controls') -----
showPageControls
self showPageControls: self shortControlSpecs!
----- Method: BooklikeMorph>>showPageControls: (in category 'page controls') -----
showPageControls: controlSpecs
"Remove any existing page controls, and add fresh controls at the top of the receiver (or in position 2 if the receiver's first submorph is one with property #header). Add a single column of controls."
| pageControls column |
self hidePageControls.
column _ AlignmentMorph newColumn beTransparent.
pageControls _ self makePageControlsFrom: controlSpecs.
pageControls borderWidth: 0; layoutInset: 4.
pageControls beSticky.
pageControls setNameTo: 'Page Controls'.
self setEventHandlerForPageControls: pageControls.
column addMorphBack: pageControls.
self addPageControlMorph: column!
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
^ (self isInFullScreenMode
ifTrue: ['exit full screen']
ifFalse: ['show full screen']) translated!
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
^ (self pageControlsVisible
ifTrue: ['hide page controls']
ifFalse: ['show page controls']) translated!
----- Method: BooklikeMorph>>sortPages (in category 'menu commands') -----
sortPages
| sorter |
sorter _ BookPageSorterMorph new
book: self morphsToSort: self morphsForPageSorter.
sorter pageHolder cursor: self pageNumber.
"Align at bottom right of screen, but leave 20-pix margin."
self bottom + sorter height < Display height ifTrue: "Place it below if it fits"
[^ self world addMorphFront: (sorter align: sorter topLeft with: self bottomLeft)].
self right + sorter width < Display width ifTrue: "Place it below if it fits"
[^ self world addMorphFront: (sorter align: sorter bottomLeft with: self bottomRight)].
"Otherwise, place it at lower right of screen"
self world addMorphFront: (sorter position: Display extent - (20 at 20) - sorter extent).
!
AlignmentMorph subclass: #FloatingBookControlsMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
----- Method: FloatingBookControlsMorph>>defaultBorderWidth (in category 'initialization') -----
defaultBorderWidth
"answer the default border width for the receiver"
^ 1!
----- Method: FloatingBookControlsMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 0;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap !
----- Method: FloatingBookControlsMorph>>morphicLayerNumber (in category 'WiW support') -----
morphicLayerNumber
"helpful for insuring some morphs always appear in front of or behind others.
smaller numbers are in front"
^23 "page controls are behind menus and balloons, but in front of most other stuff"!
----- Method: FloatingBookControlsMorph>>step (in category 'stepping and presenter') -----
step
owner == self world ifFalse: [^ self].
owner addMorphInLayer: self.
!
----- Method: FloatingBookControlsMorph>>stepTime (in category 'testing') -----
stepTime
^1000!
----- Method: FloatingBookControlsMorph>>wantsSteps (in category 'testing') -----
wantsSteps
^true!
PluggableTextMorph subclass: #MethodMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicBooks'!
----- Method: MethodMorph class>>defaultNameStemForInstances (in category 'as yet unclassified') -----
defaultNameStemForInstances
^ 'Method'!
----- Method: MethodMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
"Not to be instantiated from the menu"
^ false!
----- Method: MethodMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
self useRoundedCorners!
----- Method: MethodMorph>>installRollBackButtons: (in category 'as yet unclassified') -----
installRollBackButtons: target
| mine |
"If I don't already have such a button, put one in at the upper right. Set its target to the furtherest enclosing book. Send chooseAndRevertToVersion when clicked. Stay in place via scrollBar install."
mine := self submorphNamed: #chooseAndRevertToVersion ifNone: [nil].
mine ifNil: [mine := SimpleButtonMorph new.
"mine height: mine height - 2."
mine label: 'Roll Back'; cornerStyle: #square.
mine color: Color white; borderColor: Color black.
mine actionSelector: #chooseAndRevertToVersion.
mine align: mine topRight with: (self findA: ScrollBar) topLeft +(1 at 1).
self addMorphFront: mine.
mine height: mine height - 5 "14"].
mine target: target.!
----- Method: MethodMorph>>showScrollBar (in category 'scrolling') -----
showScrollBar
"Copied down and modified to get rid of the ruinous comeToFront of the inherited version."
| scriptor |
(submorphs includes: scrollBar)
ifTrue: [^ self].
self vResizeScrollBar.
self privateAddMorph: scrollBar atIndex: 1.
retractableScrollBar
ifTrue:
["Bring the pane to the front so that it is fully visible"
"self comeToFront. -- thanks but no thanks"
(scriptor := self ownerThatIsA: ScriptEditorMorph)
ifNotNil:
[scriptor comeToFront]]
ifFalse: [self resetExtent]!
----- Method: MethodMorph>>step (in category 'stepping and presenter') -----
step
model updateCodePaneIfNeeded!
----- Method: MethodMorph>>stepTime (in category 'testing') -----
stepTime
^ 3000!
More information about the Packages
mailing list