[squeak-dev] The Inbox: MorphicExtras-eem.322.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:14:51 UTC 2022
A new version of MorphicExtras was added to project The Inbox: http://source.squeak.org/inbox/MorphicExtras-eem.322.mcz ==================== Summary ==================== Name: MorphicExtras-eem.322 Author: eem Time: 13 July 2022, 4:43:20.802912 pm UUID: 69a2e55e-f910-4b9d-94c4-4823da5ed28b Ancestors: MorphicExtras-eem.321 Much nicer display of the WebCamMorph when it is off; Transparent light grey rather than invisible. =============== Diff against MorphicExtras-eem.321 =============== Item was removed: - SystemOrganization addCategory: #'MorphicExtras-AdditionalMorphs'! - SystemOrganization addCategory: #'MorphicExtras-AdditionalSupport'! - SystemOrganization addCategory: #'MorphicExtras-AdditionalWidgets'! - SystemOrganization addCategory: #'MorphicExtras-Books'! - SystemOrganization addCategory: #'MorphicExtras-Demo'! - SystemOrganization addCategory: #'MorphicExtras-EToy-Download'! - SystemOrganization addCategory: #'MorphicExtras-Exceptions'! - SystemOrganization addCategory: #'MorphicExtras-Flaps'! - SystemOrganization addCategory: #'MorphicExtras-GeeMail'! - SystemOrganization addCategory: #'MorphicExtras-Leds'! - SystemOrganization addCategory: #'MorphicExtras-Navigators'! - SystemOrganization addCategory: #'MorphicExtras-Obsolete'! - SystemOrganization addCategory: #'MorphicExtras-Palettes'! - SystemOrganization addCategory: #'MorphicExtras-PartsBin'! - SystemOrganization addCategory: #'MorphicExtras-Postscript Canvases'! - SystemOrganization addCategory: #'MorphicExtras-Postscript Filters'! - SystemOrganization addCategory: #'MorphicExtras-SoundInterface'! - SystemOrganization addCategory: #'MorphicExtras-SqueakPage'! - SystemOrganization addCategory: #'MorphicExtras-Support'! - SystemOrganization addCategory: #'MorphicExtras-Text Support'! - SystemOrganization addCategory: #'MorphicExtras-Undo'! - SystemOrganization addCategory: #'MorphicExtras-WebCam'! - SystemOrganization addCategory: #'MorphicExtras-Widgets'! Item was removed: - ----- Method: AIFFFileReader>>edit (in category '*MorphicExtras-Sound') ----- - edit - - | ed | - ed := WaveEditor new. - ed data: channelData first. - ed loopEnd: markers last last. - ed loopLength: (markers last last - markers first last) + 1. - ed openInWorld. - ! Item was removed: - RectangleMorph subclass: #AbstractMediaEventMorph - instanceVariableNames: 'startTimeInScore endTimeInScore' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !AbstractMediaEventMorph commentStamp: '<historical>' prior: 0! - An abstract representation of media events to be placed in a PianoRollScoreMorph (or others as they are developed)! Item was removed: - ----- Method: AbstractMediaEventMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: AbstractMediaEventMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color paleYellow! Item was removed: - ----- Method: AbstractMediaEventMorph>>endTime (in category 'accessing') ----- - endTime - - ^endTimeInScore ifNil: [startTimeInScore + 100]! Item was removed: - ----- Method: AbstractMediaEventMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self layoutPolicy: TableLayout new; - listDirection: #leftToRight; - wrapCentering: #topLeft; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 2; - rubberBandCells: true! Item was removed: - ----- Method: AbstractMediaEventMorph>>justDroppedIntoPianoRoll:event: (in category 'piano rolls') ----- - justDroppedIntoPianoRoll: pianoRoll event: evt - - | ambientEvent | - startTimeInScore := pianoRoll timeForX: self left. - - ambientEvent := AmbientEvent new - morph: self; - time: startTimeInScore. - - pianoRoll score addAmbientEvent: ambientEvent. - - "self endTime > pianoRoll scorePlayer durationInTicks ifTrue: - [pianoRoll scorePlayer updateDuration]" - ! Item was removed: - ----- Method: AbstractSound>>viewSamples (in category '*MorphicExtras-Sound') ----- - viewSamples - "Open a WaveEditor on my samples." - - WaveEditor openOn: self samples. - ! Item was removed: - ----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - "Extra items for parts bins" - - ^ {DescriptionForPartsBin - formalName: 'Column' translatedNoop - categoryList: #() - documentation: 'An object that presents the things within it in a column' translatedNoop - globalReceiverSymbol: #AlignmentMorph - nativitySelector: #columnPrototype. - DescriptionForPartsBin - formalName: 'Row' translatedNoop - categoryList: #() - documentation: 'An object that presents the things within it in a row' translatedNoop - globalReceiverSymbol: #AlignmentMorph - nativitySelector: #rowPrototype}! Item was removed: - ----- Method: AlignmentMorph>>basicInitialize (in category '*MorphicExtras-initialization') ----- - basicInitialize - "Do basic generic initialization of the instance variables" - super basicInitialize. - "" - self layoutPolicy: TableLayout new; - listDirection: #leftToRight; - wrapCentering: #topLeft; - hResizing: #spaceFill; - vResizing: #spaceFill; - layoutInset: 2; - rubberBandCells: true! Item was removed: - AlignmentMorph subclass: #AlignmentMorphBob1 - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalSupport'! - - !AlignmentMorphBob1 commentStamp: 'sm 8/12/2009 22:34' prior: 0! - A quick and easy way to space things vertically in absolute or proportional amounts.! Item was removed: - ----- Method: AlignmentMorphBob1>>acceptDroppingMorph:event: (in category 'dropping/grabbing') ----- - acceptDroppingMorph: aMorph event: evt - - | handlerForDrops | - - handlerForDrops := self valueOfProperty: #handlerForDrops ifAbsent: [ - ^super acceptDroppingMorph: aMorph event: evt - ]. - (handlerForDrops acceptDroppingMorph: aMorph event: evt inMorph: self) ifFalse: [ - aMorph rejectDropMorphEvent: evt. "send it back where it came from" - ].! Item was removed: - ----- Method: AlignmentMorphBob1>>addAColumn: (in category 'ui construction') ----- - addAColumn: aCollectionOfMorphs - - | col | - col := self inAColumn: aCollectionOfMorphs. - self addMorphBack: col. - ^col! Item was removed: - ----- Method: AlignmentMorphBob1>>addARow: (in category 'ui construction') ----- - addARow: aCollectionOfMorphs - - | row | - row := self inARow: aCollectionOfMorphs. - self addMorphBack: row. - ^row! Item was removed: - ----- Method: AlignmentMorphBob1>>addARowCentered: (in category 'ui construction') ----- - addARowCentered: aCollectionOfMorphs - - ^(self addARow: aCollectionOfMorphs) - hResizing: #shrinkWrap; - wrapCentering: #center; - cellPositioning: #leftCenter! Item was removed: - ----- Method: AlignmentMorphBob1>>addARowCentered:cellInset: (in category 'ui construction') ----- - addARowCentered: aCollectionOfMorphs cellInset: cellInsetInteger - - ^(self addARow: aCollectionOfMorphs) - hResizing: #shrinkWrap; - wrapCentering: #center; - cellPositioning: #leftCenter; - cellInset: cellInsetInteger! Item was removed: - ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'ui construction') ----- - fancyText: aString font: aFont color: aColor - | answer tm col | - col := Preferences menuAppearance3d - ifTrue: [aColor] - ifFalse: [aColor negated]. - tm := TextMorph new. - tm beAllFont: aFont; - color: col; - contents: aString. - answer := self inAColumn: {tm}. - Preferences menuAppearance3d - ifTrue: ["" - tm addDropShadow. - tm shadowPoint: 5 @ 5 + tm bounds center]. - tm lock. - ^ answer! Item was removed: - ----- Method: AlignmentMorphBob1>>fullDrawOn: (in category 'drawing') ----- - fullDrawOn: aCanvas - - | mask | - (aCanvas isVisible: self fullBounds) ifFalse:[^self]. - super fullDrawOn: aCanvas. - mask := self valueOfProperty: #disabledMaskColor ifAbsent: [^self]. - aCanvas fillRectangle: bounds color: mask. - ! Item was removed: - ----- Method: AlignmentMorphBob1>>inAColumn: (in category 'ui construction') ----- - inAColumn: aCollectionOfMorphs - - | col | - col := AlignmentMorph newColumn - color: Color transparent; - vResizing: #shrinkWrap; - layoutInset: 1; - wrapCentering: #center; - cellPositioning: #topCenter. - aCollectionOfMorphs do: [ :each | col addMorphBack: each]. - ^col! Item was removed: - ----- Method: AlignmentMorphBob1>>inARightColumn: (in category 'ui construction') ----- - inARightColumn: aCollectionOfMorphs - | col | - col := AlignmentMorph newColumn color: Color transparent; - vResizing: #shrinkWrap; - layoutInset: 1; - wrapCentering: #bottomRight; - cellPositioning: #topCenter. - aCollectionOfMorphs - do: [:each | col addMorphBack: each]. - ^ col! Item was removed: - ----- Method: AlignmentMorphBob1>>inARow: (in category 'ui construction') ----- - inARow: aCollectionOfMorphs - | row | - row := AlignmentMorph newRow color: Color transparent; - vResizing: #shrinkWrap; - layoutInset: 2; - wrapCentering: #center; - cellPositioning: #leftCenter. - aCollectionOfMorphs - do: [:each | each ifNotNil: [row addMorphBack: each]]. - ^ row! Item was removed: - ----- Method: AlignmentMorphBob1>>initialize (in category 'initialization') ----- - initialize - super initialize. - self listDirection: #topToBottom. - self layoutInset: 0. - self hResizing: #rigid. "... this is very unlikely..." - self vResizing: #rigid! Item was removed: - ----- Method: AlignmentMorphBob1>>simpleToggleButtonFor:attribute:help: (in category 'ui construction') ----- - simpleToggleButtonFor: target attribute: attribute help: helpText - - ^(Smalltalk at: #EtoyUpdatingThreePhaseButtonMorph ifAbsent:[^Morph new]) - checkBox - target: target; - actionSelector: #toggleChoice:; - arguments: {attribute}; - getSelector: #getChoice:; - setBalloonText: helpText; - step - - ! Item was removed: - ----- Method: AlignmentMorphBob1>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - - | handlerForDrops | - - handlerForDrops := self valueOfProperty: #handlerForDrops ifAbsent: [ - ^super wantsDroppedMorph: aMorph event: evt - ]. - ^handlerForDrops wantsDroppedMorph: aMorph event: evt inMorph: self! Item was removed: - EllipseMorph subclass: #AtomMorph - instanceVariableNames: 'velocity' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !AtomMorph commentStamp: 'tbn 11/25/2004 09:06' prior: 0! - AtomMorph represents an atom used in the simulation of - an ideal gas. It's container is typically a BouncingAtomsMorph. - - Try: - - BouncingAtomsMorph new openInWorld - - to open the gas simulation or: - - AtomMorph example - - to open an instance in the current world! Item was removed: - ----- Method: AtomMorph class>>example (in category 'examples') ----- - example - " - AtomMorph example - " - |a world| - world := Project current world. - a := AtomMorph new openInWorld. - a color: Color random. - [1000 timesRepeat: [a bounceIn: world bounds. (Delay forMilliseconds: 50) wait]. - a delete] fork.! Item was removed: - ----- Method: AtomMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Not to be instantiated from the menu" - ^ false! Item was removed: - ----- Method: AtomMorph>>bounceIn: (in category 'private') ----- - bounceIn: aRect - "Move this atom one step along its velocity vector and make it bounce if it goes outside the given rectangle. Return true if it is bounced." - - | p vx vy px py bounced | - p := self position. - vx := velocity x. vy := velocity y. - px := p x + vx. py := p y + vy. - bounced := false. - px > aRect right ifTrue: [ - px := aRect right - (px - aRect right). - vx := velocity x negated. - bounced := true]. - py > aRect bottom ifTrue: [ - py := aRect bottom - (py - aRect bottom). - vy := velocity y negated. - bounced := true]. - px < aRect left ifTrue: [ - px := aRect left - (px - aRect left). - vx := velocity x negated. - bounced := true]. - py < aRect top ifTrue: [ - py := aRect top - (py - aRect top). - vy := velocity y negated. - bounced := true]. - self position: px @ py. - bounced ifTrue: [self velocity: vx @ vy]. - ^ bounced - ! Item was removed: - ----- Method: AtomMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 0! Item was removed: - ----- Method: AtomMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color blue! Item was removed: - ----- Method: AtomMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Note: Set 'drawAsRect' to true to make the atoms draw faster. When testing the speed of other aspects of Morphic, such as its damage handling efficiency for large numbers of atoms, it is useful to make drawing faster." - - | drawAsRect | - drawAsRect := false. "rectangles are faster to draw" - drawAsRect - ifTrue: [aCanvas fillRectangle: self bounds color: color] - ifFalse: [super drawOn: aCanvas].! Item was removed: - ----- Method: AtomMorph>>infected (in category 'accessing') ----- - infected - - ^ color = Color red! Item was removed: - ----- Method: AtomMorph>>infected: (in category 'accessing') ----- - infected: aBoolean - - aBoolean - ifTrue: [self color: Color red] - ifFalse: [self color: Color blue].! Item was removed: - ----- Method: AtomMorph>>initialize (in category 'initialization') ----- - initialize - "Make a new atom with a random position and velocity." - super initialize. - "" - self extent: 8 @ 7. - - self - randomPositionIn: (0 @ 0 corner: 300 @ 300) - maxVelocity: 10! Item was removed: - ----- Method: AtomMorph>>randomPositionIn:maxVelocity: (in category 'initialization') ----- - randomPositionIn: aRectangle maxVelocity: maxVelocity - "Give this atom a random position and velocity." - - | origin extent | - origin := aRectangle origin. - extent := (aRectangle extent - self bounds extent) rounded. - self position: - (origin x + extent x atRandom) @ - (origin y + extent y atRandom). - velocity := - (maxVelocity - (2 * maxVelocity) atRandom) @ - (maxVelocity - (2 * maxVelocity) atRandom). - ! Item was removed: - ----- Method: AtomMorph>>velocity (in category 'accessing') ----- - velocity - - ^ velocity! Item was removed: - ----- Method: AtomMorph>>velocity: (in category 'accessing') ----- - velocity: newVelocity - - velocity := newVelocity.! Item was removed: - TransformationMorph subclass: #BOBTransformationMorph - instanceVariableNames: 'worldBoundsToShow useRegularWarpBlt' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalSupport'! Item was removed: - ----- Method: BOBTransformationMorph>>adjustAfter: (in category 'private') ----- - adjustAfter: changeBlock - "Cause this morph to remain cetered where it was before, and - choose appropriate smoothing, after a change of scale or rotation." - | | - - "oldRefPos := self referencePosition." - changeBlock value. - self chooseSmoothing. - "self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)]." - self layoutChanged. - owner ifNotNil: [owner invalidRect: bounds] - ! Item was removed: - ----- Method: BOBTransformationMorph>>changeWorldBoundsToShow: (in category 'geometry') ----- - changeWorldBoundsToShow: aRectangle - - aRectangle area = 0 ifTrue: [^self]. - worldBoundsToShow := aRectangle. - owner myWorldChanged.! Item was removed: - ----- Method: BOBTransformationMorph>>drawSubmorphsOn: (in category 'drawing') ----- - drawSubmorphsOn: aCanvas - - | t | - t := [ - self drawSubmorphsOnREAL: aCanvas - ] timeToRun. - "Q1 at: 3 put: t." - ! Item was removed: - ----- Method: BOBTransformationMorph>>drawSubmorphsOnREAL: (in category 'drawing') ----- - drawSubmorphsOnREAL: aCanvas - - | newClip | - - (self innerBounds intersects: aCanvas clipRect) ifFalse: [^self]. - newClip := ((self innerBounds intersect: aCanvas clipRect) expandBy: 1) truncated. - useRegularWarpBlt == true ifTrue: [ - transform scale asFloat = 1.0 ifFalse: [ - newClip := self innerBounds. "avoids gribblies" - ]. - ^aCanvas - transformBy: transform - clippingTo: newClip - during: [:myCanvas | - submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] - ] - smoothing: smoothing - ]. - aCanvas - transform2By: transform "#transformBy: for pure WarpBlt" - clippingTo: newClip - during: [:myCanvas | - submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] - ] - smoothing: smoothing - ! Item was removed: - ----- Method: BOBTransformationMorph>>extent: (in category 'geometry') ----- - extent: aPoint - - | newExtent | - - newExtent := aPoint truncated. - bounds extent = newExtent ifTrue: [^self]. - bounds := bounds topLeft extent: newExtent. - self recomputeExtent. - - ! Item was removed: - ----- Method: BOBTransformationMorph>>extentFromParent: (in category 'geometry') ----- - extentFromParent: aPoint - - | newExtent | - - submorphs isEmpty ifTrue: [^self extent: aPoint]. - newExtent := aPoint truncated. - bounds := bounds topLeft extent: newExtent. - newExtent := self recomputeExtent. - newExtent ifNil: [^self]. - bounds := bounds topLeft extent: newExtent. - - ! Item was removed: - ----- Method: BOBTransformationMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - "use the version from Morph" - - | myGuy | - fullBounds := nil. - owner ifNotNil: [owner layoutChanged]. - submorphs notEmpty - ifTrue: - [(myGuy := self firstSubmorph) isWorldMorph - ifFalse: - [worldBoundsToShow = myGuy bounds - ifFalse: [self changeWorldBoundsToShow: (worldBoundsToShow := myGuy bounds)]] - - "submorphs do: [:m | m ownerChanged]" "<< I don't see any reason for this"]! Item was removed: - ----- Method: BOBTransformationMorph>>recomputeExtent (in category 'private') ----- - recomputeExtent - - | scalePt newScale theGreenThingie greenIBE myNewExtent | - - submorphs isEmpty ifTrue: [^self extent]. - worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds]. - worldBoundsToShow area = 0 ifTrue: [^self extent]. - scalePt := owner innerBounds extent / worldBoundsToShow extent. - newScale := scalePt x min: scalePt y. - theGreenThingie := owner. - greenIBE := theGreenThingie innerBounds extent. - myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated. - self - scale: newScale; - offset: worldBoundsToShow origin * newScale. - smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1]. - ^myNewExtent! Item was removed: - ----- Method: BOBTransformationMorph>>useRegularWarpBlt: (in category 'accessing') ----- - useRegularWarpBlt: aBoolean - - useRegularWarpBlt := aBoolean! Item was removed: - Morph subclass: #BackgroundMorph - instanceVariableNames: 'image offset delta running' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !BackgroundMorph commentStamp: '<historical>' prior: 0! - This morph incorporates tiling and regular motion with the intent of supporting, eg, panning of endless (toroidal) backgrounds. - - The idea is that embedded morphs get displayed at a moving offset relative to my position. Moreover this display is tiled according to the bounding box of the submorphs (subBounds), as much as necesary to fill the rest of my bounds.! Item was removed: - ----- Method: BackgroundMorph class>>test (in category 'test') ----- - test - "BackgroundMorph test" - ^(BackgroundMorph new addMorph: (ImageMorph new image: Form fromUser))openInWorld.! Item was removed: - ----- Method: BackgroundMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - running - ifTrue: [aCustomMenu add: 'stop' translated action: #stopRunning] - ifFalse: [aCustomMenu add: 'start' translated action: #startRunning]! Item was removed: - ----- Method: BackgroundMorph>>delta (in category 'accessing') ----- - delta - ^delta! Item was removed: - ----- Method: BackgroundMorph>>delta: (in category 'accessing') ----- - delta: aPoint - - delta := aPoint.! Item was removed: - ----- Method: BackgroundMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "The tiling is solely determined by bounds, subBounds and offset. - The extent of display is determined by bounds and the clipRect of the canvas." - | start d subBnds | - submorphs isEmpty ifTrue: [^ super drawOn: aCanvas]. - subBnds := self subBounds. - running ifFalse: - [super drawOn: aCanvas. - ^ aCanvas fillRectangle: subBnds color: Color lightBlue]. - start := subBnds topLeft + offset - bounds topLeft - (1 at 1) \\ subBnds extent - subBnds extent + (1 at 1). - d := subBnds topLeft - bounds topLeft. - "Sensor redButtonPressed ifTrue: [self halt]." - start x to: bounds width - 1 by: subBnds width do: - [:x | - start y to: bounds height - 1 by: subBnds height do: - [:y | aCanvas translateBy: (x at y) - d clippingTo: bounds - during:[:tileCanvas| self drawSubmorphsOn: tileCanvas]]].! Item was removed: - ----- Method: BackgroundMorph>>fullBounds (in category 'layout') ----- - fullBounds - ^ self bounds! Item was removed: - ----- Method: BackgroundMorph>>fullDrawOn: (in category 'drawing') ----- - fullDrawOn: aCanvas - (aCanvas isVisible: self fullBounds) ifFalse:[^self]. - running ifFalse: [ - ^aCanvas clipBy: (bounds translateBy: aCanvas origin) - during:[:clippedCanvas| super fullDrawOn: clippedCanvas]]. - (aCanvas isVisible: self bounds) ifTrue:[aCanvas drawMorph: self]. - ! Item was removed: - ----- Method: BackgroundMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - offset := 0 @ 0. - delta := 1 @ 0. - running := true! Item was removed: - ----- Method: BackgroundMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - "Do nothing, since I clip my submorphs"! Item was removed: - ----- Method: BackgroundMorph>>offset (in category 'accessing') ----- - offset - ^offset! Item was removed: - ----- Method: BackgroundMorph>>offset: (in category 'accessing') ----- - offset: aPoint - offset := aPoint! Item was removed: - ----- Method: BackgroundMorph>>slideBy: (in category 'accessing') ----- - slideBy: inc - submorphs isEmpty ifTrue: [^ self]. - offset := offset + inc \\ self subBounds extent. - self changed! Item was removed: - ----- Method: BackgroundMorph>>startRunning (in category 'accessing') ----- - startRunning - running := true. - self changed! Item was removed: - ----- Method: BackgroundMorph>>step (in category 'stepping and presenter') ----- - step - - running ifTrue: [self slideBy: delta]! Item was removed: - ----- Method: BackgroundMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Answer the desired time between steps in milliseconds." - - ^ 20! Item was removed: - ----- Method: BackgroundMorph>>stopRunning (in category 'accessing') ----- - stopRunning - running := false. - self changed! Item was removed: - ----- Method: BackgroundMorph>>subBounds (in category 'accessing') ----- - subBounds - "calculate the submorph bounds" - - | subBounds | - subBounds := (submorphs ifEmpty: [^nil]) anyOne fullBounds copy. - self submorphsDo: [:m | subBounds swallow: m fullBounds]. - ^subBounds! Item was removed: - ----- Method: Bag>>asMorph (in category '*MorphicExtras-converting') ----- - asMorph - " - (Bag new in: [:bag | Smalltalk allClasses do: [:cls | bag add: cls name first]. bag]) - asMorph openInHand. - " - ^ HistogramMorph on: self! Item was removed: - ----- Method: BalloonMorph>>isBalloonHelp (in category '*MorphicExtras-classification') ----- - isBalloonHelp - ^true! Item was removed: - EllipseMorph subclass: #BannerMorph - instanceVariableNames: 'header contents' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !BannerMorph commentStamp: 'ct 9/7/2019 10:43' prior: 0! - I display a header and a contents text, arranged in an EllipseMorph in a flamboyant way. I use a ScreeningMorph and a BackgroundMorph to hinder the user to avert his gaze from me.! Item was removed: - ----- Method: BannerMorph class>>example (in category 'examples') ----- - example - "BannerMorph example openInWorld" - - ^ self - header: 'Yes, <u>you</u> are ...' withCRs asTextFromHtml - contents: 'Live in Morphic' asUppercase asText! Item was removed: - ----- Method: BannerMorph class>>header:contents: (in category 'instance creation') ----- - header: aStringOrText contents: anotherStringOrText - - ^ self basicNew - header: aStringOrText contents: anotherStringOrText; - initialize; - yourself! Item was removed: - ----- Method: BannerMorph>>contents (in category 'accessing') ----- - contents - - ^ contents! Item was removed: - ----- Method: BannerMorph>>createBackground (in category 'initialize-release') ----- - createBackground - - | fillMorph fillStyle | - fillStyle := GradientFillStyle colors: - ({Color red. Color green. Color blue} - in: [:colors | colors, colors reverse]). - fillStyle - origin: 0 @ 0; - direction: 150 @ 50. - fillMorph := (Morph new - fillStyle: fillStyle; - yourself). - ^ BackgroundMorph new - extent: 300 @ 130; - addMorph: fillMorph; - yourself! Item was removed: - ----- Method: BannerMorph>>createContents (in category 'initialize-release') ----- - createContents - - | text | - text := self contents asText - addAttribute: TextEmphasis bold; - addAttribute: (TextFontReference toFont: - (StrikeFont familyName: #ComicPlain size: 39)); - asMorph. - text readOnly: true; flag: #ct. "We're no *that* life, yet :(" - ^ ScreeningMorph new - addMorph: (self createBackground - extent: text extent; - yourself); - addMorph: text; - showScreened; - cellPositioning: #center; - yourself! Item was removed: - ----- Method: BannerMorph>>createHeader (in category 'initialize-release') ----- - createHeader - - | text | - text := (self header copyWithFirst: Character cr) asText - addAttribute: TextEmphasis bold; - addAttribute: (TextFontReference toFont: - (StrikeFont familyName: #Accula size: 29)); - yourself. - ^ text asMorph - centered; - fillsOwner: true; - yourself! Item was removed: - ----- Method: BannerMorph>>header (in category 'accessing') ----- - header - - ^ header! Item was removed: - ----- Method: BannerMorph>>header:contents: (in category 'accessing') ----- - header: aStringOrText contents: anotherStringOrText - - header := aStringOrText. - contents := anotherStringOrText.! Item was removed: - ----- Method: BannerMorph>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - self extent: 300 @ 200. - self - changeProportionalLayout; - addMorph: (Morph new - color: Color transparent; - changeTableLayout; - listCentering: #center; wrapCentering: #center; - addMorph: self createContents; - yourself) - fullFrame: LayoutFrame fullFrame; - addMorph: self createHeader.! Item was removed: - ----- Method: BannerMorph>>initializeToStandAlone (in category 'initialize-release') ----- - initializeToStandAlone - - self header: 'Introducing' contents: self class name. - super initializeToStandAlone.! Item was removed: - RotaryDialMorph subclass: #BarometerMorph - instanceVariableNames: 'priorPressureIndicator' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !BarometerMorph commentStamp: 'tpr 4/13/2017 16:48' prior: 0! - I am a model of a moderately visually ornate barometer, complete with curly tailed needle and the adjustable 'last pressure' needle used to help display the recent changes in pressure. In this case a d-click makes the 'last pressure' needle move to the current pressure position. - - ! Item was removed: - ----- Method: BarometerMorph>>buildDial (in category 'dial drawing') ----- - buildDial - "start by making a damn big Form, twice the size we want to end up with" - |outerRadius destForm canvas tickLabel tickLength beginAngle endAngle tickAngle tickLabelSize maxTicks | - outerRadius := self height - 1. - destForm := Form extent: self extent * 2 depth: 32. - (canvas := destForm getCanvas) fillOval: (0 at 0 extent: self extent * 2) color: Color white. - "outer ring" - self drawArcAt: destForm center radius: outerRadius thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - "inner ring" - self drawArcAt: destForm center radius: outerRadius * 0.97 thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - - "outer scale for inches of HG" - beginAngle := startAngle -360. "needs cleaning up about this" - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.8 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.73 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - "since we're going from 28in. to 31in. of Hg for the outer scale and want alternating full and half ticks as we go round we need 31-28 * 10 * 2 -> 60 ticks" - maxTicks := 31 - 28 * 10 * 2. - tickAngle := endAngle - beginAngle / maxTicks. - 0 to: maxTicks do: [:tick| - tickLabel := nil. - tickLength := {outerRadius * 0.07. outerRadius * 0.14} atWrap: tick+1. - tick \\ 20 = 0 ifTrue: [ - tickLabel := #( '28' '29' '30' '31') at: tick // 20 + 1. - tickLabelSize := 24. - ] ifFalse: [ - tick \\ 2 = 0 ifTrue: [ - tickLabel := (tick // 2 \\ 10) asString. - tickLabelSize := 18. - ]. - ]. - self drawTickRadius: outerRadius * 0.73 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick * tickAngle) onCanvas: canvas. - self tickLabel: tickLabel fontSize: tickLabelSize color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) + tickLength angle: beginAngle + (tick * tickAngle) onCanvas: canvas. - ]. - - self tickInnerLabel: 'mB' fontSize: 36 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) angle: 180 onCanvas: canvas. - - "inner scale for mB" - beginAngle := startAngle -360. "needs cleaning up about this" - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.71 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.63 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - "since we're going from 948mB to 1050 for this inner scale and want thick ticks at each 10mB interval with narrow ones elsewhere we have (1050 - 948) total ticks " - maxTicks := stopValue - startValue. - tickAngle := endAngle - beginAngle / maxTicks. - tickLength := outerRadius * 0.07. - startValue to: stopValue do: [ :tick ||tickThickness| - tickLabel := nil. - tick \\ 10 = 0 ifTrue: [ - tickLabelSize := 20. - tickThickness := 3. - tickLabel := tick asString. - ] ifFalse: [ - tickThickness := 2. - ]. - self drawTickRadius: outerRadius * 0.63 length: tickLength thickness: tickThickness color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - self tickInnerLabel: tickLabel fontSize: tickLabelSize color: Color black centeredAt: dialCenter radius: (outerRadius * 0.63) angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - tickLabel := nil. - tick = 970 ifTrue:[tickLabel := 'Rain']. - tick = 1000 ifTrue:[tickLabel := 'Change']. - tick = 1030 ifTrue:[tickLabel := 'Fair']. - self tickInnerLabel: tickLabel fontSize: 24 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.5) angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - - ]. - self tickLabel: '"Hg' fontSize: 36 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) angle: 180 onCanvas: canvas. - - self addMorph: (destForm magnify: destForm boundingBox by: 0.5 smoothing: 2) asMorph! Item was removed: - ----- Method: BarometerMorph>>doubleClick: (in category 'initialize-release') ----- - doubleClick: evt - "the user has just tapped on the glass of the barometer, so move the priorPressureIndicator to match the current value" - priorPressureIndicator rotationDegrees: needleMorph rotationDegrees! Item was removed: - ----- Method: BarometerMorph>>handlesMouseDown: (in category 'initialize-release') ----- - handlesMouseDown: evt - ^true! Item was removed: - ----- Method: BarometerMorph>>initialize (in category 'initialize-release') ----- - initialize - "assemble a nice barometer morph. The background is an ImageMorph with scale/dial drawn with code adapted from a generous donation of time and effort by Bob Arning; similarly for the needle" - | pointerMorph | - - super initialize. - "set up as a barometer type display; running clockwise with increasing values. - A decent range for a barometer is 950mB to 1050mB; it covers most plausible weather and matches decently with an additional inches-of-Hg scale going from 28 to 31. - 28in. -> 948mB and 31in. -> 1050 (to enough accuracy for a screen based widget) so we need a small tweak at the lower end of the dial. If we aim initially for 150deg each side of north we have 3deg per milliBar; to accomodate the extra 2mB we can add 6deg at the low end, which makes 1000mB sit nicely at due north. - So we will use angles of -156 to 150 and values of 948 to 1050 as our limits." - - self startAngle: -156 stopAngle: 150; - startValue: 948 stopValue: 1050. - self extent: self initialExtent; color: Color transparent; borderWidth: 0. - dialCenter := self center. - - "build the dial background. This is amazingly complex to think about programmatically; this example is fairly hard-coded by hand but somebody out there almost certainly has ideas about parameterizing this to amke a nice general utility" - self buildDial. - - "build our fancy needle as an ImageMorph, set the position to horizontal centre and about 2/3 down so that it rotates about that point when inside the TransformationMorph" - pointerMorph := self fancyNeedleOfLength: (self height * 0.65) rounded. - pointerMorph - position: pointerMorph extent * ( -0.5@ -0.65); - rotationCenter: 0.5 @ 0.65. - - "we keep track of the TransformationMorph since that is what we have to rotate as the incoming pressure values change" - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - - "Add the simpler needle used to indicate the prior 'remembered' reading; we will make a click update it to the current value" - pointerMorph := self simpleNeedleOfLength: (self height * 0.35) rounded color: (Color r: 16rFF g: 16rD7 b: 16r0 range: 512). - pointerMorph - position: pointerMorph extent * ( -0.5@ -1); - rotationCenter: 0.5 @ 1. - priorPressureIndicator := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: priorPressureIndicator. - - "add a central near-to-gold colored dot. Because we just do." - self addMorph: (CircleMorph new extent: 20 at 20; color: (Color r: 16rFF g: 16rD7 b: 16r0 range: 256); center: dialCenter) - ! Item was removed: - ----- Method: BarometerMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - "Do nothing upon mouse-down except inform the hand to watch for a - double-click; wait until an ensuing click:, doubleClick:, or drag: - message gets dispatched" - evt hand - waitForClicksOrDrag: self - event: evt - selectors: #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) - threshold: HandMorph dragThreshold! Item was removed: - RectangleMorph subclass: #BasicButton - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !BasicButton commentStamp: '<historical>' prior: 0! - A minimalist button-like object intended for use with the tile-scripting system.! Item was removed: - ----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'button' translatedNoop! Item was removed: - ----- Method: BasicButton>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'change label...' translated action: #setLabel! Item was removed: - ----- Method: BasicButton>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color yellow darker! Item was removed: - ----- Method: BasicButton>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: BasicButton>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color yellow! Item was removed: - ----- Method: BasicButton>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self label: 'Button'; useRoundedCorners! Item was removed: - ----- Method: BasicButton>>label (in category 'label') ----- - label - | s | - s := ''. - self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s := m contents]]. - ^ s! Item was removed: - ----- Method: BasicButton>>label: (in category 'label') ----- - label: aString - - | oldLabel m | - (oldLabel := self findA: StringMorph) - ifNotNil: [oldLabel delete]. - m := StringMorph contents: aString font: TextStyle defaultFont. - self extent: m extent + (self borderWidth + 6). - m position: self center - (m extent // 2). - self addMorph: m. - m lock! Item was removed: - ----- Method: BasicButton>>label:font: (in category 'label') ----- - label: aString font: aFontOrNil - - | oldLabel m aFont | - (oldLabel := self findA: StringMorph) - ifNotNil: [oldLabel delete]. - aFont := aFontOrNil ifNil: [Preferences standardButtonFont]. - m := StringMorph contents: aString font: aFont. - self extent: (m width + 6) @ (m height + 6). - m position: self center - (m extent // 2). - self addMorph: m. - m lock - ! Item was removed: - ----- Method: BasicButton>>setLabel (in category 'label') ----- - setLabel - | newLabel | - newLabel := UIManager default - request: - 'Enter a new label for this button' - initialAnswer: self label. - newLabel isEmpty ifFalse: [self label: newLabel font: nil]. - ! Item was removed: - ----- Method: BitBlt class>>previewAllBitBltRules (in category '*MorphicExtras') ----- - previewAllBitBltRules - - (self previewBitBltRules: (0 to: 41) - on: ToolIcons flag - and: ToolIcons collection - fallback: ToolIcons exception - scaledTo: 32) openInHand.! Item was removed: - ----- Method: BitBlt class>>previewAllBitBltRulesWithAlpha (in category '*MorphicExtras') ----- - previewAllBitBltRulesWithAlpha - - (self previewBitBltRules: (0 to: 41) - on: ToolIcons flag - and: ((Color red alpha: 0.4) iconOrThumbnailOfSize: 12) - fallback: ToolIcons exception - scaledTo: 32) openInHand.! Item was removed: - ----- Method: BitBlt class>>previewBitBltRules:on:and:fallback:scaledTo: (in category '*MorphicExtras') ----- - previewBitBltRules: rules on: aForm1 and: aForm2 fallback: fallbackForm scaledTo: aNumberOrPoint - "Returns a combined morph of the result of each rule applied on aForm1 combined with - aForm2 scaled to aNumberOrPoint. If the combination faild with a rule, fallbackForm is - shown instead. The number of each rule is appended at the bottom of each result." - - | resultMorph tileExtent | - tileExtent := aNumberOrPoint asPoint. - resultMorph := Morph new - color: Color transparent; - extent: (rules size * tileExtent x)@tileExtent y; - yourself. - - rules withIndexDo: [ :rule :index | | form formMorph numberLabel | - form := aForm1 copy. - [aForm2 copy displayOn: form at: 0 at 0 rule: rule] - on: Exception - do: [form := fallbackForm]. - formMorph := (form scaledToSize: tileExtent) asMorph - position: (index*tileExtent x)@0; - yourself. - resultMorph addMorph: formMorph. - - numberLabel := rule asString asMorph - center: ((index+0.5)*tileExtent x)@tileExtent y; - yourself. - resultMorph addMorph: numberLabel]. - - ^ resultMorph! Item was removed: - BooklikeMorph subclass: #BookMorph - instanceVariableNames: 'pages currentPage' - classVariableNames: 'MethodHolders VersionNames VersionTimes' - poolDictionaries: '' - category: 'MorphicExtras-Books'! - - !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.! Item was removed: - ----- 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' translated. - ^ true]]]]. - ^ false! Item was removed: - ----- 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 initializeToStandAlone. - book markAsPartsDonor. - ^ book! Item was removed: - ----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Book' translatedNoop - categories: {'Multimedia' translatedNoop} - documentation: 'Multi-page structures' translatedNoop - sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ - REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni - 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI - 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9 - AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I - hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj - SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr - dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj - CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX - pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n - 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt - f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr - LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta - ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R - 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/ - +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/ - EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8 - QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i - B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/ - EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz - A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8 - QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH - 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ - ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E - rkJggg==' readStream) readStream) nextImage! Item was removed: - ----- Method: BookMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^(suffix = 'bo') | (suffix = '*') - ifTrue: [ Array with: self serviceLoadAsBook] - ifFalse: [#()] - ! Item was removed: - ----- 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! Item was removed: - ----- Method: BookMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- 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' translated. - ^ aBook]]]]. - - "if same book name, use it" - short := (aUrl findTokens: '/') last. - urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [ - ^ bks at: ind]]. - ^ #out! Item was removed: - ----- Method: BookMorph class>>makeBookOfProjects:named: (in category 'booksAsProjects') ----- - makeBookOfProjects: aListOfProjects named: aString - " - BookMorph makeBookOfProjects: (Project allProjects select: [ :each | each world isMorph]) - " - | book | - - book := self new. - book setProperty: #transitionSpec toValue: {'silence'. #none. #none}. - aListOfProjects do: [ :each | | pvm page | - 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! Item was removed: - ----- 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 := ThreePhaseButtonMorph labelSymbol: #NextPage. - aButton target: aButton. - aButton actionSelector: #nextOwnerPage. - aButton arguments: #(). - aButton setNameTo: 'previous'. - ^ aButton! Item was removed: - ----- 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 readOnlyFileNamed: fullName. - book := BookMorph new. - book setProperty: #url toValue: aFileStream url. - book fromRemoteStream: aFileStream. - aFileStream close. - - Smalltalk isMorphic - ifTrue: [self currentWorld addMorphsAndModel: book] - ifFalse: [book isMorph ifFalse: [^self inform: 'Can only load a single morph\into an mvc project via this mechanism.' translated withCRs]. - book openInWorld]. - book goToPage: 1! Item was removed: - ----- 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 := ThreePhaseButtonMorph labelSymbol: #PrevPage. - aButton target: aButton. - aButton actionSelector: #previousOwnerPage. - aButton arguments: #(). - aButton setNameTo: 'previous'. - ^ aButton! Item was removed: - ----- 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' translatedNoop. 'A button that takes you to the next page' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop} - forFlapNamed: 'Supplies']! Item was removed: - ----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') ----- - serviceLoadAsBook - - ^ SimpleServiceEntry - provider: self - label: 'load as book' translatedNoop - selector: #openFromFile: - description: 'open as bookmorph' translatedNoop! Item was removed: - ----- Method: BookMorph class>>services (in category 'fileIn/Out') ----- - services - - ^ Array with: self serviceLoadAsBook! Item was removed: - ----- Method: BookMorph class>>unload (in category 'initialize-release') ----- - unload - "Unload the receiver from global registries" - - self environment - at: #FileServices - ifPresent: [:cl | cl unregisterFileReader: self]. - self environment - at: #Flaps - ifPresent: [:cl | cl unregisterQuadsWithReceiver: self]! Item was removed: - ----- 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." - - - self delete. - pages do: [:aPage | | pg | - (pg := aPage sqkPage) ifNotNil: [ - pg contentsMorph == aPage ifTrue: [ - pg contentsMorph: nil]]].! Item was removed: - ----- 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]! Item was removed: - ----- Method: BookMorph>>acceptSortedContentsFrom: (in category 'sorting') ----- - acceptSortedContentsFrom: aHolder - "Update my page list from the given page sorter." - - | goodPages rejects | - goodPages := OrderedCollection new. - rejects := OrderedCollection new. - aHolder submorphs withIndexDo: - [:m :i | | toAdd sqPage | - 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.']! Item was removed: - ----- 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 - ! Item was removed: - ----- 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 ifNotNil: - [:anExtent | currentPage extent: anExtent]]. - (self valueOfProperty: #floatingPageControls) ifNotNil: - [:pc | pc isInWorld ifFalse: [pc openInWorld]]! Item was removed: - ----- 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! Item was removed: - ----- Method: BookMorph>>allowSubmorphExtraction (in category 'dropping/grabbing') ----- - allowSubmorphExtraction - - ^ false! Item was removed: - ----- Method: BookMorph>>asPostscript (in category 'Postscript Canvases') ----- - asPostscript - ^self asPostscriptPrintJob. - ! Item was removed: - ----- 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 borderStyle: (BorderStyle raised width: 1). - um color: (Color r: 0.4 g: 0.8 b: 0.6). - self primaryHand attachMorph: um. - ^ um! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: BookMorph>>buildThreadOfProjects (in category 'menu') ----- - buildThreadOfProjects - - | projectNames threadName | - - projectNames := pages collect: [ :each | | thisPVM | - (thisPVM := each findA: ProjectViewMorph) ifNil: [ - nil - ] ifNotNil: [ - {thisPVM project name}. - ]. - ]. - projectNames := projectNames reject: [ :each | each isNil]. - threadName := UIManager default - 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. - ! Item was removed: - ----- Method: BookMorph>>cardsOrPages (in category 'accessing') ----- - cardsOrPages - "The turnable and printable entities" - - ^ pages! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: BookMorph>>currentPage (in category 'accessing') ----- - currentPage - (submorphs includes: currentPage) ifFalse: [currentPage := nil]. - ^ currentPage! Item was removed: - ----- Method: BookMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: BookMorph>>defaultNameStemForNewPages (in category 'insert and delete') ----- - defaultNameStemForNewPages - "Answer a stem onto which to build default names for fresh pages" - - ^ 'page' - ! Item was removed: - ----- 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] - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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) - ! Item was removed: - ----- Method: BookMorph>>exitFullScreen (in category 'other') ----- - exitFullScreen - | floater | - self isInFullScreenMode ifFalse: [ ^ self ]. - self - setProperty: #fullScreenMode - toValue: false. - (self hasProperty: #showWorldMainDockingBarWhenNotFullScreen) ifTrue: - [ MorphicProject current showWorldMainDockingBar: (self valueOfProperty: #showWorldMainDockingBarWhenNotFullScreen). - self removeProperty: #showWorldMainDockingBarWhenNotFullScreen ]. - floater := self - valueOfProperty: #floatingPageControls - ifAbsent: [ ]. - floater ifNotNil: - [ floater delete. - self removeProperty: #floatingPageControls ]. - self position: 0 @ 0. - self adjustCurrentPageForFullScreen! Item was removed: - ----- 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 here fromHereOn startToHere oldContainer oldIndex otherKeys strings good | - 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 | | thisWord | "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! Item was removed: - ----- 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.)" - - | container wasIn strings old good insideOf place start | - 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 | | thisWord | - "each key" - - good - ifTrue: - [thisWord := false. - strings do: - [:longString | | index | - (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" - self currentHand newKeyboardFocus: container. - ^true]. - ^false! Item was removed: - ----- 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." - - - pages do: [:aPage | | pg | - 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.! Item was removed: - ----- 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! Item was removed: - ----- 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 | - strm := Cursor wait showWhile: [ - (ServerFile new fullPath: url) asStream]. - strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil]. - self setProperty: #url toValue: url. - self fromRemoteStream: strm. - ^ self! Item was removed: - ----- Method: BookMorph>>fullDrawPostscriptOn: (in category 'Postscript Canvases') ----- - fullDrawPostscriptOn:aCanvas - ^aCanvas fullDrawBookMorph:self. - ! Item was removed: - ----- 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 | - oldUrls := self valueOfProperty: #allTextUrls ifAbsent: [#()]. - oldStringLists := self valueOfProperty: #allText ifAbsent: [#()]. - allText := pages collect: [:pg | OrderedCollection new]. - allTextUrls := Array new: pages size. - pages withIndexDo: [:aPage :ind | | which aUrl | - 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! Item was removed: - ----- 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 - withIndexDo: [: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: [UIManager default 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! Item was removed: - ----- Method: BookMorph>>goFullScreen (in category 'other') ----- - goFullScreen - | floater | - self isInFullScreenMode ifTrue: [ ^ self ]. - self - setProperty: #fullScreenMode - toValue: true. - self - setProperty: #showWorldMainDockingBarWhenNotFullScreen - toValue: Project current showWorldMainDockingBar. - Project current showWorldMainDockingBar: false. - self position: (currentPage topLeft - self topLeft) negated. - self adjustCurrentPageForFullScreen. - floater := self buildFloatingPageControls. - self - setProperty: #floatingPageControls - toValue: floater. - floater openInWorld! Item was removed: - ----- Method: BookMorph>>goToPage (in category 'menu') ----- - goToPage - | pageNum | - pageNum := UIManager default request: 'Page?' translated initialAnswer: '0'. - pageNum isEmptyOrNil ifTrue: [^true]. - self goToPage: pageNum asNumber. - ! Item was removed: - ----- Method: BookMorph>>goToPage: (in category 'navigation') ----- - goToPage: pageNumber - - ^ self goToPage: pageNumber transitionSpec: nil! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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). - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') ----- - goToPageMorph: newPage transitionSpec: transitionSpec - "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided." - - | 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]. - self removeViewersOnSubsIn: self currentWorld presenter. - 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). "sets currentPage" - 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"]. - self currentWorld presenter flushPlayerListCache.! Item was removed: - ----- 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"]! Item was removed: - ----- 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! Item was removed: - ----- Method: BookMorph>>goto: (in category 'navigation') ----- - goto: aPlayer - self goToPageMorph: aPlayer costume! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - super initializeToStandAlone. - self removeEverything; pageSize: 360 at 228; color: Color white. - self borderWidth: 1; borderColor: Color black. - self beSticky. - self showPageControls; insertPage. - ^ self! Item was removed: - ----- Method: BookMorph>>insertPage:pageSize: (in category 'insert and delete') ----- - insertPage: aPage pageSize: aPageSize - ^ self insertPage: aPage pageSize: aPageSize atIndex: (pages size + 1)! Item was removed: - ----- 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! Item was removed: - ----- 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" - - | pageExtent newPage borderWidth backgroundColor | - backgroundColor := currentPage isNil - ifTrue: - [pageExtent := pageSize. - borderWidth := 0. - Color blue muchLighter] - ifFalse: - [pageExtent := currentPage extent. - borderWidth := currentPage borderWidth. - currentPage borderColor]. - newPagePrototype ifNil: - [newPage := (PasteUpMorph new) - extent: pageExtent; - color: aColor. - newPage - borderWidth: borderWidth; - borderColor: backgroundColor] - ifNotNil: [newPage := Cursor wait showWhile: [newPagePrototype veryDeepCopy]]. - newPage setNameTo: self defaultNameStemForNewPages. - newPage vResizeToFit: false. - pages isEmpty - ifTrue: [pages add: (currentPage := newPage)] - ifFalse: [pages add: newPage after: currentPage]. - self nextPage! Item was removed: - ----- Method: BookMorph>>insertPageLabel:morphs: (in category 'insert and delete') ----- - insertPageLabel: labelString morphs: morphList - - | m c labelAllowance | - self insertPage. - labelString ifNotNil: - [m := labelString asMorph. - 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 - ! Item was removed: - ----- Method: BookMorph>>insertPageMorphInCorrectSpot: (in category 'navigation') ----- - insertPageMorphInCorrectSpot: aPageMorph - - self addMorphBack: (currentPage := aPageMorph). - ! Item was removed: - ----- 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: [newPage := Cursor wait showWhile: [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! Item was removed: - ----- 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: #changeDragAndDrop. - 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 - ! Item was removed: - ----- Method: BookMorph>>isInFullScreenMode (in category 'other') ----- - isInFullScreenMode - - ^self valueOfProperty: #fullScreenMode ifAbsent: [false]! Item was removed: - ----- 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.! Item was removed: - ----- 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! Item was removed: - ----- Method: BookMorph>>lastPage (in category 'navigation') ----- - lastPage - self goToPage: pages size - ! Item was removed: - ----- 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 :=DirectoryChooserDialog openOn: FileDirectory default label: 'Select the directory to load pages from'. - directory ifNil: [^ self]. - - "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: (self 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]! Item was removed: - ----- Method: BookMorph>>maintainsUniformPageSize (in category 'uniform page size') ----- - maintainsUniformPageSize - "Answer whether I am currently set up to maintain uniform page size" - - ^ self uniformPageSize notNil! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- Method: BookMorph>>menuPageSoundForAll: (in category 'menu') ----- - menuPageSoundForAll: evt - - ^ self menuPageSoundFor: self event: evt! Item was removed: - ----- Method: BookMorph>>menuPageSoundForThisPage: (in category 'menu') ----- - menuPageSoundForThisPage: evt - - currentPage ifNotNil: - [^ self menuPageSoundFor: currentPage event: evt]! Item was removed: - ----- Method: BookMorph>>menuPageVisualFor:event: (in category 'menu') ----- - menuPageVisualFor: target event: evt - | tSpec menu | - 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 | | subMenu directionChoices | - 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! Item was removed: - ----- Method: BookMorph>>menuPageVisualForAll: (in category 'menu') ----- - menuPageVisualForAll: evt - - ^ self menuPageVisualFor: self event: evt! Item was removed: - ----- Method: BookMorph>>menuPageVisualForThisPage: (in category 'menu') ----- - menuPageVisualForThisPage: evt - - currentPage ifNotNil: - [^ self menuPageVisualFor: currentPage event: evt]! Item was removed: - ----- Method: BookMorph>>methodHolderVersions (in category 'scripting') ----- - methodHolderVersions - | arrayOfVersions vTimes | - "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 := OrderedCollection new. - arrayOfVersions do: [:versionBrowser | - versionBrowser changeList do: [:cr | | strings | - (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. - ! Item was removed: - ----- Method: BookMorph>>morphsForPageSorter (in category 'sorting') ----- - morphsForPageSorter - | thumbnails | - 'Assembling thumbnail images...' - displayProgressFrom: 0 to: pages size - during: - [:bar | | i | - 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! Item was removed: - ----- 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! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: BookMorph>>nextPage (in category 'navigation') ----- - nextPage - currentPage isNil ifTrue: [^self goToPage: 1]. - self goToPage: (self pageNumberOf: currentPage) + 1! Item was removed: - ----- Method: BookMorph>>pageControlsVisible (in category 'menu') ----- - pageControlsVisible - ^ self hasSubmorphWithProperty: #pageControl! Item was removed: - ----- Method: BookMorph>>pageNamed: (in category 'accessing') ----- - pageNamed: aName - ^ pages detect: [:p | p knownName = aName] ifNone: [nil]! Item was removed: - ----- Method: BookMorph>>pageNumber (in category 'navigation') ----- - pageNumber - - ^ self pageNumberOf: currentPage! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: BookMorph>>pages (in category 'accessing') ----- - pages - - ^ pages - ! Item was removed: - ----- 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."! Item was removed: - ----- Method: BookMorph>>pagesHandledAutomatically (in category 'printing') ----- - pagesHandledAutomatically - - ^true! Item was removed: - ----- Method: BookMorph>>pasteBookPage (in category 'menu') ----- - pasteBookPage - "If the paste buffer has something to paste, paste it as a book page." - - | aPage | - aPage := self primaryHand objectToPaste. - aPage removeProperty: #revertKey. - - self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1). - "self goToPageMorph: aPage"! Item was removed: - ----- Method: BookMorph>>previousPage (in category 'navigation') ----- - previousPage - currentPage isNil ifTrue: [^self goToPage: 1]. - self goToPage: (self pageNumberOf: currentPage) - 1! Item was removed: - ----- 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 := Project uiManager - saveFilenameRequest: 'Filename to save BookMorph' translated - initialAnswer: fileName. - fileName isEmptyOrNil ifTrue: [^ Beeper beep]. - (fileName endsWith: '.ps') ifFalse: - [fileName := fileName,'.ps']. - rotateFlag := (Project uiManager - chooseOptionFrom: {'portrait (tall)' translated. 'landscape (wide)' translated} - title: 'Choose orientation...' translated) = 2. - FileStream - newFileNamed: fileName - do: - [:file| - file nextPutAll: (DSCPostscriptCanvas morphAsPostscript: self rotated: rotateFlag)]! Item was removed: - ----- 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]. - page removeProperty: #cachedThumbnail].! Item was removed: - ----- 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 which | - (url := self valueOfProperty: #url) ifNil: ["for .bo index file" - url := UIManager default - 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 | - 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). - ! Item was removed: - ----- Method: BookMorph>>removeEverything (in category 'initialization') ----- - removeEverything - currentPage := nil. - pages := OrderedCollection new. - self removeAllMorphs! Item was removed: - ----- 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 withIndexDo: - [:pg :ind | - "does write the current page too" - - pg url ifNil: [pg reserveUrl: stem , ind printString , '.sp']] - - "self saveIndexOnURL."! Item was removed: - ----- 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]]]]. - - ! Item was removed: - ----- Method: BookMorph>>resizePagesTo: (in category 'other') ----- - resizePagesTo: anExtent - pages do: - [:aPage | aPage extent: anExtent]! Item was removed: - ----- Method: BookMorph>>revertToCheckpoint: (in category 'scripting') ----- - revertToCheckpoint: secsSince1901 - - "Put all scripts (that appear in MethodPanes) back to the way they were at an earlier time." - - MethodHolders do: [:mh | | cngRecord | - cngRecord := mh versions versionFrom: secsSince1901. - cngRecord ifNotNil: [ - (cngRecord stamp: Utilities changeStamp) fileIn]]. - "does not delete method if no earlier version" - - ! Item was removed: - ----- 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 withIndexDo: - [: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"]! Item was removed: - ----- 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 remote pageURL num pre index after dict allText allTextUrls fName strm | - mine := self valueOfProperty: #url. - mine ifNil: [^ self saveIndexOnURL]. - strm := Cursor wait showWhile: [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 | - remoteFile := sf fileNamed: mine. - remoteFile fileOutClass: nil andObject: remote. - "remoteFile close"]. - ! Item was removed: - ----- 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 mine sf urlList list | - 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 withIndexDo: - [: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 | - remoteFile := sf fileNamed: mine. - remoteFile dataIsValid. - remoteFile fileOutClass: nil andObject: list - "remoteFile close"]! Item was removed: - ----- 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 := Project uiManager - chooseOptionFrom: {'Old book' translated. 'New book sharing old pages' translated} - title: '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) ifEmpty: [^ 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 ifEmpty: [^ 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.! Item was removed: - ----- 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! Item was removed: - ----- 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 := Project uiManager - chooseOptionFrom: - {'Use page numbers' translated. - 'Type in file names' translated. - 'Save in a new place (using page numbers)' translated. - 'Save in a new place (typing names)' translated. - 'Save new book sharing old pages' translated. } - title: '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" - ! Item was removed: - ----- 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].! Item was removed: - ----- 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]]! Item was removed: - ----- Method: BookMorph>>setInitialState (in category 'initialization') ----- - setInitialState - self listDirection: #topToBottom; - wrapCentering: #topLeft; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 5. - pageSize := 160 @ 300. - self enableDragNDrop! Item was removed: - ----- 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. - newPagePrototype removeProperty: #revertKey]. - "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert." - ! Item was removed: - ----- 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 ]. - NewColorPickerMorph useIt - ifTrue: - [ (NewColorPickerMorph - on: self - originalColor: self currentPage color - setColorSelector: #setAllPagesColor:) openNear: self fullBoundsInWorld ] - ifFalse: - [ ColorPickerMorph new - choseModalityFromPreference ; - sourceHand: self activeHand ; - target: self ; - selector: #setAllPagesColor: ; - originalColor: self currentPage color ; - - putUpFor: self - near: self fullBoundsInWorld ]! Item was removed: - ----- Method: BookMorph>>setWrapPages: (in category 'navigation') ----- - setWrapPages: doWrap - doWrap - ifTrue: [self removeProperty: #dontWrapAtEnd] - ifFalse: [self setProperty: #dontWrapAtEnd toValue: true]. - ! Item was removed: - ----- Method: BookMorph>>showMoreControls (in category 'navigation') ----- - showMoreControls - self currentEvent shiftPressed - ifTrue: - [self hidePageControls] - ifFalse: - [self showPageControls: self fullControlSpecs]! Item was removed: - ----- Method: BookMorph>>sortPages (in category 'menu commands') ----- - sortPages - - currentPage ifNotNil: [currentPage updateCachedThumbnail]. - ^ super sortPages! Item was removed: - ----- Method: BookMorph>>sortPages: (in category 'sorting') ----- - sortPages: evt - - ^ self sortPages! Item was removed: - ----- 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 := UIManager default 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"! Item was removed: - ----- 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"! Item was removed: - ----- Method: BookMorph>>thumbnailForThisPage (in category 'menu') ----- - thumbnailForThisPage - self primaryHand attachMorph: - (currentPage thumbnailForPageSorter pageMorph: currentPage inBook: self) - ! Item was removed: - ----- Method: BookMorph>>toggleFullScreen (in category 'menu') ----- - toggleFullScreen - self isInFullScreenMode - ifTrue: [self exitFullScreen] - ifFalse: [self goFullScreen]! Item was removed: - ----- 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! Item was removed: - ----- Method: BookMorph>>toggleShowingOfPageControls (in category 'menu') ----- - toggleShowingOfPageControls - self pageControlsVisible - ifTrue: [self hidePageControls] - ifFalse: [self showPageControls]! Item was removed: - ----- 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]! Item was removed: - ----- Method: BookMorph>>uncachePageSorter (in category 'menu') ----- - uncachePageSorter - pages do: [:aPage | aPage removeProperty: #cachedThumbnail].! Item was removed: - ----- 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]! Item was removed: - ----- Method: BookMorph>>updateReferencesUsing: (in category 'copying') ----- - updateReferencesUsing: aDictionary - - super updateReferencesUsing: aDictionary. - pages do: [:page | - page allMorphsDo: [:m | m updateReferencesUsing: aDictionary]]. - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - AlignmentMorph subclass: #BookPageSorterMorph - instanceVariableNames: 'book pageHolder' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Books'! Item was removed: - ----- Method: BookPageSorterMorph>>acceptSort (in category 'buttons') ----- - acceptSort - - book acceptSortedContentsFrom: pageHolder. - self delete. - ! Item was removed: - ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') ----- - addControls - "Add the control bar at the top of the tool." - - | bb r str aCheckbox aWrapper | - r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0. - r wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - bb := SimpleButtonMorph new target: self; borderColor: Color black. - r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)). - bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated. - r addTransparentSpacerOfSize: 12. - bb := SimpleButtonMorph new target: self; borderColor: Color black. - r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)). - bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated. - - "eliminate the parts-bin button on the book-page sorters... - r addTransparentSpacerOfSize: 24 @ 0. - - aCheckbox := UpdatingThreePhaseButtonMorph checkBox. - aCheckbox - target: self; - actionSelector: #togglePartsBinStatus; - arguments: #(); - getSelector: #getPartsBinStatus. - str := StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons. - aWrapper := AlignmentMorph newRow beTransparent. - aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. - aWrapper - addMorphBack: (self wrapperFor: aCheckbox); - addMorphBack: (self wrapperFor: str lock). - r addMorphBack: aWrapper." - - self addMorphFront: r - ! Item was removed: - ----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'initialization') ----- - book: aBookMorph morphsToSort: morphList - - | innerBounds scrollPane newHeight | - book := aBookMorph. - newHeight := self currentWorld height. - 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. - (pageHolder height > newHeight) ifTrue: [ - scrollPane := ScrollPane new. - - self height: newHeight. - scrollPane model: pageHolder. - scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28). - self addMorph: scrollPane inFrontOf: pageHolder. - scrollPane scroller addMorph: pageHolder. - scrollPane scrollBarOnLeft: false. - scrollPane retractable: false. - scrollPane hScrollBarPolicy: #never. - scrollPane borderWidth: 1; borderColor: Color gray. - ]. - ! Item was removed: - ----- Method: BookPageSorterMorph>>changeExtent: (in category 'private') ----- - changeExtent: aPoint - self extent: aPoint. - pageHolder extent: self extent - self borderWidth! Item was removed: - ----- Method: BookPageSorterMorph>>closeButtonOnly (in category 'private') ----- - 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. - ! Item was removed: - ----- Method: BookPageSorterMorph>>columnWith: (in category 'private') ----- - columnWith: aMorph - - ^AlignmentMorph newColumn - color: Color transparent; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - wrapCentering: #center; - cellPositioning: #topCenter; - layoutInset: 1; - addMorph: aMorph - ! Item was removed: - ----- Method: BookPageSorterMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 2! Item was removed: - ----- Method: BookPageSorterMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was removed: - ----- Method: BookPageSorterMorph>>getPartsBinStatus (in category 'buttons') ----- - getPartsBinStatus - - ^pageHolder isPartsBin! Item was removed: - ----- 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 wantsMouseOverHalos: false. - "pageHolder cursor: 0." - "causes a walkback as of 5/25/2000" - self addControls. - self addMorphBack: pageHolder! Item was removed: - ----- Method: BookPageSorterMorph>>pageHolder (in category 'accessing') ----- - pageHolder - - ^ pageHolder - ! Item was removed: - ----- Method: BookPageSorterMorph>>rowWith: (in category 'private') ----- - rowWith: aMorph - - ^AlignmentMorph newColumn - color: Color transparent; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - wrapCentering: #center; - cellPositioning: #topCenter; - layoutInset: 1; - addMorph: aMorph - ! Item was removed: - ----- Method: BookPageSorterMorph>>togglePartsBinStatus (in category 'buttons') ----- - togglePartsBinStatus - - pageHolder isPartsBin: pageHolder isPartsBin not! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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.! Item was removed: - ----- 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"! Item was removed: - ----- Method: BookPageSorterMorph>>wrapperFor: (in category 'private') ----- - wrapperFor: aMorph - - ^self columnWith: (self rowWith: aMorph) - ! Item was removed: - SketchMorph subclass: #BookPageThumbnailMorph - instanceVariableNames: 'page pageNumber bookMorph flipOnClick' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Books'! - - !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! Item was removed: - ----- 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:] - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>bookMorph (in category 'accessing') ----- - bookMorph - - ^bookMorph! Item was removed: - ----- Method: BookPageThumbnailMorph>>computeThumbnail (in category 'private') ----- - 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). - - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was removed: - ----- Method: BookPageThumbnailMorph>>doPageFlip (in category 'private') ----- - 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])]! Item was removed: - ----- Method: BookPageThumbnailMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - "Flip to this page with no extra sound" - BookMorph turnOffSoundWhile: [self doPageFlip]! Item was removed: - ----- Method: BookPageThumbnailMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: event - - ^ event shiftPressed or: [flipOnClick and: [event controlKeyPressed not]]! Item was removed: - ----- Method: BookPageThumbnailMorph>>inBook: (in category 'accessing') ----- - inBook: book - bookMorph := book! Item was removed: - ----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - - | f | - super initialize. - flipOnClick := false. - - f := Form extent: 160 at 120 depth: Display depth. - f fill: f boundingBox fillColor: color. - self form: f! Item was removed: - ----- Method: BookPageThumbnailMorph>>makeFlexMorphFor: (in category 'private') ----- - makeFlexMorphFor: aHand - - aHand grabMorph: (FlexMorph new originalMorph: page)! Item was removed: - ----- 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. - ! Item was removed: - ----- 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 shallowCopy. - (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! Item was removed: - ----- 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])]. - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>page (in category 'accessing') ----- - page - - ^ page - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>page: (in category 'accessing') ----- - page: aMorph - - page := aMorph. - self computeThumbnail. - self setNameTo: aMorph externalName. - page fullReleaseCachedState. - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>pageMorph:inBook: (in category 'accessing') ----- - pageMorph: pageMorph inBook: book - page := pageMorph. - bookMorph := book! Item was removed: - ----- Method: BookPageThumbnailMorph>>pageNumber:inBook: (in category 'accessing') ----- - pageNumber: n inBook: b - pageNumber := n. - bookMorph := b! Item was removed: - ----- Method: BookPageThumbnailMorph>>setPageSound: (in category 'menus') ----- - setPageSound: event - - ^ bookMorph menuPageSoundFor: self event: event! Item was removed: - ----- Method: BookPageThumbnailMorph>>setPageVisual: (in category 'menus') ----- - setPageVisual: event - - ^ bookMorph menuPageVisualFor: self event: event! Item was removed: - ----- Method: BookPageThumbnailMorph>>smaller (in category 'initialization') ----- - smaller - self form: (self form copy: (0 at 0 extent: self form extent//2)). - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>toggleBookmark (in category 'menus') ----- - 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! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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. ! Item was removed: - AlignmentMorph subclass: #BooklikeMorph - instanceVariableNames: 'pageSize newPagePrototype' - classVariableNames: 'PageFlipSoundOn' - poolDictionaries: '' - category: 'MorphicExtras-Books'! - - !BooklikeMorph commentStamp: '<historical>' prior: 0! - A common superclass for BookMorph and WebBookMorph! Item was removed: - ----- Method: BooklikeMorph class>>initialize (in category 'class initialization') ----- - initialize - "BooklikeMorph initialize" - PageFlipSoundOn := true - ! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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. - aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu. - - "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"! Item was removed: - ----- 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! Item was removed: - ----- Method: BooklikeMorph>>clearNewPagePrototype (in category 'menu commands') ----- - clearNewPagePrototype - newPagePrototype := nil - ! Item was removed: - ----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') ----- - currentPlayerDo: aBlock - | aPlayer aPage | - (aPage := self currentPage) ifNil: [^ self]. - aPage allMorphsDo:[ :m| - (aPlayer := m player) ifNotNil: - [aBlock value: aPlayer]]! Item was removed: - ----- Method: BooklikeMorph>>fewerPageControls (in category 'page controls') ----- - fewerPageControls - self currentEvent shiftPressed - ifTrue: - [self hidePageControls] - ifFalse: - [self showPageControls: self shortControlSpecs]! Item was removed: - ----- Method: BooklikeMorph>>firstPage (in category 'menu commands') ----- - firstPage - self goToPage: 1! Item was removed: - ----- 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. - {'o'. #fewerPageControls. 'Fewer controls' translated} - } - ! Item was removed: - ----- Method: BooklikeMorph>>hidePageControls (in category 'page controls') ----- - hidePageControls - "Delete all submorphs answering to the property #pageControl" - self deleteSubmorphsWithProperty: #pageControl! Item was removed: - ----- 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]! Item was removed: - ----- Method: BooklikeMorph>>insertPage (in category 'menu commands') ----- - insertPage - self insertPageColored: self color! Item was removed: - ----- 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 | - c := (color saturation > 0.4) 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 | | lastGuy b | - spec == #showDescription ifTrue: [row addMorphBack: self makeDescriptionViewer]. - spec == #pageNumber ifTrue: [row addMorphBack: self makePageNumberItem]. - spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)]. - spec == #variableSpacer ifTrue: [ - row addMorphBack: AlignmentMorph newVariableTransparentSpacer]. - spec class == Array ifTrue: [ - spec first isSymbol - ifTrue: [b := ThreePhaseButtonMorph labelSymbol: spec first] - ifFalse: [b := SimpleButtonMorph new borderWidth: 2; - borderColor: Color black; color: Color white. - b label: spec first font: Preferences standardMenuFont]. - b target: self; actionSelector: spec second; setBalloonText: spec third. - (spec atPin: 4) = #border - ifTrue: [b actWhen: #buttonDown] - ifFalse: [b borderWidth: 0]. "default is none" - 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! Item was removed: - ----- Method: BooklikeMorph>>move (in category 'misc') ----- - move - (owner isWorldMorph and:[self isSticky not]) ifTrue: [self activeHand grabMorph: self]! Item was removed: - ----- Method: BooklikeMorph>>pageSize (in category 'misc') ----- - pageSize - ^ pageSize - ! Item was removed: - ----- Method: BooklikeMorph>>pageSize: (in category 'misc') ----- - pageSize: aPoint - pageSize := aPoint! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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)! Item was removed: - ----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') ----- - shortControlSpecs - "Answer specs defining the widgets in the short form of the control panel." - - ^ { - {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}. - #variableSpacer. - {#PrevPage. #previousPage. 'Previous page' translated}. - #spacer. - #pageNumber. - #spacer. - {#NextPage. #nextPage. 'Next page' translated}. - #spacer. - #variableSpacer. - {'...'. #showMoreControls. 'More controls' translated} - } - ! Item was removed: - ----- Method: BooklikeMorph>>showPageControls (in category 'page controls') ----- - showPageControls - self showPageControls: self shortControlSpecs! Item was removed: - ----- 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! Item was removed: - ----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') ----- - showingFullScreenString - "Answer a string characterizing whether the receiver is operating in full-screen mode." - - ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated! Item was removed: - ----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') ----- - showingPageControlsString - "Answer a string characterizing whether page controls are currently showing." - - ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']), - 'page controls visible' translated! Item was removed: - ----- 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). - ! Item was removed: - ----- Method: BorderedMorph>>basicInitialize (in category '*MorphicExtras-initialization') ----- - basicInitialize - "Do basic generic initialization of the instance variables" - - super basicInitialize. - self borderInitialize! Item was removed: - Morph subclass: #BouncingAtomsMorph - instanceVariableNames: 'damageReported infectionHistory transmitInfection recentTemperatures temperature' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !BouncingAtomsMorph commentStamp: '<historical>' prior: 0! - This morph shows how an ideal gas simulation might work. When it gets step messages, it makes all its atom submorphs move along their velocity vectors, bouncing when they hit a wall. It also exercises the Morphic damage reporting and display architecture. Here are some things to try: - - 1. Resize this morph as the atoms bounce around. - 2. In an inspector on this morph, evaluate "self addAtoms: 10." - 3. Try setting quickRedraw to false in invalidRect:. This gives the - default damage reporting and incremental redraw. Try it for - 100 atoms. - 4. In the drawOn: method of AtomMorph, change drawAsRect to true. - 5. Create a HeaterCoolerMorph and embed it in the simulation. Extract - it and use an inspector on it to evaluate "self velocityDelta: -5", then - re-embed it. Note the effect on atoms passing over it. - ! Item was removed: - ----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'BouncingAtoms' translatedNoop - categories: {'Just for Fun' translatedNoop} - documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop! Item was removed: - ----- Method: BouncingAtomsMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop} - forFlapNamed: 'Widgets']! Item was removed: - ----- Method: BouncingAtomsMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: BouncingAtomsMorph>>addAtoms: (in category 'other') ----- - addAtoms: n - "Add a bunch of new atoms." - - n timesRepeat: [ - | a | - a := AtomMorph new. - a randomPositionIn: bounds maxVelocity: 10. - self addMorph: a]. - self stopStepping. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'start bouncing' translated action: #startStepping. - aCustomMenu add: 'start infection' translated action: #startInfection. - aCustomMenu add: 'set atom count' translated action: #setAtomCount. - aCustomMenu add: 'show infection history' translated action: #showInfectionHistory:. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>addMorphFront: (in category 'submorphs - add/remove') ----- - addMorphFront: aMorph - "Called by the 'embed' meta action. We want non-atoms to go to the back." - "Note: A user would not be expected to write this method. However, a sufficiently advanced user (e.g, an e-toy author) might do something equivalent by overridding the drag-n-drop messages when they are implemented." - - (aMorph isMemberOf: AtomMorph) - ifTrue: [super addMorphFront: aMorph] - ifFalse: [super addMorphBack: aMorph].! Item was removed: - ----- Method: BouncingAtomsMorph>>areasRemainingToFill: (in category 'drawing') ----- - areasRemainingToFill: aRectangle - color isTranslucent - ifTrue: [^ Array with: aRectangle] - ifFalse: [^ aRectangle areasOutside: self bounds]! Item was removed: - ----- Method: BouncingAtomsMorph>>collisionPairs (in category 'other') ----- - collisionPairs - "Return a list of pairs of colliding atoms, which are assumed to be - circles of known radius. This version uses the morph's positions--i.e. - the top-left of their bounds rectangles--rather than their centers." - - | count sortedAtoms radius twoRadii radiiSquared collisions p1 continue j p2 distSquared m1 m2 | - count := submorphs size. - sortedAtoms := submorphs - sorted: [:mt1 :mt2 | mt1 position x < mt2 position x]. - radius := 8. - twoRadii := 2 * radius. - radiiSquared := radius squared * 2. - collisions := OrderedCollection new. - 1 to: count - 1 - do: - [:i | - m1 := sortedAtoms at: i. - p1 := m1 position. - continue := (j := i + 1) <= count. - [continue] whileTrue: - [m2 := sortedAtoms at: j. - p2 := m2 position. - continue := p2 x - p1 x <= twoRadii - ifTrue: - [distSquared := (p1 x - p2 x) squared + (p1 y - p2 y) squared. - distSquared < radiiSquared - ifTrue: [collisions add: (Array with: m1 with: m2)]. - (j := j + 1) <= count] - ifFalse: [false]]]. - ^collisions! Item was removed: - ----- Method: BouncingAtomsMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.8 - g: 1.0 - b: 0.8! Item was removed: - ----- Method: BouncingAtomsMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Clear the damageReported flag when redrawn." - - super drawOn: aCanvas. - damageReported := false.! Item was removed: - ----- Method: BouncingAtomsMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - damageReported := false. - self extent: 400 @ 250. - - infectionHistory := OrderedCollection new. - transmitInfection := false. - self addAtoms: 30! Item was removed: - ----- Method: BouncingAtomsMorph>>intoWorld: (in category 'initialization') ----- - intoWorld: newOwner - "Make sure report damage at least once" - damageReported := false. - super intoWorld: newOwner. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>invalidRect:from: (in category 'change reporting') ----- - invalidRect: damageRect from: aMorph - "Try setting 'quickRedraw' to true. This invalidates the entire morph, whose bounds typically subsume all it's submorphs. (However, this code checks that assumption and passes through any damage reports for out-of-bounds submorphs. Note that atoms with super-high velocities do occaisionally shoot through the walls!!) An additional optimization is to only submit only damage report per display cycle by using the damageReported flag, which is reset to false when the morph is drawn." - - | quickRedraw | - quickRedraw := true. "false gives the original invalidRect: behavior" - (quickRedraw and: - [(bounds origin <= damageRect topLeft) and: - [damageRect bottomRight <= bounds corner]]) ifTrue: [ - "can use quick redraw if damage is within my bounds" - damageReported ifFalse: [super invalidRect: bounds from: self]. "just report once" - damageReported := true. - ] ifFalse: [super invalidRect: damageRect from: aMorph]. "ordinary damage report"! Item was removed: - ----- Method: BouncingAtomsMorph>>justDroppedInto:event: (in category 'initialization') ----- - justDroppedInto: aWorld event: evt - - damageReported := false. - self changed - - ! Item was removed: - ----- Method: BouncingAtomsMorph>>setAtomCount (in category 'menu') ----- - setAtomCount - - | countString count | - countString := UIManager default - request: 'Number of atoms?' - initialAnswer: self submorphCount printString. - countString isEmpty ifTrue: [^ self]. - count := Integer readFrom: (ReadStream on: countString). - self removeAllMorphs. - self addAtoms: count. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>showInfectionHistory: (in category 'other') ----- - showInfectionHistory: evt - "Place a graph of the infection history in the world." - - | graph | - infectionHistory isEmpty ifTrue: [^ self]. - graph := GraphMorph new data: infectionHistory. - graph extent: ((infectionHistory size + (2 * graph borderWidth) + 5)@(infectionHistory last max: 50)). - evt hand attachMorph: graph. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>startInfection (in category 'menu') ----- - startInfection - - self submorphsDo: [:m | m infected: false]. - self firstSubmorph infected: true. - infectionHistory := OrderedCollection new: 500. - transmitInfection := true. - self startStepping. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>step (in category 'stepping and presenter') ----- - step - "Bounce those atoms!!" - - | r bounces | - super step. - bounces := 0. - r := bounds origin corner: (bounds corner - (8 at 8)). - self submorphsDo: [ :m | - (m isMemberOf: AtomMorph) ifTrue: [ - (m bounceIn: r) ifTrue: [bounces := bounces + 1]]]. - "compute a 'temperature' that is proportional to the number of bounces - divided by the circumference of the enclosing rectangle" - self updateTemperature: (10000.0 * bounces) / (r width + r height). - transmitInfection ifTrue: [self transmitInfection]. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "As fast as possible." - - ^ 0 - ! Item was removed: - ----- Method: BouncingAtomsMorph>>transmitInfection (in category 'other') ----- - transmitInfection - - | count | - self collisionPairs do: [:pair | | infected | - infected := false. - pair do: [:atom | atom infected ifTrue: [infected := true]]. - infected - ifTrue: [pair do: [:atom | atom infected: true]]]. - - count := 0. - self submorphsDo: [:m | m infected ifTrue: [count := count + 1]]. - infectionHistory addLast: count. - count = submorphs size ifTrue: [ - transmitInfection := false. - self stopStepping]. - ! Item was removed: - ----- Method: BouncingAtomsMorph>>updateTemperature: (in category 'other') ----- - updateTemperature: currentTemperature - "Record the current temperature, which is taken to be the number of atoms that have bounced in the last cycle. To avoid too much jitter in the reading, the last several readings are averaged." - - recentTemperatures isNil - ifTrue: - [recentTemperatures := OrderedCollection new. - 20 timesRepeat: [recentTemperatures add: 0]]. - recentTemperatures removeLast. - recentTemperatures addFirst: currentTemperature. - temperature := recentTemperatures sum asFloat / recentTemperatures size! Item was removed: - FlattenEncoder subclass: #ByteEncoder - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Filters'! Item was removed: - ----- Method: ByteEncoder class>>defaultTarget (in category 'configuring') ----- - defaultTarget - ^WriteStream on:(String new: 40000).! Item was removed: - ----- Method: ByteEncoder class>>filterSelector (in category 'configuring') ----- - filterSelector - ^#byteEncode:.! Item was removed: - ----- Method: ByteEncoder class>>numberDefaultBase (in category 'configuring') ----- - numberDefaultBase - ^10. - ! Item was removed: - ----- Method: ByteEncoder>>cr (in category 'writing') ----- - cr - ^target cr. - ! Item was removed: - ----- Method: ByteEncoder>>elementSeparator (in category 'filter streaming') ----- - elementSeparator - ^' '.! Item was removed: - ----- Method: ByteEncoder>>nextPut: (in category 'writing') ----- - nextPut: encodedObject - "pass through for stream compatibility" - ^target nextPut: encodedObject. - ! Item was removed: - ----- Method: ByteEncoder>>nextPutAll: (in category 'writing') ----- - nextPutAll: encodedObject - "pass through for stream compatibility" - ^target nextPutAll: encodedObject. - ! Item was removed: - ----- Method: ByteEncoder>>numberDefaultBase (in category 'accessing') ----- - numberDefaultBase - ^self class numberDefaultBase. - ! Item was removed: - ----- Method: ByteEncoder>>print: (in category 'writing') ----- - print:encodedObject - ^target write:encodedObject. - ! Item was removed: - ----- Method: ByteEncoder>>space (in category 'writing') ----- - space - ^target space. - ! Item was removed: - ----- Method: ByteEncoder>>tab (in category 'writing') ----- - tab - ^target tab. - ! Item was removed: - ----- Method: ByteEncoder>>writeArray: (in category 'writing') ----- - writeArray:aCollection - ^self writeArrayedCollection:aCollection. - - ! Item was removed: - ----- Method: ByteEncoder>>writeAssocation: (in category 'writing') ----- - writeAssocation:anAssociation - ^self write:anAssociation key; print:'->'; write:anAssociation value. - - ! Item was removed: - ----- Method: ByteEncoder>>writeCollection: (in category 'writing') ----- - writeCollection:aCollection - ^self print:aCollection class name; - writeCollectionContents:aCollection. - - ! Item was removed: - ----- Method: ByteEncoder>>writeCollectionContents: (in category 'writing') ----- - writeCollectionContents:aCollection - self print:'( '. - super writeCollectionContents:aCollection. - self print:')'. - ^self. - ! Item was removed: - ----- Method: ByteEncoder>>writeNumber: (in category 'writing') ----- - writeNumber:aNumber - ^self writeNumber:aNumber base:self numberDefaultBase. - - ! Item was removed: - ----- Method: ByteEncoder>>writeNumber:base: (in category 'writing') ----- - writeNumber:aNumber base:aBase - ^aNumber byteEncode:self base:aBase. - - ! Item was removed: - ----- Method: ByteEncoder>>writeObject: (in category 'writing') ----- - writeObject:anObject - ^self print:anObject stringRepresentation. - ! Item was removed: - ----- Method: ByteEncoder>>writeString: (in category 'writing') ----- - writeString:aString - ^aString encodeDoublingQuoteOn:self.! Item was removed: - PluggableCanvas subclass: #CachingCanvas - instanceVariableNames: 'cacheCanvas mainCanvas' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !CachingCanvas commentStamp: '<historical>' prior: 0! - A canvas which has a hidden form caching the events. contentsOfArea:into: uses the cache, instead of the main canvas. This is typically used with remote canvases, where querying the bits would involve a network transaction. - ! Item was removed: - ----- Method: CachingCanvas class>>on: (in category 'instance creation') ----- - on: aCanvas - ^super new mainCanvas: aCanvas! Item was removed: - ----- Method: CachingCanvas>>allocateForm: (in category 'canvas methods') ----- - allocateForm: extentPoint - - ^cacheCanvas form allocateForm: extentPoint! Item was removed: - ----- Method: CachingCanvas>>apply: (in category 'private') ----- - apply: aBlock - aBlock value: cacheCanvas. - aBlock value: mainCanvas.! Item was removed: - ----- Method: CachingCanvas>>contentsOfArea:into: (in category 'accessing') ----- - contentsOfArea: area into: aForm - ^cacheCanvas contentsOfArea: area into: aForm! Item was removed: - ----- Method: CachingCanvas>>form (in category 'accessing') ----- - form - ^cacheCanvas form! Item was removed: - ----- Method: CachingCanvas>>mainCanvas: (in category 'initialization') ----- - mainCanvas: mainCanvas0 - mainCanvas := mainCanvas0. - cacheCanvas := FormCanvas extent: mainCanvas extent depth: mainCanvas depth.! Item was removed: - ----- Method: CachingCanvas>>showAt:invalidRects: (in category 'canvas methods') ----- - showAt: pt invalidRects: rects - - mainCanvas showAt: pt invalidRects: rects! Item was removed: - Object subclass: #CameraInterface - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-WebCam'! - - !CameraInterface commentStamp: 'eem 10/16/2020 10:53' prior: 0! - CameraInterface: Simple cross-platform webcam access interface adapted from MIT Scratch. Changes made so that different cameras can be tested when more than one is connected, and so that the interface is simpler and may be interrupt-driven. - - [| form | - form := Form extent: 352 @ 288 depth: 32. - CameraInterface - openCamera: 1 width: form width height: form height; - trySetSemaphoreForCamera: 1. - [Sensor noButtonPressed] whileTrue: - [CameraInterface - waitForNextFrame: 1 timeout: 2000; - getFrameForCamera: 1 into: form bits. - form displayAt: Sensor cursorPoint]] ensure: [CameraInterface closeCamera: 1] - - Copyright (c) 2009 Massachusetts Institute of Technology - - Permission is hereby granted, free of charge, to any person obtaining a copy - of this software and associated documentation files (the "Software"), to deal - in the Software without restriction, including without limitation the rights - to use, copy, modify, merge, publish, distribute, sublicense, and/or sell - copies of the Software, and to permit persons to whom the Software is - furnished to do so, subject to the following conditions: - - The above copyright notice and this permission notice shall be included in - all copies or substantial portions of the Software. - - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, - OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN - THE SOFTWARE.! Item was removed: - ----- Method: CameraInterface class>>bufferedInterruptDrivenVideoTest: (in category 'test') ----- - bufferedInterruptDrivenVideoTest: camNum - "A quick test of video input. Displays video on the screen until the mouse is pressed. - Answer nil if the interrupt-driven interface is unavailable." - "self bufferedInterruptDrivenVideoTest: 1" - "self bufferedInterruptDrivenVideoTest: 2" - "[self bufferedInterruptDrivenVideoTest: 2] fork. - self bufferedInterruptDrivenVideoTest: 1" - - | semaphore height frameExtent frameBuffer | - height := 16. - 1 to: camNum - 1 do: - [:camIndex| "N.B. the extent of an unopened camera is 0 at 0" - height := height + (self frameExtent: camIndex) y + 16]. - (self cameraIsOpen: camNum) ifFalse: - [(self openCamera: camNum width: 352 height: 288) ifNil: - [self inform: 'no camera'. - ^nil]]. - frameExtent := self frameExtent: camNum. - frameBuffer := Form extent: frameExtent depth: 32. - frameBuffer bits pin. - self camera: camNum setFrameBuffer: frameBuffer bits. - - semaphore := Semaphore new. - [self camera: camNum setSemaphore: (Smalltalk registerExternalObject: semaphore)] - on: Error - do: [:err| - Smalltalk unregisterExternalObject: semaphore. - self inform: 'interrupt-driven camera interface unavailable: ', err messageText. - ^nil]. - [| n startTime frameCount msecs fps | - [semaphore wait. - startTime ifNil: - [frameCount := 0. - frameExtent := self frameExtent: camNum. - "N.B. the actual frame size may not be determined until delivery of the first frame. - So resize the form if necessary." - frameExtent ~= frameBuffer extent ifTrue: - [frameBuffer := Form extent: frameExtent depth: 32 bits: frameBuffer bits]. - startTime := Time millisecondClockValue]. - Sensor anyButtonPressed] whileFalse: - [n := self getFrameForCamera: camNum into: frameBuffer bits. - n > 0 ifTrue: - [frameCount := frameCount + 1. - frameBuffer displayAt: 16 @ height]]. - msecs := Time millisecondClockValue - startTime. - fps := (frameCount * 1000) // msecs. - ^(self cameraName: camNum), ': ', frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec'] - ensure: - [self closeCamera: camNum. - Smalltalk unregisterExternalObject: semaphore. - Sensor waitNoButton]! Item was removed: - ----- Method: CameraInterface class>>camera:framesDo:while: (in category 'utilities') ----- - camera: cameraNum framesDo: aBlock while: whileBlock - "Evaluate aBlock every time a frame becomes available. Answer a tuple of frames per second - and the number of 16ms delays per second if polling is used, plus indications of which schemes - were used. Be destructive; use only one bitmap, overwriting its contents with each successive frame. - Use the buffered interface if possible. It is the sender's responsibility to open and close the camera." - | form bitmap schemes delay start duration frameCount delayCount semaphore | - form := Form - extent: (self frameExtent: cameraNum) - depth: 32. - bitmap := form bits. - bitmap pin. - schemes := Array new writeStream. - [self camera: cameraNum setFrameBuffer: bitmap. - schemes nextPut: 'buffered'] - on: Error - do: [:err| - bitmap unpin. - schemes nextPut: 'copied']. - semaphore := Semaphore new. - [self camera: cameraNum setSemaphore: (Smalltalk registerExternalObject: semaphore). - schemes nextPut: 'interrupt driven'] - on: Error - do: [:err| - Smalltalk unregisterExternalObject: semaphore. - semaphore := nil. - schemes nextPut: 'polling']. - delay := Delay forMilliseconds: (1000 / 60) asInteger. "60 fps is fast" - - start := Time utcMicrosecondClock. - frameCount := delayCount := 0. - [semaphore ifNotNil: - [semaphore wait]. - [(self getFrameForCamera: cameraNum into: bitmap) <= 0] whileTrue: - [delay wait. delayCount := delayCount + 1]. - frameCount := frameCount + 1. - aBlock value: form. - whileBlock value] whileTrue. - ^{ frameCount * 1.0e6 / (duration := Time utcMicrosecondClock - start). - delayCount * 1.0e6 / duration }, - schemes contents - - "| cameraNum | - self openCamera: (cameraNum := 1) width: 640 height: 480. - self waitForCameraStart: cameraNum. - [self camera: cameraNum framesDo: [:bitmap| bitmap display] while: [Sensor noButtonPressed]] ensure: - [self closeCamera: cameraNum]"! Item was removed: - ----- Method: CameraInterface class>>camera:getParam: (in category 'camera ops') ----- - camera: cameraNum getParam: paramNum - "Answer the given parameter for the given camera. - param 1 is the frame count, the number of frames grabbed since the last send of getFrameForCamera:into: - param 2 is the size of the bitmap in bytes required for an image" - - <primitive: 'primGetParam' module: 'CameraPlugin' error: ec> - ^nil - ! Item was removed: - ----- Method: CameraInterface class>>camera:setFrameBuffer: (in category 'camera ops') ----- - camera: cameraNum setFrameBuffer: frameBuffer - "Set a pinned non-pointer object as the frame buffer for the camera. - Fail if cameraNum does not reference an open camera, or if the buffer is not large enough." - <primitive: 'primSetCameraBuffers' module: 'CameraPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: CameraInterface class>>camera:setFrameBufferA:B: (in category 'camera ops') ----- - camera: cameraNum setFrameBufferA: frameBufferA B: frameBufferBOrNil - "Set a pair of pinned non-pointer objects as the frame buffers for the camera. - If both are non-nil the plugin will fill them alternating between first frameBufferA and second frameBufferBOrNil. - Fail if frameBufferBOrNil is not nil and a different size from frameBufferA. - Fail if cameraNum does not reference an open camera, or if the buffers are not large enough." - <primitive: 'primSetCameraBuffers' module: 'CameraPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: CameraInterface class>>camera:setSemaphore: (in category 'camera ops') ----- - camera: cameraNum setSemaphore: semaphoreIndex - "Set an external semaphore index through which to signal that a frame is available. - Fail if cameraNum does not reference an open camera, or if the platform does not - support interrupt-driven frame receipt." - <primitive: 'primSetCameraSemaphore' module: 'CameraPlugin' error: ec> - ^self primitiveFailed! Item was removed: - ----- Method: CameraInterface class>>cameraDevices (in category 'utilities') ----- - cameraDevices - "CameraInterface cameraDevices" - ^Array streamContents: - [:s| | i | - i := 1. - [(self cameraName: i) - ifNotNil: [:cameraName| s nextPut: cameraName. true] - ifNil: [false]] whileTrue: [i := i + 1]]! Item was removed: - ----- Method: CameraInterface class>>cameraGetSemaphore: (in category 'camera ops') ----- - cameraGetSemaphore: cameraNum - "Answer the external semaphore index through which to signal that a frame is available. - Fail if cameraNum has not had a semaphore index set, or is otherwise invalid. - Answer nil on failure for convenience." - <primitive: 'primGetCameraSemaphore' module: 'CameraPlugin' error: ec> - ^nil! Item was removed: - ----- Method: CameraInterface class>>cameraIsAvailable (in category 'camera ops') ----- - cameraIsAvailable - "Answer true if at least one camera is available." - - ^(self cameraName: 1) notNil - ! Item was removed: - ----- Method: CameraInterface class>>cameraIsOpen: (in category 'camera ops') ----- - cameraIsOpen: cameraNum - "Answer true if the camera is open." - - ^ (self packedFrameExtent: cameraNum) > 0 - ! Item was removed: - ----- Method: CameraInterface class>>cameraName: (in category 'camera ops') ----- - cameraName: cameraNum - "Answer the name of the given camera. Answer nil if there is no camera with the given number." - - <primitive: 'primCameraName' module: 'CameraPlugin'> - ^ nil - ! Item was removed: - ----- Method: CameraInterface class>>cameraUID: (in category 'camera ops') ----- - cameraUID: cameraNum - "Answer the unique ID of the given camera. Answer nil if there is no camera with the given number." - - <primitive: 'primCameraUID' module: 'CameraPlugin'> - ^ nil - - "CameraInterface cameraUID: 1"! Item was removed: - ----- Method: CameraInterface class>>closeCamera: (in category 'camera ops') ----- - closeCamera: cameraNum - "Close the camera. Do nothing if it was not open. Unregister any associated semaphore." - - (self cameraGetSemaphore: cameraNum) ifNotNil: - [:semaphoreIndex| - Smalltalk unregisterExternalObject: (Smalltalk externalObjectAt: semaphoreIndex ifAbsent: nil)]. - self primitiveCloseCamera: cameraNum! Item was removed: - ----- Method: CameraInterface class>>declareCVarsIn: (in category 'translation') ----- - declareCVarsIn: aCCodeGenerator - "self translate" - - super declareCVarsIn: aCCodeGenerator. - aCCodeGenerator cExtras: ' - #include "cameraOps.h" - #include <string.h> - '.! Item was removed: - ----- Method: CameraInterface class>>frameExtent: (in category 'camera ops') ----- - frameExtent: cameraNum - "Answer the frame extent of the currently open camera, or zero if the camera isn't open." - - | packedExtent | - packedExtent := self packedFrameExtent: cameraNum. - ^ (packedExtent bitShift: -16) @ (packedExtent bitAnd: 16rFFFF) ! Item was removed: - ----- Method: CameraInterface class>>getFrameForCamera:into: (in category 'camera ops') ----- - getFrameForCamera: cameraNum into: aBitmap - "Copy a camera frame into the given Bitmap. The Bitmap should be a Form of depth 32 that is the same width and height as the current camera frame. Fail if the camera is not open or if the bitmap is not the right size. If successful, answer the number of frames received from the camera since the last call. If this is zero, then there has been no change." - - <primitive: 'primGetFrame' module: 'CameraPlugin'> - ^ 0! Item was removed: - ----- Method: CameraInterface class>>interruptDrivenVideoTest: (in category 'test') ----- - interruptDrivenVideoTest: camNum - "A quick test of video input. Displays video on the screen until the mouse is pressed. - Answer nil if the interrupt-driven interface is unavailable." - "self interruptDrivenVideoTest: 1" - "self interruptDrivenVideoTest: 2" - "[self interruptDrivenVideoTest: 2] fork. - self interruptDrivenVideoTest: 1" - - | semaphore height frameExtent | - height := 16. - 1 to: camNum - 1 do: - [:camIndex| "N.B. the extent of an unopened camera is 0 at 0" - height := height + (self frameExtent: camIndex) y + 16]. - (self cameraIsOpen: camNum) ifFalse: - [(self openCamera: camNum width: 352 height: 288) ifNil: - [self inform: 'no camera'. - ^nil]]. - semaphore := Semaphore new. - [self camera: camNum setSemaphore: (Smalltalk registerExternalObject: semaphore)] - on: Error - do: [:err| - Smalltalk unregisterExternalObject: semaphore. - self inform: 'interrupt-driven camera interface unavailable: ', err messageText. - ^nil]. - [| f n startTime frameCount msecs fps | - [semaphore wait. - "N.B. the frame extent may not be known until the delivery of the first frame. - So we have to delay initialization." - startTime ifNil: - [(frameExtent := self frameExtent: camNum) x = 0 ifTrue: [self inform: 'no camera'. ^nil]. - f := Form extent: (self frameExtent: camNum) depth: 32. - frameCount := 0. - startTime := Time millisecondClockValue]. - Sensor anyButtonPressed] whileFalse: - [n := self getFrameForCamera: camNum into: f bits. - n > 0 ifTrue: - [frameCount := frameCount + 1. - f displayAt: 16 @ height]]. - msecs := Time millisecondClockValue - startTime. - fps := (frameCount * 1000) // msecs. - ^(self cameraName: camNum), ': ', frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec'] - ensure: - [self closeCamera: camNum. - Smalltalk unregisterExternalObject: semaphore. - Sensor waitNoButton]! Item was removed: - ----- Method: CameraInterface class>>openCamera:width:height: (in category 'camera ops') ----- - openCamera: cameraNum width: frameWidth height: frameHeight - "Open the given camera requesting the given frame dimensions. The camera number is usually 1 since you typically have only one camera plugged in. If the camera does not support the exact frame dimensions, an available frame size with width >= the requested width is selected." - - <primitive: 'primOpenCamera' module: 'CameraPlugin'> - ^ nil - ! Item was removed: - ----- Method: CameraInterface class>>packedFrameExtent: (in category 'camera ops') ----- - packedFrameExtent: cameraNum - "Answer the extent of the currently open camera packed in an integer. The top 16 bits are the width, the low 16 bits are the height. Answer zero if the camera isn't open." - - <primitive: 'primFrameExtent' module: 'CameraPlugin'> - ^ 0 - ! Item was removed: - ----- Method: CameraInterface class>>primitiveCloseCamera: (in category 'private-primitives') ----- - primitiveCloseCamera: cameraNum - "Close the camera. Do nothing if it was not open except answering nil." - - <primitive: 'primCloseCamera' module: 'CameraPlugin'> - ^nil! Item was removed: - ----- Method: CameraInterface class>>trySetSemaphoreForCamera: (in category 'utilities') ----- - trySetSemaphoreForCamera: camNum - "Attempt to set a semaphore to be signalled when a frame is available. - Fail silently. Use e.g. waitForCameraStart: or waitForNextFrame: to - access the semaphore if available." - | semaphore | - Smalltalk registerExternalObject: (semaphore := Semaphore new). - [CameraInterface camera: camNum setSemaphore: semaphore] - on: Error - do: [:err| - Smalltalk unregisterExternalObject: semaphore]! Item was removed: - ----- Method: CameraInterface class>>videoTest: (in category 'test') ----- - videoTest: camNum - "A quick test of video input. Displays video on the screen until the mouse is pressed." - "self videoTest: 1" - "self videoTest: 2" - - | frameExtent f n startTime frameCount msecs fps | - (self cameraIsOpen: camNum) ifFalse: - [(self openCamera: camNum width: 320 height: 240) ifNil: - [self inform: 'no camera'. - ^nil]]. - self waitForCameraStart: camNum. - (frameExtent := self frameExtent: camNum) x = 0 ifTrue: [^ self inform: 'no camera']. - f := Form extent: (self frameExtent: camNum) depth: 32. - frameCount := 0. - startTime := nil. - [Sensor anyButtonPressed] whileFalse: - [n := self getFrameForCamera: camNum into: f bits. - n > 0 ifTrue: - [startTime ifNil: [startTime := Time millisecondClockValue]. - frameCount := frameCount + 1. - f display]]. - Sensor waitNoButton. - msecs := Time millisecondClockValue - startTime. - self closeCamera: camNum. - fps := frameCount * 1000 // msecs. - ^(self cameraName: camNum), ': ', frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec'! Item was removed: - ----- Method: CameraInterface class>>waitForCameraStart: (in category 'utilities') ----- - waitForCameraStart: camNum - "Wait for the camera to get it's first frame (indicated by a non-zero frame extent. Timeout after two seconds." - "self waitForCameraStart: 1" - - | startTime | - (self cameraGetSemaphore: camNum) ifNotNil: - [:semaphoreIndex| - (Smalltalk externalObjectAt: semaphoreIndex ifAbsent: [self error: 'seriously?!!?!!?!!?']) wait. - ^self]. - startTime := Time utcMicrosecondClock. - [(self packedFrameExtent: camNum) > 0 ifTrue: [^ self]. - (Time utcMicrosecondClock - startTime) < 2000000] whileTrue: - [(Delay forMilliseconds: 50) wait]! Item was removed: - ----- Method: CameraInterface class>>waitForNextFrame:timeout: (in category 'utilities') ----- - waitForNextFrame: camNum timeout: timeoutms - "Wait for the camera to get it's first frame (indicated by a non-zero frame extent. Timeout after two seconds." - "self waitForNextFrame: 1 timeout: 2000" - - | now timeoutusecs | - (self cameraGetSemaphore: camNum) ifNotNil: - [:semaphoreIndex| - (Smalltalk externalObjectAt: semaphoreIndex ifAbsent: [self error: 'seriously?!!?!!?!!?']) waitTimeoutMSecs: timeoutms. - ^self]. - now := Time utcMicrosecondClock. - timeoutusecs := timeoutms * 1000. - [(self camera: camNum getParam: 1) > 0 ifTrue: [^self]. - (Time utcMicrosecondClock - now) < timeoutusecs] whileTrue: - [(Delay forMilliseconds: 50) wait]! Item was removed: - ----- Method: Canvas>>paragraph2:bounds:color: (in category '*MorphicExtras-drawing') ----- - paragraph2: para bounds: bounds color: c - - | scanner | - scanner := CanvasCharacterScanner new. - scanner - canvas: self; - text: para text textStyle: para textStyle; - textColor: c. - - para displayOn: self using: scanner at: bounds topLeft. - ! Item was removed: - DisplayScanner subclass: #CanvasCharacterScanner - instanceVariableNames: 'canvas' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !CanvasCharacterScanner commentStamp: 'nice 10/12/2013 01:37' prior: 0! - A CanvasCharacterScanner is displaying characters onto a Morphic canvas. - - Instance Variables - canvas: <Canvas> - - canvas - - the canvas on which characters are displayed - - ! Item was removed: - ----- Method: CanvasCharacterScanner>>canvas: (in category 'accessing') ----- - canvas: aCanvas - "set the canvas to draw on" - canvas ifNotNil: [ self inform: 'initializing twice!!' ]. - canvas := aCanvas! Item was removed: - ----- Method: CanvasCharacterScanner>>convertToCurrentVersion:refStream: (in category 'object fileIn') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - "From Squeak3.5 [latest update: #5180] on 17 June 2003" - varDict at: 'defaultTextColor' put: Color black. - ^ super convertToCurrentVersion: varDict refStream: smartRefStrm! Item was removed: - ----- Method: CanvasCharacterScanner>>displayEmbeddedForm: (in category 'displaying') ----- - displayEmbeddedForm: aForm - canvas - drawImage: aForm - at: destX @ (lineY + line baseline - aForm height)! Item was removed: - ----- Method: CanvasCharacterScanner>>displayString:from:to:at: (in category 'displaying') ----- - displayString: string from: startIndex to: stopIndex at: aPoint - canvas - drawString: string - from: startIndex - to: stopIndex - at: aPoint - font: font - color: foregroundColor.! Item was removed: - ----- Method: CanvasCharacterScanner>>fillTextBackground (in category 'displaying') ----- - fillTextBackground - "do nothing"! Item was removed: - RotaryDialMorph subclass: #ClockDialMorph - instanceVariableNames: 'hourHandMorph' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !ClockDialMorph commentStamp: 'tpr 6/29/2017 13:26' prior: 0! - A ClockDialMorph is a clock implemented as a rotary dial morph. The intersting part of this is having two needles that continuously rotate as opposed to the normal rule of having a single needle limited in range. - - Instance Variables - hourHandMorph: <Morph, typically wrapped ina a TransformationMorph>! Item was removed: - ----- Method: ClockDialMorph>>buildDial (in category 'dial drawing') ----- - buildDial - "start by making a damn big Form, twice the size we want to end up with" - |outerRadius destForm canvas tickLabel tickLength beginAngle endAngle tickAngle maxTicks | - outerRadius := self height - 1. - destForm := Form extent: self extent * 2 depth: 32. - (canvas := destForm getCanvas) fillOval: (0 at 0 extent: self extent * 2) color: Color white. - "outer ring" - self drawArcAt: destForm center radius: outerRadius thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - "inner ring" - self drawArcAt: destForm center radius: outerRadius * 0.97 thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - - "outer scale for degrees" - beginAngle := startAngle . - endAngle := stopAngle. - - maxTicks := stopValue - startValue . - tickAngle := endAngle - beginAngle / maxTicks. - startValue to: stopValue do: [:tick| - tickLength := outerRadius * 0.07. - tickLabel := nil. - tick \\ 6 = 0 ifTrue:["tick every 6 degrees on the outer ring" - self drawTickRadius: outerRadius * 0.9 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - ]. - tick \\ 30 = 0 ifTrue: ["tick every 30 degrees on the inner ring" - self drawTickRadius: outerRadius * 0.83 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - (tick \\ 30 = 0 and: [tick < 360]) ifTrue:["numbered ticks every 30 degrees, don't overwrite 0 with 360" - self tickInnerLabel: (tick // 30) asString fontSize: 24 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.75) + tickLength angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas - ] - ] - ]. - - self addMorph: (destForm magnify: destForm boundingBox by: 0.5 smoothing: 2) asMorph! Item was removed: - ----- Method: ClockDialMorph>>initialize (in category 'initialization') ----- - initialize - "assemble a nice clock morph. The background is an ImageMorph with scale/dial drawn with code adapted from a generous donation of time and effort by Bob Arning; the minute needle is the inherited needleMorph and we added a new hourHandMorph. Both are simple rectangleMorphs" - | pointerMorph | - - super initialize. - - self startAngle: 0 stopAngle: 360; - startValue: 0 stopValue: 360. - self extent: self initialExtent; color: Color transparent; borderWidth: 0. - dialCenter := self center. - - "build the dial background; basic clock with miute ticks and hour long-ticks + arabic numerals" - self buildDial. - - pointerMorph := self basicNeedleOfLength: (self height * 0.45) rounded width: 4 color: Color red. - pointerMorph - position: pointerMorph extent * ( -0.5@ -1); - rotationCenter: 0.5 @ 1. - - "we keep track of the TransformationMorph since that is what we have to rotate" - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - - "additional neelde for the hours" - pointerMorph := self basicNeedleOfLength: (self height * 0.35) rounded width: 6 color: Color black. - pointerMorph - position: pointerMorph extent * ( -0.5@ -1); - rotationCenter: 0.5 @ 1. - - "we keep track of the TransformationMorph since that is what we have to rotate" - hourHandMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: hourHandMorph. - - "add a central colored dot. Because we just do." - self addMorph: (CircleMorph new extent: 8 at 8; color: Color red twiceDarker; center: dialCenter) - ! Item was removed: - ----- Method: ClockDialMorph>>setTime: (in category 'updating') ----- - setTime: aTime - - needleMorph rotationDegrees: aTime minutes * 6 + (aTime seconds / 10). - hourHandMorph rotationDegrees: (aTime hours * 30) + (aTime minutes / 2)! Item was removed: - ----- Method: ClockDialMorph>>step (in category 'stepping and presenter') ----- - step - self setTime: Time now! Item was removed: - ----- Method: ClockDialMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^5000! Item was removed: - StringMorph subclass: #ClockMorph - instanceVariableNames: 'showSeconds show24hr' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: ClockMorph class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - ^ super authoringPrototype contents: Time now printString! Item was removed: - ----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Answer a description for use in parts bins." - - ^ self partName: 'Digital Clock' translatedNoop - categories: {'Just for Fun' translatedNoop} - documentation: 'A digital clock' translatedNoop! Item was removed: - ----- Method: ClockMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop} - forFlapNamed: 'PlugIn Supplies'.]! Item was removed: - ----- Method: ClockMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - "Add toggles for showing-seconds and display-24-hrs to the halo menu" - - "NB: intentionallyi no super call here!!" - - aCustomMenu add: 'change font' translated action: #changeFont. - - aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds. - aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr! Item was removed: - ----- Method: ClockMorph>>balloonText (in category 'accessing') ----- - balloonText - - ^ Date current weekday, ', ', Date current printString! Item was removed: - ----- Method: ClockMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - - super initialize. - - showSeconds := true. - show24hr := false. - self font: Preferences standardMenuFont emphasis: 1. - self step! Item was removed: - ----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - super initializeToStandAlone. - showSeconds := false. - self font: (Preferences standardMenuFont emphasized: 1). - self step! Item was removed: - ----- Method: ClockMorph>>show24hr: (in category '24hr') ----- - show24hr: aBoolean - show24hr := aBoolean! Item was removed: - ----- Method: ClockMorph>>showSeconds: (in category 'seconds') ----- - showSeconds: aBoolean - showSeconds := aBoolean! Item was removed: - ----- Method: ClockMorph>>step (in category 'stepping and presenter') ----- - step - - | time | - super step. - time := String streamContents: [ :stream | - | t | - t := Time now. - t seconds: t asSeconds. "ignore nanoSeconds" - t - print24: (show24hr == true) - showSeconds: (showSeconds == true) - on: stream]. - self contents: time! Item was removed: - ----- Method: ClockMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Answer the desired time between steps in milliseconds." - - ^999! Item was removed: - ----- Method: ClockMorph>>toggleShowing24hr (in category '24hr') ----- - toggleShowing24hr - show24hr := (show24hr == true) not - ! Item was removed: - ----- Method: ClockMorph>>toggleShowingSeconds (in category 'seconds') ----- - toggleShowingSeconds - showSeconds := (showSeconds == true) not - ! Item was removed: - ----- Method: Color>>encodePostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - encodePostscriptOn: aStream - - aStream setrgbcolor:self. - - ! Item was removed: - ----- Method: ColorForm>>encodePostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - encodePostscriptOn: aStream - self unhibernate. - aStream print: '% form contains '; - write: (colors select: [:c | c = Color transparent]) size; - print: ' transparent colors'; - cr. - ^ self asFormWithSingleTransparentColors - printPostscript: aStream operator: (self depth = 1 - ifTrue: ['imagemask'] - ifFalse: [(self indexOfColor: Color transparent) printString , ' transparentimage'])! Item was removed: - ----- Method: ColorForm>>printPostscript: (in category '*MorphicExtras-Postscript Canvases') ----- - printPostscript:aStream - aStream nextPutAll:'% form contains '; - print:((colors select:[:c| c=Color transparent]) size); - nextPutAll:' transparent colors'; cr. - ^self asFormWithSingleTransparentColors printPostscript:aStream operator:(self depth=1 ifTrue:['imagemask'] - ifFalse:[ (self indexOfColor:Color transparent) printString ,' transparentimage']) . - ! Item was removed: - Object subclass: #Command - instanceVariableNames: 'phase cmdWording undoTarget undoSelector undoArguments redoTarget redoSelector redoArguments parameters' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Undo'! - - !Command commentStamp: 'nice 3/25/2010 22:59' prior: 0! - An object representing an undoable command to be done in the environment. - - Structure: - phase indicates whether the cmd is current in undone or redone mode - cmdWording The wording of the command (used in arming the "undo"/"redo" menu items - parameters an IdentityDictionary /NOT USED/ - undoTarget Receiver, selector and arguments to accomplish undo - undoSelector - undoArguments - redoTarget Receiver, selector and arguments to accomplish redo - redoSelector - redoArguments - - To use this, for any command you wish to use, you - * Create an instance of Command, as follows... - cmd := Command new cmdWording: 'resizing'. - * Give the the command undo state and redo state, as follows... - cmd undoTarget: target selector: #extent: argument: oldExtent. - cmd redoTarget: target selector: #extent: argument: newExtent. - * Send a message of the form - Command rememberCommand: cmd - - LastCommand is the last command that was actually done or undone. - - CommandHistory, applicable only when infiniteUndo is set, holds a 'tape' of the complete history of commands, as far back as it's possible to go. - - CommandExcursions, also applicable only in the infiniteUndo case, and rather at the fringe even then, holds segments of former CommandHistory that have been lopped off because of variant paths taken.! Item was removed: - ----- Method: Command class>>cleanUp (in category 'initialize-release') ----- - cleanUp - - MorphExtension allInstancesDo: [ :each | each removeUndoCommands ]! Item was removed: - ----- Method: Command class>>redoEnabled (in category 'dog simple ui') ----- - redoEnabled - | w | - ^(w := self currentWorld) == nil ifTrue:[false] ifFalse:[w commandHistory redoEnabled]! Item was removed: - ----- Method: Command class>>redoNextCommand (in category 'dog simple ui') ----- - redoNextCommand - | w | - ^(w := self currentWorld) == nil ifFalse:[w commandHistory redoNextCommand]! Item was removed: - ----- Method: Command class>>undoEnabled (in category 'dog simple ui') ----- - undoEnabled - | w | - ^(w := self currentWorld) == nil ifTrue:[false] ifFalse:[w commandHistory undoEnabled]! Item was removed: - ----- Method: Command class>>undoLastCommand (in category 'dog simple ui') ----- - undoLastCommand - | w | - ^(w := self currentWorld) == nil ifFalse:[w commandHistory undoLastCommand]! Item was removed: - ----- Method: Command class>>undoRedoButtons (in category 'dog simple ui') ----- - undoRedoButtons - "Answer a morph that offers undo and redo buttons" - - | wrapper | - "self currentHand attachMorph: Command undoRedoButtons" - wrapper := AlignmentMorph newColumn. - wrapper color: Color veryVeryLightGray lighter; - borderWidth: 0; - layoutInset: 0; - vResizing: #shrinkWrap; - hResizing: #shrinkWrap. - #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) - (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: - [:tuple | - | aButton | - wrapper addTransparentSpacerOfSize: (8 at 0). - aButton := UpdatingThreePhaseButtonMorph new. - aButton - onImage: (ScriptingSystem formAtKey: tuple first); - offImage: (ScriptingSystem formAtKey: tuple fifth); - pressedImage: (ScriptingSystem formAtKey: tuple sixth); - getSelector: tuple fourth; - color: Color transparent; - target: self; - actionSelector: tuple second; - setNameTo: tuple second; - setBalloonText: tuple third; - extent: aButton onImage extent. - wrapper addMorphBack: aButton. - wrapper addTransparentSpacerOfSize: (8 at 0)]. - ^ wrapper! Item was removed: - ----- Method: Command class>>zapObsolete (in category 'class initialization') ----- - zapObsolete - "Command zapObsolete" - "kill some obsolete stuff still retained by the CompiledMethods in change records" - - | before after histories lastCmd histCount lastCount | - Smalltalk garbageCollect. - before := Command allInstances size. - histories := Association allInstances select: [ :each | - each key == #CommandHistory and: [ - (each value isKindOf: OrderedCollection) and: [ - each value isEmpty not and: [ - each value first isKindOf: Command]]] - ]. - histCount := histories size. - lastCmd := Association allInstances select: [ :each | - each key == #LastCommand and: [each value isKindOf: Command] - ]. - lastCount := lastCmd size. - histories do: [ :each | each value: OrderedCollection new]. - lastCmd do: [ :each | each value: Command new]. - Smalltalk garbageCollect. - Smalltalk garbageCollect. - after := Command allInstances size. - Transcript show: {before. after. histCount. histories. lastCount. lastCmd} printString; cr; cr. - ! Item was removed: - ----- Method: Command>>assuredParameterDictionary (in category 'private') ----- - assuredParameterDictionary - "Private!! Answer the parameters dictionary, creating it if necessary" - - ^ parameters ifNil: [parameters := IdentityDictionary new]! Item was removed: - ----- Method: Command>>cmdWording (in category 'private') ----- - cmdWording - "Answer the wording to be used to refer to the command in a menu" - - ^ cmdWording ifNil: ['last command' translated]! Item was removed: - ----- Method: Command>>cmdWording: (in category 'initialization') ----- - cmdWording: wrd - "Set the wording to be used in a menu item referring to the receiver" - - cmdWording := wrd! Item was removed: - ----- Method: Command>>doCommand (in category 'command execution') ----- - doCommand - "Do the command represented by the receiver. Not actually called by active current code, but reachable by the not-yet-unsealed promoteToCurrent: action." - - redoTarget ifNotNil: [redoTarget perform: redoSelector withArguments: redoArguments]! Item was removed: - ----- Method: Command>>parameterAt: (in category 'parameters') ----- - parameterAt: aSymbol - "Answer the parameter stored at the given symbol, or nil if none" - - ^ self parameterAt: aSymbol ifAbsent: [nil]! Item was removed: - ----- Method: Command>>parameterAt:ifAbsent: (in category 'parameters') ----- - parameterAt: aSymbol ifAbsent: aBlock - "Answer the parameter stored at the aSymbol, but if none, return the result of evaluating aBlock" - - ^ self assuredParameterDictionary at: aSymbol ifAbsent: aBlock! Item was removed: - ----- Method: Command>>parameterAt:put: (in category 'parameters') ----- - parameterAt: aSymbol put: aValue - "Place aValue in the parameters dictionary using aSymbol as key" - - ^ self assuredParameterDictionary at: aSymbol put: aValue! Item was removed: - ----- Method: Command>>phase (in category 'private') ----- - phase - "Answer the phase of the command" - - ^ phase! Item was removed: - ----- Method: Command>>phase: (in category 'initialization') ----- - phase: aPhase - "Set the phase of the command to the supplied symbol" - - phase := aPhase! Item was removed: - ----- Method: Command>>printOn: (in category 'printing') ----- - printOn: aStream - "Provide more detailed info about the receiver, put in for debugging, maybe should be removed" - - super printOn: aStream. - aStream nextPutAll: ' phase: ', phase printString. - cmdWording ifNotNil: [aStream nextPutAll: '; ', cmdWording asString]. - parameters ifNotNil: - [parameters associationsDo: - [:assoc | aStream nextPutAll: ': ', assoc printString]]! Item was removed: - ----- Method: Command>>redoCommand (in category 'command execution') ----- - redoCommand - "Perform the 'redo' operation" - - redoTarget ifNotNil: [redoTarget perform: redoSelector withArguments: redoArguments]! Item was removed: - ----- Method: Command>>redoTarget:selector:argument: (in category 'initialization') ----- - redoTarget: target selector: aSymbol argument: argument - - ^ self redoTarget: target selector: aSymbol arguments: {argument}! Item was removed: - ----- Method: Command>>redoTarget:selector:arguments: (in category 'initialization') ----- - redoTarget: target selector: selector arguments: arguments - "Give target morph a chance to refine its undo operation" - - target refineRedoTarget: target selector: selector arguments: arguments in: - [:rTarget :rSelector :rArguments | - redoTarget := rTarget. - redoSelector := rSelector. - redoArguments := rArguments]! Item was removed: - ----- Method: Command>>stillValid (in category 'command execution') ----- - stillValid - "Answer whether the receiver is still valid." - - ^ (undoTarget isMorph and: [undoTarget isInWorld]) or: [redoTarget isMorph and: [redoTarget isInWorld]]! Item was removed: - ----- Method: Command>>undoCommand (in category 'command execution') ----- - undoCommand - "Perform the 'undo' operation" - - undoTarget ifNotNil: [undoTarget perform: undoSelector withArguments: undoArguments]! Item was removed: - ----- Method: Command>>undoTarget (in category 'private') ----- - undoTarget - ^ undoTarget! Item was removed: - ----- Method: Command>>undoTarget:selector:argument: (in category 'initialization') ----- - undoTarget: target selector: aSymbol argument: argument - - ^ self undoTarget: target selector: aSymbol arguments: {argument}! Item was removed: - ----- Method: Command>>undoTarget:selector:arguments: (in category 'initialization') ----- - undoTarget: target selector: selector arguments: arguments - "Give target morph a chance to refine its undo operation" - - target refineUndoTarget: target selector: selector arguments: arguments in: - [:rTarget :rSelector :rArguments | - undoTarget := rTarget. - undoSelector := rSelector. - undoArguments := rArguments]! Item was removed: - ----- Method: Command>>veryDeepFixupWith: (in category 'copying') ----- - veryDeepFixupWith: deepCopier - "ALL inst vars were weakly copied. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!" - super veryDeepFixupWith: deepCopier. - 1 to: self class instSize do: - [:ii | - | old | - old := self instVarAt: ii. - self instVarAt: ii put: (deepCopier references at: old ifAbsent: [old])].! Item was removed: - ----- Method: Command>>veryDeepInner: (in category 'copying') ----- - veryDeepInner: deepCopier - "ALL fields are weakly copied!! Can't duplicate an object by duplicating a Command that involves it. See DeepCopier." - - super veryDeepInner: deepCopier. - "just keep old pointers to all fields" - parameters := parameters.! Item was removed: - Object subclass: #CommandHistory - instanceVariableNames: 'lastCommand history excursions' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Undo'! Item was removed: - ----- Method: CommandHistory class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Dump command histories" - - self resetAllHistory - ! Item was removed: - ----- Method: CommandHistory class>>initialize (in category 'class initialization') ----- - initialize - "CommandHistory initialize" - - Smalltalk addToStartUpList: self. - Smalltalk addToShutDownList: self.! Item was removed: - ----- Method: CommandHistory class>>resetAllHistory (in category 'system startup') ----- - resetAllHistory - "Reset all command histories, and make all morphs that might be holding on to undo-grab-commands forget them" - - self allInstancesDo: [:c | c resetCommandHistory]. - MorphExtension withAllSubclassesDo: - [:morphExtensionClass| - morphExtensionClass allInstancesDo: - [:object| object removeProperty: #undoGrabCommand]] - - "CommandHistory resetAllHistory" - ! Item was removed: - ----- Method: CommandHistory class>>shutDown: (in category 'system startup') ----- - shutDown: aboutToQuit - Preferences purgeUndoOnQuit ifTrue: [ - aboutToQuit ifTrue: [self resetAllHistory]. - ]. - ! Item was removed: - ----- Method: CommandHistory class>>startUp: (in category 'system startup') ----- - startUp: aboutToQuit - Preferences purgeUndoOnQuit - ifTrue: [ - aboutToQuit ifTrue: [self resetAllHistory]. - ]. - - ! Item was removed: - ----- Method: CommandHistory>>assureLastCommandStillValid (in category 'called by programmer') ----- - assureLastCommandStillValid - "If the lastCommand is not valid, set it to nil; answer the lastCommand." - - lastCommand ifNotNil: - [lastCommand stillValid ifFalse: - [self cantUndo]]. - ^ lastCommand! Item was removed: - ----- Method: CommandHistory>>cantUndo (in category 'called by programmer') ----- - cantUndo - "Called by client to indicate that the prior undoable command is no longer undoable" - - lastCommand := nil. - history := OrderedCollection new.! Item was removed: - ----- Method: CommandHistory>>commandToUndo (in category 'called from the ui') ----- - commandToUndo - "Undo the last command, i.e. move backward in the recent-commands tape, if possible." - - | anIndex | - lastCommand ifNil: [^ nil]. - lastCommand phase == #done ifTrue: [^ lastCommand]. - (lastCommand phase == #undone and: - [(anIndex := history indexOf: lastCommand) > 1]) - ifTrue: [^ history at: anIndex - 1] - ifFalse: [^ nil] - ! Item was removed: - ----- Method: CommandHistory>>historyIndexOfLastCommand (in category 'command history') ----- - historyIndexOfLastCommand - "Answer which position of the CommandHistory list is occupied by the LastCommand" - - ^ history indexOf: lastCommand! Item was removed: - ----- Method: CommandHistory>>initialize (in category 'initialize') ----- - initialize - lastCommand := nil. - history := OrderedCollection new. - excursions := OrderedCollection new.! Item was removed: - ----- Method: CommandHistory>>lastCommand (in category 'command history') ----- - lastCommand - "Answer the last command done or undone" - - ^ lastCommand! Item was removed: - ----- Method: CommandHistory>>nextCommand (in category 'command history') ----- - nextCommand - "Answer the command object that would be sent the #redoCommand message if the user were to request Redo, or nil if none" - - | anIndex | - lastCommand ifNil: [^ nil]. - lastCommand phase == #undone ifTrue: [^ lastCommand]. - anIndex := history indexOf: lastCommand ifAbsent: [^ nil]. - ^ anIndex = history size ifTrue: [nil] ifFalse: [history at: (anIndex + 1)]! Item was removed: - ----- Method: CommandHistory>>nextCommandToUndo (in category 'menu') ----- - nextCommandToUndo - | anIndex | - lastCommand ifNil: [^ nil]. - lastCommand phase == #done ifTrue: [^ lastCommand]. - (lastCommand phase == #undone and: - [(anIndex := history indexOf: lastCommand) > 1]) - ifTrue: [^ history at: anIndex - 1] - ifFalse: [^ nil]! Item was removed: - ----- Method: CommandHistory>>promoteToCurrent: (in category 'called by programmer') ----- - promoteToCurrent: aCommand - "Very unusual and speculative and unfinished!!. Not currently reachable. For the real thing, we presumably march forward or backward from the current command pointer to the target command in an orderly fashion, doing or undoing each command in turn." - - | itsIndex | - Preferences useUndo ifFalse: [^ self]. - itsIndex := history indexOf: aCommand ifAbsent: [nil]. - itsIndex ifNotNil: - [history remove: aCommand ifAbsent: []]. - history add: (lastCommand := aCommand). - itsIndex < history size ifTrue: - [excursions add: (history copyFrom: (itsIndex to: history size))]. - history := (history copyFrom: 1 to: itsIndex) copyWith: aCommand. - - lastCommand := aCommand. - aCommand doCommand. - lastCommand phase: #done.! Item was removed: - ----- Method: CommandHistory>>purgeAllCommandsSuchThat: (in category 'called by programmer') ----- - purgeAllCommandsSuchThat: cmdBlock - "Remove a bunch of commands, as in [:cmd | cmd undoTarget == zort]" - - Preferences useUndo ifFalse: [^self]. - history := history reject: cmdBlock. - lastCommand := history isEmpty ifTrue: [nil] ifFalse: [history last] ! Item was removed: - ----- Method: CommandHistory>>redoEnabled (in category 'menu') ----- - redoEnabled - "Answer whether the redo command is currently available" - - ^ self nextCommand notNil! Item was removed: - ----- Method: CommandHistory>>redoMenuWording (in category 'menu') ----- - redoMenuWording - "Answer the wording to be used in a menu offering the current - Redo command" - | nextCommand | - - ((nextCommand := self nextCommand) isNil - or: [Preferences useUndo not]) - ifTrue: [^ 'can''t redo' translated]. - - ^ String - streamContents: [:aStream | - aStream nextPutAll: 'redo' translated. - aStream nextPutAll: ' "'. - aStream nextPutAll: (nextCommand cmdWording truncateWithElipsisTo: 20). - aStream nextPut: $". - lastCommand phase == #done - ifFalse: [aStream nextPutAll: ' (z)']]! Item was removed: - ----- Method: CommandHistory>>redoNextCommand (in category 'called from the ui') ----- - redoNextCommand - "If there is a way to 'redo' (move FORWARD) in the undo/redo history tape, do it." - - | anIndex | - lastCommand ifNil: [^ Beeper beep]. - lastCommand phase == #undone - ifFalse: - [anIndex := history indexOf: lastCommand. - (anIndex < history size) - ifTrue: - [lastCommand := history at: anIndex + 1] - ifFalse: - [^ Beeper beep]]. - - lastCommand redoCommand. - lastCommand phase: #done - ! Item was removed: - ----- Method: CommandHistory>>rememberCommand: (in category 'undo') ----- - rememberCommand: aCommand - "Make the supplied command be the 'LastCommand', and mark it 'done'" - - | currentCommandIndex | - Preferences useUndo ifFalse: [^ self]. "Command initialize" - - Preferences infiniteUndo ifTrue: - [currentCommandIndex := history indexOf: lastCommand. - ((currentCommandIndex < history size) and: [Preferences preserveCommandExcursions]) ifTrue: - [excursions add: (history copyFrom: (currentCommandIndex to: history size)). - history := history copyFrom: 1 to: currentCommandIndex]. - history addLast: aCommand]. - - lastCommand := aCommand. - lastCommand phase: #done.! Item was removed: - ----- Method: CommandHistory>>resetCommandHistory (in category 'command history') ----- - resetCommandHistory "CommandHistory allInstancesDo: [:ch | ch resetCommandHistory]" - "Clear out the command history so that no commands are held" - - lastCommand := nil. - history := OrderedCollection new.! Item was removed: - ----- Method: CommandHistory>>undoEnabled (in category 'menu') ----- - undoEnabled - "Answer whether there is an undoable command at the ready" - - ^ lastCommand notNil! Item was removed: - ----- Method: CommandHistory>>undoLastCommand (in category 'called from the ui') ----- - undoLastCommand - "Undo the last command, i.e. move backward in the recent-commands tape, if possible." - - | aPhase anIndex | - lastCommand ifNil: [^ Beeper beep]. - - (aPhase := lastCommand phase) == #done - ifFalse: - [aPhase == #undone - ifTrue: - [anIndex := history indexOf: lastCommand. - anIndex > 1 ifTrue: - [lastCommand := history at: anIndex - 1]]]. - - lastCommand undoCommand. - lastCommand phase: #undone - - "Command undoLastCommand" - ! Item was removed: - ----- Method: CommandHistory>>undoMenuWording (in category 'menu') ----- - undoMenuWording - "Answer the wording to be used in an 'undo' menu item" - - (lastCommand isNil - or: [Preferences useUndo not - or: [(Preferences infiniteUndo not and: [lastCommand phase == #undone]) - or: [self nextCommandToUndo isNil]]]) - ifTrue: [^ 'can''t undo' translated]. - - ^ String - streamContents: [:aStream | - aStream nextPutAll: 'undo' translated. - aStream nextPutAll: ' "'. - aStream nextPutAll: (self nextCommandToUndo cmdWording truncateWithElipsisTo: 20). - aStream nextPut: $". - lastCommand phase == #done - ifTrue: [aStream nextPutAll: ' (z)']].! Item was removed: - ----- Method: CommandHistory>>undoOrRedoCommand (in category 'called from the ui') ----- - undoOrRedoCommand - "This gives a feature comparable to standard Mac undo/redo. If the undo/redo action taken was a simple do or a redo, then undo it. But if the last undo/redo action taken was an undo, then redo it." - - "Command undoOrRedoCommand" - | aPhase | - lastCommand ifNil: [^ Beeper beep]. - - (aPhase := lastCommand phase) == #done - ifTrue: - [lastCommand undoCommand. - lastCommand phase: #undone] - ifFalse: - [aPhase == #undone - ifTrue: - [lastCommand redoCommand. - lastCommand phase: #done]]! Item was removed: - ----- Method: CommandHistory>>undoOrRedoMenuWording (in category 'menu') ----- - undoOrRedoMenuWording - "Answer the wording to be used in a menu item offering undo/redo (i.e., the form used when the #infiniteUndo preference is false)" - - | pre | - self assureLastCommandStillValid. - lastCommand ifNil: [^ 'can''t undo' translated]. - pre := lastCommand phase == #done - ifTrue: ['undo' translated] - ifFalse: ['redo' translated]. - ^ pre, ' "', (lastCommand cmdWording truncateWithElipsisTo: 20), '" (z)'! Item was removed: - ----- Method: CommandHistory>>undoTo (in category 'called from the ui') ----- - undoTo - "Not yet functional, and not yet sent. Allow the user to choose a point somewhere in the undo/redo tape, and undo his way to there. Applicable only if infiniteUndo is set. " - - | anIndex commandList reply | - (anIndex := self historyIndexOfLastCommand) = 0 ifTrue: [^ Beeper beep]. - commandList := history - copyFrom: ((anIndex - 10) max: 1) - to: ((anIndex + 10) min: history size). - reply := UIManager default chooseFrom: (commandList collect: [:cmd | cmd cmdWording truncateWithElipsisTo: 20]) values: commandList title: 'undo or redo to...'. - reply ifNotNil: [self inform: #deferred] - - "ActiveWorld commandHistory undoTo" - ! Item was removed: - RotaryDialMorph subclass: #CompassDialMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !CompassDialMorph commentStamp: 'tpr 4/14/2017 13:21' prior: 0! - A CompassDialMorph shows a navigation compass. Unusually for most dials it has a full 360 degree span.! Item was removed: - ----- Method: CompassDialMorph>>basicNeedleOfLength:width:color: (in category 'needle graphics') ----- - basicNeedleOfLength: nLength width: nWidth color: aColor - "make a really trivial needle as a colored rhombus" - | fancy | - - fancy := Form extent: nWidth at nLength depth: 32. - fancy fillColor: Color transparent. - fancy getCanvas asBalloonCanvas - aaLevel: 4; - drawPolygon: (Array with: (nWidth/ 2)@0 with: (nWidth)@( nLength / 2) with:0@(nLength / 2) with: (nWidth/ 2)@0) fillStyle: aColor borderWidth: 1 borderColor: Color black; - drawPolygon: (Array with: (nWidth)@( nLength / 2) with: (nWidth/ 2)@(nLength) with:0@(nLength / 2) with: (nWidth)@( nLength / 2)) fillStyle: Color black borderWidth: 0 borderColor: Color black. - - ^fancy asMorph. - ! Item was removed: - ----- Method: CompassDialMorph>>buildDial (in category 'dial drawing') ----- - buildDial - "start by making a damn big Form, twice the size we want to end up with" - |outerRadius destForm canvas tickLabel tickLength beginAngle endAngle tickAngle maxTicks | - outerRadius := self height - 1. - destForm := Form extent: self extent * 2 depth: 32. - (canvas := destForm getCanvas) fillOval: (0 at 0 extent: self extent * 2) color: Color white. - "outer ring" - self drawArcAt: destForm center radius: outerRadius thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - "inner ring" - self drawArcAt: destForm center radius: outerRadius * 0.97 thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - - "outer scale for degrees" - beginAngle := startAngle . - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.9 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.83 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.55 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - "We use a simple % range, just one scale" - maxTicks := stopValue - startValue . - tickAngle := endAngle - beginAngle / maxTicks. - startValue to: stopValue do: [:tick| - tickLength := outerRadius * 0.07. - tickLabel := nil. - tick \\ 2 = 0 ifTrue:["tick every 2 degrees on the outer ring" - self drawTickRadius: outerRadius * 0.9 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - ]. - tick \\ 10 = 0 ifTrue: ["tick every 10 degrees on the inner ring" - self drawTickRadius: outerRadius * 0.83 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - (tick \\ 30 = 0 and: [tick < 360]) ifTrue:["numbered ticks every 30 degrees, don't overwrite 0 with 360" - self tickInnerLabel: tick asString fontSize: 24 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.75) + tickLength angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas - ] - ]. - (tick \\ 90 = 0 and: [tick < 360]) ifTrue:["Major cardianl at the full points" - tickLabel := { 'N'. 'E'. 'S'. 'W'. nil.} atWrap: tick // 90 +1. - self tickInnerLabel: tickLabel fontSize: 36 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.65) + tickLength angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas - ]. - (tick \\ 90 = 45 and: [tick < 360]) ifTrue:["minor cardinal at the half-points" - tickLabel := { 'NE'. 'SE'. 'SW'. 'NW'. nil.} atWrap: tick // 90 +1. - self tickInnerLabel: tickLabel fontSize: 30 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.48) + tickLength angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas - ] - ]. - - self addMorph: (destForm magnify: destForm boundingBox by: 0.5 smoothing: 2) asMorph! Item was removed: - ----- Method: CompassDialMorph>>initialize (in category 'initialize-release') ----- - initialize - "assemble a nice compass morph. The background is an ImageMorph with scale/dial drawn with code adapted from a generous donation of time and effort by Bob Arning; similarly for the needle" - | pointerMorph | - - super initialize. - "A compass runs from 0 deg to 360, clockwise. Traditional compass roses can be very ornate." - - self startAngle: 0 stopAngle: 360; - startValue: 0 stopValue: 360. - self extent: self initialExtent; color: Color transparent; borderWidth: 0. - dialCenter := self center. - - "build the dial background. This is amazingly complex to think about programmatically; this example is fairly hard-coded by hand but somebody out there almost certainly has ideas about parameterizing this to amke a nice general utility" - self buildDial. - - "build our fancy needle as an ImageMorph, set the position to horizontal centre and about 2/3 down so that it rotates about that point when inside the TransformationMorph" - pointerMorph := self basicNeedleOfLength: (self height * 0.65) rounded width: 10 color: Color red. - pointerMorph - position: pointerMorph extent * ( -0.5@ -0.5); - rotationCenter: 0.5 @ 0.5. - - "we keep track of the TransformationMorph since that is what we have to rotate as the incoming pressure values change" - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - - "add a central colored dot. Because we just do." - self addMorph: (CircleMorph new extent: 20 at 20; color: Color red twiceDarker; center: dialCenter) - ! Item was removed: - ----- Method: CurveMorph class>>extraExampleArrow (in category '*MorphicExtras-examples') ----- - extraExampleArrow - "CurveMorph extraExampleArrow openInHand" - - | arrow | - arrow := CurveMorph - vertices: {200 @ 75. 35 @ 0. 40 @ 55. -55 @ 30} - color: Color veryDarkGray - borderWidth: 5 - borderColor: Color veryDarkGray. - arrow makeOpen; makeForwardArrow; beSmoothCurve. - arrow addHandles. - ^ arrow! Item was removed: - ----- Method: CurveMorph class>>extraExampleTextFlow (in category '*MorphicExtras-examples') ----- - extraExampleTextFlow - "CurveMorph extraExampleTextFlow openInHand" - - | curve text | - curve := CurveMorph - vertices: {135 @ 270. 75 @ 200. 50 @ 150. 100 @ 100. 125 @ 150. 175 @ 100. 200 @ 150. 175 @ 200 . 115 @ 340} * RealEstateAgent scaleFactor - color: Color cyan - borderWidth: 25 * RealEstateAgent scaleFactor - borderColor: Color salmon. - curve makeOpen; beSmoothCurve. - text := ('Texts can also follow ........................................ an open curve. ' asText - , ('So morphic!!' asText - addAttribute: TextEmphasis italic; - addAttribute: (TextColor color: Color blue); - yourself)) - addAttribute: (TextFontChange fontNumber: (3.4 * RealEstateAgent scaleFactor) rounded); - asMorph. - text textColor: Color yellow. - curve addMorph: text. - text followCurve. - ^ curve! Item was removed: - ----- Method: CurveMorph class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop} - forFlapNamed: 'Supplies'.]! Item was removed: - ----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - ^ {DescriptionForPartsBin - formalName: 'Curvy Arrow' translatedNoop - categoryList: {'Graphics' translatedNoop} - documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop - globalReceiverSymbol: #CurveMorph - nativitySelector: #arrowPrototype} - ! Item was removed: - ----- Method: CurveMorph class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - PostscriptCanvas subclass: #DSCPostscriptCanvas - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! - - !DSCPostscriptCanvas commentStamp: '<historical>' prior: 0! - I generate multi-page Postscript files, for example of Book morphs. The goal is to crete Adobe Document Structuring Conventions compliant, but this is currently not the case. - ! Item was removed: - ----- Method: DSCPostscriptCanvas>>defaultImageableArea (in category 'page geometry') ----- - defaultImageableArea - ^ self defaultPageSize insetBy:self defaultMargin. - ! Item was removed: - ----- Method: DSCPostscriptCanvas>>defaultMargin (in category 'page geometry') ----- - defaultMargin "In Points" - ^ (0.25 * 72) asInteger. - ! Item was removed: - ----- Method: DSCPostscriptCanvas>>defaultPageSize (in category 'page geometry') ----- - defaultPageSize - " This is Letter size in points. European A4 is 595 @ 842 " - ^ 0 @ 0 extent: ((8.5 @ 11.0) * 72) asIntegerPoint. - ! Item was removed: - ----- Method: DSCPostscriptCanvas>>endGStateForMorph: (in category 'morph drawing') ----- - endGStateForMorph: aMorph - "position the morph on the page " - morphLevel - == (topLevelMorph pagesHandledAutomatically - ifTrue: [2] - ifFalse: [1]) - ifTrue: [ target showpage; print: 'grestore'; cr ]! Item was removed: - ----- Method: DSCPostscriptCanvas>>fullDraw: (in category 'drawing-general') ----- - fullDraw: aMorph - (morphLevel = 0 and: [aMorph pagesHandledAutomatically not]) - ifTrue: - [pages := pages + 1. - target - print: '%%Page: 1 1'; - cr]. - super fullDraw: aMorph. - morphLevel = 0 - ifTrue: - [ self writeTrailer: pages. ]! Item was removed: - ----- Method: DSCPostscriptCanvas>>pageBBox (in category 'page geometry') ----- - pageBBox - | pageSize offset bbox trueExtent | - trueExtent := savedMorphExtent * initialScale. - "this one has been rotated" - pageSize := self defaultPageSize. - offset := pageSize extent - trueExtent / 2 max: 0 @ 0. - bbox := offset extent: trueExtent. - ^ bbox! Item was removed: - ----- Method: DSCPostscriptCanvas>>pageOffset (in category 'page geometry') ----- - pageOffset - ^self pageBBox origin. - ! Item was removed: - ----- Method: DSCPostscriptCanvas>>setupGStateForMorph: (in category 'morph drawing') ----- - setupGStateForMorph: aMorph - "position the morph on the page " - morphLevel - == (topLevelMorph pagesHandledAutomatically - ifTrue: [2] - ifFalse: [1]) - ifTrue: [ self writePageSetupFor: aMorph ]! Item was removed: - ----- Method: DSCPostscriptCanvas>>writePSIdentifierRotated: (in category 'initialization') ----- - writePSIdentifierRotated: rotateFlag - | morphExtent pageExtent | - target print: '%!!PS-Adobe-2.0'; cr; - print: '%%Pages: (atend)'; cr; - print: '%%DocumentFonts: (atend)'; cr. - "Define initialScale so that the morph will fit the page rotated or not" - savedMorphExtent := morphExtent := rotateFlag - ifTrue: [psBounds extent transposed] - ifFalse: [psBounds extent]. - pageExtent := self defaultImageableArea extent asFloatPoint. - initialScale := (printSpecs isNil - or: [printSpecs scaleToFitPage]) - ifTrue: [pageExtent x / morphExtent x min: pageExtent y / morphExtent y] - ifFalse: [1.0]. - target print: '%%BoundingBox: '; - write: self defaultImageableArea; cr. - target print: '%%Title: '; print: self topLevelMorph externalName; cr. - target print: '%%Creator: '; print: Utilities authorName; cr. - target print: '%%CreationDate: '; print: Date today asString; space; print: Time now asString; cr. - - target print: '%%Orientation: '; - - print: (rotateFlag - ifTrue: ['Landscape'] - ifFalse: ['Portrait']); cr. - target print: '%%EndComments'; cr. - ! Item was removed: - DSCPostscriptCanvas subclass: #DSCPostscriptCanvasToDisk - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! Item was removed: - ----- Method: DSCPostscriptCanvasToDisk class>>defaultTarget (in category 'configuring') ----- - defaultTarget - - ^PostscriptEncoderToDisk stream. - ! Item was removed: - ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy: (in category 'drawing') ----- - morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset - - ^self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: nil - ! Item was removed: - ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy:specs: (in category 'drawing') ----- - morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil - - - ^[ - (self new morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset) close - ] - on: PickAFileToWriteNotification - do: [ :ex | - | newFileName stream | - newFileName := UIManager default - saveFilenameRequest: 'Name of file to write:' translated - initialAnswer: 'xxx',Time millisecondClockValue printString, self defaultExtension. - newFileName isEmptyOrNil ifFalse: [ - stream := FileStream fileNamed: newFileName. - stream ifNotNil: [ex resume: stream]. - ]. - ]. - - ! Item was removed: - ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:specs: (in category 'drawing') ----- - morphAsPostscript: aMorph rotated: rotateFlag specs: specsOrNil - - ^ self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: self baseOffset specs: specsOrNil - ! Item was removed: - ----- Method: DSCPostscriptCanvasToDisk>>morphAsPostscript:rotated:offsetBy: (in category 'drawing') ----- - morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset - - ^self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: nil - ! Item was removed: - ----- Method: DSCPostscriptCanvasToDisk>>morphAsPostscript:rotated:offsetBy:specs: (in category 'drawing') ----- - morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil - self reset. - psBounds := offset extent: aMorph bounds extent. - topLevelMorph := aMorph. - self writeHeaderRotated: rotateFlag. - self fullDrawMorph: aMorph. - ^ self close! Item was removed: - Object subclass: #DescriptionForPartsBin - instanceVariableNames: 'formalName categoryList documentation globalReceiverSymbol nativitySelector sampleImageForm' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-PartsBin'! - - !DescriptionForPartsBin commentStamp: '<historical>' prior: 0! - An object description, for use with the ObjectsTool and other parts-bin-like repositories. - - formalName The formal name by which the object is to be known - categoryList A list of category symbols, by way of attribute tags - documentation For use in balloon help, etc. - globalReceiverSymbol A symbol representing the global to whom to send nativitySelector - nativitySelector The selector to send to the global receiver to obtain a new instance! Item was removed: - ----- Method: DescriptionForPartsBin class>>formalName:categoryList:documentation:globalReceiverSymbol:nativitySelector: (in category 'instance creation') ----- - formalName: aName categoryList: aList documentation: aDoc globalReceiverSymbol: aSym nativitySelector: aSel - "Answer a new instance of the receiver with the given traits" - - ^ self new formalName: aName categoryList: aList documentation: aDoc globalReceiverSymbol: aSym nativitySelector: aSel! Item was removed: - ----- Method: DescriptionForPartsBin class>>fromQuad:categoryList: (in category 'instance creation') ----- - fromQuad: aQuad categoryList: aList - "Answer an instance of DescriptionForPartsBin from the part-defining quad provided" - - ^ self formalName: aQuad third categoryList: aList documentation: aQuad fourth globalReceiverSymbol: aQuad first nativitySelector: aQuad second! Item was removed: - ----- Method: DescriptionForPartsBin>>categories (in category 'accessing') ----- - categories - "Answer the categoryList of the receiver" - - ^ categoryList! Item was removed: - ----- Method: DescriptionForPartsBin>>documentation (in category 'accessing') ----- - documentation - "Answer the documentation of the receiver" - - ^ documentation! Item was removed: - ----- Method: DescriptionForPartsBin>>formalName (in category 'accessing') ----- - formalName - "Answer the formalName of the receiver" - - ^ formalName! Item was removed: - ----- Method: DescriptionForPartsBin>>formalName:categoryList:documentation:globalReceiverSymbol:nativitySelector: (in category 'initialization') ----- - formalName: aName categoryList: aList documentation: aDoc globalReceiverSymbol: aSym nativitySelector: aSel - "Set all of the receiver's instance variables from the parameters provided" - - formalName := aName. - categoryList := aList. - documentation := aDoc. - globalReceiverSymbol := aSym. - nativitySelector := aSel! Item was removed: - ----- Method: DescriptionForPartsBin>>globalReceiverSymbol (in category 'accessing') ----- - globalReceiverSymbol - "Answer the globalReceiverSymbol of the receiver" - - ^ globalReceiverSymbol! Item was removed: - ----- Method: DescriptionForPartsBin>>nativitySelector (in category 'accessing') ----- - nativitySelector - "Answer the nativitySelector of the receiver" - - ^ nativitySelector! Item was removed: - ----- Method: DescriptionForPartsBin>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: 'a DescriptionForPartsBin, with categoryList=', categoryList asString, ' docmentation=', documentation asString, ' globalReceiverSymbol=', globalReceiverSymbol asString, ' nativitySelector=', nativitySelector asString ! Item was removed: - ----- Method: DescriptionForPartsBin>>sampleImageForm (in category 'initialization') ----- - sampleImageForm - "If I have a sample image form override stored, answer it, else answer one obtained by launching an actual instance" - - ^ sampleImageForm ifNil: - [((Smalltalk at: globalReceiverSymbol) perform: nativitySelector) imageFormDepth: 32]! Item was removed: - ----- Method: DescriptionForPartsBin>>sampleImageForm: (in category 'initialization') ----- - sampleImageForm: aForm - "Set the sample image form" - - sampleImageForm := aForm! Item was removed: - ----- Method: DescriptionForPartsBin>>sampleImageFormOrNil (in category 'initialization') ----- - sampleImageFormOrNil - "If I have a sample image form override stored, answer it, dlse answer nil" - - ^ sampleImageForm ! Item was removed: - ----- Method: DescriptionForPartsBin>>translatedCategories (in category 'accessing') ----- - translatedCategories - "Answer translated the categoryList of the receiver" - ^ self categories - collect: [:each | each translated]! Item was removed: - PopUpChoiceMorph subclass: #DropDownChoiceMorph - instanceVariableNames: 'items border' - classVariableNames: 'SubMenuMarker' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: DropDownChoiceMorph class>>initialize (in category 'class initialization') ----- - initialize - "DropDownChoiceMorph initialize" - - | f | - f := Form - extent: 5 at 9 - fromArray: #(2147483648 3221225472 3758096384 4026531840 4160749568 4026531840 3758096384 3221225472 2147483648) - offset: 0 at 0. - SubMenuMarker := ColorForm mappingWhiteToTransparentFrom: f. - ! Item was removed: - ----- Method: DropDownChoiceMorph>>border (in category 'accessing') ----- - border - ^border! Item was removed: - ----- Method: DropDownChoiceMorph>>border: (in category 'accessing') ----- - border: newBorder - border := newBorder! Item was removed: - ----- Method: DropDownChoiceMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - aCanvas drawString: contents in: (bounds insetBy: 2) font: self fontToUse color: color. - - border ifNotNil: [aCanvas frameAndFillRectangle: bounds - fillColor: Color transparent - borderWidth: 1 - borderColor: Color black]. - - aCanvas - paintImage: SubMenuMarker - at: (self right - 8 @ ((self top + self bottom - SubMenuMarker height) // 2))! Item was removed: - ----- Method: DropDownChoiceMorph>>getCurrentSelectionIndex (in category 'list access') ----- - getCurrentSelectionIndex - ^self items indexOf: contents! Item was removed: - ----- Method: DropDownChoiceMorph>>items (in category 'accessing') ----- - items - (target notNil and: [getItemsSelector notNil]) - ifTrue: [items := target perform: getItemsSelector withArguments: getItemsArgs]. - items ifNil: [items := #()]. - ^items! Item was removed: - ----- Method: DropDownChoiceMorph>>items: (in category 'accessing') ----- - items: someItems - items := someItems! Item was removed: - ----- Method: DropDownChoiceMorph>>maxExtent: (in category 'drawing') ----- - maxExtent: listOfStrings - - | h maxW | - maxW := 0. - listOfStrings do: [:str | | f w | - f := self fontToUse. - w := f widthOfString: str. - h := f height. - maxW := maxW max: w]. - self extent: (maxW + 4 + h) @ (h + 4). - self changed! Item was removed: - ----- Method: DropDownChoiceMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - | selectedItem | - self items isEmpty ifTrue: [^ self]. - selectedItem := UIManager default chooseFrom: self items values: self items. - selectedItem ifNil: [^ self]. - self contentsClipped: selectedItem. "Client can override this if necess" - actionSelector ifNotNil: [ - target - perform: actionSelector - withArguments: (arguments copyWith: selectedItem)]. - ! Item was removed: - ----- Method: DropDownChoiceMorph>>selection: (in category 'list access') ----- - selection: val - self contentsClipped: val! Item was removed: - ----- Method: DropDownChoiceMorph>>veryDeepInner: (in category 'copying') ----- - veryDeepInner: deepCopier - super veryDeepInner: deepCopier. - items := items veryDeepCopyWith: deepCopier. - border := border veryDeepCopyWith: deepCopier! Item was removed: - PostscriptCanvas subclass: #EPSCanvas - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! - - !EPSCanvas commentStamp: '<historical>' prior: 0! - I am a canvas for generating Encapsulates PostScript (EPS) files from single morphs, for example for screen-dumps. - - I make sure that the bounding box of the EPS surrounds exactly the morph, and am not capable of generating multiple pages. I do not generate an on-screen Preview for the EPS file, though that should be possible. - ! Item was removed: - ----- Method: EPSCanvas class>>baseOffset (in category 'configuring') ----- - baseOffset - ^0 at 0.! Item was removed: - ----- Method: EPSCanvas class>>defaultExtension (in category 'configuring') ----- - defaultExtension - ^'.eps'! Item was removed: - ----- Method: EPSCanvas>>fullDraw: (in category 'drawing-general') ----- - fullDraw: aMorph - super fullDraw: aMorph. - morphLevel = 0 ifTrue: [ - self writeTrailer: 1. - ]! Item was removed: - ----- Method: EPSCanvas>>pageBBox (in category 'page geometry') ----- - pageBBox - ^psBounds! Item was removed: - ----- Method: EPSCanvas>>pageOffset (in category 'page geometry') ----- - pageOffset - ^0 at 0! Item was removed: - ----- Method: EPSCanvas>>writeEPSPreviewImageFor: (in category 'private') ----- - writeEPSPreviewImageFor: aMorph - | form stream string newExtent | - newExtent := (aMorph width roundUpTo: 8) @ aMorph height. - form := aMorph imageForm: 1 forRectangle: (aMorph bounds origin extent: newExtent). - stream := WriteStream on: (String new: (form bits byteSize * 2.04) asInteger). - form storePostscriptHexOn: stream. - string := stream contents. - - "%%BeginPreview: 80 24 1 24" - "width height depth " - target print: '%%BeginPreview: '; write: newExtent; space; write: form depth; space; write: string lineCount; cr. - - string linesDo: [:e | target nextPut: $%; nextPutAll: e; cr.]. - - target print: '%%EndPreview'; cr. - - ! Item was removed: - ----- Method: EPSCanvas>>writePSIdentifierRotated: (in category 'private') ----- - writePSIdentifierRotated: rotateFlag - target - print: '%!!PS-Adobe-2.0 EPSF-2.0'; - cr. - rotateFlag - ifTrue: - [target - print: '%%BoundingBox: '; - write: (0 @ 0 corner: psBounds corner transposed) rounded; - cr] - ifFalse: - [target - print: '%%BoundingBox: '; - write: psBounds rounded; - cr]. - target - print: '%%Title: '; - print: self topLevelMorph externalName; - cr. - target - print: '%%Creator: '; - print: Utilities authorName; - cr. - target - print: '%%CreationDate: '; - print: Date today asString; - space; - print: Time now asString; - cr. - - "is this relevant?" - target print: '%%Orientation: '; - print: (rotateFlag ifTrue: [ 'Landscape' ] ifFalse: [ 'Portrait' ]); - cr. - target print: '%%DocumentFonts: (atend)'; cr. - target - print: '%%EndComments'; - cr - - " self writeEPSPreviewImageFor: topLevelMorph." - - " target print: '%%EndProlog'; cr."! Item was removed: - ----- Method: EllipseMorph class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop} - forFlapNamed: 'PlugIn Supplies'.]! Item was removed: - ----- Method: EllipseMorph class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - AlignmentMorph subclass: #EmbeddedWorldBorderMorph - instanceVariableNames: 'heights minWidth minHeight' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalSupport'! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: menu hand: aHandMorph - - super addCustomMenuItems: menu hand: aHandMorph. - - self worldIEnclose - addScalingMenuItems: menu - hand: aHandMorph - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>appViewBoxArea (in category 'boxes') ----- - appViewBoxArea - - ^self genericBoxArea: 1 - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>boxesAndColorsAndSelectors (in category 'boxes') ----- - boxesAndColorsAndSelectors - - ^{ - {self zoomBoxArea. Color blue. #toggleZoom}. - {self appViewBoxArea. Color yellow. #goAppView}. - {self factoryViewBoxArea. Color red. #goFactoryView}. - {self fullViewBoxArea. Color cyan. #goFullView}. - {self normalEntryBoxArea. Color white. #goNormalProjectEntry}. - }! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - super drawOn: aCanvas. - self boxesAndColorsAndSelectors do: [ :each | - aCanvas fillRectangle: each first fillStyle: each second - ]. - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>extent: (in category 'geometry') ----- - extent: aPoint - - bounds extent = aPoint ifFalse: [ - self changed. - bounds := bounds topLeft extent: aPoint. - self myWorldChanged. - ]. - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>factoryViewBoxArea (in category 'boxes') ----- - factoryViewBoxArea - - ^self genericBoxArea: 2 - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>fullViewBoxArea (in category 'boxes') ----- - fullViewBoxArea - - ^self genericBoxArea: 3 - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>genericBoxArea: (in category 'boxes') ----- - genericBoxArea: countDownFromTop - - ^self innerBounds right @ (self top + (countDownFromTop * 2 * self borderWidth)) - extent: self borderWidth asPoint - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>goAppView (in category 'navigation') ----- - goAppView - - self worldIEnclose showApplicationView - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>goFactoryView (in category 'navigation') ----- - goFactoryView - - self worldIEnclose showFactoryView - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>goFullView (in category 'navigation') ----- - goFullView - - self worldIEnclose showFullView - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>goNormalProjectEntry (in category 'navigation') ----- - goNormalProjectEntry - - | w | - w := self worldIEnclose. - self delete. - w project enter. - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - self boxesAndColorsAndSelectors do: [ :each | - (each first containsPoint: evt cursorPoint) ifTrue: [^true] - ]. - ^false - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - self setBalloonText: 'This is the frame of an embedded project. Click on the colored boxes: - blue - expand or reduce - yellow - app view - red - factory view - cyan - full view - white - enter the project completely' translated! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>minHeight: (in category 'layout') ----- - minHeight: anInteger - - super minHeight: anInteger. - minHeight := anInteger.! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>minWidth: (in category 'layout') ----- - minWidth: anInteger - - super minWidth: anInteger. - minWidth := anInteger.! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>morphicLayerNumber (in category 'submorphs - layers') ----- - morphicLayerNumber - "Embedded worlds come in front of other worlds' Project navigation morphs" - - ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer - 1] - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - self boxesAndColorsAndSelectors do: [ :each | - (each first containsPoint: evt cursorPoint) ifTrue: [ - ^self perform: each third - ]. - ]. - - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>myTransformation (in category 'accessing') ----- - myTransformation - - ^submorphs detect: [ :x | x isKindOf: TransformationMorph] ifNone: [nil] - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>myWorldChanged (in category 'layout') ----- - myWorldChanged - | trans | - trans := self myTransformation. - self changed. - self layoutChanged. - trans ifNotNil:[ - trans extentFromParent: self innerBounds extent. - bounds := self bounds topLeft extent: trans extent + (self borderWidth * 2). - ]. - self changed. - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>normalEntryBoxArea (in category 'boxes') ----- - normalEntryBoxArea - - ^self genericBoxArea: 4 - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>toggleZoom (in category 'accessing') ----- - toggleZoom - - self bounds: ( - bounds area > (Display boundingBox area * 0.9) ifTrue: [ - Display extent // 4 extent: Display extent // 2. - ] ifFalse: [ - Display boundingBox - ] - ) - - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>worldIEnclose (in category 'accessing') ----- - worldIEnclose - - ^self myTransformation firstSubmorph - "quick hack since this is the only usage pattern at the moment" - ! Item was removed: - ----- Method: EmbeddedWorldBorderMorph>>zoomBoxArea (in category 'boxes') ----- - zoomBoxArea - - ^self genericBoxArea: 0 - ! Item was removed: - RectangleMorph subclass: #EnvelopeEditorMorph - instanceVariableNames: 'sound soundName envelope hScale vScale graphArea pixPerTick limits limitXs limitHandles line prevMouseDown sampleDuration showAllEnvelopes denominator keyboard' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: EnvelopeEditorMorph class>>openOn:title: (in category 'opening') ----- - openOn: aSound title: aString - "EnvelopeEditorMorph openOn: (AbstractSound soundNamed: 'brass1') copy title: 'brass1'" - (self basicNew initOnSound: aSound title: aString) openInWorld! Item was removed: - ----- Method: EnvelopeEditorMorph>>acceptGraphPoint:at: (in category 'editing') ----- - acceptGraphPoint: p at: index - | ms val points whichLim linePoint other boundedP | - boundedP := p adhereTo: graphArea bounds. - ms := self msFromX: boundedP x. - points := envelope points. - ms := self - constrain: ms - adjacentTo: index - in: points. - (index = 1 or: [(whichLim := limits indexOf: index) > 0]) - ifTrue: - ["Limit points must not move laterally" - - ms := (points at: index) x]. - val := self valueFromY: boundedP y. - points at: index put: ms @ val. - linePoint := (self xFromMs: ms) @ (self yFromValue: val). - (whichLim notNil and: [whichLim between: 1 and: 2]) - ifTrue: - ["Loop start and loop end must be tied together" - - other := limits at: 3 - whichLim. " 1 <--> 2 " - points at: other put: (points at: other) x @ val. - line verticesAt: other put: (line vertices at: other) x @ linePoint y]. - "Make sure envelope feels the change in points array..." - envelope - setPoints: points - loopStart: limits first - loopEnd: (limits second). - ^linePoint! Item was removed: - ----- Method: EnvelopeEditorMorph>>addCurves (in category 'construction') ----- - addCurves - "Add the polyLine corresponding to the currently selected envelope, - and possibly all the others, too." - - sound envelopes do: - [:env | | aLine verts | - (showAllEnvelopes or: [env == envelope]) ifTrue: - [verts := env points collect: - [:p | (self xFromMs: p x) @ (self yFromValue: p y)]. - aLine := EnvelopeLineMorph basicNew - vertices: verts borderWidth: 1 - borderColor: (self colorForEnvelope: env). - env == envelope - ifTrue: [aLine borderWidth: 2. line := aLine] - ifFalse: [aLine on: #mouseUp send: #clickOn:evt:from: - to: self withValue: env. - self addMorph: aLine]]]. - self addMorph: line "add the active one last (in front)"! Item was removed: - ----- Method: EnvelopeEditorMorph>>addEnvelopeNamed: (in category 'editing') ----- - addEnvelopeNamed: envName - | points env | - points := OrderedCollection new. - points add: 0 at 0.0; - add: (envelope points at: envelope loopStartIndex) x at 1.0; - add: (envelope points at: envelope loopEndIndex) x at 1.0; - add: (envelope points last) x at 0.0. - envName = 'volume' ifTrue: - [env := VolumeEnvelope points: points loopStart: 2 loopEnd: 3. - env target: sound; scale: 0.7]. - envName = 'modulation' ifTrue: - [env := Envelope points: (points collect: [:p | p x @ 0.5]) - loopStart: 2 loopEnd: 3. - env target: sound; updateSelector: #modulation:; - scale: sound modulation*2.0]. - envName = 'pitch' ifTrue: - [env := PitchEnvelope points: (points collect: [:p | p x @ 0.5]) - loopStart: 2 loopEnd: 3. - env target: sound; updateSelector: #pitch:; scale: 0.5]. - envName = 'random pitch:' ifTrue: - [env := RandomEnvelope for: #pitch:. - points := OrderedCollection new. - points add: 0@(env delta * 5 + 0.5); - add: (envelope points at: envelope loopStartIndex) x@(env highLimit - 1 * 5 + 0.5); - add: (envelope points at: envelope loopEndIndex) x@(env highLimit - 1 * 5 + 0.5); - add: (envelope points last) x@(env lowLimit - 1 * 5 + 0.5). - env setPoints: points loopStart: 2 loopEnd: 3. - env target: sound. ]. - envName = 'ratio' ifTrue: - [denominator := 9999. "No gridding" - env := Envelope points: (points collect: [:p | p x @ 0.5]) - loopStart: 2 loopEnd: 3. - env target: sound; updateSelector: #ratio:; - scale: sound ratio*2.0]. - env ifNotNil: - [sound addEnvelope: env. - self editEnvelope: env]! Item was removed: - ----- Method: EnvelopeEditorMorph>>addHandlesIn: (in category 'construction') ----- - addHandlesIn: frame - | handle | - handle := PolygonMorph - vertices: (Array with: 0 at 0 with: 8 at 0 with: 4 at 8) - color: Color orange borderWidth: 1 borderColor: Color black. - handle addMorph: ((RectangleMorph - newBounds: ((self handleOffset: handle)-(2 at 0) extent: 1@(graphArea height-2)) - color: Color orange) borderWidth: 0). - - limitHandles := Array with: handle with: handle veryDeepCopy with: handle veryDeepCopy. - 1 to: limitHandles size do: - [:i | handle := limitHandles at: i. - handle on: #mouseDown - send: #limitHandleMove:event:from: - to: self withValue: i. - handle on: #mouseMove - send: #limitHandleMove:event:from: - to: self withValue: i. - self addMorph: handle. - handle position: ((self xFromMs: - (envelope points at: (limits at: i)) x) @ - (graphArea top)) - (self handleOffset: handle)]! Item was removed: - ----- Method: EnvelopeEditorMorph>>addKeyboard (in category 'construction') ----- - addKeyboard - keyboard := PianoKeyboardMorph new soundPrototype: sound. - keyboard align: keyboard bounds bottomCenter with: bounds bottomCenter - (0 at 4). - self addMorph: keyboard! Item was removed: - ----- Method: EnvelopeEditorMorph>>adjustScale: (in category 'menu') ----- - adjustScale: evt - | scaleString oldScale baseValue | - oldScale := envelope scale. - scaleString := UIManager default request: 'Enter the new full-scale value...' - initialAnswer: oldScale printString. - scaleString isEmpty ifTrue: [^self]. - envelope scale: (Number readFrom: scaleString) asFloat. - baseValue := envelope updateSelector = #pitch: ifTrue: [0.5] ifFalse: [0.0]. - envelope - setPoints: (envelope points collect: - [:p | - p x @ ((p y - baseValue) * oldScale / envelope scale + baseValue min: 1.0 - max: 0.0)]) - loopStart: (limits first) - loopEnd: (limits second). - self buildView! Item was removed: - ----- Method: EnvelopeEditorMorph>>buildGraphAreaIn: (in category 'construction') ----- - buildGraphAreaIn: frame - | r y | - graphArea := RectangleMorph - newBounds: ((frame left + 15) @ (frame top + 15) - corner: (frame right+1) @ (frame bottom - 70)) - color: Color lightGreen lighter lighter. - graphArea borderWidth: 1. - self addMorph: graphArea. - (envelope updateSelector = #pitch: and: [envelope scale <= 2.0]) ifTrue: - ["Show half-steps" - r := graphArea innerBounds. - 0.0 to: 1.0 by: 1.0/12.0/envelope scale do: - [:val | - y := self yFromValue: val. - graphArea addMorph: ((RectangleMorph - newBounds: (r left at y extent: r width at 1) - color: Color veryLightGray) - borderWidth: 0)]]. - (envelope updateSelector = #ratio: and: [denominator ~= 9999]) ifTrue: - ["Show denominator gridding" - r := graphArea innerBounds. - (0.0 to: 1.0 by: 1.0/denominator/envelope scale) do: - [:v | - y := self yFromValue: v. - graphArea addMorph: ((RectangleMorph - newBounds: (r left at y extent: r width at 1) - color: Color veryLightGray) - borderWidth: 0)]]. - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') ----- - buildScalesIn: frame - | env | - env := envelope. - pixPerTick := graphArea width // (self maxTime//10) max: 1. - "hminortick := ( 1 + ( self maxTime // 800 ) ) * 10. - hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100." - hScale := (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen. - " hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) - start: 0 stop: self maxTime - minorTick: hminortick minorTickLength: 3 - majorTick: hmajortick majorTickLength: 10 - caption: 'milliseconds' tickPrintBlock: [:v | v printString]. - " - self addMorph: hScale. - vScale := (Morph newBounds: (0 at 0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen. - "vScale := ScaleMorph newBounds: (0 at 0 extent: (graphArea height)@(graphArea left - frame left))." - "env name = 'pitch' - ifTrue: - [env scale >= 2.0 - ifTrue: - [vScale start: 0 stop: env scale - minorTick: env scale / 24 minorTickLength: 3 - majorTick: env scale / 2.0 majorTickLength: 10 - caption: 'pitch (octaves)' - tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]] - ifFalse: - [vScale start: 0 stop: env scale - minorTick: 1.0/48.0 minorTickLength: 3 - majorTick: 1.0/12.0 majorTickLength: 10 - caption: 'pitch (half-steps)' - tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]] - ifFalse: [ - env name = 'random pitch:' - ifTrue: [ - vScale start: 0.9 stop: 1.1 - minorTick: 0.2 / 50.0 minorTickLength: 3 - majorTick: 0.2 / 5.0 majorTickLength: 10 - caption: env name - tickPrintBlock: [:v | v printString]] - ifFalse: [ - vScale start: 0 stop: env scale - minorTick: env scale / 50.0 minorTickLength: 3 - majorTick: env scale / 5.0 majorTickLength: 10 - caption: env name - tickPrintBlock: [:v | v printString]]. - ]." - vScale := TransformationMorph new asFlexOf: vScale. - vScale angle: Float pi / 2.0. - self addMorph: vScale. - vScale position: (frame left + 1)@(graphArea top-1) - (3 at 1). - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>buildView (in category 'construction') ----- - buildView - | frame | - self color: Color lightGreen. - self removeAllMorphs. - frame := self innerBounds. - self buildGraphAreaIn: frame. - self buildScalesIn: frame. - self addHandlesIn: frame. - self addCurves. - line addHandles. - self addMorph: self makeControls. - self addKeyboard! Item was removed: - ----- Method: EnvelopeEditorMorph>>chooseDenominator: (in category 'menu') ----- - chooseDenominator: evt - | menu | - menu := MenuMorph new. - (Integer primesUpTo: 30) do: - [:i | - menu add: i printString - target: self selector: #setDenominator: - argument: i]. - menu addLine. - menu add: 'none' target: self selector: #setDenominator: argument: 9999. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: EnvelopeEditorMorph>>chooseEnvelope: (in category 'menu') ----- - chooseEnvelope: choice - | name | - (choice beginsWith: 'edit ') ifTrue: - [name := choice copyFrom: 'edit ' size+1 to: choice size. - ^ self editEnvelope: (sound envelopes detect: - [:env | env name = name])]. - (choice beginsWith: 'add ') ifTrue: - [name := choice copyFrom: 'add ' size+1 to: choice size. - ^ self addEnvelopeNamed: name]. - (choice beginsWith: 'remove ') ifTrue: - [^ self removeEnvelope "the current one"]. - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>chooseFrom:envelopeItem: (in category 'menu') ----- - chooseFrom: chooserMorph envelopeItem: item - | name | - (item beginsWith: 'edit ') ifTrue: - [name := item copyFrom: 'edit ' size+1 to: item size. - self editEnvelope: (sound envelopes detect: - [:env | env name = name])]. - (item beginsWith: 'add ') ifTrue: - [name := item copyFrom: 'add ' size+1 to: item size. - self addEnvelopeNamed: name]. - (item beginsWith: 'remove ') ifTrue: - [self removeEnvelope "the current one"]. - chooserMorph contentsClipped: envelope name! Item was removed: - ----- Method: EnvelopeEditorMorph>>chooseFrom:soundItem: (in category 'menu') ----- - chooseFrom: chooserMorph soundItem: item - self editSoundNamed: item. - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>chooseSound: (in category 'menu') ----- - chooseSound: evt - | menu | - menu := MenuMorph new. - menu add: 'new...' target: self selector: #editNewSound. - menu addLine. - AbstractSound soundNames do: - [:name | - menu add: name - target: self selector: #editSoundNamed: - argument: name]. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: EnvelopeEditorMorph>>clickOn:evt:from: (in category 'editing') ----- - clickOn: env evt: anEvent from: aLine - self editEnvelope: env! Item was removed: - ----- Method: EnvelopeEditorMorph>>clickOnLine:evt:envelope: (in category 'editing') ----- - clickOnLine: arg1 evt: arg2 envelope: arg3 - "Reorder the arguments for existing event handlers" - (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages]. - ^self clickOn: arg1 evt: arg2 from: arg3! Item was removed: - ----- Method: EnvelopeEditorMorph>>colorForEnvelope: (in category 'construction') ----- - colorForEnvelope: env - | name index | - name := env name. - index := #('volume' 'modulation' 'pitch' 'ratio') indexOf: name - ifAbsent: [5]. - ^ Color perform: (#(red green blue magenta black) at: index)! Item was removed: - ----- Method: EnvelopeEditorMorph>>constrain:adjacentTo:in: (in category 'editing') ----- - constrain: xVal adjacentTo: ix in: points - "Return xVal, restricted between points adjacent to vertX" - | newVal | - newVal := xVal. - ix > 1 ifTrue: [newVal := newVal max: (points at: ix-1) x]. - ix < points size ifTrue: [newVal := newVal min: (points at: ix+1) x]. - ^ newVal! Item was removed: - ----- Method: EnvelopeEditorMorph>>curveChoices (in category 'construction') ----- - curveChoices - | extant others | - extant := sound envelopes collect: [:env | env name]. - others := #('volume' 'modulation' 'pitch' 'random pitch:' 'ratio') - reject: [:x | (extant includes: x) | ((x = 'pitch') & (extant includes: 'random pitch:')) | ((x = 'random pitch:') & (extant includes: 'pitch')) ]. - ^ (extant collect: [:name | 'edit ' , name]) - , (others collect: [:name | 'add ' , name]) - , (sound envelopes size > 1 - ifTrue: [Array with: 'remove ' , envelope name] - ifFalse: [Array new])! Item was removed: - ----- Method: EnvelopeEditorMorph>>deletePoint: (in category 'editing') ----- - deletePoint: ix - "If the point is a limit point, return false, - otherwise, delete the point at ix, and return true." - - (limits includes: ix) ifTrue: [^false]. - 1 to: limits size - do: - [:i | - "Decrease limit indices beyond the deletion" - - (limits at: i) > ix ifTrue: [limits at: i put: (limits at: i) - 1]]. - envelope - setPoints: (envelope points - copyReplaceFrom: ix - to: ix - with: Array new) - loopStart: (limits first) - loopEnd: (limits second). - ^true! Item was removed: - ----- Method: EnvelopeEditorMorph>>editEnvelope: (in category 'initialization') ----- - editEnvelope: env - envelope := env. - limits := Array with: envelope loopStartIndex - with: envelope loopEndIndex - with: envelope points size. - limitXs := limits collect: [:i | (envelope points at: i) x]. - self buildView! Item was removed: - ----- Method: EnvelopeEditorMorph>>editNewSound (in category 'menu') ----- - editNewSound - | known i | - known := AbstractSound soundNames. - i := 0. - [soundName := 'unnamed' , i printString. - known includes: soundName] - whileTrue: [i := 1+1]. - soundName := soundName. - self editSound: FMSound default copy! Item was removed: - ----- Method: EnvelopeEditorMorph>>editSound: (in category 'initialization') ----- - editSound: aSound - - | p | - (aSound respondsTo: #envelopes) - ifFalse: [ - UIManager default inform: 'You selected a ', aSound class name, '.', String cr, - 'I can''t handle these kinds of sounds.'. - ^self ]. - sound := aSound. - sound envelopes isEmpty ifTrue: [ - "provide a default volume envelope" - p := OrderedCollection new. - p add: 0 at 0.0; add: 10 at 1.0; add: 100 at 1.0; add: 120 at 0.0. - sound addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3)]. - - self editEnvelope: sound envelopes first. - keyboard soundPrototype: sound. - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>editSoundNamed: (in category 'menu') ----- - editSoundNamed: name - - name = 'new...' ifTrue: [^ self editNewSound]. - soundName := name. - self editSound: (AbstractSound soundNamed: soundName) copy! Item was removed: - ----- Method: EnvelopeEditorMorph>>extent: (in category 'geometry') ----- - extent: newExtent - super extent: (newExtent max: (self maxTime//10*3+50 max: 355) @ 284). - self buildView! Item was removed: - ----- Method: EnvelopeEditorMorph>>handleOffset: (in category 'construction') ----- - handleOffset: handle - "This is the offset from position to the bottom vertex" - ^ (handle width//2+1) @ handle height - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>initOnSound:title: (in category 'initialization') ----- - initOnSound: aSound title: title - sound := aSound. - soundName := title. - self initialize. - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - prevMouseDown := false. - showAllEnvelopes := true. - soundName ifNil: [soundName := 'test']. - self editSound: (sound ifNil: [FMSound brass1 copy]). - sound duration: 0.25. - denominator := 7. - self extent: 10 at 10. "ie the minimum" - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>insertPointAfter: (in category 'editing') ----- - insertPointAfter: ix - "If there is not enough roon (in x) then return false. - Otherwise insert a point between ix and ix+1 and return true." - - | points pt | - points := envelope points. - (points at: ix + 1) x - (points at: ix) x < 20 ifTrue: [^false]. - pt := ((points at: ix + 1) + (points at: ix)) // 2. - 1 to: limits size - do: - [:i | - "Increase limit indices beyond the insertion" - - (limits at: i) > ix ifTrue: [limits at: i put: (limits at: i) + 1]]. - envelope - setPoints: (points - copyReplaceFrom: ix + 1 - to: ix - with: (Array with: pt)) - loopStart: (limits first) - loopEnd: (limits second). - ^true! Item was removed: - ----- Method: EnvelopeEditorMorph>>invokeMenu (in category 'menu') ----- - invokeMenu - "Invoke a menu of additonal functions for this ScorePlayer." - | menu | - menu := MenuMorph new defaultTarget: self. - - envelope updateSelector = #ratio: ifTrue: - [menu add: 'choose denominator...' translated action: #chooseDenominator:]. - menu add: 'adjust scale...' translated action: #adjustScale:. - SoundPlayer isReverbOn - ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb] - ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb]. - menu addLine. - menu add: 'get sound from lib' translated action: #chooseSound:. - menu add: 'put sound in lib' translated action: #saveSound:. - menu add: 'read sound from disk...' translated action: #readFromDisk:. - menu add: 'save sound on disk...' translated action: #saveToDisk:. - menu add: 'save library on disk...' translated action: #saveLibToDisk:. - menu popUpInWorld: self world! Item was removed: - ----- Method: EnvelopeEditorMorph>>limitHandleMove:event:from: (in category 'editing') ----- - limitHandleMove: index event: evt from: handle - "index is the handle index = 1, 2 or 3" - | ix p x ms limIx | - ix := limits at: index. "index of corresponding vertex" - p := evt cursorPoint adhereTo: graphArea bounds. - ms := self msFromX: p x + (self handleOffset: handle) x. - - "Constrain move to adjacent points on ALL envelopes" - sound envelopes do: - [:env | - limIx := env perform: - (#(loopStartIndex loopEndIndex decayEndIndex) at: index). - ms := self constrain: ms adjacentTo: limIx in: env points]. - - "Update the handle, the vertex and the line being edited" - x := self xFromMs: ms. - handle position: (x @ graphArea top) - (self handleOffset: handle). - line verticesAt: ix put: x @ (line vertices at: ix) y. - - sound envelopes do: - [:env | | points | - limIx := env perform: - (#(loopStartIndex loopEndIndex decayEndIndex) at: index). - points := env points. - points at: limIx put: ms @ (points at: limIx) y. - env setPoints: points loopStart: env loopStartIndex loopEnd: env loopEndIndex].! Item was removed: - ----- Method: EnvelopeEditorMorph>>limitHandleMoveEvent:from:index: (in category 'editing') ----- - limitHandleMoveEvent: arg1 from: arg2 index: arg3 - "Reorder the arguments for existing event handlers" - (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages]. - ^self limitHandleMove: arg1 event: arg2 from: arg3! Item was removed: - ----- Method: EnvelopeEditorMorph>>makeControls (in category 'construction') ----- - makeControls - | chooser button row | - row := AlignmentMorph newRow color: color; borderWidth: 0. - row align: row bounds topLeft with: graphArea bounds bottomLeft + (0 at 5). - button := SimpleButtonMorph new target: self; borderColor: Color black; - borderWidth: 2; color: color. - row addMorphBack: (button label: 'Menu' translated; actWhen: #buttonDown; - actionSelector: #invokeMenu). - row addMorphBack: (Morph new extent:10 at 1; color: Color transparent). - chooser := PopUpChoiceMorph new extent: 120 at 14; - contentsClipped: 'Editing: ' , envelope name; - target: self; - actionSelector: #chooseFrom:envelopeItem:; - getItemsSelector: #curveChoices. - chooser arguments: (Array with: chooser). - row addMorphBack: chooser. - - chooser := PopUpChoiceMorph new extent: 130 at 14; - contentsClipped: 'Timbre: ' , soundName; - target: self; - actionSelector: #chooseFrom:soundItem:; - getItemsSelector: #soundChoices. - chooser arguments: (Array with: chooser). - row addMorphBack: chooser. - - ^row! Item was removed: - ----- Method: EnvelopeEditorMorph>>maxTime (in category 'scaling') ----- - maxTime - ^ (envelope points at: limits last) x + 100! Item was removed: - ----- Method: EnvelopeEditorMorph>>msFromX: (in category 'scaling') ----- - msFromX: x - ^ (x - graphArea left)//pixPerTick*10! Item was removed: - ----- Method: EnvelopeEditorMorph>>playNothing (in category 'playing') ----- - playNothing - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>readFileNamed: (in category 'menu') ----- - readFileNamed: fileName - | snd | - snd := Compiler evaluate: - (FileStream readOnlyFileNamed: fileName) contentsOfEntireFile. - soundName := fileName copyFrom: 1 to: fileName size-4. "---.fmp" - self editSound: snd! Item was removed: - ----- Method: EnvelopeEditorMorph>>readFromDisk: (in category 'menu') ----- - readFromDisk: evt - | menu | - menu := MenuMorph new. - (FileDirectory default fileNamesMatching: '*.fmp') do: - [:fileName | - menu add: fileName - target: self selector: #readFileNamed: - argument: fileName]. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: EnvelopeEditorMorph>>removeEnvelope (in category 'menu') ----- - removeEnvelope - (UIManager default confirm: 'Really remove ' , envelope name , '?') - ifFalse: [^ self]. - sound removeEnvelope: envelope. - self editEnvelope: sound envelopes first.! Item was removed: - ----- Method: EnvelopeEditorMorph>>saveLibToDisk: (in category 'menu') ----- - saveLibToDisk: evt - "Save the library to disk" - | newName | - newName := UIManager default saveFilenameRequest: 'Please confirm name for library...' initialAnswer: 'MySounds.fml'. - newName ifNil: [^ self]. - - FileStream newFileNamed: newName - do: [:f | AbstractSound soundNames - do: [:name | | snd | - snd := AbstractSound soundNamed: name. - f nextChunkPut: 'AbstractSound soundNamed: ' , name , ' put: ' , snd storeString; - cr; - cr]]! Item was removed: - ----- Method: EnvelopeEditorMorph>>saveSound: (in category 'menu') ----- - saveSound: evt - | newName | - newName := UIManager default request: 'Please confirm name for save...' - initialAnswer: soundName. - newName isEmpty ifTrue: [^ self]. - AbstractSound soundNamed: newName put: sound. - soundName := newName.! Item was removed: - ----- Method: EnvelopeEditorMorph>>saveToDisk: (in category 'menu') ----- - saveToDisk: evt - | newName | - newName := UIManager default saveFilenameRequest: 'Please confirm name for save...' - initialAnswer: soundName, '.fmp'. - newName isEmptyOrNil ifTrue: [^ self]. - FileStream newFileNamed: newName - do:[:f| sound storeOn: f]! Item was removed: - ----- Method: EnvelopeEditorMorph>>setDenominator: (in category 'menu') ----- - setDenominator: denom - denominator := denom. - self buildView! Item was removed: - ----- Method: EnvelopeEditorMorph>>soundBeingEdited (in category 'initialization') ----- - soundBeingEdited - - ^ sound! Item was removed: - ----- Method: EnvelopeEditorMorph>>soundChoices (in category 'construction') ----- - soundChoices - ^ #('new...') , AbstractSound soundNames! Item was removed: - ----- Method: EnvelopeEditorMorph>>step (in category 'stepping and presenter') ----- - step - | mouseDown hand | - hand := self world firstHand. - (bounds containsPoint: hand position) ifFalse: [^ self]. - - mouseDown := hand lastEvent redButtonPressed. - mouseDown not & prevMouseDown ifTrue: - ["Mouse just went up" - limitXs = (limits collect: [:i | (envelope points at: i) x]) ifFalse: - ["Redisplay after changing limits" - self editEnvelope: envelope]]. - prevMouseDown := mouseDown! Item was removed: - ----- Method: EnvelopeEditorMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^ 100! Item was removed: - ----- Method: EnvelopeEditorMorph>>valueFromY: (in category 'scaling') ----- - valueFromY: y - "The convention is that envelope values are between 0.0 and 1.0" - | value | - value := (graphArea bottom - y) asFloat / (graphArea height). - envelope updateSelector = #ratio: ifTrue: - ["Ratio gets gridded by denominator" - ^ (value * envelope scale * denominator) rounded asFloat / denominator / envelope scale]. - ^ value! Item was removed: - ----- Method: EnvelopeEditorMorph>>wantsRoundedCorners (in category 'rounding') ----- - wantsRoundedCorners - ^ SystemWindow roundedWindowCorners or: [super wantsRoundedCorners]! Item was removed: - ----- Method: EnvelopeEditorMorph>>xFromMs: (in category 'scaling') ----- - xFromMs: ms - ^ graphArea left + (ms//10*pixPerTick)! Item was removed: - ----- Method: EnvelopeEditorMorph>>yFromValue: (in category 'scaling') ----- - yFromValue: val - "The convention is that envelope values are between 0.0 and 1.0" - ^ graphArea bottom - (val* (graphArea height))! Item was removed: - PolygonMorph subclass: #EnvelopeLineMorph - instanceVariableNames: 'editor' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: EnvelopeLineMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color transparent! Item was removed: - ----- Method: EnvelopeLineMorph>>dragVertex:event:fromHandle: (in category 'editing') ----- - dragVertex: ix event: evt fromHandle: handle - | p | - super dragVertex: ix event: evt fromHandle: handle. - p := owner acceptGraphPoint: evt cursorPoint at: ix. - self verticesAt: ix put: p. - ! Item was removed: - ----- Method: EnvelopeLineMorph>>dropVertex:event:fromHandle: (in category 'editing') ----- - dropVertex: ix event: evt fromHandle: handle - | oldVerts | - oldVerts := vertices. - super dropVertex: ix event: evt fromHandle: handle. - vertices = oldVerts ifFalse: [owner deletePoint: ix "deleted a vertex"]! Item was removed: - ----- Method: EnvelopeLineMorph>>newVertex:event:fromHandle: (in category 'editing') ----- - newVertex: ix event: evt fromHandle: handle - "Install a new vertex if there is room." - (owner insertPointAfter: ix) ifFalse: [^ self "not enough room"]. - super newVertex: ix event: evt fromHandle: handle. - self verticesAt: ix+1 put: (owner acceptGraphPoint: evt cursorPoint at: ix+1). - ! Item was removed: - ----- Method: EnvelopeLineMorph>>vertices:borderWidth:borderColor: (in category 'initialization') ----- - vertices: verts borderWidth: bw borderColor: bc - super initialize. - vertices := verts. - - self borderWidth: bw. - self borderColor: bc. - - closed := false. - arrows := #none. - self computeBounds! Item was removed: - ----- Method: EventHandler>>adaptToWorld: (in category '*MorphicExtras-initialization') ----- - adaptToWorld: aWorld - "If any of my recipients refer to a world or a hand, make them now refer - to the corresponding items in the new world. (instVarNamed: is slow, later - use perform of two selectors.)" - - - #(mouseDownRecipient mouseStillDownRecipient mouseUpRecipient - mouseEnterRecipient mouseLeaveRecipient mouseEnterDraggingRecipient - mouseLeaveDraggingRecipient clickRecipient doubleClickRecipient startDragRecipient keyStrokeRecipient valueParameter) do: - [:aName | | value newValue | - (value := self instVarNamed: aName asString) ifNotNil:[ - newValue := value adaptedToWorld: aWorld. - (newValue notNil and: [newValue ~~ value]) - ifTrue: - [self instVarNamed: aName asString put: newValue]]]! Item was removed: - AlignmentMorph subclass: #EventRecorderMorph - instanceVariableNames: 'tape state time deltaTime recHand playHand lastEvent lastDelta tapeStream saved statusLight voiceRecorder startSoundEvent recordMeter caption journalFile' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalSupport'! - - !EventRecorderMorph commentStamp: '<historical>' prior: 0! - During recording, the EventRecorder subscribes to all events of the normal morphic hand, and saves them as they occur. - - For replay, a second playback hand is created that reads events from the recorder and plays them back in the world. - - The EventRecorder began with the work of Ted Kaehler and John Malone. This was then signifcantly expanded by Leandro Caniglia and Valeria Murgia as a tutorial aid for the Morphic Wrapper project. - - Since that time, I have... - Changed to a simple inboard array for the tape (event storage). - Provided the ability to condense linear mouse movement with interpolation at replay. - Made simple provisions for wrap-around of the millisecond clock. - Eliminated step methods in favor of using the processEvents cycle in the playback hand. - Provided a pause/resume mechanism that is capable of surviving project changes. - Added the ability to spawn a simple 'play me' button that can be saved as a morph. - Caused the playback hand to display its cursor double size for visibility. - Integrated a voice recorder with on-the-fly compression. - This currently does NOT survive project changes, not is its data stored on the tape. - Right now it can only be saved by saving the entire recorder as a morph. - This will be fixed by adding a startSound event at each project change. - We will also convert read/write file to use saveOnFile. - Added a journal file facility for recording sequences that end in a crash. - The above two features can be engaged via the ER's morph menu. - - Dan Ingalls 3/6/99! Item was removed: - ----- Method: EventRecorderMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Answer a description for use in a parts bin" - - ^ self partName: 'Event Recorder' - categories: #(Presentation Tools) - documentation: 'Lets you record and play back interactions'! Item was removed: - ----- Method: EventRecorderMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^(suffix = 'tape') | (suffix = '*') - ifTrue: [ self services] - ifFalse: [#()] - - ! Item was removed: - ----- Method: EventRecorderMorph class>>fromFileNamed: (in category 'instance creation') ----- - fromFileNamed: aFileName - | file answer | - file := FileStream readOnlyFileNamed: aFileName. - answer := self readFrom: file setConverterForCode. - file close. - ^ answer! Item was removed: - ----- Method: EventRecorderMorph class>>initialize (in category 'class initialization') ----- - initialize - - FileServices registerFileReader: self! Item was removed: - ----- Method: EventRecorderMorph class>>openTapeFromFile: (in category 'instance creation') ----- - openTapeFromFile: fullName - "Open an eventRecorder tape for playback." - - (self new) readTape: fullName; openInWorld! Item was removed: - ----- Method: EventRecorderMorph class>>readFrom: (in category 'instance creation') ----- - readFrom: aStream - ^ self new readFrom: aStream! Item was removed: - ----- Method: EventRecorderMorph class>>services (in category 'fileIn/Out') ----- - services - - ^{SimpleServiceEntry - provider: self - label: 'open for playback' - selector: #openTapeFromFile:.} - ! Item was removed: - ----- Method: EventRecorderMorph class>>unload (in category 'initialize-release') ----- - unload - - FileServices unregisterFileReader: self ! Item was removed: - ----- Method: EventRecorderMorph>>addButtons (in category 'initialization') ----- - addButtons - | r b w | - - caption ifNotNil: ["Special setup for play-only interface" - (r := self makeARowForButtons) - addMorphBack: (SimpleButtonMorph new target: self; - label: caption font: Preferences standardButtonFont; actionSelector: #play); - addMorphBack: self makeASpacer. - w := r fullBounds height * 0.5. - r addMorphBack: (self makeStatusLightIn: (w at w)); - addMorphBack: self makeASpacer. - ^ self addMorphBack: r - ]. - - (r := self makeARowForButtons) - addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'}); - addMorphBack: self makeASpacer; - addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'}); - addMorphBack: self makeASpacer; - addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}). - self addMorphBack: r. - - (r := self makeARowForButtons) - addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'}); - addMorphBack: self makeASpacer; - addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}). - self addMorphBack: r. - - (r := self makeARowForButtons) - addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'}); - addMorphBack: self makeASpacer. - w := r fullBounds height * 0.5. - r addMorphBack: (self makeStatusLightIn: (w at w)); - addMorphBack: self makeASpacer; - addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}). - self addMorph: r. - self setStatusLight: #ready.! Item was removed: - ----- Method: EventRecorderMorph>>addCustomMenuItems:hand: (in category 'initialization') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'add voice controls' translated action: #addVoiceControls. - aCustomMenu add: 'add journal file' translated action: #addJournalFile. - ! Item was removed: - ----- Method: EventRecorderMorph>>addJournalFile (in category 'initialization') ----- - addJournalFile - "In case there is a chance of not regaining control to stop recording and save a file, the EventRecorder can write directly to file as it is recording. This is useful for capturing a sequence that results in a nasty crash." - - journalFile ifNotNil: [journalFile close]. - journalFile := FileStream newFileNamed: 'EventRecorder.tape'. - journalFile nextPutAll:'Event Tape v1 ASCII'; cr.! Item was removed: - ----- Method: EventRecorderMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'sound-piano rolls') ----- - addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime - - | startX myDurationInTicks endX | - - startX := pianoRoll xForTime: t. - myDurationInTicks := pianoRoll scorePlayer ticksForMSecs: self myDurationInMS. - t > rightTime ifTrue: [^ self]. - (t + myDurationInTicks) < leftTime ifTrue: [^ self]. - endX := pianoRoll xForTime: t + myDurationInTicks. - - morphList add: - (self hResizing: #spaceFill; left: startX; width: endX - startX). - - ! Item was removed: - ----- Method: EventRecorderMorph>>addVoiceControls (in category 'sound') ----- - addVoiceControls - - | levelSlider r meterBox | - voiceRecorder := SoundRecorder new - desiredSampleRate: 11025.0; "<==try real hard to get the low rate" - codec: (GSMCodec new). "<--this should compress better than ADPCM.. is it too slow?" - "codec: (ADPCMCodec new initializeForBitsPerSample: 4 samplesPerFrame: 0)." - - levelSlider := SimpleSliderMorph new - color: color; - extent: 100 at 2; - target: voiceRecorder; - actionSelector: #recordLevel:; - adjustToValue: voiceRecorder recordLevel. - r := AlignmentMorph newRow - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #shrinkWrap; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: '0 '). - r addMorphBack: levelSlider. - r addMorphBack: (StringMorph contents: ' 10'). - self addMorphBack: r. - - meterBox := Morph new extent: 102 at 18; color: Color gray. - recordMeter := Morph new extent: 1 at 16; color: Color yellow. - recordMeter position: meterBox topLeft + (1 at 1). - meterBox addMorph: recordMeter. - - r := AlignmentMorph newRow vResizing: #shrinkWrap. - r addMorphBack: meterBox. - self addMorphBack: r. - ! Item was removed: - ----- Method: EventRecorderMorph>>button (in category 'commands') ----- - button - "Make a simple button interface for replay only" - | butnCaption erm | - butnCaption := UIManager default request: 'Caption for this butn?' translated initialAnswer: 'play' translated. - butnCaption isEmpty ifTrue: [^ self]. - erm := (EventRecorderMorph basicNew - caption: butnCaption - voiceRecorder: voiceRecorder copy - tape: tape) initialize. - self world primaryHand attachMorph: erm! Item was removed: - ----- Method: EventRecorderMorph>>button: (in category 'accessing') ----- - button: label - ^ self allMorphs - detect: [:one | (one isKindOf: SimpleButtonMorph) - and: [one label = label]] - ifNone: []! Item was removed: - ----- Method: EventRecorderMorph>>buttonFor: (in category 'initialization') ----- - buttonFor: data - - | b | - b := SimpleButtonMorph new - target: self; - label: data first asString translated; - actionSelector: data first. - data second ifNotNil: [b width < data second ifTrue: [b width: data second]]. - data third ifNotNil: [b setBalloonText: data third translated]. - ^b! Item was removed: - ----- Method: EventRecorderMorph>>caption:voiceRecorder:tape: (in category 'initialization') ----- - caption: butnCaption voiceRecorder: butnRecorder tape: butnTape - caption := butnCaption. - voiceRecorder := butnRecorder. - tape := butnTape! Item was removed: - ----- Method: EventRecorderMorph>>checkTape (in category 'fileIn/Out') ----- - checkTape - "See if this tape was already converted to the new format" - - tape ifNil: [^self]. - tape isEmpty ifTrue: [^self]. - (tape first isKindOf: Association) - ifTrue: [tape := self convertV0Tape: tape]! Item was removed: - ----- Method: EventRecorderMorph>>condense (in category 'commands') ----- - condense - "Shorten the tape by deleting mouseMove events that can just as well be - interpolated later at playback time." - - "e1, e2, and e3 are three consecutive events on the tape. - t1, t2, and t3 are the associated time steps for each of them." - - - tape := Array streamContents: - [:tStream | | e1 t1 t2 e2 t3 e3 | - e1 := e2 := e3 := nil. - t1 := t2 := t3 := nil. - 1 to: tape size - do: - [:i | - e1 := e2. - t1 := t2. - e2 := e3. - t2 := t3. - e3 := tape at: i. - t3 := e3 timeStamp. - ((e1 notNil and: - [e2 type == #mouseMove - & (e1 type == #mouseMove or: [e3 type == #mouseMove])]) - and: - ["Middle point within 3 pixels of mean of outer two" - - e2 position - onLineFrom: e1 position - to: e3 position - within: 2.5]) - ifTrue: - ["Delete middle mouse move event. Absorb its time into e3" - - e2 := e1. - t2 := t1] - ifFalse: [e1 ifNotNil: [tStream nextPut: (e1 copy setTimeStamp: t1)]]]. - e2 ifNotNil: [tStream nextPut: (e2 copy setTimeStamp: t2)]. - e3 ifNotNil: [tStream nextPut: (e3 copy setTimeStamp: t3)]]! Item was removed: - ----- Method: EventRecorderMorph>>convertV0Tape: (in category 'fileIn/Out') ----- - convertV0Tape: anArray - "Convert the tape into the new format" - | lastKey | - lastKey := 0. - ^anArray collect:[:assn| | evt | - evt := assn value. - evt setTimeStamp: (lastKey := lastKey + assn key). - evt]! Item was removed: - ----- Method: EventRecorderMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - ^ Color transparent! Item was removed: - ----- Method: EventRecorderMorph>>defaultBorderStyle (in category 'initialization') ----- - defaultBorderStyle - ^ BorderStyle raised! Item was removed: - ----- Method: EventRecorderMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 2! Item was removed: - ----- Method: EventRecorderMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color red! Item was removed: - ----- Method: EventRecorderMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'sound-piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - - self play.! Item was removed: - ----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') ----- - handleListenEvent: anEvent - "Record the given event" - anEvent hand == recHand ifFalse: [^ self]. "not for me" - state == #record ifFalse: [ - "If user got an error while recording and deleted recorder, will still be listening" - recHand ifNotNil: [recHand removeEventListener: self]. - ^self]. - anEvent = lastEvent ifTrue: [^ self]. - (anEvent isKeyboard and:[anEvent keyValue = 27 "esc"]) - ifTrue: [^ self stop]. - time := anEvent timeStamp. - tapeStream nextPut: (anEvent copy setHand: nil). - journalFile ifNotNil: - [journalFile store: anEvent; cr; flush]. - lastEvent := anEvent.! Item was removed: - ----- Method: EventRecorderMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - saved := true. - self listDirection: #topToBottom; - wrapCentering: #center; - cellPositioning: #topCenter; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 2; - minCellSize: 4; - addButtons! Item was removed: - ----- Method: EventRecorderMorph>>justDroppedIntoPianoRoll:event: (in category 'sound-piano rolls') ----- - justDroppedIntoPianoRoll: newOwner event: evt - - | startX lengthInTicks endX startTimeInScore endTimeInScore | - - super justDroppedIntoPianoRoll: newOwner event: evt. - - startTimeInScore := newOwner timeForX: self left. - lengthInTicks := newOwner scorePlayer ticksForMSecs: self myDurationInMS. - endTimeInScore := startTimeInScore + lengthInTicks. - - endTimeInScore > newOwner scorePlayer durationInTicks ifTrue: - [newOwner scorePlayer updateDuration]. - - startX := newOwner xForTime: startTimeInScore. - endX := newOwner xForTime: endTimeInScore. - self width: endX - startX. - ! Item was removed: - ----- Method: EventRecorderMorph>>makeARowForButtons (in category 'initialization') ----- - makeARowForButtons - - ^AlignmentMorph newRow - vResizing: #shrinkWrap; - wrapCentering: #center; - cellPositioning: #leftCenter; - minCellSize: 4; - color: Color blue! Item was removed: - ----- Method: EventRecorderMorph>>makeASpacer (in category 'initialization') ----- - makeASpacer - - ^AlignmentMorph newSpacer: Color transparent! Item was removed: - ----- Method: EventRecorderMorph>>makeStatusLight (in category 'initialization') ----- - makeStatusLight - - ^statusLight := EllipseMorph new - extent: 11 @ 11; - color: Color green; - borderWidth: 0! Item was removed: - ----- Method: EventRecorderMorph>>myDurationInMS (in category 'sound-piano rolls') ----- - myDurationInMS - - ^tape isEmptyOrNil ifTrue: [ - 10 - ] ifFalse: [ - tape last timeStamp - tape first timeStamp - ] - ! Item was removed: - ----- Method: EventRecorderMorph>>nextEventToPlay (in category 'event handling') ----- - nextEventToPlay - "Return the next event when it is time to be replayed. - If it is not yet time, then return an interpolated mouseMove. - Return nil if nothing has happened. - Return an EOF event if there are no more events to be played." - | nextEvent now nextTime lastP delta | - (tapeStream isNil or:[tapeStream atEnd]) - ifTrue:[^MorphicUnknownEvent new setType: #EOF argument: nil]. - now := Time millisecondClockValue. - nextEvent := tapeStream next. - "nextEvent isKeyboard ifTrue: [ nextEvent setPosition: self position ]." - deltaTime ifNil:[deltaTime := now - nextEvent timeStamp]. - nextTime := nextEvent timeStamp + deltaTime. - now < time ifTrue:["clock rollover" - time := now. - deltaTime := nil. - ^nil "continue it on next cycle"]. - time := now. - (now >= nextTime) ifTrue:[ - nextEvent := nextEvent copy setTimeStamp: nextTime. - nextEvent isMouse ifTrue:[lastEvent := nextEvent] ifFalse:[lastEvent := nil]. - ^nextEvent]. - tapeStream skip: -1. - "Not time for the next event yet, but interpolate the mouse. - This allows tapes to be compressed when velocity is fairly constant." - lastEvent ifNil: [^ nil]. - lastP := lastEvent position. - delta := (nextEvent position - lastP) * (now - lastEvent timeStamp) // (nextTime - lastEvent timeStamp). - delta = lastDelta ifTrue: [^ nil]. "No movement" - lastDelta := delta. - ^MouseMoveEvent new - setType: #mouseMove - startPoint: lastEvent position endPoint: lastP + delta - trail: #() buttons: lastEvent buttons hand: nil stamp: now.! Item was removed: - ----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') ----- - pauseIn: aWorld - "Suspend playing or recording, either as part of a stop command, - or as part of a project switch, after which it will be resumed." - - self setStatusLight: #ready. - state = #play ifTrue: - [state := #suspendedPlay. - playHand halo ifNotNil: [playHand halo delete]. - playHand delete. - aWorld removeHand: playHand. - aWorld firstHand showHardwareCursor: true. - playHand := nil]. - state = #record ifTrue: - [state := #suspendedRecord. - recHand removeEventListener: self. - recHand := nil]. - - voiceRecorder ifNotNil: - [voiceRecorder pause. - startSoundEvent ifNotNil: - [startSoundEvent argument: voiceRecorder recordedSound. - voiceRecorder clearRecordedSound. - startSoundEvent := nil]]. - ! Item was removed: - ----- Method: EventRecorderMorph>>play (in category 'commands') ----- - play - - self isInWorld ifFalse: [^ self]. - self stop. - tape ifNil: [^ self]. - tapeStream := ReadStream on: tape. - self resumePlayIn: self world. - self setStatusLight: #nowPlaying. - - ! Item was removed: - ----- Method: EventRecorderMorph>>readFrom: (in category 'fileIn/Out') ----- - readFrom: aStream - "Private" - | header | - header := aStream nextLine. - (header = 'Event Tape v1 BINARY') ifTrue:[^aStream fileInObjectAndCode]. - (header = 'Event Tape v1 ASCII') ifTrue:[^self readFromV1: aStream]. - "V0 had no header so guess" - aStream reset. - header first isDigit ifFalse:[^self convertV0Tape: (aStream fileInObjectAndCode)]. - ^self convertV0Tape: (self readFromV0: aStream). - ! Item was removed: - ----- Method: EventRecorderMorph>>readFromV0: (in category 'fileIn/Out') ----- - readFromV0: aStream - ^Array streamContents:[:tStream | | evt line t lineStream | - [aStream atEnd] whileFalse: - [line := aStream nextLine. - line isEmpty "Some MW tapes have an empty record at the end" - ifFalse: [lineStream := ReadStream on: line. - t := Integer readFrom: lineStream. - [lineStream peek isLetter] whileFalse: [lineStream next]. - evt := MorphicEvent readFromObsolete: lineStream. - tStream nextPut: t -> evt]]].! Item was removed: - ----- Method: EventRecorderMorph>>readFromV1: (in category 'fileIn/Out') ----- - readFromV1: aStream - ^Array streamContents:[:tStream | - [aStream atEnd] whileFalse:[ - tStream nextPut: (MorphicEvent readFromString: aStream nextLine)]]! Item was removed: - ----- Method: EventRecorderMorph>>readTape (in category 'fileIn/Out') ----- - readTape - ^ self readTape: (UIManager default - request: 'Tape to read' translated - initialAnswer: 'tapeName.tape').! Item was removed: - ----- Method: EventRecorderMorph>>readTape: (in category 'fileIn/Out') ----- - readTape: fileName - | file | - self writeCheck. - (FileStream isAFileNamed: fileName) ifFalse: [^ nil]. - file := FileStream oldFileNamed: fileName. - tape := self readFrom: file. - file close. - saved := true "Still exists on file"! Item was removed: - ----- Method: EventRecorderMorph>>record (in category 'commands') ----- - record - - self isInWorld ifFalse: [^ self]. - self stop. - self writeCheck. - self addJournalFile. - tapeStream := WriteStream on: (Array new: 10000). - self resumeRecordIn: self world. - self setStatusLight: #nowRecording. - ! Item was removed: - ----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') ----- - resumeIn: aWorld - "Resume playing or recording after a project switch." - - self state = #suspendedPlay ifTrue: - [self resumePlayIn: aWorld]. - self state = #suspendedRecord ifTrue: - [self resumeRecordIn: aWorld]. - ! Item was removed: - ----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') ----- - resumePlayIn: aWorld - - playHand := HandMorphForReplay new recorder: self. - playHand position: tapeStream peek position. - aWorld addHand: playHand. - playHand newKeyboardFocus: aWorld. - playHand userInitials: 'play' andPicture: nil. - - lastEvent := nil. - lastDelta := 0 at 0. - state := #play. - - self synchronize. - ! Item was removed: - ----- Method: EventRecorderMorph>>resumeRecordIn: (in category 'pause/resume') ----- - resumeRecordIn: aWorld - - recHand := aWorld activeHand ifNil: [aWorld primaryHand]. - recHand newKeyboardFocus: aWorld. - recHand addEventListener: self. - - lastEvent := nil. - state := #record. - - voiceRecorder ifNotNil: - [voiceRecorder clearRecordedSound. - voiceRecorder resumeRecording. - startSoundEvent := MorphicUnknownEvent new setType: #startSound argument: nil hand: nil stamp: Time millisecondClockValue. - tapeStream nextPut: startSoundEvent]. - - self synchronize. - ! Item was removed: - ----- Method: EventRecorderMorph>>setStatusLight: (in category 'commands') ----- - setStatusLight: aSymbol - - aSymbol == #ready ifTrue: [ - statusLight color: Color green. - tape ifNil: [ - statusLight setBalloonText: 'Ready to record'. - ] ifNotNil: [ - statusLight setBalloonText: 'Ready to record or play'. - ]. - ^self - ]. - aSymbol == #nowRecording ifTrue: [ - statusLight - color: Color red; - setBalloonText: 'Recording is active'. - ^self - ]. - aSymbol == #nowPlaying ifTrue: [ - statusLight - color: Color yellow; - setBalloonText: 'Now playing'. - ^self - ]. - ! Item was removed: - ----- Method: EventRecorderMorph>>shrink (in category 'commands') ----- - shrink - "Shorten the tape by deleting mouseMove events that can just as well be - interpolated later at playback time." - - | oldSize priorSize | - self writeCheck. - oldSize := priorSize := tape size. - [self condense. tape size < priorSize] whileTrue: [priorSize := tape size]. - self inform: ('{1} events reduced to {2}' translated format:{oldSize. tape size}). - voiceRecorder ifNotNil: [voiceRecorder suppressSilence]. - saved := false. - ! Item was removed: - ----- Method: EventRecorderMorph>>step (in category 'stepping and presenter') ----- - step - - (state == #record and: [voiceRecorder notNil]) ifTrue: [ - recordMeter width: (voiceRecorder meterLevel + 1). - ]. - ! Item was removed: - ----- Method: EventRecorderMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^500 - ! Item was removed: - ----- Method: EventRecorderMorph>>stop (in category 'stepping and presenter') ----- - stop - - state = #record ifTrue: - [tape := tapeStream contents. - saved := false]. - journalFile ifNotNil: - [journalFile close]. - self pauseIn: self world. - tapeStream := nil. - state := nil. - self setStatusLight: #ready. - recordMeter ifNotNil: [recordMeter width: 1]. - - self checkTape.! Item was removed: - ----- Method: EventRecorderMorph>>synchronize (in category 'event handling') ----- - synchronize - - time := Time millisecondClockValue. - deltaTime := nil.! Item was removed: - ----- Method: EventRecorderMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - - ^true - ! Item was removed: - ----- Method: EventRecorderMorph>>writeCheck (in category 'fileIn/Out') ----- - writeCheck - (saved not and: [self confirm: 'The current tape has not been saved. - Would you like to do so now?']) ifTrue: - [self writeTape]. - ! Item was removed: - ----- Method: EventRecorderMorph>>writeFileNamed: (in category 'fileIn/Out') ----- - writeFileNamed: fileName - | file noVoice delta | - file := FileStream newFileNamed: fileName. - noVoice := true. - tape do:[:evt | evt type = #startSound ifTrue: [noVoice := false]]. - noVoice - ifTrue: ["Simple format (reads fast) for no voice" - file nextPutAll:'Event Tape v1 ASCII'; cr. - delta := tape first timeStamp. - tape do: [:evt | file store: (evt copy setTimeStamp: evt timeStamp-delta); cr]. - file close] - ifFalse: ["Inclusion of voice events requires general object storage" - file nextPutAll:'Event Tape v1 BINARY'; cr. - file fileOutClass: nil andObject: tape]. - saved := true. - ^ file name! Item was removed: - ----- Method: EventRecorderMorph>>writeTape (in category 'fileIn/Out') ----- - writeTape - | args b fileName | - args := (b := self button: 'writeTape') isNil - ifTrue: [#()] - ifFalse: [b arguments]. - (args notEmpty - and: [args first notEmpty]) - ifTrue: [args first. - self writeTape: args first] - ifFalse: [fileName := UIManager default saveFilenameRequest: 'Tape to write' initialAnswer: 'tapeName.tape'. - fileName ifNil: [^ self]. - ^ self writeTape: fileName]! Item was removed: - ----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') ----- - writeTape: fileName - | name bb | - name := self writeFileNamed: fileName. - bb := self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph) - and: [mm label = 'writeTape']] - ifAbsent: [^ self]. - bb actionSelector: #writeTape:. - bb arguments: (Array with: name). - ! Item was removed: - Model subclass: #FancyMailComposition - instanceVariableNames: 'messageText theLinkToInclude to subject' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-EToy-Download'! Item was removed: - ----- Method: FancyMailComposition>>addAttachment (in category 'actions') ----- - addAttachment - - self changed: #acceptChanges. - - (FileChooserDialog openOn: FileDirectory default pattern: nil label: 'Choose attachment') ifNotNil: - [:fileName | - FileStream readOnlyFileNamed: fileName do: - [:file | - file binary. - self messageText: - ((MailMessage from: self messageText asString) - addAttachmentFrom: file withName: (FileDirectory localNameFor: fileName); - text)]]! Item was removed: - ----- Method: FancyMailComposition>>breakLines:atWidth: (in category 'private') ----- - breakLines: aString atWidth: width - "break lines in the given string into shorter lines" - | result atAttachment | - - result := WriteStream on: (String new: (aString size * 50 // 49)). - - atAttachment := false. - aString asString linesDo: [ :line | | start end | - (line beginsWith: '====') ifTrue: [ atAttachment := true ]. - atAttachment ifTrue: [ - "at or after an attachment line; no more wrapping for the rest of the message" - result nextPutAll: line. result cr ] - ifFalse: [ - (line beginsWith: '>') ifTrue: [ - "it's quoted text; don't wrap it" - result nextPutAll: line. result cr. ] - ifFalse: [ - "regular old line. Wrap it to multiple lines" - start := 1. - "output one shorter line each time through this loop" - [ start + width <= line size ] whileTrue: [ - - "find the end of the line" - end := start + width - 1. - [end >= start and: [ (line at: (end+1)) isSeparator not ]] whileTrue: [ - end := end - 1 ]. - end < start ifTrue: [ - "a word spans the entire width!!" - end := start + width - 1 ]. - - "copy the line to the output" - result nextPutAll: (line copyFrom: start to: end). - result cr. - - "get ready for next iteration" - start := end+1. - (line at: start) isSeparator ifTrue: [ start := start + 1 ]. - ]. - - "write out the final part of the line" - result nextPutAll: (line copyFrom: start to: line size). - result cr. - ]. - ]. - ]. - - ^result contents! Item was removed: - ----- Method: FancyMailComposition>>buildButtonsWith: (in category 'toolbuilder') ----- - buildButtonsWith: builder - - | panel | - panel := builder pluggablePanelSpec new. - panel - layout: #horizontal; - children: OrderedCollection new. - - panel children addLast: (builder pluggableButtonSpec new - model: self; - label: 'send later'; - help: 'add this to the queue of messages to be sent'; - action: #submit; - color: Color white; - yourself). - - panel children addLast: (builder pluggableButtonSpec new - model: self; - label: 'send now'; - help: 'send this message immediately'; - action: #sendNow; - color: Color white; - yourself). - - panel children addLast: (builder pluggableButtonSpec new - model: self; - label: 'add attachment'; - help: 'send a file with the message'; - action: #addAttachment; - color: Color white; - yourself). - - ^ panel! Item was removed: - ----- Method: FancyMailComposition>>buildMessageTextWith: (in category 'toolbuilder') ----- - buildMessageTextWith: builder - - ^ builder pluggableTextSpec new - model: self; - getText: #messageText; - setText: #messageText:; - menu: #menuGet:shifted:; - yourself! Item was removed: - ----- Method: FancyMailComposition>>buildTextFieldsWith: (in category 'toolbuilder') ----- - buildTextFieldsWith: builder - - | panel | - panel := builder pluggablePanelSpec new. - panel - layout: #vertical; - children: OrderedCollection new. - - panel children addLast: (builder pluggableInputFieldSpec new - model: self; - help: 'To'; - getText: #to; - setText: #to:; - yourself). - - panel children addLast: (builder pluggableInputFieldSpec new - model: self; - help: 'Subject'; - getText: #subject; - setText: #subject:; - yourself). - - ^ panel! Item was removed: - ----- Method: FancyMailComposition>>buildWith: (in category 'toolbuilder') ----- - buildWith: builder - - ^ builder build: (self buildWindowWith: builder specs: { - (0 @ 0 corner: 1 @ 0.1) -> [self buildButtonsWith: builder]. - (0 @ 0.1 corner: 1 @ 0.3) -> [self buildTextFieldsWith: builder]. - (0 @ 0.3 corner: 1 @ 1) -> [self buildMessageTextWith: builder]. })! Item was removed: - ----- Method: FancyMailComposition>>celeste:to:subject:initialText:theLinkToInclude: (in category 'initialization') ----- - celeste: aCeleste to: argTo subject: argSubject initialText: aText theLinkToInclude: linkText - "self new celeste: Celeste current to: 'danielv at netvision.net.il' subject: 'Mysubj' initialText: 'atext' theLinkToInclude: 'linkText'" - - to := argTo. - subject := argSubject. - messageText := aText. - theLinkToInclude := linkText.! Item was removed: - ----- Method: FancyMailComposition>>completeTheMessage (in category 'actions') ----- - completeTheMessage - - | newText strm | - self changed: #acceptChanges. - - newText := String new: 200. - strm := WriteStream on: newText. - strm - nextPutAll: 'Content-Type: text/html'; cr; - nextPutAll: 'From: ', MailSender userName; cr; - nextPutAll: 'To: ',to; cr; - nextPutAll: 'Subject: ',subject; cr; - - cr; - nextPutAll: '<HTML><BODY><BR>'; - nextPutAll: messageText asStringToHtml; - nextPutAll: '<BR><BR>',theLinkToInclude,'<BR></BODY></HTML>'. - ^strm contents! Item was removed: - ----- Method: FancyMailComposition>>defaultWindowColor (in category 'user interface') ----- - defaultWindowColor - - ^ Color veryLightGray! Item was removed: - ----- Method: FancyMailComposition>>forgetIt (in category 'user interface') ----- - forgetIt - - self changed: #close.! Item was removed: - ----- Method: FancyMailComposition>>menuGet:shifted: (in category 'interface') ----- - menuGet: aMenu shifted: shifted - - aMenu addList: { - {'find...(f)' translated. #find}. - {'find selection again (g)' translated. #findAgain}. - #-. - {'accept (s)' translated. #accept}. - {'send message' translated. #submit}}. - - ^aMenu.! Item was removed: - ----- Method: FancyMailComposition>>messageText (in category 'accessing') ----- - messageText - "return the current text" - ^messageText. - ! Item was removed: - ----- Method: FancyMailComposition>>messageText: (in category 'accessing') ----- - messageText: aText - "change the current text" - messageText := aText. - self changed: #messageText. - ^true! Item was removed: - ----- Method: FancyMailComposition>>open (in category 'user interface') ----- - open - - self flag: #refactor. "FancyMailComposition should probably be removed in favour of MailComposition." - ^ ToolBuilder open: self! Item was removed: - ----- Method: FancyMailComposition>>sendMailMessage: (in category 'MailSender interface') ----- - sendMailMessage: aMailMessage - self messageText: aMailMessage text! Item was removed: - ----- Method: FancyMailComposition>>sendNow (in category 'actions') ----- - sendNow - - self submit: true - ! Item was removed: - ----- Method: FancyMailComposition>>smtpServer (in category 'MailSender interface') ----- - smtpServer - ^MailSender smtpServer! Item was removed: - ----- Method: FancyMailComposition>>subject (in category 'accessing') ----- - subject - - ^ subject - - ! Item was removed: - ----- Method: FancyMailComposition>>subject: (in category 'accessing') ----- - subject: x - - subject := x. - self changed: #subject. - ^true! Item was removed: - ----- Method: FancyMailComposition>>submit (in category 'actions') ----- - submit - - self submit: false! Item was removed: - ----- Method: FancyMailComposition>>submit: (in category 'actions') ----- - submit: sendNow - - | message | - - messageText := self breakLines: self completeTheMessage atWidth: 999. - message := MailMessage from: messageText. - SMTPClient - deliverMailFrom: message from - to: (Array with: message to) - text: message text - usingServer: self smtpServer. - self forgetIt. - ! Item was removed: - ----- Method: FancyMailComposition>>to (in category 'accessing') ----- - to - - ^to! Item was removed: - ----- Method: FancyMailComposition>>to: (in category 'accessing') ----- - to: x - - to := x. - self changed: #to. - ^true - ! Item was removed: - ----- Method: FancyMailComposition>>windowTitle (in category 'user interface') ----- - windowTitle - - ^ 'Mister Postman'! Item was removed: - SketchMorph subclass: #FatBitsPaint - instanceVariableNames: 'formToEdit magnification brush brushSize brushColor lastMouse currentTools currentSelectionMorph selectionAnchor backgroundColor' - classVariableNames: 'FormClipboard' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalWidgets'! - - !FatBitsPaint commentStamp: '<historical>' prior: 0! - Extensions to FatBitsPaint - - With the goal of making FatBitsPaint a fairly nifty Form fixer-upper in the Squeak/morphic environment, I have started this set of extensions. It will probably be updated as the mood strikes, so keep an eye out for new versions. - - First, some basic operating instructions: - - Get a Form and send it the message #morphEdit. To get started, you can try: - - (Form fromUser) morphEdit - - And there is the form in all its glory. Control click on the form to get theFatBitsPaint menu and choose the "keep this menu up" item. This will be your main tool/command palette. With it you can: - ¥ Change the magnification - ¥ Change the brush size (in original scale pixels) - ¥ Change the brush color (via a ColorPickerMorph) - - Now to some of the enhancements: - - (25 September 1999 2:38:25 pm ) - - ¥ ColorPickerMorphs now have a label below that indicates their use (you might have more than one open) - ¥ A quirk that could get the brush size out of alignment with the pixel size is fixed. - ¥ A background has been added so that you can see the full extent of the Form and so that you can observe the effect of translucent pixels in the form. - ¥ A menu item has been added to change the background color so that you can simulate the real environment the form will be displayed in. - ¥ The magnification and brush size menus now highlight their current value. - ¥ An inspect option has been added to the menu so that you can do arbitrary things to the form. - ¥ A file out option has been added to write the form to a file. - - (25 September 1999 10:02:13 pm ) - - ¥ New menu item: Tools allows you to choose between (for now) Paint Brush (all there was before) and Selections. Selections allows you to select rectangular regions of the form where the next menu takes over. - ¥ New menu item: Selections gives you choices: - ¥ edit separately - opens a new editor on the selected rectangle. Useful for cropping. - ¥ copy - copies the selection rectangle to a clipboard. Can be pasted to this or another FatBitsPaint. - ¥ cut - does a copy and clears the selection to transparent. - ¥ paste - paints the contents of the clipboard over the current selection. Only the starting point of the selection matters - the extent is controlled by the clipboard. - - ! Item was removed: - ----- Method: FatBitsPaint>>accept (in category 'menu') ----- - accept - | f | - f := self unmagnifiedForm. - f boundingBox = formToEdit boundingBox - ifFalse: [^ self error: 'implementation error; form dimensions should match']. - f displayOn: formToEdit. "modify formToEdit in place"! Item was removed: - ----- Method: FatBitsPaint>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - ^ aCustomMenu add: 'fat bits paint ..' translated action: #openFatBitsPaintMenu! Item was removed: - ----- Method: FatBitsPaint>>backgroundColor: (in category 'menu') ----- - backgroundColor: aColor - - backgroundColor := aColor. - self changed! Item was removed: - ----- Method: FatBitsPaint>>brushColor: (in category 'menu') ----- - brushColor: aColor - - brushColor := aColor. - brush color: aColor. - ! Item was removed: - ----- Method: FatBitsPaint>>containsPoint: (in category 'geometry testing') ----- - containsPoint: aPoint - - ^ self bounds containsPoint: aPoint "even if we are transparent" - ! Item was removed: - ----- Method: FatBitsPaint>>copySelection (in category 'menu') ----- - copySelection - - | relativeBounds scaledBounds | - currentSelectionMorph ifNil: [^ nil]. - relativeBounds := currentSelectionMorph bounds translateBy: self position negated. - scaledBounds := relativeBounds scaleBy: 1 / magnification. - FormClipboard := (self unmagnifiedForm copy: scaledBounds). - ^ relativeBounds! Item was removed: - ----- Method: FatBitsPaint>>cutSelection (in category 'menu') ----- - cutSelection - - | relativeBounds | - relativeBounds := self copySelection ifNil: [^ nil]. - originalForm fill: relativeBounds rule: Form over fillColor: Color transparent. - self revealPenStrokes! Item was removed: - ----- Method: FatBitsPaint>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color veryVeryLightGray! Item was removed: - ----- Method: FatBitsPaint>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | f | - f := self rotatedForm. - backgroundColor ifNotNil: [aCanvas fillRectangle: bounds fillStyle: backgroundColor]. - aCanvas translucentImage: f at: bounds origin.! Item was removed: - ----- Method: FatBitsPaint>>editForm: (in category 'initialization') ----- - editForm: aForm - - formToEdit := aForm. - brushSize := magnification := 64 // (aForm height min: aForm width) max: 4. - self revert! Item was removed: - ----- Method: FatBitsPaint>>editSelection (in category 'menu') ----- - editSelection - - FatBitsPaint new openWith: (self selectionAsForm ifNil: [^ nil])! Item was removed: - ----- Method: FatBitsPaint>>fileOut (in category 'menu') ----- - fileOut - - | fileName | - - fileName := FileSaverDialog openOn: FileDirectory default. - fileName ifNil: [^Beeper beep]. - - Cursor normal showWhile: [self unmagnifiedForm writeOnFileNamed: fileName]! Item was removed: - ----- Method: FatBitsPaint>>fill (in category 'menu') ----- - fill - - | fillPt | - Cursor blank show. - fillPt := Cursor crossHair showWhile: - [Sensor waitButton - self position]. - originalForm shapeFill: brushColor interiorPoint: fillPt. - self changed. - ! Item was removed: - ----- Method: FatBitsPaint>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ true - ! Item was removed: - ----- Method: FatBitsPaint>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self setCurrentToolTo: self toolsForPaintBrush. - formToEdit := Form extent: 50 @ 40 depth: 8. - formToEdit fill: formToEdit boundingBox fillColor: Color veryVeryLightGray. - brushSize := magnification := 4. - - brushColor := Color red. - backgroundColor := Color white. - self revert! Item was removed: - ----- Method: FatBitsPaint>>inspectForm (in category 'menu') ----- - inspectForm - - self unmagnifiedForm inspect! Item was removed: - ----- Method: FatBitsPaint>>magnification: (in category 'menu') ----- - magnification: aNumber - - | oldPenSize oldForm | - oldPenSize := brushSize / magnification. - oldForm := self unmagnifiedForm. - magnification := aNumber asInteger max: 1. - self form: (oldForm magnify: oldForm boundingBox by: magnification). - brush := Pen newOnForm: originalForm. - self penSize: oldPenSize. - brush color: brushColor! Item was removed: - ----- Method: FatBitsPaint>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - ^ self - perform: (currentTools at: #mouseDown: ifAbsent: [^nil]) - with: evt! Item was removed: - ----- Method: FatBitsPaint>>mouseDownDefault: (in category 'events') ----- - mouseDownDefault: evt - lastMouse := nil. - formToEdit depth = 1 ifTrue: - [self brushColor: (originalForm colorAt: (self pointGriddedFromEvent: evt)) negated]! Item was removed: - ----- Method: FatBitsPaint>>mouseDownSelection: (in category 'events') ----- - mouseDownSelection: evt - - lastMouse := nil. - currentSelectionMorph ifNotNil: [currentSelectionMorph delete. currentSelectionMorph := nil]. - selectionAnchor := self pointGriddedFromEvent: evt! Item was removed: - ----- Method: FatBitsPaint>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - ^ self - perform: (currentTools at: #mouseMove: ifAbsent: [^nil]) - with: evt! Item was removed: - ----- Method: FatBitsPaint>>mouseMovePaintBrushMode: (in category 'events') ----- - mouseMovePaintBrushMode: evt - - | p p2 | - p := self pointGriddedFromEvent: evt. - lastMouse = p ifTrue: [^ self]. - lastMouse ifNil: [lastMouse := p]. "first point in a stroke" - "draw etch-a-sketch style-first horizontal, then vertical" - p2 := p x at lastMouse y. - brush drawFrom: lastMouse to: p2. - brush drawFrom: p2 to: p. - - self revealPenStrokes. - lastMouse := p! Item was removed: - ----- Method: FatBitsPaint>>mouseMoveSelectionMode: (in category 'menu') ----- - mouseMoveSelectionMode: evt - - | p | - p := self pointGriddedFromEvent: evt. - lastMouse = p ifTrue: [^ self]. - - currentSelectionMorph ifNil: - [currentSelectionMorph := MarqueeMorph new - color: Color transparent; - borderWidth: 2; - lock. - self addMorphFront: currentSelectionMorph. - currentSelectionMorph startStepping]. - currentSelectionMorph - bounds: ((Rectangle encompassing: {p. selectionAnchor}) translateBy: self position). - - lastMouse := p! Item was removed: - ----- Method: FatBitsPaint>>openFatBitsPaintMenu (in category 'menu') ----- - openFatBitsPaintMenu - | menu | - (menu := MenuMorph entitled: 'FatBitsPaint' translated) defaultTarget: self; - addStayUpItem; - commandKeyHandler: self. - menu add: 'background color' translated action: #setBackgroundColor:; - add: 'pen color' translated action: #setPenColor:; - add: 'pen size' translated action: #setPenSize:; - add: 'fill' translated action: #fill; - add: 'magnification' translated action: #setMagnification:; - add: 'accept' translated action: #accept; - add: 'revert' translated action: #revert; - add: 'inspect' translated action: #inspectForm; - add: 'file out' translated action: #fileOut; - add: 'selection...' translated action: #selectionMenu:; - add: 'tools...' translated action: #toolMenu:. - ^ menu popUpInWorld! Item was removed: - ----- Method: FatBitsPaint>>openWith: (in category 'initialization') ----- - openWith: aForm - - self editForm: aForm; openInWorld! Item was removed: - ----- Method: FatBitsPaint>>pasteSelection (in category 'menu') ----- - pasteSelection - - | relativeBounds tempForm | - currentSelectionMorph ifNil: [^ nil]. - FormClipboard ifNil: [^nil]. - relativeBounds := currentSelectionMorph bounds translateBy: self position negated. - tempForm := (FormClipboard magnify: FormClipboard boundingBox by: magnification). - self form - copy: (relativeBounds origin extent: tempForm boundingBox extent) - from: 0 at 0 - in: tempForm - rule: Form over. - self revealPenStrokes! Item was removed: - ----- Method: FatBitsPaint>>penSize: (in category 'menu') ----- - penSize: aNumber - - brushSize := (aNumber * magnification) asInteger. - brush squareNib: brushSize. - ! Item was removed: - ----- Method: FatBitsPaint>>pointGriddedFromEvent: (in category 'events') ----- - pointGriddedFromEvent: evt - - | relativePt | - relativePt := evt cursorPoint - self position. - ^ (relativePt x truncateTo: magnification)@(relativePt y truncateTo: magnification) - ! Item was removed: - ----- Method: FatBitsPaint>>revert (in category 'menu') ----- - revert - "since WarpBits may mangle an 8-bit ColorForm, make it 32 first" - self form: ((formToEdit asFormOfDepth: 32) - magnify: formToEdit boundingBox - by: magnification - smoothing: 1). - brush := Pen newOnForm: originalForm. - brush squareNib: brushSize. - brush color: brushColor! Item was removed: - ----- Method: FatBitsPaint>>selectionAsForm (in category 'menu') ----- - selectionAsForm - - | relativeBounds scaledBounds | - currentSelectionMorph ifNil: [^nil]. - relativeBounds := currentSelectionMorph bounds translateBy: self position negated. - scaledBounds := relativeBounds scaleBy: 1 / magnification. - ^ self unmagnifiedForm copy: scaledBounds! Item was removed: - ----- Method: FatBitsPaint>>selectionMenu: (in category 'menu') ----- - selectionMenu: evt - - | menu | - - (menu := MenuMorph new) - addTitle: 'Edit'; - addStayUpItem. - - { - {'edit separately'. #editSelection}. - {'copy'. #copySelection}. - {'cut'. #cutSelection}. - {'paste'. #pasteSelection} - } do: [:each | - menu add: each first - target: self - selector: each second - argumentList: #()]. - menu toggleStayUp: evt. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: FatBitsPaint>>setBackgroundColor: (in category 'menu') ----- - setBackgroundColor: evt - - self - changeColorTarget: self - selector: #backgroundColor: - originalColor: backgroundColor - hand: evt hand! Item was removed: - ----- Method: FatBitsPaint>>setCurrentToolTo: (in category 'initialization') ----- - setCurrentToolTo: aDictionary - - currentTools := aDictionary. - currentSelectionMorph ifNotNil: [currentSelectionMorph delete. currentSelectionMorph := nil]! Item was removed: - ----- Method: FatBitsPaint>>setMagnification: (in category 'menu') ----- - setMagnification: evt - | menu | - menu := MenuMorph new. - ((1 to: 8), #(16 24 32)) do: [:w | - menu add: w printString - target: self - selector: #magnification: - argumentList: (Array with: w). - magnification = w ifTrue: [menu lastSubmorph color: Color red]]. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: FatBitsPaint>>setPenColor: (in category 'menu') ----- - setPenColor: evt - - self changeColorTarget: self selector: #brushColor: originalColor: brushColor hand: evt hand.! Item was removed: - ----- Method: FatBitsPaint>>setPenSize: (in category 'menu') ----- - setPenSize: evt - | menu sizes | - - menu := MenuMorph new. - sizes := (1 to: 5), (6 to: 12 by: 2), (15 to: 40 by: 5). - sizes do: [:w | - menu add: w printString - target: self - selector: #penSize: - argumentList: (Array with: w). - (brushSize // magnification) = w ifTrue: [menu lastSubmorph color: Color red]]. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: FatBitsPaint>>toolMenu: (in category 'events') ----- - toolMenu: evt - | menu | - menu := MenuMorph new. - menu - addTitle: 'Tools'; - addStayUpItem. - { - {'paint brush'. self toolsForPaintBrush}. - {'selections'. self toolsForSelection} - } do: [:each | - menu add: each first - target: self - selector: #setCurrentToolTo: - argumentList: {each second}]. - menu toggleStayUp: evt. - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: FatBitsPaint>>toolsForPaintBrush (in category 'initialization') ----- - toolsForPaintBrush - - ^Dictionary new - at: #mouseMove: put: #mouseMovePaintBrushMode:; - at: #mouseDown: put: #mouseDownDefault:; - yourself! Item was removed: - ----- Method: FatBitsPaint>>toolsForSelection (in category 'initialization') ----- - toolsForSelection - - ^ Dictionary new - at: #mouseMove: put: #mouseMoveSelectionMode:; - at: #mouseDown: put: #mouseDownSelection:; - yourself! Item was removed: - ----- Method: FatBitsPaint>>unmagnifiedForm (in category 'menu') ----- - unmagnifiedForm - - ^ self form shrink: self form boundingBox by: magnification! Item was removed: - ----- Method: FileDirectory>>url (in category '*MorphicExtras-file name utilities') ----- - url - "Convert my path into a file:// type url String." - - ^self asUrl asString.! Item was removed: - ----- Method: FileStream>>url (in category '*MorphicExtras-file accessing') ----- - url - "Convert my path into a file:// type url String." - - ^self asUrl asString! Item was removed: - ReferenceMorph subclass: #FlapTab - instanceVariableNames: 'flapShowing edgeToAdhereTo slidesOtherObjects popOutOnDragOver popOutOnMouseOver inboard dragged lastReferentThickness edgeFraction labelString' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Flaps'! - - !FlapTab commentStamp: '<historical>' prior: 0! - The tab associated with a flap. - - nb: slidesOtherObjects and inboard are instance variables relating to disused features. The feature implementations still exist in the system, but the UI to them has been sealed off.! Item was removed: - ----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'flap tab' translatedNoop! Item was removed: - ----- Method: FlapTab class>>givenID:matches: (in category 'testing') ----- - givenID: aFlapID matches: pureID - "eg, FlapTab givenID: 'Stack Tools2' matches: 'Stack Tools' " - - ^ aFlapID = pureID or: - [(aFlapID beginsWith: pureID) - and: [(aFlapID copyFrom: pureID size+1 to: aFlapID size) - allSatisfy: [:c | c isDigit]]]! Item was removed: - ----- Method: FlapTab class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Not to be instantiated from the menu" - ^ false! Item was removed: - ----- Method: FlapTab>>acquirePlausibleFlapID (in category 'access') ----- - acquirePlausibleFlapID - "Give the receiver a flapID that is globally unique; try to hit the mark vis a vis the standard system flap id's, for the case when this method is invoked as part of the one-time transition" - - | wording | - wording := self wording. - (wording isEmpty or: [wording = '---']) ifTrue: [wording := 'Flap' translated]. - - ^ self provideDefaultFlapIDBasedOn: wording! Item was removed: - ----- Method: FlapTab>>adaptToWorld (in category 'initialization') ----- - adaptToWorld - | wasShowing new | - (wasShowing := self flapShowing) ifTrue: - [self hideFlap]. - (self respondsTo: #unhibernate) ifTrue: [ - (new := self unhibernate) == self ifFalse: [ - ^ new adaptToWorld]]. - wasShowing ifTrue: - [self spanWorld. - self positionObject: self. - self showFlap]! Item was removed: - ----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - "Add further items to the menu as appropriate" - - aMenu add: 'tab color...' translated target: self action: #changeColor. - aMenu add: 'flap color...' translated target: self action: #changeFlapColor. - aMenu addLine. - aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo. - aMenu addLine. - aMenu addUpdating: #textualTabString action: #textualTab. - aMenu addUpdating: #graphicalTabString action: #graphicalTab. - aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab. - aMenu addLine. - - (referent isKindOf: PasteUpMorph) ifTrue: - [aMenu addUpdating: #partsBinString action: #togglePartsBinMode]. - aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior. - aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior. - aMenu addLine. - aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap. - aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated. - - aMenu addLine. - aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap. - aMenu add: 'destroy this flap' translated action: #destroyFlap. - - "aMenu addUpdating: #slideString action: #toggleSlideBehavior. - aMenu addUpdating: #inboardString action: #toggleInboardness. - aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness." - - ! Item was removed: - ----- Method: FlapTab>>addGestureMenuItems:hand: (in category 'menus') ----- - addGestureMenuItems: aMenu hand: aHandMorph - "If the receiver wishes the Genie menu items, add a line to the menu and then those Genie items, else do nothing"! Item was removed: - ----- Method: FlapTab>>addTitleForHaloMenu: (in category 'menus') ----- - addTitleForHaloMenu: aMenu - aMenu addTitle: self externalName updatingSelector: #flapMenuTitle updateTarget: self! Item was removed: - ----- Method: FlapTab>>adjustPositionAfterHidingFlap (in category 'show & hide') ----- - adjustPositionAfterHidingFlap - self positionObject: self! Item was removed: - ----- Method: FlapTab>>adjustPositionVisAVisFlap (in category 'positioning') ----- - adjustPositionVisAVisFlap - | sideToAlignTo opposite | - opposite := Utilities oppositeSideTo: edgeToAdhereTo. - sideToAlignTo := inboard - ifTrue: [opposite] - ifFalse: [edgeToAdhereTo]. - self perform: sideToAlignTo asSimpleSetter with: (referent perform: opposite)! Item was removed: - ----- Method: FlapTab>>applyEdgeFractionWithin: (in category 'edge') ----- - applyEdgeFractionWithin: aBoundsRectangle - "Make the receiver reflect remembered edgeFraction" - - | newPosition | - edgeFraction ifNil: [^ self]. - self isCurrentlySolid ifTrue: [^ self]. - newPosition := self - ifVertical: - [self left @ (self edgeFraction * (aBoundsRectangle height - self height))] - ifHorizontal: - [(self edgeFraction * (aBoundsRectangle width - self width) @ self top)]. - - self position: (aBoundsRectangle origin + newPosition) - ! Item was removed: - ----- Method: FlapTab>>applyTabThickness: (in category 'solid tabs') ----- - applyTabThickness: newThickness - (self orientation == #vertical) - ifTrue: - [submorphs first width: newThickness asNumber] - ifFalse: - [submorphs first height: newThickness asNumber]. - self fitContents. - self positionReferent. - self adjustPositionVisAVisFlap! Item was removed: - ----- Method: FlapTab>>applyThickness: (in category 'menu') ----- - applyThickness: newThickness - | toUse | - toUse := newThickness asNumber max: 0. - (self orientation == #vertical) - ifTrue: - [referent width: toUse] - ifFalse: - [referent height: toUse]. - self positionReferent. - self adjustPositionVisAVisFlap! Item was removed: - ----- Method: FlapTab>>arrangeToPopOutOnDragOver: (in category 'mouseover & dragover') ----- - arrangeToPopOutOnDragOver: aBoolean - aBoolean - ifTrue: - [self on: #mouseEnterDragging send: #showFlapIfHandLaden: to: self. - referent on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self. - self on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self] - ifFalse: - [self on: #mouseEnterDragging send: nil to: nil. - referent on: #mouseLeaveDragging send: nil to: nil. - self on: #mouseLeaveDragging send: nil to: nil]! Item was removed: - ----- Method: FlapTab>>arrangeToPopOutOnMouseOver: (in category 'mouseover & dragover') ----- - arrangeToPopOutOnMouseOver: aBoolean - aBoolean - ifTrue: - [self on: #mouseEnter send: #showFlap to: self. - referent on: #mouseLeave send: #hideFlapUnlessBearingHalo to: self. - self on: #mouseLeave send: #maybeHideFlapOnMouseLeave to: self] - ifFalse: - [self on: #mouseEnter send: nil to: nil. - self on: #mouseLeave send: nil to: nil. - referent on: #mouseLeave send: nil to: nil]! Item was removed: - ----- Method: FlapTab>>assumeString:font:orientation:color: (in category 'textual tabs') ----- - assumeString: aString font: aFont orientation: orientationSymbol color: aColor - | aTextMorph workString tabStyle | - labelString := aString asString. - workString := orientationSymbol == #vertical - ifTrue: - [String streamContents: - [:s | - labelString do: [:c | s nextPut: c] separatedBy: [s nextPut: Character cr]]] - ifFalse: [labelString]. - tabStyle := TextStyle new - newFontArray: (Array with: aFont). - aTextMorph := (TextMorph new setTextStyle: tabStyle) - contents: (workString asText addAttribute: (TextKern kern: 3)). - aTextMorph wrapFlag: true. - self removeAllMorphs. - self borderStyle: (BorderStyle raised width: 2). - aColor ifNotNil: [self color: aColor. aTextMorph color: aColor makeForegroundColor]. - self addMorph: aTextMorph centered. - aTextMorph lock - " - FlapTab allSubInstancesDo: [:ft | ft reformatTextualTab] - "! Item was removed: - ----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') ----- - balloonTextForFlapsMenu - "Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project" - - | id | - id := self flapID. - #( - ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop) - ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop) - ('Widgets' 'A variety of controls and media tools' translatedNoop) - ('Supplies' 'Supplies' translatedNoop) - ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop) - ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop) - ('Scripting' 'Tools useful when doing tile scripting' translatedNoop) - ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop) - ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do: - [:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]]. - - ^ self balloonText! Item was removed: - ----- Method: FlapTab>>changeColor (in category 'menu') ----- - changeColor - self isCurrentlyGraphical - ifTrue: - [^ self inform: 'Color only pertains to a flap tab when the - tab is textual or "solid". This tab is - currently graphical, so color-choice - does not apply.' translated]. - super changeColor - - ! Item was removed: - ----- Method: FlapTab>>changeFlapColor (in category 'menu') ----- - changeFlapColor - (self flapShowing) - ifTrue: - [referent changeColor] - ifFalse: - [self inform: 'The flap itself needs to be open - before you can change its - color.' translated]! Item was removed: - ----- Method: FlapTab>>changeTabSolidity (in category 'solid tabs') ----- - changeTabSolidity - "Presently no actual options associated with this menu item if the flap is currently alreadly solid, so entertain the user with an anuran sound. However, in latest scheme, the corresponding menu item is disabled in this circumstance, so this method is effectively unreachable." - - self playSoundNamed: 'croak'! Item was removed: - ----- Method: FlapTab>>changeTabText (in category 'menu') ----- - changeTabText - "Allow the user to change the text on the tab" - - | reply | - reply := UIManager default - request: 'new wording for this tab:' translated - initialAnswer: self existingWording. - reply isEmptyOrNil ifTrue: [^ self]. - self changeTabText: reply. - ! Item was removed: - ----- Method: FlapTab>>changeTabText: (in category 'textual tabs') ----- - changeTabText: aString - - | label | - aString isEmptyOrNil ifTrue: [^ self]. - label := Locale current languageEnvironment class flapTabTextFor: aString in: self. - label isEmptyOrNil ifTrue: [^ self]. - self useStringTab: label. - submorphs first delete. - self assumeString: label - font: Preferences standardFlapFont - orientation: (Flaps orientationForEdge: self edgeToAdhereTo) - color: nil. - ! Item was removed: - ----- Method: FlapTab>>changeTabThickness (in category 'solid tabs') ----- - changeTabThickness - | newThickness | - newThickness := UIManager default request: 'New thickness:' - initialAnswer: self tabThickness printString. - newThickness notEmpty ifTrue: [self applyTabThickness: newThickness]! Item was removed: - ----- Method: FlapTab>>computeEdgeFraction (in category 'edge') ----- - computeEdgeFraction - "Compute and remember the edge fraction" - - | aBox aFraction | - self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]]. - - aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2). - aFraction := self - ifVertical: - [(self center y - aBox top) / (aBox height max: 1)] - ifHorizontal: - [(self center x - aBox left) / (aBox width max: 1)]. - ^ self edgeFraction: aFraction! Item was removed: - ----- Method: FlapTab>>destroyFlap (in category 'menu') ----- - destroyFlap - "Destroy the receiver" - - | reply request | - request := self isGlobalFlap - ifTrue: - ['Caution -- this would permanently - remove this flap, so it would no longer be - available in this or any other project. - Do you really want to this? ' translated] - ifFalse: - ['Caution -- this is permanent!! Do - you really want to do this? ' translated]. - reply := self confirm: request translated orCancel: [^ self]. - reply ifTrue: - [self isGlobalFlap - ifTrue: - [Flaps removeFlapTab: self keepInList: false. - self currentWorld reformulateUpdatingMenus] - ifFalse: - [referent isInWorld ifTrue: [referent delete]. - self delete]]! Item was removed: - ----- Method: FlapTab>>dismissViaHalo (in category 'submorphs - add/remove') ----- - dismissViaHalo - "Dismiss the receiver (and its referent), unless it resists" - - self resistsRemoval ifTrue: - [(Project uiManager - chooseOptionFrom: #( 'Yes' 'Um, no, let me reconsider') - title: 'Really throw this flap away?') = 2 ifFalse: [^ self]]. - referent delete. - self delete! Item was removed: - ----- Method: FlapTab>>dragoverString (in category 'mouseover & dragover') ----- - dragoverString - "Answer the string to be shown in a menu to represent the - dragover status" - ^ (popOutOnDragOver - ifTrue: ['<yes>'] - ifFalse: ['<no>']), 'pop out on dragover' translated! Item was removed: - ----- Method: FlapTab>>edgeFraction (in category 'edge') ----- - edgeFraction - ^ edgeFraction ifNil: [self computeEdgeFraction]! Item was removed: - ----- Method: FlapTab>>edgeFraction: (in category 'edge') ----- - edgeFraction: aNumber - "Set my edgeFraction to the given number, without side effects" - - edgeFraction := aNumber asFloat! Item was removed: - ----- Method: FlapTab>>edgeString (in category 'edge') ----- - edgeString - ^ 'cling to edge... (current: {1})' translated format: {edgeToAdhereTo translated}! Item was removed: - ----- Method: FlapTab>>edgeToAdhereTo (in category 'edge') ----- - edgeToAdhereTo - ^ edgeToAdhereTo! Item was removed: - ----- Method: FlapTab>>edgeToAdhereTo: (in category 'edge') ----- - edgeToAdhereTo: e - edgeToAdhereTo := e asSymbol! Item was removed: - ----- Method: FlapTab>>existingWording (in category 'menu') ----- - existingWording - ^ labelString! Item was removed: - ----- Method: FlapTab>>fitContents (in category 'layout') ----- - fitContents - self isCurrentlyTextual ifFalse: [^ super fitContents]. - self ifVertical: - [self extent: submorphs first extent + (2 * self borderWidth) + (0 @ 4). - submorphs first position: self position + self borderWidth + (1 @ 4)] - ifHorizontal: - [self extent: submorphs first extent + (2 * self borderWidth) + (8 @ -1). - submorphs first position: self position + self borderWidth + (5 @ 1)]! Item was removed: - ----- Method: FlapTab>>fitOnScreen (in category 'positioning') ----- - fitOnScreen - "19 sept 2000 - allow flaps in any paste up" - | constrainer t l | - constrainer := (owner ifNil: [self]) clearArea. - self flapShowing "otherwise no point in doing this" - ifTrue:[self spanWorld]. - self orientation == #vertical ifTrue: [ - t := ((self top min: (constrainer bottom- self height)) max: constrainer top). - t = self top ifFalse: [self top: t]. - ] ifFalse: [ - l := ((self left min: (constrainer right - self width)) max: constrainer left). - l = self left ifFalse: [self left: l]. - ]. - self flapShowing ifFalse: [self positionObject: self atEdgeOf: constrainer]. - ! Item was removed: - ----- Method: FlapTab>>flapID (in category 'access') ----- - flapID - "Answer the receiver's flapID, creating it if necessary" - - ^ self knownName ifNil: [self acquirePlausibleFlapID]! Item was removed: - ----- Method: FlapTab>>flapID: (in category 'access') ----- - flapID: anID - "Set the receiver's flapID" - - self setNameTo: anID! Item was removed: - ----- Method: FlapTab>>flapIDOrNil (in category 'access') ----- - flapIDOrNil - "If the receiver has a flapID, answer it, else answer nil" - - ^ self knownName! Item was removed: - ----- Method: FlapTab>>flapMenuTitle (in category 'menu') ----- - flapMenuTitle - ^ 'flap: ' translated , self wording! Item was removed: - ----- Method: FlapTab>>flapShowing (in category 'access') ----- - flapShowing - ^ flapShowing == true! Item was removed: - ----- Method: FlapTab>>graphicalTab (in category 'graphical tabs') ----- - graphicalTab - self isCurrentlyGraphical - ifTrue: - [self changeTabGraphic] - ifFalse: - [self useGraphicalTab]! Item was removed: - ----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') ----- - graphicalTabString - ^ (self isCurrentlyGraphical - ifTrue: ['choose new graphic...' translated] - ifFalse: ['use graphical tab' translated]) ! Item was removed: - ----- Method: FlapTab>>hideFlap (in category 'show & hide') ----- - hideFlap - | aWorld | - aWorld := self world ifNil: [self currentWorld]. - referent privateDelete. - aWorld removeAccommodationForFlap: self. - flapShowing := false. - self isInWorld ifFalse: [aWorld addMorphFront: self]. - self adjustPositionAfterHidingFlap. - aWorld haloMorphs do: - [:m | m target isInWorld ifFalse: [m delete]]! Item was removed: - ----- Method: FlapTab>>hideFlapUnlessBearingHalo (in category 'show & hide') ----- - hideFlapUnlessBearingHalo - self hasHalo ifFalse: [self hideFlapUnlessOverReferent]! Item was removed: - ----- Method: FlapTab>>hideFlapUnlessOverReferent (in category 'show & hide') ----- - hideFlapUnlessOverReferent - "Hide the flap unless the mouse is over my referent." - - | aWorld where | - (referent isInWorld and: - [where := self outermostWorldMorph activeHand lastEvent cursorPoint. - referent bounds containsPoint: (referent globalPointToLocal: where)]) - ifTrue: [^ self]. - (aWorld := self world) ifNil: [^ self]. "In case flap tabs just got hidden" - self referent delete. - aWorld removeAccommodationForFlap: self. - flapShowing := false. - self isInWorld ifFalse: - [self inboard ifTrue: [aWorld addMorphFront: self]]. - self adjustPositionAfterHidingFlap! Item was removed: - ----- Method: FlapTab>>ifVertical:ifHorizontal: (in category 'edge') ----- - ifVertical: block1 ifHorizontal: block2 - "Evaluate and return the value of either the first or the second block, depending whether I am vertically or horizontally oriented" - - ^ self orientation == #vertical - ifTrue: - [block1 value] - ifFalse: - [block2 value] - ! Item was removed: - ----- Method: FlapTab>>inboard (in category 'disused options') ----- - inboard - ^ inboard == true! Item was removed: - ----- Method: FlapTab>>inboard: (in category 'disused options') ----- - inboard: aBoolean - inboard := aBoolean! Item was removed: - ----- Method: FlapTab>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - self disableLayout: true. - "" - edgeToAdhereTo := #left. - flapShowing := false. - slidesOtherObjects := false. - popOutOnDragOver := false. - popOutOnMouseOver := false. - inboard := false. - dragged := false! Item was removed: - ----- Method: FlapTab>>isCurrentlySolid (in category 'solid tabs') ----- - isCurrentlySolid - "Don't never use double negatives" - - ^ self notSolid not! Item was removed: - ----- Method: FlapTab>>isCurrentlyTextual (in category 'menu') ----- - isCurrentlyTextual - | first | - ^submorphs notEmpty and: - [((first := submorphs first) isKindOf: StringMorph) - or: [first isTextMorph]]! Item was removed: - ----- Method: FlapTab>>isFlapTab (in category 'classification') ----- - isFlapTab - ^true! Item was removed: - ----- Method: FlapTab>>isGlobalFlap (in category 'globalness') ----- - isGlobalFlap - "Answer whether the receiver is currently a shared flap" - - ^ Flaps globalFlapTabsIfAny includes: self! Item was removed: - ----- Method: FlapTab>>isGlobalFlapString (in category 'globalness') ----- - isGlobalFlapString - "Answer a string to construct a menu item representing control - over whether the receiver is or is not a shared flap" - ^ (self isGlobalFlap - ifTrue: ['<yes>'] - ifFalse: ['<no>']) - , 'shared by all projects' translated! Item was removed: - ----- Method: FlapTab>>labelString (in category 'accessing') ----- - labelString - ^labelString! Item was removed: - ----- Method: FlapTab>>lastReferentThickness: (in category 'show & hide') ----- - lastReferentThickness: anInteger - "Set the last remembered referent thickness to the given integer" - - lastReferentThickness := anInteger! Item was removed: - ----- Method: FlapTab>>layoutChanged (in category 'layout') ----- - layoutChanged - self fitOnScreen. - ^super layoutChanged! Item was removed: - ----- Method: FlapTab>>makeNewDrawing: (in category 'mouseover & dragover') ----- - makeNewDrawing: evt - self flapShowing ifTrue:[ - self world makeNewDrawing: evt. - ] ifFalse:[ - self world assureNotPaintingEvent: evt. - ].! Item was removed: - ----- Method: FlapTab>>maybeHideFlapOnMouseLeave (in category 'show & hide') ----- - maybeHideFlapOnMouseLeave - self hasHalo ifTrue: [^ self]. - referent isInWorld ifFalse: [^ self]. - self hideFlapUnlessOverReferent. - ! Item was removed: - ----- Method: FlapTab>>maybeHideFlapOnMouseLeaveDragging (in category 'show & hide') ----- - maybeHideFlapOnMouseLeaveDragging - | aWorld | - self hasHalo ifTrue: [^ self]. - referent isInWorld ifFalse: [^ self]. - (dragged or: [referent bounds containsPoint: self cursorPoint]) - ifTrue: [^ self]. - aWorld := self world. - referent privateDelete. "could make me worldless if I'm inboard" - aWorld ifNotNil: [aWorld removeAccommodationForFlap: self]. - flapShowing := false. - self isInWorld ifFalse: [aWorld addMorphFront: self]. - self adjustPositionAfterHidingFlap! Item was removed: - ----- Method: FlapTab>>morphicLayerNumber (in category 'submorphs - layers') ----- - morphicLayerNumber - - ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]! Item was removed: - ----- Method: FlapTab>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - "Handle a mouse-move event. The event, a MorphicEvent, is passed in." - - | aPosition newReferentThickness adjustedPosition thick | - - dragged ifFalse: [(thick := self referentThickness) > 0 - ifTrue: [lastReferentThickness := thick]]. - ((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not]) - ifFalse: - [flapShowing ifFalse: [self showFlap]. - adjustedPosition := aPosition - evt hand targetOffset. - (edgeToAdhereTo == #bottom) - ifTrue: - [newReferentThickness := inboard - ifTrue: - [self world height - adjustedPosition y] - ifFalse: - [self world height - adjustedPosition y - self height]]. - - (edgeToAdhereTo == #left) - ifTrue: - [newReferentThickness := - inboard - ifTrue: - [adjustedPosition x + self width] - ifFalse: - [adjustedPosition x]]. - - (edgeToAdhereTo == #right) - ifTrue: - [newReferentThickness := - inboard - ifTrue: - [self world width - adjustedPosition x] - ifFalse: - [self world width - adjustedPosition x - self width]]. - - (edgeToAdhereTo == #top) - ifTrue: - [newReferentThickness := - inboard - ifTrue: - [adjustedPosition y + self height] - ifFalse: - [adjustedPosition y]]. - - self isCurrentlySolid ifFalse: - [(#(left right) includes: edgeToAdhereTo) - ifFalse: - [self left: adjustedPosition x] - ifTrue: - [self top: adjustedPosition y]]. - - ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue: - [newReferentThickness := referent width]. - - self applyThickness: newReferentThickness. - dragged := true. - self fitOnScreen. - self computeEdgeFraction]! Item was removed: - ----- Method: FlapTab>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - "The mouse came back up, presumably after having dragged the tab. Caution: if not operating full-screen, this notification can easily be *missed*, which is why the edge-fraction-computation is also being done on mouseMove." - - super mouseUp: evt. - (self referentThickness <= 0 or: - [(referent isInWorld and: [(referent boundsInWorld intersects: referent owner boundsInWorld) not])]) ifTrue: - [self hideFlap. - flapShowing := false]. - self fitOnScreen. - dragged ifTrue: - [self computeEdgeFraction. - dragged := false]. - Flaps doAutomaticLayoutOfFlapsIfAppropriate! Item was removed: - ----- Method: FlapTab>>mouseoverString (in category 'mouseover & dragover') ----- - mouseoverString - "Answer the string to be shown in a menu to represent the - mouseover status" - ^ (popOutOnMouseOver - ifTrue: ['<yes>'] - ifFalse: ['<no>']) - , 'pop out on mouseover' translated ! Item was removed: - ----- Method: FlapTab>>notSolid (in category 'solid tabs') ----- - notSolid - "Answer whether the receiver is currenty not solid. Used for determining whether the #solidTab menu item should be enabled" - - ^ self isCurrentlyTextual or: [self isCurrentlyGraphical]! Item was removed: - ----- Method: FlapTab>>objectForDataStream: (in category 'objects from disk') ----- - objectForDataStream: refStrm - "I am about to be written on an object file. If I am a global flap, write a proxy instead." - - | dp | - self isGlobalFlap ifTrue: - [dp := DiskProxy global: #Flaps selector: #globalFlapTabOrDummy: - args: {self flapID}. - refStrm replace: self with: dp. - ^ dp]. - - ^ super objectForDataStream: refStrm! Item was removed: - ----- Method: FlapTab>>openFully (in category 'show & hide') ----- - openFully - "Make an educated guess at how wide or tall we are to be, and open to that thickness" - - | thickness amt | - thickness := referent boundingBoxOfSubmorphs extent max: (100 @ 100). - self applyThickness: (amt := self orientation == #horizontal - ifTrue: - [thickness y] - ifFalse: - [thickness x]). - self lastReferentThickness: amt. - self showFlap! Item was removed: - ----- Method: FlapTab>>orientation (in category 'access') ----- - orientation - ^ (#left == edgeToAdhereTo or: [#right == edgeToAdhereTo]) - ifTrue: [#vertical] - ifFalse: [#horizontal]! Item was removed: - ----- Method: FlapTab>>ownerChanged (in category 'change reporting') ----- - ownerChanged - self fitOnScreen. - ^super ownerChanged.! Item was removed: - ----- Method: FlapTab>>partsBinString (in category 'parts bin') ----- - partsBinString - "Answer the string to be shown in a menu to represent the - parts-bin status" - ^ (referent isPartsBin - ifTrue: ['<yes>'] - ifFalse: ['<no>']), 'parts-bin' translated! Item was removed: - ----- Method: FlapTab>>permitsThumbnailing (in category 'thumbnail') ----- - permitsThumbnailing - ^ false! Item was removed: - ----- Method: FlapTab>>positionObject: (in category 'positioning') ----- - positionObject: anObject - "anObject could be myself or my referent" - - | pum clearArea | - pum := self pasteUpMorph ifNil: [^ self]. - - clearArea := Morph newBounds: pum clearArea. - ^self - positionObject: anObject - atEdgeOf: clearArea! Item was removed: - ----- Method: FlapTab>>positionObject:atEdgeOf: (in category 'positioning') ----- - positionObject: anObject atEdgeOf: container - "anObject could be myself or my referent" - - edgeToAdhereTo == #left ifTrue: [^ anObject left: container left]. - edgeToAdhereTo == #right ifTrue: [^ anObject right: container right]. - edgeToAdhereTo == #top ifTrue: [^ anObject top: container top]. - edgeToAdhereTo == #bottom ifTrue: [^ anObject bottom: container bottom]! Item was removed: - ----- Method: FlapTab>>positionReferent (in category 'positioning') ----- - positionReferent - self positionObject: referent! Item was removed: - ----- Method: FlapTab>>preserveDetails (in category 'menu') ----- - preserveDetails - "The receiver is being switched to use a different format. Preserve the existing details (e.g. wording if textual, grapheme if graphical) so that if the user reverts back to the current format, the details will be right" - - | thickness | - color = Color transparent ifFalse: [self setProperty: #priorColor toValue: color]. - self isCurrentlyTextual - ifTrue: - [self setProperty: #priorWording toValue: self existingWording] - ifFalse: - [self isCurrentlyGraphical - ifTrue: - [self setProperty: #priorGraphic toValue: submorphs first form] - ifFalse: - [thickness := (self orientation == #vertical) - ifTrue: [self width] - ifFalse: [self height]. - self setProperty: #priorThickness toValue: thickness]]! Item was removed: - ----- Method: FlapTab>>printOn: (in category 'printing') ----- - printOn: aStream - "Append a textual representation of the receiver to aStream" - - super printOn: aStream. - aStream nextPutAll: ' "', self wording, '"'! Item was removed: - ----- Method: FlapTab>>provideDefaultFlapIDBasedOn: (in category 'initialization') ----- - provideDefaultFlapIDBasedOn: aStem - "Provide the receiver with a default flap id" - - | aNumber usedIDs anID | - aNumber := 0. - usedIDs := FlapTab allSubInstances select: [:f | f ~~ self] thenCollect: [:f | f flapIDOrNil]. - anID := aStem. - [usedIDs includes: anID] whileTrue: - [aNumber := aNumber + 1. - anID := aStem, (aNumber asString)]. - self flapID: anID. - ^ anID! Item was removed: - ----- Method: FlapTab>>referentThickness (in category 'access') ----- - referentThickness - referent ifNil: [^ 32]. - ^ (self orientation == #horizontal) - ifTrue: - [referent height] - ifFalse: - [referent width]! Item was removed: - ----- Method: FlapTab>>reformatTextualTab (in category 'textual tabs') ----- - reformatTextualTab - "The font choice possibly having changed, reformulate the receiver" - - self isCurrentlyTextual ifFalse: [^ self]. - self assumeString: self existingWording font: Preferences standardFlapFont orientation: self orientation color: self color! Item was removed: - ----- Method: FlapTab>>roundedCorners (in category 'rounding') ----- - roundedCorners - edgeToAdhereTo == #bottom ifTrue: [^ #(1 4)]. - edgeToAdhereTo == #right ifTrue: [^ #(1 2)]. - edgeToAdhereTo == #left ifTrue: [^ #(3 4)]. - ^ #(2 3) "#top and undefined" - ! Item was removed: - ----- Method: FlapTab>>setEdge: (in category 'edge') ----- - setEdge: anEdge - "Set the edge as indicated, if possible" - - | newOrientation e | - e := anEdge asSymbol. - self edgeToAdhereTo = anEdge ifTrue: [^ self]. - newOrientation := nil. - self orientation == #vertical - ifTrue: [(#top == e or: [#bottom == e]) ifTrue: - [newOrientation := #horizontal]] - ifFalse: [(#top == e or: [#bottom == e]) ifFalse: - [newOrientation := #vertical]]. - self edgeToAdhereTo: e. - newOrientation ifNotNil: [self transposeParts]. - referent isInWorld ifTrue: [self positionReferent]. - self adjustPositionVisAVisFlap! Item was removed: - ----- Method: FlapTab>>setEdgeToAdhereTo (in category 'edge') ----- - setEdgeToAdhereTo - | aMenu | - aMenu := MenuMorph new defaultTarget: self. - #(left top right bottom) do: - [:sym | aMenu add: sym asString translated target: self selector: #setEdge: argument: sym]. - aMenu popUpEvent: self currentEvent in: self world! Item was removed: - ----- Method: FlapTab>>setName:edge:color: (in category 'initialization') ----- - setName: nameString edge: edgeSymbol color: flapColor - "Set me up with the usual..." - - self setNameTo: nameString. - self edgeToAdhereTo: edgeSymbol; inboard: false. - self assumeString: nameString font: Preferences standardFlapFont - orientation: self orientation color: flapColor. - self setToPopOutOnDragOver: true. - self setToPopOutOnMouseOver: false. - ! Item was removed: - ----- Method: FlapTab>>setToPopOutOnDragOver: (in category 'mouseover & dragover') ----- - setToPopOutOnDragOver: aBoolean - self arrangeToPopOutOnDragOver: (popOutOnDragOver := aBoolean)! Item was removed: - ----- Method: FlapTab>>setToPopOutOnMouseOver: (in category 'mouseover & dragover') ----- - setToPopOutOnMouseOver: aBoolean - self arrangeToPopOutOnMouseOver: (popOutOnMouseOver := aBoolean)! Item was removed: - ----- Method: FlapTab>>sharedFlapsAllowed (in category 'menu') ----- - sharedFlapsAllowed - "Answer (for the benefit of a menu item for which I am the target) whether the system presently allows shared flaps" - - ^ Flaps sharedFlapsAllowed! Item was removed: - ----- Method: FlapTab>>showFlap (in category 'show & hide') ----- - showFlap - "Open the flap up" - - | thicknessToUse flapOwner | - - "19 sept 2000 - going for all paste ups <- raa note" - flapOwner := self pasteUpMorph. - self referentThickness <= 0 - ifTrue: - [thicknessToUse := lastReferentThickness ifNil: [100]. - self orientation == #horizontal - ifTrue: - [referent height: thicknessToUse] - ifFalse: - [referent width: thicknessToUse]]. - inboard ifTrue: - [self stickOntoReferent]. "makes referent my owner, and positions me accordingly" - referent pasteUpMorph == flapOwner - ifFalse: - [flapOwner accommodateFlap: self. "Make room if needed" - flapOwner addMorphFront: referent. - flapOwner startSteppingSubmorphsOf: referent. - self positionReferent. - referent adaptToWorld: flapOwner]. - inboard ifFalse: - [self adjustPositionVisAVisFlap]. - flapShowing := true. - - self pasteUpMorph hideFlapsOtherThan: self ifClingingTo: edgeToAdhereTo. - - flapOwner bringTopmostsToFront! Item was removed: - ----- Method: FlapTab>>showFlapIfHandLaden: (in category 'show & hide') ----- - showFlapIfHandLaden: evt - "The hand has drifted over the receiver with the button down. If the hand is carrying anything, show the flap. If the hand is empty, the likely cause is that it's manipulating a scrollbar or some such, so in that case don't pop the flap out." - - evt hand hasSubmorphs ifTrue: [self showFlap]! Item was removed: - ----- Method: FlapTab>>slidesOtherObjects (in category 'disused options') ----- - slidesOtherObjects - ^ slidesOtherObjects! Item was removed: - ----- Method: FlapTab>>solidTab (in category 'solid tabs') ----- - solidTab - self isCurrentlySolid - ifFalse: - [self useSolidTab] - ifTrue: - [self changeTabSolidity]! Item was removed: - ----- Method: FlapTab>>solidTabString (in category 'solid tabs') ----- - solidTabString - ^ (self isCurrentlySolid - ifTrue: ['currently using solid tab' translated] - ifFalse: ['use solid tab' translated]) ! Item was removed: - ----- Method: FlapTab>>spanWorld (in category 'positioning') ----- - spanWorld - | container area | - - container := self pasteUpMorph - ifNil: [self currentWorld]. - - area := container clearArea. - - self orientation == #vertical ifTrue: [ - referent vResizing == #rigid - ifTrue: [referent height: area height]. - referent hResizing == #rigid - ifTrue: [referent width: (referent width min: area width - self width)]. - referent top: area top. - referent bottom: (area bottom min: referent bottom) - ] - ifFalse: [ - referent hResizing == #rigid - ifTrue: [referent width: area width]. - referent vResizing == #rigid - ifTrue: [referent height: (referent height min: area height - self height)]. - referent left: area left. - referent right: (area right min: referent right) - ]. - ! Item was removed: - ----- Method: FlapTab>>startOrFinishDrawing: (in category 'mouseover & dragover') ----- - startOrFinishDrawing: evt - | w | - self flapShowing ifTrue:[ - (w := self world) makeNewDrawing: evt at: w center. - ] ifFalse:[ - self world endDrawing: evt. - ].! Item was removed: - ----- Method: FlapTab>>stickOntoReferent (in category 'positioning') ----- - stickOntoReferent - "Place the receiver directly onto the referent -- for use when the referent is being shown as a flap" - | newPosition | - referent addMorph: self. - edgeToAdhereTo == #left - ifTrue: - [newPosition := (referent width - self width) @ self top]. - edgeToAdhereTo == #right - ifTrue: - [newPosition := (referent left @ self top)]. - edgeToAdhereTo == #top - ifTrue: - [newPosition := self left @ (referent height - self height)]. - edgeToAdhereTo == #bottom - ifTrue: - [newPosition := self left @ referent top]. - self position: newPosition! Item was removed: - ----- Method: FlapTab>>tabSelected (in category 'events') ----- - tabSelected - "The user clicked on the tab. Show or hide the flap. Try to be a little smart about a click on a tab whose flap is open but only just barely." - - dragged == true ifTrue: - [^ dragged := false]. - self flapShowing - ifTrue: - [self referentThickness < 23 "an attractive number" - ifTrue: - [self openFully] - ifFalse: - [self hideFlap]] - ifFalse: - [self showFlap]! Item was removed: - ----- Method: FlapTab>>tabThickness (in category 'access') ----- - tabThickness - ^ (self orientation == #vertical) - ifTrue: - [self width] - ifFalse: - [self height]! Item was removed: - ----- Method: FlapTab>>textualTab (in category 'textual tabs') ----- - textualTab - self isCurrentlyTextual - ifTrue: - [self changeTabText] - ifFalse: - [self useTextualTab]! Item was removed: - ----- Method: FlapTab>>textualTabString (in category 'textual tabs') ----- - textualTabString - ^ (self isCurrentlyTextual - ifTrue: ['change tab wording...' translated] - ifFalse: ['use textual tab' translated]) ! Item was removed: - ----- Method: FlapTab>>thicknessString (in category 'menu') ----- - thicknessString - ^ 'thickness... (currently ', self thickness printString, ')'! Item was removed: - ----- Method: FlapTab>>toggleDragOverBehavior (in category 'mouseover & dragover') ----- - toggleDragOverBehavior - self arrangeToPopOutOnDragOver: (popOutOnDragOver := popOutOnDragOver not)! Item was removed: - ----- Method: FlapTab>>toggleIsGlobalFlap (in category 'globalness') ----- - toggleIsGlobalFlap - "Toggle whether the receiver is currently a global flap or not" - - | oldWorld | - self hideFlap. - oldWorld := self currentWorld. - self isGlobalFlap - ifTrue: - [Flaps removeFromGlobalFlapTabList: self. - oldWorld addMorphFront: self] - ifFalse: - [self delete. - Flaps addGlobalFlap: self. - self currentWorld addGlobalFlaps]. - self currentWorld reformulateUpdatingMenus.! Item was removed: - ----- Method: FlapTab>>toggleMouseOverBehavior (in category 'mouseover & dragover') ----- - toggleMouseOverBehavior - self arrangeToPopOutOnMouseOver: (popOutOnMouseOver := popOutOnMouseOver not)! Item was removed: - ----- Method: FlapTab>>togglePartsBinMode (in category 'parts bin') ----- - togglePartsBinMode - referent setPartsBinStatusTo: referent isPartsBin not! Item was removed: - ----- Method: FlapTab>>transposeParts (in category 'positioning') ----- - transposeParts - "The receiver's orientation has just been changed from vertical to horizontal or vice-versa." - "First expand the flap to screen size, letting the submorphs lay out to fit, - and then shrink the minor dimension back to the last row." - - self isCurrentlyTextual ifTrue: "First recreate the tab with proper orientation" - [self assumeString: self existingWording font: Preferences standardFlapFont - orientation: self orientation color: self color]. - self orientation == #vertical - ifTrue: "changed from horizontal" - [referent listDirection: #topToBottom; wrapDirection: #leftToRight. - referent hasSubmorphs ifTrue: - [referent extent: self currentWorld extent. - referent fullBounds. "Needed to trigger layout" - referent width: (referent submorphs collect: [:m | m right]) max - - referent left + self width]] - ifFalse: - [referent listDirection: #leftToRight; wrapDirection: #topToBottom. - referent hasSubmorphs ifTrue: - [referent extent: self currentWorld extent. - referent fullBounds. "Needed to trigger layout" - referent height: (referent submorphs collect: [:m | m bottom]) max - - referent top + self height]]. - referent hasSubmorphs ifFalse: [referent extent: 100 at 100]. - - self spanWorld. - flapShowing ifTrue: [self showFlap]! Item was removed: - ----- Method: FlapTab>>useSolidTab (in category 'solid tabs') ----- - useSolidTab - | thickness colorToUse | - self preserveDetails. - - thickness := self valueOfProperty: #priorThickness ifAbsent: [20]. - colorToUse := self valueOfProperty: #priorColor ifAbsent: [Color red muchLighter]. - self color: colorToUse. - self removeAllMorphs. - - (self orientation == #vertical) - ifTrue: - [self width: thickness. - self height: self currentWorld height. - self position: (self position x @ 0)] - ifFalse: - [self height: thickness. - self width: self currentWorld width. - self position: (0 @ self position y)]. - - self borderWidth: 0. - self layoutChanged.! Item was removed: - ----- Method: FlapTab>>useStringTab: (in category 'textual tabs') ----- - useStringTab: aString - | aLabel | - labelString := aString asString. - aLabel := StringMorph new contents: labelString. - self addMorph: aLabel. - aLabel position: self position. - aLabel highlightColor: self highlightColor; regularColor: self regularColor. - aLabel lock. - self fitContents. - self layoutChanged! Item was removed: - ----- Method: FlapTab>>useTextualTab (in category 'textual tabs') ----- - useTextualTab - | stringToUse colorToUse | - self preserveDetails. - colorToUse := self valueOfProperty: #priorColor ifAbsent: [Color green muchLighter]. - submorphs notEmpty ifTrue: [self removeAllMorphs]. - stringToUse := self valueOfProperty: #priorWording ifAbsent: ['Unnamed Flap' translated]. - self assumeString: stringToUse font: Preferences standardFlapFont orientation: self orientation color: colorToUse! Item was removed: - ----- Method: FlapTab>>wantsRoundedCorners (in category 'rounding') ----- - wantsRoundedCorners - ^self isCurrentlyTextual or:[super wantsRoundedCorners]! Item was removed: - ----- Method: FlapTab>>wording (in category 'menu') ----- - wording - ^ self isCurrentlyTextual - ifTrue: - [self existingWording] - ifFalse: - [self valueOfProperty: #priorWording ifAbsent: ['---']]! Item was removed: - Object subclass: #Flaps - instanceVariableNames: '' - classVariableNames: 'FlapsQuads SharedFlapTabs SharedFlapsAllowed' - poolDictionaries: '' - category: 'MorphicExtras-Flaps'! - - !Flaps commentStamp: 'asm 3/13/2003 12:46' prior: 0! - ClassVariables - - FlapsQuads quads defining predefined flaps - default flaps are: 'PlugIn Supplies', 'Stack Tools', 'Supplies', 'Tools', 'Widgets' and 'Scripting' - - SharedFlapTabs an array of flaps shared between squeak projects - SharedFlapsAllowed boolean - - ! Item was removed: - ----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') ----- - addAndEnableEToyFlaps - "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed." - - | aSuppliesFlap | - SharedFlapTabs - ifNotNil: [^ self]. - SharedFlapTabs := OrderedCollection new. - - aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right. - aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02" - SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment" - - (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false]) - ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap] - ifFalse: [Preferences showProjectNavigator - ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]]. - - self enableGlobalFlapWithID: 'Supplies' translated. - - (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false]) - ifTrue: - [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated. - (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNil: - [:navTab | aSuppliesFlap sugarNavTab: navTab]] - ifFalse: [ - Preferences showProjectNavigator - ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]]. - - SharedFlapsAllowed := true. - Project current flapsSuppressed: false. - ^ SharedFlapTabs - - "Flaps addAndEnableEToyFlaps"! Item was removed: - ----- Method: Flaps class>>addGlobalFlap: (in category 'shared flaps') ----- - addGlobalFlap: aFlapTab - "Add the given flap tab to the list of shared flaps" - - SharedFlapTabs ifNil: [SharedFlapTabs := OrderedCollection new]. - SharedFlapTabs add: aFlapTab! Item was removed: - ----- Method: Flaps class>>addIndividualGlobalFlapItemsTo: (in category 'menu support') ----- - addIndividualGlobalFlapItemsTo: aMenu - "Add items governing the enablement of specific global flaps to aMenu" - - self globalFlapTabsIfAny do: - [:aFlapTab | - | anItem | - anItem := aMenu addUpdating: #globalFlapWithIDEnabledString: enablementSelector: #showSharedFlaps target: self selector: #enableDisableGlobalFlapWithID: argumentList: {aFlapTab flapID}. - anItem wordingArgument: aFlapTab flapID. - anItem setBalloonText: aFlapTab balloonTextForFlapsMenu].! Item was removed: - ----- Method: Flaps class>>addLocalFlap (in category 'new flap') ----- - addLocalFlap - - ^ self addLocalFlap: self currentEvent! Item was removed: - ----- Method: Flaps class>>addLocalFlap: (in category 'new flap') ----- - addLocalFlap: anEvent - "Menu command -- let the user add a new project-local flap. Once the new flap is born, the user can tell it to become a shared flap. Obtain an initial name and edge for the flap, launch the flap, and also launch a menu governing the flap, so that the user can get started right away with customizing it." - - | title edge | - edge := self askForEdgeOfNewFlap. - edge ifNil: [^ self]. - - title := UIManager default request: 'Wording for this flap:' translated initialAnswer: 'Flap' translated. - title isEmptyOrNil ifTrue: [^ self]. - - ^ self addLocalFlap: anEvent titled: title onEdge: edge! Item was removed: - ----- Method: Flaps class>>addLocalFlap:titled:onEdge: (in category 'new flap') ----- - addLocalFlap: anEvent titled: title onEdge: edge - - | flapTab menu world | - flapTab := self newFlapTitled: title onEdge: edge. - (world := anEvent hand world) addMorphFront: flapTab. - flapTab adaptToWorld: world. - menu := flapTab buildHandleMenu: anEvent hand. - flapTab addTitleForHaloMenu: menu. - flapTab computeEdgeFraction. - menu popUpEvent: anEvent in: world.! Item was removed: - ----- Method: Flaps class>>addMorph:asElementNumber:inGlobalFlapSatisfying: (in category 'construction support') ----- - addMorph: aMorph asElementNumber: aNumber inGlobalFlapSatisfying: flapBlock - "If any global flap satisfies flapBlock, add aMorph to it at the given position. Applies to flaps that are parts bins and that like thumbnailing" - - | aFlapTab flapPasteUp | - aFlapTab := self globalFlapTabsIfAny detect: flapBlock ifNone: [^ self]. - flapPasteUp := aFlapTab referent. - flapPasteUp addMorph: aMorph asElementNumber: aNumber. - flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true! Item was removed: - ----- Method: Flaps class>>addMorph:asElementNumber:inGlobalFlapWithID: (in category 'construction support') ----- - addMorph: aMorph asElementNumber: aNumber inGlobalFlapWithID: anID - "If any global flap satisfies flapBlock, add aMorph to it at the given position. No senders in the image -- intended to be invoked by doits in code updates only, and applies to flaps that are parts bins and that like thumbnailing" - - ^ self addMorph: aMorph asElementNumber: aNumber inGlobalFlapSatisfying: [:aFlap | aFlap flapID = anID]! Item was removed: - ----- Method: Flaps class>>addNewDefaultSharedFlaps (in category 'predefined flaps') ----- - addNewDefaultSharedFlaps - "Add the stack tools flap and the navigator flap to the global list, but do not have them showing initially. Transitional, called by the postscript of the FlapsOnBottom update; probably dispensable afterwards." - - SharedFlapTabs ifNotNil: - [(self globalFlapTabWithID: 'Stack Tools' translated) ifNil: - [SharedFlapTabs add: self newStackToolsFlap delete]. - self enableGlobalFlapWithID: 'Stack Tools' translated. - (self globalFlapTabWithID: 'Navigator' translated) ifNil: - [SharedFlapTabs add: self newNavigatorFlap delete]. - self enableGlobalFlapWithID: 'Navigator' translated. - self currentWorld addGlobalFlaps]! Item was removed: - ----- Method: Flaps class>>addStandardFlaps (in category 'predefined flaps') ----- - addStandardFlaps - "Initialize the standard default out-of-box set of global flaps. - This method creates them and places them in my class - variable #SharedFlapTabs, but does not itself get them - displayed. " - SharedFlapTabs - ifNil: [SharedFlapTabs := OrderedCollection new]. - SharedFlapTabs add: self newSqueakFlap. - SharedFlapTabs add: self newSuppliesFlap. - SharedFlapTabs add: self newToolsFlap. - SharedFlapTabs add: self newWidgetsFlap. - SharedFlapTabs add: self newStackToolsFlap. - - Preferences showProjectNavigator - ifTrue:[SharedFlapTabs add: self newNavigatorFlap]. - - SharedFlapTabs add: self newPaintingFlap. - SharedFlapTabs add: self newObjectsFlap. - self disableGlobalFlapWithID: 'Stack Tools' translated. - self disableGlobalFlapWithID: 'Painting' translated. - - Preferences showProjectNavigator - ifTrue:[self disableGlobalFlapWithID: 'Navigator' translated]. - - ^ SharedFlapTabs! Item was removed: - ----- Method: Flaps class>>addToSuppliesFlap:asElementNumber: (in category 'construction support') ----- - addToSuppliesFlap: aMorph asElementNumber: aNumber - "Add the given morph to the supplies flap. To be called by doits in updates, so don't be alarmed by its lack of senders." - - self addMorph: aMorph asElementNumber: aNumber inGlobalFlapWithID: 'Supplies'! Item was removed: - ----- Method: Flaps class>>anyFlapsVisibleIn: (in category 'testing') ----- - anyFlapsVisibleIn: aWorld - - aWorld submorphsDo: [:m | - (m isKindOf: FlapTab) ifTrue: [^ true]]. - - ^ false! Item was removed: - ----- Method: Flaps class>>askForEdgeOfNewFlap (in category 'new flap') ----- - askForEdgeOfNewFlap - - - ^MenuMorph - chooseFrom: (#('left' 'right' 'top' 'bottom') collect: [ :each | each translated ]) - values: #(left right top bottom) - lines: #() - title: 'Where should the new flap cling?' translated. - ! Item was removed: - ----- Method: Flaps class>>automaticFlapLayoutChanged (in category 'miscellaneous') ----- - automaticFlapLayoutChanged - "Sent when the automaticFlapLayout preference changes. No senders in easily traceable in the image, but this is really sent by a Preference object!!" - - Preferences automaticFlapLayout ifTrue: - [self positionNavigatorAndOtherFlapsAccordingToPreference]! Item was removed: - ----- Method: Flaps class>>clobberFlapTabList (in category 'flap mechanics') ----- - clobberFlapTabList - "Flaps clobberFlapTabList" - - SharedFlapTabs := nil! Item was removed: - ----- Method: Flaps class>>defaultColorForFlapBackgrounds (in category 'new flap') ----- - defaultColorForFlapBackgrounds - "Answer the color to use, by default, in new flap backgrounds" - - ^ (Color blue mixed: 0.8 with: Color white) alpha: 0.6! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningPlugInSuppliesFlap (in category 'predefined flaps') ----- - defaultsQuadsDefiningPlugInSuppliesFlap - "Answer a list of quads which define the objects to appear in the default Supplies flap used in the Plug-in image" - - "PartsBin reconstructAllPartsIcons" - - ^ #( - (ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of available objects') - (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'Stop, Step, and Go buttons for controlling all your scripts at once. The tool can also be "opened up" to control each script in your project individually.') - (TrashCanMorph new 'Trash' 'A tool for discarding objects') - (GrabPatchMorph new 'Grab Patch' 'Allows you to create a new Sketch by grabbing a rectangular patch from the screen') - (LassoPatchMorph new 'Lasso' 'Allows you to create a new Sketch by lassoing an area from the screen') - - (StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.') - "(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')" - (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.') - (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') - (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle') - (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners') - (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle') - (StarMorph authoringPrototype 'Star' 'A star') - (CurveMorph authoringPrototype 'Curve' 'A curve') - (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides') - (ScriptableButton authoringPrototype 'Button' 'A Scriptable button') - "(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page') - (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')" - "(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')" - (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations') - (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.') - (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control') - (BookMorph authoringPrototype 'Book' 'A multi-paged structure') - "(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')" - (KedamaMorph newSet 'Particles' 'A Kedama World with pre-made components') - "(RandomNumberTile new 'Random' 'A random-number tile for use with tile scripting')") asOrderedCollection! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningScriptingFlap - "Answer a structure defining the default items in the Scripting flap. - previously in quadsDeiningScriptingFlap" - - ^ { - {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. - {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}. - {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}. - {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}. - - {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}. - {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}. - {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}. - {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}. - - {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}. - - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - - - {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. - {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}. - {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop} - } asOrderedCollection! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningStackToolsFlap - "Answer a structure defining the items on the default system Stack Tools flap. - previously in quadsDefiningStackToolsFlap" - - ^ { - {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. - {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}. - {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}. - {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}. - {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}. - {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}. - {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}. - {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection - ! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningSuppliesFlap - "Answer a list of quads which define the objects to appear in the default Supplies flap. - previously in quadsDefiningSuppliesFlap" - - ^ { - {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. - {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. - {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. - {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. - {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. - {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. - {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. - {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}. - {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. - {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. - {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. - {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop} - } asOrderedCollection! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningToolsFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningToolsFlap - "Answer a structure defining the default Tools flap. - previously in quadsDefiningToolsFlap" - - ^ OrderedCollection new - addAll: #( - (Browser prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system') - (TranscriptStream openMorphicTranscript 'Transcript' 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.') - (Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')); - add: { FileList2 . - #prototypicalToolWindow. - 'File List'. - 'A File List is a tool for browsing folders and files on disks and FTP servers.' }; - addAll: #( - (DualChangeSorter prototypicalToolWindow 'Change Sorter' 'Shows two change sets side by side') - (SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results') - (MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.') - (PreferencesBrowser prototypicalToolWindow 'Preferences' 'Allows you to control numerous options') - (Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods') - (ProcessBrowser prototypicalToolWindow 'Processes' 'A Process Browser shows you all the running processes') - (Preferences annotationEditingWindow 'Annotations' 'Allows you to specify the annotations to be shown in the annotation panes of browsers, etc.') - (PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"') - (ChangeSorter prototypicalToolWindow 'Change Set' 'A tool that allows you to view and manipulate all the code changes in a single change set')); - yourself! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningWidgetsFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningWidgetsFlap - "Answer a structure defining the default Widgets flap. - previously in quadsDefiningWidgetsFlap" - - ^ #( - (TrashCanMorph new 'Trash' - 'A tool for discarding objects') - "(AllScriptsTool allScriptsToolForActiveWorld 'All - Scripts' 'A tool that lets you see and control all the running - scripts in your project')" - (PaintInvokingMorph new 'Paint' - 'Drop this into an area to start making a fresh painting there') - (GeeMailMorph new 'Gee-Mail' - 'A place to present annotated content') - (RecordingControlsMorph authoringPrototype 'Sound' - 'A device for making sound recordings.') - "(MPEGMoviePlayerMorph authoringPrototype 'Movie - Player' 'A Player for MPEG movies')" - (FrameRateMorph authoringPrototype 'Frame - Rate' 'An indicator of how fast your system is running') - (MagnifierMorph newRound 'Magnifier' - 'A magnifying glass') - "(ScriptingSystem newScriptingSpace 'Scripting' - 'A confined place for drawing and scripting, with its own - private stop/step/go buttons.') - (ScriptingSystem holderWithAlphabet 'Alphabet' - 'A source for single-letter objects') - (BouncingAtomsMorph new 'Bouncing - Atoms' 'Atoms, mate')" - (ObjectsTool newStandAlone 'Object - Catalog' 'A tool that lets you browse the catalog of objects') - ) asOrderedCollection! Item was removed: - ----- Method: Flaps class>>deleteMorphsSatisfying:fromGlobalFlapSatisfying: (in category 'construction support') ----- - deleteMorphsSatisfying: deleteBlock fromGlobalFlapSatisfying: flapBlock - "If any global flap satisfies flapBlock, then delete objects satisfying from deleteBlock from it. Occasionally called from do-its in updates or other fileouts." - - | aFlapTab flapPasteUp | - aFlapTab := self globalFlapTabsIfAny detect: flapBlock ifNone: [^ self]. - flapPasteUp := aFlapTab referent. - flapPasteUp submorphs do: - [:aMorph | (deleteBlock value: aMorph) ifTrue: [aMorph delete]]! Item was removed: - ----- Method: Flaps class>>disableGlobalFlapWithID: (in category 'menu commands') ----- - disableGlobalFlapWithID: aFlapID - "Mark this project as having the given flapID disabled" - - | disabledFlapIDs aFlapTab currentProject | - (currentProject := Project current) assureFlapIntegrity. - Smalltalk isMorphic ifFalse: [^ self]. - disabledFlapIDs := currentProject parameterAt: #disabledGlobalFlapIDs. - (aFlapTab := self globalFlapTabWithID: aFlapID) ifNotNil: - [aFlapTab hideFlap]. - (disabledFlapIDs includes: aFlapID) - ifFalse: - [disabledFlapIDs add: aFlapID]. - aFlapTab ifNotNil: [aFlapTab delete] - - ! Item was removed: - ----- Method: Flaps class>>disableGlobalFlaps (in category 'menu commands') ----- - disableGlobalFlaps - "Clobber all the shared flaps structures. First read the user her Miranda rights." - - self disableGlobalFlaps: true! Item was removed: - ----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') ----- - disableGlobalFlaps: interactive - "Clobber all the shared flaps structures. First read the user her Miranda rights." - - interactive - ifTrue: [(self confirm: - 'CAUTION!! This will destroy all the shared - flaps, so that they will not be present in - *any* project. If, later, you want them - back, you will have to reenable them, from - this same menu, whereupon the standard - default set of shared flaps will be created. - Do you really want to go ahead and clobber - all shared flaps at this time?' translated) ifFalse: [^ self]]. - - self globalFlapTabsIfAny do: - [:aFlapTab | self removeFlapTab: aFlapTab keepInList: false. - aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]]. - self clobberFlapTabList. - self initializeFlapsQuads. - SharedFlapsAllowed := false. - Smalltalk isMorphic ifTrue: [ - Project current world - restoreMorphicDisplay; - reformulateUpdatingMenus]. - - "The following reduces the risk that flaps will be created with variant IDs - such as 'Stack Tools2', potentially causing some shared flap logic to fail." - "Smalltalk garbageCollect." "-- see if we are OK without this"! Item was removed: - ----- Method: Flaps class>>doAutomaticLayoutOfFlapsIfAppropriate (in category 'miscellaneous') ----- - doAutomaticLayoutOfFlapsIfAppropriate - "Do automatic layout of flaps if appropriate" - - Preferences automaticFlapLayout ifTrue: - [self positionNavigatorAndOtherFlapsAccordingToPreference]! Item was removed: - ----- Method: Flaps class>>enableClassicNavigatorChanged (in category 'miscellaneous') ----- - enableClassicNavigatorChanged - "The #classicNavigatorEnabled preference has changed. No senders in easily traceable in the image, but this is really sent by a Preference object!!" - - Preferences classicNavigatorEnabled - ifTrue: - [Flaps disableGlobalFlapWithID: 'Navigator' translated. - Preferences enable: #showProjectNavigator. - self disableGlobalFlapWithID: 'Navigator' translated.] - ifFalse: - [self enableGlobalFlapWithID: 'Navigator' translated. - Project current world addGlobalFlaps]. - - self doAutomaticLayoutOfFlapsIfAppropriate. - Project current assureNavigatorPresenceMatchesPreference. - Project current world reformulateUpdatingMenus.! Item was removed: - ----- Method: Flaps class>>enableDisableGlobalFlapWithID: (in category 'menu commands') ----- - enableDisableGlobalFlapWithID: aFlapID - "Toggle the enable/disable status of the given global flap" - - | disabledFlapIDs aFlapTab currentProject | - (currentProject := Project current) assureFlapIntegrity. - Smalltalk isMorphic ifFalse: [^ self]. - disabledFlapIDs := currentProject parameterAt: #disabledGlobalFlapIDs. - (aFlapTab := self globalFlapTabWithID: aFlapID) ifNotNil: - [aFlapTab hideFlap]. - (disabledFlapIDs includes: aFlapID) - ifTrue: - [disabledFlapIDs remove: aFlapID. - self currentWorld addGlobalFlaps] - ifFalse: - [disabledFlapIDs add: aFlapID. - aFlapTab ifNotNil: [aFlapTab delete]]. - self doAutomaticLayoutOfFlapsIfAppropriate! Item was removed: - ----- Method: Flaps class>>enableEToyFlaps (in category 'menu support') ----- - enableEToyFlaps - "Start using global flaps, plug-in version, given that they were not present." - - Cursor wait showWhile: - [self addAndEnableEToyFlaps. - self enableGlobalFlaps]! Item was removed: - ----- Method: Flaps class>>enableGlobalFlapWithID: (in category 'menu commands') ----- - enableGlobalFlapWithID: aFlapID - "Remove any memory of this flap being disabled in this project" - - | disabledFlapIDs currentProject | - (currentProject := Project current) assureFlapIntegrity. - Smalltalk isMorphic ifFalse: [^ self]. - disabledFlapIDs := currentProject parameterAt: #disabledGlobalFlapIDs ifAbsent: [^ self]. - disabledFlapIDs remove: aFlapID ifAbsent: [] - ! Item was removed: - ----- Method: Flaps class>>enableGlobalFlaps (in category 'menu support') ----- - enableGlobalFlaps - "Start using global flaps, given that they were not present." - - Cursor wait showWhile: [ - SharedFlapsAllowed := true. - self globalFlapTabs. "This will create them" - Smalltalk isMorphic ifTrue: [ - Project current world addGlobalFlaps. - self doAutomaticLayoutOfFlapsIfAppropriate. - FlapTab allInstancesDo: [:tab | tab computeEdgeFraction]. - Project current world reformulateUpdatingMenus]]! Item was removed: - ----- Method: Flaps class>>enableOnlyGlobalFlapsWithIDs: (in category 'shared flaps') ----- - enableOnlyGlobalFlapsWithIDs: survivorList - "In the current project, suppress all global flaps other than those with ids in the survivorList" - - self globalFlapTabsIfAny do: [:flapTab | - (survivorList includes: flapTab flapID) - ifTrue: [self enableGlobalFlapWithID: flapTab flapID] - ifFalse: [self disableGlobalFlapWithID: flapTab flapID]]. - Project current world addGlobalFlaps - - "Flaps enableOnlyGlobalFlapsWithIDs: #('Supplies')"! Item was removed: - ----- Method: Flaps class>>explainFlaps (in category 'menu commands') ----- - explainFlaps - "Open a window giving flap help." - - (StringHolder new contents: self explainFlapsText translated) - openLabel: 'Flaps' translated - - "Flaps explainFlaps" - - - - - ! Item was removed: - ----- Method: Flaps class>>explainFlapsText (in category 'menu commands') ----- - explainFlapsText - "Answer the text, in English, to show in a help-window about Flaps." - - ^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below. - - ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps. - - To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence. - - ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project. - - If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it. - - If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs. - - Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options. - - You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen - - You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen. - - Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area. - - If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu. - - The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu. - - tab color... Lets you change the color of the flap''s tab. - flap color... Lets you change the color of the flap itself. - - use textual tab... If the tab is not textual, makes it become textual. - change tab wording... If the tab is already textual, allows you to edit - its wording. - - use graphical tab... If the tab is not graphical, makes it become - graphical. - choose tab graphic... If the tab is already graphical, allows you - to change the picture. - - use solid tab... If the tab is not solid, makes it become solid, i.e. - appear as a solid band of color along the - entire length or width of the screen. - - parts-bin behavior If set, then dragging an object from the flap - tears off a new copy of the object. - - dragover If set, the flap opens on dragover and closes - again on drag-leave. - - - mouseover If set, the flap opens on mouseover and closes - again on mouse-leave. - - cling to edge... Governs which edge (left, right, top, bottom) - the flap adheres to. - - shared If set, the same flap will be available in all projects; if not, the - flap will will occur only in one project. - - destroy this flap Deletes the flap. - - To define a new flap, use ''make a new flap'', found in the ''flaps'' menu. - - To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''. - - To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it. - - Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated! Item was removed: - ----- Method: Flaps class>>fileOutChanges (in category 'miscellaneous') ----- - fileOutChanges - "Bug workaround for squeak-flap 'fileOutChanges' buttons which for a while were mistakenly sending their requests here..." - - ^ ChangeSet current verboseFileOut. ! Item was removed: - ----- Method: Flaps class>>freshFlapsStart (in category 'flap mechanics') ----- - freshFlapsStart - "To be called manually only, as a drastic measure. Delete all flap artifacts and establish fresh default global flaps - Flaps freshFlapsStart - " - self currentWorld deleteAllFlapArtifacts. - self clobberFlapTabList. - self addStandardFlaps - ! Item was removed: - ----- Method: Flaps class>>globalFlapTab: (in category 'shared flaps') ----- - globalFlapTab: aName - "Answer the global flap tab in the current system whose flapID is the same as aName, or nil if none found." - - | idToMatch | - idToMatch := (aName beginsWith: 'flap: ') - ifTrue: "Ted's old scheme; this convention may still be found - in pre-existing content that has been externalized" - [aName copyFrom: 7 to: aName size] - ifFalse: - [aName]. - - ^ self globalFlapTabsIfAny detect: [:ft | ft flapID = idToMatch] ifNone: [nil]! Item was removed: - ----- Method: Flaps class>>globalFlapTabOrDummy: (in category 'shared flaps') ----- - globalFlapTabOrDummy: aName - "Answer a global flap tab in the current image with the given name. If none is found, answer a dummy StringMorph for some reason (check with tk about the use of this)" - - | gg | - (gg := self globalFlapTab: aName) ifNil: - [^ StringMorph contents: aName, ' can''t be found']. - ^ gg! Item was removed: - ----- Method: Flaps class>>globalFlapTabWithID: (in category 'shared flaps') ----- - globalFlapTabWithID: aFlapID - "answer the global flap tab with the given id, or nil if none" - - ^ self globalFlapTabsIfAny detect: [:aFlapTab | aFlapTab flapID = aFlapID] - ifNone: - ["Second try allows sequence numbers" - self globalFlapTabsIfAny detect: [:aFlapTab | FlapTab givenID: aFlapTab flapID matches: aFlapID] - ifNone: [nil]]! Item was removed: - ----- Method: Flaps class>>globalFlapTabs (in category 'shared flaps') ----- - globalFlapTabs - "Answer the list of shared flap tabs, creating it if necessary. Much less aggressive is #globalFlapTabsIfAny" - - SharedFlapTabs ifNil: [self initializeStandardFlaps]. - ^ SharedFlapTabs copy! Item was removed: - ----- Method: Flaps class>>globalFlapTabsIfAny (in category 'shared flaps') ----- - globalFlapTabsIfAny - "Answer a list of the global flap tabs, but it they don't exist, just answer an empty list" - - ^ SharedFlapTabs copy ifNil: [Array new]! Item was removed: - ----- Method: Flaps class>>globalFlapTabsWithID: (in category 'shared flaps') ----- - globalFlapTabsWithID: aFlapID - "Answer all flap tabs whose ids start with the given id" - - ^ self globalFlapTabsIfAny select: - [:aFlapTab | - (aFlapTab flapID = aFlapID) or: [FlapTab givenID: aFlapTab flapID matches: aFlapID]] - - "Flaps globalFlapTabsWithID: 'Stack Tools'"! Item was removed: - ----- Method: Flaps class>>globalFlapWithIDEnabledString: (in category 'menu support') ----- - globalFlapWithIDEnabledString: aFlapID - "Answer the string to be shown in a menu to represent the status of the givne flap regarding whether it it should be shown in this project." - - | aFlapTab wording | - aFlapTab := self globalFlapTabWithID: aFlapID. - wording := aFlapTab ifNotNil: [aFlapTab wording] ifNil: ['(', aFlapID, ')']. - ^ (Project current isFlapIDEnabled: aFlapID) - ifTrue: - ['<on>', wording] - ifFalse: - ['<off>', wording]! Item was removed: - ----- Method: Flaps class>>initialize (in category 'class initialization') ----- - initialize - self initializeFlapsQuads! Item was removed: - ----- Method: Flaps class>>initializeFlapsQuads (in category 'flaps registry') ----- - initializeFlapsQuads - "initialize the list of dynamic flaps quads. - self initializeFlapsQuads" - FlapsQuads := nil. - self registeredFlapsQuads at: 'PlugIn Supplies' put: self defaultsQuadsDefiningPlugInSuppliesFlap; - at: 'Stack Tools' put: self defaultsQuadsDefiningStackToolsFlap; - at: 'Supplies' put: self defaultsQuadsDefiningSuppliesFlap; - at: 'Tools' put: self defaultsQuadsDefiningToolsFlap; - at: 'Widgets' put: self defaultsQuadsDefiningWidgetsFlap.. - ^ self registeredFlapsQuads! Item was removed: - ----- Method: Flaps class>>initializeStandardFlaps (in category 'predefined flaps') ----- - initializeStandardFlaps - "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed." - - SharedFlapTabs := nil. - self addStandardFlaps! Item was removed: - ----- Method: Flaps class>>makeNavigatorFlapResembleGoldenBar (in category 'miscellaneous') ----- - makeNavigatorFlapResembleGoldenBar - "At explicit request, make the flap-based navigator resemble the golden bar. No senders in the image, but sendable from a doit" - - "Flaps makeNavigatorFlapResembleGoldenBar" - - Preferences setPreference: #classicNavigatorEnabled toValue: false. - Preferences setPreference: #showProjectNavigator toValue: false. - (self globalFlapTabWithID: 'Navigator' translated) ifNil: - [SharedFlapTabs add: self newNavigatorFlap delete]. - self enableGlobalFlapWithID: 'Navigator' translated. - Preferences setPreference: #navigatorOnLeftEdge toValue: true. - (self globalFlapTabWithID: 'Navigator' translated) arrangeToPopOutOnMouseOver: true. - Project current world addGlobalFlaps. - self doAutomaticLayoutOfFlapsIfAppropriate. - Project current assureNavigatorPresenceMatchesPreference. ! Item was removed: - ----- Method: Flaps class>>newFlapTitled:onEdge: (in category 'new flap') ----- - newFlapTitled: aString onEdge: anEdge - "Create a new flap with the given title and place it on the given edge" - - ^ self newFlapTitled: aString onEdge: anEdge inPasteUp: self currentWorld - ! Item was removed: - ----- Method: Flaps class>>newFlapTitled:onEdge:inPasteUp: (in category 'new flap') ----- - newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph - "Add a flap with the given title, placing it on the given edge, in the given pasteup" - - | aFlapBody aFlapTab | - aFlapBody := PasteUpMorph newSticky. - aFlapTab := FlapTab new referent: aFlapBody. - aFlapTab setName: aString edge: anEdge color: (Color r: 0.516 g: 0.452 b: 1.0). - - anEdge == #left ifTrue: - [aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top). - aFlapBody extent: (200 @ aPasteUpMorph height)]. - anEdge == #right ifTrue: - [aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top). - aFlapBody extent: (200 @ aPasteUpMorph height)]. - anEdge == #top ifTrue: - [aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top). - aFlapBody extent: (aPasteUpMorph width @ 200)]. - anEdge == #bottom ifTrue: - [aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)). - aFlapBody extent: (aPasteUpMorph width @ 200)]. - - aFlapBody - beFlap: true; - color: self defaultColorForFlapBackgrounds; - changeTableLayout. - ^ aFlapTab! Item was removed: - ----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') ----- - newLoneSuppliesFlap - "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..." - - | aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly" - aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: { - - {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. - {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}. - {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}. - - {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}. - {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. - {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. - {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. - {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. - {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. - {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. - {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. - {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}." - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. - {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}. - - {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}. - {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}. - - {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. - {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}. - {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}. - {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}. - }. - - aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. - - aStrip extent: self currentWorld width @ 78. - leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2. - - aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)). - - aStrip beFlap: true. - aStrip autoLineLayout: true. - - ^ aFlapTab! Item was removed: - ----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') ----- - newNavigatorFlap - "Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. " - - | aFlapTab navBar aFlap | - navBar := ProjectNavigationMorph preferredNavigator new addButtons. - aFlap := PasteUpMorph newSticky borderWidth: 0; - extent: navBar extent + (0 at 20); - color: (Color orange alpha: 0.8); - beFlap: true; - addMorph: navBar beSticky. - aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap. - aFlap useRoundedCorners. - aFlap setNameTo: 'Navigator Flap' translated. - navBar fullBounds. "to establish width" - - aFlapTab := FlapTab new referent: aFlap. - aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange. - aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2)) - @ (self currentWorld height - aFlapTab height). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - ^ aFlapTab - - "Flaps replaceGlobalFlapwithID: 'Navigator' translated " - ! Item was removed: - ----- Method: Flaps class>>newObjectsFlap (in category 'predefined flaps') ----- - newObjectsFlap - "Answer a fully-instantiated flap named 'Objects' to be placed at the top of the screen." - - | aFlapTab anObjectsTool | - anObjectsTool := ObjectsTool new. - anObjectsTool initializeForFlap. - - aFlapTab := FlapTab new referent: anObjectsTool beSticky. - aFlapTab setName: 'Objects' translated edge: #top color: Color red lighter. - aFlapTab position: ((Display width - (aFlapTab width + 22)) @ 0). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - - anObjectsTool extent: self currentWorld width @ 200. - anObjectsTool beFlap: true. - anObjectsTool color: Color red muchLighter. - anObjectsTool clipSubmorphs: true. - - anObjectsTool showCategories. - - ^ aFlapTab! Item was removed: - ----- Method: Flaps class>>newPaintingFlap (in category 'predefined flaps') ----- - newPaintingFlap - "Add a flap with the paint palette in it" - - | aFlap aFlapTab | - "Flaps reinstateDefaultFlaps. Flaps newPaintingFlap" - - aFlap := PasteUpMorph new borderWidth: 0. - aFlap color: Color transparent. - aFlap layoutPolicy: TableLayout new. - aFlap hResizing: #shrinkWrap. - aFlap vResizing: #shrinkWrap. - aFlap cellPositioning: #topLeft. - aFlap clipSubmorphs: false. - - aFlap beSticky. "really?!!" - aFlap addMorphFront: PaintBoxMorph new. - aFlap beFlap: true. - aFlap fullBounds. "force layout" - - aFlapTab := FlapTab new referent: aFlap. - aFlapTab setNameTo: 'Painting' translated. - aFlapTab setProperty: #priorWording toValue: 'Paint' translated. - aFlapTab useGraphicalTab. - aFlapTab removeAllMorphs. - aFlapTab setProperty: #paintingFlap toValue: true. - aFlapTab addMorphFront: - "(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))" - self paintFlapButton. - aFlapTab cornerStyle: #rounded. - aFlapTab edgeToAdhereTo: #right. - aFlapTab setToPopOutOnDragOver: false. - aFlapTab setToPopOutOnMouseOver: false. - aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab. - aFlapTab setBalloonText:'Click here to start or finish painting.' translated. - - aFlapTab fullBounds. "force layout" - aFlapTab position: (0 at 6). - self currentWorld addMorphFront: aFlapTab. - ^ aFlapTab! Item was removed: - ----- Method: Flaps class>>newSqueakFlap (in category 'predefined flaps') ----- - newSqueakFlap - "Answer a new default 'Squeak' flap for the left edge of the screen" - - | aFlap aFlapTab aButton aClock buttonColor anOffset bb aFont | - aFlap := PasteUpMorph newSticky borderWidth: 0. - aFlapTab := FlapTab new referent: aFlap. - aFlapTab setName: 'Squeak' translated edge: #left color: Color brown lighter lighter. - aFlapTab position: (0 @ ((Display height - aFlapTab height) // 2)). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - - aFlap cellInset: 14 at 14. - aFlap beFlap: true. - aFlap color: (Color brown muchLighter lighter "alpha: 0.3"). - aFlap extent: 150 @ self currentWorld height. - aFlap layoutPolicy: TableLayout new. - aFlap wrapCentering: #topLeft. - aFlap layoutInset: 2. - aFlap listDirection: #topToBottom. - aFlap wrapDirection: #leftToRight. - - "self addProjectNavigationButtonsTo: aFlap." - anOffset := 16. - - aClock := ClockMorph newSticky. - aClock color: Color red. - aClock showSeconds: false. - aClock font: (TextStyle default fontAt: 3). - aClock step. - aClock setBalloonText: 'The time of day. If you prefer to see seconds, check out my menu.' translated. - aFlap addCenteredAtBottom: aClock offset: anOffset. - - buttonColor := Color cyan muchLighter. - bb := SimpleButtonMorph new target: Smalltalk. - bb color: buttonColor. - aButton := bb copy. - aButton actionSelector: #saveSession. - aButton setBalloonText: 'Make a complete snapshot of the current state of the image onto disk.' translated. - aButton label: 'save' translated font: (aFont := ScriptingSystem fontForTiles). - aFlap addCenteredAtBottom: aButton offset: anOffset. - - aButton := bb copy target: MCMcmUpdater. - aButton actionSelector: #updateFromServer. - aButton label: 'load code updates' translated font: aFont. - aButton color: buttonColor. - aButton setBalloonText: 'Check the Squeak server for any new code updates, and load any that are found.' translated. - aFlap addCenteredAtBottom: aButton offset: anOffset. - - aButton := SimpleButtonMorph new target: Smalltalk; actionSelector: #aboutThisSystem; - label: 'about this system' translated font: aFont. - aButton color: buttonColor. - aButton setBalloonText: 'click here to find out version information' translated. - aFlap addCenteredAtBottom: aButton offset: anOffset. - - aFlap addCenteredAtBottom: (Preferences themeChoiceButtonOfColor: buttonColor font: aFont) offset: anOffset. - - aButton := TrashCanMorph newSticky. - aFlap addCenteredAtBottom: aButton offset: anOffset. - aButton startStepping. - - ^ aFlapTab - - "Flaps replaceGlobalFlapwithID: 'Squeak' translated "! Item was removed: - ----- Method: Flaps class>>newStackToolsFlap (in category 'predefined flaps') ----- - newStackToolsFlap - "Add a flap with stack tools in it" - - | aFlapTab aStrip | - aStrip := PartsBin newPartsBinWithOrientation: #leftToRight - andColor: (Color red muchLighter "alpha: 0.2") from: self quadsDefiningStackToolsFlap. - - aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab setName: 'Stack Tools' translated edge: #bottom color: Color brown lighter lighter. - aFlapTab position: ((Display width - (aFlapTab width + 226)) @ (self currentWorld height - aFlapTab height)). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - - aStrip extent: self currentWorld width @ 78. - aStrip beFlap: true. - aStrip autoLineLayout: true. - aStrip extent: self currentWorld width @ 70. - - ^ aFlapTab - - "Flaps replaceGlobalFlapwithID: 'Stack Tools' translated"! Item was removed: - ----- Method: Flaps class>>newSuppliesFlap (in category 'predefined flaps') ----- - newSuppliesFlap - "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen; this is for the non-plug-in-version" - - ^ self newSuppliesFlapFromQuads: self quadsDefiningSuppliesFlap positioning: #right! Item was removed: - ----- Method: Flaps class>>newSuppliesFlapFromQuads:positioning: (in category 'predefined flaps') ----- - newSuppliesFlapFromQuads: quads positioning: positionSymbol - "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge." - - | aFlapTab aStrip hPosition | - (Smalltalk classNamed: 'SugarNavigatorBar') ifNotNil: [:c | - c showSugarNavigator ifTrue: [ - ^ self newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: nil]]. - aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads. - "self twiddleSuppliesButtonsIn: aStrip." - aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. - hPosition := positionSymbol == #center - ifTrue: - [(Display width // 2) - (aFlapTab width // 2)] - ifFalse: - [Display width - (aFlapTab width + 22)]. - aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - - aStrip extent: self currentWorld width @ 136. - aStrip beFlap: true. - aStrip autoLineLayout: true. - - ^ aFlapTab - - "Flaps replaceGlobalFlapwithID: 'Supplies' translated"! Item was removed: - ----- Method: Flaps class>>newToolsFlap (in category 'predefined flaps') ----- - newToolsFlap - "Answer a newly-created flap which adheres to the right edge of the screen and which holds prototypes of standard tools." - - | aFlapTab aStrip | - aStrip := PartsBin newPartsBinWithOrientation: #topToBottom andColor: (Color orange muchLighter alpha: 0.8) from: self quadsDefiningToolsFlap. - - aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab setName: 'Tools' translated edge: #right color: Color orange lighter. - aFlapTab position: (self currentWorld width - aFlapTab width) @ ((Display height - aFlapTab height) // 2). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - - aStrip extent: (90 @ self currentWorld height). - aStrip beFlap: true. - - ^ aFlapTab - - "Flaps replaceGlobalFlapwithID: 'Tools' translated " - ! Item was removed: - ----- Method: Flaps class>>newWidgetsFlap (in category 'predefined flaps') ----- - newWidgetsFlap - "Answer a newly-created flap which adheres to the bottom edge of the screen and which holds prototypes of standard widgets. " - - | aFlapTab aStrip | - aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: (Color blue muchLighter alpha: 0.8) - from: self quadsDefiningWidgetsFlap. - - aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab setName: 'Widgets' translated edge: #bottom color: Color blue lighter lighter. - aFlapTab position: ((Display width - (aFlapTab width + 122)) @ (self currentWorld height - aFlapTab height)). - aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. - - aStrip extent: self currentWorld width @ 78. - aStrip beFlap: true. - aStrip autoLineLayout: true. - - ^ aFlapTab - - "Flaps replaceGlobalFlapwithID: 'Widgets' translated " - ! Item was removed: - ----- Method: Flaps class>>orientationForEdge: (in category 'miscellaneous') ----- - orientationForEdge: anEdge - "Answer the orientation -- #horizontal or #vertical -- that corresponds to the edge symbol" - - ^ (#(left right) includes: anEdge) - ifTrue: [#vertical] - ifFalse: [#horizontal]! Item was removed: - ----- Method: Flaps class>>paintFlapButton (in category 'miscellaneous') ----- - paintFlapButton - "Answer a button to serve as the paint flap" - - | pb oldArgs brush myButton m | - pb := PaintBoxMorph new submorphNamed: #paint:. - pb - ifNil: - [(brush := Form extent: 16 at 16 depth: 16) fillColor: Color red] - ifNotNil: - [oldArgs := pb arguments. - brush := oldArgs third. - brush := brush copy: (2 at 0 extent: 42 at 38). - brush := brush scaledToSize: brush extent // 2]. - myButton := BorderedMorph new. - myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderStyle: (BorderStyle raised width: 2). - myButton addMorph: (m := brush asMorph lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - ^ myButton - - ! Item was removed: - ----- Method: Flaps class>>positionNavigatorAndOtherFlapsAccordingToPreference (in category 'shared flaps') ----- - positionNavigatorAndOtherFlapsAccordingToPreference - "Lay out flaps along the designated edge right-to-left, possibly positioning the navigator flap, exceptionally, on the left." - - | ids | - ids := Preferences navigatorOnLeftEdge ifTrue: [{'Navigator' translated}] ifFalse: [#()]. - - Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapsWithIDs: ids - - "Flaps positionNavigatorAndOtherFlapsAccordingToPreference"! Item was removed: - ----- Method: Flaps class>>positionVisibleFlapsRightToLeftOnEdge:butPlaceAtLeftFlapsWithIDs: (in category 'shared flaps') ----- - positionVisibleFlapsRightToLeftOnEdge: edgeSymbol butPlaceAtLeftFlapsWithIDs: idList - "Lay out flaps along the designated edge right-to-left, while laying left-to-right any flaps found in the exception list - - Flaps positionVisibleFlapsRightToLeftOnEdge: #bottom butPlaceAtLeftFlapWithIDs: {'Navigator' translated. 'Supplies' translated} - Flaps sharedFlapsAlongBottom" - - | leftX flapList flapsOnRight flapsOnLeft | - flapList := self globalFlapTabsIfAny select: - [:aFlapTab | aFlapTab isInWorld and: [aFlapTab edgeToAdhereTo == edgeSymbol]]. - flapsOnLeft := OrderedCollection new. - flapsOnRight := OrderedCollection new. - - flapList do: [:fl | - (idList includes: fl flapID) - ifTrue: [ flapsOnLeft addLast: fl ] - ifFalse: [ flapsOnRight addLast: fl ] ]. - - leftX := Project current world width - 15. - - flapsOnRight - sort: [:f1 :f2 | f1 left > f2 left]; - do: [:aFlapTab | - aFlapTab right: leftX - 3. - leftX := aFlapTab left]. - - leftX := Project current world left. - - flapsOnLeft - sort: [:f1 :f2 | f1 left > f2 left]; - do: [:aFlapTab | - aFlapTab left: leftX + 3. - leftX := aFlapTab right]. - - flapList do: - [:ft | ft computeEdgeFraction. - ft flapID = 'Navigator' translated ifTrue: - [ft referent left: (ft center x - (ft referent width//2) max: 0)]]! Item was removed: - ----- Method: Flaps class>>possiblyReplaceEToyFlaps (in category 'construction support') ----- - possiblyReplaceEToyFlaps - "If in eToyFriendly mode, and if it's ok to reinitialize flaps, replace the existing flaps with up-too-date etoy flaps. Caution: this is destructive of existing flaps. If preserving the contents of existing flaps is important, set the preference 'okToReinitializeFlaps' to true" - - PartsBin thumbnailForPartsDescription: StickyPadMorph descriptionForPartsBin. "Puts StickyPadMorph's custom icon back in the cache which typically will have been called" - (Preferences eToyFriendly and: [Preferences okToReinitializeFlaps]) ifTrue: - [Flaps disableGlobalFlaps: false. - Flaps addAndEnableEToyFlaps. - Smalltalk isMorphic ifTrue: [Project current world enableGlobalFlaps]]. - "PartsBin clearThumbnailCache" - - "Flaps possiblyReplaceEToyFlaps"! Item was removed: - ----- Method: Flaps class>>quadsDefiningPlugInSuppliesFlap (in category 'predefined flaps') ----- - quadsDefiningPlugInSuppliesFlap - "Answer a list of quads which define the objects to appear in the default Supplies flap used in the Plug-in image" - - ^ self registeredFlapsQuadsAt: 'PlugIn Supplies'! Item was removed: - ----- Method: Flaps class>>quadsDefiningStackToolsFlap (in category 'predefined flaps') ----- - quadsDefiningStackToolsFlap - "Answer a structure defining the items on the default system Stack Tools flap" - - ^ self registeredFlapsQuadsAt: 'Stack Tools' - - "Flaps replaceGlobalFlapwithID: 'Stack Tools'"! Item was removed: - ----- Method: Flaps class>>quadsDefiningSuppliesFlap (in category 'predefined flaps') ----- - quadsDefiningSuppliesFlap - "Answer a list of quads which define the objects to appear in the default Supplies flap" - - ^ self registeredFlapsQuadsAt: 'Supplies'! Item was removed: - ----- Method: Flaps class>>quadsDefiningToolsFlap (in category 'predefined flaps') ----- - quadsDefiningToolsFlap - "Answer a structure defining the default Tools flap" - - ^ self registeredFlapsQuadsAt: 'Tools'! Item was removed: - ----- Method: Flaps class>>quadsDefiningWidgetsFlap (in category 'predefined flaps') ----- - quadsDefiningWidgetsFlap - "Answer a structure defining the default Widgets flap" - - ^ self registeredFlapsQuadsAt: 'Widgets'! Item was removed: - ----- Method: Flaps class>>quadsDeiningScriptingFlap (in category 'predefined flaps') ----- - quadsDeiningScriptingFlap - "Answer a structure defining the default items in the Scripting flap" - - ^ self registeredFlapsQuadsAt: 'Scripting'! Item was removed: - ----- Method: Flaps class>>registerQuad:forFlapNamed: (in category 'flaps registry') ----- - registerQuad: aQuad forFlapNamed: aLabel - "If any previous registration of the same label string is already known, delete the old one." - - "aQuad received must be an array of the form {TargetObject. #command label 'A Help String'} - - Flaps registerQuad: #(FileList2 openMorphicViewInWorld 'Enhanced File List' 'A nicer File List.') - forFlapNamed: 'Tools' " - - self unregisterQuad: aQuad forFlapNamed: aLabel. - (self registeredFlapsQuads at: aLabel ifAbsent:[^self]) add: aQuad! Item was removed: - ----- Method: Flaps class>>registeredFlapsQuads (in category 'flaps registry') ----- - registeredFlapsQuads - "Answer the list of dynamic flaps quads" - - FlapsQuads ifNil: [FlapsQuads := Dictionary new]. - ^ FlapsQuads - - " FlapsQuads := nil. "! Item was removed: - ----- Method: Flaps class>>registeredFlapsQuadsAt: (in category 'flaps registry') ----- - registeredFlapsQuadsAt: aLabel - "Answer the list of dynamic flaps quads at aLabel" - - ^ (self registeredFlapsQuads at: aLabel ifAbsent:[^#()]) - removeAllSuchThat: [:q | (self environment includesKey: q first) not or: [(self environment at: q first) isNil]] - ! Item was removed: - ----- Method: Flaps class>>reinstateDefaultFlaps (in category 'flap mechanics') ----- - reinstateDefaultFlaps - "Remove all existing 'standard' global flaps clear the global list, and and add fresh ones. To be called by doits in updates etc. This is a radical step, but it does *not* clobber non-standard global flaps or local flaps. To get the effect of the *former* version of this method, call Flaps freshFlapsStart" - - "Flaps reinstateDefaultFlaps" - self globalFlapTabsIfAny do: - [:aFlapTab | - ({ - - 'Squeak' translated. - 'Menu' translated. - 'Widgets' translated. - 'Tools' translated. - 'Supplies' translated. - - 'Objects' translated. - 'Navigator' translated - } includes: aFlapTab flapID) ifTrue: - [self removeFlapTab: aFlapTab keepInList: false]]. - - "The following reduces the risk that flaps will be created with variant IDs - such as 'Stack Tools2', potentially causing some shared flap logic to fail." - "Smalltalk garbageCollect." "-- see if we are OK without this" - - self addStandardFlaps. - "self disableGlobalFlapWithID: 'Scripting'. - self disableGlobalFlapWithID: 'Objects'." - self currentWorld addGlobalFlaps. - self currentWorld reformulateUpdatingMenus. - ! Item was removed: - ----- Method: Flaps class>>removeDuplicateFlapTabs (in category 'shared flaps') ----- - removeDuplicateFlapTabs - "Remove flaps that were accidentally added multiple times" - "Flaps removeDuplicateFlapTabs" - | tabs duplicates | - SharedFlapTabs copy ifNil: [^self]. - tabs := SharedFlapTabs copy. - duplicates := Set new. - tabs do: [:tab | | same | - same := tabs select: [:each | each wording = tab wording]. - same isEmpty not - ifTrue: [ - same removeFirst. - duplicates addAll: same]]. - SharedFlapTabs removeAll: duplicates! Item was removed: - ----- Method: Flaps class>>removeFlapTab:keepInList: (in category 'flap mechanics') ----- - removeFlapTab: aFlapTab keepInList: aBoolean - "Remove the given flap tab from the screen, and, if aBoolean is true, also from the global list" - - (SharedFlapTabs ~~ nil and: [SharedFlapTabs includes: aFlapTab]) - ifTrue: - [aBoolean ifFalse: [self removeFromGlobalFlapTabList: aFlapTab]]. - aFlapTab ifNotNil: - [aFlapTab referent delete. - aFlapTab delete]! Item was removed: - ----- Method: Flaps class>>removeFromGlobalFlapTabList: (in category 'miscellaneous') ----- - removeFromGlobalFlapTabList: aFlapTab - "If the flap tab is in the global list, remove it" - - SharedFlapTabs remove: aFlapTab ifAbsent: []! Item was removed: - ----- Method: Flaps class>>replaceGlobalFlapwithID: (in category 'replacement') ----- - replaceGlobalFlapwithID: flapID - "If there is a global flap with flapID, replace it with an updated one." - - | replacement tabs | - (tabs := self globalFlapTabsWithID: flapID) size = 0 ifTrue: [^ self]. - tabs do: [:tab | - self removeFlapTab: tab keepInList: false]. - flapID = 'Stack Tools' translated ifTrue: [replacement := self newStackToolsFlap]. - flapID = 'Supplies' translated ifTrue: [replacement := self newSuppliesFlapFromQuads: - (Preferences eToyFriendly - ifFalse: [self quadsDefiningSuppliesFlap] - ifTrue: [self quadsDefiningPlugInSuppliesFlap]) positioning: #right]. - flapID = 'Tools' translated ifTrue: [replacement := self newToolsFlap]. - flapID = 'Widgets' translated ifTrue: [replacement := self newWidgetsFlap]. - flapID = 'Navigator' translated ifTrue: [replacement := self newNavigatorFlap]. - flapID = 'Squeak' translated ifTrue: [replacement := self newSqueakFlap]. - replacement ifNil: [^ self]. - self addGlobalFlap: replacement. - self currentWorld ifNotNil: [self currentWorld addGlobalFlaps] - - "Flaps replaceFlapwithID: 'Widgets' translated "! Item was removed: - ----- Method: Flaps class>>replacePartSatisfying:inGlobalFlapSatisfying:with: (in category 'replacement') ----- - replacePartSatisfying: elementBlock inGlobalFlapSatisfying: flapBlock with: replacement - "If any global flap satisfies flapBlock, look in it for a part satisfying elementBlock; if such a part is found, replace it with the replacement morph, make sure the flap's layout is made right, etc." - - | aFlapTab flapPasteUp anElement | - aFlapTab := self globalFlapTabsIfAny detect: flapBlock ifNone: [^ self]. - flapPasteUp := aFlapTab referent. - anElement := flapPasteUp submorphs detect: elementBlock ifNone: [^ self]. - flapPasteUp replaceSubmorph: anElement by: replacement. - flapPasteUp replaceTallSubmorphsByThumbnails; setPartsBinStatusTo: true. - - "Flaps replacePartSatisfying: [:el | (el isKindOf: MorphThumbnail) and: [(el morphRepresented isKindOf: SystemWindow) and: [el morphRepresented label = 'scripting area']]] - inGlobalFlapSatisfying: [:fl | (fl submorphs size > 0) and: [(fl submorphs first isKindOf: TextMorph) and: [(fl submorphs first contents string copyWithout: Character cr) = 'Tools']]] with: ScriptingSystem newScriptingSpace"! Item was removed: - ----- Method: Flaps class>>replacePartSatisfying:inGlobalFlapWithID:with: (in category 'replacement') ----- - replacePartSatisfying: elementBlock inGlobalFlapWithID: aFlapID with: replacement - "If a global flapl exists with the given flapID, look in it for a part satisfying elementBlock; if such a part is found, replace it with the replacement morph, make sure the flap's layout is made right, etc." - - ^ self replacePartSatisfying: elementBlock inGlobalFlapSatisfying: [:fl | fl flapID = aFlapID] with: replacement! Item was removed: - ----- Method: Flaps class>>replaceToolsFlap (in category 'replacement') ----- - replaceToolsFlap - "if there is a global tools flap, replace it with an updated one." - - self replaceGlobalFlapwithID: 'Tools' translated - - "Flaps replaceToolsFlap"! Item was removed: - ----- Method: Flaps class>>setUpSuppliesFlapOnly (in category 'menu support') ----- - setUpSuppliesFlapOnly - "Set up the Supplies flap as the only shared flap. A special version formulated for this stand-alone use is used, defined in #newLoneSuppliesFlap" - - | supplies | - SharedFlapTabs isEmptyOrNil ifFalse: "get rid of pre-existing guys if any" - [SharedFlapTabs do: - [:t | t referent delete. t delete]]. - - SharedFlapsAllowed := true. - SharedFlapTabs := OrderedCollection new. - SharedFlapTabs add: (supplies := self newLoneSuppliesFlap). - self enableGlobalFlapWithID: 'Supplies' translated. - supplies setToPopOutOnMouseOver: false. - - Smalltalk isMorphic ifTrue: [ - Project current world - addGlobalFlaps; - reformulateUpdatingMenus].! Item was removed: - ----- Method: Flaps class>>sharedFlapsAllowed (in category 'shared flaps') ----- - sharedFlapsAllowed - "Answer whether the shared flaps feature is allowed in this system" - - ^ SharedFlapsAllowed ifNil: [SharedFlapsAllowed := SharedFlapTabs isEmptyOrNil not]! Item was removed: - ----- Method: Flaps class>>sharedFlapsAlongBottom (in category 'shared flaps') ----- - sharedFlapsAlongBottom - "Put all shared flaps (except Painting which can't be moved) along the bottom" - "Flaps sharedFlapsAlongBottom" - - | leftX unordered ordered | - unordered := self globalFlapTabsIfAny asIdentitySet. - ordered := Array streamContents: - [:s | { - 'Squeak' translated. - 'Navigator' translated. - 'Supplies' translated. - 'Widgets' translated. - 'Stack Tools' translated. - 'Tools' translated. - 'Painting' translated. - } do: - [:id | (self globalFlapTabWithID: id) ifNotNil: - [:ft | unordered remove: ft. - id = 'Painting' translated ifFalse: [s nextPut: ft]]]]. - - "Pace off in order from right to left, setting positions" - leftX := Display width-15. - ordered , unordered asArray reverseDo: - [:ft | ft setEdge: #bottom. - ft right: leftX - 3. leftX := ft left]. - - "Put Nav Bar centered under tab if possible" - (self globalFlapTabWithID: 'Navigator' translated) ifNotNil: - [:ft | ft referent left: (ft center x - (ft referent width//2) max: 0)]. - self positionNavigatorAndOtherFlapsAccordingToPreference. - ! Item was removed: - ----- Method: Flaps class>>showSharedFlaps (in category 'menu support') ----- - showSharedFlaps - "Answer whether shared flaps are currently showing. Presumably it is in service of Alan's wishes to have flaps show sometimes on interior subprojects and sometomes on outer projects that Bob's CurrentProjectRefactoring is threaded into the logic here." - - ^ Project current showSharedFlaps! Item was removed: - ----- Method: Flaps class>>suppressFlapsString (in category 'menu support') ----- - suppressFlapsString - "Answer the string to be shown in a menu to represent the suppress-flaps-in-this-project status" - - ^ Project current suppressFlapsString! Item was removed: - ----- Method: Flaps class>>twiddleSuppliesButtonsIn: (in category 'predefined flaps') ----- - twiddleSuppliesButtonsIn: aStrip - "Munge item(s) in the strip whose names as seen in the parts bin should be different from the names to be given to resulting torn-off instances" - - (aStrip submorphs detect: [:m | m target == StickyPadMorph] ifNone: [nil]) - ifNotNil: - [:aButton | aButton arguments: {#newStandAlone. 'tear off'}]! Item was removed: - ----- Method: Flaps class>>unregisterQuad:forFlapNamed: (in category 'flaps registry') ----- - unregisterQuad: aQuad forFlapNamed: aLabel - "If any previous registration at the same label string has the same receiver-command, - delete the old one." - (self registeredFlapsQuadsAt: aLabel) - removeAllSuchThat: [:q | q first = aQuad first - and: [q second = aQuad second]]! Item was removed: - ----- Method: Flaps class>>unregisterQuadsWithReceiver: (in category 'flaps registry') ----- - unregisterQuadsWithReceiver: aReceiver - "delete all quads with receiver aReceiver." - self registeredFlapsQuads - do: [:assoc | assoc value - removeAllSuchThat: [:q | (self environment at: (q first) ifAbsent:[nil]) = aReceiver ]]! Item was removed: - ----- Method: Flaps class>>unregisterQuadsWithReceiver:fromFlapNamed: (in category 'flaps registry') ----- - unregisterQuadsWithReceiver: aReceiver fromFlapNamed: aLabel - "delete all quads with receiver aReceiver." - (self registeredFlapsQuads at: aLabel) removeAllSuchThat: [:q | q first = aReceiver name]! Item was removed: - EllipseMorph subclass: #Flasher - instanceVariableNames: 'onColor' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !Flasher commentStamp: '<historical>' prior: 0! - A simple example - a circle that flashes. - - The "onColor" instance variable indicates the color to use when "on", A darker color is used to represent "off". - - The #step method, called every 500ms. by default, alternatively makes the flasher show its "on" and its "off" color.! Item was removed: - ----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Answer a description of the receiver for use in a parts bin" - - ^ self partName: 'Flasher' translatedNoop - categories: {'Just for Fun' translatedNoop} - documentation: 'A circle that flashes' translatedNoop! Item was removed: - ----- Method: Flasher>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - "Initialize the flasher." - - super initializeToStandAlone. - self color: Color red. - self onColor: Color red. - self borderWidth: 2. - self extent: 25 at 25! Item was removed: - ----- Method: Flasher>>onColor (in category 'operations') ----- - onColor - "Answer my onColor" - - ^ onColor ifNil: [onColor := Color red]! Item was removed: - ----- Method: Flasher>>onColor: (in category 'operations') ----- - onColor: aColor - "Change my on color to be aColor" - - onColor := aColor. - self color: aColor! Item was removed: - ----- Method: Flasher>>step (in category 'stepping and presenter') ----- - step - "Perform my standard periodic action" - - super step. - self color = self onColor - ifTrue: [self color: (onColor alphaMixed: 0.5 with: Color black)] - ifFalse: [self color: onColor]! Item was removed: - ----- Method: Flasher>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Answer the desired time between steps, in milliseconds." - - ^ 500! Item was removed: - SketchMorph subclass: #FlexMorph - instanceVariableNames: 'originalMorph borderWidth borderColor' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalMorphs'! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: FlexMorph>>borderColor: (in category 'accessing') ----- - borderColor: aColor - borderColor := aColor. - self updateFromOriginal! Item was removed: - ----- Method: FlexMorph>>borderWidth: (in category 'accessing') ----- - borderWidth: width - borderWidth := width asPoint. - self updateFromOriginal! Item was removed: - ----- Method: FlexMorph>>changeBorderColor: (in category 'menus') ----- - changeBorderColor: evt - | aHand | - aHand := evt ifNotNil: [evt hand] ifNil: [self primaryHand]. - self changeColorTarget: self selector: #borderColor: originalColor: self borderColor hand: aHand.! Item was removed: - ----- Method: FlexMorph>>changeBorderWidth: (in category 'menus') ----- - 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! Item was removed: - ----- Method: FlexMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - originalForm := nil. "Aggressively uncache the originalForm" - ^ super drawOn: aCanvas! Item was removed: - ----- Method: FlexMorph>>extent: (in category 'geometry') ----- - extent: newExtent - - self loadOriginalForm. "make sure it's not nil" - ^ super extent: newExtent! Item was removed: - ----- Method: FlexMorph>>form (in category 'accessing') ----- - form - - self loadOriginalForm. "make sure it's not nil" - ^ super form! Item was removed: - ----- Method: FlexMorph>>generateRotatedForm (in category 'drawing') ----- - generateRotatedForm - - self loadOriginalForm. "make sure it's not nil" - ^ super generateRotatedForm! Item was removed: - ----- Method: FlexMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - borderWidth := 2 at 2. - borderColor := Color black.! Item was removed: - ----- Method: FlexMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - - self loadOriginalForm. "make sure it's not nil" - ^ super layoutChanged! Item was removed: - ----- Method: FlexMorph>>loadOriginalForm (in category 'private') ----- - loadOriginalForm - - originalForm ifNil: [self updateFromOriginal]. - ! Item was removed: - ----- Method: FlexMorph>>originalMorph (in category 'accessing') ----- - originalMorph - - ^ originalMorph! Item was removed: - ----- Method: FlexMorph>>originalMorph: (in category 'accessing') ----- - originalMorph: aMorph - - originalMorph := aMorph. - scalePoint := 0.25 at 0.25. - self updateFromOriginal.! Item was removed: - ----- 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.! Item was removed: - ----- Method: FlexMorph>>updateFromOriginal (in category 'private') ----- - 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! Item was removed: - AlignmentMorph subclass: #FloatingBookControlsMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Navigators'! Item was removed: - ----- Method: FloatingBookControlsMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: FloatingBookControlsMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self layoutInset: 0; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap ! Item was removed: - ----- Method: FloatingBookControlsMorph>>morphicLayerNumber (in category 'submorphs - layers') ----- - morphicLayerNumber - "page controls are behind menus and balloons, but in front of most other stuff" - - ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]! Item was removed: - ----- Method: FloatingBookControlsMorph>>step (in category 'stepping and presenter') ----- - step - - owner == self world ifFalse: [^ self]. - owner addMorphInLayer: self. - self position: (owner bottomCenter) - ((self width//2)@self height) - ! Item was removed: - ----- Method: FloatingBookControlsMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^1000! Item was removed: - ----- Method: FloatingBookControlsMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - - ^true! Item was removed: - ----- Method: Form class>>exampleColorSees (in category '*MorphicExtras-examples') ----- - exampleColorSees - "Form exampleColorSees" - "First column as above shows the sneaky red/yellow pirate sneaking up on the blue/peach galleon. - Second column shows the 1bpp made from the red/yellow/transparent - white -> ignore this, black -> test this - Third shows the hit area - where red touches blue - superimposed on the original scene. - Fourth column is the tally of hits via the old algorithm - Last column shows the tally of hits via the new prim" - - | formA formB maskA offset tally map intersection left top dCanvas sensitiveColor soughtColor index | - formA := formB := maskA := offset := tally := map := intersection := nil. "just to shut up the compiler when testing" - Project current world restoreMorphicDisplay; doOneCycle. - - sensitiveColor := Color red. - soughtColor := Color blue. - - top := 50. - dCanvas := FormCanvas on: Display. - -50 to: 80 by: 10 do:[:p| - offset:= p at 0. "vary this to check different states" - left := 10. - - formA := (Form extent: 100 at 50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths". - formB := Form extent: 100 at 50 depth: 32. - - "make a red square in the middle of the form" - (FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: sensitiveColor. - (FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent. - (FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color yellow. - "formA displayOn: Display at: left at top rule: Form paint. - dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green. - left := left + 150." - - "make a blue block on the right half of the form" - (FormCanvas on: formB) fillRectangle: (50 at 0 extent: 50 at 100) fillStyle: soughtColor. - (FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach. - "formB displayOn: Display at: left at top rule: Form paint. - dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green. - left := left + 150." - - intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox). - - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150. - - maskA := Form extent: intersection extent depth: 1. - - map := Bitmap new: (1 bitShift: (formA depth min: 15)). - map at: (index := sensitiveColor indexInMap: map) put: 1. - - maskA copyBits: (intersection translateBy: offset negated) from: formA at: 0 at 0 colorMap: map. - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. left := left + 150. - - "intersect world pixels of the color we're looking for with sensitive pixels mask" - map at: index put: 0. "clear map and reuse it" - map at: (soughtColor indexInMap: map) put: 1. - - maskA - copyBits: intersection - from: formB at: 0 at 0 clippingBox: formB boundingBox - rule: Form and - fillColor: nil - map: map. - - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 170. - - (maskA tallyPixelValues at: 2) asString asDisplayText displayOn: Display at: left@(top +20). - left := left + 70. - - "now try using the new primitive" - tally := (BitBlt - destForm: formB - sourceForm: formA - fillColor: nil - combinationRule: 3 "really ought to work with nil but prim code checks" - destOrigin: intersection origin - sourceOrigin: (offset negated max: 0 at 0) - extent: intersection extent - clipRect: intersection) - primCompareColor: ((sensitiveColor pixelValueForDepth: formA depth) ) to: ((soughtColor pixelValueForDepth: formB depth) ) test: (Form compareMatchColor bitOr: Form compareTallyFlag). - tally asString asDisplayText displayOn: Display at: left@(top +20). - top:= top + 60]! Item was removed: - ----- Method: Form class>>exampleTouchTest (in category '*MorphicExtras-examples') ----- - exampleTouchTest - "Form exampleTouchTest" - "Demonstrate the algorithm used in Scratch code to determine if a sprite's non-transparent pixels touch a - non-transparent pixel of the background upon which it is displayed. - First column shows a form with a red block in the midst of transparent area sneaking up on a form with a transparent LHS and blue RHS. The green frame shows the intersection area. - Second column shows in grey the part of the red that is within the intersection. - Third column shows in black the blue that is within the intersection. - Fourth column shows just the A touching B area. - Fifth column is the tally of hits via the old algorithm - Last column shows the tally of hits via the new prim" - |formA formB maskA maskB offset tally map intersection left top dCanvas| - formA := formB := maskA := maskB := offset := tally := map := intersection := nil. "just to shut up the compiler when testing" - - Project current world restoreMorphicDisplay; doOneCycle. - - top := 50. - dCanvas := FormCanvas on: Display. - -50 to: 80 by: 10 do:[:p| - offset:= p at 0. "vary this to check different states" - left := 10. - - formA := Form extent: 100 at 50 depth: 32. - formB := Form extent: 100 at 50 depth: 16. - - "make a red square in the middle of the form" - (FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: Color yellow. - (FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent. - (FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color red. - "formA displayOn: Display at: left at top rule: Form paint. - dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green. - left := left + 150." - - "make a blue block on the right half of the form" - (FormCanvas on: formB) fillRectangle: (50 at 0 extent: 50 at 100) fillStyle: Color blue. - (FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach. - "formB displayOn: Display at: left at top rule: Form paint. - dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green. - left := left + 150." - - intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox). - - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150. - - maskA := Form extent: intersection extent depth: 2. - formA displayOn: maskA at: offset - intersection origin rule: Form paint. - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150. - - maskB := Form extent: intersection extent depth: 2. - formB displayOn: maskB at: intersection origin negated rule: Form paint. - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - maskB displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150. - - map := Bitmap new: 4 withAll: 1. - map at: 1 put: 0. "transparent" - - maskA copyBits: maskA boundingBox from: maskA at: 0 at 0 colorMap: map. - "maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150." - - maskB copyBits: maskB boundingBox from: maskB at: 0 at 0 colorMap: map. - "maskB displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150." - - maskB displayOn: maskA at: 0 at 0 rule: Form and. - maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 170. - - (maskA boundingBox area -( maskA tallyPixelValues at: 1)) asString asDisplayText displayOn: Display at: left@(top +20). - left := left + 70. - - "now try using the new primitive" - tally := (BitBlt - destForm: formB - sourceForm: formA - fillColor: nil - combinationRule: 3 "really ought to work with nil but prim code checks" - destOrigin: intersection origin - sourceOrigin: (offset negated max: 0 at 0) - extent: intersection extent - clipRect: intersection) - primCompareColor: ((Color transparent pixelValueForDepth: formA depth) bitAnd: 16rFFFFFF) to: ((Color transparent pixelValueForDepth: formB depth) bitAnd: 16rFFFFFF) test: (Form compareNotColorANotColorB bitOr: Form compareTallyFlag). - tally asString asDisplayText displayOn: Display at: left@(top +20). - top:= top + 60]! Item was removed: - ----- Method: Form class>>exampleTouchingColor (in category '*MorphicExtras-examples') ----- - exampleTouchingColor - "Form exampleTouchingColor" - "Demonstrate the algorithm used in Scratch code to determine if a sprite's non-transparent pixels touch a - particular color pixel of the background upon which it is displayed. - First column as above shows the sneaky red/yellow pirate sneaking up on the blue/peach galleon. - Second column shows the 1bpp made from the red/yellow/transparent - white -> ignore this, black -> test this - Third shows the hit area (black) superimposed on the original scene - Fourth column is the tally of hits via the old algorithm - Last column shows the tally of hits via the new prim" - |formA formB maskA offset tally map intersection left top dCanvas ignoreColor soughtColor| - formA := formB := maskA := offset := tally := map := intersection := nil. "just to shut up the compiler when testing" - Project current world restoreMorphicDisplay; doOneCycle. - - ignoreColor := Color transparent. - soughtColor := Color blue. - - top := 50. - dCanvas := FormCanvas on: Display. - -50 to: 80 by: 10 do:[:p| - offset:= p at 0. "vary this to check different states" - left := 10. - - formA := (Form extent: 100 at 50 depth: 32) asFormOfDepth: 16 "so we can try original forms of other depths". - formB := Form extent: 100 at 50 depth: 32. - - "make a red square in the middle of the form" - (FormCanvas on: formA) fillRectangle: (25 at 25 extent: 50 at 5) fillStyle: Color red. - (FormCanvas on: formA) fillRectangle: (25 at 30 extent: 50 at 5) fillStyle: Color transparent. - (FormCanvas on: formA) fillRectangle: (25 at 35 extent: 50 at 50) fillStyle: Color yellow. - "formA displayOn: Display at: left at top rule: Form paint. - dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green. - left := left + 150." - - "make a blue block on the right half of the form" - (FormCanvas on: formB) fillRectangle: (50 at 0 extent: 50 at 100) fillStyle: soughtColor. - (FormCanvas on: formB) fillRectangle: (60 at 0 extent: 10 at 100) fillStyle: Color palePeach. - "formB displayOn: Display at: left at top rule: Form paint. - dCanvas frameRectangle: (left at top extent: formA extent) width:2 color: Color green. - left := left + 150." - - intersection := (formA boundingBox translateBy: offset) intersect: (formB boundingBox). - - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 150. - - maskA := Form extent: intersection extent depth: 1. - - map := Bitmap new: (1 bitShift: (formA depth min: 15)). - map atAllPut: 1. - map at: ( ignoreColor indexInMap: map) put: 0. - - maskA copyBits: (intersection translateBy: offset negated) from: formA at: 0 at 0 colorMap: map. - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. left := left + 150. - - "intersect world pixels of the color we're looking for with sensitive pixels mask" - map atAllPut: 0. "clear map and reuse it" - map at: (soughtColor indexInMap: map) put: 1. - - maskA - copyBits: intersection - from: formB at: 0 at 0 clippingBox: formB boundingBox - rule: Form and - fillColor: nil - map: map. - - formB displayOn: Display at: left at top rule: Form paint. - formA displayOn: Display at: (left at top) + offset rule: Form paint. - maskA displayOn: Display at: (left at top) + intersection origin rule: Form paint. - dCanvas frameRectangle: (intersection translateBy: left at top) width:2 color: Color green. - left := left + 170. - - (maskA tallyPixelValues at: 2) asString asDisplayText displayOn: Display at: left@(top +20). - left := left + 70. - - "now try using the new primitive" - tally := (BitBlt - destForm: formB - sourceForm: formA - fillColor: nil - combinationRule: 3 "really ought to work with nil but prim code checks" - destOrigin: intersection origin - sourceOrigin: (offset negated max: 0 at 0) - extent: intersection extent - clipRect: intersection) - primCompareColor: ((ignoreColor pixelValueForDepth: formA depth) bitAnd: 16rFFFFFF) to: ((soughtColor pixelValueForDepth: formB depth) bitAnd: 16rFFFFFF) test: (Form compareNotColorAMatchColorB bitOr: Form compareTallyFlag). - tally asString asDisplayText displayOn: Display at: left@(top +20). - top:= top + 60]! Item was removed: - ----- Method: Form class>>extraCook (in category '*MorphicExtras-sprites') ----- - extraCook - - ^ Imports default imports - at: #extraCook - ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self extraCookContents readStream) ]! Item was removed: - ----- Method: Form class>>extraCookContents (in category '*MorphicExtras-sprites') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: Form class>>extraWizard (in category '*MorphicExtras-sprites') ----- - extraWizard - - ^ Imports default imports - at: #extraWizard - ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self extraWizardContents readStream) ]! Item was removed: - ----- Method: Form class>>extraWizardContents (in category '*MorphicExtras-sprites') ----- - extraWizardContents - - ^ 'iVBORw0KGgoAAAANSUhEUgAAALQAAAC0CAYAAAA9zQYyAAA4UklEQVR4XuWdB1gT6fb//d37 - 33vvdsvaUOkoVZGekJCGnY6Iiljo2HvDQhFUioIi9k4HsaAIKihN3XVXd9e19wZY1oJAIJTz - P+8ALqEJmAA653nOE8hMMpPMZ06+7zlv6UJ/o7/R3+hvn4X5BmUbevtlKtD/m6C/fZbmE5w5 - CiEO8wvOSVkTkvsEH/9e4X/2mcf8ozPp/+3Q3z4PiIMyLXyDcgJqIC7wCcwuX+J9BmYtOg4u - Mw/BNM8EmOIW995mcqQ//b8t+lvnlRMBiRzvdZmbEOJnfsG5FSsDzsECr1RwnZUEU9zjG/hk - t7iyqa4HJ9L/m6O/dRrzXnt2EEbiLQjxW3RY5psObrMPw1SPhEYhbuBuceX2Dvv49P8m6W8d - bkO03eUXr0q55L/hPCDUsHj1aXCakdgykOu4o2vsUWuPpB/p/43S3zrM9A3mC0xH+5wjUdl7 - fRalj1sLch3pUTTJOWY4/b9V+luH2GDGPBsGe+ETt9lR4LXmLLjNOdxmmGt9kmtsMv2/Wfpb - u5sBc+5mI/bCd6Mt12KDLwWcpie2RlqA7cQdMM5xd0OgneLW0//bpb+1q+kazA9jmCwC4mNs - AsHOcRdMRkhRMrREVoDF2M3Ua1n85Q1hd4vdQf9vmP7WfpqZOW8FRubSWqBrnWO6CsxsQmH8 - lH3NAk0iszF3aTXQvGWNRe/Do62Pf0v/b5r+JlXT1nO3QgizRlr4l9s7RlSNc9wOYx12gP2U - vTBh6n6wm7QLbCZsAzPbULAcF06BXT9iE4lBICYwG5ksLDFiLVwx2S32oevMRJi5MLk2gv88 - 0SlSnv7fOP1NauYxOzrEfU5M8cqADFjpnwGe8442KymIRp7kEi0G9CTnKOAN9/4Q0XUMPV5+ - +32/GTL9tZbNXZJQigUYmL88lbzmhoNLlCb9v3X6m8TNOyBrDKbjHpCUHKn2uc850qbMhaNL - DHCHrxaTKCpqllF4CEP0SSNHzApa4Xe6ihxn+vxjxQ7OccPo/+3T3yQLc1DmDATsFYFsqfeZ - VmUx6ruV/RaEePEHmA2M55X+2E3hEh7GE32UspLh5NlzYkTkWPOxRG7vcpD+FUP6m+TMJzB7 - BVb9Skjlb6lPesvL143llZ2jwcR0pVh01jOafenf//7fbDyULPqWrl272lhaLr/lE5hVtQSr - jChZFtL/KtDfJGJ+QTnr14RUw0xkhksTHYpa6qSBWBdmzJCUDdGZOwUPpYVOoO6PPn2ottmo - JSuOv8ObiRzzGM9hc1f6Xw362yfZqoAsZ/zZF1V3Lsposndca1wwyk8MaB0Djxtduyvr4eGG - oG9C/w59HDm+q9uetb6BWaKlPmcKHKYd0af/FaG/tU1iBGWZ+YXkXq+Nym1t/DUK9Ei/utH5 - ep9++gTUfejzag7vK3ZT+ad7r16b/swvJGeXr+85+kdp+lsro/L6THPSb5nA7BuU88kSo76T - vHQt0KoatrF4yAASjEljEP0bdOv659Sjl6zVyoCz6vS/OvS3Vln88WsChPl5bbfPT+kp11RO - erj5ug9AKw0a/QQPW5uSM0P3auS0fkKnf487+lvrjD384Y8+ITlH/4E5WaIwE58w9QAwuUs+ - AK2mZfcAD21ZcwpK6LMaObUhNbDT3+hvLdTMIb8YrwnJiUeYq1avy4QZC45JHGZH1xjgj6zf - IHS/goe3RXdEn9bE6ZEGozn9rxL9rUW2fHWqwprgnDO1mpkMk5I0zFS6zk48XVfdf2NRGp6C - BnocunYTp+iAbkf/K0V/a5H5BWUHom6uJECTqpw0YCY+2npDA6B1jTzP4ykEEcXT1PkpyslO - 6dXzp4V8Ltve0FCvH/2vGP2t6ejsnUoyGkUEZlLAcJVwRkOsMWi2rgHQqKEf4mmMaOzctLQ0 - RuhoD46Xl5MtkJHp+05DQ/2FsrLiNZm+vffiZlX6Xz36WwNDmC8SmEnhZO7SFKnATLSz9fiI - D32e67oBc+6hJk5tQK9ePQ999dVXVZMnT4aAgADYtWsXdO/eHf7zn68e43b6p/Dob+LmG3Te - rhbmBSvSJA6yg3MUmI/d1CjIdQorJ5o4vUE12Y8AhHpO36+/8v3q/7q44f8CokLof/Xobw2B - Ds4mWQ1qZLakiydEYgwbE0B1ETWu6cDfBNCnmznFPuh96X+l6G8taQjaYWTOI0AvWnVKKpqZ - jFipLqIsbg7oX4bqz5aj/xWhv31adF6b4eofcr6SjAppbrRJ24GOxZyzLzW8igx8JSNTTAQr - UX4sqQ/0LT3jeUz6XxH62yfZEu+Th0h0XrX2XPUEiVKI0A5OkZQTuGunKrCfvIfS1Wy+Vy3Q - bw1Y813of0Xob222vgOWDnCbHX2b6qzvfUZqeefm+0Rv+RClh+jNH0v/q0J/a7NpDpnhPHHa - tmIC9OzFJzoEaNKno3a0twFz/hr6XxX6W5vNkLXgqLltIJa5s6k5mTsCaCJDTAQrqoFmLThM - /6tCf2uT6RjNm4G6tchEsBzmL0/uEJhr3XTUmlodfVXbePZA+l8d+lurTFt3/mQj9oLrtdp1 - +Bj/Fk3VJS23sNv8oWGorOpJ/+6h9LdWSg3M+RqxF1URiJicJTDSIrBDgZ4w7QBmO5ZTUOsz - 5y2i/xWiv7XYVNVn6GMkrCDwmI72g7EOO6nJFDtScpCbieSqyTmhrqf/lLn0t5aZorJDD0Pj - +RmkqDF+ylaY5hHfoSCLdSm1CqmVHfe0jebr0v9q0d+atX79Fn1jYDwvkEAz1W2PVEaifIpX - z6BEAS3UNZzjSf8rRn9r0vQMZ/XGn/IUAsw4x3CJTkUgKbdz3A0MTnVfD0P2gks9ZfS/p/+V - o781sL4DxvVAQMIJKDbjN8IynzOdDubqhuFBYAs+lMFfKw0yG0X/q0d/a2AunntWWNtvqHCd - GQkr/M+C84y2FFDiYKp7LDh5xqDujqH+Js9JumFYdyYlPaO5K+l/9ehvYjZnRbKyX0jub7V9 - nV3bMOjV2TMKtq1fDD/HjIEnqfrw4IQRnI+ygAOhM2HxonAJ9+v4Z/AsSqTL9L+C9LcP5hec - 7ecXnHN2TUhulZdfBrjPbZ1uJtF4T8g8eHDcCIqzVECYI+4l2SpQmMOA+9lLIT05GhISsyA6 - 5jwEBR0Ct5kxbQJ6olMkcIatqpUdRfS/ivQ3ynxDsidWLz2cA/OWHgFzm1AQjFgDxuxlYGC0 - EDS13ClXVp4EigoTKFfXcKWe0xrsAfqG8yFgoUOjIIv5LxwQ3V4BFQVHoUr4DKpKHoPwQRQ8 - z50FPyfMhIObfGC1V0Rbq4ZV+oy5Y+h/NWluXMESV1v7kPsskwUwUGUCyPQxh5+6D4fuPwpa - 7D278WG/95DmYUYv/XUkiO6vg4pX6VAl+hsqC29AxYPtIPptMoh+sYGyn23gbfY4iESwXWdE - tThK184ZPVR/7lr6X1Ga2n//w2L/+B33KAL5tjXwNubyMlx4cHSQGLwkWufs0oDfo9TgdTp5 - biCUXrEB0aPNUPHmIgL9Firf/AbldzaA6NJ4CuhaL75gC9kxc8CtBVBTS7vVRGnU0VH0v7I0 - tR++5e7q9oOg8lNhJm5qYNwgGqdu0gT5vjxQlecAT48F8x0M4fg2e3h8eQuUv7sKVWWvofJl - JpTf8EOIx4oBTVx40RaStnu1bGZ/l2gq42HEWviU/leWhvbjN9z13X7gl0gC5h5d+RA4W6cB - 0A6jjBrs27enKRgOHQvOk/0gZG0CbA8Og2Nb3eFaoiW8yrBCyWEtBvXrLHvw8QpvUUeo8VP3 - k45TZVjdpH+nf1pJja80dRHm95KAmbgcRuHzu9XFYH6cPAgGynEb3b93j1GgozUDhpn4gZry - VHzOFJQHCGAkczgkBI6B0oviUCeGzgFr6y1g77iPWmOlObjNx26qGsqYHUT/q0wT+9e/FL5D - 3ZyGQFdJCughA03gTbp4dE4J1cJozGt0/369LcFIZyHwWN6gMGCc2DbG4GGYu7YSAzpzjxPw - jDE1p7cImIylMHzUOhg3aQ+1vFtjetrWYWeuunr4v+h/tWlg337NnSIpkGt9mrlhA7mxxlO3 - yf0JxBzGCmAZLEW4LcS2MYcMg2dp4kBn7JwGbMNloDt4FmgMdAYluQkg398OhurMwsJKBDXL - Uj2oi3UN3L+j/9WmgWFkfiRZoPmwY7l2A6DHsJhN6O1hlMwwZfuC3pDZ0Kv7CLHtk81GiEkO - ksbb7+8ODN2FMETdAwYpTga5fmOhz0+jq9+v2zBQUXEE3jBfavBsNdDxlVZjt+nQ/2p/6Q3B - r02cJR2d1RQ4cDNBVQxmkqbr35vXpH4mkdbUxBdUlaY02H48zEwsOr/NsgUXu7mgh69RU5mG - 0d0eZHqZ441h2uj7yw6wBTZ3ZZWVffhi+l/xL9i+/g9bq+sP/IeSBnqYoTFV0q4L9N5V2vAT - Zj4a21+mtzkwUQtzmaso2VB32yB5U7iZZCkG9JPUccBlLARtDU8YqDgJZGVsoFePkS05t5ff - fs0LpP+V/1Kj8/e8/ZhzrpI00HamzAZyY5GjftMZkX62CPNKqoHXFyNt3W2jWcPhTaZ4hiNt - qyMYDJ0LmoNcQFG2+ehc31FeVaIX0//qf2kNwf+xJ0oq51zfbXgNgd6yGCN0t8YjNGnQmbJ9 - QEdzJvSsp5+XOY0Sy0OXXrSB9fNdqBQfkSetiM5iTn8C6ln+6b5Gn+u5//At3xNhfiwNmGtT - dvVL3q/TB8LhIC0ImK4LLlaGGHm5oKo4HGWIKZWlECDQ9fVzr+4CSN9mLhadX2aMhXGjPUFL - 1ZW6Efr2MqNy1q05v+//y/OnNbxnOV3+L3aunHzt/8/tuvz7WZr8pM/xs9g7hHG5/CU3eYJl - YGYVAKPM1oDpyIAPPmzUWjC33QwWY8MpH2MVKradw18NTPYyMDJeAtpDZ4KauhOVUVBQGA8D - +ttCn55jEERTCGqkSviPD4RX2aiN0+dBSuxG8F+9G6aOD0Sg7cXAMxrcMF13OcYeI7knqCqT - 6GyLUX94q2+4bv/l0aezUvr6QT3OrlUTW5Tx5vHew7JClM22L//JpOCU/OnHqf35tUDnn5Ad - mX9SdkJn/ky+QTmjfQKznfyCcxPR73mvz6r0WpMBC7xS2zjypF7hwjUWJk6LhHGOe8HafiuY - 22wCh4l+8FcStwmg1aD0CoJ6zx8qXqZBRckTeHnnNFw65gPbV9nCFEzTcfWGQey6MSCsVyHc - 4+OI0dkFVBQcavLVpq0GuiuW+GkB89OU/prkMSNIayt5zEvs0/fpyQEDC9LkjlyIUFx1IUJB - UJAmX/o0TW7cs1S5BRTQqXLx6Ps64+exc/RT9w3O3r8mJPcJgly1KuActe6Jy8ykdhnfR0ai - 3DnGagj0eS0o/cMBRA9DoeJ1LlQi0BUFKSC6teZDD7u3WdYN+nAUZtuA5/hpmKqbQhViSLqv - LZLoh285G794mO8c/MEkP03+8qvkXoyzwVrbf907wDg/VXYzwpqAj1vuHZKLuBCu6Pn8lILw - +SlZt2cn5aixagh47o1YxRMJy1UX5h/r0+EzxxubOv13issWVb/g7GAE+RHpnL9izVlYsCwJ - ps+NAreZkeC1cgt4ztlPjSYh4JGxfR6zD0p8fB/x5UtC4WLMGMg/pQOFmTW6+oIBlF1zh/In - u6Dy3e9QWfwQyp8lguj6skZ72NX6hQP2oD+4OjoP6GvdJrlBRehvuaG0iNAFqfJpCOit9GAF - nYxgrdgnR+VmPU+Tf5eXKncGPe/wioHT81Ply56lDFhKgC5I6aeL22+djxj46NAKjScYyd/k - pfRe2hHnvtgrtavP+vOzEOIXZNEeMvZv3rKTMM0jFkLXBkDk6iXwZPEoeLeEA2+sOfD3PB5c - n28DN/ys4f5WC0ib4w6p26eDF0bVlSvDpRa1583bDrtDV0P2sfVQcOsQFL+5BxWFN6D84Q4Q - /eHZJMz5p+2AqetWUxW0hd41VcG2Ac2jB9B5JwY4IdBFl2P6qGYED466ul/FGf8vxCh9tuCU - QnlWmMquvJMKlQhuKEbtVXkpA2xx+9P0kEF5x7zVn5HX3j/x06S3UT/2keZ56uoG/3vxyowf - VgXc6L3K9yzDOyjHEyNxCsqKcrI2IFmBynlGAkbkfRAbvgj+9B0Hb2cjyOPROXWcW/34dioH - Cjfh3w7oW/lw2WU8THWT/rReTtPjYdWaFIiLSYObWVvg/c/OVH9nUtquLXEXXxgLN5LdwGfx - RmAxlsAgbAz272tFlcvbCnS377hbadMoRFjT8lJkV59Zp+6QHaYZhZBmIbw7n5+Sr/xlu9Lp - u4mK5fj3NoR8B/r8vJPyL04FqpamBKg+xH2fPUvpJ9H1PVavXv2v6eHH/73a74+BKwLP2KwK - yVqM0XeXX0jOZYzE5avXZsJSn3RqxVYyi5HzjEQKlrVrQyBy9zLIH20Kb4bVA7kZf+vJgReb - htVIkPadU2Pm7EjYHLAZjm73hrMHl0BixBoI8t4Bs2YehhkzjlLu4hILZqODQHuwR5vyzzVA - b6MN0IfW9hyBmYx7f+xTZp8NGXzmXpJCdH6abBzq68c3YxWzL+9WFhWkysUgvHvQtz05rlBx - MkCtIjNs4DsE/AwCPfJTjr8y4KyuT1D2uiWrUrf7BuZsxaibjl6AEFd4+WVULlp5qoo07Dzm - HoGpHk2vZTLTeQ/8NmocvBnRcpgpR/h32nth9IzukIlipqK7eaLen34EAT7yAeS6TrYRn+Sw - F5iMRSDbz4b+QNe32PkqtvHLFPTnTvzv1wjqa4zSPtg43Hhlj+oR1Mn3qhuHcnczN6r8nX9S - 7hgBGiWH+4MjilXJfupVl/coV+WdlNv4LLnPR2fqmbvocFefoCwzn6Cc9d7B2WGYVtuBjbhM - lA15KBmKMKVWtmhlWtWcJSfAc/6x6tRaKyZE9HA+APHWc+Fns4lQMAUjtCWCOqplQD8NGAXr - 1gR3+AxILh6JNVAfbdbJPu7uiWBjvQl0MS/ep+do+gNdawmLVZft8RwwOj+1/1wE9t2NKCXP - zA2Drz88ongfc807MMMBOZsGvnt0TOEibt+HgIfejFUCBBruH1aEvFTZxWcj7cx8g3Nd/YKy - tyGgYX4h2Qcxwl7Avx+vXpf5aplPeinCCtWwHqVgJatGNRdt2+oko0FmKAoOCoQF83bCrrBV - sG/1ckjz94Ac68nwfJYpvODyoTCiGuZ3qzmQGz0NXDooOjc6QQ2C7Tn98EfBrnUPjySYOHE3 - FbnlsNBDa6B3eMgNTFiqtv1OxE+KCOtV1Me52aGaUTdiBpZjliMBIa64skcZrh5QuoTbj6Gn - XtmnAmnr1QD3rXyULLfBzoo9Y4y5/R37ibOFzp6BVc7TtyKwe/EnPBY9EcHtKDjiKHedGUVl - PlauCIc1qzeAl1s4RM1ZBOljnODqKBvwnxuM5xjbqearIzLEFWVIS6GujdzTpkXByOH+1BQM - tNXQsUtVhh9aouL05Hj/eQhw8dWDKlv/PKBajn/fxQbjX7fjlSB3s8ot/Ps4Pnfj4taBgGk7 - wL9fFaTK+svIyHyvpqapb2LCmc3j8X/m84dVCkzHgMDUGoaPmgqWdt4wblIoODjt7dDZ7muh - nVqTeyZZjenOmJt2jemUkzDWyhDPFsiQ+mA7Ou4DtvFSkK2J2LQCmljiUrWkcyHKUxDSq09P - KFz7eavGtYI0hQqE+Cw2AqvSAlQxRSeXS7Ia50IHwV9RygToh4+Oy86p+z6ysvKqJiYm4xHs - RD5fUICPVQg6sNg84HAR8mETsUy8DOwdsVTstK9DAf9cXLzR2Dqwp06NBB5nJZEiW2kF9C7X - vuzEpar7f92htBezG69+36eafztepQolxp9Edpxep1qCDcOHz1Lk32VsUIWHRxUBt11GDT29 - qffkcrkOfD4/DaHOQrgruVyEmsMFNtuEAtyEYwYmPDvgD3eC0ZaLwHZCMEyYuhMcXaPoD3Ij - Ps09AcE+REXs6a0Am7irS/xfbm6H5w0dGtGVPtJjgRIjabnab9ciFW/filMRng/XRGjl8xHo - sosRKvAkWQGwsQg54QPJ8yKM2L+35H0R5D0EaIHAFIjj3xituWBoZAh6+nqgo6sD2kO10YeC - vqEJsLm2MNJsLgX3JBf6w90o2B6H2hCxjwo9PQ8HKCiE0GdC9MjFKnYnfFULsZgC2WGD4W6i - MuSnyb3866Ay3I5XhDsJSnBljwpQ1cQ0udsfez82m62DAItqYa4FGqM2sE1MgMFggBHDCAwM - DUBXTxeG6gytgVsb/2cAi2ONcM+GsQ5hMMn5IP0lSj2w3VspRXDfMnf3w2sVFdO+pQ3USUtU - N/y8VaXyyh41+HWHOonGQgL4pR0qcCNGCW7FU3KjCCP0pebex8DAoA+PJ0iuC3N9J3CbELCZ - 1WCTqF0Ldy3Ytc5kjYEJ4+fBnNkR1NzL0uhY9Dm6c03DsaVg434id/dDAbQBertzjz5HV6hd - xGwHnNswBB4nY745RQEyggfB1UhleHRMEUh+GqGO/IjUmCMQiEfnppxEbBabTUFd6wRufQP9 - OpJEG0Ln6cG1GDac22UFO9fNhXlzt9Ef6to0X40MmT6jRcWZYg7nwgDaQB23RGXJoWXq5WcC - NeGX7SRKK0Cytxr8tpvIDQUiOcqxauja1Osx6upxOLxIjMBPWwJ0fTlSH27ii6cx4fVpPjxP - 5WJRhw034ljwy/7hkLp1HMQFTIUdK2ZByBIvWDp3I160XXihY2kLt0cLCjOenkeeurnF29EC - aOvB3/4ncbGqb5KXBpwJ1MKshhIc91GDP/crU9GZ9LjLPznAqrn30NTU/J++PrsHk8kcjqm7 - lQhqMgL7qKVgk4wI09j4A9Cbl7Gh/PwwykW5w6A4UwB5JzhwM5oJ1zbrwV+b9OAq+h9hBvB7 - mBFc2siC9PWjId7XEcKXLwD/Rb6weE4YZgoO0AJsJ4+PaewjVQh1Jm2i9H7Lb747ulL10pEV - GnB5tyolOe4nVcuNglS5i9d2fvNDa95PQ0Pje4RbXltbh2liwgtAwFMR3GcIcGVTUGPaD9N7 - HArs3B0cqLgw/IOXZmMZm0Tr/UZwI1yPgropJ7D/iaBfCWVQoKeutYBIb2fYtGwR+CwIgPmz - t3yxmvxD47HxzEfF1KkJ9NHTv2+R90xerVae4qcOuRGKcGW/PDw8Jg9kRMunvreurm4PDoev - bWjIMEd47zcXrR2s+VCYbioGNPHyLFMoSWRBcawxvMVIXbDXCB7sMIBbEfrNAl7X/wgzhF8R - 8nOBIyDBzwG2LJ+HkK+FOTO3fVGQk8ZjYxEb/3/r7p40gzZQX96jmLvJRREWWsjAAnMZ8Bor - AyEuMssleQwOhzMDI3Z+41ALYNsyPiUz6gMtOsOHskS2mAsTWFAUZwzvoo3hBUbvRzsN4DYC - fr2FgNdCfnEDByO5Jexf7QrrF6+i5MrUL0CXVxdokuo0Hon0SEqiDdDTh/U55cHvW+5pKgPz - RveDRZYyMHd0X4kveSArK9sbq4uzMSLn1QV6zAgB/J0qaABzBWrpsuOcBkA35aUIekm8MRTG - YCTfZwQPMZLf2ar/UblS169u0qdAT1tnAXtXu4PfwjXYANv32cONab9Kd/cEX1oA7crt5bLC - Tub9wQUqELVgEGRtViy9Gi17J/+krJk0jofR2gLz17m1QC9zaTw6l6OGLjts0mKgGwechYAb - w8sDDLi/Xb/VkZwAnhE4Cg6udgbfBWtg5oydn2UUJ5kRZ/fEQktLry+/ipge2M3wWoz822Oo - pZOWa8DJNaoPn56Qu4KVwuvSOqa6uoY8Qv07yo3KuAA+ldloIDdO89oMc1OAF6NUeRtVHcEJ - 4De3tBxu0vDMCRbA3lUesGD2ZtSskR80+BJMJRJN7uTRuUv59i7Ri/rJ6f/3iwY6P3VA9IND - SnmHlquXHfdWBwL2rXiqs/95rBaGSOu4ampqA4cJuNt+2y8or6gHNAG8LJkjUaAbA/w9Ru9X - BxnweFfrdPiVUCNIDrCFwMUrUJLshZXzAzGFOAoOrxkP61CPe0zf0ymBnuwWJ5zgHLVQc2j4 - lxmp/z7Re33eSYWi37YPepO8Sr0yN0wNjqxQJ/2j0zHTMRuhTpTm8YuijfqXnjMtaRCdzwmg - 7BBbqkA3BvjrSCY2NBmQj9mUx7sMKcg/BndW0HDYuXImpggXUtqbRPJMfO6gtytEeM3DaL4F - o3nnKeUj1BWObrEJdo4Rml8UzIVR38thASXvTqzyk+yNapVHlqveyggYVJWwULUsdtGggOep - faVeOi0/zBA0aAyil53ktivMH4P86e6Pw02KPYf8JsA5hLn+ttPrzVGD+6OWjek0YDu6xmVO - mBSj+sVF6Quzu7NO+qnG7nVVnrXJWvHNJhvFkjBrhQXtcezSFI5Xg8YgNhDLjph0CqDrw00y - KM8Q7uYyJ7+HGlKPjTmJ4IGLV4KLx0EKqo72Sa7xEV2kYR1t/gZdvtpu1WMgAv1ws40SbDRv - uh+HpAyC+/6n7JTJvgZAd4DcaC3YJBf+JpIBTxDuW800LAn4b6MYVL787tbqCE/K9+eDuVTf - lI5uRE52i71n5xTJ6fKl2iYrxQsE6DArealPLQVHDXuL0vmXGujnU7xOC3NTqUGiue9ta1yS - kOeFuA/x19gAJYUgAjrR2umYEty4dCm4dlz/kypH19ir5nYHh3yRQIdZyvsToDFS/7ZuTK9e - 0jxW5Sk1JSxtlzfIbnRCudFSJ5H7PZbpn9aTJaTAUxLHErsRinA/kl0h+12lUoJ82LB0GUbt - 6A6I1HGFDi5RPl8c0D7GvWwR5gr0JxstBlhI81hlh41MyusVVMozsZiSxP5sgRbT29HVertW - kpDcd1Opw2d7qvcjJfmTa62wQulXk+duV6iFDi6RX9Y809gYnIkwv95srShE+eEnzWOVnuS4 - tqTvxucONonYBFjSqaoECzvN7Uci+/XwarBT1lrDGiy9tyfYCLVoknOs0xcD9EazAdoI9E2q - YWghN12qQJ/mb+is6Tpp+N8HqxuHBN7mbgDSq/DRjmopQsCO8naCWTN2QHul+xDq1/bOMR7q - 6pe//UIahgrJ1TpaIUqaxxFl8JO/JP3cEie9BJsDui7Y76KrS/REf2cHD4Non2mwZpEfuHvu - bw+oSx1dYmNtx++coDTU4uvPG2hLheUEaJQdN6R5nPJMwdX6fZ87c7quo7wYG5N5KFlIvxPS - Wer0OjNYPCdUrC+JFMF+7+Ac5f1ZA73BQs4DiyuVKD3ypBqhswSvxfRzBp/+ADfjRGM/2VWt - scnonBNrbaisyPQZu2Gau3SnO5voEjNTU+czXSg/zEJ+EsL8Ar1Uajlos75fke6h4r3r6A90 - y6qVxmLFnMuhTIjycYIlczZSUVsa3Vup/h+usTGsEV7yn2HDsD9pGP5FZEeIRV9FaRzj/UGD - nvV72H1OBZUOz3djkYb0Enyw3UCsiHM+hE9p7YBF3jX57DiJyhJHt7hHthN22X5+UdpKIYkA - HWop7yWVHHQyU6tByi6N/kC3NlpTfbxRipDGI0n51VYrSRXyl41sSA6wg+CFM8HMaiGYWy8G - 2wnrYPyUCHB0jf6UaF2Gft3BKXrO5yQ75leXwOWkstJ/aRrXpAHQqfQH+pP7mGDkLophwsv9 - 1aV4ordTfPSBwWDWOAuYTBMwNuaCCWc0mA53hDGW88DKzhvsHEKo+QZbWjJHqN+Nm3ow6LMA - 2tu49zAKaEv5nVIpe6do6DcA+gSX/mBKWJaQ8vrlTUxgsdgIMasO2PXduBp0Fg84PHMQDJ8E - oy3mgvU4X7CbtBEcXSKbiNbxlaitr0+cEjuxs0sOa9TRzzEnfUEqETrZmN+gqCLlESp09RcH - 2TVzoFTPWkWmPSZzetc6mfCHPFfXyXPUdnzkcE2BxzeD4SMdwMxyFtiM94Pxk7eIyRZSNp/k - FDPf3iFmYOfMRZvLqSHQV0jqLtC8v5rEgT7OHt8A6C+8qNJhFcooNrRmurbm5k+pdVPTMTB8 - xFgYY+EK1nbLYdykDTDJJbLcxt43afDgwX07acVQfjsCXYINw3CJNwrTOCsaVAnpX1SRGtDD - hwkkAnUduCvJvIZksnsej+eDkmYsh8OREViEdvwAXGHuQKWybJ6LKEewuuIcZ0xlrik11izU - Sm72ZhvFqmDzPvMlXlQ5wwtuMGVBB11w0p952xx98HXSpXytiy7snKcHu+frU37Sz5DyNPRf - Qxnw5+Zqv7OdCXd3VPvTvcbwbF+1vzpoDG+iWJST9+5ooN9Es2GcuUASEJcTiPl8/lkmkzWT - zTax6nRR+H0GU1+UbfpLWSq3iprU5SS3UpTJ/1WUyRsV5azECbdVgjh31eMVZ1jDRBkcia0o - K0rnRTYYpdJhFTgWzBo7FPSGalGuPUQLtLQ+7ixDLWAbDqbcnDcELPjVPnGUNkwx04ap6DPx - feeO06F85WQdCHTXpXzrHD1I9jZol8/3FoG2txB8CsR5XC5/r5aWtgPqavNmuzM8ku1edpFl - IsrleYlyBf4VORyzdoMZ3Pr+u/w8P6LsGKdK7EsgP/2p3Nd39hkFXFqjDW8imaSPclXZUZPn - ZzZo20gE6HOCRDGgO7DsTTrlXw1nwLl1RpSf8DWEQyuqPWapASwYPxT0df4BmUDvbKkNjmOq - nQCsq90QeF3cz0jvHyf76NQ42W4tGNJpgCarMKC/R3+F/pjHE2QixBFaWkMnsVisBisJw5Ve - 3YQ/s03Ls7n2f2cYKFHtonPGGqJMQYzoFLeUauCjizL4RaKLvPaZVw9yGV+XpfHymrzQR0zK - GuQ6j7NPl98e8EkL05TFG/ZEoNPrTvkl6UllJOW3tjFgmPHgBrBOGq0NF0Oqu4Le2saEYayG - +4xkD4a9C/XhyiYG5elrjeCUvxGkonSJXWYAx70N2wfoGHbVeAt+IUqFmwjpYTabE66pqRWL - 4L6tgfcaWdUM3YvL5X501eDKyz37o2Q8LjrJBcrTefcqNmpblaVy/iw7XO/4GBxFadxXZdmc - WdIH+rj+f1FmXGll8v6xMJYp9ynHLYk3lC3PFOTWbRCKOmE/aALrkolDm5QcDhiZ38WwYLmj - TpP7WGEUbkl3Uel+DnZhSQJDYnKx9BR3YYMGfDqvvMlzwF93vN7n2yVKi/aqz8aDVrbi5zlH - lGjc41OOWXSYrY0/TX+JAd0JiyovsXFngdq4OR1NGoYC5uAmtxOZ8WSP8RcFdEmccVCrjp/I - LhKmcttnaJfIstePwnjj8y0+uXj9Ty51osbSxqzGNbGU3bHOV1R5fsCYauwRMDE1BVu2bIGE - hASwt7f/AGxOoBFwjaqBHjNmDCQmJkJ6ejpMnjyZeo7o5esRzC8K6MJoA2v81aloOTPGl8pX - 9+vebo1D0XFDb2zwiRo7mXdRTKqDOfV/Aut+2QVl3U++w5PZLIzQD8SAPtz5iipk/unxI4aA - trY2REVFwfPnz+HFixeQlJREwcrAht7jXQywEQwGHR0dSElJ+bBPcnIytY+hrha8OPBlAV26 - R7dXSbxxSgtl2yvhXlXT9sk/p2pxSjP450Qp3LKmRlrfC9eHPZNU4MCUgfByn+H2B5wu/5KA - BhtZnmX6vLMXVUj2I36ZLrCMmZCVlUWBSvzixYswFFN7oR7aVKf7xOW6wGQYwvnz5z/sQ/42 - wMzIRtxHGP9laWgqPRen79CiYx/n3MtPNtkkfZjPaH+H+eZjH5sy4O/9DNg2ThnCbZTgWpje - 30WnTXifDPQZBDq7DtA5pp22yvYGf6G8HIZAoN9SuH//PjwvKIADOzbAjtlDPgx4JdPzek0a - Aut9l8H169fh8ePHsDNsDe6jTe3T8Y1byQNdkshoEdBUoDrJrRDlmkZJN8NxQdAbc833P3ZC - hfizG+2sCqTnXe6qIVgAYX/yjEqlp7mjEOiXH3rZZQk6dZfM+9sMIMNfH7I220DutolwKYwL - z/eJj94m+6Sv0YP0DWaQtcUOU3rVfZQ7OsMhLaDL4rWXtuo80njvy7L40us/Lczh9ShL4fzR - ki6IJ+ZqUEAfmakGpckm70uyuAsqbqv80PZGIc8BJYdIbOrcTt7PmIzAJtGWQEpu8ub2IbCT - YVKd5/wlC7Qoi2NYegJzzq05hyR2WXm2IFJ6EXqK/P8rPsxqUfrlPEZmAvRe1NKUHjzOKUO5 - srcym6vTlmNXnOZPrTuekP6DYz8foMtz2byyM7zfWzu7FabuhGXp3DDpa+l440BMqzzCCCNq - 6mQebzWkgCZesLuOJkzGzEQG/6Yom2sEZ416thjoswh0zjCpLT1Bf2/w6/GuKEpb+ZOici7b - Aa/11TZ28a0siWfGt1va7u2egUNKE4wTUIJcbSzbQFJ3pGFIgP4zUOcdpu+qxER/GmZJsgRn - RBfYEypvq8q0Gmj6D72SdoR+3aZfcacB/32fyx1Sls0LRjYq6rJB8tDo5R+5kcg+b4RxzH0d - 0vMO78BTjQFdFEMahoMooKNt5faWxjFPNPgw5CcoBat95/jPyrM568ouD1IqOqv/9UeBJlXC - 1E5Y9kZpVYr591JMywkxj1y0WR/erR0Kb1F+NebvN+pBUYQBCPHmL41lUa//XIEuSWd8W5qi - xRFl8Q6K0vmFWKOoD2op/rJnoIc2edzjJsXoB3Bfsw7rSlp2inuoiYZhxcn5GkXV890p+lP7 - 7tWYiVH970Y/zDETatJFbAT8VpEtWFfxq+LwpoCmctCdqOz9PlQPXmHjN99aAR4bysB9xZ/g - zo8/ttx7dIUH6r0gz0weXi/ShOKdhp8N0O9zOGoVv+tOw6zTXVEar6pBR6NqmB+JVmuMI/sX - x+lxmwaaUyE6b+rVoX2j38XoW+EJ/yV+cqwqYYLx6WgnlZXUoFlzueAPX0CM/lhRtK4/vkbY - 5Ac7alKFEbgcZUle2WnekYoMwWHMamR1BqCFUcbwZsVgeIG/PgV2SvBwcB+40+3H1gHcnHdF - 7/4jPNTqTb3/qxlqULzNsCM09L2GjTv+ZMwNp4iyTV+UnWQG4fU5jxAXi05wKxp/D+PzeXs0 - lr2P1TD4kH7drdULn/+tiazGY8yEjOnwDv+vojXlhXFGi7GheAa/iN/KEpih5dED+gWM7qlR - Pa2BwpG1I7uKTQn1PtbAFve92+IvGX/CxIBu534cREq8CxgKjxn9KOAkBnALAL/XvzvkmctD - 4QbddstRCxNZN0TnBRGiC/xwUY4gpfycIA9/Qd+hRBS1pMsB6evzdL9eo5Pflyaqm+DnKK53 - A70pizPoXKPAC/cP6iWMN1Co/X+DhWzPTdaK78OsFa9uMu/bp8H+kQaaWN/fXxLHKv3ol4x6 - m0zM2BFAF2Ep/9kYObjbp1v7gdyI35XpDvljFSmNLvXPncQuxyJaCTUi6TC7xd0MEMxCDG5r - SvcO6d9soeygxggMgEdwf9TVzLCKeM2hXTq77eDKfLPJSiEHoRat5/dsNAVUeKRvt6e79O3/ - Psh40Gz/hfpAH22fjkmvF2vCfZWeHQpy/Yj9bLQcFG837GzzeVQVxTKvlCYxTcGiR4sGvUJo - v2/f7x/Su8vnYqt7dvl/YVZyu6pXyJJptj/Ho+06ox7vMsh5eYBRTiY6afDTWh/ow+3Q2AvT - g7u9unYemOtATTT2u7U6naIzVmEMs+Lpbj3/tzs0v8xFhOqaz6iuYzdbK1WEWbRsueS7vjLq - dyP0ZqJffbLLsJwsYEkAFx5qX6BfL9WCOz+1EuZu3eAvfLz03Xdw6ptv4NjXX8Nh9KQaP1TH - k/73P8rJdrJfGu5/EV939fvv4dYPP7QY7Kf8ASA8yGzP7Ac1ATsGnioMQE8fbTfwf7hNT78L - XWyu8fdkHcNybBge9R/+XYv7ctzerKF1PVQ78E6E/sv72wyqnu01gtKzgn8W2ZTiIkEkh9wa - mXFXRQUe2NvDk5074bS+PiQgqKcR0PPffgu/IaR/IKTXENLrdZz8/zs+/ytuz8H9yA1wGF93 - CD0ZAc/C58jrbnft+lGoX7qrSrWxKKyzgD9Ziu7+doNXd7fqbbkbqsTuQkdDoN+h395gNWBQ - a197Y6vusFtb9ELubTd4WHKGX/EBaCl2Kvp7rkZ1+qwZkG4jkLd694YHEyZA/qVLHzrp3/by - ooBti5S4ga+7jICfQ7iPItSJCPS95cvh7pAhmKvu0eTrHqj1guK9DMnOO1IDMEZiasJ0hJgs - c1F8N0L//O0tOlO70NnCrBXOI9DCFXq91Nv6HvkxbL2yTNN7UgcaG6bPRsg1C/I1BC0Tocsa - PfpD53wCdMHDh/A4NBRvBsno7uujRkHB06dQcOcOPAkPh3sY/e90797ovvm2ilRqUVKygkTi - O1sNKL+9Vf/1rS36sbfDB7t2ob916bLRUm5ndT5ats1rGAqTGCqiLNNL7QH0Y6N+jUJDtC2R - EUQapCPQf7FYFMj5v/8Oj9euhXsmJpSOllTj73FQ0IfIT900eMNcd3WFm439AnTvSpXRJfQr - VfVst2HZrQiDvD/CGdsubTIaRn+KxSXHewpoa4U2D6spitfvU55telbaQFMjTlYMEav+EZAz - EeQUlAFE1/4DEUbLPn2kmtG4x+fDs+RkeJ6fDwV//AE3tbTgaI1Grw924UY9SQFdjIWR9fQn - twnbZKP4ggCNOem0zaN69OjSBiv9q//XWP5OljDQUNbII6Wj52nAfeWfKJgvI8R/tiD7cF+h - Gzxj94IX42TgtYcsvJktB4VLFcT83WIFaturKf0hf3gfeGLQEx4odW+++og3zv3hw+GhkxP1 - PwGZNCRTEeprNedEdLQwUjLZDtJ1tDiBKdX1Jj9rwwh9GVN3ZIWsW6EW8tptfZ/yTNP49gCa - eBEWLkgnI6KZb38E5KcI8ZuZslDkrwQlQcogDFEBYeigat+sJu6bVKufx31KgpWhZL0yFAco - QeFKBXg5oR881ukJd3t+XIPfrpMpeaDRC4pQ60oq04Hv83dJrJEZ/cltwsIs5YNJoxC9LGj0 - T4ZtfZ+yM7wt7QV0nrXCR6F6OKgHvJzcH0oCEeIwBHXbYBDu04PSGAY20IyrPb6e1z4fy4TS - gwYg3KtT/bpwdSjZMBCK1yHcKxTguZ0MPNLo8dFsS21vvberJTfnHQL9oijGUJv+5DZhXoN+ - ILloSnZssJSb3Nb3EZ3hrWovoEklrtGcc0+MyMxelGQoCsBIvFULSg/oVwPa1ghJFvIhsEfj - jbBPF4Q7hoAwQhPhVoG/XQdQMuZe/+ajNum2WiqhMYn4OZ7Sn9qPRWkrhRwCND5ubXOEPs3z - aC+g8837N4T5px/hxViZalmxDUGONqJglMo5EMgx0gu3D4YSlCfvFsnDE6OeTWrtB4N6SkxD - YyHlZ/oT+1HZIRdKNQytFc8FmfVtU4cUUQrXst009NpBKCn+yfne69cVXjr2Q7gGYUTWkx7I - jYF9wICSJMVrleEFSpHGZMizYTIS64UnjGem0J/Yj9hGc9n1CDRpGN4JNZdjtOU9hEdMuO0F - tHCvLhQuV4CHaj3gse5PVKOvBBtzRPe2C8j1ZQDqbuFuHdTZg6hGaF2o7/buio1KFUq2SAjo - PfQn9uMNw2UIc+EmG6XSIEFPQZuyHOcEo9oLaBIZiT6mMhbEN6tXS4wOgFkM7EhDzKYow1OT - XlRPQCKDCsz7gnCntsSyHCVxjAD6E9uy9N1DIjs2Wsi2aTYc4WmOQbsBXetxqEvjO88EMBTU - sQzqBvtws6HOlmTnpHf7h/rRn9aWNQxP1zQM2zRnWWmKiQoFdDv1h+7MTqX+SIoQpRHJsEgw - ZVeGVcKD9Ke1JTraUj6opmGY05bXQxKjF5nCgP5AS/FGSWAVlsQZ+9Cf1hZY0JgByzfVNAzb - XC3MpT/QUgb6ZUk8cyL9aW2BrTPry0a5kRRqKR/SZqCzTYuqB8nSfwVZqQCdyHpSFG88lP60 - tpMh0FcooOm/xrd00pUJrKv0p6wdTZQpOEkBfZz+QEsF6Hjjk/SnrD2BPsvfTQGdwqU/gFIB - mrWT/pS1o5Wmc71I6o7+s49Kx0viGSvpT1l7Ruh0EwsK6FP0B1oaLkpgrqA/Ze1o70/qamDq - rpL+M/hLx4vjjX3pT1k7mjCdpyTKNi0QdfI1Vj7btB39c9Dta4UprJ6Y6chFqOkPoFQahfr0 - z0G3p0Fw3/+I0rn7qEwH/QGUsLOq6E9YRzQMz3Cd23MGUhqVvV/Tn66OqBYeZ7II0CL6F1ck - Xfa+R3+6OgLo1ardUUOXdMaFgz7zCJ1Bf7o6wIqOc3/AhuGvZJEh+oMo0bI3/UeqdJiOzuCF - lWcKqugPosSic8n7WMZU+pPVUbIjg8tHHV3Z0rU/6O8fA9r4ekkc/VN2HZe+W9T9m/Jc01f0 - z3RITG7Qf9hVh0fpXH6U6AT9G4YSkBuil1Hq5vQnqqN1dK7pMVEar5z+UH6y3MitOKAvT3+i - OoGVpXLv0x/KT8o9FwrjmXPoT1JnidKpnDP0B/OT5MaZ53u0fqI/SZ0F6CzTM9Sqp/SHs61A - Py5drWFPf5I6iVWcVZAtPWZym/5wftK0Z+XCBOMY+tPUSUx4iJVOfzA/FWp2Jf21dCew0njj - X+kPpCSkB7uiOM7Qnf5EdWRkTmBlYiu9gv5Atmn+jfMYDO7X6GgSnVOKt8r3oz9VHRmdE1jP - UP9VfWKjqJis+vQZQllFpu3CHPLF4jhmMP5d3lSnfdTHdwi04pM9MqeIIg31SmKNnEpi9Mbf - DlKWoz9RHWzFscyJeKFe1YHzOV68K41Vwpop+R4XHRw4sijGwBnhSMF9b+JN8pwA09mqeej5 - 6H+UxRtvLo7UH18ax3B4u0uzf83NfbOJ190vjGaY4Oc8Vgs4PvewOF5nAP0J6pRRmrkDL5AQ - /VdhAtOpMM5wBBW5/2nBF5QlaLjhc0WNFBWKX+/VdKn7fkUxRrolCczJ+LoIBPwkWUCnKNIg - sTjeKBx/omPwhjmNz13B7dcILOgPqBsAnawehf4e37eI8gRWYe22Rjyv5vX3sEF2Df//A6E7 - h+9/CD/H7sKYoSTqluIxb5QlGCfg8+vxefv3kYaKjcqvRKOVKCPS8TVva6J3Kb7f6bLIgVRK - rjDWUJNK0SUYv0KtTP8ljj8nK4xirKyB67fimOpRzAipP4JRUBt5yXAjYTxjSVuPkRLc939l - SUxNYSJjaEkiYwJxhH6qMI7pgyD5Ey+JZ66s3VbfixKMzMjrSxOM1CTarsDP9C5Gz604gbmY - /iR8QdbYwpGlCYb2ojijRcI4xqo3cUOs6f8t0d/ob/S3z8L+P1PYPpP1IB7GAAAAAElFTkSu - QmCC'! Item was removed: - ----- Method: Form class>>squeakLogo (in category '*MorphicExtras-sprites') ----- - squeakLogo - - ^ Imports default imports - at: #squeakLogo - ifAbsentPut: [ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self squeakLogoContents readStream) ]! Item was removed: - ----- Method: Form class>>squeakLogoContents (in category '*MorphicExtras-sprites') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: Form>>encodePostscriptOn: (in category '*MorphicExtras-postscript generation') ----- - encodePostscriptOn: aStream - self unhibernate. - - "since current Postscript support treats 8-bit forms as 0 to 255 gray scale, convert - to 16 first so we get more faithful results" - - self depth <= 8 ifTrue: [^(self asFormOfDepth: 16) encodePostscriptOn: aStream]. - - ^ self printPostscript: aStream operator: (self depth = 1 - ifTrue: ['imagemask'] - ifFalse: ['image'])! Item was removed: - ----- Method: Form>>graphicForViewerTab (in category '*MorphicExtras-other') ----- - graphicForViewerTab - "Answer the graphic to be used in the tab of a viewer open on me" - - ^ self! Item was removed: - StringMorph subclass: #FrameRateMorph - instanceVariableNames: 'updateInterval lastDisplayTime framesSinceLastDisplay mSecsPerFrame framesPerSec' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: FrameRateMorph class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - "Answer a morph representing a prototypical instance of the receiver" - - | aMorph | - aMorph := self new. - aMorph color: Color blue. - aMorph step. - ^ aMorph! Item was removed: - ----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'FrameRate' translatedNoop - categories: {'Just for Fun' translatedNoop. 'Tools' translatedNoop} - documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop! Item was removed: - ----- Method: FrameRateMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | - cl registerQuad: { - #FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. - 'An indicator of how fast your system is running' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: { - #FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. - 'An indicator of how fast your system is running' translatedNoop} - forFlapNamed: 'Supplies']! Item was removed: - ----- Method: FrameRateMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: FrameRateMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - - super addCustomMenuItems: aMenu hand: aHandMorph. - - aMenu add: 'set update interval...' translated action: #editUpdateInterval.! Item was removed: - ----- Method: FrameRateMorph>>editUpdateInterval (in category 'menu') ----- - editUpdateInterval - - | old new | - old := self updateInterval. - new := Project uiManager request: 'edit update interval' translated initialAnswer: old asString. - new isEmptyOrNil ifTrue: [^ false]. - - self updateInterval: (old class readFromString: new). - ^ true! Item was removed: - ----- Method: FrameRateMorph>>framesPerSec (in category 'accessing') ----- - framesPerSec - - ^ framesPerSec! Item was removed: - ----- Method: FrameRateMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - lastDisplayTime := TimeStamp new. - framesSinceLastDisplay := 0. - self updateInterval: 500 milliSeconds. - self font: (Preferences standardMenuFont emphasized: 1). - ! Item was removed: - ----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - "Initialize the receiver as a stand-alone entity" - - super initializeToStandAlone. - self color: Color blue. - self font: (Preferences standardMenuFont emphasized: 1). - self step. - ! Item was removed: - ----- Method: FrameRateMorph>>mSecsPerFrame (in category 'accessing') ----- - mSecsPerFrame - - ^ mSecsPerFrame! Item was removed: - ----- Method: FrameRateMorph>>step (in category 'stepping and presenter') ----- - step - "Compute and display (every half second or so) the current framerate" - - | now timePassed newContents | - framesSinceLastDisplay := framesSinceLastDisplay + 1. - now := TimeStamp now. - timePassed := now - lastDisplayTime. - (timePassed > self updateInterval) ifTrue: - [| mSecs | - mSecs := timePassed asMilliSeconds. - mSecsPerFrame := mSecs // framesSinceLastDisplay. - framesPerSec := (framesSinceLastDisplay * 1000) // mSecs. - newContents := mSecsPerFrame printString, ' mSecs (', framesPerSec printString, ' frame', (framesPerSec = 1 ifTrue: [''] ifFalse: ['s']), '/sec)'. - self contents: newContents. - lastDisplayTime := now. - framesSinceLastDisplay := 0] - ifFalse: - ["Ensure at least one pixel is drawn per frame" - Preferences higherPerformance ifTrue: [self invalidRect: (self position extent: 1 at 1)]]! Item was removed: - ----- Method: FrameRateMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Answer the desired time between steps in milliseconds." - - ^ 0 - ! Item was removed: - ----- Method: FrameRateMorph>>updateInterval (in category 'accessing') ----- - updateInterval - - ^ updateInterval! Item was removed: - ----- Method: FrameRateMorph>>updateInterval: (in category 'accessing') ----- - updateInterval: aDuration - - updateInterval := aDuration! Item was removed: - BookMorph subclass: #GeeBookMorph - instanceVariableNames: 'geeMail' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: GeeBookMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^ false! Item was removed: - ----- Method: GeeBookMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.909 - g: 0.819 - b: 0.09! Item was removed: - ----- Method: GeeBookMorph>>geeMail: (in category 'accessing') ----- - geeMail: aGeeMail - - geeMail := aGeeMail.! Item was removed: - ----- Method: GeeBookMorph>>geePageRectangles (in category 'ui') ----- - geePageRectangles - - | pageBounds allPageRects | - - pageBounds := geeMail topLeft - extent: geeMail width @ (geeMail height min: Display height - 50). - allPageRects := OrderedCollection new. - [pageBounds top <= geeMail bottom] whileTrue: [ - allPageRects add: pageBounds. - pageBounds := pageBounds translateBy: 0 @ pageBounds height. - ]. - ^allPageRects - ! Item was removed: - ----- Method: GeeBookMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - newPagePrototype := GeeBookPageMorph new extent: Display extent // 3 ! Item was removed: - ----- Method: GeeBookMorph>>rebuildPages (in category 'ui') ----- - rebuildPages - - pages := self geePageRectangles collect: [ :each | - GeeBookPageMorph new - disableDragNDrop; - geeMail: geeMail geeMailRectangle: each. - ]. - currentPage delete. - currentPage := nil. - pages isEmpty ifTrue: [^ self insertPage]. - self goToPage: 1. - - ! Item was removed: - PasteUpMorph subclass: #GeeBookPageMorph - instanceVariableNames: 'geeMail geeMailRectangle' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: GeeBookPageMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^ false! Item was removed: - ----- Method: GeeBookPageMorph>>fullDrawOn: (in category 'drawing') ----- - fullDrawOn: aCanvas - - aCanvas - translateTo: self topLeft + aCanvas origin - geeMailRectangle origin - clippingTo: (bounds translateBy: aCanvas origin) - during: [ :c | - geeMail disablePageBreaksWhile: [geeMail fullDrawOn: c]. - ]. - ! Item was removed: - ----- Method: GeeBookPageMorph>>geeMail:geeMailRectangle: (in category 'initialization') ----- - geeMail: aGeeMail geeMailRectangle: aRectangle - - geeMail := aGeeMail. - geeMailRectangle := aRectangle. - self extent: aRectangle extent.! Item was removed: - ----- Method: GeeBookPageMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - "Handle a mouse down event." - - - "{evt. self recipientForMouseDown: evt. self} explore." - ! Item was removed: - ScrollPane subclass: #GeeMailMorph - instanceVariableNames: 'theTextMorph thePasteUp' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! - - !GeeMailMorph commentStamp: '<historical>' prior: 0! - GeeMail is a scrolling playfield with a text morph (typically on the left) and room on the right for other morphs to be placed. The morphs on the right can be linked to text selections on the left so that they remain positioned beside the pertinent text as the text is reflowed. Probably the best thing is and example and Alan will be making some available soon.! Item was removed: - ----- Method: GeeMailMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^ false "to encourage the use of GeeMail instead"! Item was removed: - ----- Method: GeeMailMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - self addGeeMailMenuItemsTo: aCustomMenu.! Item was removed: - ----- Method: GeeMailMorph>>addGeeMailMenuItemsTo: (in category 'menus') ----- - addGeeMailMenuItemsTo: menu - - menu - addUpdating: #showPageBreaksString action: #togglePageBreaks; - addUpdating: #keepScrollbarString action: #toggleKeepScrollbar; - addLine; - add: 'Print...' translated action: #printPSToFile; - addLine. - thePasteUp allTextPlusMorphs size = 1 ifTrue: [ - menu add: 'make 1-column book' translated selector: #makeBookStyle: argument: 1. - menu add: 'make 2-column book' translated selector: #makeBookStyle: argument: 2. - menu add: 'make 3-column book' translated selector: #makeBookStyle: argument: 3. - menu add: 'make 4-column book' translated selector: #makeBookStyle: argument: 4. - ] ifFalse: [ - menu add: 'make a galley of me' translated action: #makeGalleyStyle. - ]. - ^menu! Item was removed: - ----- Method: GeeMailMorph>>adjustPasteUpSize (in category 'private') ----- - adjustPasteUpSize - - | newBottom | - - thePasteUp ifNil: [^self]. - newBottom := thePasteUp bottom max: thePasteUp boundingBoxOfSubmorphs bottom + 20. - thePasteUp height: (newBottom - thePasteUp top max: self height). - thePasteUp width: (thePasteUp width max: scroller innerBounds width - 5).! Item was removed: - ----- Method: GeeMailMorph>>allTextPlusMorphs (in category 'accessing') ----- - allTextPlusMorphs - - ^thePasteUp allTextPlusMorphs! Item was removed: - ----- Method: GeeMailMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: GeeMailMorph>>doLayoutIn: (in category 'layout') ----- - doLayoutIn: layoutBounds - "layout has changed. update scroll deltas or whatever else" - - self adjustPasteUpSize. - scroller ifNotNil: [self setScrollDeltas]. - super doLayoutIn: layoutBounds. - ! Item was removed: - ----- Method: GeeMailMorph>>extraScrollRange (in category 'geometry') ----- - extraScrollRange - ^ bounds height - ! Item was removed: - ----- Method: GeeMailMorph>>getMenu: (in category 'menus') ----- - getMenu: shiftKeyState - - | menu | - menu := MenuMorph new defaultTarget: self. - self addGeeMailMenuItemsTo: menu. - ^menu! Item was removed: - ----- Method: GeeMailMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^evt yellowButtonPressed ! Item was removed: - ----- Method: GeeMailMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self initializeThePasteUp. - self position: 100 at 100. - self extent: Display extent // 3. - self useRoundedCorners. - ! Item was removed: - ----- Method: GeeMailMorph>>initializeThePasteUp (in category 'initialization') ----- - initializeThePasteUp - "initialize the receiver's thePasteUp" - thePasteUp := TextPlusPasteUpMorph new borderWidth: 0; - color: color. - scroller addMorph: thePasteUp! Item was removed: - ----- Method: GeeMailMorph>>keepScrollBarAlways (in category 'menus') ----- - keepScrollBarAlways - - ^self valueOfProperty: #keepScrollBarAlways ifAbsent: [false]! Item was removed: - ----- Method: GeeMailMorph>>keepScrollbarString (in category 'menus') ----- - keepScrollbarString - - ^self keepScrollBarAlways ifTrue: ['<on>scrollbar stays up'] ifFalse: ['<off>scrollbar stays up']! Item was removed: - ----- Method: GeeMailMorph>>makeBookStyle: (in category 'menus') ----- - makeBookStyle: nColumns - - | all totalWidth second columnWidth currY prev columnHeight currX currColumn pageBreakRectangles r rm columnGap pageGap starter | - - pageBreakRectangles := OrderedCollection new. - all := thePasteUp allTextPlusMorphs. - all size = 1 ifFalse: [^self]. - Cursor wait show. - starter := prev := all first. - totalWidth := self width - 16. - columnGap := 32. - pageGap := 16. - columnWidth := totalWidth - (columnGap * (nColumns - 1)) // nColumns. - columnHeight := self height - 12. - currY := 4. - currX := 4. - currColumn := 1. - prev - position: currX at currY; - width: columnWidth. - [ - second := prev makeSuccessorMorph. - thePasteUp addMorphBack: second. - prev - setProperty: #autoFitContents toValue: false; - height: columnHeight. - (currColumn := currColumn + 1) <= nColumns ifTrue: [ - currX := currX + columnWidth + columnGap. - ] ifFalse: [ - r := 4@(prev bottom + 4) corner: (self right - 4 @ (prev bottom + pageGap - 4)). - rm := RectangleMorph new bounds: r; color: (Color gray alpha: 0.3); borderWidth: 0. - pageBreakRectangles add: rm beSticky. - thePasteUp addMorphBack: rm. - currColumn := 1. - currX := 4. - currY := prev bottom + pageGap. - ]. - second - autoFit: true; - position: currX at currY; - width: columnWidth. - prev recomposeChain. "was commented" - prev := second. - prev height > columnHeight - ] whileTrue. - prev autoFit: true. - thePasteUp height: (prev bottom + 20 - self top). - self layoutChanged. - self setProperty: #pageBreakRectangles toValue: pageBreakRectangles. - thePasteUp allTextPlusMorphs do: [ :each | - each repositionAnchoredMorphs - ]. - Cursor normal show. - ! Item was removed: - ----- Method: GeeMailMorph>>makeGalleyStyle (in category 'menus') ----- - makeGalleyStyle - - | all first theRest | - - (self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]) do: [ :each | - each delete - ]. - self removeProperty: #pageBreakRectangles. - all := thePasteUp allTextPlusMorphs. - first := all select: [ :x | x predecessor isNil]. - first size = 1 ifFalse: [^self]. - Cursor wait show. - first := first first. - theRest := all reject: [ :x | x predecessor isNil]. - theRest do: [ :each | each delete]. - first autoFit: true. - first width: self width - 8. - first recomposeChain. - first repositionAnchoredMorphs. - Cursor normal show. - ! Item was removed: - ----- Method: GeeMailMorph>>mouseUp:inMorph: (in category 'event handling') ----- - mouseUp: evt inMorph: aMorph - - evt hand grabMorph: aMorph "old instances may have a handler we no longer use"! Item was removed: - ----- Method: GeeMailMorph>>pageRectanglesForPrinting (in category 'printing') ----- - pageRectanglesForPrinting - - | pageBreaks pageRects prevBottom | - - pageBreaks := self valueOfProperty: #pageBreakRectangles ifAbsent: [^nil]. - prevBottom := 0. - pageRects := pageBreaks collect: [ :each | | r | - r := 0 at prevBottom corner: self width @ each top. - prevBottom := each bottom. - r - ]. - pageRects add: (0 at prevBottom corner: self width @ thePasteUp bottom). - ^pageRects! Item was removed: - ----- Method: GeeMailMorph>>printPSToFile (in category 'Postscript Canvases') ----- - printPSToFile - - thePasteUp printer - geeMail: self; - doPages! Item was removed: - ----- Method: GeeMailMorph>>scrollBarValue: (in category 'scroll bar events') ----- - scrollBarValue: scrollValue - - | newPt pageBreaks topOfPage | - - scroller hasSubmorphs ifFalse: [^ self]. - newPt := -3 @ (self vLeftoverScrollRange * scrollValue). - - pageBreaks := self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]. - pageBreaks isEmpty ifTrue: [ - ^scroller offset: newPt. - ]. - topOfPage := pageBreaks inject: (0 at 0 corner: 0 at 0) into: [ :closest :each | - (each bottom - newPt y) abs < (closest bottom - newPt y) abs ifTrue: [ - each - ] ifFalse: [ - closest - ]. - ]. - topOfPage ifNotNil: [ - newPt := newPt x @ topOfPage bottom. - scrollBar value: newPt y / self vLeftoverScrollRange. - ]. - scroller offset: newPt.! Item was removed: - ----- Method: GeeMailMorph>>scrollSelectionIntoView:alignTop:inTextMorph: (in category 'scrolling') ----- - scrollSelectionIntoView: event alignTop: alignTop inTextMorph: tm - "Scroll my text into view if necessary and return true, else return false" - - | selRects delta selRect rectToTest transform cpHere | - - selRects := tm paragraph selectionRects. - selRects isEmpty ifTrue: [^ false]. - rectToTest := selRects first merge: selRects last. - transform := scroller transformFrom: self. - (event notNil and: [event isMouse and: [event anyButtonPressed]]) ifTrue: "Check for autoscroll" - [cpHere := transform localPointToGlobal: event cursorPoint. - cpHere y <= self top - ifTrue: [rectToTest := selRects first topLeft extent: 2 at 2] - ifFalse: [cpHere y >= self bottom - ifTrue: [rectToTest := selRects last bottomRight extent: 2 at 2] - ifFalse: [^ false]]]. - selRect := transform localBoundsToGlobal: rectToTest. - selRect height > bounds height - ifTrue: [^ false]. "Would not fit, even if we tried to scroll" - alignTop ifTrue: [ - self scrollBy: 0@(bounds top - selRect top). - ^ true - ]. - selRect bottom > bounds bottom ifTrue: [ - self scrollBy: 0@(bounds bottom - selRect bottom - 30). - ^ true - ]. - (delta := selRect amountToTranslateWithin: self bounds) y ~= 0 ifTrue: [ - "Scroll end of selection into view if necessary" - self scrollBy: 0 at delta y. - ^ true]. - ^ false! Item was removed: - ----- Method: GeeMailMorph>>scrollToPage: (in category 'scrolling') ----- - scrollToPage: pageNumber - - | rects oneRect | - - rects := self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]. - oneRect := rects at: pageNumber - 1 ifAbsent: [0 at 0 extent: 0 at 0]. - self scrollToYAbsolute: oneRect bottom. - ! Item was removed: - ----- Method: GeeMailMorph>>scrollToYAbsolute: (in category 'scrolling') ----- - scrollToYAbsolute: yValue - - | transform transformedPoint | - - transform := scroller transformFrom: self. - transformedPoint := transform localPointToGlobal: 0 at yValue. - - self scrollBy: 0@(bounds top - transformedPoint y). - ! Item was removed: - ----- Method: GeeMailMorph>>showPageBreaksString (in category 'menus') ----- - showPageBreaksString - - ^(thePasteUp ifNil: [^'???']) showPageBreaksString! Item was removed: - ----- Method: GeeMailMorph>>toggleKeepScrollbar (in category 'menus') ----- - toggleKeepScrollbar - - self setProperty: #keepScrollBarAlways toValue: self keepScrollBarAlways not! Item was removed: - ----- Method: GeeMailMorph>>togglePageBreaks (in category 'menus') ----- - togglePageBreaks - - (thePasteUp ifNil: [^self]) togglePageBreaks! Item was removed: - ----- Method: GeeMailMorph>>vHideScrollBar (in category 'scrolling') ----- - vHideScrollBar - - self keepScrollBarAlways ifTrue: [^self]. - ^super vHideScrollBar! Item was removed: - ----- Method: GeeMailMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - "Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. The default implementation returns false. - NOTE: the event is assumed to be in global (world) coordinates." - - ^false! Item was removed: - ----- Method: GeeMailMorph>>wantsSlot (in category 'accessing') ----- - wantsSlot - - ^false! Item was removed: - Object subclass: #GeePrinter - instanceVariableNames: 'pasteUp printSpecs geeMail computedBounds' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: GeePrinter>>allPages (in category 'private - postscript canvases') ----- - allPages - - | pageNumber allPages maxPages | - - maxPages := 9999. - pageNumber := 0. - allPages := self pageRectangles collect: [ :rect | - pageNumber := pageNumber + 1. - (self as: GeePrinterPage) pageNumber: pageNumber bounds: rect - ]. - allPages size > maxPages ifTrue: [allPages := allPages first: maxPages]. - allPages do: [ :each | each totalPages: allPages size]. - ^allPages - - ! Item was removed: - ----- Method: GeePrinter>>bounds (in category 'geometry') ----- - bounds - - ^computedBounds ifNil: [computedBounds := self computeBounds]! Item was removed: - ----- Method: GeePrinter>>computeBounds (in category 'geometry') ----- - computeBounds - - | w ratio | - - w := pasteUp width. - self printSpecs scaleToFitPage ifTrue: [ - ^0 at 0 extent: w@(w * self hOverW) rounded. - ]. - ratio := 8.5 @ 11. - self printSpecs landscapeFlag ifTrue: [ - ratio := ratio transposed - ]. - ^0 at 0 extent: (ratio * 72) rounded! Item was removed: - ----- Method: GeePrinter>>doPages (in category 'postscript canvases') ----- - doPages - - | dialog | - (dialog := GeePrinterDialogMorph new) - printSpecs: self printSpecs - printBlock: [ :preview :specs | - preview ifTrue: [self doPrintPreview] ifFalse: [self doPrintToPrinter] - ]; - fullBounds; - position: Display extent - dialog extent // 2; - openInWorld - - ! Item was removed: - ----- Method: GeePrinter>>doPrintPreview (in category 'private - postscript canvases') ----- - doPrintPreview - - | pageDisplay sz | - - sz := (85 @ 110) * 3. - self printSpecs landscapeFlag ifTrue: [ - sz := sz transposed - ]. - pageDisplay := BookMorph new - color: Color paleYellow; - borderWidth: 1. - self allPages withIndexDo: [ :each :index | | pic align newPage subBounds | - pic := ImageMorph new image: (each pageThumbnailOfSize: sz). - align := AlignmentMorph newColumn - addMorph: pic; - borderWidth: 1; - layoutInset: 0; - borderColor: Color blue. - newPage := pageDisplay - insertPageLabel: 'Page ',index printString - morphs: {align}. - subBounds := newPage boundingBoxOfSubmorphs. - newPage extent: subBounds corner - newPage topLeft + ((subBounds left - newPage left)@0). - ]. - pageDisplay - goToPage: 1; - deletePageBasic; - position: Display extent - pageDisplay extent // 2; - openInWorld. - ! Item was removed: - ----- Method: GeePrinter>>doPrintToPrinter (in category 'postscript canvases') ----- - doPrintToPrinter - - "fileName := ('gee.',Time millisecondClockValue printString,'.eps') asFileName." - self pageRectangles. "ensure bounds computed" - DSCPostscriptCanvasToDisk - morphAsPostscript: self - rotated: self printSpecs landscapeFlag - specs: self printSpecs - ! Item was removed: - ----- Method: GeePrinter>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - pasteUp drawOn: aCanvas - - ! Item was removed: - ----- Method: GeePrinter>>fullBounds (in category 'layout') ----- - fullBounds - - ^self bounds! Item was removed: - ----- Method: GeePrinter>>fullDrawOn: (in category 'drawing') ----- - fullDrawOn: aCanvas - - pasteUp fullDrawOn: aCanvas - - ! Item was removed: - ----- Method: GeePrinter>>fullDrawPostscriptOn: (in category 'postscript canvases') ----- - fullDrawPostscriptOn: aCanvas - - aCanvas drawPages: self allPages. - - ! Item was removed: - ----- Method: GeePrinter>>geeMail: (in category 'accessing') ----- - geeMail: aGeeMail - - geeMail := aGeeMail! Item was removed: - ----- Method: GeePrinter>>hOverW (in category 'private - postscript canvases') ----- - hOverW - - ^self printSpecs landscapeFlag ifTrue: [ - 8.5 / 11.0 - ] ifFalse: [ - 11.0 / 8.5 - ]. - ! Item was removed: - ----- Method: GeePrinter>>pageRectangles (in category 'private - postscript canvases') ----- - pageRectangles - - | pageBounds allPageRects maxExtent | - - geeMail ifNotNil: [ - allPageRects := geeMail pageRectanglesForPrinting. - allPageRects ifNotNil: [ - maxExtent := allPageRects inject: 0 at 0 into: [ :max :each | - max max: each extent - ]. - computedBounds := 0 at 0 extent: maxExtent. - ^allPageRects - ]. - ]. - pageBounds := self bounds. - allPageRects := OrderedCollection new. - [pageBounds top <= pasteUp bottom] whileTrue: [ - allPageRects add: pageBounds. - pageBounds := pageBounds translateBy: 0 @ pageBounds height. - ]. - ^allPageRects - ! Item was removed: - ----- Method: GeePrinter>>pagesHandledAutomatically (in category 'printing') ----- - pagesHandledAutomatically - - ^true! Item was removed: - ----- Method: GeePrinter>>pasteUp: (in category 'accessing') ----- - pasteUp: x - - pasteUp := x.! Item was removed: - ----- Method: GeePrinter>>printSpecs (in category 'accessing') ----- - printSpecs - - ^printSpecs ifNil: [printSpecs := PrintSpecifications defaultSpecs]. - ! Item was removed: - ----- Method: GeePrinter>>printSpecs: (in category 'accessing') ----- - printSpecs: aPrintSpecification - - printSpecs := aPrintSpecification! Item was removed: - ----- Method: GeePrinter>>wantsRoundedCorners (in category 'rounding') ----- - wantsRoundedCorners - - ^false! Item was removed: - AlignmentMorphBob1 subclass: #GeePrinterDialogMorph - instanceVariableNames: 'printSpecs printBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: GeePrinterDialogMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^ false! Item was removed: - ----- Method: GeePrinterDialogMorph>>buttonColor (in category 'user interface - constants') ----- - buttonColor - - ^color darker! Item was removed: - ----- Method: GeePrinterDialogMorph>>buttonNamed:action:color:help: (in category 'private') ----- - buttonNamed: aString action: aSymbol color: aColor help: helpString - | f col | - f := SimpleButtonMorph new target: self; - label: aString; - color: aColor; - borderColor: aColor muchDarker; - actionSelector: aSymbol; - setBalloonText: helpString. - col := self inAColumn: {f}. - col hResizing: #shrinkWrap. - ^ col! Item was removed: - ----- Method: GeePrinterDialogMorph>>cancelButton (in category 'user interface') ----- - cancelButton - ^ self - buttonNamed: 'Cancel' - action: #doCancel - color: Color lightRed - help: 'Cancel this printing operation.'! Item was removed: - ----- Method: GeePrinterDialogMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ self color darker! Item was removed: - ----- Method: GeePrinterDialogMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 8! Item was removed: - ----- Method: GeePrinterDialogMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color paleYellow! Item was removed: - ----- Method: GeePrinterDialogMorph>>doCancel (in category 'user interface') ----- - doCancel - - self delete! Item was removed: - ----- Method: GeePrinterDialogMorph>>doPreview (in category 'user interface') ----- - doPreview - - self delete. - printBlock value: true value: printSpecs.! Item was removed: - ----- Method: GeePrinterDialogMorph>>doPrint (in category 'user interface') ----- - doPrint - - self delete. - printBlock value: false value: printSpecs.! Item was removed: - ----- Method: GeePrinterDialogMorph>>getChoice: (in category 'user interface') ----- - getChoice: aSymbol - - aSymbol == #landscapeFlag ifTrue: [^printSpecs landscapeFlag]. - aSymbol == #drawAsBitmapFlag ifTrue: [^printSpecs drawAsBitmapFlag]. - aSymbol == #scaleToFitPage ifTrue: [^printSpecs scaleToFitPage]. - ! Item was removed: - ----- Method: GeePrinterDialogMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self vResizing: #shrinkWrap; - hResizing: #shrinkWrap; - layoutInset: 4; - useRoundedCorners. - printSpecs - ifNil: [printSpecs := PrintSpecifications defaultSpecs]. - self rebuild ! Item was removed: - ----- Method: GeePrinterDialogMorph>>previewButton (in category 'user interface') ----- - previewButton - - ^self - buttonNamed: 'Preview' - action: #doPreview - color: self buttonColor - help: 'Show a preview of the pages that will be printed on the screen.'! Item was removed: - ----- Method: GeePrinterDialogMorph>>printButton (in category 'user interface') ----- - printButton - - ^self - buttonNamed: 'Print' - action: #doPrint - color: self buttonColor - help: 'Print me (a PostScript file will be created)'! Item was removed: - ----- Method: GeePrinterDialogMorph>>printSpecs:printBlock: (in category 'accessing') ----- - printSpecs: aPrintSpecification printBlock: aTwoArgBlock - - printSpecs := aPrintSpecification. - printBlock := aTwoArgBlock.! Item was removed: - ----- Method: GeePrinterDialogMorph>>rebuild (in category 'private') ----- - rebuild - - self removeAllMorphs. - self addARow: { - (StringMorph contents: 'PostScript Printing Options') lock. - }. - self addARow: { - self - simpleToggleButtonFor: self - attribute: #landscapeFlag - help: 'Print in landscape mode'. - (StringMorph contents: ' Landscape') lock. - }. - self addARow: { - self - simpleToggleButtonFor: self - attribute: #drawAsBitmapFlag - help: 'Print as a bitmap'. - (StringMorph contents: ' Bitmap') lock. - }. - self addARow: { - self - simpleToggleButtonFor: self - attribute: #scaleToFitPage - help: 'Scale printing to fill page'. - (StringMorph contents: ' Scale to fit') lock. - }. - - - self addARow: { - self printButton. - self previewButton. - self cancelButton. - }.! Item was removed: - ----- Method: GeePrinterDialogMorph>>toggleChoice: (in category 'user interface') ----- - toggleChoice: aSymbol - - aSymbol == #landscapeFlag ifTrue: [ - printSpecs landscapeFlag: printSpecs landscapeFlag not - ]. - aSymbol == #drawAsBitmapFlag ifTrue: [ - printSpecs drawAsBitmapFlag: printSpecs drawAsBitmapFlag not - ]. - aSymbol == #scaleToFitPage ifTrue: [ - printSpecs scaleToFitPage: printSpecs scaleToFitPage not - ]. - ! Item was removed: - GeePrinter subclass: #GeePrinterPage - instanceVariableNames: 'pageNumber bounds totalPages' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: GeePrinterPage>>fullDrawPostscriptOn: (in category 'postscript canvases') ----- - fullDrawPostscriptOn: aCanvas - - | s | - s := TextMorph new - beAllFont: (TextStyle default fontOfSize: 30); - contentsAsIs: ' Drawing page ',pageNumber printString,' of ',totalPages printString,' '. - s layoutChanged; fullBounds. - s := AlignmentMorph newRow - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - addMorph: s; - color: Color yellow. - s position: Display center - (s width // 2 @ 0). - Project current world addMorphFront: s; - displayWorld. - printSpecs drawAsBitmapFlag ifTrue: [ - aCanvas paintImage: self pageAsForm at: 0 at 0 - ] ifFalse: [ - aCanvas - translateTo: bounds origin negated - clippingTo: (0 at 0 extent: bounds extent) - during: [ :c | - pasteUp fullDrawForPrintingOn: c - ]. - ]. - s delete. - - ! Item was removed: - ----- Method: GeePrinterPage>>pageAsForm (in category 'private - postscript canvases') ----- - pageAsForm - - | f canvas | - f := Form extent: bounds extent depth: 16. - canvas := f getCanvas. - canvas fillColor: pasteUp color. - canvas translateTo: bounds origin negated clippingTo: f boundingBox during: [ :c | - pasteUp fullDrawForPrintingOn: c - ]. - ^f - - ! Item was removed: - ----- Method: GeePrinterPage>>pageNumber:bounds: (in category 'private - accessing') ----- - pageNumber: anInteger bounds: aRect - - pageNumber := anInteger. - bounds := aRect.! Item was removed: - ----- Method: GeePrinterPage>>pageThumbnailOfSize: (in category 'private - postscript canvases') ----- - pageThumbnailOfSize: aPoint - - ^self pageAsForm scaledToSize: aPoint - - ! Item was removed: - ----- Method: GeePrinterPage>>totalPages: (in category 'private - accessing') ----- - totalPages: x - - totalPages := x! Item was removed: - ImageMorph subclass: #GrabPatchMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !GrabPatchMorph commentStamp: 'sw 8/1/2004 13:27' prior: 0! - When an instance of GrabPatchMorph is dropped by the user, it signals a desire to do a screen-grab of a rectangular area.! Item was removed: - ----- Method: GrabPatchMorph class>>authoringPrototype (in category 'instance creation') ----- - authoringPrototype - "Answer a prototype for use in a parts bin" - - ^ self new image: (ScriptingSystem formAtKey: 'GrabPatch'); markAsPartsDonor; setBalloonText: 'Use this to grab a rectangular patch from the screen'; yourself! Item was removed: - ----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Answer a description of the receiver's instances for a parts bin" - - ^ self partName: 'Grab Patch' translatedNoop - categories: {'Graphics' translatedNoop} - documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop! Item was removed: - ----- Method: GrabPatchMorph>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver. Emblazon the GrabPatch icon on its face" - - super initialize. - self image: (ScriptingSystem formAtKey: 'GrabPatch'). - self setProperty: #ignorePartsBinDrop toValue: true! Item was removed: - ----- Method: GrabPatchMorph>>initializeToStandAlone (in category 'initialization') ----- - initializeToStandAlone - "Initialize the receiver. Emblazon the GrabPatch icon on its face" - - super initializeToStandAlone. - self image: (ScriptingSystem formAtKey: 'GrabPatch')! Item was removed: - ----- Method: GrabPatchMorph>>justDroppedInto:event: (in category 'dropping') ----- - justDroppedInto: aPasteUpMorph event: anEvent - "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph" - - super justDroppedInto: aPasteUpMorph event: anEvent. - - aPasteUpMorph isPartsBin ifFalse: [ - "Do not show this morph in the screenshot." - self hide. - anEvent hand hide. - self refreshWorld. - - [aPasteUpMorph grabDrawingFromScreen: anEvent] - ensure: [anEvent hand show]]. - - "Just needed for this operation. Remove." - self delete.! Item was removed: - ----- Method: GrabPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') ----- - wantsToBeDroppedInto: aMorph - "Only into PasteUps that are not part bins" - - ^ aMorph isPlayfieldLike! Item was removed: - RectangleMorph subclass: #GradientFillMorph - instanceVariableNames: 'fillColor2 gradientDirection colorArray colorDepth' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !GradientFillMorph commentStamp: 'dtl 11/11/2017 22:32' prior: 0! - Class GradientFillMorph is obsolete. For getting gradient fills use a BorderedMorph with an appropriate fill style, e.g., - - | morph fs | - morph := BorderedMorph new. - fs := GradientFillStyle ramp: {0.0 -> Color red. 1.0 -> Color green}. - fs origin: morph bounds center. - fs direction: (morph bounds width // 2) @ 0. - fs radial: true. - morph fillStyle: fs. - Project current world primaryHand attachMorph: morph. - - Here's the old (obsolete) comment: - GradientFills cache an array of bitpatterns for the colors across their rectangle. It costs a bit of space, but makes display fast enough to eschew the use of a bitmap. The array must be recomputed whenever the colors, dimensions or display depth change.! Item was removed: - ----- Method: GradientFillMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'gradient color' translated action: #setGradientColor:. - gradientDirection == #vertical - ifTrue: [aCustomMenu add: 'horizontal pan' translated action: #beHorizontal] - ifFalse: [aCustomMenu add: 'vertical pan' translated action: #beVertical]. - ! Item was removed: - ----- Method: GradientFillMorph>>beHorizontal (in category 'menu') ----- - beHorizontal - gradientDirection := #horizontal. - self changed! Item was removed: - ----- Method: GradientFillMorph>>beVertical (in category 'menu') ----- - beVertical - gradientDirection := #vertical. - self changed! Item was removed: - ----- Method: GradientFillMorph>>changed (in category 'updating') ----- - changed - super changed. - self releaseCachedState! Item was removed: - ----- Method: GradientFillMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Note that this could run about 4 times faster if we got hold of - the canvas's port and just sent it copyBits with new coords and color" - - | style | - super drawOn: aCanvas. - (color isColor) ifFalse: [^self]. "An InfiniteForm, for example" - color = Color transparent ifTrue: [^self]. "Skip the gradient attempts, which will drop into debugger" - color = fillColor2 ifTrue: [^self]. "same color; no gradient" - "Check if we can use the cached gradient fill" - ((self valueOfProperty: #cachedGradientColor1) = color - and: [(self valueOfProperty: #cachedGradientColor2) = fillColor2]) - ifTrue: [style := self valueOfProperty: #cachedGradientFill]. - style ifNil: - [style := GradientFillStyle ramp: { - 0.0 -> color. - 1.0 -> fillColor2}. - self setProperty: #cachedGradientColor1 toValue: color. - self setProperty: #cachedGradientColor2 toValue: fillColor2. - self setProperty: #cachedGradientFill toValue: style]. - style origin: self position. - style direction: (gradientDirection == #vertical - ifTrue: [0 @ self height] - ifFalse: [self width @ 0]). - aCanvas fillRectangle: self innerBounds fillStyle: style! Item was removed: - ----- Method: GradientFillMorph>>gradientFillColor: (in category 'accessing') ----- - gradientFillColor: aColor - - fillColor2 := aColor. - self changed. - ! Item was removed: - ----- Method: GradientFillMorph>>hasTranslucentColor (in category 'accessing') ----- - hasTranslucentColor - "Answer true if this any of this morph is translucent but not transparent." - - (color isColor and: [color isTranslucentColor]) ifTrue: [^ true]. - (fillColor2 isColor and: [fillColor2 isTranslucentColor]) ifTrue: [^ true]. - ^ false - ! Item was removed: - ----- Method: GradientFillMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - self borderWidth: 0. - fillColor2 := Color black. - gradientDirection := #vertical! Item was removed: - ----- Method: GradientFillMorph>>setGradientColor: (in category 'menu') ----- - setGradientColor: evt - - self changeColorTarget: self selector: #gradientFillColor: originalColor: fillColor2 hand: evt hand! Item was removed: - RectangleMorph subclass: #GraphMorph - instanceVariableNames: 'data dataColor cursor cursorColor cursorColorAtZeroCrossings startIndex minVal maxVal cachedForm hasChanged' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !GraphMorph commentStamp: '<historical>' prior: 0! - I display a graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse. - - Implementation notes: Some operations on me may be done at sound sampling rates (e.g. 11-44 thousand times/second). To allow such high bandwidth application, certain operations that change my appearance do not immediately report a damage rectangle. Instead, a flag is set indicating that my display needs to refreshed and a step method reports the damage rectangle if that flag is set. Also, I cache a bitmap of my graph to allow the cursor to be moved without redrawing the graph. - ! Item was removed: - ----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Graph' translatedNoop - categories: #() - documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop! Item was removed: - ----- Method: GraphMorph>>addCustomMenuItems:hand: (in category 'sound') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'open wave editor' translated action: #openWaveEditor. - aCustomMenu add: 'read file' translated action: #readDataFromFile. - ! Item was removed: - ----- Method: GraphMorph>>appendValue: (in category 'commands') ----- - appendValue: aPointOrNumber - - | newVal | - (data isKindOf: OrderedCollection) ifFalse: [data := data asOrderedCollection]. - newVal := self asNumber: aPointOrNumber. - data addLast: newVal. - newVal < minVal ifTrue: [minVal := newVal]. - newVal > maxVal ifTrue: [maxVal := newVal]. - self cursor: data size. - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>centerCursor (in category 'commands') ----- - centerCursor - "Scroll so that the cursor is as close as possible to the center of my window." - - | w | - w := self width - (2 * self borderWidth). - self startIndex: ((cursor - (w // 2)) max: 1). - ! Item was removed: - ----- Method: GraphMorph>>clear (in category 'commands') ----- - clear - - self startIndex: 1. - self cursor: 1. - self data: OrderedCollection new. - ! Item was removed: - ----- Method: GraphMorph>>color: (in category 'accessing') ----- - color: aColor - - super color: aColor. - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - hasChanged ifNil: [hasChanged := false]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: GraphMorph>>cursor (in category 'e-toy support') ----- - cursor - - ^ cursor - ! Item was removed: - ----- Method: GraphMorph>>cursor: (in category 'e-toy support') ----- - cursor: aNumber - - | truncP | - cursor ~= aNumber ifTrue: [ - cursor := aNumber. - truncP := aNumber truncated. - truncP > data size ifTrue: [cursor := data size]. - truncP < 0 ifTrue: [cursor := 1]. - self keepIndexInView: truncP. - hasChanged := true]. - ! Item was removed: - ----- Method: GraphMorph>>cursorAtEnd (in category 'accessing') ----- - cursorAtEnd - - ^ cursor truncated >= data size - ! Item was removed: - ----- Method: GraphMorph>>cursorColor (in category 'accessing') ----- - cursorColor - - ^ cursorColor - ! Item was removed: - ----- Method: GraphMorph>>cursorColor: (in category 'accessing') ----- - cursorColor: aColor - - cursorColor := aColor. - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>cursorColorAtZeroCrossing (in category 'accessing') ----- - cursorColorAtZeroCrossing - - ^ cursorColorAtZeroCrossings - ! Item was removed: - ----- Method: GraphMorph>>cursorColorAtZeroCrossings: (in category 'accessing') ----- - cursorColorAtZeroCrossings: aColor - - cursorColorAtZeroCrossings := aColor. - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>cursorWrapped: (in category 'accessing') ----- - cursorWrapped: aNumber - - | sz | - cursor ~= aNumber ifTrue: [ - cursor := aNumber. - sz := data size. - sz = 0 - ifTrue: [cursor := 1] - ifFalse: [ - ((cursor >= (sz + 1)) or: [cursor < 0]) ifTrue: [ - cursor := cursor - ((cursor // sz) * sz)]. - cursor < 1 ifTrue: [cursor := sz + cursor]]. - "assert: 1 <= cursor < data size + 1" - hasChanged := true]. - ! Item was removed: - ----- Method: GraphMorph>>data (in category 'accessing') ----- - data - - ^ data - ! Item was removed: - ----- Method: GraphMorph>>data: (in category 'accessing') ----- - data: aCollection - - data := aCollection. - maxVal := minVal := 0. - data do: [:x | - x < minVal ifTrue: [minVal := x]. - x > maxVal ifTrue: [maxVal := x]]. - - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>dataColor (in category 'accessing') ----- - dataColor - - ^ dataColor - ! Item was removed: - ----- Method: GraphMorph>>dataColor: (in category 'accessing') ----- - dataColor: aColor - - dataColor := aColor. - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.8 - g: 0.8 - b: 0.6! Item was removed: - ----- Method: GraphMorph>>drawCursorOn: (in category 'private') ----- - drawCursorOn: aCanvas - - | ptr x r c | - ptr := (cursor asInteger max: 1) min: data size. - c := cursorColor. - ((ptr > 1) and: [ptr < data size]) ifTrue: [ - (data at: ptr) sign ~= (data at: ptr + 1) sign - ifTrue: [c := cursorColorAtZeroCrossings]]. - r := self innerBounds. - x := r left + ptr - startIndex. - ((x >= r left) and: [x <= r right]) ifTrue: [ - aCanvas fillRectangle: (x at r top corner: x + 1 at r bottom) color: c]. - ! Item was removed: - ----- Method: GraphMorph>>drawDataOn: (in category 'private') ----- - drawDataOn: aCanvas - - | yScale baseLine x start end value left top bottom right | - super drawOn: aCanvas. - - data isEmpty ifTrue: [^ self]. - maxVal = minVal ifTrue: [ - yScale := 1. - ] ifFalse: [ - yScale := (self bounds height - (2 * self borderWidth)) asFloat / (maxVal - minVal)]. - baseLine := self bounds bottom - self borderWidth + (minVal * yScale) truncated. - left := top := 0. right := 10. bottom := 0. - x := self bounds left + self borderWidth. - start := (startIndex asInteger max: 1) min: data size. - end := (start + self bounds width) min: data size. - start to: end do: [:i | - left := x truncated. right := x + 1. - right > (self bounds right - self borderWidth) ifTrue: [^ self]. - value := (data at: i) asFloat. - value >= 0.0 ifTrue: [ - top := baseLine - (yScale * value) truncated. - bottom := baseLine. - ] ifFalse: [ - top := baseLine. - bottom := baseLine - (yScale * value) truncated]. - aCanvas fillRectangle: (left at top corner: right at bottom) color: dataColor. - x := x + 1]. - ! Item was removed: - ----- Method: GraphMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | c | - cachedForm isNil - ifTrue: - [c := Display defaultCanvasClass extent: bounds extent. - c translateBy: bounds origin negated - during: [:tempCanvas | self drawDataOn: tempCanvas]. - cachedForm := c form]. - aCanvas - cache: bounds - using: cachedForm - during: [:cachingCanvas | self drawDataOn: cachingCanvas]. - self drawCursorOn: aCanvas! Item was removed: - ----- Method: GraphMorph>>flushCachedForm (in category 'private') ----- - flushCachedForm - - cachedForm := nil. - hasChanged := true. - ! Item was removed: - ----- Method: GraphMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - evt shiftPressed - ifTrue: [^ super handlesMouseDown: evt] - ifFalse: [^ true]. - ! Item was removed: - ----- Method: GraphMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self extent: 365 @ 80. - - dataColor := Color darkGray. - cursor := 1.0. - "may be fractional" - cursorColor := Color red. - cursorColorAtZeroCrossings := Color red. - startIndex := 1. - hasChanged := false. - self - data: ((0 to: 360 - 1) - collect: [:x | (100.0 * x degreesToRadians sin) asInteger])! Item was removed: - ----- Method: GraphMorph>>interpolatedValueAtCursor (in category 'accessing') ----- - interpolatedValueAtCursor - | sz prev frac next | - data isEmpty ifTrue: [^0]. - sz := data size. - cursor < 0 ifTrue: [^data first]. "just to be safe, though cursor shouldn't be negative" - prev := cursor truncated. - frac := cursor - prev. - prev < 1 ifTrue: [prev := sz]. - prev > sz ifTrue: [prev := 1]. - "assert: 1 <= prev <= sz" - frac = 0 ifTrue: [^data at: prev]. "no interpolation needed" - - "interpolate" - next := prev = sz ifTrue: [1] ifFalse: [prev + 1]. - ^(1.0 - frac) * (data at: prev) + (frac * (data at: next))! Item was removed: - ----- Method: GraphMorph>>keepIndexInView: (in category 'private') ----- - keepIndexInView: index - - | w newStart | - w := self bounds width - (2 * self borderWidth). - index < startIndex ifTrue: [ - newStart := index - w + 1. - ^ self startIndex: (newStart max: 1)]. - index > (startIndex + w) ifTrue: [ - ^ self startIndex: (index min: data size)]. - ! Item was removed: - ----- Method: GraphMorph>>lastValue (in category 'accessing') ----- - lastValue - data isEmpty ifTrue: [^0]. - ^data last! Item was removed: - ----- Method: GraphMorph>>lastValue: (in category 'accessing') ----- - lastValue: aNumber - - self appendValue: aNumber. - ! Item was removed: - ----- Method: GraphMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - - super layoutChanged. - cachedForm := nil. - ! Item was removed: - ----- Method: GraphMorph>>loadSineWave (in category 'commands') ----- - loadSineWave - - self loadSoundData: SoundBuffer sineTable. - ! Item was removed: - ----- Method: GraphMorph>>loadSound: (in category 'commands') ----- - loadSound: aSound - - self loadSoundData: aSound samples. - ! Item was removed: - ----- Method: GraphMorph>>loadSoundData: (in category 'commands') ----- - loadSoundData: aCollection - - | newData scale | - scale := 0. - aCollection do: [:v | - | absV | - (absV := v abs) > scale ifTrue: [scale := absV]]. - scale := 100.0 / scale. - newData := OrderedCollection new: aCollection size. - 1 to: aCollection size do: [:i | newData addLast: (scale * (aCollection at: i))]. - - self data: newData. - self startIndex: 1. - self cursor: 1. - ! Item was removed: - ----- Method: GraphMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - | x w | - x := evt cursorPoint x - (self bounds left + self borderWidth). - w := self width - (2 * self borderWidth). - - self changed. - x < 0 ifTrue: [ - cursor := startIndex + (3 * x). - cursor := (cursor max: 1) min: data size. - ^ self startIndex: cursor]. - x > w ifTrue: [ - cursor := startIndex + w + (3 * (x - w)). - cursor := (cursor max: 1) min: data size. - ^ self startIndex: cursor - w]. - - cursor := ((startIndex + x) max: 1) min: data size. - ! Item was removed: - ----- Method: GraphMorph>>openWaveEditor (in category 'sound') ----- - openWaveEditor - - | scaleFactor scaledData editor | - self data: data. "make sure maxVal and minVal are current" - scaleFactor := 32767 // ((minVal abs max: maxVal abs) max: 1). - scaledData := SoundBuffer newMonoSampleCount: data size. - 1 to: data size do: [:i | scaledData at: i put: (scaleFactor * (data at: i)) truncated]. - editor := WaveEditor new - data: scaledData; - samplingRate: 11025; - perceivedFrequency: 220.0. - editor openInWorld. - ! Item was removed: - ----- Method: GraphMorph>>playOnce (in category 'commands') ----- - playOnce - - | scaledData scale | - data isEmpty ifTrue: [^ self]. "nothing to play" - scale := 1. - data do: [:v | - | absV | - (absV := v abs) > scale ifTrue: [scale := absV]]. - scale := 32767.0 / scale. - scaledData := SoundBuffer newMonoSampleCount: data size. - 1 to: data size do: [:i | scaledData at: i put: (scale * (data at: i)) truncated]. - SoundService default playSampledSound: scaledData rate: 11025. - ! Item was removed: - ----- Method: GraphMorph>>readDataFromFile (in category 'sound') ----- - readDataFromFile - "This makes very little sense; it appears to be inteded as a general load data method but explicitly handles only AIFF files; very odd" - | fileName | - fileName := UIManager default - chooseFileMatchingSuffixes: #('aif') - label: 'File name?' translated. - fileName isEmpty ifTrue: [^ self]. - (StandardFileStream isAFileNamed: fileName) ifFalse: [ - ^ self inform: 'Sorry, I cannot find that file' translated]. - self data: (SampledSound fromAIFFfileNamed: fileName) samples. - - ! Item was removed: - ----- Method: GraphMorph>>reverse (in category 'commands') ----- - reverse - - data := data reversed. - self flushCachedForm. - ! Item was removed: - ----- Method: GraphMorph>>startIndex (in category 'accessing') ----- - startIndex - - ^ startIndex - ! Item was removed: - ----- Method: GraphMorph>>startIndex: (in category 'accessing') ----- - startIndex: aNumber - - startIndex ~= aNumber ifTrue: [ - startIndex := aNumber asInteger. - self flushCachedForm]. - ! Item was removed: - ----- Method: GraphMorph>>step (in category 'stepping and presenter') ----- - step - "Make a deferred damage rectangle if I've changed. This allows applications to call methods that invalidate my display at high-bandwidth without paying the cost of doing the damage reporting on ever call; they can merely set hasChanged to true." - - super step. - hasChanged isNil ifTrue: [hasChanged := false]. - hasChanged - ifTrue: - [self changed. - hasChanged := false]! Item was removed: - ----- Method: GraphMorph>>valueAtCursor (in category 'accessing') ----- - valueAtCursor - - data isEmpty ifTrue: [^ 0]. - ^ data at: ((cursor truncated max: 1) min: data size) - ! Item was removed: - ----- Method: GraphMorph>>valueAtCursor: (in category 'accessing') ----- - valueAtCursor: aPointOrNumber - - data isEmpty ifTrue: [^ 0]. - data - at: ((cursor truncated max: 1) min: data size) - put: (self asNumber: aPointOrNumber). - self flushCachedForm. - ! Item was removed: - GraphicalMenu subclass: #GraphicalDictionaryMenu - instanceVariableNames: 'baseDictionary entryNames lastSearchString' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalWidgets'! - - !GraphicalDictionaryMenu commentStamp: '<historical>' prior: 0! - A morph that allows you to view, rename, and remove elements from a dictionary whose keys are strings and whose values are forms.! Item was removed: - ----- Method: GraphicalDictionaryMenu class>>example (in category 'example') ----- - example - "GraphicalDictionaryMenu example" - | aDict | - aDict := Dictionary new. - #('ColorTilesOff' 'ColorTilesOn' 'Controls') do: - [:aString | aDict at: aString put: (ScriptingSystem formAtKey: aString)]. - self openOn: aDict withLabel: 'Testing One Two Three'! Item was removed: - ----- Method: GraphicalDictionaryMenu class>>example2 (in category 'example') ----- - example2 - "GraphicalDictionaryMenu example2" - | aDict | - aDict := Dictionary new. - self openOn: aDict withLabel: 'Testing Zero'! Item was removed: - ----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') ----- - openOn: aFormDictionary withLabel: aLabel - "open a graphical dictionary in a window having the label aLabel. - aFormDictionary should be a dictionary containing as value a form." - - | inst aWindow | - aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated]. - inst := self new initializeFor: nil fromDictionary: aFormDictionary. - - aWindow := (SystemWindow labelled: aLabel) model: inst. - aWindow addMorph: inst frame: (0 at 0 extent: 1 at 1). - aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3); - minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3). - - HandMorph attach: aWindow. - - ^ inst! Item was removed: - ----- Method: GraphicalDictionaryMenu>>baseDictionary: (in category 'initialization') ----- - baseDictionary: aDictionary - baseDictionary := aDictionary. - entryNames := aDictionary keys asArray sort. - formChoices := entryNames collect: [:n | aDictionary at: n]. - currentIndex := 1! Item was removed: - ----- Method: GraphicalDictionaryMenu>>browseIconReferences (in category 'menu commands') ----- - browseIconReferences - "Browse all calls on the symbol by which the currently-seen graphic is keyed" - - self systemNavigation browseAllCallsOn: self nameOfGraphic! Item was removed: - ----- Method: GraphicalDictionaryMenu>>browseStringIconReferences (in category 'menu commands') ----- - browseStringIconReferences - "Browse string references to the selected entry's key" - - self systemNavigation browseMethodsWithString: self nameOfGraphic asString matchCase: true! Item was removed: - ----- Method: GraphicalDictionaryMenu>>copyName (in category 'menu commands') ----- - copyName - "Copy the name of the current selection to the clipboard" - - Clipboard clipboardText: self nameOfGraphic asText! Item was removed: - ----- Method: GraphicalDictionaryMenu>>encodeToWorkspace (in category 'menu commands') ----- - encodeToWorkspace - | stream encodedStream pict text | - pict := formChoices at: currentIndex. - stream := ByteArray new writeStream. - PNGReadWriter putForm: pict onStream: stream. - encodedStream := stream contents base64Encoded. - text := Workspace open model. - text contents: 'Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: ''', encodedStream,''' readStream)'! Item was removed: - ----- Method: GraphicalDictionaryMenu>>findAgain (in category 'menu commands') ----- - findAgain - "Look for the next occurrence of the search string" - - | toFind searchIndex | - lastSearchString ifNil: [lastSearchString := 'controls']. - searchIndex := currentIndex + 1. - searchIndex > entryNames size ifTrue: - [currentIndex := 0. - self inform: 'not found' translated. - ^ self]. - toFind := '*', lastSearchString, '*'. - [toFind match: (entryNames at: searchIndex) asString] - whileFalse: - [searchIndex := (searchIndex \\ entryNames size) + 1. - searchIndex == currentIndex ifTrue: - [^ (toFind match: (entryNames at: searchIndex) asString) - ifFalse: - [self inform: 'not found' translated] - ifTrue: - [self flash]]]. - - currentIndex := searchIndex. - self updateThumbnail! Item was removed: - ----- Method: GraphicalDictionaryMenu>>findEntry (in category 'menu commands') ----- - findEntry - "Prompt the user for a search string and find the next match for it" - - | toFind searchIndex | - lastSearchString ifNil: [lastSearchString := 'controls']. - toFind := UIManager default request: 'Type name or fragment: ' initialAnswer: lastSearchString. - toFind isEmptyOrNil ifTrue: [^ self]. - lastSearchString := toFind asLowercase. - searchIndex := currentIndex + 1. - toFind := '*', lastSearchString, '*'. - [toFind match: (entryNames at: searchIndex) asString] - whileFalse: - [searchIndex := (searchIndex \\ entryNames size) + 1. - searchIndex == currentIndex ifTrue: [^ self inform: 'not found']]. - - currentIndex := searchIndex. - self updateThumbnail! Item was removed: - ----- Method: GraphicalDictionaryMenu>>handMeOne (in category 'menu commands') ----- - handMeOne - self currentHand attachMorph: (self world drawingClass new form: (formChoices at: currentIndex))! Item was removed: - ----- Method: GraphicalDictionaryMenu>>initializeFor:fromDictionary: (in category 'initialization') ----- - initializeFor: aTarget fromDictionary: aDictionary - "Initialize me for a target and a dictionary." - - | anIndex aButton | - self baseDictionary: aDictionary. - target := aTarget. - coexistWithOriginal := true. - self extent: 210 @ 210. - self clipSubmorphs: true. - self layoutPolicy: ProportionalLayout new. - aButton := (IconicButton new) - borderWidth: 0; - labelGraphic: (ScriptingSystem formAtKey: 'TinyMenu'); - color: Color transparent; - actWhen: #buttonDown; - actionSelector: #showMenu; - target: self; - setBalloonText: 'menu'. - self addMorph: aButton - fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) - offsets: (-50 @ 6 extent: aButton extent)). - aButton := (SimpleButtonMorph new) - target: self; - borderColor: Color black; - label: 'Prev'; - actionSelector: #downArrowHit; - actWhen: #whilePressed; - setBalloonText: 'show previous picture'; - yourself. - self addMorph: aButton - fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) - offsets: (-24 @ 4 extent: aButton extent)). - aButton := (SimpleButtonMorph new) - target: self; - borderColor: Color black; - label: 'Next'; - actionSelector: #upArrowHit; - actWhen: #whilePressed; - setBalloonText: 'show next pictutre'. - self addMorph: aButton - fullFrame: (LayoutFrame fractions: (0.5 @ 0 extent: 0 @ 0) - offsets: (24 @ 4 extent: aButton extent)). - self addMorph: ((UpdatingStringMorph new) - contents: ' '; - target: self; - putSelector: #renameGraphicTo:; - getSelector: #truncatedNameOfGraphic; - useStringFormat; - setBalloonText: 'The name of the current graphic'; - yourself) - fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) - offsets: (10 @ 40 corner: -10 @ 60)). - self addMorph: ((Morph new) - extent: 100 @ 4; - color: Color black) - fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ 0) - offsets: (0 @ 60 corner: 0 @ 64)). - formDisplayMorph := (Thumbnail new) - extent: 100 @ 100; - useInterpolation: true; - maxWidth: 300 minHeight: 100; - yourself. - formDisplayMorph layoutFrame: - (LayoutFrame fractions: (0 @ 0 extent: 0 at 0) - offsets: (8 @ 72 corner: 108 @ 172)). - self addMorph: formDisplayMorph. - self minimumExtent: 116 at 180. - target ifNotNil: - [(anIndex := formChoices indexOf: target form ifAbsent: []) - ifNotNil: [currentIndex := anIndex]]. - self updateThumbnail! Item was removed: - ----- Method: GraphicalDictionaryMenu>>nameOfGraphic (in category 'private') ----- - nameOfGraphic - ^ entryNames at: currentIndex! Item was removed: - ----- Method: GraphicalDictionaryMenu>>removeEntry (in category 'menu commands') ----- - removeEntry - baseDictionary removeKey: (entryNames at: currentIndex). - self baseDictionary: baseDictionary. - self updateThumbnail! Item was removed: - ----- Method: GraphicalDictionaryMenu>>renameEntry (in category 'menu commands') ----- - renameEntry - | reply curr | - reply := UIManager default - request: 'New key? ' - initialAnswer: (curr := entryNames at: currentIndex). - (reply isEmptyOrNil or: [reply = curr]) ifTrue: [^ Beeper beep]. - (baseDictionary includesKey: reply) ifTrue: - [^ self inform: 'sorry that conflicts with - the name of another - entry in this dictionary']. - baseDictionary at: reply put: (baseDictionary at: curr). - baseDictionary removeKey: curr. - self baseDictionary: baseDictionary. - self updateThumbnail! Item was removed: - ----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') ----- - renameGraphicTo: newName - | curr | - curr := entryNames at: currentIndex. - (newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep]. - (baseDictionary includesKey: newName) ifTrue: - [^ self inform: 'sorry that conflicts with - the name of another - entry in this dictionary' translated]. - baseDictionary at: newName put: (baseDictionary at: curr). - baseDictionary removeKey: curr. - self baseDictionary: baseDictionary. - currentIndex := entryNames indexOf: newName. - self updateThumbnail! Item was removed: - ----- Method: GraphicalDictionaryMenu>>repaintEntry (in category 'menu commands') ----- - repaintEntry - "Let the user enter into painting mode to repaint the item and save it back." - - | aWorld bnds sketchEditor aPaintBox formToEdit | - - (aWorld := self world) assureNotPaintingElse: [^ self]. - - aWorld prepareToPaint. - aWorld displayWorld. - formToEdit := formChoices at: currentIndex. - bnds := (submorphs second boundsInWorld origin extent: formToEdit extent) intersect: aWorld bounds. - bnds := (aWorld paintingBoundsAround: bnds center) merge: bnds. - sketchEditor := SketchEditorMorph new. - aWorld addMorphFront: sketchEditor. - sketchEditor initializeFor: ((aWorld drawingClass withForm: formToEdit) position: submorphs second positionInWorld) inBounds: bnds pasteUpMorph: aWorld paintBoxPosition: bnds topRight. - sketchEditor - afterNewPicDo: [:aForm :aRect | - formChoices at: currentIndex put: aForm. - baseDictionary at: (entryNames at: currentIndex) put: aForm. - self updateThumbnail. - (aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]] - ifNoBits: - [(aPaintBox := aWorld paintBoxOrNil) ifNotNil: [aPaintBox delete]]. - - ! Item was removed: - ----- Method: GraphicalDictionaryMenu>>showMenu (in category 'menu commands') ----- - showMenu - "Show the receiver's menu" - - | aMenu | - aMenu := MenuMorph new defaultTarget: self. - aMenu title: 'Graphics Library'. - aMenu addStayUpItem. - aMenu addList: #( - ('remove' removeEntry 'Remove this entry from the dictionary') - ('rename' renameEntry 'Rename this entry') - ('repaint' repaintEntry 'Edit the actual graphic for this entry' ) - - - ('hand me one' handMeOne 'Hand me a morph with this picture as its form') - ('encode to Workspace' encodeToWorkspace 'Open a Workspace with the grapics encoded to be added to code') - ('browse symbol references' - browseIconReferences 'Browse methods that refer to this icon''s name') - ('browse string references' - browseStringIconReferences 'Browse methods that refer to string constants that contain this icon''s name') - ('copy name' copyName 'Copy the name of this graphic to the clipboard') - - - ('find...' findEntry 'Find an entry by name') - ('find again' findAgain 'Find the next match for the keyword previously searched for')). - aMenu popUpInWorld - ! Item was removed: - ----- Method: GraphicalDictionaryMenu>>truncatedNameOfGraphic (in category 'menu commands') ----- - truncatedNameOfGraphic - ^ self nameOfGraphic truncateTo: 30! Item was removed: - ----- Method: GraphicalDictionaryMenu>>updateThumbnail (in category 'private') ----- - updateThumbnail - super updateThumbnail. - (self findA: UpdatingStringMorph) - doneWithEdits; - contents: (entryNames at: currentIndex) - ! Item was removed: - AlignmentMorph subclass: #GraphicalMenu - instanceVariableNames: 'target selector argument currentIndex formChoices formDisplayMorph coexistWithOriginal' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalWidgets'! Item was removed: - ----- Method: GraphicalMenu>>argument (in category 'accessing') ----- - argument - ^argument! Item was removed: - ----- Method: GraphicalMenu>>argument: (in category 'accessing') ----- - argument: anObject - argument := anObject! Item was removed: - ----- Method: GraphicalMenu>>cancel (in category 'event handling') ----- - cancel - coexistWithOriginal - ifTrue: - [self delete] - ifFalse: - [owner replaceSubmorph: self topRendererOrSelf by: target]! Item was removed: - ----- Method: GraphicalMenu>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color blue darker! Item was removed: - ----- Method: GraphicalMenu>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: GraphicalMenu>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: GraphicalMenu>>downArrowHit (in category 'event handling') ----- - downArrowHit - currentIndex := currentIndex - 1. - (currentIndex < 1) ifTrue: [currentIndex := formChoices size]. - self updateThumbnail - - ! Item was removed: - ----- Method: GraphicalMenu>>initialize (in category 'initialization') ----- - initialize - super initialize. - selector := #newForm:.! Item was removed: - ----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') ----- - initializeFor: aTarget withForms: formList coexist: aBoolean - "World primaryHand attachMorph: - (GraphicalMenu new initializeFor: nil - withForms: Form allInstances coexist: true)" - | buttons bb anIndex buttonCage | - target := aTarget. - coexistWithOriginal := aBoolean. - formChoices := formList. - currentIndex := 1. - self borderWidth: 1; - cellPositioning: #center; - color: Color white; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap. - buttons := AlignmentMorph newRow. - buttons borderWidth: 0; - layoutInset: 0. - buttons hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - extent: 5 @ 5. - buttons wrapCentering: #topLeft. - buttonCage := AlignmentMorph newColumn. - buttonCage hResizing: #shrinkWrap; - vResizing: #spaceFill. - buttonCage addTransparentSpacerOfSize: 0 @ 10. - bb := SimpleButtonMorph new target: self; - borderColor: Color black. - buttons addMorphBack: (bb label: 'Prev' translated; - actionSelector: #downArrowHit; - actWhen: #whilePressed). - buttons addTransparentSpacerOfSize: 9 @ 0. - bb := SimpleButtonMorph new target: self; - borderColor: Color black. - buttons addMorphBack: (bb label: 'Next' translated; - actionSelector: #upArrowHit; - actWhen: #whilePressed). - buttons addTransparentSpacerOfSize: 5 @ 0. - buttons submorphs last color: Color white. - buttonCage addMorphBack: buttons. - buttonCage addTransparentSpacerOfSize: 0 @ 12. - buttons := AlignmentMorph newRow. - bb := SimpleButtonMorph new target: self; - borderColor: Color black. - buttons addMorphBack: (bb label: 'OK' translated; - actionSelector: #okay). - buttons addTransparentSpacerOfSize: 5 @ 0. - bb := SimpleButtonMorph new target: self; - borderColor: Color black. - buttons addMorphBack: (bb label: 'Cancel' translated; - actionSelector: #cancel). - buttonCage addMorphBack: buttons. - buttonCage addTransparentSpacerOfSize: 0 @ 10. - self addMorphFront: buttonCage. - formDisplayMorph := Thumbnail new extent: 100 @ 100; - maxWidth: 100 minHeight: 30; - yourself. - self addMorphBack: (Morph new color: Color white; - layoutPolicy: TableLayout new; - layoutInset: 4 @ 4; - hResizing: #spaceFill; - vResizing: #spaceFill; - listCentering: #center; - addMorphBack: formDisplayMorph; - yourself). - target - ifNotNil: [(anIndex := formList - indexOf: target form - ifAbsent: []) - ifNotNil: [currentIndex := anIndex]]. - self updateThumbnail! Item was removed: - ----- Method: GraphicalMenu>>okay (in category 'event handling') ----- - okay - | nArgs | - target ifNotNil:[ - nArgs := selector numArgs. - nArgs = 1 ifTrue:[target perform: selector with: (formChoices at: currentIndex)]. - nArgs = 2 ifTrue:[target perform: selector with: (formChoices at: currentIndex) with: argument]]. - coexistWithOriginal - ifTrue: - [self delete] - ifFalse: - [owner replaceSubmorph: self topRendererOrSelf by: target]! Item was removed: - ----- Method: GraphicalMenu>>selector (in category 'accessing') ----- - selector - ^selector! Item was removed: - ----- Method: GraphicalMenu>>selector: (in category 'accessing') ----- - selector: aSymbol - selector := aSymbol! Item was removed: - ----- Method: GraphicalMenu>>upArrowHit (in category 'event handling') ----- - upArrowHit - currentIndex := currentIndex + 1. - (currentIndex > formChoices size) ifTrue: [currentIndex := 1]. - self updateThumbnail - - ! Item was removed: - ----- Method: GraphicalMenu>>updateThumbnail (in category 'event handling') ----- - updateThumbnail - | f | - f := formChoices at: currentIndex. - formDisplayMorph - makeThumbnailFromForm: f. - ! Item was removed: - ----- Method: HTTPDownloadRequest>>url (in category '*MorphicExtras-accessing') ----- - url - ^url! Item was removed: - ----- Method: HandMorph>>pauseEventRecorderIn: (in category '*MorphicExtras-event handling') ----- - pauseEventRecorderIn: aWorld - "Suspend any recorder prior to a project change, and return it. - It will be resumed after starting the new project." - eventListeners ifNil:[^nil]. - eventListeners do: - [:er | (er isKindOf: EventRecorderMorph) ifTrue: [^ er pauseIn: aWorld]]. - ^ nil! Item was removed: - HandMorph subclass: #HandMorphForReplay - instanceVariableNames: 'recorder suspended' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalSupport'! - - !HandMorphForReplay commentStamp: '<historical>' prior: 0! - I am a hand for replaying events stored in an EventRecorderMorph. When there are no more events, I delete myself.! Item was removed: - ----- Method: HandMorphForReplay>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver." - - super initialize. - suspended := false. - self showTemporaryCursor: Cursor normal - ! Item was removed: - ----- Method: HandMorphForReplay>>needsToBeDrawn (in category 'drawing') ----- - needsToBeDrawn - - ^true! Item was removed: - ----- Method: HandMorphForReplay>>pauseEventRecorderIn: (in category 'event handling') ----- - pauseEventRecorderIn: aWorld - "Suspend my recorder prior to a project change, and return it. - It will be resumed after starting the new project." - - ^ recorder pauseIn: aWorld! Item was removed: - ----- Method: HandMorphForReplay>>processEvents (in category 'event handling') ----- - processEvents - "Play back the next event" - - | evt hadMouse hadAny tracker | - suspended == true ifTrue: [^ self]. - hadMouse := hadAny := false. - tracker := recorder objectTrackingEvents. - [(evt := recorder nextEventToPlay) isNil] whileFalse: - [ - ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self]. - tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp]. - evt type == #EOF - ifTrue: - [recorder pauseIn: self currentWorld. - ^ self]. - evt type == #startSound - ifTrue: - [recorder perhapsPlaySound: evt argument. - recorder synchronize. - ^ self]. - evt type == #startEventPlayback - ifTrue: - [evt argument launchPlayback. - recorder synchronize. - ^ self]. - - evt type == #noteTheatreBounds - ifTrue: - ["The argument holds the content rect --for now we don't make any use of that info in this form." - ^ self]. - - evt isMouse ifTrue: [hadMouse := true]. - (evt isMouse or: [evt isKeyboard]) - ifTrue: - [self handleEvent: (evt setHand: self) resetHandlerFields. - hadAny := true]]. - (mouseClickState notNil and: [hadMouse not]) - ifTrue: - ["No mouse events during this cycle. Make sure click states time out accordingly" - - mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]. - hadAny - ifFalse: - ["No pending events. Make sure z-order is up to date" - - self mouseOverHandler processMouseOver: lastMouseEvent]! Item was removed: - ----- Method: HandMorphForReplay>>recorder: (in category 'initialization') ----- - recorder: anEventRecorder - recorder := anEventRecorder! Item was removed: - ----- Method: HandMorphForReplay>>showTemporaryCursor:hotSpotOffset: (in category 'cursor') ----- - showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset - "When I show my cursor, it appears double size, - unless it is a form such as a paint brush." - - cursorOrNil - ifNil: ["Setting cursor to nil cannot revert to hardware cursor -- just show normal." - ^ self showTemporaryCursor: Cursor normal hotSpotOffset: Cursor normal offset] - ifNotNil: - [(cursorOrNil isKindOf: Cursor) - ifTrue: ["Show cursors magnified for visibility" - ^ super showTemporaryCursor: (cursorOrNil asCursorForm magnifyBy: 2) - hotSpotOffset: (cursorOrNil offset negated*2) + hotSpotOffset] - ifFalse: [^ super showTemporaryCursor: cursorOrNil - hotSpotOffset: hotSpotOffset]]! Item was removed: - ----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - "Handmorph blocks deep copy. Go up to Morph" - - ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph! Item was removed: - RectangleMorph subclass: #HistogramMorph - instanceVariableNames: 'bag cachedForm values counts max sum limit labelBlock countLabelBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !HistogramMorph commentStamp: 'topa 6/14/2016 11:27' prior: 0! - I display bags as a histogram, that is a bar chart of the counts in the bag. - - Example: - HistogramMorph openOn: (Smalltalk allClasses gather: - [:class | class selectors collect: [:selector | class ]]) - - - Instance Variables - bag: <Bag> - cachedForm: <Form> - countLabelBlock: <BlockClosure> - counts: <SequencableCollection> - labelBlock: <BlockClosure> - limit: <Number> - max: <Number> - sum: <Number> - values: <SequencableCollection> - - bag - - The bag that forms the data basis for the histogram display - - cachedForm - - A form used to cache the historgram rendering. - - countLabelBlock - - Optional. Block that receives the count for the current bar and should return a String. - Leaving this nil is equivalent to [:count | count asString]. - - counts - - Cached collection of all counts in (value-)frequency-sorted order for rendering speed. - See values. - - labelBlock - - Optional. Block that receives the value for the current bar and should return a - String for the label. Leaving this nil is equivalent to [:value | value asString]. - - limit - - Maximum number of elements from values to consider. Defaults to 25. - - max - - Cached maximum value from values. - - sum - - Cached sum of all elements in values. Determines overall histogram height. - - values - - Cached collection of all values in frequency-sorted order for rendering speed. - See counts.! Item was removed: - ----- Method: HistogramMorph class>>on: (in category 'instance creation') ----- - on: aCollection - - ^ self new - bag: aCollection asBag; - yourself! Item was removed: - ----- Method: HistogramMorph class>>openOn: (in category 'instance creation') ----- - openOn: aCollection - - ^ (self on: aCollection) - openInHand! Item was removed: - ----- Method: HistogramMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aMenu hand: aHandMorph - - super addCustomMenuItems: aMenu hand: aHandMorph. - - aMenu add: 'set limit...' translated action: #editLimit.! Item was removed: - ----- Method: HistogramMorph>>bag (in category 'accessing') ----- - bag - - ^ bag! Item was removed: - ----- Method: HistogramMorph>>bag: (in category 'accessing') ----- - bag: anObject - - self basicBag: anObject. - self flush. - self changed. - ! Item was removed: - ----- Method: HistogramMorph>>basicBag: (in category 'accessing') ----- - basicBag: anObject - - bag := anObject.! Item was removed: - ----- Method: HistogramMorph>>basicLimit: (in category 'accessing') ----- - basicLimit: anObject - - limit := anObject. - ! Item was removed: - ----- Method: HistogramMorph>>cachedForm (in category 'accessing') ----- - cachedForm - - ^ cachedForm! Item was removed: - ----- Method: HistogramMorph>>cachedForm: (in category 'accessing') ----- - cachedForm: anObject - - cachedForm := anObject.! Item was removed: - ----- Method: HistogramMorph>>color: (in category 'accessing') ----- - color: aColor - - super color: aColor. - self flushCachedForm. - ! Item was removed: - ----- Method: HistogramMorph>>countLabelBlock (in category 'accessing') ----- - countLabelBlock - - ^ countLabelBlock! Item was removed: - ----- Method: HistogramMorph>>countLabelBlock: (in category 'accessing') ----- - countLabelBlock: anObject - - countLabelBlock := anObject.! Item was removed: - ----- Method: HistogramMorph>>countLabelFor: (in category 'drawing') ----- - countLabelFor: aNumber - - ^ self countLabelBlock - ifNotNil: [:block | block value: aNumber] - ifNil: [aNumber asString] - ! Item was removed: - ----- Method: HistogramMorph>>counts (in category 'accessing') ----- - counts - - ^ counts! Item was removed: - ----- Method: HistogramMorph>>counts: (in category 'accessing') ----- - counts: anObject - - counts := anObject.! Item was removed: - ----- Method: HistogramMorph>>defaultColor (in category 'initialization') ----- - defaultColor - ^ Color veryVeryLightGray! Item was removed: - ----- Method: HistogramMorph>>drawBar:value:count:chartHeight:font:on: (in category 'drawing') ----- - drawBar: aRectangle value: anObject count: anInteger chartHeight: chartHeight font: aFont on: aCanvas - - | label countLabel labelWidth countWidth midX | - label := self labelFor: anObject. - countLabel := self countLabelFor: anInteger. - labelWidth := aFont widthOfString: label. - countWidth := aFont widthOfString: countLabel. - midX := aRectangle origin x + (aRectangle width // 2). - - aCanvas fillRectangle: aRectangle color: Color blue. - self drawLabel: label width: labelWidth at: (midX - (labelWidth // 2) @ chartHeight) barWidth: aRectangle width font: aFont on: aCanvas. - countWidth < aRectangle width - ifTrue: [aCanvas drawString: countLabel at: (midX - (countWidth // 2) @ (chartHeight - (3/2 * aFont height))) font: aFont color: Color lightGray]. - ! Item was removed: - ----- Method: HistogramMorph>>drawDataOn: (in category 'drawing') ----- - drawDataOn: aCanvas - - | numX elementWidth offsetX font fontHeight offsetY maxY barWidth barRadius chartHeight | - font := TextStyle defaultFont. - fontHeight := font height. - numX := self limit. - maxY := self sum. - elementWidth := self width / (numX + 1). - barWidth := 2 max: (elementWidth * 0.9) floor. - barRadius := barWidth / 2. - offsetX := elementWidth / 2. - offsetY := fontHeight * 1.2 - max: (self values collect: [:value | font widthOfString: (self labelFor: value)]) max. - chartHeight := self height - offsetY. - - 0 to: (self height - offsetY) by: 20 do: [:i | - aCanvas - line: 0 at i to: aCanvas clipRect width at i width: 1 color: (Color lightGray lighter alpha: 0.5)]. - - self valuesAndCountsWithIndexDo: - [:value :count :barIndex | | barMidX origin end | - barIndex <= self limit ifTrue: [ - barMidX := barIndex * elementWidth. - origin := barMidX - barRadius @ ((maxY - count) / maxY * chartHeight). - end := barMidX + barRadius @ chartHeight. - - self - drawBar: (origin corner: end) - value: value - count: count - chartHeight: chartHeight - font: font - on: aCanvas]]. - ! Item was removed: - ----- Method: HistogramMorph>>drawLabel:width:at:barWidth:font:on: (in category 'drawing') ----- - drawLabel: aString width: aNumber at: aPoint barWidth: barWidth font: aFont on: aCanvas - - aNumber <= barWidth - ifTrue: [aCanvas drawString: aString at: aPoint font: aFont color: Color black] - ifFalse: [ - | c | - c := Display defaultCanvasClass extent: aNumber @ aFont height. - c drawString: aString at: 0 @ 0 font: aFont color: Color black. - aCanvas paintImage: (c form rotateBy: -90 smoothing: 3) at: aPoint].! Item was removed: - ----- Method: HistogramMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | c | - self cachedForm - ifNil: - [c := Display defaultCanvasClass extent: self bounds extent. - c translateBy: self bounds origin negated - during: [:tempCanvas | super drawOn: tempCanvas]. - self drawDataOn: c. - self cachedForm: c form]. - aCanvas - cache: self bounds - using: self cachedForm - during: [:cachingCanvas | self drawDataOn: cachingCanvas]. - ! Item was removed: - ----- Method: HistogramMorph>>editLimit (in category 'menus') ----- - editLimit - - | newLimit | - newLimit := Project uiManager request: 'limit for histogram' translated initialAnswer: self limit asString. - newLimit isEmptyOrNil ifTrue: [^ false]. - - self limit: newLimit asInteger. - ^ true! Item was removed: - ----- Method: HistogramMorph>>flush (in category 'initialization') ----- - flush - - | valuesAndCounts | - self bag ifNil: [^self]. "nothing to do yet" - valuesAndCounts := self bag sortedCounts. - valuesAndCounts size < self limit - ifTrue: [self basicLimit: valuesAndCounts size]. - self values: ((valuesAndCounts collect: [:ea | ea value]) first: self limit). - self counts: ((valuesAndCounts collect: [:ea | ea key]) first: self limit). - self max: self counts max. - self sum: self counts sum. - - self flushCachedForm. - ! Item was removed: - ----- Method: HistogramMorph>>flushCachedForm (in category 'initialization') ----- - flushCachedForm - - cachedForm := nil. - ! Item was removed: - ----- Method: HistogramMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - self - extent: 700 @ 400; - basicLimit: 25; - yourself.! Item was removed: - ----- Method: HistogramMorph>>labelBlock (in category 'accessing') ----- - labelBlock - - ^ labelBlock! Item was removed: - ----- Method: HistogramMorph>>labelBlock: (in category 'accessing') ----- - labelBlock: anObject - - labelBlock := anObject.! Item was removed: - ----- Method: HistogramMorph>>labelFor: (in category 'drawing') ----- - labelFor: aValue - - ^ self labelBlock - ifNotNil: [:block | block value: aValue] - ifNil: [aValue asString] - ! Item was removed: - ----- Method: HistogramMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - - super layoutChanged. - cachedForm := nil. - ! Item was removed: - ----- Method: HistogramMorph>>limit (in category 'accessing') ----- - limit - - ^ limit! Item was removed: - ----- Method: HistogramMorph>>limit: (in category 'accessing') ----- - limit: anObject - - self basicLimit: anObject. - self flush. - self changed! Item was removed: - ----- Method: HistogramMorph>>max (in category 'accessing') ----- - max - - ^ max! Item was removed: - ----- Method: HistogramMorph>>max: (in category 'accessing') ----- - max: anObject - - max := anObject.! Item was removed: - ----- Method: HistogramMorph>>sum (in category 'accessing') ----- - sum - - ^ sum! Item was removed: - ----- Method: HistogramMorph>>sum: (in category 'accessing') ----- - sum: anObject - - sum := anObject! Item was removed: - ----- Method: HistogramMorph>>values (in category 'accessing') ----- - values - - ^ values! Item was removed: - ----- Method: HistogramMorph>>values: (in category 'accessing') ----- - values: anObject - - values := anObject.! Item was removed: - ----- Method: HistogramMorph>>valuesAndCountsWithIndexDo: (in category 'enumeration') ----- - valuesAndCountsWithIndexDo: aBlock - - 1 to: self values size do: [:index | - aBlock - value: (self values at: index) - value: (self counts at: index) - value: index]. ! Item was removed: - RotaryDialMorph subclass: #HygrometerDialMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !HygrometerDialMorph commentStamp: 'tpr 4/14/2017 10:13' prior: 0! - A Hygrometer measures the relative humidity of the air; a HygrometerDialMorph provides a way to display the value of R.H.! Item was removed: - ----- Method: HygrometerDialMorph>>buildDial (in category 'dial drawing') ----- - buildDial - "start by making a damn big Form, twice the size we want to end up with" - |outerRadius destForm canvas tickLabel tickLength beginAngle endAngle tickAngle tickLabelSize maxTicks | - outerRadius := self height - 1. - destForm := Form extent: self extent * 2 depth: 32. - (canvas := destForm getCanvas) fillOval: (0 at 0 extent: self extent * 2) color: Color white. - "outer ring" - self drawArcAt: destForm center radius: outerRadius thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - "inner ring" - self drawArcAt: destForm center radius: outerRadius * 0.97 thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - - "just one scale for a hygrometer" - beginAngle := startAngle -360. "needs cleaning up about this" - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.8 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.73 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - "We use a simple % range, just one scale" - maxTicks := stopValue - startValue . - tickAngle := endAngle - beginAngle / maxTicks. - startValue to: stopValue do: [:tick| - tickLength := outerRadius * 0.07. - tickLabel := nil. - tick \\ 10 = 0 ifTrue: [ - tickLabel := tick asString. - tickLabelSize := 24 - ] ifFalse: [ - tick \\ 2 = 0 ifTrue:[ - tickLabel := (tick \\ 10) asString. - tickLabelSize := 18 - ] ifFalse: [ - tickLength := tickLength * 2 - ] - ]. - self drawTickRadius: outerRadius * 0.73 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - self tickLabel: tickLabel fontSize: tickLabelSize color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) + tickLength angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - ]. - - self tickLabel: '% R.H.' fontSize: 36 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.53) angle: 180 onCanvas: canvas. - - self addMorph: (destForm magnify: destForm boundingBox by: 0.5 smoothing: 2) asMorph! Item was removed: - ----- Method: HygrometerDialMorph>>initialize (in category 'initialize-release') ----- - initialize - "Build a hygrometer. The background is an ImageMorph showing a dial derived from the same general principles as the BarometerMorph. " - | pointerMorph | - super initialize. - - self startAngle: -140 stopAngle: 140; - startValue: 0 stopValue: 100. - self extent: self initialExtent; color: Color transparent; borderWidth: 0. - dialCenter := self center. - - self buildDial. - - "build our fancy needle as an ImageMorph, set the position to horizontal centre and about 2/3 down so that it rotates about that point when inside the TransformationMorph" - pointerMorph := self fancyNeedleOfLength: (self height * 0.65) rounded. - pointerMorph - position: pointerMorph extent * ( -0.5@ -0.65); - rotationCenter: 0.5 @ 0.65. - - "we keep track of the TransformationMorph since that is what we have to rotate as the incoming pressure values change" - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - - "add a central colored dot. Because we just do." - self addMorph: (CircleMorph new extent: 20 at 20; color: Color black; center: dialCenter) - ! Item was removed: - ----- Method: IconicButton>>initializeToShow:withLabel:andSend:to: (in category '*MorphicExtras-initialization') ----- - initializeToShow: aMorph withLabel: aLabel andSend: aSelector to: aReceiver - "Initialize the receiver to show the current appearance of aMorph on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the specified selector to the specified receiver" - - | aThumbnail | - aThumbnail := Thumbnail new. - aThumbnail makeThumbnailFromForm: (aMorph imageFormDepth: 32). - ^ self initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: self color andSend: aSelector to: aReceiver ! Item was removed: - ----- Method: ImageMorph>>drawPostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - drawPostscriptOn: aCanvas - - | top f2 c2 clrs | - - clrs := image colorsUsed. - (clrs includes: Color transparent) - ifFalse: [^super drawPostscriptOn: aCanvas]. "no need for this, then" - - top := aCanvas topLevelMorph. - f2 := Form extent: self extent depth: image depth. - c2 := f2 getCanvas. - c2 fillColor: Color white. - c2 translateBy: bounds origin negated clippingTo: f2 boundingBox during: [ :c | - top fullDrawOn: c - ]. - aCanvas paintImage: f2 at: bounds origin - - ! Item was removed: - PasteUpMorph subclass: #IndexTabs - instanceVariableNames: 'highlightColor regularColor basicHeight basicWidth verticalPadding fixedWidth' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Palettes'! - - !IndexTabs commentStamp: '<historical>' prior: 0! - Used in conjunction wi[th a TabbedPalette -- each TabbedPalette has one. Each submorph of an IndexTabs is a TabMorph. When you click on one of the tabs, a corresponding action is taken -- sometimes, the existing palette gets replaced by the new one, other times, the tab results in some selector being invoked; in any case, tab highlighting takes place accordingly.! Item was removed: - ----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - "Answer a basis for names of default instances of the receiver" - ^ 'tabs' translatedNoop! Item was removed: - ----- Method: IndexTabs>>addTab: (in category 'tabs') ----- - addTab: aTab - self addMorphBack: aTab. - self laySubpartsOutInOneRow! Item was removed: - ----- Method: IndexTabs>>addTabFor:font: (in category 'tabs') ----- - addTabFor: aReferent font: aFont - | aTab | - aTab := ReferenceMorph forMorph: aReferent font: aFont. - self addMorphBack: aTab. - aTab highlightColor: self highlightColor; regularColor: self regularColor. - aTab unHighlight. - self laySubpartsOutInOneRow; layoutChanged. - ^ aTab! Item was removed: - ----- Method: IndexTabs>>addTabForBook: (in category 'tabs') ----- - addTabForBook: aBook - | aTab | - aTab := ReferenceMorph forMorph: aBook. - self addMorphBack: aTab. - aTab highlightColor: self highlightColor; regularColor: self regularColor. - aTab unHighlight. - self laySubpartsOutInOneRow; layoutChanged. - ^ aTab! Item was removed: - ----- Method: IndexTabs>>basicHeight (in category 'layout') ----- - basicHeight - ^ basicHeight! Item was removed: - ----- Method: IndexTabs>>basicWidth (in category 'layout') ----- - basicWidth - basicWidth ifNil: [basicWidth := owner ifNotNil: [owner width] ifNil: [100]]. - ^ basicWidth! Item was removed: - ----- Method: IndexTabs>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 0! Item was removed: - ----- Method: IndexTabs>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.0 - g: 0.6 - b: 0.6! Item was removed: - ----- Method: IndexTabs>>fixedWidth: (in category 'layout') ----- - fixedWidth: aWidth - fixedWidth := aWidth! Item was removed: - ----- Method: IndexTabs>>highlightColor (in category 'accessing') ----- - highlightColor - ^ highlightColor ifNil: [Color yellow]! Item was removed: - ----- Method: IndexTabs>>highlightColor: (in category 'accessing') ----- - highlightColor: aColor - highlightColor := aColor! Item was removed: - ----- Method: IndexTabs>>highlightColor:regularColor: (in category 'highlighting') ----- - highlightColor: color1 regularColor: color2 - "Apply these colors to all of the receiver's tabs" - highlightColor := color1. - regularColor := color2. - self tabMorphs do: - [:m | m highlightColor: color1. m regularColor: color2]! Item was removed: - ----- Method: IndexTabs>>highlightTab: (in category 'highlighting') ----- - highlightTab: aTab - self tabMorphs do: - [:m | m == aTab - ifTrue: [m highlight] - ifFalse: [m unHighlight]]! Item was removed: - ----- Method: IndexTabs>>highlightTabFor: (in category 'highlighting') ----- - highlightTabFor: aBook - | theOne | - self tabMorphs do: [:m | - (m morphToInstall == aBook) - ifTrue: [m highlight. theOne := m] - ifFalse: [m unHighlight]]. - ^ theOne - ! Item was removed: - ----- Method: IndexTabs>>highlightedTab (in category 'highlighting') ----- - highlightedTab - ^ self tabMorphs detect: [:m | m isHighlighted] ifNone: [nil]! Item was removed: - ----- Method: IndexTabs>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver. Make sure it is not open to drag and - drop" - super initialize. - "" - padding := 10. - verticalPadding := 4. - basicHeight := 14. - basicWidth := 200. - - self enableDragNDrop: false! Item was removed: - ----- Method: IndexTabs>>laySubpartsOutInOneRow (in category 'layout') ----- - laySubpartsOutInOneRow - | aPosition neededHeight widthToUse mid | - fixedWidth ifNotNil: [self error: 'incompatibility in IndexTabs']. - verticalPadding ifNil: [verticalPadding := 4]. "for benefit of old structures" - aPosition := self topLeft. - neededHeight := self basicHeight. - submorphs do: - [:aMorph | - aMorph position: (aPosition + (padding @ 0)). - aPosition := aMorph topRight. - neededHeight := neededHeight max: aMorph height]. - neededHeight := neededHeight + (verticalPadding * 2). - mid := self top + (neededHeight // 2). - submorphs do: - [:aMorph | - aMorph top: (mid - (aMorph height // 2))]. - widthToUse := self widthImposedByOwner max: self requiredWidth. - self extent: (((aPosition x + padding - self left) max: widthToUse) @ neededHeight)! Item was removed: - ----- Method: IndexTabs>>ownerChanged (in category 'change reporting') ----- - ownerChanged - fixedWidth ifNil: [self laySubpartsOutInOneRow]! Item was removed: - ----- Method: IndexTabs>>regularColor (in category 'accessing') ----- - regularColor - ^ regularColor ifNil: [Color r: 0.4 g: 0.2 b: 0.6]! Item was removed: - ----- Method: IndexTabs>>regularColor: (in category 'accessing') ----- - regularColor: aColor - regularColor := aColor! Item was removed: - ----- Method: IndexTabs>>repelsMorph:event: (in category 'dropping/grabbing') ----- - repelsMorph: aMorph event: evt - ^ false! Item was removed: - ----- Method: IndexTabs>>requiredWidth (in category 'layout') ----- - requiredWidth - submorphs isEmpty ifTrue: [^self basicWidth]. - ^(submorphs detectSum: [:m | m width]) + (submorphs size * padding)! Item was removed: - ----- Method: IndexTabs>>rowsNoWiderThan: (in category 'layout') ----- - rowsNoWiderThan: maxWidth - | aPosition neededHeight | - self fixedWidth: maxWidth. - verticalPadding ifNil: [verticalPadding := 4]. "for benefit of old structures" - aPosition := self topLeft. - neededHeight := self basicHeight. - submorphs do: - [:aMorph | - aMorph position: (aPosition + (padding @ 0)). - (aMorph right > (self left + maxWidth)) ifTrue: - [aPosition := self left @ (aPosition y + neededHeight). - aMorph position: aPosition + (padding @ 0). - neededHeight := self basicHeight]. - aPosition := aMorph topRight. - neededHeight := neededHeight max: aMorph height]. - self extent: (maxWidth @ ((aPosition y + neededHeight) - self top))! Item was removed: - ----- Method: IndexTabs>>selectTab: (in category 'selection') ----- - selectTab: aTab - | aWorld | - (aWorld := self world) ifNotNil: [aWorld abandonAllHalos]. "nil can happen at init time" - self highlightTab: aTab. - ! Item was removed: - ----- Method: IndexTabs>>tabMorphs (in category 'tabs') ----- - tabMorphs - "Presently all the submorphs are ReferenceMorphs, but this still supports an earlier design where spacers are interleaved, and where the old TabMorph class was used" - - ^ submorphs select: [:m | (m isKindOf: TabMorph) or: [m isKindOf: ReferenceMorph]]! Item was removed: - ----- Method: IndexTabs>>widthImposedByOwner (in category 'layout') ----- - widthImposedByOwner - ((owner isNil or: [owner isWorldOrHandMorph]) - or: [owner submorphs size < 2]) ifTrue: [^self basicWidth]. - ^owner submorphs second width! Item was removed: - RectangleMorph subclass: #InterimSoundMorph - instanceVariableNames: 'graphic sound' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: InterimSoundMorph>>addGraphic (in category 'initialization') ----- - addGraphic - - graphic := SketchMorph withForm: self speakerGraphic. - graphic position: bounds center - (graphic extent // 2). - self addMorph: graphic. - ! Item was removed: - ----- Method: InterimSoundMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: InterimSoundMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0 - g: 0.8 - b: 0.6! Item was removed: - ----- Method: InterimSoundMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - (graphic containsPoint: evt cursorPoint) - ifTrue: [^ true] - ifFalse: [^ super handlesMouseDown: evt]. - ! Item was removed: - ----- Method: InterimSoundMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - self extent: 30 @ 30. - self addGraphic. - sound := PluckedSound - pitch: 880.0 - dur: 2.0 - loudness: 0.5! Item was removed: - ----- Method: InterimSoundMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - (graphic containsPoint: evt cursorPoint) - ifTrue: [sound copy play] - ifFalse: [super mouseDown: evt]. - ! Item was removed: - ----- Method: InterimSoundMorph>>sound (in category 'accessing') ----- - sound - - ^ sound - ! Item was removed: - ----- Method: InterimSoundMorph>>sound: (in category 'accessing') ----- - sound: aSound - - sound := aSound. - ! Item was removed: - ----- Method: InterimSoundMorph>>speakerGraphic (in category 'initialization') ----- - speakerGraphic - - ^ Form - extent: 19 at 18 - depth: 8 - fromArray: #(0 0 1493172224 2816 0 0 0 1493172224 11 0 0 138 1493172224 184549376 184549376 0 35509 2315255808 720896 720896 0 9090522 2315255808 2816 720896 0 2327173887 2315255819 2816 720896 138 3051028442 2315255819 2816 2816 1505080590 4294957786 2315255808 184549387 2816 3053453311 4292532917 1493172224 184549387 2816 1505080714 3048584629 1493172224 184549387 2816 9079434 3048584629 1493172224 184549387 2816 138 2327164341 1493172235 2816 2816 0 2324346293 1493172235 2816 720896 0 9079477 1493172224 2816 720896 0 35466 1493172224 720896 720896 0 138 0 184549376 184549376 0 0 0 11 0 0 0 0 2816 0) - offset: 0 at 0 - ! Item was removed: - ThreadNavigationMorph subclass: #InternalThreadNavigationMorph - instanceVariableNames: 'threadName preferredIndex' - classVariableNames: 'CachedThumbnails KnownThreads' - poolDictionaries: '' - category: 'MorphicExtras-Navigators'! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') ----- - cacheThumbnailFor: aProject - "Save a thumbnail of the given project in my thumbnail cache." - - | form | - CachedThumbnails ifNil: [CachedThumbnails := Dictionary new]. - CachedThumbnails - at: aProject name - put: (form := self sorterFormForProject: aProject sized: 160 @ 120). - ^ form - ! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>clearKnownThreads (in category 'known threads') ----- - clearKnownThreads - - KnownThreads := nil! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>clearThumbnailCache (in category 'thumbnails') ----- - clearThumbnailCache - - CachedThumbnails := nil! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'ThreadNavigator' translatedNoop - categories: {'Multimedia' translatedNoop} - documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') ----- - getThumbnailFor: aProject - "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it." - - CachedThumbnails ifNil: [CachedThumbnails := Dictionary new]. - ^CachedThumbnails - at: aProject name - ifAbsentPut: [self sorterFormForProject: aProject sized: 160 at 120]! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>know:as: (in category 'known threads') ----- - know: listOfPages as: nameOfThread - - self knownThreads at: nameOfThread put: listOfPages. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>knownThreads (in category 'known threads') ----- - knownThreads - - ^KnownThreads ifNil: [KnownThreads := Dictionary new]. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>openThreadNamed:atIndex: (in category 'known threads') ----- - openThreadNamed: nameOfThread atIndex: anInteger - - | coll nav | - - coll := self knownThreads at: nameOfThread ifAbsent: [^self]. - nav := Project current world - submorphThat: [ :each | (each isKindOf: self) and: [each threadName = nameOfThread]] - ifNone: [ - nav := self basicNew. - nav - listOfPages: coll; - threadName: nameOfThread index: anInteger; - initialize; - openInWorld; - positionAppropriately. - ^self - ]. - nav - listOfPages: coll; - threadName: nameOfThread index: anInteger; - removeAllMorphs; - addButtons. - - ! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>openThreadNamed:atIndex:beKeyboardHandler: (in category 'known threads') ----- - openThreadNamed: nameOfThread atIndex: anInteger beKeyboardHandler: aBoolean - "Activate the thread of the given name, from the given index; set it up to be navigated via desktop keys if indicated" - - | coll nav | - - coll := self knownThreads at: nameOfThread ifAbsent: [^self]. - nav := Project current world - submorphThat: [ :each | (each isKindOf: self) and: [each threadName = nameOfThread]] - ifNone: - [nav := self basicNew. - nav - listOfPages: coll; - threadName: nameOfThread index: anInteger; - initialize; - openInWorld; - positionAppropriately. - aBoolean ifTrue: [Project current world keyboardNavigationHandler: nav]. - ^ self]. - nav - listOfPages: coll; - threadName: nameOfThread index: anInteger; - removeAllMorphs; - addButtons. - aBoolean ifTrue: [Project current world keyboardNavigationHandler: nav].! Item was removed: - ----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') ----- - sorterFormForProject: aProject sized: aSize - "Answer a form to use in a project-sorter to represent the project." - - ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>acceptSortedContentsFrom: (in category 'sorting') ----- - acceptSortedContentsFrom: aHolder - "Update my page list from the given page sorter." - - - - threadName isEmpty ifTrue: [threadName := 'I need a name' translated]. - threadName := UIManager default - request: 'Name this thread.' translated - initialAnswer: threadName. - threadName isEmptyOrNil ifTrue: [^self]. - listOfPages := OrderedCollection new. - aHolder submorphs withIndexDo: [:m :i | | cachedData proj nameOfThisProject | - (nameOfThisProject := m valueOfProperty: #nameOfThisProject) ifNotNil: [ - cachedData := {nameOfThisProject}. - proj := Project named: nameOfThisProject. - (proj isNil or: [proj thumbnail isNil]) ifFalse: [ - cachedData := cachedData, {proj thumbnail scaledToSize: self myThumbnailSize}. - ]. - listOfPages add: cachedData. - ]. - ]. - self class know: listOfPages as: threadName. - self removeAllMorphs; addButtons. - self world ifNil: [ - self openInWorld; positionAppropriately. - ]. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>addButtons (in category 'initialization') ----- - addButtons - - | marginPt i sz data images b1 b2 dot arrowWidth arrowHeight nameMorph sizeRatio controlsColor | - - sizeRatio := self sizeRatio. - controlsColor := Color orange lighter. - - self changeNoLayout. - self hResizing: #rigid. - self vResizing: #rigid. - marginPt := (4 @ 4 * sizeRatio) rounded.. - i := self currentIndex. - sz := self myThumbnailSize. - arrowWidth := (14 * sizeRatio) rounded. - arrowHeight := (14 * sizeRatio) rounded. - data := { - {i - 1. 'Previous:'. #previousPage. #leftCenter. arrowWidth. 'Prev'}. - {i + 1. 'Next:'. #nextPage. #rightCenter. arrowWidth negated. 'Next'} - }. - images := data collect: [ :tuple | | pageNumber f vertices m arrowCenter | - pageNumber := tuple first. - (pageNumber between: 1 and: listOfPages size) ifTrue: [ - f := self - makeThumbnailForPageNumber: pageNumber - scaledToSize: sz - default: tuple sixth. - f := f deepCopy. "we're going to mess it up" - arrowCenter := f boundingBox perform: tuple fourth. - vertices := { - arrowCenter + (tuple fifth @ arrowHeight negated). - arrowCenter + (tuple fifth @ arrowHeight). - arrowCenter. - }. - f getCanvas - drawPolygon: vertices - color: controlsColor - borderWidth: 0 - borderColor: Color transparent. - m := ImageMorph new image: f. - m setBalloonText: tuple second translated,' ',(listOfPages at: pageNumber) first. - m addMouseUpActionWith: ( - MessageSend receiver: self selector: tuple third - ). - ] ifFalse: [ - f := (Form extent: sz depth: 16) fillColor: Color lightGray. - m := ImageMorph new image: f. - ]. - m - ]. - b1 := images first. - b2 := images second. - dot := EllipseMorph new extent: (18 at 18 * sizeRatio) rounded; color: controlsColor; borderWidth: 0. - - self addMorph: (b1 position: self position + marginPt). - self addMorph: (b2 position: b1 topRight + (marginPt x @ 0)). - - self extent: (b1 bottomRight max: b2 bottomRight) - self position + marginPt. - self addMorph: dot. - dot align: dot center with: b1 bounds rightCenter + ((marginPt x @ 0) // 2). - dot setBalloonText: threadName,' - more commands'. - dot on: #mouseDown send: #moreCommands to: self. - self fullBounds. - self addMorph: (nameMorph := SquishedNameMorph new). - nameMorph - target: self getSelector: #threadName setSelector: nil; - color: Color transparent; - width: self width; - height: (15 * sizeRatio) rounded; - align: nameMorph bottomLeft with: self bottomLeft. - - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') ----- - buttonForMenu - - ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>currentIndex (in category 'private') ----- - currentIndex - - | currentName | - - currentName := Project current name. - listOfPages withIndexDo: [ :each :index | - (each first = currentName and: [preferredIndex = index]) ifTrue: [^currentIndex := index] - ]. - listOfPages withIndexDo: [ :each :index | - each first = currentName ifTrue: [^currentIndex := index] - ]. - - currentIndex isNil - ifTrue: [^ 1]. - - ^ currentIndex min: listOfPages size - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^(Color r: 0.27 g: 0.634 b: 0.365) alpha: 0.5! Item was removed: - ----- Method: InternalThreadNavigationMorph>>deleteCurrentPage (in category 'navigation') ----- - deleteCurrentPage - - "no-op here"! Item was removed: - ----- Method: InternalThreadNavigationMorph>>destroyThread (in category 'navigation') ----- - destroyThread - "Manually destroy the thread" - - (self confirm: ('Destroy thread <{1}> ?' translated format:{threadName})) ifFalse: [^ self]. - self class knownThreads removeKey: threadName ifAbsent: []. - self setProperty: #moribund toValue: true. "In case pointed to in some other project" - self currentWorld keyboardNavigationHandler == self ifTrue: - [self stopKeyboardNavigation]. - self delete.! Item was removed: - ----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') ----- - editThisThread - - | sorter | - - sorter := ProjectSorterMorph new. - sorter navigator: self listOfPages: listOfPages. - self currentWorld addMorphFront: sorter. - sorter align: sorter topCenter with: self currentWorld topCenter. - self delete. - - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>ensureSuitableDefaults (in category 'initialization') ----- - ensureSuitableDefaults - - listOfPages ifNil: [ - listOfPages := Project allMorphicProjects collect: [ :each | {each name}]. - threadName := 'all (default)' translated. - self class know: listOfPages as: threadName. - ]. - currentIndex ifNil: [currentIndex := 0]. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>getRecentThread (in category 'navigation') ----- - getRecentThread - - self switchToThread: ( - ProjectHistory currentHistory mostRecentThread ifNil: [^self] - ) - - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>insertNewProject (in category 'navigation') ----- - insertNewProject - - | newProj | - - [newProj := MorphicProject openViewOn: nil.] - on: ProjectViewOpenNotification - do: [ :ex | ex resume: false]. - - Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| - aClass - getFullInfoFor: newProj - ifValid: [self insertNewProjectActionFor: newProj] - expandedFormat: false. - ]. - - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>insertNewProjectActionFor: (in category 'navigation') ----- - insertNewProjectActionFor: newProj - - | me | - - me := Project current name. - listOfPages withIndexDo: [ :each :index | - each first = me ifTrue: [ - listOfPages add: {newProj name} afterIndex: index. - ^self switchToThread: threadName. - ]. - ]. - listOfPages add: {newProj name} afterIndex: listOfPages size. - ^self switchToThread: threadName - - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>jumpToIndex: (in category 'navigation') ----- - jumpToIndex: anInteger - - currentIndex := anInteger. - self loadPageWithProgress.! Item was removed: - ----- Method: InternalThreadNavigationMorph>>jumpWithinThread (in category 'navigation') ----- - jumpWithinThread - - | aMenu me weHaveOthers myIndex | - - me := Project current name. - aMenu := MenuMorph new defaultTarget: self. - weHaveOthers := false. - myIndex := self currentIndex. - listOfPages withIndexDo: [ :each :index | - index = myIndex ifTrue: [ - aMenu add: 'you are here' translated action: #yourself. - aMenu lastSubmorph color: Color red. - ] ifFalse: [ - weHaveOthers := true. - aMenu add: ('jump to <{1}>' translated format:{each first}) selector: #jumpToIndex: argument: index. - myIndex = (index - 1) ifTrue: [ - aMenu lastSubmorph color: Color blue - ]. - myIndex = (index + 1) ifTrue: [ - aMenu lastSubmorph color: Color orange - ]. - ]. - ]. - weHaveOthers ifFalse: [^self inform: 'This is the only project in this thread' translated]. - aMenu popUpEvent: self world primaryHand lastEvent in: self world! Item was removed: - ----- Method: InternalThreadNavigationMorph>>listOfPages: (in category 'private') ----- - listOfPages: aCollection - - listOfPages := aCollection. - currentIndex := nil. - self currentIndex - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>loadPageWithProgress (in category 'private') ----- - loadPageWithProgress - "Load the desired page, showing a progress indicator as we go" - - | projectInfo projectName beSpaceHandler | - projectInfo := listOfPages at: currentIndex. - projectName := projectInfo first. - loadedProject := Project named: projectName. - self class know: listOfPages as: threadName. - beSpaceHandler := (Project current world keyboardNavigationHandler == self). - self currentWorld addDeferredUIMessage: - [InternalThreadNavigationMorph openThreadNamed: threadName atIndex: currentIndex beKeyboardHandler: beSpaceHandler]. - - loadedProject ifNil: [ - ComplexProgressIndicator new - targetMorph: self; - historyCategory: 'project loading' translated; - withProgressDo: [ - [ - loadedProject := Project current - fromMyServerLoad: projectName - ] - on: ProjectViewOpenNotification - do: [ :ex | ex resume: false] - "we probably don't want a project view morph in this case" - ]. - ]. - loadedProject ifNil: [ - ^self inform: 'I cannot find that project' translated - ]. - self delete. - - loadedProject enter.! Item was removed: - ----- Method: InternalThreadNavigationMorph>>makeThumbnailForPageNumber:scaledToSize:default: (in category 'sorting') ----- - makeThumbnailForPageNumber: pageNumber scaledToSize: sz default: aString - - | cachedData proj tn label | - cachedData := listOfPages at: pageNumber. - proj := Project named: cachedData first. - (proj isNil or: [proj thumbnail isNil]) ifTrue: [ - cachedData size >= 2 ifTrue: [^cachedData second]. - tn := Form extent: sz depth: 8. - tn fillColor: Color veryLightGray. - label := (StringMorph contents: aString) imageForm. - label displayOn: tn at: tn center - (label extent // 2) rule: Form paint. - ^tn - ]. - tn := proj thumbnail scaledToSize: sz. - cachedData size < 2 ifTrue: [ - cachedData := cachedData,#(0). - listOfPages at: pageNumber put: cachedData. - ]. - cachedData at: 2 put: tn. - ^tn - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>moreCommands (in category 'navigation') ----- - moreCommands - "Put up a menu of options" - - | allThreads aMenu others target | - allThreads := self class knownThreads. - aMenu := MenuMorph new defaultTarget: self. - aMenu addTitle: 'navigation' translated. - - Preferences noviceMode ifFalse:[ - self flag: #deferred. "Probably don't want that stay-up item, not least because the navigation-keystroke stuff is not dynamically handled" - aMenu addStayUpItem - ]. - - others := (allThreads keys reject: [ :each | each = threadName]) asArray sort. - others do: [ :each | - aMenu add: ('switch to <{1}>' translated format:{each}) selector: #switchToThread: argument: each - ]. - - aMenu addList: { - {'switch to recent projects' translated. #getRecentThread}. - #-. - {'create a new thread' translated. #threadOfNoProjects}. - {'edit this thread' translated. #editThisThread}. - {'create thread of all projects' translated. #threadOfAllProjects}. - #-. - {'First project in thread' translated. #firstPage}. - {'Last project in thread' translated. #lastPage} - }. - - (target := self currentIndex + 2) > listOfPages size ifFalse: [ - aMenu - add: ('skip over next project ({1})' translated format:{(listOfPages at: target - 1) first}) - action: #skipOverNext - ]. - - aMenu addList: { - {'jump within this thread' translated. #jumpWithinThread}. - {'insert new project' translated. #insertNewProject}. - #-. - {'simply close this navigator' translated. #delete}. - {'destroy this thread' translated. #destroyThread}. - #- - }. - - (self currentWorld keyboardNavigationHandler == self) ifFalse:[ - aMenu add: 'start keyboard navigation with this thread' translated action: #startKeyboardNavigation - ] - ifTrue: [ - aMenu add: 'stop keyboard navigation with this thread' translated action: #stopKeyboardNavigation - ]. - - aMenu popUpInWorld.! Item was removed: - ----- Method: InternalThreadNavigationMorph>>myThumbnailSize (in category 'navigation') ----- - myThumbnailSize - ^ (52 @ 39 * self sizeRatio) rounded! Item was removed: - ----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') ----- - positionAppropriately - - | others world otherRects overlaps bottomRight | - (self ownerThatIsA: HandMorph) ifNotNil: [^self]. - others := (world := Project currentWorld) submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]]. - otherRects := others collect: [ :each | each bounds]. - bottomRight := (world hasProperty: #threadNavigatorPosition) - ifTrue: [world valueOfProperty: #threadNavigatorPosition] - ifFalse: [world bottomRight]. - self align: self fullBounds bottomRight with: bottomRight. - self setProperty: #previousWorldBounds toValue: self world bounds. - - [ - overlaps := false. - otherRects do: [ :r | - (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top]. - ]. - self top < self world top ifTrue: [ - self bottom: bottomRight y. - self right: self left - 1. - ]. - overlaps - ] whileTrue.! Item was removed: - ----- Method: InternalThreadNavigationMorph>>showMenuFor:event: (in category 'menu') ----- - showMenuFor: actionSelector event: evt - - self perform: actionSelector - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') ----- - sizeRatio - "answer the size ratio for the receiver" - - ^ 1.0 - - "^ Preferences standardMenuFont height / 12" "Good grief!!"! Item was removed: - ----- Method: InternalThreadNavigationMorph>>skipOverNext (in category 'navigation') ----- - skipOverNext - - | target | - - (target := self currentIndex + 2) > listOfPages size ifTrue: [^Beeper beep]. - currentIndex := target. - self loadPageWithProgress. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>startKeyboardNavigation (in category 'navigation') ----- - startKeyboardNavigation - "Tell the active world to starting navigating via desktop keyboard navigation via me" - - self currentWorld keyboardNavigationHandler: self! Item was removed: - ----- Method: InternalThreadNavigationMorph>>step (in category 'stepping') ----- - step - - super step. - (self valueOfProperty: #previousWorldBounds) = self world bounds ifFalse: [ - self positionAppropriately. - ]. - self class knownThreads - at: threadName - ifPresent: [ :known | - known == listOfPages ifFalse: [ - listOfPages := known. - self removeAllMorphs. - self addButtons. - ]. - ]. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>stopKeyboardNavigation (in category 'navigation') ----- - stopKeyboardNavigation - "Cease navigating via the receiver in response to desktop keystrokes" - - self currentWorld removeProperty: #keyboardNavigationHandler! Item was removed: - ----- Method: InternalThreadNavigationMorph>>switchToThread: (in category 'navigation') ----- - switchToThread: newName - - threadName := newName. - listOfPages := self class knownThreads at: threadName. - self removeAllMorphs. - self addButtons. - self currentIndex. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>threadName (in category 'navigation') ----- - threadName - - ^threadName! Item was removed: - ----- Method: InternalThreadNavigationMorph>>threadName:index: (in category 'navigation') ----- - threadName: aString index: anInteger - - threadName := aString. - preferredIndex := anInteger. - self currentIndex.! Item was removed: - ----- Method: InternalThreadNavigationMorph>>threadOfAllProjects (in category 'navigation') ----- - threadOfAllProjects - - | nameList nav | - - nameList := Project allMorphicProjects collect: [ :each | {each name}]. - nav := self class basicNew. - nav - listOfPages: nameList; - threadName: '' index: nil; - initialize. - nav editThisThread. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>threadOfNoProjects (in category 'navigation') ----- - threadOfNoProjects - - | nameList nav | - - nameList := { {Project current name} }. - nav := self class basicNew. - nav - listOfPages: nameList; - threadName: '' index: nil; - initialize. - nav editThisThread. - ! Item was removed: - ----- Method: InternalThreadNavigationMorph>>triggerActionFromPianoRoll (in category 'piano rolls') ----- - triggerActionFromPianoRoll - - WorldState addDeferredUIMessage: - [ | proj | - self currentIndex >= listOfPages size - ifTrue: [Beeper beep] - ifFalse: - [currentIndex := self currentIndex + 1. - proj := Project named: ((listOfPages at: currentIndex) first). - proj world setProperty: #letTheMusicPlay toValue: true. - proj enter]]! Item was removed: - PianoKeyboardMorph subclass: #KeyboardMorphForInput - instanceVariableNames: 'pianoRoll duration durationModifier articulation buildingChord insertMode prevSelection startOfNextNote chordSemitones chordDictionary' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! - - !KeyboardMorphForInput commentStamp: 'nice 3/24/2010 07:37' prior: 0! - This class adds state and controls to the basic PianoKeyboardMorph so that notes of reliable duration can be keyed into a score without the need for a real keyboard. - - To try this out, execute... - - | n score | n := 3. - score := (MIDIScore new tracks: ((1 to: n) collect: [:i | Array new]); - trackInfo: ((1 to: n) collect: [:i | 'Instrument' , i printString]); - tempoMap: nil; ticksPerQuarterNote: 96). - ScorePlayerMorph openOn: score title: 'empty score' - - Then open a pianoRoll and, from that, open a keyboard. The rule is that the keyboard will append after the current selection. If the current selection is muted or nil, then input will go to the end of the first non-muted track.! Item was removed: - ----- Method: KeyboardMorphForInput>>addChordControls (in category 'initialization') ----- - addChordControls - | switch chordRow | - chordRow := AlignmentMorph newRow. - chordRow color: color; borderWidth: 0; layoutInset: 0. - chordRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'maj' translated; - actionSelector: #chords:onOff:; arguments: #(maj)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'min' translated; - actionSelector: #chords:onOff:; arguments: #(min)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'dim' translated; - actionSelector: #chords:onOff:; arguments: #(dim)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'maj7' translated; - actionSelector: #chords:onOff:; arguments: #(maj7)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'min7' translated; - actionSelector: #chords:onOff:; arguments: #(min7)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'dom7' translated; - actionSelector: #chords:onOff:; arguments: #(dom7)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'sus2' translated; - actionSelector: #chords:onOff:; arguments: #(sus2)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'sus4' translated; - actionSelector: #chords:onOff:; arguments: #(sus4)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - chordRow addMorphBack: (switch label: 'aug' translated; - actionSelector: #chords:onOff:; arguments: #(aug)). - ^chordRow - ! Item was removed: - ----- Method: KeyboardMorphForInput>>addNoteEventAt:rootNote: (in category 'simple keyboard') ----- - addNoteEventAt: eventTime rootNote: rootNote - | noteEvent noteEvents semitones | - semitones := chordSemitones. - buildingChord ifFalse:[ semitones := #(0)]. - noteEvents := OrderedCollection new. - semitones do: - [: semitone | noteEvent := NoteEvent new time: eventTime; duration: self noteDuration; - key: rootNote + semitone velocity: self velocity channel: 1. - pianoRoll appendEvent: noteEvent fullDuration: self fullDuration. - noteEvents add: noteEvent]. - ^noteEvents! Item was removed: - ----- Method: KeyboardMorphForInput>>addRecordingControls (in category 'initialization') ----- - addRecordingControls - | button switch playRow durRow articRow modRow chordRow | - - "Add chord, rest and delete buttons" - playRow := AlignmentMorph newRow. - playRow color: color; borderWidth: 0; layoutInset: 0. - playRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - playRow addMorphBack: (switch label: 'chord' translated; actionSelector: #buildChord:). - button := SimpleButtonMorph new target: self; - borderStyle: (BorderStyle raised width: 2); color: color. - playRow addMorphBack: (button label: ' rest ' translated; actionSelector: #emitRest). - button := SimpleButtonMorph new target: self; - borderStyle: (BorderStyle raised width: 2); color: color. - playRow addMorphBack: (button label: 'del' translated; actionSelector: #deleteNotes). - self addMorph: playRow. - playRow align: playRow fullBounds topCenter - with: self fullBounds bottomCenter. - - chordRow := self addChordControls. - self addMorph: chordRow. - chordRow align: chordRow fullBounds topCenter - with: playRow fullBounds bottomCenter. - - "Add note duration buttons" - durRow := AlignmentMorph newRow. - durRow color: color; borderWidth: 0; layoutInset: 0. - durRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - durRow addMorphBack: (switch label: 'whole' translated; - actionSelector: #duration:onOff:; arguments: #(1)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - durRow addMorphBack: (switch label: 'half' translated; - actionSelector: #duration:onOff:; arguments: #(2)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - durRow addMorphBack: (switch label: 'quarter' translated; - actionSelector: #duration:onOff:; arguments: #(4)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - durRow addMorphBack: (switch label: 'eighth' translated; - actionSelector: #duration:onOff:; arguments: #(8)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - durRow addMorphBack: (switch label: 'sixteenth' translated; - actionSelector: #duration:onOff:; arguments: #(16)). - self addMorph: durRow. - durRow align: durRow fullBounds topCenter - with: chordRow fullBounds bottomCenter. - - "Add note duration modifier buttons" - modRow := AlignmentMorph newRow. - modRow color: color; borderWidth: 0; layoutInset: 0. - modRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - modRow addMorphBack: (switch label: 'dotted' translated; - actionSelector: #durMod:onOff:; arguments: #(dotted)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - modRow addMorphBack: (switch label: 'normal' translated; - actionSelector: #durMod:onOff:; arguments: #(normal)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - modRow addMorphBack: (switch label: 'triplets' translated; - actionSelector: #durMod:onOff:; arguments: #(triplets)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - modRow addMorphBack: (switch label: 'quints' translated; - actionSelector: #durMod:onOff:; arguments: #(quints)). - self addMorph: modRow. - modRow align: modRow fullBounds topCenter - with: durRow fullBounds bottomCenter. - - "Add articulation buttons" - articRow := AlignmentMorph newRow. - articRow color: color; borderWidth: 0; layoutInset: 0. - articRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - articRow addMorphBack: (switch label: 'legato' translated; - actionSelector: #articulation:onOff:; arguments: #(legato)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - articRow addMorphBack: (switch label: 'normal' translated; - actionSelector: #articulation:onOff:; arguments: #(normal)). - switch := SimpleSwitchMorph new target: self; borderWidth: 2; - offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. - articRow addMorphBack: (switch label: 'staccato' translated; - actionSelector: #articulation:onOff:; arguments: #(staccato)). - self addMorph: articRow. - articRow align: articRow fullBounds topCenter - with: modRow fullBounds bottomCenter. - - self bounds: (self fullBounds expandBy: (0 at 0 extent: 0 @ self borderWidth)) - ! Item was removed: - ----- Method: KeyboardMorphForInput>>articulation:onOff: (in category 'note controls') ----- - articulation: artic onOff: ignored "artic = eg, #legato, #normal, #staccato." - "Set the articulation of notes to be emitted when a key is pressed." - - self allMorphsDo: - [:m | ((m isMemberOf: SimpleSwitchMorph) - and: [m actionSelector == #articulation:onOff:]) - ifTrue: [m setSwitchState: m arguments first == artic]]. - articulation := artic! Item was removed: - ----- Method: KeyboardMorphForInput>>backspaceNote (in category 'note controls') ----- - backspaceNote - - self deleteNotes! Item was removed: - ----- Method: KeyboardMorphForInput>>buildChord: (in category 'note controls') ----- - buildChord: onOff - buildingChord := buildingChord not.! Item was removed: - ----- Method: KeyboardMorphForInput>>chords:onOff: (in category 'note controls') ----- - chords: chord onOff: ignored - "Select the semi tones of the chord from the chordDictonary." - - self allMorphsDo: - [:m | ((m isMemberOf: SimpleSwitchMorph) - and: [m actionSelector == #chords:onOff:]) - ifTrue: [m setSwitchState: m arguments first = chord]]. - chordSemitones := chordDictionary at: chord. - ! Item was removed: - ----- Method: KeyboardMorphForInput>>deleteNotes (in category 'note controls') ----- - deleteNotes - - pianoRoll deleteSelection! Item was removed: - ----- Method: KeyboardMorphForInput>>durMod:onOff: (in category 'note controls') ----- - durMod: durMod onOff: ignored "durMod = eg, #dotted, #normal, #triplets, #quints" - "Set the duration of notes to be emitted when a key is pressed." - - self allMorphsDo: - [:m | ((m isMemberOf: SimpleSwitchMorph) - and: [m actionSelector == #durMod:onOff:]) - ifTrue: [m setSwitchState: m arguments first = durMod]]. - durationModifier := durMod! Item was removed: - ----- Method: KeyboardMorphForInput>>duration:onOff: (in category 'note controls') ----- - duration: denom onOff: ignored "denom = eg, 1, 2, 4, 8, 16" - "Set the duration of notes to be emitted when a key is pressed." - - self allMorphsDo: - [:m | ((m isMemberOf: SimpleSwitchMorph) - and: [m actionSelector == #duration:onOff:]) - ifTrue: [m setSwitchState: m arguments first = denom]]. - duration := denom. - self durMod: #normal onOff: true! Item was removed: - ----- Method: KeyboardMorphForInput>>emitRest (in category 'note controls') ----- - emitRest - - | sel noteEvent | - - "All this selection logic should be shared with mouseDown..." - (sel := pianoRoll selection) ifNil: [^ self]. - insertMode ifTrue: - [sel := pianoRoll selectionForInsertion. - insertMode := false]. - sel = prevSelection ifFalse: - ["This is a new selection -- need to determine start time" - sel third = 0 - ifTrue: [startOfNextNote := 0] - ifFalse: [startOfNextNote := ((pianoRoll score tracks at: sel first) - at: sel third) endTime. - startOfNextNote := startOfNextNote + self fullDuration - 1 - truncateTo: self fullDuration]]. - noteEvent := NoteEvent new time: startOfNextNote; duration: self noteDuration; - key: -1 "my flag for rest" velocity: self velocity channel: 1. - pianoRoll appendEvent: noteEvent fullDuration: self fullDuration. - soundPlaying ifNotNil: [soundPlaying stopGracefully]. - prevSelection := pianoRoll selection. - startOfNextNote := startOfNextNote + self fullDuration.! Item was removed: - ----- Method: KeyboardMorphForInput>>fullDuration (in category 'note controls') ----- - fullDuration - - | num denom | - num := denom := 1. - durationModifier == #dotted ifTrue: [num := 3. denom := 2]. - durationModifier == #triplets ifTrue: [num := 2. denom := 3]. - durationModifier == #quints ifTrue: [num := 2. denom := 5]. - ^ pianoRoll score ticksPerQuarterNote * 4 * num // duration // denom! Item was removed: - ----- Method: KeyboardMorphForInput>>initChordDictionary (in category 'initialization') ----- - initChordDictionary - - chordDictionary := - {'maj' -> #(0 4 7). - 'min' -> #(0 3 7). - 'dim' -> #(0 3 6). - 'maj7' -> #(0 4 7 11). - 'min7' -> #(0 3 7 10). - 'dom7' -> #(0 4 7 10). - 'sus2' -> #(0 2 7). - 'sus4' -> #(0 5 7). - 'aug' -> #(0 4 8)} as: Dictionary! Item was removed: - ----- Method: KeyboardMorphForInput>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - buildingChord := false. - self addRecordingControls. - self duration: 4 onOff: true. - self durMod: #normal onOff: true. - self articulation: #normal onOff: true. - insertMode := false. - self initChordDictionary! Item was removed: - ----- Method: KeyboardMorphForInput>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') ----- - mouseDownPitch: midiKey event: event noteMorph: keyMorph - - | sel noteEvents | - event hand hasSubmorphs ifTrue: [^ self "no response if drag something over me"]. - keyMorph color: playingKeyColor. - (sel := pianoRoll selection) ifNil: [^ self]. - insertMode ifTrue: - [sel := pianoRoll selectionForInsertion. - insertMode := false]. - sel = prevSelection ifFalse: - ["This is a new selection -- need to determine start time" - sel third = 0 - ifTrue: [startOfNextNote := 0] - ifFalse: [startOfNextNote := ((pianoRoll score tracks at: sel first) - at: sel third) endTime. - startOfNextNote := startOfNextNote + self fullDuration - 1 - truncateTo: self fullDuration]]. - noteEvents := self addNoteEventAt:startOfNextNote rootNote: midiKey +23. - soundPlaying ifNotNil: [soundPlaying stopGracefully]. - (soundPlaying := self soundForEvent: noteEvents inTrack: sel first) play. - prevSelection := pianoRoll selection. - startOfNextNote := startOfNextNote + self fullDuration.! Item was removed: - ----- Method: KeyboardMorphForInput>>mouseUpPitch:event:noteMorph: (in category 'simple keyboard') ----- - mouseUpPitch: pitch event: event noteMorph: noteMorph - noteMorph color: ((#(0 1 3 5 6 8 10) includes: pitch\\12) - ifTrue: [whiteKeyColor] - ifFalse: [blackKeyColor]). - ! Item was removed: - ----- Method: KeyboardMorphForInput>>noteDuration (in category 'note controls') ----- - noteDuration - - articulation == #staccato ifTrue: [^ (self fullDuration * 0.65) asInteger]. - articulation == #normal ifTrue: [^ (self fullDuration * 0.8) asInteger]. - articulation == #legato ifTrue: [^ (self fullDuration * 0.95) asInteger]. - ! Item was removed: - ----- Method: KeyboardMorphForInput>>pianoRoll: (in category 'initialization') ----- - pianoRoll: prMorph - - pianoRoll := prMorph! Item was removed: - ----- Method: KeyboardMorphForInput>>soundForEvent:inTrack: (in category 'events') ----- - soundForEvent: noteEvents inTrack: trackIndex - - | sound player | - player := pianoRoll scorePlayer. - sound := MixedSound new. - noteEvents do:[: noteEvent| - sound add: ((player instrumentForTrack: trackIndex) - soundForMidiKey: noteEvent midiKey - dur: noteEvent duration / (pianoRoll scorePlayer ticksForMSecs: 1000) - loudness: (noteEvent velocity asFloat / 127.0)) - pan: (player panForTrack: trackIndex) - volume: player overallVolume * - (player volumeForTrack: trackIndex)]. - ^ sound - ! Item was removed: - ----- Method: KeyboardMorphForInput>>velocity (in category 'note controls') ----- - velocity - - ^ 80 "Later put a slider on the keyboard control"! Item was removed: - ImageMorph subclass: #LassoPatchMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !LassoPatchMorph commentStamp: 'sw 8/1/2004 13:27' prior: 0! - When dropped by the user, a cursor is presented, allowing the user to grab a rectangular patch from the screen.! Item was removed: - ----- Method: LassoPatchMorph class>>authoringPrototype (in category 'instance creation') ----- - authoringPrototype - "Answer a prototype for use in a parts bin" - - ^ self new image: (ScriptingSystem formAtKey: 'Lasso'); markAsPartsDonor; setBalloonText: 'Drop this on the desktop and you can then grab a patch from the screen with a lasso.'; yourself! Item was removed: - ----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Answer a description of the receiver to be used in a parts bin" - - ^ self partName: 'Lasso' translatedNoop - categories: {'Graphics' translatedNoop} - documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop! Item was removed: - ----- Method: LassoPatchMorph>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver. Sets its image to the lasso picture" - - super initialize. - self image: (ScriptingSystem formAtKey: 'Lasso')! Item was removed: - ----- Method: LassoPatchMorph>>initializeToStandAlone (in category 'initialization') ----- - initializeToStandAlone - "Initialize the receiver such that it can live on its own. Sets its image to the lasso picture" - - super initializeToStandAlone. - self image: (ScriptingSystem formAtKey: 'Lasso')! Item was removed: - ----- Method: LassoPatchMorph>>justDroppedInto:event: (in category 'dropping') ----- - justDroppedInto: aPasteUpMorph event: anEvent - "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph" - - super justDroppedInto: aPasteUpMorph event: anEvent. - - aPasteUpMorph isPartsBin ifFalse: [ - "Do not show this morph in the screenshot." - self hide. - anEvent hand hide. - self refreshWorld. - - [aPasteUpMorph grabLassoFromScreen: anEvent] - ensure: [anEvent hand show]]. - - "Just needed for this operation. Remove." - self delete.! Item was removed: - ----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') ----- - wantsToBeDroppedInto: aMorph - "Only wanted by the world" - - ^ aMorph isWorldMorph! Item was removed: - Morph subclass: #LedCharacterMorph - instanceVariableNames: 'char highlighted' - classVariableNames: 'BSegments CHSegmentOrigins CHSegments CVSegmentOrigins CVSegments DSegments TSegments' - poolDictionaries: '' - category: 'MorphicExtras-Leds'! - - !LedCharacterMorph commentStamp: 'cbr 7/27/2010 18:47' prior: 0! - I represent a character to be displayed on an LedMorph; I am a peer to LedDigitMorph. The char 36 is SPACE. - - I can live outside of LedMorphs, however. If you'd like to play with me, evaluate the following line: - - - LedCharacterMorph new char: $e; openInWorld! Item was removed: - ----- Method: LedCharacterMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^false! Item was removed: - ----- Method: LedCharacterMorph class>>initialize (in category 'class initialization') ----- - initialize - - CHSegmentOrigins := {0.2 at 0.1. 0.2 at 0.45. 0.2 at 0.8}. - CVSegmentOrigins := {0.1 at 0.2. 0.1 at 0.55. 0.8 at 0.2. 0.8 at 0.55}. - TSegments := { 0.25 at 0.25. 0.45 at 0.25. 0.55 at 0.25. 0.75 at 0.25. 0.25 at 0.6. 0.45 at 0.6. 0.55 at 0.6. 0.75 at 0.6. }. - BSegments := { 0.45 at 0.4. 0.25 at 0.4. 0.75 at 0.4. 0.55 at 0.4. 0.45 at 0.76. 0.25 at 0.76. 0.75 at 0.76. 0.55 at 0.76. }. - - DSegments := { - {false. false. false. false. false. false. false. false. }."0" - {false. false. false. false. false. false. false. false. }."1" - {false. false. false. false. false. false. false. false. }."2" - {false. false. false. false. false. false. false. false. }."3" - {false. false. false. false. false. false. false. false. }."4" - {false. false. false. false. false. false. false. false. }."5" - {false. false. false. false. false. false. false. false. }."6" - {false. false. false. false. false. false. false. false. }."7" - {false. false. false. false. false. false. false. false. }."8" - {false. false. false. false. false. false. false. false. }."9" - {false. false. false. false. false. false. false. false. }."A" - {false. false. false. false. false. false. false. false. }."B" - {false. false. false. false. false. false. false. false. }."C" - {false. false. false. false. false. false. false. false. }."D" - {false. false. false. false. false. false. false. false. }."E" - {false. false. false. false. false. false. false. false. }."F" - {false. false. false. false. false. false. false. false. }."G" - {false. false. false. false. false. false. false. false. }."H" - {false. false. false. false. false. false. false. false. }."I" - {false. false. false. false. false. false. false. false. }."J" - {false. false. false. true. false. false. false. false. }."K" - {false. false. false. false. false. false. false. false. }."L" - {true. false. false. true. false. false. false. false. }."M" - {true. false. false. false. false. false. true. false. }."N" - {false. true. true. false. true. false. false. true. }."O" - {false. false. false. false. false. false. false. false. }."P" - {false. false. false. false. false. false. true. false. }."Q" - {false. false. false. false. false. false. true. false. }."R" - {false. false. false. false. false. false. false. false. }."S" - {false. false. false. false. false. false. false. false. }."T" - {false. false. false. false. false. false. false. false. }."U" - {false. false. false. false. true. false. false. true. }."V" - {false. false. false. false. false. true. true. false. }."W" - {true. false. false. true. false. true. true. false. }."X" - {false. false. false. false. false. false. false. false. }."Y" - {false. false. false. true. false. true. false. false. }."Z" - {false. false. false. false. false. false. false. false. }}."SPACE" - - CHSegments := { - {true. false. true}."0" - {false. false. false}."1" - {true. true. true}."2" - {true. true. true}."3" - {false. true. false}."4" - {true. true. true}."5" - {true. true. true}."6" - {true. false. false}."7" - {true. true. true}."8" - {true. true. true}."9" - {true. true. false}."A" - {true. true. true}."B" - {true. false. true}."C" - {true. false. true}."D" - {true. true. true}."E" - {true. true. false}."F" - {true. true. true}."G" - {false. true. false}."H" - {false. false. false}."I" - {false. false. true}."J" - {false. true. false}."K" - {false. false. true}."L" - {false. false. false}."M" - {false. false. false}."N" - {false. false. false}."O" - {true. true. false}."P" - {true. false. true}."Q" - {true. true. false}."R" - {true. true. true}."S" - {false. true. true}."t" - {false. false. true}."U" - {false. false. false}."V" - {false. false. false}."W" - {false. false. false}."X" - {false. true. true}."Y" - {true. false. true}."Z" - {false. false. false.}}."SPACE" - CVSegments := { - {true. true. true. true}."0" - {false. false. true. true}."1" - {false. true. true. false}."2" - {false. false. true. true}."3" - {true. false. true. true}."4" - {true. false. false. true}."5" - {true. true. false. true}."6" - {false. false. true. true}."7" - {true. true. true. true}."8" - {true. false. true. true}."9" - {true. true. true. true}."A" - {true. true. true. true}."B" - {true. true. false. false}."C" - {true. true. true. true}."D" - {true. true. false. false}."E" - {true. true. false. false}."F" - {true. true. false. true}."G" - {true. true. true. true}."H" - {true. true. false. false}."I" - {false. true. true. true}."J" - {true. true. false. true}."K" - {true. true. false. false}."L" - {true. true. true. true}."N" - {true. true. true. true}."N" - {false. false. false. false}."O" - {true. true. true. false}."P" - {true. true. true. true}."q" - {true. true. true. false}."R" - {true. false. false. true}."S" - {true. true. false. false}."t" - {true. true. true. true}."U" - {true. false. true. false}."V" - {true. true. true. true}."w" - {false. false. false. false}."x" - {true. false. true. true}."y" - {false. false. false. false}."z" - {false. false. false. false}}."SPACE"! Item was removed: - ----- Method: LedCharacterMorph>>char (in category 'accessing') ----- - char - - ^ char ! Item was removed: - ----- Method: LedCharacterMorph>>char: (in category 'accessing') ----- - char: aCharacter - char := aCharacter digitValue. - char >= 0 & (char <= 35) ifFalse: [char := 36]! Item was removed: - ----- Method: LedCharacterMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color green! Item was removed: - ----- Method: LedCharacterMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | foregroundColor backgroundColor thickness hThickness vThickness hOffset vOffset i | - i := 0. - foregroundColor := highlighted - ifTrue: [Color white] - ifFalse: [color]. - backgroundColor := color darker darker darker. - hThickness := self height * 0.1. - vThickness := self width * 0.1. - thickness := hThickness min: vThickness. - vOffset := hThickness - thickness // 2 max: 0. - hOffset := vThickness - thickness // 2 max: 0. - aCanvas fillRectangle: self bounds color: backgroundColor. - CHSegmentOrigins with: (CHSegments at: char + 1) - do: [:o :isLit | aCanvas fillRectangle: (Rectangle origin: (self position + (0 @ vOffset) + (o * self extent)) rounded extent: (self width * 0.6 @ thickness) rounded) - color: (isLit - ifTrue: [foregroundColor] - ifFalse: [backgroundColor])]. - CVSegmentOrigins with: (CVSegments at: char + 1) - do: [:o :isLit | aCanvas fillRectangle: (Rectangle origin: (self position + (hOffset @ 0) + (o * self extent)) rounded extent: (thickness @ (self height * 0.25)) rounded) - color: (isLit - ifTrue: [foregroundColor] - ifFalse: [backgroundColor])]. - TSegments with: (DSegments at: char + 1) - do: - [:tOrigin :isLit | | bOrigin | - i := i + 1. - bOrigin := BSegments at: i. - aCanvas - line: self position x - hOffset + (self width * tOrigin x) @ (self position y - vOffset + (self height * tOrigin y)) - to: self position x + hOffset + (self width * bOrigin x) @ (self position y + vOffset + (self height * bOrigin y)) - width: thickness + 1 // 1.25 - color: (isLit - ifTrue: [foregroundColor] - ifFalse: [Color transparent])]! Item was removed: - ----- Method: LedCharacterMorph>>drawOnFills: (in category 'drawing') ----- - drawOnFills: aRectangle - - ^ true! Item was removed: - ----- Method: LedCharacterMorph>>highlighted (in category 'accessing') ----- - highlighted - - ^ highlighted! Item was removed: - ----- Method: LedCharacterMorph>>highlighted: (in category 'accessing') ----- - highlighted: aBoolean - - highlighted := aBoolean. - self changed.! Item was removed: - ----- Method: LedCharacterMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - highlighted := false. - char := 0! Item was removed: - Morph subclass: #LedDigitMorph - instanceVariableNames: 'digit highlighted' - classVariableNames: 'HSegmentOrigins HSegments VSegmentOrigins VSegments' - poolDictionaries: '' - category: 'MorphicExtras-Leds'! - - !LedDigitMorph commentStamp: '<historical>' prior: 0! - I am a 7-segment LED that can display a decimal digit! Item was removed: - ----- Method: LedDigitMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^false! Item was removed: - ----- Method: LedDigitMorph class>>initialize (in category 'class initialization') ----- - initialize - - HSegmentOrigins := {0.2 at 0.1. 0.2 at 0.45. 0.2 at 0.8}. - VSegmentOrigins := {0.1 at 0.2. 0.1 at 0.55. 0.8 at 0.2. 0.8 at 0.55}. - HSegments := { - {true. false. true}. - {false. false. false}. - {true. true. true}. - {true. true. true}. - {false. true. false}. - {true. true. true}. - {true. true. true}. - {true. false. false}. - {true. true. true}. - {true. true. true}. - {false. true. false}}. - VSegments := { - {true. true. true. true}. - {false. false. true. true}. - {false. true. true. false}. - {false. false. true. true}. - {true. false. true. true}. - {true. false. false. true}. - {true. true. false. true}. - {false. false. true. true}. - {true. true. true. true}. - {true. false. true. true}. - {false. false. false. false}}.! Item was removed: - ----- Method: LedDigitMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color green! Item was removed: - ----- Method: LedDigitMorph>>digit (in category 'accessing') ----- - digit - - ^ digit! Item was removed: - ----- Method: LedDigitMorph>>digit: (in category 'accessing') ----- - digit: anInteger - - digit := anInteger \\ 10 "make sure it stays between 0 and 9"! Item was removed: - ----- Method: LedDigitMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - | foregroundColor backgroundColor thickness hThickness vThickness hOffset vOffset | - foregroundColor := highlighted ifTrue: [Color white] ifFalse: [color]. - backgroundColor := color muchDarker. - hThickness := self height * 0.1. - vThickness := self width * 0.1. - thickness := hThickness min: vThickness. - vOffset := ((hThickness - thickness) // 2) max: 0. - hOffset := ((vThickness - thickness) // 2) max: 0. - aCanvas fillRectangle: self bounds color: backgroundColor. - "added to show the minus sign" - (digit asString = '-') ifTrue: [digit := 10]. - HSegmentOrigins with: (HSegments at: digit+1) do: - [:o :isLit | - aCanvas - fillRectangle: (Rectangle - origin: (self position + (0 at vOffset) + (o * self extent)) rounded - extent: ((self width * 0.6) @ thickness) rounded) - color: (isLit ifTrue: [foregroundColor] ifFalse: [backgroundColor])]. - VSegmentOrigins with: (VSegments at: digit+1) do: - [:o :isLit | - aCanvas - fillRectangle: (Rectangle - origin: (self position + (hOffset at 0) + (o * self extent)) rounded - extent: (thickness @ (self height * 0.25)) rounded) - color: (isLit ifTrue: [foregroundColor] ifFalse: [backgroundColor])]. - ! Item was removed: - ----- Method: LedDigitMorph>>drawOnFills: (in category 'drawing') ----- - drawOnFills: aRectangle - - ^ true! Item was removed: - ----- Method: LedDigitMorph>>highlighted (in category 'accessing') ----- - highlighted - - ^ highlighted! Item was removed: - ----- Method: LedDigitMorph>>highlighted: (in category 'accessing') ----- - highlighted: aBoolean - - highlighted := aBoolean. - self changed.! Item was removed: - ----- Method: LedDigitMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - highlighted := false. - digit := 0 ! Item was removed: - Morph subclass: #LedMorph - instanceVariableNames: 'digits chars value flashing flash string scroller scrollLoop' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Leds'! - - !LedMorph commentStamp: '<historical>' prior: 0! - I am a collection of LED digits that can display a decimal value. The display can be set to flash by sending flash: true. - - LedMorph can now display characters: - - LedMorph new string:'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; openInWorld - - Lowercase letters will be converted to Uppercase. Carachters not in the examle - above will be shown as SPACE which is char 36 in LedCharacterMorph. - - LedMorph new chars: 10; string:' I must get a life';flash:true;scrollLoop:true; openInWorld - - The number of letters is set by chars. - If chars is not specified it will be set to the string size. - When the string size is bigger than chars - the string will scroll across the led. WOW!! - scrollLoop let's you set the scrolling to start over once its finished. - - Enjoy. - - ! Item was removed: - ----- Method: LedMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^false! Item was removed: - ----- Method: LedMorph>>chars (in category 'accessing') ----- - chars - - ^ chars! Item was removed: - ----- Method: LedMorph>>chars: (in category 'accessing') ----- - chars: aNumber - chars := aNumber. - self removeAllMorphs. - 1 to: chars do: [:i | self addMorph: (LedCharacterMorph new color: color)]. - self layoutChanged. - self changed! Item was removed: - ----- Method: LedMorph>>color: (in category 'accessing') ----- - color: aColor - "set the receiver's color and the submorphs color" - super color: aColor. - self - submorphsDo: [:m | m color: aColor]! Item was removed: - ----- Method: LedMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color green! Item was removed: - ----- Method: LedMorph>>digits (in category 'accessing') ----- - digits - - ^ digits! Item was removed: - ----- Method: LedMorph>>digits: (in category 'accessing') ----- - digits: aNumber - - digits := aNumber. - self removeAllMorphs. - 1 to: digits do: [:i | self addMorph: (LedDigitMorph new color: color)]. - self layoutChanged. - self changed.! Item was removed: - ----- Method: LedMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - aCanvas fillRectangle: self bounds color: color darker darker. - ! Item was removed: - ----- Method: LedMorph>>flash (in category 'macpal') ----- - flash - - ^ flash! Item was removed: - ----- Method: LedMorph>>flash: (in category 'accessing') ----- - flash: aBoolean - - flash := aBoolean.! Item was removed: - ----- Method: LedMorph>>highlighted: (in category 'accessing') ----- - highlighted: aBoolean - - self submorphsDo: [:m | m highlighted: aBoolean]! Item was removed: - ----- Method: LedMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - flashing := false. - flash := false. - self scrollInit. - self digits: 2. - self value: 0! Item was removed: - ----- Method: LedMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - - super layoutChanged. - submorphs withIndexDo: - [:m :i | - m - position: self position + (((i-1) * self width / digits) rounded @ 0); - extent: (self width / digits) rounded @ self height]! Item was removed: - ----- Method: LedMorph>>scrollInit (in category 'initialization') ----- - scrollInit - - chars := 0. - scroller := 1. - string := ''. - scrollLoop := false. - ! Item was removed: - ----- Method: LedMorph>>scrollLoop (in category 'accessing') ----- - scrollLoop - - ^ scrollLoop! Item was removed: - ----- Method: LedMorph>>scrollLoop: (in category 'accessing') ----- - scrollLoop: aBoolean - - scrollLoop := aBoolean.! Item was removed: - ----- Method: LedMorph>>step (in category 'stepping and presenter') ----- - step - (flash or: [flashing]) - ifTrue: - [flashing := flashing not. - self highlighted: flashing]. - scroller ifNil: [scroller := 1]. - chars ifNil: [^ self]. - scroller + chars < (string size + 1) - ifTrue: - [scroller := scroller + 1. - self stringToLed] - ifFalse: [scrollLoop ifTrue: [scroller := 1]]! Item was removed: - ----- Method: LedMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^ 500! Item was removed: - ----- Method: LedMorph>>string (in category 'accessing') ----- - string - - ^ string! Item was removed: - ----- Method: LedMorph>>string: (in category 'accessing') ----- - string: aString - string := aString. - chars = 0 - ifTrue: - [chars := string size. - self chars: chars]. - self stringToLed! Item was removed: - ----- Method: LedMorph>>stringToLed (in category 'accessing') ----- - stringToLed - | i k actualString | - i := scroller ifNil: [1]. - k := 1. - actualString := String new: chars. - actualString do: - [:m | - i > string size ifFalse: [actualString at: k put: (string at: i) asUppercase asCharacter]. - i := i + 1. - k := k + 1]. - i := 1. - submorphs do: - [:m | - m char: (actualString at: i). - i := i + 1]. - self changed! Item was removed: - ----- Method: LedMorph>>value (in category 'accessing') ----- - value - - ^ value! Item was removed: - ----- Method: LedMorph>>value: (in category 'accessing') ----- - value: aNumber - - | val | - value := aNumber. - val := value. - submorphs reverseDo: - [:m | - m digit: val \\ 10. - val := val // 10]. - self changed.! Item was removed: - LedMorph subclass: #LedTimerMorph - instanceVariableNames: 'counting startSeconds' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Leds'! Item was removed: - ----- Method: LedTimerMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^false! Item was removed: - ----- Method: LedTimerMorph>>continue (in category 'accessing') ----- - continue - - counting := true! Item was removed: - ----- Method: LedTimerMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - counting := false. - startSeconds := Time totalSeconds! Item was removed: - ----- Method: LedTimerMorph>>pause (in category 'accessing') ----- - pause - - counting ifTrue: [self updateTime]. - counting := false! Item was removed: - ----- Method: LedTimerMorph>>reset (in category 'accessing') ----- - reset - - startSeconds := Time totalSeconds. - self value: 0.! Item was removed: - ----- Method: LedTimerMorph>>resume (in category 'accessing') ----- - resume - - counting ifFalse: [ - counting := true. - startSeconds := (Time totalSeconds) - self value]! Item was removed: - ----- Method: LedTimerMorph>>start (in category 'stepping and presenter') ----- - start - - counting := true! Item was removed: - ----- Method: LedTimerMorph>>step (in category 'stepping and presenter') ----- - step - - flash - ifTrue: [super step] - ifFalse: [ - counting ifTrue: [self updateTime]]! Item was removed: - ----- Method: LedTimerMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^ 1000! Item was removed: - ----- Method: LedTimerMorph>>stop (in category 'stepping and presenter') ----- - stop - - counting ifTrue: [self updateTime]. - counting := false.! Item was removed: - ----- Method: LedTimerMorph>>updateTime (in category 'stepping and presenter') ----- - updateTime - - self value: Time totalSeconds - startSeconds. - self changed! Item was removed: - ----- Method: LineMorph class>>exampleBackArrow (in category '*MorphicExtras-examples') ----- - exampleBackArrow - "LineMorph exampleBackArrow openInHand" - - ^ (LineMorph from: 12 @ 0 to: 0 @ 0 color: Color black width: 1) - makeForwardArrow; - yourself! Item was removed: - ----- Method: LoopedSampledSound>>edit (in category '*MorphicExtras-Sound') ----- - edit - "Open a WaveEditor on this sound." - - | loopLen ed | - loopLen := scaledLoopLength asFloat / LoopIndexScaleFactor. - ed := WaveEditor new - data: leftSamples; - samplingRate: originalSamplingRate; - loopEnd: loopEnd; - loopLength: loopLen; - loopCycles: (loopLen / (originalSamplingRate asFloat / perceivedPitch)) rounded. - ed openInWorld. - ! Item was removed: - AlignmentMorph subclass: #MIDIControllerMorph - instanceVariableNames: 'channel controller midiPort lastValue' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: MIDIControllerMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'set channel' translated action: #setChannel:. - aCustomMenu add: 'set controller' translated action: #setController:. - ! Item was removed: - ----- Method: MIDIControllerMorph>>channel (in category 'accessing') ----- - channel - - ^ channel - ! Item was removed: - ----- Method: MIDIControllerMorph>>channel: (in category 'accessing') ----- - channel: anInteger - - channel := anInteger. - lastValue := nil. - self updateLabel. - ! Item was removed: - ----- Method: MIDIControllerMorph>>controller (in category 'accessing') ----- - controller - - ^ controller - ! Item was removed: - ----- Method: MIDIControllerMorph>>controller: (in category 'accessing') ----- - controller: anInteger - - controller := anInteger. - lastValue := nil. - self updateLabel. - ! Item was removed: - ----- Method: MIDIControllerMorph>>controllerList (in category 'menu') ----- - controllerList - "Answer a list of controller name, number pairs to be used in the menu." - - ^ #((1 modulation) - (2 'breath control') - (7 volume) - (10 pan) - (11 expression) - (92 'tremolo depth') - (93 'chorus depth') - (94 'celeste depth') - (95 'phaser depth')) - ! Item was removed: - ----- Method: MIDIControllerMorph>>controllerName: (in category 'menu') ----- - controllerName: controllerNumber - "Answer a name for the given controller. If no name is available, use the form 'CC5' (CC is short for 'continuous controller')." - - self controllerList do: [:pair | - pair first = controllerNumber ifTrue: [^ pair last]]. - ^ 'CC', controllerNumber asString - ! Item was removed: - ----- Method: MIDIControllerMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: MIDIControllerMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.484 - g: 0.613 - b: 0.0! Item was removed: - ----- Method: MIDIControllerMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - | slider | - super initialize. - "" - self listDirection: #topToBottom. - self wrapCentering: #center; - cellPositioning: #topCenter. - self hResizing: #shrinkWrap. - self vResizing: #shrinkWrap. - channel := 0. - controller := 7. - "channel volume" - slider := SimpleSliderMorph new target: self; - actionSelector: #newSliderValue:; - minVal: 0; - maxVal: 127; - extent: 128 @ 10. - self addMorphBack: slider. - self - addMorphBack: (StringMorph contents: 'Midi Controller'). - self updateLabel! Item was removed: - ----- Method: MIDIControllerMorph>>midiPort (in category 'accessing') ----- - midiPort - - ^ midiPort - ! Item was removed: - ----- Method: MIDIControllerMorph>>midiPort: (in category 'accessing') ----- - midiPort: anInteger - - midiPort := anInteger. - ! Item was removed: - ----- Method: MIDIControllerMorph>>newSliderValue: (in category 'other') ----- - newSliderValue: newValue - "Send a control command out the MIDI port." - - | val | - midiPort ifNil: [^ self]. - val := newValue asInteger. - lastValue = val ifTrue: [^ self]. - lastValue := val. - midiPort midiCmd: 16rB0 channel: channel byte: controller byte: val. - ! Item was removed: - ----- Method: MIDIControllerMorph>>setChannel: (in category 'menu') ----- - setChannel: evt - | menu | - menu := MenuMorph new. - 1 to: 16 do: [:chan | - menu add: chan printString - target: self - selector: #channel: - argumentList: (Array with: chan - 1)]. - - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: MIDIControllerMorph>>setController: (in category 'menu') ----- - setController: evt - | menu | - menu := MenuMorph new. - self controllerList do: [:pair | - menu add: (pair last) - target: self - selector: #controller: - argumentList: (Array with: pair first)]. - - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: MIDIControllerMorph>>updateLabel (in category 'other') ----- - updateLabel - - | label | - (label := self findA: StringMorph) ifNil: [^ self]. - label contents: (self controllerName: controller), ', ch: ', (channel + 1) printString. - ! Item was removed: - ----- Method: MIDIScore class>>extraExample (in category '*MorphicExtras-examples') ----- - extraExample - "(ScorePlayerMorph on: MIDIScore extraExample) openInWorld" - - | tracks | - tracks := self extraExampleTrackData collect: [:track | (ReferenceStream on: - (Base64MimeConverter mimeDecodeToBytes: track readStream)) next]. - ^ self new - tracks: tracks values trackInfo: tracks keys; - ticksPerQuarterNote: 96; - tempoMap: self extraExampleTempoMap; - yourself! Item was removed: - ----- Method: MIDIScore class>>extraExampleTempoMap (in category '*MorphicExtras-examples') ----- - extraExampleTempoMap - - ^ {0->750000 . 26496->769230 . 26592->789473 . 26688->810810 . 26784->833333 . 26880->857142 . 26976->882352 . 27072->909090} - collect: [:tempoData | TempoEvent time: tempoData key tempo: tempoData value]! Item was removed: - ----- Method: MIDIScore class>>extraExampleTrackData (in category '*MorphicExtras-examples') ----- (excessive size, no diff calculated) Item was removed: - BorderedMorph subclass: #MagnifierMorph - instanceVariableNames: 'magnification trackPointer srcExtent showPointer' - classVariableNames: 'RecursionLock' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !MagnifierMorph commentStamp: '<historical>' prior: 0! - MagnifierMorph instances are magnifying lenses that magnify the morphs below them (if grabbed or if trackPointer is false) or the area around the mouse pointer. - - Instance variables: - - magnification <Number> The magnification to use. If non-integer, smooths the magnified form. - - trackPointer <Boolean> If set, magnifies the area around the Hand. If not, magnfies the area underneath the magnifier center. - - showPointer <Boolean> If set, display a small reversed rectangle in the center of the lens. Also enables the display of Morphs in the Hand itself. - - srcExtent <Rectangle> The extent of the source rectangle. - - Class variables: - - RecursionLock <MagnifierMorph|nil> Used to avoid infinite recursion when getting the source patch to display.! Item was removed: - ----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Magnifier' translatedNoop - categories: {'Just for Fun' translatedNoop} - documentation: 'A magnifying glass' translatedNoop! Item was removed: - ----- Method: MagnifierMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry.! Item was removed: - ----- Method: MagnifierMorph class>>newRound (in category 'instance creation') ----- - newRound - "Answer a round Magnifier" - - | aMagnifier sm | - aMagnifier := self new. - sm := ScreeningMorph new position: aMagnifier position. - sm addMorph: aMagnifier. - sm addMorph: (EllipseMorph newBounds: aMagnifier bounds). - sm setNameTo: 'Magnifier'. - ^ sm! Item was removed: - ----- Method: MagnifierMorph class>>newShowingPointer (in category 'instance creation') ----- - newShowingPointer - "Answer a Magnifier that also displays Morphs in the Hand and the Hand position" - - ^(self new) - showPointer: true; - setNameTo: 'HandMagnifier'; - yourself! Item was removed: - ----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop} - forFlapNamed: 'Widgets']! Item was removed: - ----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') ----- - supplementaryPartsDescriptions - ^ {DescriptionForPartsBin - formalName: 'RoundGlass' translatedNoop - categoryList: {'Just for Fun' translatedNoop} - documentation: 'A round magnifying glass' translatedNoop - globalReceiverSymbol: #MagnifierMorph - nativitySelector: #newRound. - - DescriptionForPartsBin - formalName: 'Hand Magnifier' translatedNoop - categoryList: #() - documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop - globalReceiverSymbol: #MagnifierMorph - nativitySelector: #newShowingPointer }! Item was removed: - ----- Method: MagnifierMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: MagnifierMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu - addLine; - add: 'magnification...' translated action: #chooseMagnification; - addUpdating: #trackingPointerString action: #toggleTrackingPointer; - addUpdating: #showingPointerString action: #toggleShowingPointer.! Item was removed: - ----- Method: MagnifierMorph>>borderWidth: (in category 'accessing') ----- - borderWidth: anInteger - "Grow outwards preserving innerBounds" - | c | - c := self center. - super borderWidth: anInteger. - super extent: self defaultExtent. - self center: c.! Item was removed: - ----- Method: MagnifierMorph>>chooseMagnification (in category 'menu') ----- - chooseMagnification - | result | - result := UIManager default chooseFrom: #(1.5 2 4 8) values: #(1.5 2 4 8) - title: ('Choose magnification - (currently {1})' translated format:{magnification}). - (result isNil or: [result = magnification]) ifTrue: [^ self]. - magnification := result. - self extent: self extent. "round to new magnification" - self changed. "redraw even if extent wasn't changed"! Item was removed: - ----- Method: MagnifierMorph>>chooseMagnification: (in category 'menu') ----- - chooseMagnification: evt - | handle origin aHand currentMag | - currentMag := magnification. - aHand := evt ifNil: [self currentHand] ifNotNil: [evt hand]. - origin := aHand position y. - handle := HandleMorph new forEachPointDo: - [:newPoint | self magnification: (newPoint y - origin) / 8.0 + currentMag]. - aHand attachMorph: handle. - handle startStepping. - self changed. "Magnify handle"! Item was removed: - ----- Method: MagnifierMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: MagnifierMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color black! Item was removed: - ----- Method: MagnifierMorph>>defaultExtent (in category 'geometry') ----- - defaultExtent - ^(srcExtent * magnification) truncated + (2 * self borderWidth)! Item was removed: - ----- Method: MagnifierMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - super drawOn: aCanvas. "border and fill" - aCanvas isShadowDrawing ifFalse: [ - "Optimize because #magnifiedForm is expensive" - aCanvas paintImage: self magnifiedForm at: self innerBounds origin]! Item was removed: - ----- Method: MagnifierMorph>>extent: (in category 'geometry') ----- - extent: aPoint - "Round to multiples of magnification" - srcExtent := (aPoint - (2 * self borderWidth)) // magnification. - ^super extent: self defaultExtent! Item was removed: - ----- Method: MagnifierMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^evt yellowButtonPressed - or: [super handlesMouseDown: evt]! Item was removed: - ----- Method: MagnifierMorph>>hasTranslucentColor (in category 'accessing') ----- - hasTranslucentColor - "I may show what's behind me, so tell the hand to don't cache" - ^self sourceRect intersects: self bounds! Item was removed: - ----- Method: MagnifierMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - - trackPointer := true. - showPointer := false. - magnification := 2. - - self extent: 128 @ 128! Item was removed: - ----- Method: MagnifierMorph>>magnification: (in category 'magnifying') ----- - magnification: aNumber - | c | - magnification := aNumber min: 8 max: 0.5. - magnification := magnification roundTo: - (magnification < 3 ifTrue: [0.5] ifFalse: [1]). - srcExtent := srcExtent min: (512 at 512) // magnification. "to prevent accidents" - c := self center. - super extent: self defaultExtent. - self center: c.! Item was removed: - ----- Method: MagnifierMorph>>magnifiedForm (in category 'magnifying') ----- - magnifiedForm - "Answer the magnified form" - | srcRect form exclusion magnified | - srcRect := self sourceRectFrom: self sourcePoint. - (RecursionLock isNil and: [ self showPointer or: [ srcRect intersects: self bounds ]]) - ifTrue: [RecursionLock := self. - exclusion := self. - form := self currentWorld - patchAt: srcRect - without: exclusion - andNothingAbove: false. - RecursionLock := nil] - ifFalse: ["cheaper method if the source is not occluded" - form := Display copy: srcRect]. - "smooth if non-integer scale" - magnified := form - magnify: form boundingBox - by: magnification - smoothing: (magnification isInteger - ifTrue: [1] - ifFalse: [2]). - "display the pointer rectangle if desired" - self showPointer - ifTrue: [magnified - reverse: (magnified center - (2 @ 2) extent: 4 @ 4) - fillColor: Color white]. - ^ magnified! Item was removed: - ----- Method: MagnifierMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - evt yellowButtonPressed - ifTrue: [self chooseMagnification: evt] - ifFalse: [super mouseDown: evt]! Item was removed: - ----- Method: MagnifierMorph>>showPointer (in category 'menu') ----- - showPointer - ^showPointer ifNil: [ showPointer := false ].! Item was removed: - ----- Method: MagnifierMorph>>showPointer: (in category 'accessing') ----- - showPointer: aBoolean - "If aBoolean is true, display the current pointer position as a small square in the center of the lens." - - showPointer == aBoolean ifTrue: [ ^self ]. - showPointer := aBoolean. - self changed.! Item was removed: - ----- Method: MagnifierMorph>>showingPointerString (in category 'menu') ----- - showingPointerString - "Answer a string characterizing whether or not I'm showing the pointer." - - ^ (self showPointer - ifTrue: ['<yes>'] - ifFalse: ['<no>']), 'show pointer' translated! Item was removed: - ----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') ----- - sourcePoint - "If we are being dragged use our center, otherwise use pointer position" - ^(trackPointer not or: [owner notNil and: [owner isHandMorph]]) - ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]] - ifFalse: [self currentHand position]! Item was removed: - ----- Method: MagnifierMorph>>sourceRect (in category 'magnifying') ----- - sourceRect - ^self sourceRectFrom: self sourcePoint - ! Item was removed: - ----- Method: MagnifierMorph>>sourceRectFrom: (in category 'magnifying') ----- - sourceRectFrom: aPoint - ^ (aPoint extent: srcExtent) translateBy: (srcExtent // -2) + 1. - ! Item was removed: - ----- Method: MagnifierMorph>>step (in category 'stepping and presenter') ----- - step - self changed! Item was removed: - ----- Method: MagnifierMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^ 33 "ms = 30 frames-per-second"! Item was removed: - ----- Method: MagnifierMorph>>toggleShowingPointer (in category 'menu') ----- - toggleShowingPointer - self showPointer: self showPointer not! Item was removed: - ----- Method: MagnifierMorph>>toggleTrackingPointer (in category 'menu') ----- - toggleTrackingPointer - trackPointer := trackPointer not! Item was removed: - ----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') ----- - trackingPointerString - "Answer a string describing whether or not I'm currently tracking the pointer." - - ^ (trackPointer - ifTrue: ['<yes>'] - ifFalse: ['<no>']), 'track pointer' translated! Item was removed: - BorderedMorph subclass: #MarqueeMorph - instanceVariableNames: 'colors count' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalWidgets'! - - !MarqueeMorph commentStamp: '<historical>' prior: 0! - The MarqueeMorph is a subclass of the BorderedMorph which quickly cycles its border color. - - The implementation could be simplified and generalized. The color values and cycle speed are hard-coded for example.! Item was removed: - ----- Method: MarqueeMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - colors := {Color red. Color white. Color blue}. - count := 0! Item was removed: - ----- Method: MarqueeMorph>>step (in category 'stepping and presenter') ----- - step - - count := count + 1. - count > colors size ifTrue: [count := 1]. - self borderColor: (colors at: count)! Item was removed: - ----- Method: MarqueeMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Answer the desired time between steps in milliseconds." - - ^ 200! Item was removed: - ----- Method: MarqueeMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - - ^ true! Item was removed: - ----- Method: MatrixTransform2x3>>encodePostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - encodePostscriptOn: aStream - aStream writeMatrix:self. - ! Item was removed: - ----- Method: MenuIcons class>>backIcon (in category '*MorphicExtras-accessing - icons') ----- - backIcon - "Private - Generated method" - ^ Icons - at: #'back' - ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self backIconContents readStream) ].! Item was removed: - ----- Method: MenuIcons class>>backIconContents (in category '*MorphicExtras-private - icons') ----- - backIconContents - "Private - Method generated with the content of the file /home/dgd/back.png" - ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0 - RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADRElEQVRIie3WW4hVVRgH8N/e+5y56aCizpnR - jJzUCNFqLhqEWGlQDz0mGEJBCSL1Ur1YZA9BSIZGZg9dVBoo0B5D6qGwOzVaairZiJiKZ0hs - 1NE5c2bm7N3DmXF2zQyO5lv+YbFZa/2/77+/y9prcxNpNFnoHi3/xUU4LtYiszX5WGC/ULsW - m69XMLgqo8UzEhtRlVpNJJb62Tc3TnCxnH7bBR65sra0nt8vkC9Ah9Ay7U5d2Z+jUrUaoRqx - Hr/qGp9gk0cFPsB0UFfFugUsybH1N7YfS7O7UTE4/u2vgDze02ijXUrRCLFmzwtswwRhwGO3 - Wb55tcWNzQ75g7+KfNmZtqhEZoyXz2IKlutSIe+LNCnQ7A08NxRVuKHVywvXWG+lDXZ5SRs9 - A7Qd53g3pSQlG1GboTY7PKojNh/hXBFK+s0oC85XocoOrASzJ6p9+wE7c69I8K7PfKrdgBK4 - XYNWc+VMFgwGlkgU9Svo06OooOiksw7u3MPrhwySVmVAlTasAAummPzWg16oXWGdD+13fESe - ulxSZ5I7zTJHg1tNVxIr6FNQ1KlLuw7fOkJ9dTqHDwWarBJoA7lqPlqiflJO58gGuz78cJZn - fxya/ZQRutdQKZY1MKlifGJJzEA/A32UUs+4NDhispVcjtMRdmeU7BBag8iJM5yOmDmPYIwj - 2pXn5MGy2LhQl3pJF0O/2CuwBXzfS0cnR7+j9/IoUSWcPnINYuhNcRN/DnXpRFUOoFFNwKYa - wgJ1s2mYS1TuLedOceLAsIMwIsoSZEhC4oCBgD70xpzB9ktcGExr4PHhvLVqFPsaM02NeC2L - XjKVTJtVdp7vKNfufB1bznO2RLE03lhj5P5ZqBZ3SHyFnFsyrM+SFEaabqrm6CjrY6Mf79tn - 7cjOaDVfbA+mmRzyajUVqXpGE3g6NQ88IXZYKFISCUVioUAfetDjolOOKZbpo6HV3WK70SCL - F2uZ0V3eOzCFd64cm8/t8/C1hDr29dSqXuwT3AfuyjIvy66etPVT9tp2YwShWRZvYu0ouydd - MG8oVePFyOspjbxY3m4znMD9hm/90xJPOuzYmLZj4Oq/GENYZKqS1QKxPlsdNMqX4Sb+D/gb - LOgMCUjhiw4AAAAASUVORK5CYII='! Item was removed: - ----- Method: MenuIcons class>>forwardIcon (in category '*MorphicExtras-accessing - icons') ----- - forwardIcon - "Private - Generated method" - ^ Icons - at: #'forward' - ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self forwardIconContents readStream) ].! Item was removed: - ----- Method: MenuIcons class>>forwardIconContents (in category '*MorphicExtras-private - icons') ----- - forwardIconContents - "Private - Method generated with the content of the file /home/dgd/forward.png" - ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0 - RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAADXUlEQVRIie3WX2iVZRwH8M97znv2f1o2Fy4r - hxMvhhCeTewmJcuEbiLLP0GECoJWEIlYUBoR3QTVhRRIXffvJupiBF4oRCZukq5Na4LhlKnT - 6XE7c/P8ebs4O8fNlh3nVdEPHnif5/d8f9/3+33e53le/usRvyv0UknzzDXgQrmQ2IzJkt4V - 6BT4xVJfWKa5HFgwI7J27fIOmerQmMBOnfbeGWGrChXmoVZeSlZKjzQisEyznA4s1lhFWwMd - Z4tZIh0SNjk8vc03CZO2Yzcap32R6WLLIrYt5sgl3jvOudFiZlBki6O+vxVSsKTNK9iLurLJ - 4PkFLKy38YE1Wp5b7uT1P+hJEakV2KDJiAGHpipMSmAIdeoT7GwlGzGaJT2pjeUK49l8Aflw - HZtaqI57xwv22OhD33qj+2OZXYe5OFaYF/nIUTtMmB5ot0LeAbB5kSXbn9LqIRXCUksIBZOE - Dxl2RJ8T+ktjKy2x1RpN5lh7aY/Lr+6n71qR9EvjXtLjRijnyVKt+TVOOqtNiyc84kENQnGJ - Cef7XXLKgGtG9Ruc4u4B3Q7o1mKelxue9ennCYOv76fzMoENqmXxYiDpK6wD7y9ldVPZS3i7 - mKPe0PAQ6w/etDfwTIjh0qx0mounuXEdAUFAECMekqgkrCCsJFFReA7+/twYMkx9guVz+W7C - +rwVIVKlWUGK/vPlSQgC5rfSuGD6fD7H6V76SvXGBPbFBJM2aCpTHhlEEQO/E+X/mhu+TO9B - jl3lxETNyG5dTsbdb1xgK+gaY3YdFdXkagiqCWuIVxFWEYbEYhMkUUFFWEntPYWimXHOdHO2 - l5Fa3koVyQ5aaJteUYCYpAtoKFtdTYwd9zF/sGBtY3OBfOgcuSz5Wbw2zHgEXVilq7B0cUSa - jKEdNWURZiL6MqyMCkrTVxhNFZTnZ7MrzWgeesSt0ulKETr1GFviXjUqkJAVE8rLysnIqZKT - 0SzmR1SCfXVEIzfxV+t5e4QbEZzCY7oMTKa48+sp6TNsAetn8fi1wvY4Vssnw8Vb41c8rcuZ - W+EzIVyNH0r99gT9Oc6XvtavZWx2XHo6+Mwu4DY/iTx6y2hO5E1HfXA76Ex/MTbh50n930RW - /xMZM1VYxLZZK2/MQh2+kbuLWv/Hvyj+BJaPHpqZ0oo8AAAAAElFTkSuQmCC'! Item was removed: - ----- Method: MenuIcons class>>helpIcon (in category '*MorphicExtras-accessing - icons') ----- - helpIcon - "Private - Generated method" - ^ Icons - at: #'help' - ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self helpIconContents readStream) ].! Item was removed: - ----- Method: MenuIcons class>>helpIconContents (in category '*MorphicExtras-private - icons') ----- - helpIconContents - "Private - Method generated with the content of the file /home/dgd/help.png" - ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0 - RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAGoklEQVRIicWWeWxU1xWHv/fmzZvF4wF3AION - XXuKgSAT0yZhNaRKIMIToARSkbQJIVEw2CW0FRQEIoUUNWpLSCsFlECxUKpilsqCsFjESzFl - bGpsEG4DqUjBLRiN8W6P7Vk8753+ETCbIbSq2t8/V/e+q/vdc879HT34H0t5xH2PAbOByTfn - UeA68CngB/r+28COzXxt0GNYARDgLBEO08tFot3ANuAdIPxIQNmEejZAriK8BDhNCCkKn13r - 4srmSrLqrvJqE2nEo953QD19rKCFUkLXgTnA+YcBVYBzDXwT4SeGsB6T1yIma1eWEFtyXN88 - bNwzCzLRB4QBHKOXckJYNCXJEW/5aPpo68QTm9AeBNQAFJOAWGifuJMqwDrI49xvt+m+fXv3 - 2CyqlZ0VL6MMSwKLBSJRJNAEIvyUNt7Xe/ng19vx+XKUtetWZx49dqiyutbx98o8a9ctiICu - wF+jii2/n1y7jO01S8nxJLpLn587q7epuUlERM6cOSPzJk2TnvIqCZVXSaS8SowDx6T82RfF - 6XRKZWWl3Klfbnk35ozXwpqDKXcAFX/eoC2V+YPe6weeWcqERU/FfTZufEYkEomIiEhnZ1CK - i0+I3e6Ro08vktIn5knFs6/I56+ukinDU6SwsFAG0sof5cfcHkeAIcTfOr9yuSvTn+eu/TK6 - XJw75rHX7lLFX3lKRETa2jrkyJFyKSo6LpmZk2Q6HnkOj8zCI9PxSGKiV5qb2wYEBoNBSU0f - HhvscWzrB+a5X/HnufeoZ9/kceAvBZcGT16y+A2ZNjWbUCjMqVM1RKN9tLQ009p6PVqtB3tO - 2robTurBi+fjo1esVvOfM2Y8E6upqb3vYbhcLpblrrAYhrkUcJ3Kd+eLQr6uGKuoyaXoD4t4 - yxanSH39lZt1q5OiouPy4Ye/Mz2eYdfgdj3uVHZ2dlZqqjdYV1d3X5Tlf/SL7kTiB9tf8+e5 - L/tXOJMAVAUyV1fQk5aWHktLS6ejo4tr1wIAbN26paG1tWkucHogoN/vr+vrCy3ZuHFj8N5v - 4VAfSUkpjBo1ai7wZ0xLDoDWZ1A20mXd1Gpq2vz58zlXc562zhAOh4OOjmaVrzByIBA4Vlpa - epdJw+EI4XCE5KRkWtuax6jSN9vAeuJkvqtKnVLAb62XtZStjQoHVq6hOGMq7/U4yG4JEYtF - Enl4+1OAHaqq9t65eONGCwDd3d3YbHZt6keh68ARDUu2CiTOJ47nvGOwohDs6cWDhZt9UwOy - HgJ8B1jc29vrKSsr61/84ot/ICIEAg3YdL27arkjWRFllihGlQo0dWCACABxaSMB8GJFBWw2 - 2/cHAKlAHvD2ehJYb7hVn8/H7t27CQSa6Orqpr7+Ch2dHUxMsSWYivWoqLIme3v3BQDXHJxm - 1DZWzOMnpenAMdmZ8Lh4cciECRNkxIgRoZkzZ751R2rnAFcAeYN4ieCVKF75ZEqOaCji8y2U - PXsOSY7vO6I7kVULx+fe11ttKCVX+brE3lwnV3ftk9R4j6xbt04Mw5Bdu3bJkCFDRNM0w+12 - 96iqagBSwgiJ3oTFXv6hGOVV8umLy2QobklISBbNZpXMrNEdD6rFwnnESbN9jEwdniKrV6+X - 9vbOfk+1t7fLjh07ZMOGDeLz+QSQ0yRLVMuQ2HdXiFFeJe3FFXIkeYrsJl2ySBBQJGPMqIIH - AVWgJBlNdJsuP3/3fTl4sEQuXaqXWCx2l6EbGxsFkKJpPjH2HZVQeZU0Hi6Tkqzn5QBe+T3p - kkqc6DY9CiTcC7LcHAUo9gw2X4pqqsN/usLidLqx6S7q6xsIBnuIxQzC4QhWq87evfvxjh3H - 2Kee5GpFNRd+9gHdl68CsI8uziidaBYtxzCMC/cC7/JYbS4Na/5EXk2jXhiJRl3Dhqay4IXv - MSP7aRTl9taCggL8pWVsiyVgl9s3LqSLw0ordrv9x6FQ6DcDpfJeYLtuwTv5YxzOePfHXcGu - maCQOCyVMRmZjExJxaJaaGtt4+DBT8jDzSTsXCBCMZ18rob6TNNcABx9UO3uUm0uLdU/wHNr - bnfx7SGJg0ptcYqhOxHdoYrVoYnVroui6mJHFwVNQDGBQ8Dor2Lc++9xwxojEWitXspoVcGn - 0ll95BJLf1FLuhjm+NezePvkdcv+S4FIT1gYjVANHAYuPkpQd6X0bC7rTXgB6FXAA6xFwYuw - XCwswOQbirDliZ1kKl+W7d/WfY353OsMBfjWbpr7L7KM2WKyWBTCCvzqyZ387T+B/V/0L+bC - W2tds0/6AAAAAElFTkSuQmCC'! Item was removed: - ----- Method: MenuIcons class>>openIcon (in category '*MorphicExtras-accessing - icons') ----- - openIcon - "Private - Generated method" - ^ Icons - at: #'open' - ifAbsentPut:[ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: self openIconContents readStream) ].! Item was removed: - ----- Method: MenuIcons class>>openIconContents (in category '*MorphicExtras-private - icons') ----- - openIconContents - "Private - Method generated with the content of the file /home/dgd/open.png" - ^ 'iVBORw0KGgoAAAANSUhEUgAAABwAAAAcCAYAAAByDd+UAAAABHNCSVQICAgIfAhkiAAAABF0 - RVh0U29mdHdhcmUAU29kaXBvZGmU4xfQAAAGO0lEQVRIieWWW0wc5xXHf9/MzuwNFnNbYLFJ - ggFjgs1l1yYhqTExdlKlbpVA7FiK08qt3SqqJSt5cCu/9MVSq0qtKiupZNLkIU2bKoG0TsCY - RtTGhYLDGjvBxlAcQ1i8G67mzt5m+jDLxU6jKm3y1CMdndGMvu93/uc78+nA/4UdzcEM8DOQ - Dm9j2xE3+YD4OljiSCmnEPwYWATmEtPSUmVZZmzk9hzwV0nibVWm4VQnM18FUHZncNSW4Mjd - 5PEo0xMTdmtcHAeOH2fnMzWqSVE2j/tGqhcXgy+6XTzkycD80AaGPxxh8b9WeNjNzwvKyo4f - e/lldF2nu6WF906fxpGcTM2xY7iys+lpb6ezsZGPWlsJh0IRBBfQqTNJvPvKhwS+lEKPC6ce - DVXv2rmAQCcjv4yKmn0oqsrvTpzA/0kfj3znacr37qVy/36cWVnS0vx89mQg8KSm6S+Wutjj - ySShOA1/d4Dp/6jwRx4KNZ2PT9W9gMooyDZIehxsm7h98ya/+uER8rcm84MTz4N1o+FCZWp0 - lEtNTXQ2NjIyMGBsBl4N6pCpq71E/79V+K08JmdD/GTbrnLZ4ZAAHRb7IDxJfGYZkXCEno7L - PLbHCQt9MNMBwUGsFsgpLadi30FKKiux2O1M+P2u4Pz8LqFz1O3iGU8GE14/1+4Cnh9Ec7uo - ydq8OT0rOwEkFYQK0Rmw5ZGceT/v177Ojic9mG12EApE5iA4BDNdsHADR4JCwcM7qXruMLml - pUiyzJjP54yEwzUeF0VuF/VePxqADODOoNwSt66o9JEcAyYpxsamdVgTs7h64QIfdfyTnC3Z - 2BMcse8qyCpoYQjdhrkriIUeUtITKK56mh3VzzLc38+Yz7cZnSWvn4srwFIXGxdnF/ZU7Xvc - OIlloK6BZQMFZWXc7LnBO789Q2BkBmucg+SMVISkGhVZdqIQDMBcN6oSpuypF+g8e5aFmRmH - 10/tCnB7JmJxfv5Q1YFqFAUDJimgB0EyY0vMxLN7D+6qKob7B2n64wd8UN/JZ7dnQTaTlJaC - rFiMNZIaK/sdhKOUqdEx+q9cDXUHqAXChsIMAsBLuSVFijMzBSQTCJMRI1MQnQWixCWmsmXH - LnY/9zybPG6mJ6dpfa+Nd2qbCYUk8orzYqoVY73lPob7b9HTeSl4JWC+DNGADOD1o7ldVKhm - 68aiRz0g5FWokEEPQ2TaOKvwOESXSEhNJW9bBTtqnmXrNx7l3Jv1jPnv8OD2wliJFTC7+LR/ - kI/b2pe6A+YGUGVpuV11ON/V8neiugUk66rLNpBsqxEgMgkLAzDbBUtDrM/bxLFXTtPd1sut - vnGQ40COB0BRVQSYjIWaZRWo87el+XkG+3wgWe52eTnem4jFgIfGiE9KYvfB79LacAkkO8h2 - QKBYLAhh9AogrQBfvUwnMNjRdH71X5TMhosYUHxBApEp0DXK936bXu91giHJgCKhqCoIlBhG - WwEaVeW1tjPvc2d8brXVhXlN639BApLRlWarle1PfBPvhStGIkIgm0xIKyWVgmuBaCZej0Yi - wT/88jdomrz6e4hlxWsTMN+dgLYIukbl/v10NLUa71cqufwQDt0FfLUTn65z4Grrxeipl36K - b+BTAypMsbg2AeXzFdDmSXQ6cSSnMDoyDmJle6HKyCCCMvfYZT833C56x3y+na3179oHr90g - dcN9JKZnGLeQEIBkbLbsyLGog1BJTE+nz9tN9pYtBIaG6Wpu5vqYqT4UFUPSvUCA017eBnLR - +XVPe3vkF4e+z8mD36PhtTcY+cQXK+Ma5ctXoTCBHuKBwkJ0YonFzCJjAvnzCpfN6yfo9XOu - bD21IY1r45+N09/V5bxYV2f9R0Mj47cDKGYr65wZSLJpVTWAkNB1QVJ6OoHBIbqamxmYMP15 - Lqz2funJrLqAMllIT5lNeqVF1otUs2p+oLCQnOJicktLyN66FYvNhhbVAGg7c4bfnzzJ2ZuW - Q8N3lv70P42CrnhSHkyRn7CpekWcqhdZFD1fkaX49Xl55JaUkJWfT8tbb3Hreu/Cm1etBxej - i3/5KmdPO5jTi9J0jzNOe3idJVpgNbEhojE1OCWfa/eZLsJSy9cy7AIy2FMAJ2gOkOZBvQVT - 0/8ClPo3sCGCJrEAAAAASUVORK5CYII='! Item was removed: - ----- Method: MenuMorph>>allWordings (in category '*MorphicExtras-accessing') ----- - allWordings - "Answer a collection of the wordings of all items and subitems, omitting the window-list in the embed... branch and (unless a certain hard-coded preference is set) also omitting items from the debug menu" - - | verboten | - verboten := OrderedCollection with: 'embed into'. - Preferences debugMenuItemsInvokableFromScripts - ifFalse: [verboten add: 'debug...' translated]. - ^ self allWordingsNotInSubMenus: verboten! Item was removed: - ----- Method: MenuMorph>>allWordingsNotInSubMenus: (in category '*MorphicExtras-accessing') ----- - allWordingsNotInSubMenus: verbotenSubmenuContentsList - "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContents" - - | aList | - aList := OrderedCollection new. - self items do: [:anItem | aList addAll: (anItem allWordingsNotInSubMenus: verbotenSubmenuContentsList)]. - ^ aList! Item was removed: - ----- Method: MessageNames class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop} - forFlapNamed: 'Tools']! Item was removed: - ----- Method: MessageNames class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #FileServices ifPresent: [:cl | - cl unregisterFileReader: self]. - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: Morph class>>addPartsDescriptorQuadsTo:if: (in category '*MorphicExtras-new-morph participation') ----- - addPartsDescriptorQuadsTo: aList if: aBlock - "For each of the standard objects to be put into parts bins based on declarations in this class, add a parts-launching quintuplet to aList, provided that the boolean-valued-block-with-one-argument supplied evaluates to true when provided the DescriptionForPartsBin" - - | info more | - (self class includesSelector: #descriptionForPartsBin) ifTrue: - [info := self descriptionForPartsBin. - (aBlock value: info) ifTrue: - [aList add: - {info globalReceiverSymbol. - info nativitySelector. - info formalName. - info documentation. - info sampleImageFormOrNil}]]. - - (self class includesSelector: #supplementaryPartsDescriptions) - ifTrue: - [more := self supplementaryPartsDescriptions. - (more isKindOf: DescriptionForPartsBin) ifTrue: [more := Array with: more]. - "The above being a mild bit of forgiveness, so that in the usual only-one - case, the user need not return a collection" - more do: - [:aPartsDescription | (aBlock value: aPartsDescription) ifTrue: - [aList add: - {aPartsDescription globalReceiverSymbol. - aPartsDescription nativitySelector. - aPartsDescription formalName. - aPartsDescription documentation. - aPartsDescription sampleImageFormOrNil}]]]! Item was removed: - ----- Method: Morph class>>defaultArrowheadSize (in category '*MorphicExtras-arrow head size') ----- - defaultArrowheadSize - - ^ 5 @ 4! Item was removed: - ----- Method: Morph class>>obtainArrowheadFor:defaultValue: (in category '*MorphicExtras-arrow head size') ----- - obtainArrowheadFor: aPrompt defaultValue: defaultPoint - "Allow the user to supply a point to serve as an arrowhead size. Answer nil if we fail to get a good point" - - | result | - result := UIManager default request: aPrompt initialAnswer: defaultPoint asString. - result isEmptyOrNil ifTrue: [^ nil]. - ^ [(Point readFrom: (ReadStream on: result))] - on: Error do: [:ex | nil].! Item was removed: - ----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" - - ^ { DescriptionForPartsBin - formalName: 'Status' translatedNoop - categoryList: #() - documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #scriptControlButtons. - DescriptionForPartsBin - formalName: 'Scripting' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #newScriptingSpace. - DescriptionForPartsBin - formalName: 'Random' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'A tile that will produce a random number in a given range' translatedNoop - globalReceiverSymbol: #FunctionTile - nativitySelector: #randomNumberTile. - DescriptionForPartsBin - formalName: 'ButtonDown?' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'Tiles for querying whether the mouse button is down' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #anyButtonPressedTiles. - DescriptionForPartsBin - formalName: 'ButtonUp?' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'Tiles for querying whether the mouse button is up' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #noButtonPressedTiles. - DescriptionForPartsBin - formalName: 'NextPage' translatedNoop - categoryList: {'Multimedia' translatedNoop} - documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop - globalReceiverSymbol: #BookMorph - nativitySelector: #nextPageButton. - DescriptionForPartsBin - formalName: 'PreviousPage' translatedNoop - categoryList: {'Multimedia'} - documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop - globalReceiverSymbol: #BookMorph - nativitySelector: #previousPageButton.}, - - self partsDescriptionsFromToolsFlap! Item was removed: - ----- Method: Morph>>asEPS (in category '*MorphicExtras-postscript') ----- - asEPS - - ^ EPSCanvas morphAsPostscript: self rotated: false. - ! Item was removed: - ----- Method: Morph>>asPostscriptPrintJob (in category '*MorphicExtras-postscript') ----- - asPostscriptPrintJob - - ^ DSCPostscriptCanvas morphAsPostscript: self rotated: false. - ! Item was removed: - ----- Method: Morph>>dismissButton (in category '*MorphicExtras-menus') ----- - dismissButton - "Answer a button whose action would be to dismiss the receiver, and whose action is to send #delete to the receiver" - - | aButton | - aButton := SimpleButtonMorph new. - aButton - target: self topRendererOrSelf; - color: Color lightRed; - borderColor: Color lightRed muchDarker; - borderWidth: 1; - label: 'X' font: Preferences standardButtonFont; - actionSelector: #delete; - setBalloonText: 'dismiss' translated. - ^ aButton! Item was removed: - ----- Method: Morph>>exportAsEPS (in category '*MorphicExtras-postscript') ----- - exportAsEPS - - | fName | - fName := UIManager default saveFilenameRequest:'Please enter the name' translated initialAnswer: self externalName,'.eps'. - fName ifNil:[^self]. - self exportAsEPSNamed: fName - ! Item was removed: - ----- Method: Morph>>exportAsEPSNamed: (in category '*MorphicExtras-postscript') ----- - exportAsEPSNamed: aString - - FileStream fileNamed: aString do: [:stream | - stream nextPutAll: self asEPS] - ! Item was removed: - ----- Method: Morph>>nextOwnerPage (in category '*MorphicExtras') ----- - nextOwnerPage - "Tell my container to advance to the next page" - | targ | - targ := self ownerThatIsA: BookMorph. - targ ifNotNil: [targ nextPage]! Item was removed: - ----- Method: Morph>>previousOwnerPage (in category '*MorphicExtras') ----- - previousOwnerPage - "Tell my container to advance to the previous page" - | targ | - targ := self ownerThatIsA: BookMorph. - targ ifNotNil: [targ previousPage]! Item was removed: - ----- Method: Morph>>printPSToFileNamed: (in category '*MorphicExtras-menus') ----- - printPSToFileNamed: aString - "Ask the user for a filename and print this morph as postscript." - | fileName rotateFlag psCanvasType psExtension | - - psCanvasType := PostscriptCanvas defaultCanvasType. - psExtension := psCanvasType defaultExtension. - fileName := UIManager default saveFilenameRequest: 'File name? ' - initialAnswer: (aString, psExtension) asFileName. - fileName ifNil: [^ Beeper beep]. - - rotateFlag := (UIManager default chooseOptionFrom: { - 'portrait (tall)' translated. - 'landscape (wide)' translated. - } title: 'Choose orientation...' translated) = 2. - (FileStream newFileNamed: fileName) - nextPutAll: (psCanvasType morphAsPostscript: self rotated: rotateFlag); - close! Item was removed: - ----- Method: Morph>>shiftSubmorphsBy: (in category '*MorphicExtras-geometry') ----- - shiftSubmorphsBy: delta - self shiftSubmorphsOtherThan: (submorphs select: [:m | m wantsToBeTopmost]) by: delta! Item was removed: - ----- Method: MorphExtension>>removeUndoCommands (in category '*MorphicExtras-Undo') ----- - removeUndoCommands - - | keysToBeRemoved | - otherProperties ifNil: [ ^self ]. - otherProperties keysAndValuesDo: [ :key :value | - value class == Command ifTrue: [ - (keysToBeRemoved ifNil: [ - keysToBeRemoved := OrderedCollection new ]) add: key ] ]. - keysToBeRemoved ifNil: [ ^self ]. - keysToBeRemoved do: [ :each | - self removeProperty: each ] - ! Item was removed: - ----- Method: MorphExtension>>updateReferencesUsing: (in category '*MorphicExtras-copying') ----- - updateReferencesUsing: aDictionary - "Update intra-morph references within a composite morph that - has been copied. For example, if a button refers to morph X in - the orginal - composite then the copy of that button in the new composite - should refer to - the copy of X in new composite, not the original X. This default - implementation updates the contents of any morph-bearing slot." - - | old | - eventHandler isNil - ifFalse: - [self eventHandler: self eventHandler copy. - 1 to: self eventHandler class instSize - do: - [:i | - old := eventHandler instVarAt: i. - old isMorph - ifTrue: [eventHandler instVarAt: i put: (aDictionary at: old ifAbsent: [old])]]]. - otherProperties ifNotNil: [otherProperties associationsDo: [:assn | - assn value: (aDictionary at: assn value ifAbsent: [assn value])]]! Item was removed: - ObjectOut subclass: #MorphObjectOut - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SqueakPage'! Item was removed: - ----- Method: MorphObjectOut>>doesNotUnderstand: (in category 'error handling') ----- - doesNotUnderstand: aMessage - "Bring in the object, install, then resend aMessage" - | aMorph myUrl oldFlag response | - "Transcript show: thisContext sender selector; cr." "useful for debugging" - oldFlag := recursionFlag. - recursionFlag := true. - myUrl := url. "can't use inst vars after become" - "fetch the object" - aMorph := self xxxFetch. "watch out for the become!!" - "Now we ARE a MORPH" - oldFlag == true ifTrue: - [response := Project uiManager - chooseOptionFrom: #('proceed normally' 'debug') - title: 'Object being fetched for a second time. - Should not happen, and needs to be fixed later.'. - response = 2 ifTrue: [self halt]]. "We are already the new object" - - aMorph setProperty: #SqueakPage toValue: (SqueakPageCache pageCache at: myUrl). - "Can't be a super message, since this is the first message sent to this object" - ^ aMorph perform: aMessage selector withArguments: aMessage arguments - ! Item was removed: - ----- Method: MorphObjectOut>>fullReleaseCachedState (in category 'caching') ----- - fullReleaseCachedState - "do nothing, especially don't bring in my object!!"! Item was removed: - ----- Method: MorphObjectOut>>smallThumbnailForPageSorter (in category 'misc') ----- - smallThumbnailForPageSorter - - ^ self sqkPage thumbnail! Item was removed: - ----- Method: MorphObjectOut>>thumbnailForPageSorter (in category 'misc') ----- - thumbnailForPageSorter - - ^ self sqkPage thumbnail! Item was removed: - SketchMorph subclass: #MorphThumbnail - instanceVariableNames: 'morphRepresented' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Books'! - - !MorphThumbnail commentStamp: '<historical>' prior: 0! - A morph whose appearance is a thumbnail of some other morph.! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: MorphThumbnail>>computeThumbnail (in category 'private') ----- - 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! Item was removed: - ----- Method: MorphThumbnail>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was removed: - ----- Method: MorphThumbnail>>grabOriginal (in category 'menus') ----- - grabOriginal - self primaryHand attachMorph: morphRepresented! Item was removed: - ----- 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! Item was removed: - ----- Method: MorphThumbnail>>innocuousName (in category 'naming') ----- - innocuousName - ^ morphRepresented isNil - ifTrue: [super innocuousName] - ifFalse: [morphRepresented innocuousName]! Item was removed: - ----- Method: MorphThumbnail>>isPartsDonor (in category 'parts bin') ----- - isPartsDonor - "answer whether the receiver is PartsDonor" - ^ self partRepresented isPartsDonor! Item was removed: - ----- Method: MorphThumbnail>>isPartsDonor: (in category 'parts bin') ----- - isPartsDonor: aBoolean - "change the receiver's isPartDonor property" - self partRepresented isPartsDonor: aBoolean! Item was removed: - ----- Method: MorphThumbnail>>morphRepresented (in category 'thumbnail') ----- - morphRepresented - - ^ morphRepresented - ! Item was removed: - ----- Method: MorphThumbnail>>morphRepresented: (in category 'accessing') ----- - morphRepresented: aMorph - - morphRepresented := aMorph. - self computeThumbnail. - ! Item was removed: - ----- Method: MorphThumbnail>>partRepresented (in category 'parts bin') ----- - partRepresented - ^self morphRepresented! Item was removed: - ----- 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! Item was removed: - ----- Method: MorphThumbnail>>revealOriginal (in category 'menus') ----- - revealOriginal - ((owner isKindOf: PasteUpMorph) and: [owner alwaysShowThumbnail]) - ifTrue: [^Beeper beep]. - morphRepresented owner isNil - ifTrue: [^owner replaceSubmorph: self by: morphRepresented]. - Beeper beep! Item was removed: - ----- Method: MorphThumbnail>>smaller (in category 'initialization') ----- - smaller - self form: (self form copy: (0 at 0 extent: self form extent // 2))! Item was removed: - ----- 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].! Item was removed: - ----- 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"! Item was removed: - ----- Method: MorphicModel>>compileInitMethods (in category '*MorphicExtras-compilation') ----- - compileInitMethods - | s nodeDict varNames | - nodeDict := IdentityDictionary new. - s := WriteStream on: (String new: 2000). - varNames := self class allInstVarNames. - s nextPutAll: 'initMorph'. - 3 to: self class instSize do: - [:i | (self instVarAt: i) isMorph ifTrue: - [s cr; tab; nextPutAll: (varNames at: i) , ' := '. - s nextPutAll: (self instVarAt: i) initString; nextPutAll: '.'. - nodeDict at: (self instVarAt: i) put: (varNames at: i)]]. - submorphs do: - [:m | s cr; tab; nextPutAll: 'self addMorph: '. - m printConstructorOn: s indent: 1 nodeDict: nodeDict. - s nextPutAll: '.']. - self class - compile: s contents - classified: 'initialization' - notifying: nil.! Item was removed: - EllipseMorph subclass: #MovingEyeMorph - instanceVariableNames: 'inner iris' - classVariableNames: 'IrisSize' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: MovingEyeMorph class>>color:irisColor: (in category 'instance creation') ----- - color: aColor irisColor: anotherColor - - ^ self new color: aColor irisColor: anotherColor! Item was removed: - ----- Method: MovingEyeMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'MovingEye' translatedNoop - categories: {'Just for Fun' translatedNoop} - documentation: 'An eye which follows the cursor' translatedNoop! Item was removed: - ----- Method: MovingEyeMorph class>>extraExampleSqueakGhostIsWatchingYou (in category 'examples') ----- - extraExampleSqueakGhostIsWatchingYou - "MovingEyeMorph extraExampleSqueakGhostIsWatchingYou openInHand" - - | logoMorph leftEye rightEye | - logoMorph := (Form squeakLogo collectColors: #negated) asMorph. - leftEye := (self color: Color white irisColor: Color black) - extent: logoMorph extent * (0.1 @ 0.15); - center: (logoMorph pointAtFraction: 0.39 @ 0.55); - yourself. - rightEye := (self color: Color white irisColor: Color black) - extent: logoMorph extent * (0.1 @ 0.15); - center: (logoMorph pointAtFraction: 0.59 @ 0.56); - yourself. - logoMorph addAllMorphs: {leftEye. rightEye}. - ^ logoMorph.! Item was removed: - ----- Method: MovingEyeMorph class>>extraExampleSqueakIsWatchingYou (in category 'examples') ----- - extraExampleSqueakIsWatchingYou - "MovingEyeMorph extraExampleSqueakIsWatchingYou openInHand" - - | logoMorph leftEye rightEye | - logoMorph := Form squeakLogo asMorph. - leftEye := self new - extent: logoMorph extent * (0.1 @ 0.15); - center: (logoMorph pointAtFraction: 0.39 @ 0.55); - yourself. - rightEye := self new - extent: logoMorph extent * (0.1 @ 0.15); - center: (logoMorph pointAtFraction: 0.59 @ 0.56); - yourself. - logoMorph addAllMorphs: {leftEye. rightEye}. - ^ logoMorph.! Item was removed: - ----- Method: MovingEyeMorph class>>initialize (in category 'class initialization') ----- - initialize - " - MovingEyeMorph initialize - " - IrisSize := (0.42 at 0.50).! Item was removed: - ----- Method: MovingEyeMorph>>color: (in category 'accessing') ----- - color: aColor - - super color: aColor. - - "Migrate old instances." - inner color: Color transparent. - - self keepIrisVisible.! Item was removed: - ----- Method: MovingEyeMorph>>color:irisColor: (in category 'accessing') ----- - color: aColor irisColor: anotherColor - - self color: aColor. - self irisColor: anotherColor.! Item was removed: - ----- Method: MovingEyeMorph>>defaultBorderWidth (in category 'accessing') ----- - defaultBorderWidth - - ^ 0! Item was removed: - ----- Method: MovingEyeMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color black! Item was removed: - ----- Method: MovingEyeMorph>>extent: (in category 'geometry') ----- - extent: aPoint - - super extent: aPoint. - inner extent: (self extent * ((1.0 at 1.0)-IrisSize)) asIntegerPoint. - iris extent: (self extent * IrisSize) asIntegerPoint. - inner position: (self center - (inner extent // 2)) asIntegerPoint. - ! Item was removed: - ----- Method: MovingEyeMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - inner := EllipseMorph new. - inner color: Color transparent. - inner extent: (self extent * (1.0 @ 1.0 - IrisSize)) asIntegerPoint. - inner borderWidth: 0. - "" - iris := EllipseMorph new. - iris color: Color white. - iris extent: (self extent * IrisSize) asIntegerPoint. - "" - self addMorphCentered: inner. - inner addMorphCentered: iris. - "" - self extent: 26 @ 33! Item was removed: - ----- Method: MovingEyeMorph>>irisColor (in category 'accessing') ----- - irisColor - - ^ iris color! Item was removed: - ----- Method: MovingEyeMorph>>irisColor: (in category 'accessing') ----- - irisColor: aColor - - iris color: aColor. - - self keepIrisVisible.! Item was removed: - ----- Method: MovingEyeMorph>>irisPos (in category 'accessing') ----- - irisPos - - ^ iris position! Item was removed: - ----- Method: MovingEyeMorph>>irisPos: (in category 'accessing') ----- - irisPos: cp - - | a b theta x y | - theta := (cp - self center) theta. - a := inner width // 2. - b := inner height // 2. - x := a * (theta cos). - y := b * (theta sin). - iris position: ((x at y) asIntegerPoint) + self center - (iris extent // 2).! Item was removed: - ----- Method: MovingEyeMorph>>keepIrisVisible (in category 'private') ----- - keepIrisVisible - - self color = self irisColor - ifTrue: [ - iris borderWidth: 1; - borderColor: self color makeForegroundColor] - ifFalse: [ - iris borderWidth: 0].! Item was removed: - ----- Method: MovingEyeMorph>>step (in category 'stepping and presenter') ----- - step - | cp | - cp := self globalPointToLocal: self world primaryHand position. - (inner containsPoint: cp) - ifTrue: [iris position: (cp - (iris extent // 2))] - ifFalse: [self irisPos: cp].! Item was removed: - ----- Method: MovingEyeMorph>>stepTime (in category 'testing') ----- - stepTime - - ^ 100.! Item was removed: - FormCanvas subclass: #MultiResolutionCanvas - instanceVariableNames: 'deferredMorphs' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Support'! Item was removed: - ----- Method: MultiResolutionCanvas>>deferredMorphs (in category 'accessing') ----- - deferredMorphs - - ^deferredMorphs! Item was removed: - ----- Method: MultiResolutionCanvas>>deferredMorphs: (in category 'accessing') ----- - deferredMorphs: aCollection - - deferredMorphs := aCollection! Item was removed: - ----- Method: MultiResolutionCanvas>>fullDraw: (in category 'drawing-general') ----- - fullDraw: aMorph - - aMorph canDrawAtHigherResolution ifTrue: [ - deferredMorphs ifNil: [deferredMorphs := OrderedCollection new]. - deferredMorphs add: aMorph. - ] ifFalse: [ - super fullDraw: aMorph - ].! Item was removed: - ----- Method: MultiResolutionCanvas>>initializeFrom: (in category 'initialize-release') ----- - initializeFrom: aFormCanvas - - origin := aFormCanvas origin. - clipRect := aFormCanvas privateClipRect. - form := aFormCanvas form. - port := aFormCanvas privatePort. - shadowColor := aFormCanvas shadowColor. - ! Item was removed: - ----- Method: NewBalloonMorph>>isBalloonHelp (in category '*MorphicExtras-classification') ----- - isBalloonHelp - ^ true! Item was removed: - ----- Method: Object>>capturedState (in category '*MorphicExtras-Undo') ----- - capturedState - "May be overridden in subclasses." - - ^ self shallowCopy - ! Item was removed: - ----- Method: Object>>commandHistory (in category '*MorphicExtras-Undo') ----- - commandHistory - "Return the command history for the receiver" - | w | - (w := self currentWorld) ifNotNil: [^ w commandHistory]. - ^ CommandHistory new. "won't really record anything but prevent breaking things"! Item was removed: - ----- Method: Object>>descriptionForPartsBin (in category '*MorphicExtras-PartsBin') ----- - descriptionForPartsBin - "If the receiver is a member of a class that would like to be represented in a parts bin, answer the name by which it should be known, and a documentation string to be provided, for example, as balloon help. When the 'nativitySelector' is sent to the 'globalReceiver', it is expected that some kind of Morph will result. The parameters used in the implementation below are for documentation purposes only!!" - - ^ DescriptionForPartsBin - formalName: 'PutFormalNameHere' - categoryList: #(PutACategoryHere MaybePutAnotherCategoryHere) - documentation: 'Put the balloon help here' - globalReceiverSymbol: #PutAGlobalHere - nativitySelector: #PutASelectorHere! Item was removed: - ----- Method: Object>>purgeAllCommands (in category '*MorphicExtras-Undo') ----- - purgeAllCommands - "Purge all commands for this object" - Preferences useUndo ifFalse: [^ self]. "get out quickly" - self commandHistory purgeAllCommandsSuchThat: [:cmd | cmd undoTarget == self]. - ! Item was removed: - ----- Method: Object>>redoFromCapturedState: (in category '*MorphicExtras-Undo') ----- - redoFromCapturedState: st - "May be overridden in subclasses. See also capturedState" - - self undoFromCapturedState: st "Simple cases are symmetric" - ! Item was removed: - ----- Method: Object>>refineRedoTarget:selector:arguments:in: (in category '*MorphicExtras-Undo') ----- - refineRedoTarget: target selector: aSymbol arguments: arguments in: refineBlock - "Any object can override this method to refine its redo specification" - - ^ refineBlock - value: target - value: aSymbol - value: arguments! Item was removed: - ----- Method: Object>>refineUndoTarget:selector:arguments:in: (in category '*MorphicExtras-Undo') ----- - refineUndoTarget: target selector: aSymbol arguments: arguments in: refineBlock - "Any object can override this method to refine its undo specification" - - ^ refineBlock - value: target - value: aSymbol - value: arguments! Item was removed: - ----- Method: Object>>rememberCommand: (in category '*MorphicExtras-Undo') ----- - rememberCommand: aCommand - "Remember the given command for undo" - Preferences useUndo ifFalse: [^ self]. "get out quickly" - ^ self commandHistory rememberCommand: aCommand! Item was removed: - ----- Method: Object>>rememberUndoableAction:named: (in category '*MorphicExtras-Undo') ----- - rememberUndoableAction: actionBlock named: caption - | cmd result | - cmd := Command new cmdWording: caption. - cmd undoTarget: self selector: #undoFromCapturedState: argument: self capturedState. - result := actionBlock value. - cmd redoTarget: self selector: #redoFromCapturedState: argument: self capturedState. - self rememberCommand: cmd. - ^ result! Item was removed: - ----- Method: Object>>undoFromCapturedState: (in category '*MorphicExtras-Undo') ----- - undoFromCapturedState: st - "May be overridden in subclasses. See also capturedState" - - self copyFrom: st - ! Item was removed: - ProtoObject subclass: #ObjectOut - instanceVariableNames: 'url page recursionFlag' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SqueakPage'! - - !ObjectOut commentStamp: '<historical>' prior: 0! - I am a stand-in for an object that is out on the disk. The object that is out on the disk is the head of a tree of objects that are out. See SqueakPage. - - When any message is sent to me, I don't understand it, and bring in my true object. I become myself with the objects and resend the message. - - I may not represent the object nil. - The file is represented as a url, and that url may point at any file on the net. - - page is a SqueakPage. - If the cache already has an object, widely in use, that claims to be the object for my url, what do I do? I can't become him, since others believe that he is the true object. Run through memory and replace refs to me with refs to him. Be careful not to trigger a fault. Become me to a string, then find pointers and replace? - - [[[They don't want to end up holding an ObjectOut. (would oscillate back and forth) This is a problem. A user could bring in two trees that both refer to a 3rd url. (check with cache before installing any new ObjectOut) Two trees could be written to the same url. - Or, I remain an ObjectOut, and keep getting notUnderstood, and keep returning the other guy. - Or I smash the cache, and install MY page and object. Other guy is a copy -- still in, but with no place in the cache. When we both write to the same url, there will be trouble.] No -- search and replace.]]] - ! Item was removed: - ----- Method: ObjectOut>>comeFullyUpOnReload: (in category 'object storage') ----- - comeFullyUpOnReload: smartRefStream - "Normally this read-in object is exactly what we want to store. Try to dock first. If it is here already, use that one." - - | sp | - "Transcript show: 'has ref to: ', url; cr." - (sp := SqueakPageCache pageCache at: page ifAbsent: [nil]) ifNotNil: [ - sp isContentsInMemory ifTrue: [^ sp contentsMorph]]. - ^ self! Item was removed: - ----- Method: ObjectOut>>doesNotUnderstand: (in category 'error handling') ----- - doesNotUnderstand: aMessage - "Bring in the object, install, then resend aMessage" - | realObject oldFlag response | - oldFlag := recursionFlag. - recursionFlag := true. - "fetch the object" - realObject := self xxxFetch. "watch out for the become!!" - "Now we ARE the realObject" - oldFlag == true ifTrue: - [response := (Project uiManager - chooseOptionFrom: #('proceed normally' 'debug') - title: 'Object being fetched for a second time. - Should not happen, and needs to be fixed later.'). - response = 2 ifTrue: [self halt]]. "We are already the new object" - - "Can't be a super message, since this is the first message sent to this object" - ^ realObject perform: aMessage selector withArguments: aMessage arguments! Item was removed: - ----- Method: ObjectOut>>isInMemory (in category 'basics') ----- - isInMemory - "We are a place holder for an object that is out." - ^ false! Item was removed: - ----- Method: ObjectOut>>objectForDataStream: (in category 'object storage') ----- - objectForDataStream: refStrm - "Return an object to store on a data stream (externalize myself)." - - ^ self! Item was removed: - ----- Method: ObjectOut>>readDataFrom:size: (in category 'object storage') ----- - readDataFrom: aDataStream size: varsOnDisk - "Make self be an object based on the contents of aDataStream, which was generated by the object's storeDataOn: method. Return self." - | cntInstVars | - cntInstVars := self xxxClass instSize. - self xxxClass isVariable - ifTrue: [self xxxClass error: 'needs updating'] "assume no variable subclasses" - ifFalse: [cntInstVars := varsOnDisk]. - - aDataStream beginReference: self. - 1 to: cntInstVars do: - [:i | self xxxInstVarAt: i put: aDataStream next]. - " 1 to: cntIndexedVars do: - [:i | self basicAt: i put: aDataStream next]. - " - ^ self! Item was removed: - ----- Method: ObjectOut>>sqkPage (in category 'access') ----- - sqkPage - ^ page! Item was removed: - ----- Method: ObjectOut>>storeDataOn: (in category 'object storage') ----- - storeDataOn: aDataStream - "Store myself on a DataStream. See also objectToStoreOnDataStream. - must send 'aDataStream beginInstance:size:'" - | cntInstVars | - - cntInstVars := self class instSize. - "cntIndexedVars := self basicSize." - aDataStream - beginInstance: self xxxClass - size: cntInstVars "+ cntIndexedVars". - 1 to: cntInstVars do: - [:i | aDataStream nextPut: (self xxxInstVarAt: i)]. - " 1 to: cntIndexedVars do: - [:i | aDataStream nextPut: (self basicAt: i)] - "! Item was removed: - ----- Method: ObjectOut>>url (in category 'access') ----- - url - ^ url! Item was removed: - ----- Method: ObjectOut>>url: (in category 'access') ----- - url: aString - - url := aString! Item was removed: - ----- Method: ObjectOut>>veryDeepCopyWith: (in category 'object storage') ----- - veryDeepCopyWith: deepCopier - "Copy me and the entire tree of objects I point to. An object in the tree twice is copied once, and both references point to him. deepCopier holds a dictionary of objects we have seen. Some classes refuse to be copied. Some classes are picky about which fields get deep copied." - | class index sub subAss new absent | - new := deepCopier references at: self ifAbsent: [absent := true]. - absent ifNil: [^ new]. "already done" - class := self xxxClass. - class isMeta ifTrue: [^ self]. "a class" - new := self xxxClone. - "not a uniClass" - deepCopier references at: self put: new. "remember" - "class is not variable" - index := class instSize. - [index > 0] whileTrue: - [sub := self xxxInstVarAt: index. - (subAss := deepCopier references associationAt: sub ifAbsent: [nil]) - ifNil: [new xxxInstVarAt: index put: (sub veryDeepCopyWith: deepCopier)] - ifNotNil: [new xxxInstVarAt: index put: subAss value]. - index := index - 1]. - new rehash. "force Sets and Dictionaries to rehash" - ^ new - ! Item was removed: - ----- Method: ObjectOut>>xxxClass (in category 'basics') ----- - xxxClass - "Primitive. Answer the object which is the receiver's class. Essential. See - Object documentation whatIsAPrimitive." - - <primitive: 111> - self primitiveFailed! Item was removed: - ----- Method: ObjectOut>>xxxClone (in category 'basics') ----- - xxxClone - - <primitive: 148> - self primitiveFailed! Item was removed: - ----- Method: ObjectOut>>xxxFetch (in category 'fetch from disk') ----- - xxxFetch - "Bring in my object and replace all references to me with references to him. First try looking up my url in the pageCache. Then try the page (and install it, under its url). Then start from scratch with the url." - - | truePage object existing | - existing := SqueakPageCache pageCache at: url ifAbsent: [nil]. - existing ifNotNil: [existing isContentsInMemory - ifTrue: [page := truePage := existing]]. "This url already has an object in this image" - truePage ifNil: [ - truePage := SqueakPageCache atURL: url oldPage: page]. - object := truePage isContentsInMemory - ifTrue: [truePage contentsMorph] - ifFalse: [truePage fetchInformIfError]. "contents, not the page" - "Later, collect pointers to object and fix them up. Not scan memory" - object ifNil: [^ 'Object could not be fetched.']. - "recursionFlag := false." "while I still have a pointer to myself" - truePage contentsMorph: object. - page := truePage. - self xxxFixup. - ^ object "the final object!!" - ! Item was removed: - ----- Method: ObjectOut>>xxxFixup (in category 'fetch from disk') ----- - xxxFixup - "There is already an object in memory for my url. All pointers to me need to be pointers to him. Can't use become, because other pointers to him must stay valid." - - | real temp list | - real := page contentsMorph. - real == self ifTrue: [page error: 'should be converted by now']. - temp := self. - list := (PointerFinder pointersTo: temp) asOrderedCollection. - list add: thisContext. list add: thisContext sender. - list do: [:holder | - 1 to: holder class instSize do: - [:i | (holder instVarAt: i) == temp ifTrue: [holder instVarAt: i put: real]]. - 1 to: holder basicSize do: - [:i | (holder basicAt: i) == temp ifTrue: [holder basicAt: i put: real]]. - ]. - ^ real! Item was removed: - ----- Method: ObjectOut>>xxxInstVarAt: (in category 'basics') ----- - xxxInstVarAt: index - "Primitive. Answer a fixed variable in an object. The numbering of the - variables corresponds to the named instance variables. Fail if the index - is not an Integer or is not the index of a fixed variable. Essential. See - Object documentation whatIsAPrimitive." - - <primitive: 73> - self primitiveFailed ! Item was removed: - ----- Method: ObjectOut>>xxxInstVarAt:put: (in category 'basics') ----- - xxxInstVarAt: anInteger put: anObject - "Primitive. Store a value into a fixed variable in the receiver. The - numbering of the variables corresponds to the named instance variables. - Fail if the index is not an Integer or is not the index of a fixed variable. - Answer the value stored as the result. Using this message violates the - principle that each object has sovereign control over the storing of - values into its instance variables. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 74> - self primitiveFailed ! Item was removed: - ----- Method: ObjectOut>>xxxReset (in category 'access') ----- - xxxReset - "mark as never brought in" - recursionFlag := nil! Item was removed: - ----- Method: ObjectOut>>xxxSetUrl:page: (in category 'fetch from disk') ----- - xxxSetUrl: aString page: aSqkPage - - url := aString. - page := aSqkPage.! Item was removed: - AlignmentMorph subclass: #ObjectsTool - instanceVariableNames: 'searchString modeSymbol' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-PartsBin'! - - !ObjectsTool commentStamp: '<historical>' prior: 0! - I am a Master Parts Bin that allows the user to drag out a new Morph from a voluminous iconic list. - - Choose "objects" from the world menu, or type Alt-o (Cmd-o on the Mac). - - To add a new kinds of Morphs: - In the class of the Morph, implement the message: - - descriptionForPartsBin - ^ self partName: 'Rectangle' - categories: #('Graphics' ' Basic 1 ') - documentation: 'A rectangular shape, with border and fill style' - - The partName is the title that will show in the lower pane of the Object Tool. - When is categories mode, an object can be seen in more than one category. The list above tells which ones. - Documentation is what will show in the balloon help for each object thumbnail. - The message #initializeToStandAlone creates the actual instance. - - To make a second variant object prototype coming from the same class, implement #supplementaryPartsDescriptions. In it, you get to specify the nativitySelector. It is sent to the class to get the variant objects. Often it is #authoringPrototype. (A class may supply supplementaryPartsDescriptions without implementing descriptionForPartsBin. This gives you better control.) - - ! Item was removed: - ----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Objects' translatedNoop - categories: #() - documentation: 'A place to obtain many kinds of objects' translatedNoop! Item was removed: - ----- Method: ObjectsTool class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop} - forFlapNamed: 'Widgets'.]! Item was removed: - ----- Method: ObjectsTool class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #borderColor. 'Colors'. 'Color of the tools'' border.' }. - { #borderWidth. 'Borders'. 'Width of the tools'' border.' }. - { #borderStyle. 'Borders'. 'Whether to use a plain border, inset, or outset.' }. - { #color. 'Colors'. 'Background color of the tool.' }. - { #textColor. 'Colors'. 'Color for the category button labels.' }. - { #selectionTextColor. 'Colors'. 'Color used for the button of the selected category.' }. - }! Item was removed: - ----- Method: ObjectsTool class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: ObjectsTool>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHand - "Add items to the given halo-menu, given a hand" - - super addCustomMenuItems: aMenu hand: aHand. - aMenu addLine. - aMenu add: 'alphabetic' translated target: self selector: #showAlphabeticTabs. - aMenu add: 'find' translated target: self selector: #showSearchPane. - aMenu add: 'categories' translated target: self selector: #showCategories. - aMenu addLine. - aMenu add: 'reset thumbnails' translated target: self selector: #resetThumbnails.! Item was removed: - ----- Method: ObjectsTool>>alphabeticTabs (in category 'alphabetic') ----- - alphabeticTabs - "Answer a list of buttons which, when hit, will trigger the choice of a morphic category" - - | buttonList tabLabels | - - self flag: #todo. "includes non-english characters" - tabLabels := (($a to: $z) asOrderedCollection collect: [:ch | ch asString]) . - - buttonList := tabLabels collect: - [:catName | - | aButton | - aButton := SimpleButtonMorph new label: catName. - aButton actWhen: #buttonDown. - aButton target: self; actionSelector: #showAlphabeticCategory:fromButton:; arguments: {catName. aButton}]. - ^ buttonList - - "ObjectsTool new tabsForMorphicCategories"! Item was removed: - ----- Method: ObjectsTool>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - super applyUserInterfaceTheme. - self setDefaultParameters.! Item was removed: - ----- Method: ObjectsTool>>baseBackgroundColor (in category 'constants') ----- - baseBackgroundColor - - ^ self userInterfaceTheme borderColor ifNil: [Color veryLightGray] ! Item was removed: - ----- Method: ObjectsTool>>baseBorderColor (in category 'constants') ----- - baseBorderColor - - ^ self userInterfaceTheme borderColor ifNil: [Color veryLightGray] ! Item was removed: - ----- Method: ObjectsTool>>buttonActiveColor (in category 'constants') ----- - buttonActiveColor - - ^ self userInterfaceTheme selectionTextColor ifNil: [Color white]! Item was removed: - ----- Method: ObjectsTool>>buttonColor (in category 'constants') ----- - buttonColor - - ^ self userInterfaceTheme textColor ifNil: [Color black]! Item was removed: - ----- Method: ObjectsTool>>buttonPane (in category 'submorph access') ----- - buttonPane - "Answer the receiver's button pane, nil if none" - - ^ self submorphNamed: 'ButtonPane' ifNone: [].! Item was removed: - ----- Method: ObjectsTool>>extent: (in category 'layout') ----- - extent: anExtent - "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed" - super extent: anExtent. - self submorphsDo: [:m | - m width: anExtent x]! Item was removed: - ----- Method: ObjectsTool>>fixLayoutFrames (in category 'layout') ----- - fixLayoutFrames - "Adjust the boundary between the tabs or search pane and the parts bin, giving preference to the tabs." - - | oldY newY aTabsPane aTabsPaneHeight | - oldY := ((aTabsPane := self tabsPane - ifNil: [self searchPane]) - ifNil: [^ self]) layoutFrame bottomOffset. - aTabsPaneHeight := aTabsPane hasSubmorphs - ifTrue: [(aTabsPane submorphBounds outsetBy: aTabsPane layoutInset) height] - ifFalse: [aTabsPane height]. - newY := (self buttonPane ifNil: [^ self]) height + aTabsPaneHeight. - oldY = newY ifTrue: [^ self]. - aTabsPane layoutFrame bottomOffset: newY. - (self partsBin ifNil: [^ self]) layoutFrame topOffset: newY. - submorphs do: [:m | m layoutChanged]! Item was removed: - ----- Method: ObjectsTool>>highlightOnlySubmorph:in: (in category 'tabs') ----- - highlightOnlySubmorph: aMorph in: anotherMorph - "Distinguish only aMorph with border highlighting (2-pixel wide red); make all my other submorphs have one-pixel-black highlighting. This is a rather special-purpose and hard-coded highlighting regime, of course. Later, if someone cared to do it, we could parameterize the widths and colors via properties, or some such." - - anotherMorph submorphs do: [:m | | color | - color := m == aMorph ifTrue: [self buttonActiveColor] ifFalse: [self buttonColor]. - m - borderWidth: 1; - borderColor: color. - m firstSubmorph color: color] - ! Item was removed: - ----- Method: ObjectsTool>>icon (in category 'thumbnail') ----- - icon - "Answer a form with an icon to represent the receiver" - ^ MenuIcons objectCatalogIcon! Item was removed: - ----- Method: ObjectsTool>>initializeForFlap (in category 'initialization') ----- - initializeForFlap - "Initialize the receiver to operate in a flap at the top of the screen." - - " - Flaps newObjectsFlap openInWorld - " - - | buttonPane aBin aColor heights tabsPane | - self basicInitialize. - - self layoutInset: 0; - layoutPolicy: ProportionalLayout new; - hResizing: #shrinkWrap; - vResizing: #rigid; - borderWidth: 2; borderColor: Color darkGray; - extent: (self minimumWidth @ self minimumHeight). - - "mode buttons" - buttonPane := self paneForTabs: self modeTabs. - buttonPane - vResizing: #shrinkWrap; - setNameTo: 'ButtonPane'; - color: (aColor := buttonPane color) darker; - layoutInset: 6; - wrapDirection: nil; - width: self width; - layoutChanged; fullBounds. - - "Place holder for a tabs or text pane" - tabsPane := Morph new - setNameTo: 'TabPane'; - hResizing: #spaceFill; - yourself. - - heights := { buttonPane height. 40 }. - - buttonPane vResizing: #spaceFill. - self - addMorph: buttonPane - fullFrame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 @ 0 corner: 0 @ heights first)). - - self - addMorph: tabsPane - fullFrame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 @ heights first corner: 0 @ (heights first + heights second))). - - aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #()) - listDirection: #leftToRight; - wrapDirection: #topToBottom; - color: aColor lighter lighter; - setNameTo: 'Parts'; - dropEnabled: false; - vResizing: #spaceFill; - yourself. - - self - addMorph: aBin - fullFrame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 1) - offsets: (0 @ (heights first + heights second) corner: 0 @ 0)). - - aBin color: (Color orange muchLighter); - setNameTo: 'Objects' translated. - - self color: (Color orange muchLighter); - setNameTo: 'Objects' translated. - ! Item was removed: - ----- Method: ObjectsTool>>initializeToStandAlone (in category 'initialization') ----- - initializeToStandAlone - "Initialize the receiver so that it can live as a stand-alone morph" - - | buttonPane aBin aColor tabsPane | - self basicInitialize. - - self - layoutInset: 0; - useRoundedCorners; - hResizing: #rigid; - vResizing: #shrinkWrap; - extent: RealEstateAgent standardSize; - listDirection: #topToBottom; - wrapDirection: #none. - - "mode buttons" - buttonPane := self paneForTabs: self modeTabs. - buttonPane color: self baseBackgroundColor. - buttonPane - vResizing: #shrinkWrap; - setNameTo: 'ButtonPane'; - addMorphFront: self dismissButton; - addMorphBack: self helpButton; - color: (aColor := buttonPane color) darker; - layoutInset: 5; - width: self width; - layoutChanged; fullBounds. - - "Place holder for a tabs or text pane" - tabsPane := Morph new. - tabsPane - color: self baseBackgroundColor; - setNameTo: 'TabPane'; - hResizing: #spaceFill; - vResizing: #shrinkWrap. - - aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #()) - changeTableLayout; - listDirection: #leftToRight; - wrapDirection: #topToBottom; - vResizing: #shrinkWrap; - color: aColor lighter lighter; - borderColor: aColor lighter lighter; - setNameTo: 'Parts'; - dropEnabled: false; - yourself. - - self addMorphBack: buttonPane. - self addMorphBack: tabsPane. - self addMorphBack: aBin. - - self - borderWidth: 1; - borderColor: self baseBorderColor; - color: self baseBackgroundColor; - setNameTo: 'Objects' translated; - showCategories.! Item was removed: - ----- Method: ObjectsTool>>initializeWithTabs: (in category 'tabs') ----- - initializeWithTabs: tabList - "Initialize the receiver to have the given tabs" - - | oldPane newPane | - oldPane := self tabsPane ifNil: [ self searchPane ]. - newPane := (self paneForTabs: tabList) - setNameTo: 'TabPane'; - yourself. - self replaceSubmorph: oldPane by: newPane. - - ! Item was removed: - ----- Method: ObjectsTool>>installQuads:fromButton: (in category 'alphabetic') ----- - installQuads: quads fromButton: aButton - "Install items in the bottom pane that correspond to the given set of quads, as triggered from the given button" - - | aPartsBin sortedQuads oldResizing | - aPartsBin := self partsBin. - oldResizing := aPartsBin vResizing. - aPartsBin removeAllMorphs. - sortedQuads := ((PartsBin translatedQuads: quads) - select: [ :each | Smalltalk hasClassNamed: each first ]) - sort: [ :a :b | a third < b third ]. - aPartsBin listDirection: #leftToRight quadList: sortedQuads. - aButton ifNotNil: [self highlightOnlySubmorph: aButton in: self tabsPane]. - aPartsBin vResizing: oldResizing. - aPartsBin layoutChanged; fullBounds.! Item was removed: - ----- Method: ObjectsTool>>minHeight (in category 'layout') ----- - minHeight - ^(self minimumBottom - self top) max: 280! Item was removed: - ----- Method: ObjectsTool>>minWidth (in category 'layout') ----- - minWidth - "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall." - - ^ 400! Item was removed: - ----- Method: ObjectsTool>>minimizePartsBinSize (in category 'layout') ----- - minimizePartsBinSize - self layoutChanged; fullBounds. - self fixLayoutFrames. - self setExtentFromHalo: (self minimumWidth @ self minimumHeight) ! Item was removed: - ----- Method: ObjectsTool>>minimumBottom (in category 'layout') ----- - minimumBottom - | iconsBottom partsBin | - partsBin := self partsBin ifNil: [ ^self bottom ]. - iconsBottom := partsBin submorphs isEmpty - ifTrue: [ partsBin top + 60 ] - ifFalse: [ partsBin submorphBounds bottom + partsBin layoutInset ]. - - ^iconsBottom + self layoutInset + self borderWidth! Item was removed: - ----- Method: ObjectsTool>>modeSymbol (in category 'major modes') ----- - modeSymbol - "Answer the modeSymbol" - - ^ modeSymbol! Item was removed: - ----- Method: ObjectsTool>>modeSymbol: (in category 'major modes') ----- - modeSymbol: aSymbol - "Set the receiver's modeSymbol as indicated" - - modeSymbol := aSymbol. - self tweakAppearanceAfterModeShift. - ! Item was removed: - ----- Method: ObjectsTool>>modeTabs (in category 'major modes') ----- - modeTabs - "Answer a list of buttons which, when hit, will trigger the choice of mode of the receiver" - - | buttonList tupleList | - tupleList := #( - ('alphabetic' alphabetic showAlphabeticTabs 'A separate tab for each letter of the alphabet') - ('find' search showSearchPane 'Provides a type-in pane allowing you to match') - ('categories' categories showCategories 'Grouped by category') - - "('standard' standard showStandardPane 'Standard Squeak tools supplies for building')" - ). - - buttonList := tupleList collect: - [:tuple | - | aButton | - aButton := SimpleButtonMorph new label: tuple first translated. - aButton actWhen: #buttonUp. - aButton setProperty: #modeSymbol toValue: tuple second. - aButton target: self; actionSelector: tuple third. - aButton setBalloonText: tuple fourth translated. - aButton borderWidth: 0. - aButton]. - ^ buttonList - - "ObjectsTool new modeTabs"! Item was removed: - ----- Method: ObjectsTool>>newSearchPane (in category 'search') ----- - newSearchPane - "Answer a type-in pane for searches" - - | aTextMorph | - aTextMorph := TextMorph new - setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); - setTextStyle: (TextStyle fontArray: { Preferences standardEToysFont }); - setDefaultContentsIfNil; - on: #keyStroke send: #searchPaneCharacter: to: self; - setNameTo: 'SearchPane'; - setBalloonText: 'Type here and all entries that match will be shown.' translated; - vResizing: #shrinkWrap; - hResizing: #spaceFill; - margins: 4 at 6; - backgroundColor: Color white. - ^ aTextMorph! Item was removed: - ----- Method: ObjectsTool>>paneForTabs: (in category 'tabs') ----- - paneForTabs: tabList - "Answer a pane bearing tabs for the given list" - | aPane | - tabList do: [:t | - t color: Color transparent. - t borderWidth: 1; - borderColor: Color black]. - - aPane := Morph new - changeTableLayout; - color: self baseBackgroundColor; - listDirection: #leftToRight; - wrapDirection: #topToBottom; - vResizing: #spaceFill; - hResizing: #spaceFill; - cellGap: 6; - layoutInset: 4; - listCentering: #center; - addAllMorphs: tabList; - yourself. - - aPane width: self layoutBounds width. - - ^ aPane! Item was removed: - ----- Method: ObjectsTool>>partsBin (in category 'submorph access') ----- - partsBin - ^self findDeeplyA: PartsBin.! Item was removed: - ----- Method: ObjectsTool>>presentHelp (in category 'tabs') ----- - presentHelp - "Sent when a Help button is hit; provide the user with some form of help for the tool at hand" - - StringHolder new contents: 'The Objects tool allows you to browse through, and obtain copies of, many kinds of objects. - - You can obtain an Objects tool by choosing "Objects" from the world menu, or by the shortcut of typing alt-o (cmd-o) any time the cursor is over the desktop. - - There are three ways to use Objects, corresponding to the three tabs seen at the top: - - alphabetic - gives you separate tabs for a, b, c, etc. Click any tab, and you will see the icons of all the objects whose names begin with that letter - - search - gives you a type-in pane for a search string. Type any letters there, and icons of all the objects whose names match what you have typed will appear in the bottom pane. - - categories - provides tabs representing categories of related items. Click on any tab to see the icons of all the objects in the category. - - When the cursor lingers over the icon of any object, you will get balloon help for the item. - - When you drag an icon from Objects, it will result in a new copy of it in your hand; the new object will be deposited wherever you next click.' translated; - openLabel: 'About Objects' translated! Item was removed: - ----- Method: ObjectsTool>>resetThumbnails (in category 'menu') ----- - resetThumbnails - "Reset the thumbnail cache" - - PartsBin clearThumbnailCache. - modeSymbol == #categories ifTrue: [self showCategories] ifFalse: [self showAlphabeticTabs]! Item was removed: - ----- Method: ObjectsTool>>searchPane (in category 'submorph access') ----- - searchPane - "Answer the receiver's search pane, nil if none" - - ^ self submorphNamed: 'SearchPane' ifNone: [].! Item was removed: - ----- Method: ObjectsTool>>searchPaneCharacter: (in category 'search') ----- - searchPaneCharacter: evt - "A character represented by the event handed in was typed in the search pane by the user" - - ^ self showMorphsMatchingSearchString - - " | char | *** The variant below only does a new search if RETURN or ENTER is hit *** - char := evt keyCharacter. - (char == Character enter or: [char == Character cr]) ifTrue: - [self showMorphsMatchingSearchString]"! Item was removed: - ----- Method: ObjectsTool>>setDefaultParameters (in category 'initialization') ----- - setDefaultParameters - - self - borderColor: self baseBorderColor; - color: self baseBackgroundColor! Item was removed: - ----- Method: ObjectsTool>>setExtentFromHalo: (in category 'layout') ----- - setExtentFromHalo: anExtent - "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed" - super setExtentFromHalo: ((anExtent x max: self minimumWidth) @ (anExtent y max: self minimumHeight)). - ! Item was removed: - ----- Method: ObjectsTool>>setSearchStringFromSearchPane (in category 'search') ----- - setSearchStringFromSearchPane - "Set the search string by obtaining its contents from the search pane, and doing a certain amount of munging" - - searchString := self searchPane text string asLowercase withBlanksTrimmed. - searchString := searchString copyWithoutAll: {Character enter. Character cr}! Item was removed: - ----- Method: ObjectsTool>>showAll (in category 'search') ----- - showAll - "Put items matching the search string into my lower pane. - showAll is for testing that all bin parts can be displayed. - Currently it has no callers of use other than the test." - | quads | - self partsBin removeAllMorphs. - self modeSymbol: nil . - Cursor wait - showWhile: [quads := OrderedCollection new. - Morph withAllSubclasses - do: [:aClass | aClass - addPartsDescriptorQuadsTo: quads - if: [:info | true ]]. - self installQuads: quads fromButton: nil]! Item was removed: - ----- Method: ObjectsTool>>showAlphabeticCategory:fromButton: (in category 'submorph access') ----- - showAlphabeticCategory: aString fromButton: aButton - "Blast items beginning with a given letter into my lower pane" - self partsBin removeAllMorphs. - Cursor wait - showWhile: [ - | eligibleClasses quads uc | - uc := aString asUppercase asCharacter. - eligibleClasses := Morph withAllSubclasses. - quads := OrderedCollection new. - eligibleClasses - do: [:aClass | aClass theNonMetaClass - addPartsDescriptorQuadsTo: quads - if: [:info | info formalName translated asUppercase first = uc]]. - self installQuads: quads fromButton: aButton]! Item was removed: - ----- Method: ObjectsTool>>showAlphabeticTabs (in category 'alphabetic') ----- - showAlphabeticTabs - "Switch to the mode of showing alphabetic tabs" - - modeSymbol == #alphabetic ifTrue: [ ^self ]. - self partsBin removeAllMorphs. - self initializeWithTabs: self alphabeticTabs. - self modeSymbol: #alphabetic. - self tabsPane submorphs first doButtonAction! Item was removed: - ----- Method: ObjectsTool>>showCategories (in category 'categories') ----- - showCategories - "Set the receiver up so that it shows tabs for each of the standard categories" - - modeSymbol == #categories ifTrue: [ ^self ]. - - self partsBin removeAllMorphs. - self initializeWithTabs: self tabsForCategories. - self modeSymbol: #categories. - self tabsPane submorphs first doButtonAction. - ! Item was removed: - ----- Method: ObjectsTool>>showCategory:fromButton: (in category 'categories') ----- - showCategory: aCategoryName fromButton: aButton - "Project items from the given category into my lower pane" - - "self partsBin removeAllMorphs. IMHO is redundant, " - Cursor wait - showWhile: [ - | quads | - quads := OrderedCollection new. - Morph withAllSubclasses - do: [:aClass | aClass theNonMetaClass - addPartsDescriptorQuadsTo: quads - if: [:aDescription | aDescription translatedCategories includes: aCategoryName]]. - quads sort: [:q1 :q2 | q1 third <= q2 third]. - self installQuads: quads fromButton: aButton]! Item was removed: - ----- Method: ObjectsTool>>showMorphsMatchingSearchString (in category 'search') ----- - showMorphsMatchingSearchString - "Put items matching the search string into my lower pane" - self setSearchStringFromSearchPane. - self partsBin removeAllMorphs. - Cursor wait - showWhile: [ - | quads | - quads := OrderedCollection new. - Morph withAllSubclasses - do: [:aClass | aClass - addPartsDescriptorQuadsTo: quads - if: [:info | info formalName translated includesSubstring: searchString caseSensitive: false]]. - self installQuads: quads fromButton: nil]! Item was removed: - ----- Method: ObjectsTool>>showSearchPane (in category 'search') ----- - showSearchPane - "Set the receiver up so that it shows the search pane" - - | tabsPane aPane | - modeSymbol == #search ifTrue: [ ^self ]. - - self partsBin removeAllMorphs. - - tabsPane := self tabsPane. - aPane := self newSearchPane. - self replaceSubmorph: tabsPane by: aPane. - - self modeSymbol: #search. - self showMorphsMatchingSearchString. - self currentHand newKeyboardFocus: aPane! Item was removed: - ----- Method: ObjectsTool>>tabsForCategories (in category 'categories') ----- - tabsForCategories - "Answer a list of buttons which, when hit, will trigger the choice of a category" - - | buttonList classes categoryList basic | - classes := Morph withAllSubclasses. - categoryList := Set new. - classes do: [:aClass | - (aClass class includesSelector: #descriptionForPartsBin) ifTrue: - [categoryList addAll: aClass descriptionForPartsBin translatedCategories]. - (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: - [aClass supplementaryPartsDescriptions do: - [:aDescription | categoryList addAll: aDescription translatedCategories]]]. - - categoryList := categoryList asOrderedCollection sort. - - basic := categoryList remove: ' Basic' translated ifAbsent: [ ]. - basic ifNotNil: [ categoryList addFirst: basic ]. - - basic := categoryList remove: 'Basic' translated ifAbsent: [ ]. - basic ifNotNil: [ categoryList addFirst: basic ]. - - buttonList := categoryList collect: - [:catName | - | aButton | - aButton := SimpleButtonMorph new label: catName. - aButton actWhen: #buttonDown. - aButton target: self; actionSelector: #showCategory:fromButton:; arguments: {catName. aButton}]. - ^ buttonList - - "ObjectsTool new tabsForCategories"! Item was removed: - ----- Method: ObjectsTool>>tabsPane (in category 'submorph access') ----- - tabsPane - "Answer the receiver's tabs pane, nil if none" - - ^ self submorphNamed: 'TabPane' ifNone: [].! Item was removed: - ----- Method: ObjectsTool>>tweakAppearanceAfterModeShift (in category 'initialization') ----- - tweakAppearanceAfterModeShift - "After the receiver has been put into a given mode, make an initial selection of category, if appropriate, and highlight the mode button." - - self buttonPane submorphs do: - [:aButton | - | aColor | - "aButton borderWidth: 1." - aColor := (aButton valueOfProperty: #modeSymbol) = modeSymbol - ifTrue: [self buttonActiveColor] - ifFalse: [self buttonColor]. - - aButton firstSubmorph color: aColor. - aButton borderColor: aColor].! Item was removed: - ----- Method: PackagePaneBrowser class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry; - registerInAppRegistry.! Item was removed: - ----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop} - forFlapNamed: 'Tools']! Item was removed: - ----- Method: PackagePaneBrowser class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self]. - SystemBrowser unregister: self.! Item was removed: - ImageMorph subclass: #PaintBoxColorPicker - instanceVariableNames: 'currentColor locOfCurrent' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !PaintBoxColorPicker commentStamp: 'JMM 9/13/2004 07:37' prior: 0! - A pop-up, 32-bit color palette used as part of a PaintBoxMorph. - ! Item was removed: - ----- Method: PaintBoxColorPicker>>beStatic (in category 'initialization') ----- - beStatic - - "an aid for Nebraska: make the color chart a static image to reduce traffic" - image isStatic ifFalse: [ - image := image as: StaticForm - ].! Item was removed: - ----- Method: PaintBoxColorPicker>>currentColor (in category 'accessing') ----- - currentColor - - ^ currentColor - ! Item was removed: - ----- Method: PaintBoxColorPicker>>currentColor: (in category 'accessing') ----- - currentColor: aColor - "Force me to select the given color." - - currentColor := aColor. - locOfCurrent := nil. "remove the marker" - ! Item was removed: - ----- Method: PaintBoxColorPicker>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Image plus circles for currently selected color." - - | c | - super drawOn: aCanvas. - locOfCurrent ifNotNil: [ - c := self ringColor. - aCanvas - fillOval: (Rectangle center: locOfCurrent + self topLeft extent: 9 at 9) - color: Color transparent - borderWidth: 1 - borderColor: c]. - ! Item was removed: - ----- Method: PaintBoxColorPicker>>endColorSelection: (in category 'event handling') ----- - endColorSelection: evt - "Update current color and report it to paint box." - - self selectColor: evt. - "restore mouseLeave handling" - self on: #mouseLeave send: #delete to: self. - ! Item was removed: - ----- Method: PaintBoxColorPicker>>initMouseHandlers (in category 'event handling') ----- - initMouseHandlers - - self on: #mouseDown send: #startColorSelection: to: self. - self on: #mouseMove send: #selectColor: to: self. - self on: #mouseUp send: #endColorSelection: to: self. - self on: #mouseLeave send: #delete to: self. - ! Item was removed: - ----- Method: PaintBoxColorPicker>>initialize (in category 'initialization') ----- - initialize - - super initialize. - currentColor := Color black. - locOfCurrent := nil. - self initMouseHandlers. - ! Item was removed: - ----- Method: PaintBoxColorPicker>>ringColor (in category 'drawing') ----- - ringColor - "Choose a color that contrasts with my current color. If that color isn't redish, return red. Otherwise, return green" - - currentColor isTransparent ifTrue: [^ Color red]. - currentColor red < 0.5 ifTrue: [^ Color red]. - currentColor red > (currentColor green + (currentColor blue * 0.5)) - ifTrue: [^ Color green] - ifFalse: [^ Color red]. - ! Item was removed: - ----- Method: PaintBoxColorPicker>>selectColor: (in category 'event handling') ----- - selectColor: evt - "Update the receiver from the given event. Constrain locOfCurrent's center to lie within the color selection area. If it is partially in the transparent area, snap it entirely into it vertically." - - | r | - - locOfCurrent := evt cursorPoint - self topLeft. - r := Rectangle center: locOfCurrent extent: 9 @ 9. - locOfCurrent := locOfCurrent - + (r amountToTranslateWithin: (8 @ 11 corner: (self image width-6) @ (self image height-6))). - locOfCurrent x > (self image width-(12+7)) ifTrue: [locOfCurrent := (self image width - 12) @ locOfCurrent y]. "snap into grayscale" - currentColor := locOfCurrent y < 19 - ifTrue: - [locOfCurrent := locOfCurrent x @ 11. "snap into transparent" - Color transparent] - ifFalse: [image colorAt: locOfCurrent]. - (owner isKindOf: PaintBoxMorph) - ifTrue: [owner takeColorEvt: evt from: self]. - self changed! Item was removed: - ----- Method: PaintBoxColorPicker>>startColorSelection: (in category 'event handling') ----- - startColorSelection: evt - "Start color selection. Make me stay up as long as the mouse is down." - - self on: #mouseLeave send: nil to: nil. - self selectColor: evt. - ! Item was removed: - ImageMorph subclass: #PaintBoxMorph - instanceVariableNames: 'action tool currentCursor thumbnail currentColor currentBrush colorMemory stampHolder rotationTabForm scaleTabForm colorMemoryThin brushes focusMorph weakDependents recentColors' - classVariableNames: 'ColorChart ImageLibrary Prototype RecentColors UseLargeColorPicker' - poolDictionaries: '' - category: 'MorphicExtras-Support'! Item was removed: - ----- Method: PaintBoxMorph class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Flush caches" - - ColorChart := nil. - ! Item was removed: - ----- Method: PaintBoxMorph class>>colorChart (in category 'resources') ----- - colorChart - ^ColorChart ifNil: - [ColorChart := self useLargeColorPicker - ifTrue: [ColorPickerMorph colorPaletteForDepth: 32 extent: (360+10)@(180+10)] - ifFalse: [ColorPickerMorph colorPaletteForDepth: 16 extent: 120 @ 89]]! Item was removed: - ----- Method: PaintBoxMorph class>>colorMemoryImage (in category 'resources') ----- - colorMemoryImage - ^self imageLibrary at: #colorMemoryImage ifAbsentPut: - [| offset chart spec fillStyle colorMemoryImage | - offset := 7 at 6. - chart := self colorChart. - colorMemoryImage := Form extent: chart extent+(offset*2) depth: chart depth. - spec := #( - (1.00 #(0.4 0.6 0.8)) - (0.67 #(0.6 0.6 0.8)) - (0.33 #(0.6 0.8 0.8)) - (0.00 #(0.6 0.8 0.9))). - fillStyle := GradientFillStyle ramp: (spec collect: [:e | e first -> (Color fromRgbTriplet: e second)]). - fillStyle origin: 0@(colorMemoryImage extent y //2); direction: colorMemoryImage extent x @0. - - (colorMemoryImage getCanvas copyOrigin: 0 at 0 clipRect: (0 at 0 extent: colorMemoryImage extent)) - fillRectangle: (0 at 0 extent: colorMemoryImage extent) fillStyle: fillStyle; - frameAndFillRectangle: (0 at 0 extent: colorMemoryImage extent) fillColor: Color transparent borderWidth: 1 borderColor: Color black. - colorMemoryImage copy: (0 at 0 extent: chart extent) from: chart to: offset rule: Form over. - colorMemoryImage]! Item was removed: - ----- Method: PaintBoxMorph class>>colorMemoryThinImage (in category 'resources') ----- - colorMemoryThinImage - ^self imageLibrary at: #colorMemoryThinImage ifAbsentPut: - [| offset chart spec fillStyle thinImage | - offset := 7 at 6. - chart := self colorChart. - thinImage := Form extent: 42 at 101 depth: chart depth. - spec := #( - (1.00 #(0.4 0.6 0.8)) - (0.67 #(0.6 0.6 0.8)) - (0.33 #(0.6 0.8 0.8)) - (0.00 #(0.6 0.8 0.9))). - fillStyle := GradientFillStyle ramp: (spec collect: [:e | e first -> (Color fromRgbTriplet: e second)]). - fillStyle origin: 0@(thinImage extent y //2); direction: thinImage extent x @0. - (thinImage getCanvas copyOrigin: 0 at 0 clipRect: (0 at 0 extent: thinImage extent)) - fillRectangle: (0 at 0 extent: thinImage extent) fillStyle: fillStyle; - frameAndFillRectangle: (0 at 0 extent: thinImage extent) fillColor: Color transparent borderWidth: 1 borderColor: Color black. - thinImage copy: (chart extent x - thinImage extent x + (2*offset x)@0 corner: chart extent x @ (chart extent y min: thinImage extent y - (2 * offset y))) from: chart to: offset rule: Form over. - thinImage]! Item was removed: - ----- Method: PaintBoxMorph class>>ellipseIcon (in category 'resources') ----- - ellipseIcon - ^self imageLibrary at: #ellipseIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABsAAAAVCAMAAACAAGUXAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAALJJREFUeF6N0U0OgyAQBWDfFm0ygGLk73rteTzurCpIBIxN+lYTvpmEgYE5ZeeHDPyXRWeFlHLeWttz3g5QWhMgXD8XPcGEVFoN8p15KgdH1oLFPrFSQtGYh2lvqGGrLYitTRgvi1L0q5G+zMqxt9x7mqPl5xyT6g11jkV/F4u12oS5NYFQ7aVyZ0k8ty3G6TlLGQJU+54ZpbEc3AZo7o3jAoCOL6KV73boNOrZbPd/f8wXgWSq2Ol/ETUAAAAASUVORK5CYII=' readStream)) offset: -5@ -4; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>ellipseIconImage (in category 'resources') ----- - ellipseIconImage - ^self imageLibrary at: #ellipseIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABsAAAAVCAMAAACAAGUXAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAALJJREFUeF6N0U0OgyAQBWDfFm0ygGLk73rteTzurCpIBIxN+lYTvpmEgYE5ZeeHDPyXRWeFlHLeWttz3g5QWhMgXD8XPcGEVFoN8p15KgdH1oLFPrFSQtGYh2lvqGGrLYitTRgvi1L0q5G+zMqxt9x7mqPl5xyT6g11jkV/F4u12oS5NYFQ7aVyZ0k8ty3G6TlLGQJU+54ZpbEc3AZo7o3jAoCOL6KV73boNOrZbPd/f8wXgWSq2Ol/ETUAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>eraseIcon (in category 'resources') ----- - eraseIcon - ^self imageLibrary at: #eraseIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAC8AAAAjCAMAAAAzO6PlAAADAFBMVEUAAAAAAAD//+V/f3//AAAA/wAAAP8A/////wD/AP8fHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8v/AP//Mv//Zf//mP//y////+Vs9r+lAAABAHRSTlMA////////////////////////////////////////////////////AP//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////2hiZ4AAAATlJREFUeF7l1DFuhDAQBVA0bST7AFmJzsfci9Cl4xSWVgodVHsDJJBWWMJ2AW4yGRsWJYWxt0qRoaF4Y/4YQ/GXBY7qRZ7f8eTuNW5NNgevjcnmShnTXanN5PFRdcaV750FOB8CNz4aAwjXt9TQTz5auqFIiV1CpMiej5TIACR2tUYSgfsOa1Nv4YFw8L3FWqViXGuEn3wcqG5DNLxe0f3iN6opPqtff5dT4HTZGBfeC7QbVyqsPkRnFd73GnHbTRV0dFLiwfd3EHaPPsSzeE6e99QguAtZhsmdcf610gOklC1jrOsmc3ZsiK/LwgX4BvlxuZQcz04ZcfLUIFgjZVVV9fmZ96svi9Z3zlhZt0wkvhG+8Xlua58l/Q16TbxpPhudwQt+8DXvF8L1/CA989w/GtfEl+L/11Hf/SVoHyShmoYAAAAASUVORK5CYII=' readStream)) offset: -16@ -34; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>eraseIconImage (in category 'resources') ----- - eraseIconImage - ^self imageLibrary at: #eraseIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAC8AAAAjCAMAAAAzO6PlAAADAFBMVEUAAAAAAAD//+V/f3//AAAA/wAAAP8A/////wD/AP8fHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8v/AP//Mv//Zf//mP//y////+Vs9r+lAAABAHRSTlMA////////////////////////////////////////////////////AP//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////2hiZ4AAAATlJREFUeF7l1DFuhDAQBVA0bST7AFmJzsfci9Cl4xSWVgodVHsDJJBWWMJ2AW4yGRsWJYWxt0qRoaF4Y/4YQ/GXBY7qRZ7f8eTuNW5NNgevjcnmShnTXanN5PFRdcaV750FOB8CNz4aAwjXt9TQTz5auqFIiV1CpMiej5TIACR2tUYSgfsOa1Nv4YFw8L3FWqViXGuEn3wcqG5DNLxe0f3iN6opPqtff5dT4HTZGBfeC7QbVyqsPkRnFd73GnHbTRV0dFLiwfd3EHaPPsSzeE6e99QguAtZhsmdcf610gOklC1jrOsmc3ZsiK/LwgX4BvlxuZQcz04ZcfLUIFgjZVVV9fmZ96svi9Z3zlhZt0wkvhG+8Xlua58l/Q16TbxpPhudwQt+8DXvF8L1/CA989w/GtfEl+L/11Hf/SVoHyShmoYAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>eyedropperIcon (in category 'resources') ----- - eyedropperIcon - ^self imageLibrary at: #eyedropperIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACYAAAAkCAMAAADSK7iXAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAR5JREFUeF6t1DGygjAQBmCHVkYroplhFBjzwmHouAidF8ALZOzSeYF4g1Smeu8CtlRJR5vqJejTV0CWwq2/2QnL/ruwdk4t7CfYj5IXmKnOaMkhdjO+5DHMlDF93xvZ4BD71oNyrAmx7ql4VQbYSzXlFFNK6f9qgslOaq/0U02wi2tjetPJYzWoqbdxZaQcWpWBn7Vfcfeqtxpn2ToquB/Enxpl2VdED7g5Vy81xpwi91Od1m81wnLqVJtYe64DLKeUXFsErKXvdcU1sL2riBKxXQJLnrtPFNsYyELhFUJAZJy6CxQDySr8uBAGAph7lcRATjM/riQF4rxfExEvUyD1rCACbcDjwA4t2sE3hKUYPDXsUTMuEpt3uD7LoPoFh1uzvVTXHQoAAAAASUVORK5CYII=' readStream)) offset: -12@ -35; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>eyedropperIconImage (in category 'resources') ----- - eyedropperIconImage - ^self imageLibrary at: #eyedropperIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACYAAAAkCAMAAADSK7iXAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAR5JREFUeF6t1DGygjAQBmCHVkYroplhFBjzwmHouAidF8ALZOzSeYF4g1Smeu8CtlRJR5vqJejTV0CWwq2/2QnL/ruwdk4t7CfYj5IXmKnOaMkhdjO+5DHMlDF93xvZ4BD71oNyrAmx7ql4VQbYSzXlFFNK6f9qgslOaq/0U02wi2tjetPJYzWoqbdxZaQcWpWBn7Vfcfeqtxpn2ToquB/Enxpl2VdED7g5Vy81xpwi91Od1m81wnLqVJtYe64DLKeUXFsErKXvdcU1sL2riBKxXQJLnrtPFNsYyELhFUJAZJy6CxQDySr8uBAGAph7lcRATjM/riQF4rxfExEvUyD1rCACbcDjwA4t2sE3hKUYPDXsUTMuEpt3uD7LoPoFh1uzvVTXHQoAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>fillIcon (in category 'resources') ----- - fillIcon - ^self imageLibrary at: #fillIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACEAAAAxCAMAAABj7DDGAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAglJREFUeF6tlN2aoyAMhsfTitIZJSugCX/67PXO5Xq0AdpOZ7a2J8ORJC/Jlwh52/cX623/VcL5mDwdE9R7RB+3SAeE87jsO2InpXtIkFuuFimJyNEPouvxZiFGUgrOfSPcV2QDuPnY9zH13R1xLYFYbM9SMMgUg/siuksB5IOUqwwbmhBD6N2NcKH6OXTis1zyZBjw5K6Ej9XPzhiTTFJqsAwQ3hHE/j4E9ksm1nmCmQGkSnQx9DF4HyKrWNcU49YJAMTZ2kowizkJu7dVphDc1llQwhotukIgHwDtt7UECD15mYlWazHZQkytUuPQIheaYhEoOyOUAjGByAQqBhgZZ8lqKAuUi5nYCqAgE2JUAzOM1ArRznIWkI3qQvDnULbKUi4AaTEChjFbShY7jGWj2uHEgDFhMQZUiayK0mWsG1BN085Ga88U1KBT7cckBKsGdW6as8gVcgx1BQphtck9+2h4jZp7IzSUvPr2b23uqckABwHuTlHZ2q/7gUQ+QiGaFmoCBXh3C/nmpDRU4lQTtAK/3VPPDX +vxN/czLbVP+46pTWem4sQBsD+/15iuBDNxL9jefjmrjE0TPj43V6IDy0OXjZW4iTwcDqcMgBIx/Mj90PTk/mRY0D3dAaNTWOfT6k/jXoxx+bHIe4n3Vnsr7KMLwj1Wsf7cx2fdT1X+vlyav8GcbD+Ab0bxRv8puClAAAAAElFTkSuQmCC' readStream)) offset: -10@ -44; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>fillIconImage (in category 'resources') ----- - fillIconImage - ^self imageLibrary at: #fillIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACEAAAAxCAMAAABj7DDGAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAglJREFUeF6tlN2aoyAMhsfTitIZJSugCX/67PXO5Xq0AdpOZ7a2J8ORJC/Jlwh52/cX623/VcL5mDwdE9R7RB+3SAeE87jsO2InpXtIkFuuFimJyNEPouvxZiFGUgrOfSPcV2QDuPnY9zH13R1xLYFYbM9SMMgUg/siuksB5IOUqwwbmhBD6N2NcKH6OXTis1zyZBjw5K6Ej9XPzhiTTFJqsAwQ3hHE/j4E9ksm1nmCmQGkSnQx9DF4HyKrWNcU49YJAMTZ2kowizkJu7dVphDc1llQwhotukIgHwDtt7UECD15mYlWazHZQkytUuPQIheaYhEoOyOUAjGByAQqBhgZZ8lqKAuUi5nYCqAgE2JUAzOM1ArRznIWkI3qQvDnULbKUi4AaTEChjFbShY7jGWj2uHEgDFhMQZUiayK0mWsG1BN085Ga88U1KBT7cckBKsGdW6as8gVcgx1BQphtck9+2h4jZp7IzSUvPr2b23uqckABwHuTlHZ2q/7gUQ+QiGaFmoCBXh3C/nmpDRU4lQTtAK/3VPPDX +vxN/czLbVP+46pTWem4sQBsD+/15iuBDNxL9jefjmrjE0TPj43V6IDy0OXjZW4iTwcDqcMgBIx/Mj90PTk/mRY0D3dAaNTWOfT6k/jXoxx+bHIe4n3Vnsr7KMLwj1Wsf7cx2fdT1X+vlyav8GcbD+Ab0bxRv8puClAAAAAElFTkSuQmCC' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>imageLibrary (in category 'resources') ----- - imageLibrary - ^ImageLibrary ifNil: [ImageLibrary := IdentityDictionary new]! Item was removed: - ----- Method: PaintBoxMorph class>>initialize (in category 'class initialization') ----- - initialize - "PaintBoxMorph initialize" - - Prototype := ColorChart := ImageLibrary := nil. - - ! Item was removed: - ----- Method: PaintBoxMorph class>>lineIcon (in category 'resources') ----- - lineIcon - ^self imageLibrary at: #lineIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABYAAAAVCAMAAAB1/u6nAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAF5JREFUeF6V0LEOgDAIBNB2dmmiSRPhq/ncTlbRSuEGvfGFELjUGkpqn3mviGktgLty5EsD03aqZ531zFnV8aMz50LgnTE7sdGbpd9gdXB991rmhV2DogHFCu77H4cc4R6SttzoBIUAAAAASUVORK5CYII=' readStream)) offset: -5@ -17; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>lineIconImage (in category 'resources') ----- - lineIconImage - ^self imageLibrary at: #lineIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABYAAAAVCAMAAAB1/u6nAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAF5JREFUeF6V0LEOgDAIBNB2dmmiSRPhq/ncTlbRSuEGvfGFELjUGkpqn3mviGktgLty5EsD03aqZ531zFnV8aMz50LgnTE7sdGbpd9gdXB991rmhV2DogHFCu77H4cc4R6SttzoBIUAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>localeChanged (in category 'notification') ----- - localeChanged - | caption | - caption := ColorPickerMorph noColorCaption. - ColorChart ifNotNil: [ - caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)].! Item was removed: - ----- Method: PaintBoxMorph class>>new (in category 'instance creation') ----- - new - - | pb | - pb := self prototype veryDeepCopy. - "Assume that the PaintBox does not contain any scripted Players!!" - pb stampHolder normalize. "Get the stamps to show" - "Get my own copies of the brushes so I can modify them" - #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | | dualUse button | - button := pb submorphNamed: sel. - button offImage: button offImage deepCopy. - dualUse := button onImage == button pressedImage. "sometimes shared" - button onImage: button onImage deepCopy. - dualUse - ifTrue: [button pressedImage: button onImage] - ifFalse: [button pressedImage: button pressedImage deepCopy]. - ]. - pb showColor. - pb fixUpRecentColors. - pb addLabels. - ^ pb! Item was removed: - ----- Method: PaintBoxMorph class>>newPrototype (in category 'instance creation') ----- - newPrototype - ^self basicNew buildAPrototype! Item was removed: - ----- Method: PaintBoxMorph class>>paintIcon (in category 'resources') ----- - paintIcon - ^self imageLibrary at: #paintIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACwAAAAnCAMAAABDnVrwAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAATNJREFUeF7d1KFywzAMBuCN9griLLnF7Rxs5DcJcZDZYKmRQ8pSVBZsFFS2ZwgK6mMUJU9QNMXLunV3sTwwMuHvdDrZ+h8er+H1f7EpaTA2WhcmEFfaWl2UQXiyXWeKKgC3YG03jDYAb7WBvv04Xs44Bmu7EWyPz1xN9vJhMWy+WwS7RdysH7duaTBwH/Dczg7QOMex/hz4jH8kZ4fbwF5czQMPPf5Ft7P96ruMmXvle7uEaVTcLc2H11FEyp99F/AKLOGge/wGnY1jzlvsYPPNc+osIQly3XmmklSCJYI85X68kUpJKMEJT5g/N/I4AalUTWW8ZkjIpEKArU9vJ8X8idRcM07EbCkSXw3jHKza13uZYVl3EICnMaR68Qdj0+wOx+NrpqA3DUjR5jeR+3c4oN4B/GzJ0c+GFaAAAAAASUVORK5CYII=' readStream)) offset: 0 at 0; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>paintIconImage (in category 'resources') ----- - paintIconImage - ^self imageLibrary at: #paintIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACwAAAAnCAMAAABDnVrwAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAATNJREFUeF7d1KFywzAMBuCN9griLLnF7Rxs5DcJcZDZYKmRQ8pSVBZsFFS2ZwgK6mMUJU9QNMXLunV3sTwwMuHvdDrZ+h8er+H1f7EpaTA2WhcmEFfaWl2UQXiyXWeKKgC3YG03jDYAb7WBvv04Xs44Bmu7EWyPz1xN9vJhMWy+WwS7RdysH7duaTBwH/Dczg7QOMex/hz4jH8kZ4fbwF5czQMPPf5Ft7P96ruMmXvle7uEaVTcLc2H11FEyp99F/AKLOGge/wGnY1jzlvsYPPNc+osIQly3XmmklSCJYI85X68kUpJKMEJT5g/N/I4AalUTWW8ZkjIpEKArU9vJ8X8idRcM07EbCkSXw3jHKza13uZYVl3EICnMaR68Qdj0+wOx+NrpqA3DUjR5jeR+3c4oN4B/GzJ0c+GFaAAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>paletteImage (in category 'resources') ----- - paletteImage - ^self imageLibrary at: #paletteImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAGgAAAEECAYAAADEXXE0AAAABHNCSVQFBQUBSsjp7wAAL55JREFUeF7lnSuUqzwUhUeOHFlZWYlEIpFIJBKJRCKRSCQSiaysrKysrKysrMt/9kkC4VnamT7uz11rL3pnOn3kY5+cJIfwNfXvcjmL82kvjodKHPYlqVi+/kB7peNhK87no7heL+Lrnn+Xy4n+uFRafoP+OaBdXmu3hTKGNQvU+bQTp2NFKg1Iy9ffqQ8KgKBtlYnL+SQm4JDlTlUNqK1KnKHT8vUbmW0LYBqUBJSyzkOQzue96ANqXvhy3k7quny1dKu9GmANJDioKlPW9WKEuysnAybhPpjrZUDLBzFPA21ngtKQ4KKqkoB2u6IBdDpuR+F0X9Ckv3zdp1bEMdpVQ2pclIiSxHCQPmswZlgbexEdN6XyVkayfLWF9tFtheQAbddq33O7ffEcdhE5qCwSgWHO144sZXZcQ3+M3+OPm85Mdmg6Xi5fI1Kd/pazNA1NghpuZ+kiDYiThd02rZ3RdY+GI+NjXkOB/fACULF8DUq3D9oKbYa2w8k9CMlwEX6H5zKg01EC0jk6YJgZWWM7Dcd44+VrWgqMhiP7lrjlpFbEujTtjec2DqpSBacccI/uuCScr6/v5esPNOUi/AxOqwFtJwDpJ+uYiBdPA3dAXq1MK7xHvsiHFBnHZ0u9Z8byfiejLdKOuoDqqGWYYhagJh5mtW2HAXXg3PFFctYboXQAZX8FqAOqC8jM7NDufUD5fECV6rD6gLxfwvkQMC33NJ8vDTuNa/z/HkDZDECYwdGzDwxodwuQShB0ylfkcQfQ43BGXfMLFcax+7iY7Zw2mITlKsn/9773A04aBlQZgGS7jwK69gAlHUC/geP/Gk7xBzJfT4e1PIlEVdD4blvRGbyl75uLNA5FTIBiv5GGlt4LTLXVnwGqnzgBaD6c3ztmutGDu37eem2CUJV0IlalyPOMV ZZYUKNlF2qg7XYrkjAQkedImbBawNxeSByC9ACg5G5A8zM1vx/S/hRGMEN+57HxPnBNVYiMoCT0OKHPF9P3YsFZKbXN8SgOhyO5KRIhAQpdRx41MFIX2FRGOwWo2+6/A3RvSPszp5DiARDxiHog1fvQ7+CUNEtlKFONDIdEnltDiMk9hwMt+x9PIoljERPIOIkZaBT4IgAw166BDYEyw9/TAT0LTjG3YzfGK+OvYwJSkOK2gyrqY3JSBufAMRoOA5KNrSEB4ommXfaHg8gIakXAtqRyv2X3AZTvWASrA2oA0kcAugfOnE48JYWeL1zLFZuVLX6+NsJeu8Kz6Ux3kWGF9JyQGpee33FU3guHvijTmN2TUwjTcLqAtHsCkuvRe6SYXb6IivqkivqnkhKJghIKPAaslF7Ts60a1BCkW33Q3wB6Ipyh7AqNDhibH1dYK4+Ex45YfW/E99eatGL9fK/5ubkRwhpAjZukezJRUN+T0v+ToB3auGGRViOM5anI6XkAAefsOdQdRUKOgnt2xwPD0cBi6qdca8OgtJt0yJuTZj8V0D3JwK30V7rGoy9KQNYenZWxCLxE+G5MDRAwpNW3xU4CnK+vHz7bU52YwCXoYzQgs09KQrHdVZyttUIbhyaX+5aMsjo0OADsENrOR35c0c+wRpNlFNaoP6r2yk101I6KolA4E5DeCOgROMEonMCFc5BVoZ+oKMMq6GexcDa+4SAJx3P0GKUPqNsflVlCgLbc92g43Ij0O/QnBf2O+5ijEhxy2DEIHJF673Y7DnshOQZgNJycUnU4LfC9FiQd7pCKvwnQvHHOLOdwmhsQCAo/Yclw0qhgBzkWwVkRnB+LAf18r8RmbVEDSwckqn+cAsSD0f2WU2p2DkIPQSvIVRpEqZyh/w9QOpwd6HgkhdTnARKcZMJJKfGI01Q4BIchGX0SXPQWQH8V1tDAngMAaHiboMTUiBmdiSG5yeMEYU2SR4L0s6aw51IIVA 1AZ2jPQXEb0JYaEQ5CP5OSi4ptKWGQAIkdpOAAiAxzBwlIgTqdTtxHAZBLJ0dMCQTDQdgk4f8+ZXbWZs19EhIHHepeDOgR5wyHNTTYZk1h6/uHtOLjD0AxEIePFkGDiyBr7Qh7Ywm3DiNmiCM41NdoSGWdMAT0nSruS3LMHii35HAAgUKo0lD2qu9h0WPA0SAR5vI8Fz71ew6NgzjLo8QBApyQ4AVRJGzLos+4boW6FwLqzBLcAaedrWFaJCBHNFCk6PG31Hq1YUdtCIi1celLA5RVx3mM7mPVCdeDUAAyIDEgGpDiLI/RmHREOMooNOnwBqcAyIEaBtLJQZ2pEUg4Dg4q6G8jAgFANrkejsH/0S8FlCgAnkcnjbVe8+fULnqpg/7CORjjbOhL9OAwoG+lFbvLAiAc1yvqo4xO2G+7BzAqglN1ACU0VvGDgMMSGtahIxoT/UcN5dS4hjM3Y8yj+5kj/a4GRK9h2zZDCqhfYjh4D1+Gvw19VtNFLwE0N6We7nMk5Nh36rDWhtMAWtOXXK9++MvqM9IMG2b2ViggDSAJKSc4aDQ0pE19lkV/v7EgGvQSLDhKO6hxTQMmJzAZZrhJSBSKXKbaHo298FoWQQIQj5yE93H4JHD5cwOQ+0pA2Q04xUw4h9wV18oR2wQhS7uogfP99cVwNqsVu8Y2Ot1+v9PAKRWcyghz6NTRiLIxNZwGEo7oPxiOdk0HjO5nMGDN6BhSP9MAkmIwCG2OdBUA6WQhcF4A6P5+pw1IzxAcGQ5p69HRE/uMOlt7ZYS1bw597JpN4xpkbKHX9DljzjEB4XfoE9pQ+pDQwBFB6qbNieq3ENIAEYAA3FfTQObryJPA5sdvAnR/aOsOQnd5QGAknEvpEizpoixA/yLdgy9Vu8ZWnWzd37j8OuY0TtkB03UQOnHtlCFpByD8AQS7BmmzkZnhMSZYUxrnYMYA4Qx92dDrsJtMQParAT0IZ5sFHNa0c46Fy3DyiEK MhzPthwZ5tkwELNW5OuZovJ0MlBNwzEQBDToESPcfluro1+TaFQlQtGtkZhbxRGlKP8drQXCPdkv/9SQghOeXJgn39D1dOFXiNXBIJ8BJJZzEJ5fYPzQ41XCGEgFvtK/pKW0DwqB02Dk2Z2FoTIv+r2vXAAvhTqfNyNCw6orQFhMsTIxK90joVgc2EgSMg/R3kRHAeRGgG+7Jx5xTNs4BnJ2GE8D+K4KxaaZIFJxB1/SARARaqoIwIcr/b8Icag6QXaFTRxqM8ORxKuzJxqRG/f42CgzpMfqYgEOZTJuxUAcHAQ4gafe0XGjA6abYLxmozgltXTglnGPAOSs4RWxR42/ozFqze3yMTax1H47qawZdkzZwGoUNsDpRCGs3hKqzT9SANaHZ6dVq1asAReP7mHMz0mb0ZQFSaXpsJgW2I4VU29psajiy/7RfN9VzN5w0EJfCrsPamZICZGwFOScNFRxyD76Aebb1ZgbiNpjtIJi+tKN4LESTojITa2YSkErjZ0MlunAUJwIYjLrd8VPjHFul1HJgum7gGKEN470kcN/noH6tGTVu7BMct4ZzKTH2cajBZMYWeWvV71j12XYLjumO2ZC0i+gxXMNTPJRCAw7m5eCMsTpqNDyPa+wGTpOpSThyPs7l6aox5+iV1fcDqosAfXHInCadRsaWq4wtlBmbdI7NfY4824yE4I/gmC7i+TikypWeGJUz1hsKSWOAkNUBUD/j066hfozT6c4sxwCcl9QkzIaT+3IgumsyNu53VMYmk4J1nRToyUS9ZNAdeD4Cpg1JuQgi9+gZaxwxezEG6Jt+hz7IstrpOOQRHE4GVu3BdHuRrj13+T5AoV+Xzu4yr5+xkZvKWPc7K3aP59j1opY+22Qq3YUzD9Bu5HEr1GHilObl4BwAwmRoK3sb6od4OqeBg5CGDHCzGepvmsW5Bk4zNHkLoMxwDsOp+nDMjA3ptOtY/aQgbC8XzHXOTiszjoaGQl2Rp7zE gFA3BQgCIO0a9Fdwzs3+xqiPMPV6QGPOQcaGObZUZWxGUuATEDMpiAbWcrrjm5tgptRzEY2L0B+h1Jf6o0lAajwEMOhvAGezGp5VN0PaWIH/ywHpOgJOpztjHSQJJTI2Sgo0nNB3WmeduVwg4QT1TMAknEEYsaGofexAkgt4Ac9KTwH6IRiYRUBIwxSUdk2v3iBoT96OTRq/FJAObbK2bCMqCmNIpZGxYSmhiiUc/A59Tp1OtzI2lRRE3YztHtfEM9QOd3qWO1Ud95AwJ8ezCQTItjbG5K3VCWlGXzNYN/4OQDq0qdoy36XGX3+zU5BK1+m0hoNpHGvTzth8t6khaPU7NwDdBaYDqXZRxCcE0vmhWQSEM0yWYvYBMwPdLG1oySM3y4y7pcfvA+TyKBn9iGMhNlOnSus6SKVNOK49UEMwkBRUs+E8AkiqG+ow+m/BQUE81nroCDC2ZSQCrlMvsZuJwGjxfgfSywHhgyJU4awKPAkJTsKyAeDodHoyY5sx3tnNcM++oykn6bER3n9tOAjjHcDA57VnuKZ7ZcVYudcbAUkH4Qvgi+DLyS/4Q/9f11+2KfBw6i84tAr6aGjbT2jKRXAuXKIBYcJWfg+rXsHFJSZ6eZ1dEzUz6yaUQThxuy96Wx+Eswt9CxIAR5199maqwKM/O30zpR4BVMPIDd2CZADy1ToN+hr5PWwFppsItMNZOaLPCHGdLI4v2XBthqSd1L0co1fg0Vlgm0wObsHpAhqANRjm6L1xlQO+W+h76ns4IyFtGkz5USHOuEI6DQxIuj9S0gmBTKfbM9TdtZ0/c88cQGaiQBkdxkK++qxR6yKsIThhUxjZqWD9LEBmdWjg1dfaSLUvu7i5XD17YDoHUHKXg5oQt25d0KX7nO7n7ulTQ9xQuBu+NL1TtxYP1xDMG//8kYMMQI6qRUAflNR7JJhpdNs57YqhD3ZQcWNLldaUh/Hhxwo9fuWgbBrOKCBSSsvgKPXiKx5Uy E7DGQWRI4CKTwI0dRljMZSKTlThPAJoNxPQ2FjIXIbI1SWSfIIZ36Ec6TM/GtDo5fEDKjvxexzQLxOFO8ZBPUB6GaIG1fn8XefMDXHRRzhoGFDvg08BGq3QeXzAupsxm9CFpBu8+Q5h73M3z5vhnjh432x2z0WTA7hwBqDwV3DumdXurhON1TFUd4S1W7MIHwPoYQfNgDSV0d0LZxzQCJhkpmPiod1QPgxQOQGo/CWgx0BF890zBCa5FcamwbxtHHSXg2aGuVl90ezV1M7jGTV0Q64ZcoZeA8rv2GXrs0PcH4Y5VjazJmFWWIsGL1spO6nybzcffK+D5oS5OS7qOWraVaOQ0rZu1c114bTTbjk2Gt/T1G+VV30goD920U1w99fF3eMcs185biNxKOFYjJVkzfngNpndLQo+AVD+C0BTkHQ6u6VpmL3nib3jiIIWzYaXKX5XcToER7vmQHDOh1icto2OFZ0Aeci15+2tMrug+o56+9UNkzMJM1xkxv4Drc9cHVdcPV9cXU+cLVukNKHZTP0/DqmacI6Gc9xF1BbUUPs2IFNZ5KmliYHtx7puemfp790uGpq6N353JMcwmCgW1ziRRz8Q+40lwvVaVdA8Vr89DcevnQM4DGjXB4OQV2U+7/nT3XGxWzBvuskEZN4e4LWA7oXUGV8cKaQxHIBJMyk8Duh3NjXCzw8vBDb1dMFsJ1VpOAkn68C5npKB8IZtzWidKJE7Lda7LeoK0+5mfiN7lj4HUDhzV5G5gFp76fhiTxAQzmo4WS6uSSodRNC2FOZCAuSR6opUo+hxmww7ZjswdTMIpzLgnOl9T6k4KQftC3p+Su+XopLWE9uCXpPaZlvEvH2zWccQDVx6ogHtjfsKvfEi4nmQzJ0QkRBwnwMY2jmQCm9H+l223ggH+yh8ffVqugevWU2iyWmbUecAzpne+2CJU2VROAsYTBbhEseV2Jb0mU6l2NMRvwOkktxZL/UPOCkz7t2gIb 31Ku+hcVFvUlFv8krPZThh1IDRziE4B+qTckoQfOxEQnAghDldnVrMuBx/FA79/b4KB+Fcd19iV2w4nAHQjlwTBh5fzJUQrB256nLIxWVPTiPAeex19i3Vl6K4rZtrdO+A8rKNLOauEUHbwBclpc5b0mUIDv5PYe1gSzgBwVkpOOblkkO13dWNDNF0zhZ3XTzFPTgXggOVqSNKGgOddvTzc0VZXSY2a+wv9EWuSxWcJgwyIMfok+raDPeFgOZu3jcxw8uZGoE5Uti6oN8BFN3nEJwLJQs7pNaUtXkGHFz6wVurtKpUp5fT+7MD0jnY4O+w187JenBO22/lkoz7oz1lb9wPEbCcQhr+383wUJxpbtMcqzr05KWA7tqGrD/JyGknjXPOyNaCUBwtahQKZZwcEJwzAauwwRF26qA+B3Agc+eOsOegYHJs1YVT5RnfAuByjBUcOjEOmxpOrf2PuO4JVvVDTgrISXQSnQr6eTI4NkKYq69T7WzR/HRA2UNbkTU7wHdLtVLbFmfK3ABnR2EMrkIyUKj+Zq1cA/G+N8bOHb1ri0Z2uuomI3h+SX972u8JUMnOAJzLft2HY+i0/aExETn94HJ/c9omg0KY8+z2JZG6L0Ib7p4NKPuDHa/0LWDKcitygnLRWRo5JF2RQ76bZABa/fy0du4IB4vwhwe+XTgF6ULuxHb/B/ruCG+34PS1pjERJS8lJRjY+6FwaHxkUzi0KJmwpwEN3GzwSVtiPrCxktrgAqVOu/1RXK5Xsd0dREZ9DQahuZFGD8GpL5s03dOt+own4KQ02HQpIfFpKud0pkai0LZfzQZzVcdd/kWDVakciulx+kXjIb3P0Jsd9OjNM/hvY5odPl3EmeAcz1exO1xEEMbkmm+RoI+ZgtO6Mq9T9Tk4+DXCGt73cBAnAnSJY3bQjkLSZTsO5Lxtw8H/q0wBUXAkKJQOr+srCD3+rMOA9q8CNHdLZrP6NE8ScThLOAeCU+1OIk5 yGlc4fA2obWRrehvM/jWtA/vFDdQJtOCQY8+7PQM6k3suUUT9z4Fv6IRMbQhOyQ2P0PetkgSk3AYc5ZosXsnrovhqjmZ/u9b0j0q13wBoBiS1mFVkKTmmDSeKaUxh2XyVm9z8biPWajA6CMe/H05FbrnmNH45HCUgJCU0yN2Xpai2e7HDINUMY3sdwtDP2BwC90XbMTgCVhTIjQcxu+DU7uncZEOn2e8ANNofdW57mac0mLtcJZzTVZTbowijVO4/oLbu0rL05rEDexCkE9fpFAN9zlbBuRbbGtCR0vsTnQA7GmdVu50oq4oW5ZwWpGOFcEYp995mWHBLboa0FLck0Ft2mnCG3PPCcdDc+9OZN+0raPB5uko4e4JTVAfqcxJ5uSF2kML2l52Lvlxjz5toAs5QkWALDoFhlTtKqw9ij01jCdCeAG2/4IKUARVFSZA8ds9VuWiov4FrsgSfs9nolsPaLTjdmYRnzcXdcytO3j8hl3Cg/VHC8YOINykHiCEonqMuc3dH4ETjpU/awRUlBBoMix4fq63Y0tinos8EOBWpoMSkSLEXaSky/JwmP897miDdNv2NBlRlPzRLoELaut3nmGGtt+zQnYt75mz2bDhwTl5IOBeZqeXFTnh+yNtPYhOlLph6ut4dmq7v3xtoqEBdu+eIKSMDzjWlcJLm8gZNpJLCW0GAclIG0bxgQglMSJOzMTkvo2mcDLukZDadZJT+px6HNN3f1J99DE5rhbUN6KnrQfPg0BlMZyvgHBWcLMe+bD7vHu+acOxmx47ufeC6l4HMdQ8+g3TPlvufC2WJZ+rvTgGt3RA4hLSSEoQSd+wiOAkpxvIFKcCO9tjJiqaaQppyyuj5ER1brun2N8rt2FqtG9a6d4h8PqCJmwzqDwE4ZwVnuz+LlBrJceXWXba6yFjCmbilmNm3jd2frtPvmDs9MqAOnKNP4yAKrwi7eVGwCkq3M+zyqwGRPMyWkzBgttX2lnNCWjch GLp95+vuAhn0wXCfQ7FcD0ABJ8lKytQ83uNT9zkmnO72XUNgeoCifmF6d++gE4WzS0z9HyUjNRyP5NKcnxdyVpniTloU1qIYt+gMqc/wSDjzfb43xGbMNTf6m2TkdtovBdR/c1fk9IVPCg4PQCnuW5bDY5u2c27srTZnIXDoojHjouaKwhLgHA04e5emlwDIphPJovd0UJFDC2zkboS0mPrHyPPrTdUtM4ExXVOHNGcipPVvRP8yQENwMLeGQSgGoHqMAzjYLhJhwn4QTn7PrZ/N62QplUY4k3BCCcehRULA2Tg0KWuJ7Gcjku+1SH/osUWgNlY9BuulzyrlH0wEJsCYcLLXA9KxlmZ0MQjEGKfcc6amxzj6i96G4/36zpHdzTVyClUSTlDDKRQcgIGylS0ScpO9XjdgetnlsGvmhDSzS3iRg9yW8OEqyooARyYDPicDevMkLe+BPuduGYASVZ+WUwjbOpRVEoR8TauzyjUJHTOCFVh2MxbrghlwTfduw1MhLRvoDl4KiGeUqYPdHS88p+bQhCf2HIBTNBh3Cs6d7sln3aG42bOBIeH96DOllgGHHBRT+PUsq/U5TTBmEnCPa2ooofeuJKGBk6jNHiIsFThyjxu9EZHcVEnOCgS9WYFuaPN+fbd8c96vBchvtqkJ1FY1vtooqSu/G87uzNCmnPN6QH67AeSXb/bq8VoVl47hnG5J7Aik8HFAmdlHql1PNCQG5TSfta4MdewemHtdo99bnyTZQDL1EkDJACC9AVFg7hTVnW4fKIXtz4oPgOpCC28AMsJL8zmd5ibqbgMiMB7rE6nnGn8iQwv7rhkbhrwOkN8HpCGF7sgYYbDqfxpUNgVqYmmjDan9WWOvgTCkLpjkFphwus8x4bwEUNP3GF/av/FFg/HQNk/+8BL7yBJHre5wwDc3e1IbPhlhbA6YtDvVFXiDexQNwXkNIN8dlLnD1dgXzR4GNL3+lIXjlyb2x2zu6He4NeBMw 1thbBzM2wENKR34sn8J6Z51qbGGmxrLjGVn2QNgPgtQMAynB+mVwCYb07s5RZPO1jicl9xsfQpK/2ycASp4Hag0eJbcmzKLRl4PKJgLaCao4LlOmgMs+yswnT7v6YBcY1pk+bpPmBV/OqAq9pevX+jpgA5Z+P9QauiF77t8QB+u5QNaPqDlN/LyAS0f0PIBLR/Q/0jbxBepj6UUixW5Ni+H7JJg+YA+QWmA+oWN2KzkDXFRmoU1rzL2lw9oSkXkyYuJPZvP8OqBBpsjvIeGU9/je4N79f2jDtJhAHNRzwQU8f1YV3zfBUyjANiz3qd/h+Ivsc+ifxNQ5MkvhG0pnwkIzvlR90D9+fnmfUqf9T4Ia627E9uWOObJvwkoC8k59DfXXfHkvsFl56wIDi55uWzz54TS0OOTDoWNcA4qlnYE51yly++DJrOrGFdv+/XJcCqSp7wPsjX0bxwR6L1OZUpwMnJQtHxAyx8HLR/Q8gEtX8sHtHxAywe0fEDLB7R8QMsH9L8TxkAYqMaenM0OnEb4WU6D8pLHSMHyAb1jMhbzcCiZsrHRE02Y1lNL33JW27XWDAuzGnMmaxcDCGdtyvcPt0WIyysduVYjz2qPZxl+8/p4Dd/e1JOx3clSU5hqwpTTnBn1/z2gPYWSjMDgrMXV40NnNRoWE5xwwD59zDl4je4E6S3BTbcgvRUQGi/neG2r7SCbZYfywcbqTcTyPRJuNx7Wa5IH1ojQ58CVcM49cJpZ7s3kifE2QICDs8dTZx5sr+2PWWAsehW/hITGBvi5ZzbO6OLOpWk8H9/h5+f7IUDYYxUnxliIfRugXH2xdWflUQuNmvxy1RNORKPf02A4Me55T3zGR91juqj8NEBDi1qDHzzyf7Vwthk5Acbk3Lk0jfC2vvM9hk7Gsfd8GyD0N6sbYQFf/JF1fPM9bmVUQyHnnpVdvMf39/evAPHq7sh7vhGQPevD/2ZZeu57/OY9H32Pue/5NkAIDb ccBOsff7HqicZ7xEH7OwH91kFoh/2nAUL669zowHH194WWih8FhA783rEJijuwTD2/n3Pu7ud6/R7NPIy959sAIWvBmGesAVFocaS1/N/UDRRqdH9PY2FnxnOZ3jGDcH+m2BX2LxorKHnjOCjkwaiutDGrMPGBj+Sc8y/co0tw4SJkZnMaCtu8oNLneIeDkJLPSXjGhG00D3kyeiK+eSYh5CytWwGDRjqVf1NxwycBQcIE5vT4x+ET4h73mFNJ3p1O1cqiYLL8awFzcfIs1yEV/R4SAZ3GI5Ti3kFXagDp2Oihcq7sgUExIsX1UE2G8cXMZmP6Bm7VTkVYQYaoa9ZORfyr168UJOwht/75uRnW4BzAueXY5a8H/ellJwHPfKQ8QWvxjvOtOUYKs9i/54AwPrNwcvmAnhBSu/2q6dbLNrurf10+oOXXJCy/kZcPaPmAlg/ofwto+fq9ngoo355qZS0dRVZJpV2VB1bS014khVTc007E+U5EXWXQVoQDcsNEbCxHlPn+F9qJkt6jGFFpKjc17/WXD+guQNMw2toq3YB3A9jyAc0BlHXBUMOnBR0z+rlUpR+nqSiSRORJzMrocZakIk9zUkXasoYADsFaPqApQC0wFUGRIHZ5KQ70ftCe3mNPr7Wjxt8mJc35FTSbkIuClIcZKRUZvU8WkEIChjt4xYBWKGBVD5YJafmABgFpMNIpgLLPt7Q+dZCi9zuQAGdHz9mmJc0cSDgFw8kUHAUoMJXQVBAkYaVJRrDK2l1tUG8E9OpMaDYgapiCRY2e5QIuOdNJcyIBDrsmaxxTERTtmIKAFAyFFGilrMwQA/KhmB4TpDAUadyAMiHhswPOCwGdWPjdwS8nhedc7XJS/JxVOSk8J8ymAO3a4SyVYQxgzvRZTwxmz2C2SaWgKDBhzlBYgVTeU9qBBDgSUOIpBQQpImD02hIUIG1lO+0XDqjQYHDmEhy4BGDO1YldU9LPWQREN/ZvJOFIxW4 kYk8q8UORUNhL4rx20/IBMSB5tiLT2ucVhzMOaeSaXSrBaP0FnC6kBIAIVOSGfOPCOCRIEUJesXxAAIQzNaeOvkwyDmXc11DY29LPEcr+wjVTTkKIg4MAiCEFgYgoDCZ0QiwfEAFK6UzN4lRUdNzRz3fc15QMB33MswC1IRmAvFAEpChMlg8IgHCmYmyCNLkiMBXDUQmA0ck/S5l2EQA5IR891xeBHy0fEADFNFZBBsWZGMColDmvs7LnOsgEFDoBu8ixadncC5YPCIA43lPH3B2vyEZ8voPMEKcB2bjrpOu/F9ArNQUopFF9RAPGzMis9Jn9GjhxDSd0UB4WCMuyheu8GZD35U2K3RFfJ8XP8a+TmgMopHiPFFcOHCM+ppAB7BmAdHoNOIHty6PjkYOWD8gIcTFDQuaEDIoHj0p6jPLXkOpBKikgEIAjAeHm7dbrQ1z2wYCQJCClRdbkU6MAkk55Oe01gGl1nTV0HFINxW6g+LYnHys40MuThE8GhFF7TIKLfIr/noPdgf1W6IFugZoCUoPBGMeA49J7AYxPR4DZrBv3hO9Osz8FECYoU5r/gpPQKGgcnMEeKXSDVoPWUqFwDFwLysDfMxj12N7YYr3e1HD4d+gT6fO8CdDxowBlNKWDyUlAiqhRAgOStbFbjfmXsgjIz8+PhLPRcPwaDk6cN4W4zwKU80TpEKSAIHmc8qIxcXQs92EgAI3XWa/XYr2S2ljqdeFYer+QliDiKPuM2exPAaSXGrAGoyFxuEOfRKEMDQswGtRGNzJptV7VjQ03dKV/V0v9nQmcp3XU3JteatCLdm910KcMVEtjPYgh0ZmL8ILkgbM7L+SzG6BasDQwS0Ib1WYjgRhQ8Dp4zRpMlBsLdc0C4lsdVNrXSfFzVtdJ8XO+rpOaAwirqkULlA55BbtJO0rD6gK7Jf1cDSVUY68xMG8vGvkoQL8tXGzBHdc/Vbj4bwJSDWsUdYyrUpoAhmX0Ty1c/OcA daGkmayTo++6y4OeqtRn4frXMqGJ2CThUKY1BPCDCheP/wYgs9KHGrPKUbMQi/M2EJe9PGodylAcC7fWLnNqVcmmPkLYi8EE1q+He0MflP1rDqo77KIFpQsGGgNjqkjcGhIe45hHNAaLfILUlAV3QS3fQT1AGkwp9vRdAOR6SnpwTCDDYCyWdI9Vu8dUHq2VbJGF5CqMgWpQu/cXLn4cINUoCGWnLcCkLBPOsFusGXJaYc6EVMQ4bggSzQtGaavC9K0O+piBagtOplwj4VwPDZimoa1Z0u6ZchM7SAGC0sCi5XdZYfr2qZ7NVzkpng4il0yJn2OXk5oDqFD9zXkXiesxkdpH5CTfcIv1ZzIh1Q7icLehlV2LBsbJaydLPxqQcs++iMg9EbvmsgvFqfLFofhbMEOQykSHuLXSRkSe+/7lhk8BJMc1W0qVfXJQKENa5TGcfW4/DZAJCS6Cg1IAirDr8YZmtsPlA9KAEO8PBUEppfYKzv6JcLS2KXb9lf1RqlwUumta3fWWH+J08Twyp13uNMrsp4MxAbGDCEwaSEgA5NnO8gHJ4nkJaJvaND0jtU2p4V4AxwxxAJMoQIGzFq5tLx+QvroBGVOZ2CSrVgVI6fMBafcAjgbkWStaZV2+g2oH8ZVtNEdWGGMSPC6NdPgZcNDvaDixv+Jj6K74XhJYBn/rXNynDFQZUFLw2EPOj8mMSo9L0Ih/DQivx/2NAtNozbca0LVx73UQnd1TwnPi+DopdpB/ndTcJEGWXdGcWGjJDltlVGhEPW82NKc25rChn3GmFjSKvJWIOnA2640q/fXeW5PwaYASXbzo+SIO7Car6qiZ5BwHpn+nn9d9DQajBDgyrAHO+j2VpZ/toF2dKMRcciUreTzHpj5hUzfoEKwheOZxDIopx8Lt1NZcHyfh6MrSePmAzLKrpi5OVvK4fJWBQ+nupm5Ms6HHIHWfNySk0Z79wzsPc30cw9H1cf5nVJZ+CiBd9KHHQ 6i0wUVdcBJXmBplVth/G407BmzocRfKxqilW6uQZreKF99QWfovADLLrZK6VjuuS6w0KF3nhiM/3qxZKGLcKKHh9eOVEoCs6t8ZdXK2yyW/virH0nDev9zwMYD2HUgaVNGAUjVxveJFDco46upRDcL8nXairpcDfAZDJwJKjps6uer9O418FqCh/eAMR0UNKOgvihcDwzF4fR4sd2oTln+N6qyyq13rOKdI8Z+rixu8gCsuJyVd5k2Kn7O9Tuq3gHRjthofNXFpJOvisqiWroerUA9HU0eoi0OJFZ7/z9XFfTygbl1cKiGgDAs7yWvtGRKJfr9NCFLs0zyeUuQJ3MeoCF05jRR7CpoJ6+Pq4j4d0K7e0K/Mcoait/bXasFRYHC/IoYTKTA1HE/gRlCmMt/h38sCxuLT6uI+OMTV/YMsWNT3M5L3NErbjuE7qkgoVWxAiaRjCgVDH+EggGFAgYTE/49c3ivorRv6fX4f1ISzKk1p+TuWYHCXEhMMwpy6eUYLjAIxpLxz1GCgxHMEbkCVB/T/KHzfhn6fHuKKGg59P1SUbgsW7i1UwyEwt2DckgmrAURzfp7NR9xXyBwLLT/EGWVXJXZbzONWSDtQKAOcbuj6rXLDSRqQhpSGwWds6PcpgHgeDnvEpaggRRKQ8RH3Nt3+gWum1IS6BlIWyN1PAGn5A1W1HoRwsiNA8oZMKjOjcUz1RDi1m4LGRbFyUex7PGH7Xgddr5PCcyw6TokdRMcpza7qiXGPO9xBK5QJAMEpnwxHA8o0INcSKYNy3r+h3+cAqngdCPefw90i+ajgvAMQjriVNralWT4g7DSilrtlg7VD2qsAcVgjOBoQ7hH+xu3Ijh8HCLt78JmMASQf5djk2XBkkiDdExGcSAHCcvtLi0Y+HhAWydToPlXK/OdBag9WJZzQ2dSQXl7V8y84CFcTmGOSevDoO08BhEEqL587Eo4GZBsbKy2/D2JAlSy5olXNwPXqdLfpE5 xa5pmvwelj3nncdYo5vRMyFIsBBS04m7rsyntfknD8yCwO4w7UonmOy1lUrMINGlIXfUzBGgJhPtaOacCshW9tlHskHFm02OwZt/yBqgLUhLlYbUOG2z3bNaCuAAxHE9iYulA0GF9VCKFSSNcv6L4HdQovHagOzWZvruWkuHFxnBKek3vTurNw0dx1EQUe8ixvg2mHqPUghFtiMKpgsdnQr4Hz9ns3fBKgortXHG8wK4tCdPWOs2nO/CFXdQEMuQZQUKKla+K40ocLFrtw5BL58gEZ9w9qbein6rSDgQ39LKO0qlWEWOuncxze0A/7zLX2jqOTor13XLV8QO3CRekkc3vMOMxa+8QNwTLr3sbq4swN/Xqb+gEMuQYnRXvBbrd8QEMrqu2auIrPaLMurrsD45y6OLMmztzUT9bEmWCaJe/y3UvenwXoeRv66ZKtf2hDv+M/Cuh/XLiY/+sO6hQu5nkuN/XDcjgraClPfFamChf/sQ39/pHS307hYlHI77atArHfR3w0VRRuS3lu8zFNLX4cR9jNyhVJHNWZ2sds6DcIKP+aFp6TfE0Lz4m/pvXghn6y0Qr+PgBiagqMhlOLnARIXQEYbiw1Xri4fECjG/rxnYjpuxz2sTgek1pjYFpAlIagmHD0MYarjC3I8vffifj4YYB27TQ7z8RuF4vTKWWZrrkXiPnzOszR4xAXKKtjHG/o5xbfnjP9pOuDPgVQK7vKU3E4NHDweAjMlDvmCrAAKIo2jXxa7sDiYfIBV9h9DiAdUnJyTlSHM7imqvw/B9MDFWtAElboeZ9x95NPASQ76Io+c8hQ4JrdLlRwnKfCgZJEAoKbWAFNstJsQ/z2wsX8a1p4DiBMCc8BhCnRcwCkKw1IZlEZJQW+2G5DUkBwvBoOGhHCYy39szlK0+kjAEkXSUBRuBEeTQ9hKgifffFJAo9JUvrMpceS/Y2Ek2WyETWUv4Yj1QFER4eWILD08F5AL9QUoJg75ZA a36mVZRKOCciUbtwusHv/bwICnCCQkGya+X77jW6949ek8JzN9WtS/Bx67pRuAeIFsjikhrINWS1Az3SRDnFdQM7by64+BBBP+0cRucimxrJq/X0o60uPgzQcBhTIBb23b0f2SYDkgplXp7w8eCTh7J7T0I+4qs7aFBzfX/HRdTZ8Z8jlAzJCHJaawyAiSLYxJlnX6e8znKMFMLU8uEdvrOQtH5BOEjDmkBsoBQSl3YCmdOP+BZzAXwvP68Phna/eey/vz+qDsOScqEIRvj2n55Gb7FZDmscxYCY482fm62gBjBbCmucacDZ6Q7/lp9kMCPNeQ3vFua5NjbepO29TZsM34bAts3/RfUxXnrfmitL1amNs6Ke2JXtn4WJWHWulLR2kyoNIetqLpNiLeEg0Gx2NaQCOCUhP9Zh7xfnGhn6OY1FjblqwdIc+rtUgEN9fs+AY21Jg9IZ+amsyn+HE7y1chIuGAR0ZzhSgZARQ/CCgQi2UDUNqKkxt1LHZNA3jESgA8/tgNIj6ZwoI+hfP3TAUwKjvRKxc06oqDeUNb186m539BaDiMOmghwFlwxv6cbhTt4xmN9mO2tDPUkLJ7rrRuq11V7rMV5X6IlOrwSjX6No4uR60e6ODpkLcqIMO4w4qHg9x7doDQOpWmJqgpKMAC4XuaGSrBjZ2J2KrBiKd6LR3WfSbXRZRh/cRdXF/76DxfiicA6i162L3bsQSlBwrxbyXKV+mQnNlaGQuXISo0YelCxz9eofFfjVpVS91//pOxOaTL3jiZctH/CHg4Q92O9nBfX//1Pq5Q9/f37/ST62fP9VvP1ejeW2CNkR7AgTa93za1m2Ox+CwrTKafY8loMNhaxCVNE1IeCH8XD/HFF5sSvp5GvBum9Gbp7ROo5WwM3G2QFVPKT8fHxh/i9fYKx32+ezP0f08+jPt1WeSn6v72UiVfn+pauT3+Pvmc5nvWcropCKUVGXAqXqGwN/jtRG1zuez+Lpc zh3LNX8Ey2lIeHH5ht0vXt6QapxDMQA5NzT0s3zwxBg+SeZ9juOhuPma89T/fGOfxYRz7sBpm6Ek2E23crlcyHH073TaG/T7LtJ0IQ1r+ZqrtmNMMJdz2wRofzgSUeV0Oko4+AdSpkV1x6Vf4Gq8YK3TtvWmy9eQZDtdztPi0EbOQ6jU7uHwZv47n4+dOFoO0ubQd9n2f758jesy3G46IqG9AQd9T8895r/T6cAx0Ozs2E3HvjWXD+i2phzTJF/5PDimk3Rm089MOh3e8sPYLOl+SCdanEUymJyzR8CBOW7CMfsk/AGnngqWCUxDW77mq07r6+GGCeYgkE1/3fvver2QJc90FhzlCx0P6rhfvh6WbEO06eV8G8p/jjw6cUDj8rwAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>paletteOnImage (in category 'resources') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: PaintBoxMorph class>>polygonIcon (in category 'resources') ----- - polygonIcon - ^self imageLibrary at: #polygonIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABsAAAAVCAMAAACAAGUXAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAI9JREFUeF6dkU0OhCAMhWXrOAmo0IxM5lIeQs/jcbvyp7appOPCBwuSj34vgQpxz4JGKnzOFsq/ufkNsad0sWATeCf5FqxOfBvc68qGIAxdKJgHYT1LT5YVa1hqOEXKc5qx1OgTqdEnUqsPR5LyXKvZh6Q8V8c8ZAlJpW97Rx8o7XZW7JfgWLQBkmJ48+9mVvybrBthz+e6AAAAAElFTkSuQmCC' readStream)) offset: -5@ -4; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>polygonIconImage (in category 'resources') ----- - polygonIconImage - ^self imageLibrary at: #polygonIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABsAAAAVCAMAAACAAGUXAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAI9JREFUeF6dkU0OhCAMhWXrOAmo0IxM5lIeQs/jcbvyp7appOPCBwuSj34vgQpxz4JGKnzOFsq/ufkNsad0sWATeCf5FqxOfBvc68qGIAxdKJgHYT1LT5YVa1hqOEXKc5qx1OgTqdEnUqsPR5LyXKvZh6Q8V8c8ZAlJpW97Rx8o7XZW7JfgWLQBkmJ48+9mVvybrBthz+e6AAAAAElFTkSuQmCC' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>prototype (in category 'instance creation') ----- - prototype - "Later we will be a subclass of Model, and it will have a general version of this" - ^ Prototype ifNil: [Prototype := self newPrototype]! Item was removed: - ----- Method: PaintBoxMorph class>>rectIcon (in category 'resources') ----- - rectIcon - ^self imageLibrary at: #rectIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABUAAAAUCAMAAABVlYYBAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAG5JREFUeF6VkNEKgCAMRfV1L7mMRhZ9tJ+7p+ZyZCCIRxhyuNyH65gL99mQTqeSlwMwoLLG4KslpL08PWgWIn9Eswg9G8bZbZCNE9lub7+hm80IKdk4F5j1gq0j32pJVtFtdB4Sm1+aYq5Z/jNjH9oIHun4V1LxAAAAAElFTkSuQmCC' readStream)) offset: -6@ -17; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>rectIconImage (in category 'resources') ----- - rectIconImage - ^self imageLibrary at: #rectIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABUAAAAUCAMAAABVlYYBAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAG5JREFUeF6VkNEKgCAMRfV1L7mMRhZ9tJ+7p+ZyZCCIRxhyuNyH65gL99mQTqeSlwMwoLLG4KslpL08PWgWIn9Eswg9G8bZbZCNE9lub7+hm80IKdk4F5j1gq0j32pJVtFtdB4Sm1+aYq5Z/jNjH9oIHun4V1LxAAAAAElFTkSuQmCC' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>rotationTabImage (in category 'resources') ----- - rotationTabImage - ^self imageLibrary at: #rotationTabImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABcAAAAXCAYAAADgKtSgAAAABHNCSVQFBQUBSsjp7wAAAwZJREFUeF6VlS2UpDAQhCORSCQSiUQikUgkEolEIpFIJBKJRCKRSOTIkchxfVX5Ydnd2b27vNdvZjbJ19WVTlb9Np7rKkfbypplskSRTEEgUxjKlCSy1JXs8yzqf8e577IXuWxhIFtgYkUsiJkJECOiD3wZkOifkzynSXao3AHWEZhwCVySjwSBtEgyNc3vCR59r4HH17gl2L5UMCA635cG0Zel/KiYoIeOUAdBNTZFnicRqonjWEL8TvGbwNmpx/cWUTFBXcs3j4840uAnAGdRyJSmElERyt0xf56njsfjITM8TuA1kwwEBgZOIYXvyTyOHwmOPDdgqD2rUuau00q3bZPX6/VjMHGklIZ3Fl4iclRDEercVu2zhkewAxsytN5xHBeECwkqUFEJX0coc3P8nVubGgvPWBEEqkfbXF4TPqCKu+IVvR5Z70co7K3nFECbns+neFDfXMo9Da/BUTtVXnC0FZTcS8/g/dbUOvFh25P9T7U1Dk+vAYNeOzjnctiqNrvJeI6TRzkOzApaHPSZJXrewdeQrejrzuG6FreY1dQAO+UJ5tRqN7gEXOjgPfqeXt7Bs+2MKTAtSmu4LsH3CuDCwmOEWqB8u12YlK2IDYQPwyAlFl122K7w8Deq9vHJdVVVaWBp4awipvIlTXSZLgEXsY+5iYcVoT0HQDm/Br5WzgPmQbuDZ7LUwnP7PcU+teF1W+xmBkG8IM4aqo89dYFpR3IT4OzjfQnQNdpvRIFGUAcWcQMTrCGTmD5lX7tOaHnrLJjtSG/Z37SPyXnhCI6tan527iGbklhvnG2SWatTkiI7VTsoq+JtbACn37QstGpph1MdYX6HZeb6L7PeOFp1Luhhh3BgHqa5iQZW3Hy+wHfVbiy4qb2F3KPXt9IkoT2Nb/pZW2MTOHDsvH43RvhIQ HcDvoXalss/gWEP2lg/WD+NCVe6trDmBv0E9r6Diyz9HezGilevxmGVFuaU3tWmFhr7bzz+6/9SqJjwzrR43Uq0WhaY1zDh9WZiKCX06oo34w9N0ZSkQD6ZeQAAAABJRU5ErkJggg==' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>scaleTabImage (in category 'resources') ----- - scaleTabImage - ^self imageLibrary at: #scaleTabImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABcAAAAXCAYAAADgKtSgAAAABHNCSVQFBQUBSsjp7wAAAr9JREFUeF6VlSGUo0AQRJHISCQSiUQikUgkEolEIpHISCQSGYlEIpFIJBLXVzVpcvOyZHPHe7UDZPOrp6e74/x27eMoS13LnCQyBoEMnie970sfRfIoC5mHQZz/vfZ5liVLZfa9p7ynRsgYQB3Ueje5w+ifTba+lzUMZAV0Ua0ALdCkBg81MQa3m9RQX1W/G2xta6AbtJvVN/cr1kWjtw3MDgCmQeW60mbZtcHOiC3wAeCuosl6ATcpUngNeOE40haF/MgxU2HAgS9HFMoRhsbgNDFpuooe4DvUAF4CnkLD/f7XYE1TBSPiOJKjLKEC97Hk+GKGSslgFgMW4ZkKKQADyAcwhypdE3y2rqs4+zSaQyP8YNSokqPrnsIWE0Bn7gz/vCyLubfFdymCSy14zPQ0jThrXb1y/YLjg6Op5UgTqfJc9n2X4zg+qkAQNjzhit5wFvxZ9RBNWpjvJJYd4n2DJvoGzxHAOzzGOTkTol2sKqEBD/VUi/r9Bs9Qgu9wnoczno1iGTzQeT1XHGSOfA7oQKpHuW7b9gPOnBPIask05wHkjIhutgwoVgLz2KKpGuS/Rmr4HOJw+fwJXig8esFRepPOkLPdWXJX26dZhTRdwWNNSarwEAxnQj0zDTQ4FeGDq+2fu7jKeaRRJxp1ih5xFuYScBqMPoT1N3iML9GgRKMxVVw9NpcVNZuqxnvToT1KjgaDmoTQFZxpCTXCVBUrMNH7UOHzND3hy2OQO4Adq8R7tjY7kiVoi5ET2DAyrY7cMjnBzfv4feBFe3MxhDArXOQNZcjqsMXtn/VcfACn+PG4HLtdnmHwu9Lc4O5a0kgrK9rsAhwjIDOwPl0dDqlQyLsKC5pY9expdawYYl9/6h6Yx2bUKswGngd4RuujzetvP3HvF6PocIAlBluKIRRxdjNSr CxVRkrodFbFxfUHM1HXoyHv+TYAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>shapeTabImage (in category 'resources') ----- - shapeTabImage - ^self imageLibrary at: #shapeTabImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAACUAAAAXCAYAAACMLIalAAAABHNCSVQFBQUBSsjp7wAAAmFJREFUeF7FlCGQpDAQRZHIkStPjkSuHHlyJRKJRCKRSCQSiYyMRCKRSGQkclxf/w4ZAlu3M2zVsqn6RRFI5/XvTgKtChqHlqaxJTMpuhstmkZFfVdT2xbU1Dm1TUFBEFJWdw/lTS8q2sETz9Wa0rJ9zGHd0DeicWi+3MuYiQ5DORCBcVpg3HucFhS9/2W4jt+7X4JalDNAkld0eXujK0NllRLXToVa1QlAnOYCdItThqulhJg/Hwq9xQLQNXpnh24Us1sWqvkFKAHSlBWlfAMQYJIFKmOn8uqM8i3OWClKMjt/+0gozsrVpaI5safclcAOAOjPNeKy3SxQVgmUAMElBjrl9Nk7SlNZN7Zkke0hAcosUFoq+QfXRHnGPZWwAzhdm5ItDiWFPXFwCD0HoFKNPw8V88bR7UPuIQeDpwVa+mi5t0p1EhR6KeWN4QhArJrHneRueOdSdTaU9I8HZBt7KdujdBg/DHUJLxuFYfhUWKdV9TrUMGgvC/vzjJ9nLU8swLyfqS/Vllaq5I1X4d19QwwIsffx8Y64+A/JG2MomGezs3ZdhCwcGLID3F5u7VcyO6Bt0i11eq3IPM+25NPUi33/c8tlBCHIUfkws9kmiz3hLNpjmlwP8gAdoByYH+juBfHhjsgH8uMMXJlOVw+XpHT+MGbcgPmO+Rl+R3sY5xCA0EufXPLHNA1S3xVscW1Un5w7CuVgbB/WrwH5jmEBtHVude+o3IHoBaaW60FOJZvwFMjvMSzAYr0AOshXTtteXWed2cIMhJMfHB33+8zWG852tIFGqP+GLATizOY5yD+ABou9MdPjbQAAAABJRU5ErkJggg==' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>shapesImage (in category 'resources') ----- - shapesImage - ^self imageLibrary at: #shapesImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAD8AAAB4CAYAAABFAioLAAAABHNCSVQFBQUBSsjp7wAAC+RJREFUeF7lXC108zoMHSwcLCwsHCwcLCwsLAwMDAwMDAwMDAw0LBwsLCwMLPxYniVbtvyTNPveO2fO3s7R2dZ1ba8k29L1td9EX473Wzc+7t04PPrxzyDQHvd+/Lo2Y9eVY9sUY9eW49vbZsxqEbW8uUatAGu/HCvJOrCbYxVYD3Y3VpMJsIexhuyqDD7f7atFu9/aWUzDIJ8vUgRvHHCLOOD/AN7Lglj0fx34uUzwHfALwau/nfNqPJ5z8zzHAb8PvH38UtTjfr8fN5sN/n/ZXvFx1wFrB+9ZIUES8DcJ/JzXY1738jWEcgBkwG8Dj483ALxiwKsxq7oxBzMOUNFfPXj7+zUAfsrKMStbZb8NfMGijcBzF/ilbKQzGgleWtVq8L8k7SnaEM28rPB1DfCiwXGvwLeY9kWtxny1XvBXBhr+JsaqaSeA1xh9G3U/5dcEvrEpboF3FvilQMBnbSbqdWdmejfqqwJPoKXVIXAEnXvAWbpTkbPO8tb87qU6B55b4GqGFzhMbHW30tqegGd5OQv84ixtvKpLuKvL0a6TDgD7PGfB5EbgFfAmAF5Gu7oIePHTkZ8FLxDox+EogVcYYb6kXSLFjCU21tDPvwCf4/N6BIngy0bbd4DPRX74SfBiMXg0DZoDL3j39h3wPx95MTvmXQdoJ8iffeAxHq9elPZD+uCV9dqEAq6rQIe4iE126YJfClwY4C74K4t+mAHJgp9d6hhoTHltPPrWCdYRZWT8TxY5IrkxL9RaLttVWN5gbV9i8HxYFskRIX11T3yd18643W5jlmXjbrcb39/fZ2273RreDt4nn6v0kgRfX3V6qxQ/n8/jRgLby+LG2qe2Y2BQBG027+p92Pof4+8SW+evbGwLXM4gmtvtDkvYU+6nfqVS3LN3+Xx4H+rpsbt71c+nM eY5+A5TGMCEwEt8TAGm5kb9vtXg4Wfs8jShoXr6OfA/OtsLJ+Ud8P6ER6CptmdNzna3Z+BrTWpY8NUkmZEAeFrSLlPg9WxuGhpt1OxMgYeJT7E5qaY9i/wlSPvKAtftK01oOdX8EuiOwGsub33gqwh4neqKremc8lbNFcoBu/2HnfAMl/cbwGPUGU3lcHzKARZ8MwH+liCB+bfg2xnwZfNLxjxPexrrVMtT41P1/yLth7Qij6VrdMJrncmOT3ou+IUTXopLnarbt+PhdEH7BJNEJogOjpK9jTU277Iq/LulLrEiB9laZjgMZpob/twAfJt02odc3eF4Vk3LxyfaTn9HizY36nFocKYqvDS3q4Lavsexfcaevo709PHGxhgrhlbQ2Fyjqe84QM/6JwdoHVi4S+u3tPcUeXvh9vQV4+mxeWnMTixvahwrm4gi4zpPZvz8dlWczbEOoM2KuCnAbUSH421WilTJjAnG1uHqZyyv3Jo/LkFLjMaa36hc7gCo8MwmBunvVrFF/YK6BnBnuUWd5YUhNGHdB44PqjoofHjVF035VbC3TsQFzupFUZgCBqq4rXQAUlabDXt8p2RosTGffNrXkR2aojJ0tNqiLh0ZCtinjDpxd0aHF9HfzVPXKezVsbUe9HUIXNrRUWLE1/iPz5Mpg6cckC6ByVId1uuqri1wDTpgbQvXyAGQCabCM+XtnA5vSKefzwolLtxjnV6bttYAN0VNa8UKWq1BJCZOgqTMishP6yTByyXr4+OAz6c+3vTznvjIMe2Ew/GiHCcboJC7/wpTP4V+3rA4EkRAZGQs4g6ZIdgEqatBGX0Y95j6viAxlvo/vc5nLOpHOVnBh4cWdprFYQRma5WZygEtAx/ZtpogMdMAf9HgZfFCUVfgVdQVf8fECEyFnbOtLg7enfgSi7zbx2vyUlJYNuUVeK6141KU0qix1b4+zvi7ndPeJgk+j4Cn3VbF1dnIR8G3HvhMVYMHueytAn zmgacZG5YtP+3hObknRCLg4ByIuFopSi/tRRy8SCXtNXOrZvytWevNMlfGeHsLvO16Uwpb+joy4QXghwQmPN26AnhIeWpc9nLdp7o+xtvDY4U+dQGNjzl0ENm4oHU+3e0qzdxwB4DkBLIAGpmLITalQy6Z6ewg5Ym5fTXT16ltV8XYWxjztBPDOfwNa2fBQVDXW37Pj/pcyifE3uZT7K2MMgDcySEAqwFMhpgJcicnYG/5iQufxEySva2nyMvWkZ5M8/UucLMstqugrl/JzFtLX/t8PR/jEycu6qR1eAuk5vagQWPbWtbeZpNHTW4rJDB9Bzj8vd2ouESOjxarZ2+nos8d4G9acPKyXcXpqrjeHoDVTTuezhcsdGDJmzKc/WUbnAdbVV+pC49FlLPHWfx8Dvbq58wlL69R8jL9tJePQ4EDGtyPw2kxewvR94XH1ZzwOLljJnqcnzSrs9eCA7tPH25Tw2NUBhthwpL9+R/n8CJRB/DE6uz1hoUrTqidcvbMmdtLHiUvE5aleDM8UlqFBv8ZPVFBsz2t/yBloS4wGv1YbS9Sm+3nwHtkJqeu4XGe+q40ZYLISPGYSRx8RIzIjptBmlMHeMRz9VOa+0dKHN6StJ+isAVTYXbY5dlNCy/1mf42zSPk9VLwvSdAFprVaWZS3477laW93bmxXJ4XeUj9kqd+PqPHS1GW4oF/xxNW/oTntq7+oQOb+gd0FicxAx4vucsDGHiQoUAkgc4GMxpcGdWTr8GF36XB3yj17WEjf9wneZY2TPvvaHB9He5ROgpTHzYuvP26RNb5eIUHEfsgXe1HxKY0uOw5tHkxCT658/MBiVkvOF/H6n3dA5zZZkdspzbdU9QOiUnc3Yz+tpjQ4U4KFBJvafnJi5gGN6a9de7TWHwz2rBGGivU3rpSVFeRachMkRT4F9dGOPX7hPw0uE5ChBcJxLj79C8M4UtgN5Zlib27H2lHdxvcoXFPj8yYuh6qiNyNhVG tGsPrQR0QUNZN/OaUlW1axKOe5bnZuSXFlXs9lAiufF01b2+WPSZOJOkKbVS+ckCd/LURsRtSaK2HI+L63BwUMCRdIbU11vCBA66vL/1NSXur+PoahceXHECesDujWp1KVuz4tDNgGKhNi4OksI8oPUWpei0mLw1JTnuLXL380H3fj03TOE0KaHQAIHRsR+zcCiQswQG8+eE/O5sXXaoEJpealx2CJLk5yFAo0q+MNi7AoA2eJjDv6clSqJyFEpbUWBv5HRxwJNNA/SYHe/zjkUnYlIDp5anKFAVJ4ACio+AszecpU04g4KyxQU2+XvtBtkLPwWufoaNbcKQ0jYPEupFBMRJc/6IdsNUHiSwwu2MDB49QfyfTnmeGAt+mCz6UnQvbx0uAtAuz2x8YeKa9l7bXDiIai+itgMToUjxp0cQOEqvof2rwGFUNXnF4hYk8sDeot5Vr/4lF3ZIYic72zukq5yytij6s8wgMLhGQjjieTkhqKk3+wSx5RqnJhsWilE+qpWXlLICnAscUNPpnugSManwzyzspH9+kTLu2ZyJkzsQCaJ7+6iY09+94IbCmq6dSPu2DxOwY6dtG8e+Y8pqT51UeOcGAN+N9+l6sxG8/dVOflj27OTF/GyKRlqHG/r6S654nNLizrO2U4Li7rekg8bQENSAuffvuQeL0yQz//HwfXBLkE5jJnZ9/lxPXEiM9/b+3d7Ql7wmfT/T1cvC3m2DeUk9+wpOfAr/DP8Dj3KMxo7+DwRuAXUWNBh9I9LLH75jJ3wWzfuLv8P/0eu77dypoOnDKejTA4OOA3+H/4bUhmMMgl8bnc/BSxf4TeIscAC9Obxha3Al/b422NuJ097058MED7gaxk460mfx8PmWmyK/H44t5Now+eQ7MvlkK5kaag34ObvAAG2QSDN/H466Awxd4gacWjRV6gT9D6ISfN/l5HsIBGzNMd5kxMHwo6pjy/GsY7t7Y6qKeTM6e1nzQFHEADmM9 iDr/ejxuOC745IJZcO+DTPhpm4u0naSbZcB5BtAsHc6yXUJp3xugfELG1QZBN7jKAHAI6kvgfA6Af8AlSjuCnPHfzOb/rZmlVS+vLujbCCva23e//vx5ylQapIfv6oXuYF8JmwILn/c5vAb8D4urlEau+p8NAAAAAElFTkSuQmCC' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>shapesOnImage (in category 'resources') ----- - shapesOnImage - ^self imageLibrary at: #shapesOnImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAD8AAAB4CAYAAABFAioLAAAABHNCSVQFBQUBSsjp7wAACUFJREFUeF7VXSuT4zAMXnjwft7BwMJCw8LCwsDAwEDDwIWFgYWBhctylhMl8kOO3d3ZqJ3RpO32pbf0WfZ+6O4yDfd2egztND666WvUlh5DN3329dS2l6mp1dQ2l+nj4890uukonevekF6oD+jSfK7XFN26Yb3695Fq/VivlvqZ4PfdPxtLw71J8jSO5vX6x5nvHQEoTwB7THNCSApABvNpxnOFsMe4LwTRmkfKNfm3NHvXAnpHAKU+v2f6As1er6QSpl+qdfuZTfMOzIdaP39T85frZTpVlfRo76Y79YLZU8aV0TYy7pu/0GjvRv3vCIBj3In08nw+NH2VkeZ8xqsdxt8m1b2icficXcalFzm5Jt92ndU2NfW9Kk9gntdBmtsTQPf5aRlHU08VOoJr+7gAfMZp7ucY3ytx38bsuUKHMo7WQRl/+64OmfJjQKd1MePiov3ZUry251rapukCxku7u1Xz+mjN39wKLxXs1LVZozq8NubnRZ1dL4D5WfM6WuC4gc8I53xlNZ4b8Fy/H49kXrOlLdX6K1BWjskfrPl4L+8IxL62m05XoNbePxtSYAnNIpT2Pl2BOqDBksM4mPtCLvMHaT4FXOZqPNbPc34ukPl4M7PHeEmQWwUgi3m+jz9n4ncl/h4wf2SqS2leMW7wigBYsz+W+Xh+d543uZ1e1+eb7bGtAQC9iRQ7SbM/vMgJtD8L4mG+pG7qSanTSlDc0MeUsJevCGaXp/lDfT4OXQHjllmjcaDLuY7ep8Qxv2l+kO3zqyBMJXeqLkVIDryHY37W/CBJ85qN9qDF0/VUBF6CsDj8Lqr5/ujyltE8ML6neT/XW82rUs0fHu37YLXGat4wnw1eEuSWD3gifV4H0X5P87EKL+XzAgMeD1+hz5cEPPR5ttqL+rzAtTrUfG5FR30+O +DJ07z+ZZ8fZWne1vZq8/nciF/s8zK6Ohrtl1RnGAfTL1qo3FmnE1rk9LzmlwaGNjJ+gxMLeOLNPlXbIzyNaC3X1ADDcLWvVdULZi9ofX7t56FZAaSWNC7Q0FTnNnjepzep8HSin998XRWAGUlAQ5Lmv4PhlWD2aQDzIQPDK5nCKl2s4JGcUc4qbcnwYfEEpjwAUydH0HJ8Phu7l2f2fRK6LoWv0wHvDTSvIoEPihlYnra5/Xpauz6b9pYpy70JLKHQdZ9Yn9dT13YrOGnLXihsljq+Is+nTF9cwNsbQUNNV4jiMi6AZS1ifm9U2/s+P9+v7YrszDgdRGBHTsngwl6uF9jVuR0ezt2kGPd3WaAAwCWijPt+34vq5+cyF+duUqbOFTnY1vpTmNHOTpbm+3XBYmagfIFy1X6kwYHBBcf0ezGpbntsU9kCZKgC9HYLgHPw8zVvmY80N2JgLFxzg/a1tLHB+5j/A+ZbUZqP4HckaOVuL/EtAPN+YPatOLMPBQA//N/5X3ZX55s+wt7vyfxSvp4LGhp/QlORjUUY6QPmJS1RK8/0c3F7qnksjGLj5kG0P76fjwvAlqyqWsZR8gJfP9zZNEdL3FpewNNebU8mq03wy99tceFLWwbKElTbuwJAM7ZWYIWgycYDbX38RISU09aKBzAd8ttX7OfxObWZehrGGt4DwIxVdrB6g7M61gqaJo9psYsWt9SgcTtVl8bSP1Ubupn875F5rgK61NPJvA7eMw8lz8Jb05skJCfM8To6Y69ewO6TPn/0HhsbyBJFDt1J9ROYfXRz0ZFmvwkgvq+m5OiIXEHUEZMXsVa3F/FLOrxszR/n8/3u5mG4Apy1bQm/OOitzevXy3ZlIn/U36X5fFDkGKZxBnddf1fbOjx0fjT/VxnbxsOAN8rw+UAAZI2+BL4q8/lRls+vqzTAkNrK1j1C60j5e2j645F5vk9EfL2OnWfP4e3g9ocHPNfn46Ut+nyKeV8IEB hTLW3AuBaR5zXr8whG5p6QwiG38jYS756LNZs9DCEVjaAySI6YIierwLk2RT6Px8Rwps+VuL/u8zGzV0Hg00mz51wgZfq15PV55QGZewEvNpKSbfq9oIDHwVh7GJ4vAMT/qOnzLe0oI9XFNI81PB7yxW0sxBlcvHKmX8sCM1JHQumtrk/M39IZXNx8yNX6tXQA09l44M3g4oZCbmMhN4fLgxmHm72OztwVHw+1N5AkS/P8GXilAEbR2ZdSNxuU7J3PPfrRZ/omp6uLl7c/ed4tu2ojZSxFvTh1/fKBv0cjOTnn4MWugOv5y9dFx0JJ31HJaf1mCHA9Om72EmYvrbzlBEA7PQQ06abDnMAnDLreP/b17J2MdlvK1hnhuSTPyMpHckYZc3gq0txQ5nEImUJWgNfnbDgQ09hwB4WcaUkLmP21m0vZZaS08tpbnLZGhHctaxsXvmZNXtxmA/Pj749hjug4lUHn7EkQVGTbqT+44G8udOBrCctVNOBR3G4eQAjPvdsbRQNLoXM8woucnj0xhW4gyK3xr7drcuQ8Xt4+ZBQ53CyOb+4xwtyfwuzFmD0HaHDj56nZexxDS87fsaefHrpQmV6bPzdNEOW5w4HepsjJQXIUGUW1k1f0LEw6voI5P3UomKQiJ9xkEC9wEL6m+X/F7pbDQCnE/RYzOTkgptXuUuBgOYs1PQ4oILS9N4EpWPM8nFWRSUs6fooDCXRqA+duk1vLJBz3nOrqQubnszNSe+q4DQbiZnK+08/nbDLKNnlpZ2OpX8DxasnbTF7F74phrN9i/u+fvw6V4Hff/bdNPvP+b4Hfp7tbPvP3uybSml/8hBc/tb3CG+B5KtEY4d+B4AuAen2zBD9Id9epawmZx5pQx/wd3o+f535/OyttUdxMnSXgwecDHsP74bNBmeNoUuPzOXqmsr0JpIUCgA/HLwwpLoTXqV6oiQjd/W7K+Ogx7iqxNYLcLPn5fBpLMbfH45NINtQ+Sg5 o+zIJ5GqaMv0cXeUBb2BJ4L4PA7J84A2kQE0LfQU/4GsMhXA8md/z0A6zMbLmbiwG3Ae1bk2e3sZx8HyrjUpSHD038plGjQPj4OuB1unt8bhbv6DBxVrB0AWWcDSlNL0F6TqPcWoBGKXDKNsKMvtuZZQGZJttLNO1zTLAOCh1l3EaA+ANNkUtgkBh/Ew0/1laU+uSXl2m7xNktI/S29fX05jSaCQ8zB80AH0KpplZ+L3PcZ/h/8QoMMmzBDbEAAAAAElFTkSuQmCC' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>stampTabImage (in category 'resources') ----- - stampTabImage - ^self imageLibrary at: #stampTabImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAADMAAAAWCAYAAABtwKSvAAAABHNCSVQFBQUBSsjp7wAAA6tJREFUeF69ViuwqzAURFYikUgkEhkZiUQiI5FIJLISWYlEIisrkUhkJLLuvLNJU0J75777PoWZnbTAJmd3T9IG49DQPPW0zD3pZaC7Hg2WeaDbtaO+b+jS1dRfGgqCExVVYVEXVNblDrjnYO41JSmgVTtU54rBn8/q7ZkPrDfdLgbzdPm2Rq0X+jsxLwVjbHjszznVSvA7uX3uCUHxVoQF7p353tAVdK4llRXm2zh45/Ni6pdUHmJ0J+k+KhqrjPIspryUT0G+CIe2LWk9C8OZGkkqi54c1ZZHi9mSQVpKRNTIxIxpdKJMpJSr/CFGvQuCCWlItYwNRHyiJLGCnAGHiFEQ4vYOI+e2UqUgyQXFYUDhKWAxGUlXGLdNDUHP/VAaM5TieTgRcCLmxHFEspDGJBjwcTEVF7HUKS2t4PYQNHCLFEVGV/5cipjiBIh2yXRtQbrJDOfWSurRViz+xmPDqaRpYjgpc+SRyZScQhOHNGQhTVVKMxeJtkKbpFxQnMaUZAmJQtj2w2bmsY0CusqIZjbiUqbMCUgmoUkFYt44h7QZ2ordy+OYFBdScVECe4TFZCwm4cIyuTnsTrOSUyq4jSrmlMzJnpzQiDFJeqkck0xt9wiKFZL3RRRSwf2ehyiQwakJrzD12Pz4vSlYkMSzkE3h94vIcThZTmY7MFhMd4SYxm5el5DIM8rY2fwhSqJt0HZpZIrffiQhSBme5HYSHudphDnNxHFtZsQ4GFGPlCAKG5j3TM7pSEbORTun60tNNc+Dz7iHFHBygSeRCgsBB8nZ0+wAMXDX/8vhhJmkXIEsAu4/24ZbpmF+01tAmPsXYLm5SRmm+JyPiwlP4Q6n0+kPERqEPwDWG4fzz8VM0+ipty+veHkdzQgC7vsO+Rj61mJoeeEN+P585j2/jmdTALCfr 7emPoy1GAxQ02td+A4+5obZWmsK1lW/RLmRoN4JwuRuQR+O+z26By5fmLKfzxeiX4TsTe7ZmK1z1nXlJPlalpvn1Hs6zglgW+wT2Cfhi1j13lzUiqTR/ssyWyG4oMqP3vWmm+Cu30X9f/D8y7gr/iuY9uJE0a4uFdNi/qX1/NLL/ZfOfBzrhlcRLhEIwV55S8W/lmUyfehvTpPSPLwl9b/xXRLbIdT9TIifEAhfnzr9B9tseBbuHzhY+2ZEdOaYhhCY/lsh/h4CAeTxIcyJ+9np9W9wJl6vNom9iIlwAgd/et3vK0et2bHZTjQDtwNhi8f6q/69gF+MUOdTGgYgKwAAAABJRU5ErkJggg==' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>stampsImage (in category 'resources') ----- - stampsImage - ^self imageLibrary at: #stampsImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAGgAAABOCAYAAADM6VOKAAAABHNCSVQFBQUBSsjp7wAADypJREFUeF7lXSuUqz4Tr6xEVlZWIpGRSGQkMhIZiaxEIiuRlZUrV1ZWVlZW1uWbyQOSEB7d+y/7nWXPmbP3tiGTmd+8EpLs5nIuxe3aiPutEY/7WbweF0n321l8f9WiaUpxqrloTqXYbLYi2kZv01bS9scUbX/Gd3pc2/+IlIxzeKIOL+dKXL9PoPfTqN4fj7t4GyBaZEDUJd5R7pH8XLfL4NmMjRNFMjzafnKRl7lgkphgR5eKqmiJVf3vgwT9YJ+SsH9vrMNkjdXXhT1ehzr9oA4RnP8coFMLUBic4MDK4YEGnyvHgRgDpkBg5oLzExoCdIBMm+73hwFqQgD1BuQqug/SCEAGGF8xFZPKV1SMkP2cNQYH9HwE4KG+XOpkm/C4QDTJFwVoCBwfIKACBLvXVLzOQKdMfBWxONJY5Bgq7HDmec44IC5h+8upEK8mA6LifiSiyQ+Cs9RSmAbrjf59L+LwWStL3clC80Do64X9fKEQx2d4jwXS1Qj0zcXrUojHMZXKY/EWQKKdUAaktwFioobfr5qI1xf8/gI+Jyq+eSKO6U4wSnRu04rSPKa90gMJnrtJWXItCxgeyHICWXKUBUBK89QCakGAWg+akUP80HLnsVQYgvNqALAyFRVFoXYi3m2l9aFgCJJt5UGF1R5pgC5lJp5VCspjkh4VFWeWCE72ItltRJomImt50DbcvQMQx0hQWrKccvFdEikLjSMpS4ayUAQp9UDKfwcgOgaQ/pyTSNTZXlxAYRdOwOJiUYDi0kMkDtFGJEksCFi5EWjUwnvgKAWWoJAq3UvP/CqIOBfgPRkqbieS/VbstgBSRjRIdNwIBgAqIMSVE7IQArIAHwXSEgCd5njQcJEglQFKkVYMQqDCkDKwOLKPxB6EiuODSMDCbS96J8TJtkAx8CAABvZt+ CBPtGwESPLQipvNw6viKEVZtq4sByXLzpJFGpyWZ3GA8sCcpw+WVeWgQshBChZbdACKNqBUEEgpj3jKm1+5ybBV5KCoTcdjv23BiYBibd3SsmWYG+LBOmDs6s3II8NmX5YtyJKQpOVj8pHKfX2AkD7qQSUMmqOgCMpAuYkDxIFijqghVmMYiLYWaaGCAB1V1VQBlZXKAf35ifJW5MXgWcxvaN073bcBZxdtHYAkoJYRVBAyj8jDgKPzpx8N8NnLMRNVpmXZdLIogOI+QL8R4nDwT0iYj2MiblDSXqGa+cLqDIA48gysOVOJEgZ5O6nyGqud+LAXMeScA/zeYYjbQ6GQDIU4Jr5qBnwS4EPEDYqAKyjnAgVAXaKBKONAxZ1g7vMAPtguBc/BvIaE/SOfQ2KFnkAYVbIQWZXdKiifgU9zpOIIPAquVhAwEhhZ0Nji2JJlp2Rx+PghrlwAIBO6GgDhxg7iAcp7gmDPiqjfABj++wVUQNLOwJJQmDMkbk52sprag0BIBxCwFcgJPXlbNV0h2WMV+ND9Kj6KJ/K4wncpWCzPYtFA4sakLRM25ALZv+bReo8uEvwq7lb4siSdLPAZg7BGUZZcyVIkKAtpZZHyWHzsIsHOy4sAJMMDMC9gQBW4eXPYiq9sJ64A2I0ra8c5iInPqUyiW1kQYJWzDyguNdWVnX8QJPi8hD5qKADOUEFd6R6UGUO5m8iymspSfSMrtbYg0JWhBGmUh5V3jCyxKwsC9lW4siStLIljaMgnyRIPnF8CyCR/CkKnsKLLIP4eQVE1JOlLshFUJ+hkrwRCIiAEhgMFkFGcXVnRdiXBKXExx4AyKPDgoJhqh0YBvECZicdD/pvErtKGqjerXJeFAEya+7Jsg7KkOrS1siSxE9oyL7SZnLYsQJhnECAQHgecRpHIQDgKCZOBgDmWvT5Ih52y7pBlB+YmLUDIEyeBEOdTzSOPFJ9Ue5BNOB6pNC+0OTwAHG4DpIuNjF iyRO/IEvCedsLOlgLIWvi0qjS0HCyXMxgwCpZrBaJgFBW408rbKUpBKGJyz8TkUZXReWcQEPszUCB6lOSh+SBQscWHQDhKR3hwkAtJeVFnCFImfOYNWVQeTfqltQMQ+3yZba8QUN69HzEgyYEi7ZQCW0sHSiNLOC1gRrtyVIaf0qxgu0s5cqKoQZK80PNQgRCSkIexdOrwiNQEGRSISzB+9cZrA1LAi5gxOuAzVxZZHISrNwPS5z2ot5TTeZIKd0RaEgKF7p/tdo5wSERPIlGBcvYPcZwOhCAHpNaTqF7zUl6bQg6Q4cjyqCzqWzoqsO9FYyBlrTzEk4UNyJKCLJlei+utoi8OkDeJ80MegiRjMwhHIXdIS7eE61kgtB0KQ74C0TAyy5sMUHm07Vl63HqTCntyZSPIg7fLOy0P1vGQ0YH0ZaEDsoRy0WIAmaTXAyoU9tCjiErYMixBcs1BYQwXMLebLpajJzE/DIHiThZpJfYs3VIizosohDVUJNspwJJIFRIxKhQsfIxHMehNHQ8jCx2SJdkH89EiAA2+ku4B1SlPhQotnBFQK5JhZQa/zbuhbhmmU14J/A31gOJ5kBfR+ZACH4ZhEPhkaeytxfk8LEOoi26hlA8D5ctCtCyhig51+P1dfw6gufsFnFfDJkf5Csx0fNfJtSsWLICM4hqPNFBFIPQ5OVHzU6SWnmjACBAYu/8hj80HDM8s+JpqjlAy6EEfBojNAqi/Eux6laPAXCmu9z6o1gAZxcFYj+ejJB+orlwuXJ69nTjUWU7q8QgYwVjfSg4DVtoaQgeO9aZ4MYCGwKi6EpmFNl+UbHSbk/s6um/ZBpwWpLOvUGP1/rucwAYSP4SGALJBsry1rSgDBZKzhazwXrN/pIpr3gAouGOGhXfJlGOK05YdUt65dIE5h5TahSfuKdXeIcSN94x4UOkXKHX/Tas/5Qjuk9OyLQPQkHLLn+85C4FrV1fBPDTD6n2l2q/OexViiOw yvx7eTBLaXpb3JqoL7EkI7TnIp159zyRn31rFensQWmXX7twlREVAobM2ofggVDM2Mto5lg9t7PxUmR0AKNZvDT9JS/FBZS/Bx4D1eYC4Ulxzfn6MYj0LX4IPKm4JPqaq+zMA4TxiEcUtxMfMixbZF7eEQIb+Ch/zWn+RvdlLCIRvKpfgY97sfpyPfmf0ZwDa4W6fP8THGMKfASiCl2R/iQ9uLlk/QOsHaEGAouhP8dnrDZvrB2j9AK0foPUDtH6A1g/Q+gFaP0DrB2j9AK0foPUDtH6A1g/Q+gFaP0DrB2j9a3HrXyxdP0Drfx+0JECfJvNG9a/wWe6NqndmxjBHC7GPpM+i2CVzKtuc+exRYvEyz0302Ws3xCcN8zlM9Tchn+G13J4Ee3e/dQzjx9aVxt2RlPZ0gD4xQC3K3OMrXR9gJGka6DdRFOSreemTFQ4fc0wmS3rjMsdN3pXRyLTIrp7w2Z/UUWJQwRapUwBpewrAJ2cTunfPqToUpk/VsUpk1UMkRQMKJZIUD9UGP8fvSVG13yfW2BS/4ftTQ2PrTjF0pxnIBNmnHZbZ+muBRGdcFJu1Nytmg9dH+ltk84HTexm0R4WT40Nk9Uvkpxf8v5GASOW1PKlIy7P8Htth+4QdW/AMMIp/+KbI3tVrQ/cRFdn4hbnWDYzL7c3mI4LMuOgvH9tsX3V3lXYnCJhI+VHE/Cb2/CWi4iWS40tQUD56SmqUrhWOlJYX9f1Rtcfn8Pkk5xogDc67G//9fdnB/er+pbIL7s2e3gQ/foZoaiM79zay0yMXO/YtNuwlNvlTEfw7Ll8irRRA0iukRxijYBIg/B7b+c9G+Zcgee5cDcOOUzc7Bu6qqyZObZTuzVmLAjR52q6avjWxdzLBOvbBqlIc8pPYpGdNF7HJAKjsCop+SI8gCAA7QV5RHiQBKpXHEQhx+D22w/byOXwe+9F97rJKpAXzjv/z4OHl3smJ+n3QFgNoDJgxD+E+KAPn chCcbQZKTGqxiUtFyVFsSK2UC8reQtiKIXwd8hoqJUzIKsQZDyL8LL/HdhIcfA6fx37aPmvJJysUqIMATYE159bgpQBikwCxkfDFh73m5HsQFwdqlFmIzQEo5hqoRmzoXeUWWsuSmshT1SavMJEAQPg9tpPtJTBc91PIfiPCO2DLLsyNjcul/0OAJkGq2GSOmQOQERCte5/yTrkHpVzpEQhSWsm5jQ/QoVDfy3bY/tCBvI2hz0RfTqGfG72fYQCg8XD3iyHuR2FuCKB6HCBUHFp4THOxTTRQxpNA+REpwwAxHQ6N50hgCrGLCczyzf1u+rh8MQOgt07x/XIOmvKiovoHkGoboEIq20yMEYRDChO+BPNHBaHrBB7EdQ5K2zJbApSr72U7AGlPMlh2iSW1M3z7sgk/xNVD4PQrzbl/WmDxMjv49xZmgjR11nToSha5SgCWv09B4LSBSqzsJp9WFRczLAAayGNcPZMSmavUMg/xwPHvkZtx/rV+/28//Mo86O2C4V9Aahdrs25Jh1JnkmoAopzL/+PndntnJYEH7qkbHE8x43Dy+LxokbU4f3VgumCYA1IxeVq7d2+O9ChNFjhm0mlWIAxIblva3U/ngDNmMP8GzjIT1YHlm9FJ64zVgzGQeOBPAeTOrSVmHIZf0dFE29E5Wshz3iipQxdN/RpAc9azin8EKvQ3G1xDGJrZj7Rt+RX/FtaqseWeT9766wG0fvp3egug6/ViPaAaP7Hx8yJ/4wP4uX0Rqs1gjEw7ZPiFdKnE5XwU58ZQKYHHwSCde3SU7fGP8uGz2Me3pqu+MWrOOPzxmDF96zGpcfljAzob/orOA9/j8924bJ6NMn7tAIrOklDPvq7x//g89o1O8XjA+uHz+fAQ7R5CRA1I2Lli6AveTJBWzvUUALm2KPRZHTSMsJHMG8fteprscx71xzc0FhuchweO6wwNgN1FrecTVt7x537/ttDve5FBF8mAtX6aS67H2MA8H 64ToP7RIzGq3O83BQ7+IFK2i5q4aDp4WR22dL84TNdPIVJ6ej7GSYY28DwMlcZ7ZHizfx6PmxdHmyDaMvQ9L/3P10/D9AzrzUQk1DeCg7mn5z32z/1+lTHQTnbSm25911w/QNM05jFd8VXPA8f2JFPZ9CsTL+GtP4zNIpOHTKElq0gJTC2rRwQHnWMSHDsn4QOy9NRg2YAZ0NZP86kt69vphg3MVWA1vXn35/V6gks+wApuqqPbVf/+Xj/9mJQOUafPxzQo/wMcEe7O1bJ7FwAAAABJRU5ErkJggg==' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>stampsOnImage (in category 'resources') ----- - stampsOnImage - ^self imageLibrary at: #stampsOnImage ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAGgAAABOCAYAAADM6VOKAAAABHNCSVQFBQUBSsjp7wAADRZJREFUeF7lnSGUozwQxytXrly5srKyEomsRCKRSCSyEolEIisrV1ZWrqysrKzLl3+SSYeQAN27ct9b9r159HYhk5lfZjJJ097qeCjF97kVl+9WXC8Hcb8elVy+D+L0VYu2LUVTF6JtSrFavYn3t3eR5ElH0iK11zHJ9pm9huTt7a37u0pf8ypXr/n1pwI7oIfaGuqPK9yOKQLfQB8EPjweKnE+NdLvzaDfr9eLeBpQku+eBjMFChfocIGE5Jm/c7hZKftUpt57p8DxvfaBsa+LRAl8CDh/HVBjAT0fPT6DgqKcl1pH8evfFK7T/f0YJBfYtIh6MaDWAfTXwTBHvQKID9DoPQMR5do0BEr7ScssgCbBqbIeqBAUN039BFDRFJN+N1WHb8BMif6hCMJ1thQ3BsYH4nqsxF12Sl2bTJwrjxOqbNR55HhcOQS8Phz3SoeSNlc6Doeid6/WkU2ONG4L2iFb7mepr0qsLeE56cWAbAQViXcSHEtrD4OMHEtl1Nd+J/bVvuMUd/LmQFww9FrBafbaYVyPHAinNJUDrHsv5rmfplKvLW0qDtI3sMXNIFxmBTSW0ug1jIKjOkbR6JbVVJ0nHUgckBshPjAkZ9lPOIt0wJGXY6r0QEe5L+29qQHktjmlGkTffba00l7ooUjygfr7gJppgIbmGnQYkQIjFChj0HGfi0Y+V8iyGs6zgIrUGzFjglSGdpWeNu8NAtKjABUPQD74IUgYSFNsCaW62QHZOacartZgGJwEIyBwGr0uikyLcQzamQqFC3RU2c62y/VwHRDYgbUQf96XTn2CdAk9sAft+2wJLWg5IMgsETRWglJ6gGFqJBfMaXLE4Uopjkb3M5FDUkqj+EBAu6Qvk/MQxKY4ANpnwbbGYCFiqG26whbo4BHkRtKsEUQGAgCNGr414 07CmMRpPrAOM87jznAjCE6nSR6vFQyTquy1fVwxD1G6IT2k6wEo7QFC/0KQ+Gs8dzrVHVv4IHCrPjuYyxkApQyQnTClQy5furo516WaC+BQXqrayqd5pBobNUXWq7D4v+EMNfkbubSVKqeVHDQUgLIltgGE9gkoj0jcn5V9QGQL6UCfAQ224Blq43qpta1mYNL82Rmk7r5dOTMgRMkJVZOZKLkDIQqIvH7tNSSaVJGv3bLaTS89xwV0WD2NbhNph9ZXAKTAeYR0QDePxCE9EOo7FSH4N4Eb3Xko/0EEYcSgtPxOInHNYrVgU0JGNtpRvDhA2uHzTQgQOY7SG9Yy0HMp4oeOVkctVWmdiRp6DvtO6uOinFrnHWhoJ2hLq+cc0kOpDf3LnAW3VxCxcwFyKzaa9I+ysjmmsTawiERjDKK/8/XO0GTv+zuciDZa2QacCD3QAWAcDL2um3owgjggPoepASF1uLa0VAgYUaCaaZuxGlA2F6Dwmocc1ErjWmMgVtcuJJofOgDYIpIAuU4tD3pOqdKdchh0HFItVPby6o3mDp8oHXXh1QOp8qprixEeQbYapeKBp7jKByh7fZlNK3BfOU0TJYyrmfOO5rULikPhoGBcyLGARKDIgaSHdLgOVMWCSXddQPlolKmIxHqH2dKazMCFL7R9+3jKbw6g10RQmYZ3pWnkVHoOqYwx3Dg3j1Pa4yOZioQgJKx3DCToIR000jE4KKJ4NHFQtkjwgOG681brqJkObksnrTpbVm6RMBugsW2dTnVmHMRHesvmJvo7VUS0TzYEpgOJR5PRQ+modVKeBSWfoYE2FEH2yiq9UNpzbXEjab4qrkyD0RN6a4Abx0f60TNv4L7UKZEJCr9yQcqrZDVHoNyR7k7wDZtH3dQ3BIrs8NnC06tK89hyapy3H+YE5Jt/QmcE3DnGjkRT+cEw2kPD6EOlGAI0JgqUiaqvqrDVJRxIVSV00V6cG5UhSC4oG1lmqeHaQo ONfKOWJwaQ2oV4FaCsTJ+OnqG3CuBI2nBU85Z0MAGyETIRDgEiSBbWQa+laFNTv2eTdCLIvQ6BCi0NbGSVJlKbnAFK5wI07W3r0C6BnYA9e2gkMMQ71wxFjPM6dA8JDTR3EDwzJ/kg+TZX1bqRLVRnBTQWQUOL0pAzaPJ+Jmrcqyvu76nPvflsAJQvzU19m+J1VVwbBjQlvYXADAHCWYGh1Dbm/BAs3gatg6bCGYPkRpGvisN1VkDPpjeeGoZKaN/IHkppvogZAgjBNg92Enw6JqW7/XOQ0pftxbWedRBJ58RK0tlIpUnxGekUIAS9fggcyl8PiX1u7BBI7RFn/vBvfmY9X9Dp0c7hTvO715XZHkCbaPNymUsPnD2HHoL1ekCFdlx7uL1M0P5OriXm0APHzaEnlhvHsOnXAIrkWwqzOG4mPbAHkGY5FzeHQSS/Rc823opoF81zNnsOgz43n7PoWW/W8+jZrhWkXwPo4/PjV+mhgfBrAL1/vP8qPZ/rz+UDWj6gOQG9v/8qPQrQdvmAlg9o+YCWD2j5gJYPaPmAlg9o+YCWD2j5gJYPaPmAlg9o+YCWD2j5gJa/F7f8zdLlA1r++0HzAnq10Duqv0XPfO+oFok6nYIDEHiPnZRjhCCMn5JNV9AG2uoZuGU66P6RtoLC7id9HZ3xpmPTeqydEftIx3xnEszBPAUp0ZCg/MejK9YHKrjgBIyVXWR1dPXIwRHHnva2/Wuwf0bnTjuP68Xv3H4p+YGNBGeWUz32BGX+iCQFijnTSuIX3G8l7Qva3eU7fTWiItYMiCirxK66im3eSkdGSnTbsVdwH+6P8srev2V91Hq7+qxtPuH9T8J2duyd7VwcP+aqjrf2DfOK+jLaXe87T/nxWH5E1j1Su5P3wcHR/ip29V2kzV3+u1UAlNOsrqR3jcuDuh/P4flttrfwCIzuBzuyzI/y+o70MlGDKR+zfa6Tpb1z2R5D3HPawbPYoc+58g/fZiI u9mJTfIvP4i7e87vY7u8ikc5GZMTkZONgn8TlUd+/18+jHbS3TQsDyMAZ6NPguWzvefWU+WDms9njh+CHv9dz0kF2+e9kX4iP7CRW2V2s0psW+XpT3kVcaUAqClQE0GDIelcAwv14zm3rPf0SUfr49kjdz+ED9ZMO17PvRqBvGZkdkO3AIIxsEETvkwnq27NKsU4bsYoPRo5itZOgdmfp2KuKgAgOzxo5j+gIUoDKzCuRTHG4H8/hedUO2kO7RsfHrhJx/vgcD/XFiu+TE/Xz0GYDNARmKEIKF4rn8zVvO+m0bS1Wm1LLdi9WUa2dKZ37JtPURqardVrLCgkTsU5xoQiKioO6H88pOGgH7aFdq6NWene5hhrqWxDWxK+EmQVQNgooHDXez/O4X6ZUFWKdkPNysVpL2RQGVCtWyUXPJUmtSmikucc8kvWuWwkI9+M59bwCU5h2c6XnPSoeoIcA9fr/PwQ0Cik0z9TToogMw2j+jIuHM9famSoCACmu1FpmDNA61/er5/D8+gH9bSN1bCOz/tLtqG/ymghoON39wxT3ozQXAlT7AcFRGNGbJBVvWwOKIkk6+z0qpwHKTHqkyFFgcvGxieRqX+8ibM1CklKlF9BTn+L7x3PQWBTl1c8haUC5drJZEAPCOpYLvS3mi0qmqkZGUGHmoNiW2V5Aqb5fPSchfUY7uf2yUWJX+kls10M2xdUhOPkjtdXT4cwOqPe50ichheYkMpo+Hc0hYaR/xtLQuJWVV/lYbA5UcZsMBUAr57VCtxFHau7S2zyRA4dVcWOff30yev4JoPQnBcNPINlN2t1jCydJOovUEKCkKNTfcR9/vrOTUDzg2O+SCxUEgx9OHl4XzbIX5+4OjBcMUyDlwfxuV+/mvyPYqYgywuDQItN3pZTXf9YsUMvu3DkI6Idw5lmoBrZvBhetE3cPinqaY8jhna2VkkFSi0UjI/cOrtF8kfNESe1+Z+k/BTRlHyv/Q1C5B1R3 IIRW9gP3Wn1/mNaqoe2e9IXfF+cAWr78uTwF6Hw+sgf0zTfcfDuqKx7A7/kXoXIFQ0L3QeEX5FiJ42EvDi1JqcCjM5BDT/bqfvynfHgWbZyMnM03Rk3ph9sf6tPJ9En3y+0bvjSd9Gs5BP6O5x/94jpbPfhNAGg5KIGfXV/j33gebSMorle5b3i7XR2ij4dAlCChca3QNbwdEeOcc+OBXDPx/a72Dgz/IJnWj+9zM9rmNOn3L9QXDufqwOkGQythP7LW7SZ33PFzuZwY/X4UEV0IwVq+TJVuxHAwt2s3COB/RCSyyuXyreHgB6R4iFJepAburEErl2NH6fLFJ9pPt+uwqNQmIw+pkqJHpTf+c71+O3m09dJWqe927P9++RKWm99vlJHgb8DB3NOLHv5zuZxVDuSTnYqm735oLh/QuAxFzKP4qqfB4ZFElU2/MnEmvOWnsUlC8xAVWqqKVGBqVT0CDoJjFA6fk/CAKj0NLA6MoC1fpost6+1yg4M5C1TTq2d/7vebDMmrHAXfuqHvs7meli8/Fu1D+PR2HYfyH/S9a0J0gNMLAAAAAElFTkSuQmCC' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>starIcon (in category 'resources') ----- - starIcon - ^self imageLibrary at: #starIcon ifAbsentPut: [(Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAUCAMAAACgaw2xAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAKlJREFUeF51kTsSwyAMRNkWU8gQrOEzuV5yHh+XKsIEE2aIqkVPQlpQpaxDTSc3g7MfGHEJIsEtAdiNFnW2EGmpxNFydaQU2QMs00Fu45AaeJWyA/YhMjlRBDTw1kR5LBoA331Y2Dufj5rvBv1NMtdZw7nH1kSCmZ4k4OgVzwkYhCaOr0d1P1NOrGmTCi7zDA1UE+7aaQBISu4wFU2A9u8MQ3rxUX9/8Cc+919bKkV5meQAAAAASUVORK5CYII=' readStream)) offset: -2@ -5; yourself]! Item was removed: - ----- Method: PaintBoxMorph class>>starIconImage (in category 'resources') ----- - starIconImage - ^self imageLibrary at: #starIcon ifAbsentPut: [Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAABgAAAAUCAMAAACgaw2xAAADAFBMVEX///8AAAD///9/f3//AAAA/wAAAP8A/////wAAAAAfHx8/Pz9fX1+enp6+vr7e3t4HBwcPDw8XFxcnJycvLy83NzdHR0dPT09XV1dnZ2dvb293d3eGhoaOjo6Wlpampqaurq62trbGxsbOzs7W1tbm5ubu7u729vYAAAAAMgAAZQAAmAAAywAA/wAAADIAMjIAZTIAmDIAyzIA/zIAAGUAMmUAZWUAmGUAy2UA/2UAAJgAMpgAZZgAmJgAy5gA/5gAAMsAMssAZcsAmMsAy8sA/8sAAP8AMv8AZf8AmP8Ay/8A//8yAAAyMgAyZQAymAAyywAy/wAyADIyMjIyZTIymDIyyzIy/zIyAGUyMmUyZWUymGUyy2Uy/2UyAJgyMpgyZZgymJgyy5gy/5gyAMsyMssyZcsymMsyy8sy/8syAP8yMv8yZf8ymP8yy/8y//9lAABlMgBlZQBlmABlywBl/wBlADJlMjJlZTJlmDJlyzJl/zJlAGVlMmVlZWVlmGVly2Vl/2VlAJhlMphlZZhlmJhly5hl/5hlAMtlMstlZctlmMtly8tl/8tlAP9lMv9lZf9lmP9ly/9l//+YAACYMgCYZQCYmACYywCY/wCYADKYMjKYZTKYmDKYyzKY/zKYAGWYMmWYZWWYmGWYy2WY/2WYAJiYMpiYZZiYmJiYy5iY/5iYAMuYMsuYZcuYmMuYy8uY/8uYAP+YMv+YZf+YmP+Yy/+Y///LAADLMgDLZQDLmADLywDL/wDLADLLMjLLZTLLmDLLyzLL/zLLAGXLMmXLZWXLmGXLy2XL/2XLAJjLMpjLZZjLmJjLy5jL/5jLAMvLMsvLZcvLmMvLy8vL/8vLAP/LMv/LZf/LmP/Ly//L////AAD/MgD/ZQD/mAD/ywD//wD/ADL/MjL/ZTL/mDL/yzL//zL/AGX/MmX/Z WX/mGX/y2X//2X/AJj/Mpj/ZZj/mJj/y5j//5j/AMv/Msv/Zcv/mMv/y8v//8sAAAD/Mv//Zf//mP//y//////eTOgfAAABAHRSTlP///////////8A////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AP//////OE00OwAAAKlJREFUeF51kTsSwyAMRNkWU8gQrOEzuV5yHh+XKsIEE2aIqkVPQlpQpaxDTSc3g7MfGHEJIsEtAdiNFnW2EGmpxNFydaQU2QMs00Fu45AaeJWyA/YhMjlRBDTw1kR5LBoA331Y2Dufj5rvBv1NMtdZw7nH1kSCmZ4k4OgVzwkYhCaOr0d1P1NOrGmTCi7zDA1UE+7aaQBISu4wFU2A9u8MQ3rxUX9/8Cc+919bKkV5meQAAAAASUVORK5CYII=' readStream)]! Item was removed: - ----- Method: PaintBoxMorph class>>useLargeColorPicker (in category 'preferences') ----- - useLargeColorPicker - <preference: 'Use large color picker' - category: 'Morphic' - description: 'If true, then the color picker of the paint box will be large and 32bits deep.' - type: #Boolean> - ^UseLargeColorPicker ifNil: [ false ]! Item was removed: - ----- Method: PaintBoxMorph class>>useLargeColorPicker: (in category 'preferences') ----- - useLargeColorPicker: aBoolean - UseLargeColorPicker = aBoolean - ifFalse: - [ColorChart := nil. - ImageLibrary ifNotNil: [ImageLibrary - removeKey: #colorMemoryImage ifAbsent: []; - removeKey: #colorMemoryThinImage ifAbsent: []]]. - UseLargeColorPicker := aBoolean! Item was removed: - ----- Method: PaintBoxMorph>>action (in category 'actions') ----- - action - ^ action ! Item was removed: - ----- Method: PaintBoxMorph>>actionCursor (in category 'actions') ----- - actionCursor - "Return the cursor to use with this painting action/tool. Offset of the form must be set." - - ^self - cursorFor: action - oldCursor: currentCursor - currentNib: self getNib - color: currentColor - ! Item was removed: - ----- Method: PaintBoxMorph>>addActionsOffImage:onImage: (in category 'initialization') ----- - addActionsOffImage: offImage onImage: onImage - | posSpec actionSpec | - posSpec := #( - (53 53 53 53) "offset X" - (154 178 202 226) "offset Y" - (39 39 39 39) "width" - (23 23 23 23) "height"). - actionSpec := #(undo:with:evt: keep:with:evt: clear:with:evt: toss:with:evt:). - #(undo: keep: clear: toss:) keysAndValuesDo: [:index :name | - | button rect | - (self submorphNamed: name) ifNil: - [rect := ((posSpec at: 1) at: index) @ ((posSpec at: 2) at: index) - extent: ((posSpec at: 3) at: index) @ ((posSpec at: 4) at: index). - (button := ThreePhaseButtonMorph new) - onImage: (onImage copy: rect); - offImage: (offImage copy: rect); - pressedImage: (onImage copy: rect); - bounds: (rect translateBy: self position); - setNamePropertyTo: name; - actionSelector: (actionSpec at: index); - arguments: (Array with: button with: name); - actWhen: #buttonUp; target: self. - self addMorph: button.]].! Item was removed: - ----- Method: PaintBoxMorph>>addBrushesOffImage: (in category 'initialization') ----- - addBrushesOffImage: offImage - | posSpec | - posSpec := #( - (13 37 64 13 37 64) "offset X" - (107 107 107 124 124 124) "offset Y" - (21 24 27 21 24 27) "width" - (18 18 18 25 25 25) "height"). - #(brush1: brush2: brush3: brush4: brush5: brush6: ) keysAndValuesDo: [:index :name | - | button nib rect on off | - (self submorphNamed: name) ifNil: - [nib := Form dotOfSize: (#(1 2 3 6 11 26) at: index). - rect := ((posSpec at: 1) at: index) @ ((posSpec at: 2) at: index) - extent: ((posSpec at: 3) at: index) @ ((posSpec at: 4) at: index). - off := (offImage copy: rect) as8BitColorForm. - "highlight a frame" - on := off deepCopy. - (on getCanvas copyOrigin: 0 at 0 clipRect: (0 at 0 extent: rect extent)) - frameAndFillRectangle: (0 at 0 extent: rect extent) fillColor: Color transparent - borderWidth: 2 borderColor: (Color r: 0.6 g: 0.8 b: 1.0). - (button := ThreePhaseButtonMorph new) - onImage: on; - offImage: off; - pressedImage: on; - bounds: (rect translateBy: self position); - setNamePropertyTo: name; - actionSelector: #brush:action:nib:evt:; - arguments: (Array with: button with: name with: nib); - actWhen: #buttonUp; target: self. - self addMorph: button.]]. - brushes := #(brush1: brush2: brush3: brush4: brush5: brush6: ) collect: [:name | self submorphNamed: name]. - currentBrush := brushes at: 3. - currentBrush state: #on. - - ! Item was removed: - ----- Method: PaintBoxMorph>>addCustomMenuItems:hand: (in category 'other') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - "super addCustomMenuItems: aCustomMenu hand: aHandMorph." - "don't want the ones from ImageMorph" - aCustomMenu add: 'grab stamp from screen' translated action: #grabFromScreen:. - - ! Item was removed: - ----- Method: PaintBoxMorph>>addGraphicLabels (in category 'initialization') ----- - addGraphicLabels - "translate button labels" - - | formTranslator | - formTranslator := NaturalLanguageFormTranslator localeID: (Locale current localeID). - - #('KEEP' 'UNDO' 'CLEAR' 'TOSS') do: [:label | - (formTranslator translate: label, '-off') ifNil: [^ false]. - (formTranslator translate: label, '-pressed') ifNil: [^ false]. - ]. - - #('keep:' 'undo:' 'clear:' 'toss:') with: #('KEEP' 'UNDO' 'CLEAR' 'TOSS') do: [:extName :label | - | button newForm ext pos | - button := submorphs detect: [:m | m externalName = extName] ifNone: [nil]. - button ifNotNil: [ - button removeAllMorphs. - ext := button extent. - pos := button position. - (newForm := formTranslator translate: label, '-off') ifNotNil: [ - button offImage: newForm. - - ]. - (newForm := formTranslator translate: label, '-pressed') ifNotNil: [ - button pressedImage: newForm. - ]. - button extent: ext. - button position: pos. - ]. - ]. - - ^ true. - ! Item was removed: - ----- Method: PaintBoxMorph>>addLabels (in category 'initialization') ----- - addLabels - - Preferences useFormsInPaintBox ifFalse: [ - self addTextualLabels. - ] ifTrue: [ - self addGraphicLabels ifFalse: [self addTextualLabels]. - ]. - ! Item was removed: - ----- Method: PaintBoxMorph>>addShapeButtonsOffImage:onImage: (in category 'initialization') ----- - addShapeButtonsOffImage: offImage onImage: onImage - | shapes posSpec iconSpec | - posSpec := #( - (17 17 17 17 17) "offset X" - (0 22 44 66 88) "offset Y" - (30 30 30 30 30) "width" - (21 21 21 21 21) "height"). - shapes := self submorphNamed: 'shapes'. - iconSpec := #(lineIcon rectIcon ellipseIcon polygonIcon starIcon). - #(line: rect: ellipse: polygon: star:) keysAndValuesDo: [:index :name | - | button rect | - (self submorphNamed: name) ifNil: - [rect := ((posSpec at: 1) at: index) @ ((posSpec at: 2) at: index) - extent: ((posSpec at: 3) at: index) @ ((posSpec at: 4) at: index). - (button := ThreePhaseButtonMorph new) - onImage: (onImage copy: rect); - offImage: (offImage copy: rect); - pressedImage: (onImage copy: rect); - bounds: (rect translateBy: shapes position); - setNamePropertyTo: name; - actionSelector: #tool:action:cursor:evt:; - arguments: (Array with: button with: name with: (self class perform: (iconSpec at: index))); - actWhen: #buttonUp; target: self. - shapes addMorph: button.]].! Item was removed: - ----- Method: PaintBoxMorph>>addStampButtonsOffImage:onImage: (in category 'initialization') ----- - addStampButtonsOffImage: offImage onImage: onImage - | stamps posSpec actionSpec argSpec names | - posSpec := #( - (13 38 63 13 38 63 37 55) "offset X" - (0 0 0 25 25 25 51 51) "offset Y" - (25 25 25 25 25 25 15 15) "width" - (25 25 25 25 25 25 15 15) "height"). - actionSpec := #( - pickup:action:cursor:evt: pickup:action:cursor:evt: pickup:action:cursor:evt: - pickup:action:cursor:evt: pickup:action:cursor:evt: pickup:action:cursor:evt: - scrollStamps:action:evt: scrollStamps:action:evt:). - argSpec := #( - stamp: stamp: stamp: - stamp: stamp: stamp: - prevStamp: nextStamp:). - names := #( - pickup: pickup: pickup: - stamp: stamp: stamp: - prevStamp: nextStamp:). - stamps := self submorphNamed: 'stamps'. - names keysAndValuesDo: [:index :name | - | button rect | - (self submorphNamed: name) ifNil: - [rect := ((posSpec at: 1) at: index) @ ((posSpec at: 2) at: index) - extent: ((posSpec at: 3) at: index) @ ((posSpec at: 4) at: index). - (button := ThreePhaseButtonMorph new) - onImage: (onImage copy: rect); - offImage: (offImage copy: rect); - pressedImage: (onImage copy: rect); - bounds: (rect translateBy: stamps position); - setNamePropertyTo: name; - actionSelector: (actionSpec at: index); - arguments: ((Array with: button with: (argSpec at: index) with: Cursor origin) first: (actionSpec at: index) numArgs - 1); - actWhen: #buttonUp; target: self. - stamps addMorph: button.]].! Item was removed: - ----- Method: PaintBoxMorph>>addStampsAndShapes (in category 'initialization') ----- - addStampsAndShapes - | shapeTab shapes stampTab stamps | - (stampTab := ThreePhaseButtonMorph new) - onImage: self class stampTabImage; - offImage: self class stampTabImage; - pressedImage: self class stampTabImage; - setNamePropertyTo: 'stampTab'; - actionSelector: #toggleStamps; target: self; - position: self position + (9 at image height); - bounds: (stampTab position extent: stampTab onImage extent). - self addMorph: stampTab. - - (shapeTab := ThreePhaseButtonMorph new) - onImage: self class shapeTabImage; - offImage: self class shapeTabImage; - pressedImage: self class shapeTabImage; - setNamePropertyTo: 'shapeTab'; - actionSelector: #toggleShapes; target: self; - position: self position + (image width - shapeTab onImage width-9 at image height); - bounds: (shapeTab position extent: shapeTab onImage extent). - self addMorph: shapeTab. - - self layoutChanged. - - (stamps := self class stampsImage asMorph) - setNamePropertyTo: 'stamps'; - visible: false; - position: self position + (0@(image height - stamps image height)). - self addMorph: stamps. - - (shapes := self class shapesImage asMorph) - setNamePropertyTo: 'shapes'; - visible: false; - position: self position + (image width - shapes image width at image height). - self addMorph: shapes.! Item was removed: - ----- Method: PaintBoxMorph>>addTextualLabels (in category 'initialization') ----- - addTextualLabels - "Translate button labels. Use unscaled font because of #beSupersized." - - #('keep:' 'undo:' 'clear:' 'toss:') with: #('KEEP' 'UNDO' 'CLEAR' 'TOSS') do: [:extName :label | - | button | - button := submorphs detect: [:m | m externalName = extName] ifNone: [nil]. - button ifNotNil: [ - button removeAllMorphs. - button addMorph: (TextMorph new - contentsWrapped: (Text string: label translated - attributes: { - TextAlignment centered. - TextEmphasis bold. - TextFontReference toFont: (StrikeFont familyName: 'Bitmap DejaVu Sans' size: 12) - }); - bounds: (button bounds translateBy: 0 at 3); - lock)]]! Item was removed: - ----- Method: PaintBoxMorph>>addToolsOffImage:onImage: (in category 'initialization') ----- - addToolsOffImage: offImage onImage: onImage - | posSpec actionSpec iconSpec | - posSpec := #( - (13 53 13 53) "offset X" - (13 13 61 61) "offset Y" - (40 40 40 40) "width" - (48 48 44 44) "height"). - actionSpec := #(tool:action:cursor:evt: tool:action:cursor:evt: eyedropper:action:cursor:evt: tool:action:cursor:evt:). - iconSpec := #(paintIcon fillIcon eyedropperIcon eraseIcon). - #(paint: fill: eyedropper: erase:) keysAndValuesDo: [:index :name | - | button rect | - (self submorphNamed: name) ifNil: - [rect := ((posSpec at: 1) at: index) @ ((posSpec at: 2) at: index) - extent: ((posSpec at: 3) at: index) @ ((posSpec at: 4) at: index). - (button := ThreePhaseButtonMorph new) - onImage: (onImage copy: rect); - offImage: (offImage copy: rect); - pressedImage: (onImage copy: rect); - bounds: (rect translateBy: self position); - setNamePropertyTo: name; - actionSelector: (actionSpec at: index); - arguments: (Array with: button with: name with: (self class perform: (iconSpec at: index))); - actWhen: #buttonUp; target: self. - index = 1 - ifTrue: - [action := name. - tool := button. - currentCursor := button arguments at: 3]. - self addMorph: button.]]. - - ! Item was removed: - ----- Method: PaintBoxMorph>>addWeakDependent: (in category 'initialization') ----- - addWeakDependent: anObject - - weakDependents ifNil: [^weakDependents := WeakArray with: anObject]. - weakDependents := weakDependents,{anObject} reject: [ :each | each isNil].! Item was removed: - ----- Method: PaintBoxMorph>>beStatic (in category 'initialization') ----- - beStatic - - colorMemory ifNotNil: [colorMemory beStatic].! Item was removed: - ----- Method: PaintBoxMorph>>beSupersized (in category 'initialization') ----- - beSupersized - | scaleFactor | - scaleFactor := RealEstateAgent scaleFactor. - self isFlexed - ifFalse: [self scaleFactor: scaleFactor. - self position: self position / scaleFactor. - self changed]! Item was removed: - ----- Method: PaintBoxMorph>>brush:action:nib:evt: (in category 'actions') ----- - brush: brushButton action: aSelector nib: aMask evt: evt - "Set the current tool and action for the paintBox. " - - currentBrush - ifNotNil: [currentBrush == brushButton ifFalse: [currentBrush state: #off]]. - currentBrush := brushButton. "A ThreePhaseButtonMorph" - - "currentBrush state: #on. already done" - "aSelector is like brush3:. Don't save it. Can always say (currentBrush arguments at: 2) - aMask is the brush shape. Don't save it. Can always say (currentBrush arguments at: 3)" - self notifyWeakDependentsWith: { - #currentNib. - evt. - currentBrush arguments third}. - self brushable ifFalse: [self setAction: #paint: evt: evt] "User now thinking of painting"! Item was removed: - ----- Method: PaintBoxMorph>>brushable (in category 'actions') ----- - brushable - "Return true if the current tool uses a brush." - ^ (#("non-brushable" eyedropper: fill: pickup: stamp:) indexOf: action) = 0! Item was removed: - ----- Method: PaintBoxMorph>>buildAPrototype (in category 'initialization') ----- - buildAPrototype - | onImage | - self initialize. - self image: self class paletteImage. - rotationTabForm := self class rotationTabImage. - scaleTabForm := self class scaleTabImage. - (colorMemoryThin := self class colorMemoryThinImage asMorph) - setNamePropertyTo: 'ColorPickerClosed'; - position: self position + (11 at 150); - on: #mouseEnter send: #showColorPalette: to: self. - self addMorph: colorMemoryThin. - (colorMemory := PaintBoxColorPicker new image: self class colorMemoryImage) - setNamePropertyTo: 'ColorPickerOpened'; - on: #mouseDown send: #takeColorEvt:from: to: self. - currentColor := Color black. - - onImage := self class paletteOnImage. - self - addToolsOffImage: image onImage: onImage; - addBrushesOffImage: image; - addActionsOffImage: image onImage: onImage; - addStampsAndShapes; - addShapeButtonsOffImage: self class shapesImage onImage: self class shapesOnImage; - addStampButtonsOffImage: self class stampsImage onImage: self class stampsOnImage. - stampHolder := ScrollingToolHolder newPrototypeFor: self.! Item was removed: - ----- Method: PaintBoxMorph>>clear:with:evt: (in category 'actions') ----- - clear: clearButton with: clearSelector evt: evt - - | ss | - (ss := self focusMorph) - ifNotNil: [ss clearPainting: self] - ifNil: [self notCurrentlyPainting]. - clearButton state: #off.! Item was removed: - ----- Method: PaintBoxMorph>>colorMemory (in category 'other') ----- - colorMemory - - ^ colorMemory! Item was removed: - ----- Method: PaintBoxMorph>>colorMemory: (in category 'other') ----- - colorMemory: aMorph - - colorMemory := aMorph! Item was removed: - ----- Method: PaintBoxMorph>>colorable (in category 'actions') ----- - colorable - "Return true if the current tool uses a color." - ^ (#("These use no color" erase: eyedropper: "fill: does" pickup: stamp:) indexOf: action) = 0! Item was removed: - ----- Method: PaintBoxMorph>>currentColor:evt: (in category 'actions') ----- - currentColor: aColor evt: evt - "Accept a color from the outside. (my colorMemoryMorph must call takeColorEvt: evt from: colorPicker instead)" - - currentColor := aColor. - colorMemory currentColor: aColor. - self notifyWeakDependentsWith: {#currentColor. evt. currentColor}. - self showColor. - self colorable ifFalse: [self setAction: #paint: evt: evt]. "User now thinking of painting"! Item was removed: - ----- Method: PaintBoxMorph>>cursorFor:oldCursor:currentNib:color: (in category 'actions') ----- - cursorFor: anAction oldCursor: oldCursor currentNib: aNibForm color: aColor - "Return the cursor to use with this painting action/tool. Offset of the - form must be set." - - | ff width co larger c box | - - anAction == #paint: - ifTrue: ["Make a cursor from the brush and the color" - width := aNibForm width. - c := self ringColorFor: aColor. - co := oldCursor offset - (width // 4 @ 34 - (width // 6)) min: 0 @ 0. - larger := width negated + 10 @ 0 extent: oldCursor extent + (width @ width). - ff := oldCursor copy: larger. - ff colors at: 1 put: Color transparent. - ff colors at: 2 put: Color transparent. - ff offset: co - (width @ width // 2). - ff getCanvas - fillOval: (Rectangle center: ff offset negated extent: width @ width) - color: Color transparent - borderWidth: 1 - borderColor: c. - ^ ff]. - anAction == #erase: - ifTrue: ["Make a cursor from the cursor and the color" - width := aNibForm width. - co := oldCursor offset + (width // 2 @ 4) min: 0 @ 0. - larger := 0 @ 0 extent: oldCursor extent + (width @ width). - ff := oldCursor copy: larger. - ff offset: co - (width @ width // 2). - ff - fill: (box := co negated extent: width @ width) - fillColor: (Color r: 0.5 g: 0.5 b: 1.0). - ff - fill: (box insetBy: 1 @ 1) - fillColor: Color transparent. - ^ ff]. - ^ oldCursor! Item was removed: - ----- Method: PaintBoxMorph>>delete (in category 'actions') ----- - delete - - ^ self isSupersized - ifTrue: [self owner delete] - ifFalse: [super delete]! Item was removed: - ----- Method: PaintBoxMorph>>deleteCurrentStamp: (in category 'actions') ----- - deleteCurrentStamp: evt - "The trash is telling us to delete the currently selected stamp" - - (tool arguments second) == #stamp: - ifTrue: - [stampHolder remove: tool. - self setAction: #paint: evt: evt] "no use stamping with a blank stamp"! Item was removed: - ----- Method: PaintBoxMorph>>eyedropper:action:cursor:evt: (in category 'actions') ----- - eyedropper: aButton action: aSelector cursor: aCursor evt: evt - "Take total control and pick up a color!!!!" - - | pt feedbackColor delay | - delay := Delay forMilliseconds: 10. - aButton state: #on. - tool ifNotNil: [tool state: #off]. - currentCursor := aCursor. - evt hand showTemporaryCursor: currentCursor - hotSpotOffset: 6 negated @ 4 negated. - "<<<< the form was changed a bit??" - feedbackColor := Display colorAt: Sensor cursorPoint. - colorMemory align: colorMemory bounds topRight - with: colorMemoryThin bounds topRight. - self addMorphFront: colorMemory. - - "Full color picker" - [Sensor anyButtonPressed] whileFalse: - [pt := Sensor cursorPoint. - "deal with the fact that 32 bit displays may have garbage in the - alpha bits" - feedbackColor := Display depth = 32 - ifTrue: - [Color colorFromPixelValue: ((Display pixelValueAt: pt) bitOr: 16rFF000000) - depth: 32] - ifFalse: [Display colorAt: pt]. - "the hand needs to be drawn" - evt hand position: pt. - currentColor ~= feedbackColor ifTrue: [ - currentColor := feedbackColor. - self showColor ]. - self refreshWorld. - delay wait]. - - "Now wait for the button to be released." - [Sensor anyButtonPressed] whileTrue: - [ pt := Sensor cursorPoint. - "the hand needs to be drawn" - evt hand position: pt. - self refreshWorld. - delay wait]. - - evt hand showTemporaryCursor: nil hotSpotOffset: 0 @ 0. - self currentColor: feedbackColor evt: evt. - colorMemory delete. - tool ifNotNil: - [tool state: #on. - currentCursor := tool arguments third]. - aButton state: #off - ! Item was removed: - ----- Method: PaintBoxMorph>>fixUpColorPicker (in category 'recent colors') ----- - fixUpColorPicker - | chart picker | - chart := self class colorChart. - chart getCanvas frameRectangle: chart boundingBox color: Color black. - picker := Form extent: (chart extent + (14 @ 12)) depth: 16. - picker fillWhite. - "top" - picker copy: (0 @ 0 extent: picker width @ 6) - from: (colorMemory image width - picker width) @ 0 - in: colorMemory image rule: Form over. - "bottom" - picker copy: (0 @ (picker height - 6) extent: picker width @ 6) - from: (colorMemory image width - picker width) @ (colorMemory image height - 7) - in: colorMemory image rule: Form over. - "left" - picker copy: (0 @ 6 corner: 8 @ (picker height - 6)) - from: (colorMemory image boundingBox topLeft + (0 @ 6)) - in: colorMemory image rule: Form over. - "right" - picker copy: (picker width-6 @ 6 corner: picker width @ (picker height - 6)) - from: (colorMemory image boundingBox topRight - (6 @ -6)) - in: colorMemory image rule: Form over. - chart displayOn: picker at: 8 @ 6. - picker getCanvas frameRectangle: picker boundingBox color: Color black. - colorMemory image: picker. - ! Item was removed: - ----- Method: PaintBoxMorph>>fixUpRecentColors (in category 'recent colors') ----- - fixUpRecentColors - | inner outer border box form newImage canvas morph | - self fixUpColorPicker. - recentColors := WriteStream on: Array new. - form := image. - newImage := Form extent: form extent + (0 @ 41) depth: form depth. - form displayOn: newImage. - newImage - copy: (0 @ (form height - 10) - extent: form width @ (newImage height - form height + 10)) - from: 0 @ (form height - (newImage height - form height + 10)) - in: form - rule: Form over. - canvas := newImage getCanvas. - canvas - line: 12 @ (form height - 10) - to: 92 @ (form height - 10) - width: 1 - color: Color black. - canvas := canvas copyOffset: 12 @ (form height - 9). - inner := Color - r: 0.677 - g: 0.71 - b: 0.968. - outer := inner darker darker. - border := Color - r: 0.194 - g: 0.258 - b: 0.194. - 0 to: 1 - do: - [:y | - 0 to: 3 - do: - [:x | - box := (x * 20) @ (y * 20) extent: 20 @ 20. - morph := BorderedMorph new - bounds: ((box insetBy: 1) translateBy: canvas origin + bounds origin). - morph - borderWidth: 1; - borderColor: border. - morph color: Color white. - morph - on: #mouseDown - send: #mouseDownRecent:with: - to: self. - morph - on: #mouseMove - send: #mouseStillDownRecent:with: - to: self. - morph - on: #mouseUp - send: #mouseUpRecent:with: - to: self. - self addMorphFront: morph. - recentColors nextPut: morph. - canvas fillRectangle: box color: Color white. - canvas frameRectangle: (box insetBy: 1) color: border. - canvas frameRectangle: box color: inner. - box := box insetBy: 1. - canvas - line: box topRight - to: box bottomRight - width: 1 - color: outer. - canvas - line: box bottomLeft - to: box bottomRight - width: 1 - color: outer]]. - recentColors := recentColors contents. - (RecentColors isNil or: [RecentColors size ~= recentColors size]) - ifTrue: [RecentColors := recentColors collect: [:each | each color]] - ifFalse: - [RecentColors - keysAndValuesDo: [:idx :aColor | (recentColors at: idx) color: aColor]]. - self image: newImage. - self toggleStamps. - self toggleStamps! Item was removed: - ----- Method: PaintBoxMorph>>focusMorph (in category 'other') ----- - focusMorph - "Note: For backward compatibility we search the world for a SketchEditorMorph if the current focus morph is nil" - ^focusMorph ifNil:[focusMorph := self world findA: SketchEditorMorph]! Item was removed: - ----- Method: PaintBoxMorph>>focusMorph: (in category 'other') ----- - focusMorph: newFocus - "Set the new focus morph" - focusMorph ifNotNil:[focusMorph paletteDetached: self]. "In case the morph is interested" - focusMorph := newFocus. - focusMorph ifNotNil:[focusMorph paletteAttached: self]. "In case the morph is interested"! Item was removed: - ----- Method: PaintBoxMorph>>getColor (in category 'actions') ----- - getColor - ^ currentColor! Item was removed: - ----- Method: PaintBoxMorph>>getNib (in category 'actions') ----- - getNib - ^currentBrush arguments third! Item was removed: - ----- Method: PaintBoxMorph>>getSpecial (in category 'actions') ----- - getSpecial - ^ action "a selector like #paint:"! Item was removed: - ----- Method: PaintBoxMorph>>grabFromScreen: (in category 'actions') ----- - grabFromScreen: evt - "Allow the user to grab a picture from the screen OUTSIDE THE PAINTING AREA and install it in a blank stamp. To get a stamp in the painting area, click on the stamp tool in a blank stamp." - - "scroll to blank stamp" - - | stampButton form | - stampButton := stampHolder stampButtons first. - [(stampHolder stampFormFor: stampButton) isNil] - whileFalse: [stampHolder scroll: 1]. - form := Form fromUser. - tool state: #off. - tool := stampHolder otherButtonFor: stampButton. - stampHolder stampForm: form for: tool. "install it" - stampButton state: #on. - stampButton doButtonAction: evt. - evt hand showTemporaryCursor: (focusMorph getCursorFor: evt)! Item was removed: - ----- Method: PaintBoxMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - colorMemory ifNotNil: [colorMemory on: #mouseDown send: #takeColorEvt:from: to: self].! Item was removed: - ----- Method: PaintBoxMorph>>isSupersized (in category 'initialization') ----- - isSupersized - - ^ self isFlexed! Item was removed: - ----- Method: PaintBoxMorph>>keep:with:evt: (in category 'actions') ----- - keep: keepButton with: keepSelector evt: evt - "Showing of the corrent palette (viewer or noPalette) is done by the block submitted to the SketchMorphEditor, see (EToyHand makeNewDrawing) and (SketchMorph editDrawingInWorld:forBackground:)." - | ss | - owner ifNil: [^ self]. - keepButton ifNotNil: [keepButton state: #off]. - (ss := self focusMorph) - ifNotNil: [ss savePainting: self evt: evt] - ifNil: - [keepSelector == #silent ifTrue: [^ self]. - self notCurrentlyPainting].! Item was removed: - ----- Method: PaintBoxMorph>>loadJapanesePaintBoxBitmaps (in category 'initialization') ----- - loadJapanesePaintBoxBitmaps - " - PaintBoxMorph new loadJapanesePaintBoxBitmaps. - " - - | formTranslator form bb | - self position: 0 at 0. - formTranslator := NaturalLanguageFormTranslator localeID: (LocaleID isoString: 'ja'). - form := Form fromFileNamed: 'offPaletteJapanese(children).form'. - - #('keep:' 'undo:' 'clear:' 'toss:') with: #('KEEP' 'UNDO' 'CLEAR' 'TOSS') do: [:extName :label | - bb := (self submorphs detect: [:e | e externalName = extName]) bounds. - formTranslator name: label, '-off' form: (form copy: bb) - ]. - - - form := Form fromFileNamed: 'pressedPaletteJapanese(children).form'. - #('keep:' 'undo:' 'clear:' 'toss:') with: #('KEEP' 'UNDO' 'CLEAR' 'TOSS') do: [:extName :label | - bb := (self submorphs detect: [:e | e externalName = extName]) bounds. - formTranslator name: label, '-pressed' form: (form copy: bb) - ]. - ! Item was removed: - ----- Method: PaintBoxMorph>>maxBounds (in category 'other') ----- - maxBounds - | rr | - "fullBounds if all flop-out parts of the paintBox were showing." - - rr := bounds merge: colorMemory bounds. - rr := rr merge: (self submorphNamed: 'stamps') bounds. - rr := rr origin corner: rr corner + (0@ (self submorphNamed: 'shapes') height - + 10 "what is showing of (self submorphNamed: #toggleShapes) height"). - ^ rr! Item was removed: - ----- Method: PaintBoxMorph>>mouseDownRecent:with: (in category 'recent colors') ----- - mouseDownRecent: evt with: aMorph - aMorph borderColor: Color white. - ! Item was removed: - ----- Method: PaintBoxMorph>>mouseStillDownRecent:with: (in category 'recent colors') ----- - mouseStillDownRecent: evt with: aMorph - (aMorph containsPoint: evt cursorPoint) - ifTrue:[aMorph borderColor: Color white] - ifFalse:[aMorph borderColor: (Color r: 0.194 g: 0.258 b: 0.194)] - ! Item was removed: - ----- Method: PaintBoxMorph>>mouseUpBalk: (in category 'user interface') ----- - mouseUpBalk: evt - "A button I own got a mouseDown, but the user moved out before letting up. Prevent this for the current tool. Some tool must stay selected." - - tool state: #on. "keep current one, even if user balked on it" - currentBrush ifNotNil: [currentBrush state: #on].! Item was removed: - ----- Method: PaintBoxMorph>>mouseUpRecent:with: (in category 'recent colors') ----- - mouseUpRecent: evt with: aMorph - aMorph borderColor: (Color r: 0.194 g: 0.258 b: 0.194). - (aMorph containsPoint: evt cursorPoint) ifTrue:[ - self takeColor: aMorph color event: evt. - ].! Item was removed: - ----- Method: PaintBoxMorph>>notCurrentlyPainting (in category 'actions') ----- - notCurrentlyPainting - self inform: 'You are not currently painting'! Item was removed: - ----- Method: PaintBoxMorph>>notifyWeakDependentsWith: (in category 'actions') ----- - notifyWeakDependentsWith: arguments - - weakDependents ifNil: [^self]. - weakDependents do: [ :each | - each ifNotNil: [ - each paintBoxChanged: arguments. - each paintBoxChanged: {#changed. arguments second. true}. - ]. - ].! Item was removed: - ----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') ----- - offsetFromMaxBounds - "location of normal PaintBox within maxBounds." - | left | - left := self left. - ((Preferences canUnderstand: #useBiggerPaintingBox) and: [ Preferences useBiggerPaintingBox ]) ifTrue: [left := left - (( self width * 1.5)- self width)]. - ^ left - colorMemory left @ 0! Item was removed: - ----- Method: PaintBoxMorph>>pickup:action:cursor:evt: (in category 'actions') ----- - pickup: actionButton action: aSelector cursor: aCursor evt: evt - "Special version for pickup: and stamp:, because of these tests" - - | ss picker old map stamper | - self - tool: actionButton - action: aSelector - cursor: aCursor - evt: evt. - aSelector == #stamp: - ifTrue: - [(stampHolder pickupButtons includes: actionButton) - ifTrue: - [stamper := stampHolder otherButtonFor: actionButton. - ^self - pickup: stamper - action: #stamp: - cursor: (stamper arguments third) - evt: evt]. - (stampHolder stampFormFor: actionButton) ifNil: - ["If not stamp there, go to pickup mode" - - picker := stampHolder otherButtonFor: actionButton. - picker state: #on. - ^self - pickup: picker - action: #pickup: - cursor: (picker arguments third) - evt: evt] - ifNotNil: - [old := stampHolder stampFormFor: actionButton. - currentCursor := ColorForm extent: old extent depth: 8. - old displayOn: currentCursor. - map := Color indexedColors copy. - map at: 1 put: Color transparent. - currentCursor colors: map. - currentCursor offset: currentCursor extent // -2. - "Emphisize the stamp button" - actionButton owner borderColor: (Color - r: 0.65 - g: 0.599 - b: 0.8) "layoutMorph" "color: (Color r: 1.0 g: 0.645 b: 0.419);"]]. - aSelector == #pickup: - ifTrue: - [ss := self focusMorph. - ss ifNotNil: [currentCursor := aCursor] - ifNil: - [self notCurrentlyPainting. - self setAction: #paint: evt: evt]]! Item was removed: - ----- Method: PaintBoxMorph>>pickupForm: (in category 'actions') ----- - pickupForm: stampForm - "Install the new picture in this stamp" - - | stampButton | - stampHolder stampForm: stampForm for: tool. - stampButton := action == #pickup: - ifTrue: [stampHolder otherButtonFor: tool] - ifFalse: [tool]. "was a nil stampForm" - stampButton state: #on. - stampButton doButtonAction.! Item was removed: - ----- Method: PaintBoxMorph>>pickupForm:evt: (in category 'actions') ----- - pickupForm: stampForm evt: evt - "Install the new picture in this stamp" - - | stampButton | - stampHolder stampForm: stampForm for: tool. - stampButton := action == #pickup: - ifTrue: [stampHolder otherButtonFor: tool] - ifFalse: [tool]. "was a nil stampForm" - stampButton state: #on. - stampButton doButtonAction: evt.! Item was removed: - ----- Method: PaintBoxMorph>>plainCursor (in category 'actions') ----- - plainCursor - "Return the cursor to use with this painting action/tool. Offset of the form must be set." - - ^currentCursor - ! Item was removed: - ----- Method: PaintBoxMorph>>plainCursor:event: (in category 'actions') ----- - plainCursor: aCursor event: anEvent - "Set the cursor to use with this painting action/tool. Offset of the form must be set." - - currentCursor := aCursor. - anEvent hand showTemporaryCursor: aCursor. - self notifyWeakDependentsWith: {#currentCursor. anEvent. currentCursor}.! Item was removed: - ----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') ----- - recentColor: aColor - "Remember the color as one of our recent colors" - Prototype currentColor: aColor. - (recentColors anySatisfy: [:any | any color = aColor]) - ifTrue: [^self]. "already remembered" - RecentColors := {aColor}, RecentColors allButLast. - RecentColors keysAndValuesDo: [:i :each | - (recentColors at: i) color: each]! Item was removed: - ----- Method: PaintBoxMorph>>ringColor (in category 'actions') ----- - ringColor - "Choose a color that contrasts with my current color. If that color isn't redish, return red. Otherwise, return green" - - ^self ringColorFor: currentColor - ! Item was removed: - ----- Method: PaintBoxMorph>>ringColorFor: (in category 'actions') ----- - ringColorFor: aColor - "Choose a color that contrasts with my current color. If that color isn't redish, return red. Otherwise, return green" - - aColor isTransparent ifTrue: [^ Color red]. - aColor red < 0.5 ifTrue: [^ Color red]. - aColor red > (aColor green + (aColor blue * 0.5)) - ifTrue: [^ Color green] - ifFalse: [^ Color red]. - ! Item was removed: - ----- Method: PaintBoxMorph>>rotationTabForm (in category 'other') ----- - rotationTabForm - ^ rotationTabForm! Item was removed: - ----- Method: PaintBoxMorph>>scaleTabForm (in category 'other') ----- - scaleTabForm - ^ scaleTabForm! Item was removed: - ----- Method: PaintBoxMorph>>scrollStamps:action:evt: (in category 'actions') ----- - scrollStamps: actionButton action: aSelector evt: evt - "Move the stamps over" - - aSelector == #prevStamp: - ifTrue: [stampHolder scroll: -1] - ifFalse: [stampHolder scroll: 1]. - actionButton state: #off. - action == #stamp: ifTrue: ["reselect the stamp and compute the cursor" - self stampForm - ifNil: [self setAction: #paint: evt: evt] - ifNotNil: [tool doButtonAction: evt]]. - ! Item was removed: - ----- Method: PaintBoxMorph>>setAction:evt: (in category 'actions') ----- - setAction: aSelector evt: evt - "Find this button and turn it on. Does not work for stamps or pickups" - - | button | - button := self submorphNamed: aSelector. - - button ifNotNil: [ - button state: #on. - button doButtonAction: evt]. "select it!!"! Item was removed: - ----- Method: PaintBoxMorph>>showColor (in category 'actions') ----- - showColor - "Display the current color in all brushes, both on and off." - - | offIndex onIndex center | - currentColor ifNil: [^self]. - "colorPatch color: currentColor. May delete later" - (brushes isNil or: [brushes first owner ~~ self]) - ifTrue: - [brushes := OrderedCollection new. - #(#brush1: #brush2: #brush3: #brush4: #brush5: #brush6:) - do: [:sel | brushes addLast: (self submorphNamed: sel)]]. - brushes last offImage unhibernate. - brushes last onImage unhibernate. - brushes last pressedImage unhibernate. - center := brushes last offImage extent // 2. - offIndex := brushes last offImage pixelValueAt: center. - onIndex := brushes last onImage pixelValueAt: center. - brushes do: - [:bb | - bb offImage colors at: offIndex + 1 put: currentColor. - bb offImage clearColormapCache. - bb onImage colors at: onIndex + 1 put: currentColor. - bb onImage clearColormapCache. - bb invalidRect: bb bounds]. - self invalidRect: (brushes first topLeft rect: brushes last bottomRight)! Item was removed: - ----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') ----- - showColorPalette: evt - - | w box | - self comeToFront. - colorMemory align: colorMemory bounds topRight - with: colorMemoryThin bounds topRight. - "make sure color memory fits or else align with left" - w := self world. - box := self bounds: colorMemory fullBounds in: w. - box left < 0 ifTrue:[ - colorMemory align: colorMemory bounds topLeft - with: colorMemoryThin bounds topLeft]. - self addMorphFront: colorMemory. - self changed! Item was removed: - ----- Method: PaintBoxMorph>>stampCursorBeCursorFor: (in category 'actions') ----- - stampCursorBeCursorFor: anAction - "User just chose a stamp. Take that stamp picture and make it be the cursor for the tool named." - "self stampCursorBeCursorFor: #star:. - currentCursor offset: -9 at -3. Has side effect on the saved cursor." - - (self submorphNamed: anAction) arguments at: 3 put: currentCursor. - "Already converted to 8 bits and in the right form"! Item was removed: - ----- Method: PaintBoxMorph>>stampDeEmphasize (in category 'actions') ----- - stampDeEmphasize - "Turn off an emphasized stamp. Was turned on in pickup:action:cursor:" - - tool owner class == AlignmentMorph ifTrue: [ - tool "actionButton" owner "layoutMorph" color: Color transparent; - borderColor: Color transparent].! Item was removed: - ----- Method: PaintBoxMorph>>stampForm (in category 'actions') ----- - stampForm - "Return the selected stamp" - - ^ stampHolder stampFormFor: tool. - ! Item was removed: - ----- Method: PaintBoxMorph>>stampHolder (in category 'actions') ----- - stampHolder - - ^ stampHolder! Item was removed: - ----- Method: PaintBoxMorph>>stampHolder: (in category 'actions') ----- - stampHolder: newOne - - stampHolder := newOne! Item was removed: - ----- Method: PaintBoxMorph>>takeColor:event: (in category 'actions') ----- - takeColor: aColor event: evt - "Accept the given color programmatically" - currentColor := aColor. - self notifyWeakDependentsWith: {#currentColor. evt. currentColor}. - self showColor. - self colorable ifFalse: [self setAction: #paint: evt: evt]. "User now thinking of painting"! Item was removed: - ----- Method: PaintBoxMorph>>takeColorEvt:from: (in category 'actions') ----- - takeColorEvt: evt from: colorPicker - "Accept a new color from the colorMemory. Programs use currentColor: instead. Do not do this before the picker has a chance to set its own color!!" - ^self takeColor: colorPicker currentColor event: evt! Item was removed: - ----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') ----- - toggleShapes - | tab sh stamps | - "The sub panel that has the shape tools on it. Rect, line..." - stamps := self submorphNamed: 'stamps'. - tab := self submorphNamed: 'shapeTab'. - (sh := self submorphNamed: 'shapes') visible - ifTrue: [sh hide. tab top: stamps bottom-1] - ifFalse: [sh comeToFront. sh top: stamps bottom-9. - sh show. tab top: sh bottom - tab height + 10]. - self layoutChanged. - self changed - ! Item was removed: - ----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') ----- - toggleStamps - | tab otherTab st shapes | - "The sub panel that has the stamps in it. For saving and moving parts of an image." - shapes := self submorphNamed: 'shapes'. - otherTab := self submorphNamed: 'shapeTab'. - tab := self submorphNamed: 'stampTab'. - (st := self submorphNamed: 'stamps') visible - ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1. - shapes top: self bottom-9. - otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10] - ifFalse: [self bottom-1])] - ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0. - shapes top: st bottom-9. - otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10] - ifFalse: [st bottom-0])]. - self layoutChanged. - self changed! Item was removed: - ----- Method: PaintBoxMorph>>tool (in category 'actions') ----- - tool - ^ tool! Item was removed: - ----- Method: PaintBoxMorph>>tool:action:cursor:evt: (in category 'actions') ----- - tool: actionButton action: aSelector cursor: aCursor evt: evt - "Set the current tool and action for the paintBox. " - - tool ifNotNil: [ - tool == actionButton ifFalse: [ - tool state: #off. - action == #stamp: ifTrue: [self stampDeEmphasize]]]. - tool := actionButton. "A ThreePhaseButtonMorph" - "tool state: #on. already done" - action := aSelector. "paint:" - currentCursor := aCursor. - self notifyWeakDependentsWith: {#action. evt. action}. - self notifyWeakDependentsWith: {#currentCursor. evt. currentCursor}. - ! Item was removed: - ----- Method: PaintBoxMorph>>toss:with:evt: (in category 'actions') ----- - toss: cancelButton with: cancelSelector evt: evt - "Reject the painting. Showing noPalette is done by the block submitted to the SketchEditorMorph" - - | focus | - owner ifNil: ["it happens" ^ self]. - (focus := self focusMorph) - ifNotNil: [focus cancelPainting: self evt: evt] - ifNil: - [self delete]. - cancelButton state: #off. - ! Item was removed: - ----- Method: PaintBoxMorph>>undo:with:evt: (in category 'actions') ----- - undo: undoButton with: undoSelector evt: evt - | ss | - (ss := self focusMorph) - ifNotNil: [ss undoPainting: self evt: evt] - ifNil: [self notCurrentlyPainting]. - undoButton state: #off.! Item was removed: - ----- Method: PaintBoxMorph>>updateReferencesUsing: (in category 'copying') ----- - updateReferencesUsing: aDictionary - "Fix up stampHolder which is a ScrollingToolHolder, which is not a Morph" - - super updateReferencesUsing: aDictionary. - stampHolder updateReferencesUsing: aDictionary. - colorMemory updateReferencesUsing: aDictionary.! Item was removed: - ImageMorph subclass: #PaintInvokingMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !PaintInvokingMorph commentStamp: '<historical>' prior: 0! - When this is dropped inside some appropriate place, then painting is invoked for that place.! Item was removed: - ----- Method: PaintInvokingMorph class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - ^ self new image: (ScriptingSystem formAtKey: 'Painting'); markAsPartsDonor; setBalloonText: 'drop this into any playfield or book page to make a new painting there'; yourself! Item was removed: - ----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Paint' translatedNoop - categories: {'Graphics' translatedNoop} - documentation: 'Drop this icon to start painting a new object.' translatedNoop! Item was removed: - ----- Method: PaintInvokingMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry.! Item was removed: - ----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'Scripting']! Item was removed: - ----- Method: PaintInvokingMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: PaintInvokingMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - self image: (ScriptingSystem formAtKey: 'Painting')! Item was removed: - ----- Method: PaintInvokingMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - super initializeToStandAlone. - self image: (ScriptingSystem formAtKey: 'Painting')! Item was removed: - ----- Method: PaintInvokingMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - justDroppedInto: aPasteUpMorph event: anEvent - "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph" - aPasteUpMorph isPartsBin ifFalse:[ - self removeHalo. - self delete. - ^aPasteUpMorph makeNewDrawing: anEvent]. - ^super justDroppedInto: aPasteUpMorph event: anEvent! Item was removed: - ----- Method: PaintInvokingMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- - wantsToBeDroppedInto: aMorph - "Only into PasteUps that are not part bins" - ^aMorph isPlayfieldLike! Item was removed: - PasteUpMorph subclass: #PartsBin - instanceVariableNames: '' - classVariableNames: 'Thumbnails' - poolDictionaries: '' - category: 'MorphicExtras-PartsBin'! Item was removed: - ----- Method: PartsBin class>>cacheAllThumbnails (in category 'thumbnail cache') ----- - cacheAllThumbnails - "In one monster operation, cache all the thumbnails of parts. Intended to be called from do-its in update postscripts, for example, or manually." - - Cursor wait showWhile: - [Morph withAllSubclasses do: [:aClass | - (aClass class includesSelector: #descriptionForPartsBin) ifTrue: - [self thumbnailForPartsDescription: aClass descriptionForPartsBin]. - (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: - [aClass supplementaryPartsDescriptions do: - [:aDescription | self thumbnailForPartsDescription: aDescription]]]] - - "Time millisecondsToRun: [PartsBin initialize. PartsBin cacheAllThumbnails]" - ! Item was removed: - ----- Method: PartsBin class>>cacheThumbnail:forSymbol: (in category 'thumbnail cache') ----- - cacheThumbnail: aThumbnail forSymbol: aSymbol - "Cache the thumbnail provided as the graphic representing a parts-bin denizen whose name is the given symbol" - - Thumbnails at: aSymbol put: aThumbnail! Item was removed: - ----- Method: PartsBin class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Flush caches" - - self clearThumbnailCache! Item was removed: - ----- Method: PartsBin class>>clearThumbnailCache (in category 'thumbnail cache') ----- - clearThumbnailCache - "Clear the cache of thumbnails: - PartsBin clearThumbnailCache - " - - Thumbnails := Dictionary new! Item was removed: - ----- Method: PartsBin class>>initialize (in category 'class initialization') ----- - initialize - "Initialize the PartsBin class, by starting it out with an empty Thumbnails dictionary" - - Thumbnails := Dictionary new - "PartsBin initialize"! Item was removed: - ----- Method: PartsBin class>>localeChanged (in category 'class initialization') ----- - localeChanged - self initialize! Item was removed: - ----- Method: PartsBin class>>newPartsBinWithOrientation:andColor:from: (in category 'instance creation') ----- - newPartsBinWithOrientation: aListDirection andColor: aColor from: quadList - "Answer a new PartBin object, to run horizontally or vertically, - obtaining its elements from the list of tuples of the form: - (<receiver> <selector> <label> <balloonHelp>)" - ^ (self new) - color: aColor; - listDirection: aListDirection quadList: (self translatedQuads: quadList).! Item was removed: - ----- Method: PartsBin class>>newPartsBinWithOrientation:from: (in category 'instance creation') ----- - newPartsBinWithOrientation: aListDirection from: quadList - "Answer a new PartBin object, to run horizontally or vertically, - obtaining its elements from the list of tuples of the form: - (<receiver> <selector> <label> <balloonHelp>)" - ^ self new - listDirection: aListDirection - quadList: (self translatedQuads: quadList) ! Item was removed: - ----- Method: PartsBin class>>thumbnailForInstanceOf: (in category 'thumbnail cache') ----- - thumbnailForInstanceOf: aMorphClass - "Answer a thumbnail for a stand-alone instance of the given class, creating it if necessary. If it is created afresh, it will also be cached at this time" - - ^ Thumbnails at: aMorphClass name ifAbsent: - [| aThumbnail | - aThumbnail := Thumbnail new makeThumbnailFromForm: aMorphClass newStandAlone imageForm. - self cacheThumbnail: aThumbnail forSymbol: aMorphClass name. - ^ aThumbnail] - - "PartsBin initialize"! Item was removed: - ----- Method: PartsBin class>>thumbnailForPartsDescription: (in category 'thumbnail cache') ----- - thumbnailForPartsDescription: aPartsDescription - "Answer a thumbnail for the given parts description creating it if necessary. If it is created afresh, it will also be cached at this time" - - | aSymbol | - aSymbol := aPartsDescription formalName asSymbol. - ^ Thumbnails at: aSymbol ifAbsent: - [| aThumbnail | - aThumbnail := Thumbnail new makeThumbnailFromForm: aPartsDescription sampleImageForm. - self cacheThumbnail: aThumbnail forSymbol: aSymbol. - ^ aThumbnail] - - "PartsBin initialize"! Item was removed: - ----- Method: PartsBin class>>thumbnailForQuad: (in category 'thumbnail cache') ----- - thumbnailForQuad: aQuint - "Answer a thumbnail for a morph obtaining as per the quintuplet provided, creating the thumbnail if necessary. If it is created afresh, it will also be cached at this time" - ^self thumbnailForQuad: aQuint color: Color transparent.! Item was removed: - ----- Method: PartsBin class>>thumbnailForQuad:color: (in category 'thumbnail cache') ----- - thumbnailForQuad: aQuint color: aColor - "Answer a thumbnail for a morph obtaining as per the quintuplet provided, creating the thumbnail if necessary. If it is created afresh, it will also be cached at this time" - - | aThumbnail aSymbol formToThumbnail labeledItem | - aSymbol := aQuint third. - Thumbnails at: aSymbol ifPresent: [ :thumb | ^thumb ]. - formToThumbnail := aQuint at: 5 ifAbsent: []. - formToThumbnail ifNil: [ - labeledItem := (Smalltalk at: aQuint first) perform: aQuint second. - formToThumbnail := labeledItem imageForm: 32 backgroundColor: aColor forRectangle: labeledItem fullBounds. - formToThumbnail replaceColor: aColor withColor: Color transparent. - labeledItem delete. - ]. - - aThumbnail := Thumbnail new makeThumbnailFromForm: formToThumbnail. - self cacheThumbnail: aThumbnail forSymbol: aSymbol. - ^ aThumbnail - - "PartsBin initialize"! Item was removed: - ----- Method: PartsBin class>>translatedQuads: (in category 'private') ----- - translatedQuads: quads - "private - convert the given quads to a translated one" - - | translatedQuads | - - translatedQuads := quads collect: [:each | - | element | - element := each copy. - element at: 3 put: each third translated. - element at: 4 put: each fourth translated. - element. - ]. - - ^ translatedQuads - ! Item was removed: - ----- Method: PartsBin>>innocuousName (in category 'properties') ----- - innocuousName - "Answer a harmless name for an unnamed instance" - - ^ 'parts bin' translated! Item was removed: - ----- Method: PartsBin>>listDirection:quadList: (in category 'initialization') ----- - listDirection: aListDirection quadList: quadList - "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: - (<receiver> <selector> <label> <balloonHelp>)" - - ^self listDirection: aListDirection quadList: quadList buttonClass: IconicButton! Item was removed: - ----- Method: PartsBin>>listDirection:quadList:buttonClass: (in category 'initialization') ----- - listDirection: aListDirection quadList: quadList buttonClass: buttonClass - "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: - (<receiver> <selector> <label> <balloonHelp>) - Used by external package Connectors." - - self layoutPolicy: TableLayout new. - self listDirection: aListDirection. - self wrapCentering: #topLeft. - self layoutInset: 2. - self cellPositioning: #bottomCenter. - - aListDirection == #leftToRight - ifTrue: - [self vResizing: #rigid. - self hResizing: #spaceFill. - self wrapDirection: #topToBottom] - ifFalse: - [self hResizing: #rigid. - self vResizing: #spaceFill. - self wrapDirection: #leftToRight]. - quadList do: - [:tuple | - | aButton aClass | - aClass := Smalltalk at: tuple first. - aButton := buttonClass new - initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third - andColor: self color - andSend: tuple second - to: aClass. - (tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue: - [aButton setBalloonText: tuple fourth]. - self addMorphBack: aButton]! Item was removed: - ----- Method: PartsBin>>morphToDropFrom: (in category 'dropping/grabbing') ----- - morphToDropFrom: aMorph - "Answer the morph to drop if the user attempts to drop aMorph" - - | aButton | - ((aMorph isKindOf: IconicButton) and: [aMorph actionSelector == #launchPartVia:label:]) - ifTrue: [^ aMorph]. - "The above handles the unusual case of a button that's already set up in a manner suitable for living in PartsBin; the archetypal example is the attempt to reposition an object within a partsflap by dragging it via the black halo handle." - - aButton := IconicButton new. - aButton color: self color; - initializeToShow: aMorph withLabel: aMorph externalName andSend: #veryDeepCopy to: aMorph veryDeepCopy. - ^ aButton! Item was removed: - ----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - "Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves" - - (aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue: - [^ true]. - - ^ super wantsDroppedMorph: aMorph event: evt! Item was removed: - ----- Method: PartsBin>>wantsEasySelection (in category 'event handling') ----- - wantsEasySelection - "Answer if the receiver want easy selection mode" - ^ false! Item was removed: - ----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - "Initialize the class" - - #('keyStroke') translatedNoop. - - self registerInFlapsRegistry. - ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.! Item was removed: - ----- Method: PasteUpMorph class>>newWorldTesting (in category '*MorphicExtras-project') ----- - newWorldTesting - - | world ex | - - ex := 500 at 500. - world := PasteUpMorph newWorldForProject: nil. - world extent: ex; color: Color orange. - world openInWorld. - BouncingAtomsMorph new openInWorld: world. - - "----- - - | world window | - world := PasteUpMorph newWorldForProject: nil. - world extent: 300 at 300; color: Color orange. - world viewBox: (0 at 0 extent: 300 at 300). - window := (SystemWindow labelled: 'the new world') model: world. - window color: Color orange. - window addMorph: world frame: (0 at 0 extent: 1.0 at 1.0). - window openInWorld. - - ---" - ! Item was removed: - ----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop} - forFlapNamed: 'Scripting']! Item was removed: - ----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - ^ {DescriptionForPartsBin - formalName: 'Holder' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #prototypicalHolder}! Item was removed: - ----- Method: PasteUpMorph class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: PasteUpMorph>>deleteAllFlapArtifacts (in category '*MorphicExtras-flaps') ----- - deleteAllFlapArtifacts - "self currentWorld deleteAllFlapArtifacts" - - self submorphs do:[:m | m wantsToBeTopmost ifTrue:[m delete]].! Item was removed: - ----- Method: PasteUpMorph>>roundUpStrays (in category '*MorphicExtras-misc') ----- - roundUpStrays - self submorphs - reject: [:each | each wantsToBeTopmost] - thenDo: [:each | each goHome]. - super roundUpStrays! Item was removed: - RectangleMorph subclass: #PianoKeyboardMorph - instanceVariableNames: 'whiteKeyColor blackKeyColor playingKeyColor nOctaves target noteOnSelector noteOffSelector soundPrototype soundPlaying' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'PianoKeyboard' translatedNoop - categories: {'Multimedia' translatedNoop} - documentation: 'A piano keyboard' translatedNoop! Item was removed: - ----- Method: PianoKeyboardMorph>>basicMouseDownPitch: (in category 'simple keyboard') ----- - basicMouseDownPitch: midiKey - - | pitch | - pitch := AbstractSound pitchForMIDIKey: midiKey + 23. - soundPlaying ifNotNil: [soundPlaying stopGracefully]. - soundPlaying := soundPrototype soundForPitch: pitch dur: 100.0 loudness: 0.3. - SoundPlayer resumePlaying: soundPlaying quickStart: true.! Item was removed: - ----- Method: PianoKeyboardMorph>>basicMouseUpPitch: (in category 'simple keyboard') ----- - basicMouseUpPitch: pitch - - soundPlaying ifNotNil: [soundPlaying stopGracefully].! Item was removed: - ----- Method: PianoKeyboardMorph>>buildKeyboard (in category 'simple keyboard') ----- - buildKeyboard - | wtWid bkWid keyRect octavePt nWhite nBlack | - self removeAllMorphs. - wtWid := 8. bkWid := 5. - self extent: 10 @ 10. - 1 to: nOctaves + 1 do: - [:i | i <= nOctaves ifTrue: [nWhite := 7. nBlack := 5] - ifFalse: [nWhite := 1. nBlack := 0 "High C"]. - octavePt := self innerBounds topLeft + ((7 * wtWid * (i - 1) - 1) @ -1). - 1 to: nWhite do: - [:j | keyRect := octavePt + (j - 1 * wtWid @ 0) extent: (wtWid + 1) @ 36. - self addMorph: ((RectangleMorph newBounds: keyRect color: whiteKeyColor) - borderWidth: 1; - on: #mouseDown send: #mouseDownPitch:event:noteMorph: to: self - withValue: i - 1 * 12 + (#(1 3 5 6 8 10 12) at: j))]. - 1 to: nBlack do: - [:j | keyRect := octavePt + ((#(6 15 29 38 47) at: j) @ 1) extent: bkWid @ 21. - self addMorph: ((Morph newBounds: keyRect color: blackKeyColor) - on: #mouseDown send: #mouseDownPitch:event:noteMorph: to: self - withValue: i - 1 * 12 + (#(2 4 7 9 11) at: j))]]. - self submorphsDo: - [:m | m on: #mouseMove send: #mouseMovePitch:event:noteMorph: to: self; - on: #mouseUp send: #mouseUpPitch:event:noteMorph: to: self; - on: #mouseEnterDragging send: #mouseDownPitch:event:noteMorph: to: self; - on: #mouseLeaveDragging send: #mouseUpPitch:event:noteMorph: to: self]. - self extent: (self fullBounds extent + self borderWidth - 1)! Item was removed: - ----- Method: PianoKeyboardMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color veryLightGray! Item was removed: - ----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - whiteKeyColor := Color gray: 0.95. - blackKeyColor := Color black. - playingKeyColor := Color red. - nOctaves := 6. - self buildKeyboard. - soundPrototype := FMSound new.! Item was removed: - ----- Method: PianoKeyboardMorph>>initializeToStandAlone (in category 'initialization') ----- - initializeToStandAlone - - super initializeToStandAlone. - soundPrototype := FMSound brass1 duration: 9.9.! Item was removed: - ----- Method: PianoKeyboardMorph>>mouseDownEvent:noteMorph:pitch: (in category 'simple keyboard') ----- - mouseDownEvent: arg1 noteMorph: arg2 pitch: arg3 - "Reorder the arguments for existing event handlers" - (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages]. - ^self mouseDownPitch: arg1 event: arg2 noteMorph: arg3! Item was removed: - ----- Method: PianoKeyboardMorph>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') ----- - mouseDownPitch: midiKey event: event noteMorph: noteMorph - - event redButtonPressed ifFalse: [^ self]. - event hand hasSubmorphs ifTrue: [^ self "no response if drag something over me"]. - event hand mouseFocus ifNil: - ["If dragged into me, then establish focus so I'll see moves" - event hand newMouseFocus: noteMorph event: event]. - - noteMorph color: playingKeyColor. - - self basicMouseDownPitch: midiKey.! Item was removed: - ----- Method: PianoKeyboardMorph>>mouseMoveEvent:noteMorph:pitch: (in category 'simple keyboard') ----- - mouseMoveEvent: arg1 noteMorph: arg2 pitch: arg3 - "Reorder the arguments for existing event handlers" - (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages]. - ^self mouseMovePitch: arg1 event: arg2 noteMorph: arg3! Item was removed: - ----- Method: PianoKeyboardMorph>>mouseMovePitch:event:noteMorph: (in category 'simple keyboard') ----- - mouseMovePitch: pitch event: event noteMorph: noteMorph - - (noteMorph containsPoint: event cursorPoint) ifFalse: - ["If drag out of me, zap focus so other morphs can see drag in." - event hand releaseMouseFocus: noteMorph] - ! Item was removed: - ----- Method: PianoKeyboardMorph>>mouseUpEvent:noteMorph:pitch: (in category 'simple keyboard') ----- - mouseUpEvent: arg1 noteMorph: arg2 pitch: arg3 - "Reorder the arguments for existing event handlers" - (arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages]. - ^self mouseUpPitch: arg1 event: arg2 noteMorph: arg3! Item was removed: - ----- Method: PianoKeyboardMorph>>mouseUpPitch:event:noteMorph: (in category 'simple keyboard') ----- - mouseUpPitch: pitch event: event noteMorph: noteMorph - - noteMorph color: ((#(0 1 3 5 6 8 10) includes: pitch \\ 12) - ifTrue: [whiteKeyColor] - ifFalse: [blackKeyColor]). - - self basicMouseUpPitch: pitch.! Item was removed: - ----- Method: PianoKeyboardMorph>>soundPrototype: (in category 'simple keyboard') ----- - soundPrototype: aSound - soundPrototype := aSound! Item was removed: - Morph subclass: #PianoRollNoteMorph - instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' - classVariableNames: 'SoundPlaying' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! - - !PianoRollNoteMorph commentStamp: '<historical>' prior: 0! - A PianoRollNoteMorph is drawn as a simple mroph, but it carries the necessary state to locate its source sound event via its owner (a PianorRollScoreMorph) and the score therein. Simple editing of pitch and time placement is provided here.! Item was removed: - ----- Method: PianoRollNoteMorph>>deselect (in category 'selecting') ----- - deselect - - selected ifFalse: [^ self]. - self changed. - selected := false. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - selected - ifTrue: [aCanvas frameAndFillRectangle: self fullBounds fillColor: color borderWidth: 1 borderColor: Color black] - ifFalse: [aCanvas fillRectangle: self bounds color: color]. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>editPitch: (in category 'editing') ----- - editPitch: evt - - | mk note | - mk := owner midiKeyForY: evt cursorPoint y. - note := (owner score tracks at: trackIndex) at: indexInTrack. - note midiKey = mk ifTrue: [^ self]. - note midiKey: mk. - self playSound: (self soundOfDuration: 999.0). - self position: self position x @ ((owner yForMidiKey: mk) - 1) - ! Item was removed: - ----- Method: PianoRollNoteMorph>>fullBounds (in category 'layout') ----- - fullBounds - - selected - ifTrue: [^ bounds expandBy: 1] - ifFalse: [^ bounds]! Item was removed: - ----- Method: PianoRollNoteMorph>>gridToNextQuarter (in category 'editing') ----- - gridToNextQuarter - - owner score gridTrack: trackIndex toQuarter: 1 at: indexInTrack. - owner rebuildFromScore! Item was removed: - ----- Method: PianoRollNoteMorph>>gridToPrevQuarter (in category 'editing') ----- - gridToPrevQuarter - - owner score gridTrack: trackIndex toQuarter: -1 at: indexInTrack. - owner rebuildFromScore! Item was removed: - ----- Method: PianoRollNoteMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ owner scorePlayer isPlaying not! Item was removed: - ----- Method: PianoRollNoteMorph>>indexInTrack (in category 'accessing') ----- - indexInTrack - - ^ indexInTrack! Item was removed: - ----- Method: PianoRollNoteMorph>>invokeNoteMenu: (in category 'menu') ----- - invokeNoteMenu: evt - "Invoke the note's edit menu." - - | menu | - menu := MenuMorph new defaultTarget: self. - menu addList: - #(('grid to next quarter' gridToNextQuarter) - ('grid to prev quarter' gridToPrevQuarter)). - - menu popUpEvent: evt in: self world. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - hitLoc := evt cursorPoint. - editMode := nil. - owner submorphsDo: - [:m | (m isKindOf: PianoRollNoteMorph) ifTrue: [m deselect]]. - selected := true. - self changed. - owner changed. - owner selection: (Array with: trackIndex with: indexInTrack with: indexInTrack). - self playSound! Item was removed: - ----- Method: PianoRollNoteMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - | delta offsetEvt | - editMode isNil - ifTrue: - ["First movement determines edit mode" - - ((delta := evt cursorPoint - hitLoc) dist: 0 @ 0) <= 2 - ifTrue: [^self "No significant movement yet."]. - delta x abs > delta y abs - ifTrue: - [delta x > 0 - ifTrue: - ["Horizontal drag" - - editMode := #selectNotes] - ifFalse: - [self playSound: nil. - offsetEvt := evt copy translateBy:(20 @ 0). - self invokeNoteMenu: offsetEvt]] - ifFalse: [editMode := #editPitch "Vertical drag"]]. - editMode == #editPitch ifTrue: [self editPitch: evt]. - editMode == #selectNotes ifTrue: [self selectNotes: evt]! Item was removed: - ----- Method: PianoRollNoteMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - self playSound: nil! Item was removed: - ----- Method: PianoRollNoteMorph>>noteInScore (in category 'note playing') ----- - noteInScore - - ^ (owner score tracks at: trackIndex) at: indexInTrack - ! Item was removed: - ----- Method: PianoRollNoteMorph>>noteOfDuration: (in category 'note playing') ----- - noteOfDuration: duration - - | note | - note := self noteInScore. - ^ (owner scorePlayer instrumentForTrack: trackIndex) - soundForMidiKey: note midiKey - dur: duration - loudness: (note velocity asFloat / 127.0) - ! Item was removed: - ----- Method: PianoRollNoteMorph>>playSound (in category 'note playing') ----- - playSound - "This STARTS a single long sound. It must be stopped by playing another or nil." - - ^ self playSound: (self soundOfDuration: 999.0)! Item was removed: - ----- Method: PianoRollNoteMorph>>playSound: (in category 'note playing') ----- - playSound: aSoundOrNil - - SoundPlaying ifNotNil: [SoundPlaying stopGracefully]. - SoundPlaying := aSoundOrNil. - SoundPlaying ifNotNil: [SoundPlaying play].! Item was removed: - ----- Method: PianoRollNoteMorph>>select (in category 'selecting') ----- - select - - selected ifTrue: [^ self]. - selected := true. - self changed! Item was removed: - ----- Method: PianoRollNoteMorph>>selectFrom: (in category 'selecting') ----- - selectFrom: selection - (trackIndex = selection first and: - [indexInTrack >= (selection second) and: [indexInTrack <= (selection third)]]) - ifTrue: [selected ifFalse: [self select]] - ifFalse: [selected ifTrue: [self deselect]]! Item was removed: - ----- Method: PianoRollNoteMorph>>selectNotes: (in category 'selecting') ----- - selectNotes: evt - - | lastMorph oldEnd saveOwner | - - saveOwner := owner. - (owner autoScrollForX: evt cursorPoint x) ifTrue: - ["If scroll talkes place I will be deleted and my x-pos will become invalid." - owner := saveOwner. - bounds := bounds withLeft: (owner xForTime: self noteInScore time)]. - oldEnd := owner selection last. - (owner notesInRect: (evt cursorPoint x @ owner top corner: owner bottomRight)) - do: [:m | m trackIndex = trackIndex ifTrue: [m deselect]]. - self select. - lastMorph := self. - (owner notesInRect: (self left @ owner top corner: evt cursorPoint x @ owner bottom)) - do: [:m | m trackIndex = trackIndex ifTrue: [m select. lastMorph := m]]. - owner selection: (Array with: trackIndex with: indexInTrack with: lastMorph indexInTrack). - lastMorph indexInTrack ~= oldEnd ifTrue: - ["Play last note as selection grows or shrinks" - owner ifNotNil: [lastMorph playSound]]. - owner changed. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>selected (in category 'selecting') ----- - selected - - ^ selected! Item was removed: - ----- Method: PianoRollNoteMorph>>soundOfDuration: (in category 'note playing') ----- - soundOfDuration: duration - - | sound | - sound := MixedSound new. - sound add: (self noteOfDuration: duration) - pan: (owner scorePlayer panForTrack: trackIndex) - volume: owner scorePlayer overallVolume * - (owner scorePlayer volumeForTrack: trackIndex). - ^ sound reset - ! Item was removed: - ----- Method: PianoRollNoteMorph>>trackIndex (in category 'accessing') ----- - trackIndex - - ^ trackIndex! Item was removed: - ----- Method: PianoRollNoteMorph>>trackIndex:indexInTrack: (in category 'initialization') ----- - trackIndex: ti indexInTrack: i - - trackIndex := ti. - indexInTrack := i. - selected := false! Item was removed: - RectangleMorph subclass: #PianoRollScoreMorph - instanceVariableNames: 'scorePlayer score colorForTrack lowestNote leftEdgeTime timeScale indexInTrack lastUpdateTick lastMutedState cursor selection timeSignature beatsPerMeasure notePerBeat showMeasureLines showBeatLines soundsPlaying soundsPlayingMorph movieClipPlayer' - classVariableNames: 'NotePasteBuffer' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! - - !PianoRollScoreMorph commentStamp: '<historical>' prior: 0! - A PianoRollScoreMorph displays a score such as a MIDIScore, and will scroll through it tracking the progress of a ScorePlayerMorph (from which it is usually spawned). - - timeScale is in pixels per score tick. - - Currently the ambient track (for synchronizing thumbnails, eg) is treated specially here and in the score. This should be cleaned up by adding a trackType or something like it in the score.! Item was removed: - ----- Method: PianoRollScoreMorph>>acceptDroppingMorph:event: (in category 'layout') ----- - acceptDroppingMorph: aMorph event: evt - "In addition to placing this morph in the pianoRoll, add a corresponding - event to the score so that it will always appear when played, in addition - to possibly triggering other actions" - - aMorph justDroppedIntoPianoRoll: self event: evt. - super acceptDroppingMorph: aMorph event: evt. - - ! Item was removed: - ----- Method: PianoRollScoreMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - - super addCustomMenuItems: aMenu hand: aHandMorph. - aMenu add: 'expand time' translated action: #expandTime. - aMenu add: 'contract time' translated action: #contractTime. - aMenu addLine. - aMenu add: 'add movie clip player' translated action: #addMovieClipPlayer. - (self valueOfProperty: #dragNDropEnabled) == true - ifTrue: [aMenu add: 'close drag and drop' translated action: #disableDragNDrop] - ifFalse: [aMenu add: 'open drag and drop' translated action: #enableDragNDrop]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>addKeyboard (in category 'menu') ----- - addKeyboard - - (KeyboardMorphForInput new pianoRoll: self) openInWorld! Item was removed: - ----- Method: PianoRollScoreMorph>>addNotes (in category 'drawing') ----- - addNotes - "Recompute the set of morphs that should be visible at the current scroll position." - - | visibleMorphs rightEdge topEdge rightEdgeTime | - visibleMorphs := OrderedCollection new: 500. - rightEdge := self right - self borderWidth. - rightEdgeTime := self timeForX: rightEdge. - topEdge := self top + self borderWidth + 1. - - "Add ambient morphs first (they will be front-most)" - score eventMorphsWithTimeDo: - [:m :t | m addMorphsTo: visibleMorphs pianoRoll: self eventTime: t - betweenTime: leftEdgeTime and: rightEdgeTime]. - - "Then add note morphs" - score tracks withIndexDo: - [:track :trackIndex | | done n i nRight nTop nLeft trackColor | - trackColor := colorForTrack at: trackIndex. - i := indexInTrack at: trackIndex. - done := scorePlayer mutedForTrack: trackIndex. - [done | (i > track size)] whileFalse: [ - n := track at: i. - (n isNoteEvent and: [n midiKey >= lowestNote]) ifTrue: [ - n time > rightEdgeTime - ifTrue: [done := true] - ifFalse: [ - nLeft := self xForTime: n time. - nTop := (self yForMidiKey: n midiKey) - 1. - nTop > topEdge ifTrue: [ - nRight := nLeft + (n duration * timeScale) truncated - 1. - visibleMorphs add: - ((PianoRollNoteMorph - newBounds: (nLeft at nTop corner: nRight@(nTop + 3)) - color: trackColor) - trackIndex: trackIndex indexInTrack: i)]]]. - i := i + 1]. - (selection notNil - and: [trackIndex = selection first - and: [i >= selection second and: [(indexInTrack at: trackIndex) <= selection third]]]) - ifTrue: [visibleMorphs do: - [:vm | (vm isKindOf: PianoRollNoteMorph) ifTrue: [vm selectFrom: selection]]]]. - - "Add the cursor morph in front of all notes; height and position are set later." - cursor ifNil: [cursor := Morph newBounds: (self topLeft extent: 1 at 1) color: Color red]. - visibleMorphs addFirst: cursor. - - self changed. - self removeAllMorphs. - self addAllMorphs: visibleMorphs. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>appendEvent:fullDuration: (in category 'editing') ----- - appendEvent: noteEvent fullDuration: fullDuration - - | sel x | - score appendEvent: noteEvent fullDuration: fullDuration at: (sel := self selection). - noteEvent midiKey = -1 ifFalse: "Unless it is a rest..." - ["Advance the selection to the note just entered" - selection := Array with: sel first with: sel third + 1 with: sel third + 1]. - - "This is all horribly inefficient..." - scorePlayer updateDuration. - (x := self xForTime: noteEvent endTime) > (self right - 30) ifTrue: - [self autoScrollForX: x + (30 + self width // 4)]. - self updateLowestNote. - self rebuildFromScore! Item was removed: - ----- Method: PianoRollScoreMorph>>autoScrollForX: (in category 'scrolling') ----- - autoScrollForX: x - "Scroll by the amount x lies outside of my innerBounds. Return true if this happens." - - | d ticks | - ((d := x - self innerBounds right) > 0 - or: [(d := x - self innerBounds left) < 0]) - ifTrue: [ticks := (self timeForX: self bounds center x + d+1) - min: score durationInTicks max: 0. - self moveCursorToTime: ticks. - scorePlayer ticksSinceStart: ticks. - ^ true]. - ^ false - ! Item was removed: - ----- Method: PianoRollScoreMorph>>beatLinesOnOff (in category 'menu') ----- - beatLinesOnOff - - showBeatLines := showBeatLines not. - self changed! Item was removed: - ----- Method: PianoRollScoreMorph>>beatsPerMeasure: (in category 'accessing') ----- - beatsPerMeasure: n - - ^ self timeSignature: n over: notePerBeat! Item was removed: - ----- Method: PianoRollScoreMorph>>contractTime (in category 'geometry') ----- - contractTime - - timeScale := timeScale / 1.5. - self rebuildFromScore. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>copySelection (in category 'editing') ----- - copySelection - selection isNil ifTrue: [^self]. - NotePasteBuffer := (score tracks at: selection first) - copyFrom: selection second - to: selection third! Item was removed: - ----- Method: PianoRollScoreMorph>>cutSelection (in category 'editing') ----- - cutSelection - selection isNil ifTrue: [^self]. - self copySelection. - self deleteSelection! Item was removed: - ----- Method: PianoRollScoreMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: PianoRollScoreMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: PianoRollScoreMorph>>deleteSelection (in category 'editing') ----- - deleteSelection - | selMorphs priorEvent x | - (selection isNil or: [selection second = 0]) ifTrue: [^self]. - score cutSelection: selection. - selection second > 1 - ifTrue: - [selection at: 2 put: selection second - 1. - selection at: 3 put: selection second. - priorEvent := (score tracks at: selection first) at: selection second. - (x := self xForTime: priorEvent time) < (self left + 30) - ifTrue: [self autoScrollForX: x - ((30 + self width) // 4)]] - ifFalse: [selection := nil]. - scorePlayer updateDuration. - self rebuildFromScore. - selMorphs := self - submorphsSatisfying: [:m | (m isKindOf: PianoRollNoteMorph) and: [m selected]]. - selMorphs isEmpty ifFalse: [(selMorphs last soundOfDuration: 0.3) play]! Item was removed: - ----- Method: PianoRollScoreMorph>>drawMeasureLinesOn: (in category 'drawing') ----- - drawMeasureLinesOn: aCanvas - - | ticksPerMeas x measureLineColor inner | - showBeatLines ifNil: [showBeatLines := false]. - showMeasureLines ifNil: [showMeasureLines := true]. - notePerBeat ifNil: [self timeSignature: 4 over: 4]. - showBeatLines ifTrue: - [measureLineColor := Color gray: 0.8. - ticksPerMeas := score ticksPerQuarterNote. - inner := self innerBounds. - (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) - to: ((self timeForX: self right - self borderWidth) truncateTo: ticksPerMeas) - by: ticksPerMeas - do: [:tickTime | x := self xForTime: tickTime. - aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) - color: measureLineColor]]. - - showMeasureLines ifTrue: - [measureLineColor := Color gray: 0.7. - ticksPerMeas := beatsPerMeasure*score ticksPerQuarterNote*4//notePerBeat. - inner := self innerBounds. - (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) - to: ((self timeForX: self right - self borderWidth) truncateTo: ticksPerMeas) - by: ticksPerMeas - do: [:tickTime | x := self xForTime: tickTime. - aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) - color: (tickTime = 0 ifTrue: [Color black] ifFalse: [measureLineColor])]]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - super drawOn: aCanvas. - self drawStaffOn: aCanvas. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>drawStaffOn: (in category 'drawing') ----- - drawStaffOn: aCanvas - - | blackKeyColor l r topEdge y | - self drawMeasureLinesOn: aCanvas. - - blackKeyColor := Color gray: 0.5. - l := self left + self borderWidth. - r := self right - self borderWidth. - topEdge := self top + self borderWidth + 3. - lowestNote to: 127 do: [:k | - y := self yForMidiKey: k. - y <= topEdge ifTrue: [^ self]. "over the top!!" - (self isBlackKey: k) ifTrue: [ - aCanvas - fillRectangle: (l at y corner: r@(y + 1)) - color: blackKeyColor]]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>expandTime (in category 'geometry') ----- - expandTime - - timeScale := timeScale * 1.5. - self rebuildFromScore. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>extent: (in category 'geometry') ----- - extent: aPoint - "Force rebuild when re-sized." - - super extent: aPoint. - score ifNotNil: [self updateLowestNote]. - self rebuildFromScore. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>fullBounds (in category 'layout') ----- - fullBounds - "Overridden to clip submorph hit detection to my bounds." - - fullBounds ifNil: [fullBounds := bounds]. - ^ bounds - ! Item was removed: - ----- Method: PianoRollScoreMorph>>goToTime: (in category 'scrolling') ----- - goToTime: scoreTime - - | track trackSize index newLeftEdgeTime | - newLeftEdgeTime := scoreTime asInteger. - newLeftEdgeTime < leftEdgeTime - ifTrue: [indexInTrack := Array new: score tracks size+1 withAll: 1]. - leftEdgeTime := newLeftEdgeTime. - 1 to: score tracks size do: [:trackIndex | - track := score tracks at: trackIndex. - index := indexInTrack at: trackIndex. - trackSize := track size. - [(index < trackSize) and: - [(track at: index) endTime < leftEdgeTime]] - whileTrue: [index := index + 1]. - indexInTrack at: trackIndex put: index]. - self addNotes. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ true! Item was removed: - ----- Method: PianoRollScoreMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - self extent: 400 @ 300. - showMeasureLines := true. - showBeatLines := false. - self timeSignature: 4 over: 4. - self clipSubmorphs: true! Item was removed: - ----- Method: PianoRollScoreMorph>>insertSelection (in category 'editing') ----- - insertSelection - self selection isNil ifTrue: [^self]. - score insertEvents: NotePasteBuffer at: self selection. - scorePlayer updateDuration. - self rebuildFromScore! Item was removed: - ----- Method: PianoRollScoreMorph>>insertTransposed (in category 'editing') ----- - insertTransposed - | delta transposedNotes | - (delta := UIManager default - chooseFrom: ((12 to: -12 by: -1) collect: [:i | i printString]) - values: ((12 to: -12 by: -1) collect: [:i | i printString]) - title: 'offset...') ifNil: [^self]. - transposedNotes := NotePasteBuffer - collect: [:note | note copy midiKey: note midiKey + delta]. - selection isNil ifTrue: [^self]. - score insertEvents: transposedNotes at: self selection. - scorePlayer updateDuration. - self rebuildFromScore! Item was removed: - ----- Method: PianoRollScoreMorph>>invokeScoreMenu: (in category 'menu') ----- - invokeScoreMenu: evt - "Invoke the score's edit menu." - - | menu subMenu | - menu := MenuMorph new defaultTarget: self. - menu addList: - {{'cut' translated. #cutSelection}. - {'copy' translated. #copySelection}. - {'paste' translated. #insertSelection}. - {'paste...' translated. #insertTransposed}}. - menu addLine. - menu addList: - {{'legato' translated. #selectionBeLegato}. - {'staccato' translated. #selectionBeStaccato}. - {'normal' translated. #selectionBeNormal}}. - menu addLine. - menu addList: - {{'expand time' translated. #expandTime}. - {'contract time' translated. #contractTime}}. - menu addLine. - subMenu := MenuMorph new defaultTarget: self. - (2 to: 12) do: [:i | subMenu add: i printString selector: #beatsPerMeasure: argument: i]. - menu add: 'time ' translated, beatsPerMeasure printString subMenu: subMenu. - subMenu := MenuMorph new defaultTarget: self. - #(2 4 8) do: [:i | subMenu add: i printString selector: #notePerBeat: argument: i]. - menu add: 'sig ' translated, notePerBeat printString subMenu: subMenu. - menu addLine. - showMeasureLines - ifTrue: [menu add: 'hide measure lines' translated action: #measureLinesOnOff] - ifFalse: [menu add: 'show measure lines' translated action: #measureLinesOnOff]. - showBeatLines - ifTrue: [menu add: 'hide beat lines' translated action: #beatLinesOnOff] - ifFalse: [menu add: 'show beat lines' translated action: #beatLinesOnOff]. - - menu addLine. - menu add: 'add keyboard' translated action: #addKeyboard. - - menu popUpEvent: evt in: self world. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>isBlackKey: (in category 'drawing') ----- - isBlackKey: midiKey - "Answer true if the given MIDI key corresponds to a black key on the piano keyboard." - - | note | - note := midiKey \\ 12. - note = 1 ifTrue: [^ true]. - note = 3 ifTrue: [^ true]. - note = 6 ifTrue: [^ true]. - note = 8 ifTrue: [^ true]. - note = 10 ifTrue: [^ true]. - ^ false - ! Item was removed: - ----- Method: PianoRollScoreMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - "Override this to avoid propagating 'layoutChanged' when just adding/removing note objects." - - fullBounds = bounds ifTrue: [^ self]. - super layoutChanged. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>measureLinesOnOff (in category 'menu') ----- - measureLinesOnOff - - showMeasureLines := showMeasureLines not. - self changed! Item was removed: - ----- Method: PianoRollScoreMorph>>midiKeyForY: (in category 'geometry') ----- - midiKeyForY: y - - ^ lowestNote - ((y - (bounds bottom - self borderWidth - 4)) // 3) - ! Item was removed: - ----- Method: PianoRollScoreMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - | noteMorphs chordRect | - (self notesInRect: ((evt cursorPoint extent: 1 at 0) expandBy: 2 at 30)) isEmpty - ifTrue: ["If not near a note, then put up score edit menu" - ^ self invokeScoreMenu: evt]. - - "Clicked near (but not on) a note, so play all notes at the cursor time" - noteMorphs := self notesInRect: ((evt cursorPoint extent: 1 at 0) expandBy: 0 at self height). - chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. - soundsPlayingMorph := Morph newBounds: chordRect color: Color green. - self addMorphBack: soundsPlayingMorph. - - soundsPlaying := IdentityDictionary new. - noteMorphs do: - [:m | | sound | sound := m soundOfDuration: 999.0. - soundsPlaying at: m put: sound. - SoundPlayer resumePlaying: sound quickStart: false]. - - ! Item was removed: - ----- Method: PianoRollScoreMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - | noteMorphs chordRect | - soundsPlaying ifNil: [^ self]. - self autoScrollForX: evt cursorPoint x. - - "Play all notes at the cursor time" - noteMorphs := self notesInRect: ((evt cursorPoint extent: 1 at 0) expandBy: 0 at self height). - chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. - soundsPlayingMorph delete. - soundsPlayingMorph := Morph newBounds: chordRect color: Color green. - self addMorphBack: soundsPlayingMorph. - - noteMorphs do: - [:m | | sound | "Add any new sounds" - (soundsPlaying includesKey: m) - ifFalse: [sound := m soundOfDuration: 999.0. - soundsPlaying at: m put: sound. - SoundPlayer resumePlaying: sound quickStart: false]]. - soundsPlaying keys do: - [:m | "Remove any sounds no longer in selection." - (noteMorphs includes: m) - ifFalse: [(soundsPlaying at: m) stopGracefully. - soundsPlaying removeKey: m]]. - - ! Item was removed: - ----- Method: PianoRollScoreMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - soundsPlayingMorph ifNotNil: [soundsPlayingMorph delete]. - soundsPlaying ifNotNil: [soundsPlaying do: [:s | s stopGracefully]]. - soundsPlayingMorph := soundsPlaying := nil - ! Item was removed: - ----- Method: PianoRollScoreMorph>>moveCursorToTime: (in category 'scrolling') ----- - moveCursorToTime: scoreTime - - | cursorOffset desiredCursorHeight | - scorePlayer isPlaying - ifTrue: - [cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger. - (cursorOffset < 0 - or: [cursorOffset > (self width-20)]) - ifTrue: - [self goToTime: scoreTime - (20/timeScale). - cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]] - ifFalse: - [self goToTime: (scoreTime - (self width//2 / timeScale) - max: (self width//10 / timeScale) negated). - cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]. - - cursor position: (self left + self borderWidth + cursorOffset)@(self top + self borderWidth). - desiredCursorHeight := self height. - cursor height ~= desiredCursorHeight ifTrue: [cursor extent: 1 at desiredCursorHeight]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>movieClipPlayer (in category 'accessing') ----- - movieClipPlayer - - ^ movieClipPlayer! Item was removed: - ----- Method: PianoRollScoreMorph>>movieClipPlayer: (in category 'accessing') ----- - movieClipPlayer: moviePlayer - - movieClipPlayer := moviePlayer - ! Item was removed: - ----- Method: PianoRollScoreMorph>>notePerBeat: (in category 'accessing') ----- - notePerBeat: n - - ^ self timeSignature: beatsPerMeasure over: n! Item was removed: - ----- Method: PianoRollScoreMorph>>notesInRect: (in category 'scrolling') ----- - notesInRect: timeSlice - - ^ self submorphsSatisfying: - [:m | (timeSlice intersects: m bounds) - and: [m isKindOf: PianoRollNoteMorph]]! Item was removed: - ----- Method: PianoRollScoreMorph>>on: (in category 'initialization') ----- - on: aScorePlayer - - scorePlayer := aScorePlayer. - score := aScorePlayer score. - colorForTrack := Color wheel: score tracks size. - leftEdgeTime := 0. - timeScale := 0.1. - indexInTrack := Array new: score tracks size withAll: 1. - lastUpdateTick := -1. - - self updateLowestNote - ! Item was removed: - ----- Method: PianoRollScoreMorph>>rebuildFromScore (in category 'drawing') ----- - rebuildFromScore - "Rebuild my submorphs from the score. This method should be invoked after changing the time scale, the color or visibility of a track, the extent of this morph, etc." - - score ifNil: [^ self]. - self addNotes. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>removedMorph: (in category 'private') ----- - removedMorph: aMorph - | trackSize | - trackSize := score ambientTrack size. - score removeAmbientEventWithMorph: aMorph. - trackSize = score ambientTrack size ifFalse: - ["Update duration if we removed an event" - scorePlayer updateDuration]. - ^super removedMorph: aMorph! Item was removed: - ----- Method: PianoRollScoreMorph>>score (in category 'accessing') ----- - score - - ^ score! Item was removed: - ----- Method: PianoRollScoreMorph>>scorePlayer (in category 'accessing') ----- - scorePlayer - - ^ scorePlayer! Item was removed: - ----- Method: PianoRollScoreMorph>>selection (in category 'accessing') ----- - selection - "Returns an array of 3 elements: - trackIndex - indexInTrack of first note - indexInTrack of last note" - - | trackIndex track | - selection ifNil: "If no selection, return last event of 1st non-muted track (or nil)" - [trackIndex := (1 to: score tracks size) - detect: [:i | (scorePlayer mutedForTrack: i) not] ifNone: [^ nil]. - track := score tracks at: trackIndex. - ^ Array with: trackIndex with: track size with: track size]. - (scorePlayer mutedForTrack: selection first) - ifTrue: [selection := nil. ^ self selection]. - ^ selection! Item was removed: - ----- Method: PianoRollScoreMorph>>selection: (in category 'accessing') ----- - selection: anArray - - selection := anArray! Item was removed: - ----- Method: PianoRollScoreMorph>>step (in category 'stepping and presenter') ----- - step - - | t | - score ifNil: [^ self]. - - lastMutedState ~= scorePlayer mutedState ifTrue: [ - self rebuildFromScore. - lastMutedState := scorePlayer mutedState copy]. - - t := scorePlayer ticksSinceStart. - t = lastUpdateTick ifFalse: [ - self moveCursorToTime: t. - lastUpdateTick := t]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^ 0 - ! Item was removed: - ----- Method: PianoRollScoreMorph>>tickTimeAtCursor (in category 'geometry') ----- - tickTimeAtCursor - cursor ifNil: [^ 0]. - ^ self timeForX: cursor left! Item was removed: - ----- Method: PianoRollScoreMorph>>timeForX: (in category 'geometry') ----- - timeForX: aNumber - - ^ ((aNumber - self left - self borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! Item was removed: - ----- Method: PianoRollScoreMorph>>timeScale (in category 'accessing') ----- - timeScale - - ^ timeScale "in pixels per tick"! Item was removed: - ----- Method: PianoRollScoreMorph>>timeSignature:over: (in category 'accessing') ----- - timeSignature: num over: denom - - beatsPerMeasure := num. - notePerBeat := denom. "a number like 2, 4, 8" - self changed! Item was removed: - ----- Method: PianoRollScoreMorph>>updateLowestNote (in category 'initialization') ----- - updateLowestNote - "find the actual lowest note in the score" - - - lowestNote := 128 - (self innerBounds height // 3). - score tracks do: [:track | | n | - 1 to: track size do: [:i | - n := track at: i. - (n isNoteEvent and: [n midiKey < lowestNote]) - ifTrue: [lowestNote := n midiKey - 4]]]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>xForTime: (in category 'geometry') ----- - xForTime: aNumber - - ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + self left + self borderWidth - ! Item was removed: - ----- Method: PianoRollScoreMorph>>yForMidiKey: (in category 'geometry') ----- - yForMidiKey: midiKey - - ^ (self bottom - self borderWidth - 4) - (3 * (midiKey - lowestNote)) - ! Item was removed: - Notification subclass: #PickAFileToWriteNotification - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Exceptions'! Item was removed: - ----- Method: Point>>encodePostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - encodePostscriptOn:aStream - aStream writePoint:self.! Item was removed: - ----- Method: PolygonMorph class>>curvePrototype (in category '*MorphicExtras-instance creation') ----- - curvePrototype - "Answer an instance of the receiver that will serve as a prototypical curve" - - | aa | - aa := self new. - aa vertices: (Array with: 0 at 80 with: 70 at 90 with: 60 at 0) - color: Color orange lighter - borderWidth: 4 - borderColor: Color black. - aa beSmoothCurve. - aa setNameTo: 'Curve'. - aa makeForwardArrow. "is already open" - aa computeBounds. - ^ aa - - " - PolygonMorph curvePrototype openInHand - "! Item was removed: - ----- Method: PolygonMorph class>>extraCircularVertices (in category '*MorphicExtras-examples') ----- - extraCircularVertices - - self flag: #note. "Cannot use Circle because it is in the ST80 package." - ^ {400 at 100. 477 at 115. 541 at 159. 585 at 223. 600 at 300. 600 at 300. 585 at 377. 541 at 441. 477 at 485. 400 at 500. 400 at 500. 438 at 492. 471 at 471. 492 at 438. 500 at 400. 500 at 400. 492 at 362. 471 at 329. 438 at 308. 400 at 300. 400 at 300. 362 at 292. 329 at 271. 308 at 238. 300 at 200. 300 at 200. 308 at 162. 329 at 129. 362 at 108. 400 at 100} - - " ^ ((Circle center: 400 @ 300 radius: 200 quadrant: 1) computeVertices: 5) reverse - , ((Circle center: 400 @ 300 radius: 200 quadrant: 4) computeVertices: 5) reverse - , ((Circle center: 400 @ 400 radius: 100 quadrant: 4) computeVertices: 5) - , ((Circle center: 400 @ 400 radius: 100 quadrant: 1) computeVertices: 5) - , ((Circle center: 400 @ 200 radius: 100 quadrant: 3) computeVertices: 5) reverse - , ((Circle center: 400 @ 200 radius: 100 quadrant: 2) computeVertices: 5) reverse"! Item was removed: - ----- Method: PolygonMorph class>>extraExampleTextFlow (in category '*MorphicExtras-examples') ----- - extraExampleTextFlow - "PolygonMorph extraExampleTextFlow openInHand" - - | polygon text obstacle | - polygon := self new. - polygon - setVertices: self extraCircularVertices; - extent: 309 asPoint; - beSmoothCurve; - color: Color lightGray; - addHandles. - - text := (TextMorph - string: 'TextMorphs can be chained together, causing their contents to flow between containers as either the contents or the containers change. If a TextMorph is embedded in another Morph, you can ask it to have fill the shape of that Morph. Moreover, you can ask it to avoid occlusions, in which case it will do its best to avoid collisions with siblings being in front of it. If a TextMorph is embedded in a CurveMorph, you can ask it to have the text follow the curve, as illustrated here.' asTextMorph - fontName: #BitstreamVeraSans - size: 14) - textColor: Color white; - fillsOwner: true; - yourself. - obstacle := StarMorph new - center: polygon center - (50 @ 25); - extent: 81 asPoint; - color: Color orchid; - yourself. - - polygon - addMorph: text; - addMorph: obstacle. - text centered. - text container avoidsOcclusions: true. - ^ polygon! Item was removed: - ----- Method: PolygonMorph class>>extraExampleTrapeze (in category '*MorphicExtras-examples') ----- - extraExampleTrapeze - "PolygonMorph extraExampleTrapeze openInHand" - - | polygon text | - polygon := self new. - polygon - setVertices: {0 @ 100. 275 @ 100. 200 @ 0. 75 @ 0}; - addHandles ; - balloonText: 'Click and drag the handles to change my shape'. - text := '<b>Polygons</b> can be closed or open, filled or empty as well as lined or convex and can have directed arrows, bevelled borders and last but not least adapted handles.' asTextFromHtml asMorph - beAllFont: (TextStyle default fontOfSize: 14); - fillsOwner: true; - yourself. - polygon addMorph: text. - text centered. - ^ polygon! Item was removed: - ----- Method: PolygonMorph class>>extraExampleTrapezePlus (in category '*MorphicExtras-examples') ----- - extraExampleTrapezePlus - "PolygonMorph extraExampleTrapezePlus openInHand" - "Some additional decoration" - - ^ self extraExampleTrapeze - fillStyle: ((GradientFillStyle - ramp: { 0.0 -> Color orange. 0.7 -> Color magenta twiceLighter. 1.0 -> Color red muchLighter }) - origin: 0 @ 0; direction: 275 @ 100; - yourself); - borderWidth: 2; - borderColor: Color blue; - dashedBorder: {35. 20. Color yellow}; - yourself! Item was removed: - ----- Method: PolygonMorph class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop} - forFlapNamed: 'Supplies'.]! Item was removed: - ----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') ----- - supplementaryPartsDescriptions - "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" - - ^ {DescriptionForPartsBin - formalName: 'Arrow' translatedNoop - categoryList: {'Graphics' translatedNoop} - documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop - globalReceiverSymbol: #PolygonMorph - nativitySelector: #arrowPrototype. - DescriptionForPartsBin - formalName: 'Triangle' translatedNoop - categoryList: {'Graphics' translatedNoop} - documentation: 'A three-sided polygon.' translatedNoop - globalReceiverSymbol: #PolygonMorph - nativitySelector: #trianglePrototype. - - DescriptionForPartsBin - formalName: 'Curve' translatedNoop - categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop} - documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop - globalReceiverSymbol: #PolygonMorph - nativitySelector: #curvePrototype. - } - - - ! Item was removed: - ----- Method: PolygonMorph class>>trianglePrototype (in category '*MorphicExtras-instance creation') ----- - trianglePrototype - "Answer an instance of the receiver that will serve as a prototypical triangle" - - | aa | - aa := self new. - aa vertices: {0.0 at 0.0. 138.0 at 0.0. -37.0@ -74.0} - color: (TranslucentColor r: 0.387 g: 1.0 b: 0.548 alpha: 0.463) - borderWidth: 3 - borderColor: Color black. - aa setProperty: #noNewVertices toValue: true. - aa setNameTo: 'Triangle'. - aa makeForwardArrow. "is already open" - aa computeBounds. - aa addHandles. - ^ aa - - " - PolygonMorph trianglePrototype openInHand - "! Item was removed: - ----- Method: PolygonMorph class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: PolygonMorph>>drawPostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - drawPostscriptOn: aCanvas - "Display the receiver, a spline curve, approximated by straight - line segments." - | array | - vertices size < 1 - ifTrue: [self error: 'a polygon must have at least one point']. - array := self drawArrowsOn: aCanvas. - closed - ifTrue: [aCanvas - drawPolygon: self getVertices - color: self color - borderWidth: self borderWidth - borderColor: self borderColor] - ifFalse: [self drawClippedBorderOn: aCanvas usingEnds: array]. - ! Item was removed: - ----- Method: PolygonMorph>>scale: (in category '*MorphicExtras-geometry eToy') ----- - scale: scaleFactor - | flex center ratio | - ratio := self scaleFactor / scaleFactor. - self borderWidth: ((self borderWidth / ratio) rounded max: 0). - center := self referencePosition. - flex := (MorphicTransform offset: center negated) - withScale: ratio. - self - setVertices: (vertices - collect: [:v | (flex transform: v) - - flex offset]). - super scale: scaleFactor.! Item was removed: - Canvas subclass: #PostscriptCanvas - instanceVariableNames: 'origin clipRect currentColor shadowColor currentFont morphLevel gstateStack fontMap usedFonts psBounds topLevelMorph initialScale savedMorphExtent currentTransformation printSpecs pages' - classVariableNames: 'FontMap' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! - - !PostscriptCanvas commentStamp: '<historical>' prior: 0! - I am a canvas that converts Morphic drawing messages into Postscript. The canvas itself does not actually generate the Postscript code, but rather sends messages corresponding 1:1 to the Postscript imaging model to its target (default: PostscriptEncoder), which has the job of generating actual drawing commands. - - PostscriptCharacterScanner and PostscriptDummyWarp are helper classes that simulate effects currently implemented via BitBlt-specific mechanisms during Postscript generation. They should be going away as Morphic becomes fully device independent. - - ! Item was removed: - ----- Method: PostscriptCanvas class>>baseOffset (in category 'configuring') ----- - baseOffset - ^0 at 0. - ! Item was removed: - ----- Method: PostscriptCanvas class>>convertFontName: (in category 'font mapping') ----- - convertFontName: aName - "Break apart aName on case boundaries, inserting hyphens as needed." - | lastCase | - lastCase := aName first isUppercase. - ^ String streamContents: [ :s | - aName do: [ :c | | thisCase | - thisCase := c isUppercase. - (thisCase and: [ lastCase not ]) ifTrue: [ s nextPut: $- ]. - lastCase := thisCase. - s nextPut: c ]]! Item was removed: - ----- Method: PostscriptCanvas class>>defaultCanvasType (in category 'configuring') ----- - defaultCanvasType - - ^Preferences postscriptStoredAsEPS ifTrue: [EPSCanvas] ifFalse: [DSCPostscriptCanvas]! Item was removed: - ----- Method: PostscriptCanvas class>>defaultExtension (in category 'configuring') ----- - defaultExtension - ^ '.ps'! Item was removed: - ----- Method: PostscriptCanvas class>>defaultTarget (in category 'configuring') ----- - defaultTarget - ^PostscriptEncoder stream. - ! Item was removed: - ----- Method: PostscriptCanvas class>>filterSelector (in category 'configuring') ----- - filterSelector - ^#fullDrawPostscriptOn:. - ! Item was removed: - ----- Method: PostscriptCanvas class>>fontMap (in category 'font mapping') ----- - fontMap - "Answer the font mapping dictionary. Made into a class var so that it can be edited." - ^FontMap ifNil: [ self initializeFontMap. FontMap ].! Item was removed: - ----- Method: PostscriptCanvas class>>fontSampler (in category 'font mapping') ----- - fontSampler - "Produces a Postscript .eps file on disk, returns a Morph." - "PostscriptCanvas fontSampler" - "PostscriptCanvas fontSampler openInWorld" - | morph file | - morph := Morph new - layoutPolicy: TableLayout new; - listDirection: #topToBottom; - wrapDirection: #leftToRight; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - color: Color white. - TextStyle actualTextStyles keysAndValuesDo: [ :styleName :style | - { style fontArray first. style fontArray last } do: [ :baseFont | | info | - 0 to: 2 do: [ :i | | font string string2 textMorph row | - font := baseFont emphasized: i. - (i isZero or: [ font ~~ baseFont ]) ifTrue: [ - string := font fontNameWithPointSize. - row := Morph new - layoutPolicy: TableLayout new; - listDirection: #topToBottom; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - cellGap: 20 at 0; - color: Color white. - - textMorph := TextMorph new hResizing: #spaceFill; backgroundColor: Color white; beAllFont: font; contentsAsIs: string. - row addMorphBack: (textMorph imageForm asMorph). - - info := self postscriptFontInfoForFont: font. - string2 := String streamContents: [ :stream | - stream nextPutAll: info first; space; print: (font pixelSize * info second) rounded. - ]. - textMorph := TextMorph new hResizing: #spaceFill; backgroundColor: Color white; beAllFont: font; contentsAsIs: string2. - row addMorphBack: textMorph. - - morph addMorphBack: row. - ] - ] - ] - ]. - morph bounds: Project current world bounds. - morph layoutChanged; fullBounds. - file := (FileDirectory default newFileNamed: 'PSFontSampler.eps'). - Cursor wait showWhile: [ - file nextPutAll: (EPSCanvas morphAsPostscript: morph) ]. - ^morph! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForAccuAt (in category 'font mapping') ----- - fontsForAccuAt - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - d := Dictionary new. - d - at: 0 put: #('Helvetica-Bold' 1.0); - at: 1 put: #('Helvetica-Bold' 1.0); - at: 2 put: #('Helvetica-BoldOblique' 1.0); - at: 3 put: #('Helvetica-BoldOblique' 1.0). - ^d! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForComicBold (in category 'font mapping') ----- - fontsForComicBold - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - d := Dictionary new. - d - at: 0 put: #('Helvetica-Narrow-Bold' 0.9); - at: 1 put: #('Helvetica-Narrow-Bold' 0.9); - at: 2 put: #('Helvetica-Narrow-BoldOblique' 0.9); - at: 3 put: #('Helvetica-Narrow-BoldOblique' 0.9). - ^d! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForComicPlain (in category 'font mapping') ----- - fontsForComicPlain - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - - "how do we do underlined??" - - d := Dictionary new. - d - at: 0 put: #('Helvetica-Narrow' 0.9); - at: 1 put: #('Helvetica-Narrow-Bold' 0.9); - at: 2 put: #('Helvetica-Narrow-Oblique' 0.9); - at: 3 put: #('Helvetica-Narrow-BoldOblique' 0.9). - ^d - ! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForDejaVuSans (in category 'font mapping') ----- - fontsForDejaVuSans - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - d := Dictionary new. - d - at: 0 put: #('Helvetica-Bold' 1.0); - at: 1 put: #('Helvetica-Bold' 1.0); - at: 2 put: #('Helvetica-Oblique' 1.0); - at: 3 put: #('Helvetica-BoldOblique' 1.0). - ^d! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForHelvetica (in category 'font mapping') ----- - fontsForHelvetica - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - d := Dictionary new. - d - at: 0 put: #('Helvetica' 1.0); - at: 1 put: #('Helvetica-Bold' 1.0); - at: 2 put: #('Helvetica-Oblique' 1.0); - at: 3 put: #('Helvetica-BoldOblique' 1.0); - at: 8 put: #('Helvetica-Narrow' 1.0); - at: 9 put: #('Helvetica-Narrow-Bold' 1.0); - at: 10 put: #('Helvetica-Narrow-Oblique' 1.0); - at: 11 put: #('Helvetica-Narrow-BoldOblique' 1.0). - ^d! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForNewYork (in category 'font mapping') ----- - fontsForNewYork - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - d := Dictionary new. - d - at: 0 put: #('Times-Roman' 1.0); - at: 1 put: #('Times-Bold' 1.0); - at: 2 put: #('Times-Italic' 1.0); - at: 3 put: #('Times-BoldItalic' 1.0); - at: 8 put: #('Helvetica-Narrow' 1.0); - at: 9 put: #('Helvetica-Narrow-Bold' 1.0); - at: 10 put: #('Helvetica-Narrow-Oblique' 1.0); - at: 11 put: #('Helvetica-Narrow-BoldOblique' 1.0). - ^d! Item was removed: - ----- Method: PostscriptCanvas class>>fontsForPalatino (in category 'font mapping') ----- - fontsForPalatino - - | d | - - "Bold = 1, Ital = 2, Under = 4, Narrow = 8, Struckout = 16" - d := Dictionary new. - d - at: 0 put: #('Palatino-Roman' 1.0); - at: 1 put: #('Palatino-Bold' 1.0); - at: 2 put: #('Palatino-Italic' 1.0); - at: 3 put: #('Palatino-BoldItalic' 1.0). - ^d - ! Item was removed: - ----- Method: PostscriptCanvas class>>initializeFontMap (in category 'font mapping') ----- - initializeFontMap - "Initialize the dictionary mapping font names to substitutions for Postscript code generation." - "PostscriptCanvas initializeFontMap" - | f | - FontMap := Dictionary new. - FontMap - at: 'NewYork' put: (f := self fontsForNewYork); - at: 'Accuny' put: f; - - at: 'Helvetica' put: (f := self fontsForHelvetica); - at: 'Accujen' put: f; - - at: 'Palatino' put: self fontsForPalatino; - - at: 'ComicBold' put: (f := self fontsForComicBold); - at: 'Accuat' put: self fontsForAccuAt; - - at: 'Bitmap DejaVu Sans' put: self fontsForDejaVuSans; - - at: 'ComicPlain' put: self fontsForComicPlain! Item was removed: - ----- Method: PostscriptCanvas class>>morphAsPostscript: (in category 'drawing') ----- - morphAsPostscript:aMorph - ^self morphAsPostscript:aMorph rotated:false offsetBy:self baseOffset. - ! Item was removed: - ----- Method: PostscriptCanvas class>>morphAsPostscript:rotated: (in category 'drawing') ----- - morphAsPostscript: aMorph rotated: rotateFlag - - ^ self morphAsPostscript: aMorph rotated: rotateFlag offsetBy: self baseOffset. - ! Item was removed: - ----- Method: PostscriptCanvas class>>morphAsPostscript:rotated:offsetBy: (in category 'drawing') ----- - morphAsPostscript:aMorph rotated:rotateFlag offsetBy:offset - | psCanvas | - psCanvas := self new. - psCanvas reset. - psCanvas bounds: (0 at 0 extent: (aMorph bounds extent + (2 * offset))). - psCanvas topLevelMorph:aMorph. - psCanvas resetContentRotated: rotateFlag. - psCanvas fullDrawMorph: aMorph . - ^psCanvas contents. - ! Item was removed: - ----- Method: PostscriptCanvas class>>postscriptFontInfoForFont: (in category 'font mapping') ----- - postscriptFontInfoForFont: font - - | decoded decodedName keys match fontName | - - fontName := font textStyleName asString. - decoded := TextStyle decodeStyleName: fontName. - decodedName := decoded second. - keys := self fontMap keys asArray sort: [ :a :b | a size > b size ]. - match := keys select: [ :k | decoded first = k or: [ fontName = k ] ]. - match do: [ :key | | subD desired mask | - subD := self fontMap at: key. - desired := font emphasis. - mask := 31. - [ - desired := desired bitAnd: mask. - subD at: desired ifPresent: [ :answer | ^answer]. - mask := mask bitShift: -1. - desired > 0 - ] whileTrue. - ]. - - "No explicit lookup found; try to convert the style name into the canonical Postscript name. - This name will probably still be wrong." - - fontName := String streamContents: [ :s | - s nextPutAll: decodedName. - decoded third do: [ :nm | s nextPut: $-; nextPutAll: nm ]. - - (font emphasis = 0 and: [ (decoded last includes: 0) not ]) - ifTrue: [ s nextPutAll: '-Regular' ]. - - (font emphasis = 1 and: [ (decoded first anyMask: 1) not ]) - ifTrue: [ s nextPutAll: '-Bold' ]. - - (font emphasis = 2 and: [ (decoded first anyMask: 2) not ]) - ifTrue: [ s nextPutAll: '-Italic' ]. - - (font emphasis = 3 and: [ (decoded first anyMask: 3) not ]) - ifTrue: [ s nextPutAll: '-BoldItalic' ]. - ]. - - ^ {'(', fontName, ') cvn'. 1.0} - ! Item was removed: - ----- Method: PostscriptCanvas class>>postscriptFontMappingSummary (in category 'font mapping') ----- - postscriptFontMappingSummary - " - Transcript nextPutAll: - PostscriptCanvas postscriptFontMappingSummary - ; endEntry - " - | stream | - stream := WriteStream on: (String new: 1000). - TextStyle actualTextStyles keysAndValuesDo: [ :styleName :style | - stream nextPutAll: styleName; cr. - style fontArray do: [ :baseFont | | info | - 0 to: 3 do: [ :i | | font | - font := baseFont emphasized: i. - font emphasis = i ifTrue: [ - stream tab; nextPutAll: font fontNameWithPointSize; tab. - info := self postscriptFontInfoForFont: font. - stream nextPutAll: info first; space; print: (font pixelSize * info second) rounded. - stream cr. - ] - ] - ] - ]. - ^stream contents! Item was removed: - ----- Method: PostscriptCanvas>>aaLevel: (in category 'balloon compatibility') ----- - aaLevel:newLevel - "ignore "! Item was removed: - ----- Method: PostscriptCanvas>>asBalloonCanvas (in category 'balloon compatibility') ----- - asBalloonCanvas - ^self.! Item was removed: - ----- Method: PostscriptCanvas>>bounds: (in category 'private') ----- - bounds:newBounds - psBounds := newBounds. - ! Item was removed: - ----- Method: PostscriptCanvas>>canBlendAlpha (in category 'testing') ----- - canBlendAlpha - ^false! Item was removed: - ----- Method: PostscriptCanvas>>clip (in category 'private') ----- - clip - ^target clip. - ! Item was removed: - ----- Method: PostscriptCanvas>>clipBy:during: (in category 'drawing-support') ----- - clipBy: aRectangle during: aBlock - ^self translateBy: 0 at 0 clippingTo: aRectangle during: aBlock. - ! Item was removed: - ----- Method: PostscriptCanvas>>clipRect (in category 'accessing') ----- - clipRect - ^clipRect. - ! Item was removed: - ----- Method: PostscriptCanvas>>closepath (in category 'private') ----- - closepath - ^target closepath. - - - ! Item was removed: - ----- Method: PostscriptCanvas>>comment: (in category 'private') ----- - comment:aString - target comment:aString. - ! Item was removed: - ----- Method: PostscriptCanvas>>comment:with: (in category 'private') ----- - comment: aString with: anObject - target comment:aString with:anObject. - ! Item was removed: - ----- Method: PostscriptCanvas>>contentsOfArea:into: (in category 'accessing') ----- - contentsOfArea: aRectangle into: aForm - "not supported for PS canvas" - ! Item was removed: - ----- Method: PostscriptCanvas>>defaultFont (in category 'private') ----- - defaultFont - ^ TextStyle defaultFont! Item was removed: - ----- Method: PostscriptCanvas>>deferred: (in category 'balloon compatibility') ----- - deferred: ignored! Item was removed: - ----- Method: PostscriptCanvas>>defineFont: (in category 'private') ----- - defineFont: aFont - - | psNameFor alreadyRemapped | - - (usedFonts includesKey: aFont) ifFalse:[ - psNameFor := self postscriptFontNameForFont: aFont. - alreadyRemapped := usedFonts includes: psNameFor. - usedFonts at: aFont put: psNameFor. - " here: define as Type-3 unless we think its available " - " or, just remap" - - " I had some problems if same font remapped twice" - alreadyRemapped ifFalse: [target remapFontForSqueak: psNameFor]. - ].! Item was removed: - ----- Method: PostscriptCanvas>>definePathProcIn:during: (in category 'drawing-support') ----- - definePathProcIn: pathBlock during: duringBlock - "Bracket the output of pathBlock (which is passed the receiver) in - gsave - newpath - <pathBlock> - closepath - <duringBlock> - grestore - " - ^self - preserveStateDuring: [:tgt | - | retval | - self comment: 'begin pathProc path block'. - target newpath. - pathBlock value: tgt. - target closepath. - self comment: 'begin pathProc during block'. - retval := duringBlock value: tgt. - self comment: 'end pathProc'. - retval].! Item was removed: - ----- Method: PostscriptCanvas>>doesRoundedCorners (in category 'testing') ----- - doesRoundedCorners - - ^ false! Item was removed: - ----- Method: PostscriptCanvas>>draw: (in category 'drawing-general') ----- - draw: anObject - ^anObject drawPostscriptOn: self! Item was removed: - ----- Method: PostscriptCanvas>>drawGeneralBezierShape:color:borderWidth:borderColor: (in category 'balloon compatibility') ----- - drawGeneralBezierShape: shapeArray color: color borderWidth: borderWidth borderColor: borderColor - "shapeArray is an array of: - arrays of points, each of which must have - a multiple of 3 points in it. - This method tries to sort the provided triplets so that curves that - start and end at the same point are together." - | groups fillC where triplets | - fillC := self shadowColor - ifNil: [color]. - shapeArray isEmpty - ifTrue: [^ self]. - where := nil. - groups := OrderedCollection new. - triplets := OrderedCollection new. - shapeArray - do: [:arr | arr - groupsOf: 3 - atATimeDo: [:bez | - | rounded | - rounded := bez roundTo: 0.001. - (where isNil - or: [where = rounded first]) - ifFalse: [groups addLast: triplets. - triplets := OrderedCollection new]. - triplets addLast: rounded. - where := rounded last]]. - groups addLast: triplets. - triplets := OrderedCollection new. - "now try to merge stray groups" - groups copy - do: [:g1 | | g2 | - g1 first first = g1 last last - ifFalse: ["not closed" - g2 := groups - detect: [:g | g ~~ g1 - and: [g1 last last = g first first]] - ifNone: []. - g2 - ifNotNil: [groups remove: g2. - groups add: g2 after: g1]]]. - groups - do: [:g | triplets addAll: g]. - where := nil. - self - definePathProcIn: [ :cvs | - triplets do: [:shape | - where ~= shape first - ifTrue: [where - ifNotNil: [cvs closepath]. - cvs moveto: shape first]. - where := cvs outlineQuadraticBezierShape: shape]] - during: [ :cvs | - cvs clip. - cvs setLinewidth: borderWidth "*2"; - fill: fillC andStroke: borderColor]! Item was removed: - ----- Method: PostscriptCanvas>>drawGradient: (in category 'private') ----- - drawGradient: fillColor - self comment: 'not-solid fill ' with: fillColor. - self comment: ' origin ' with: fillColor origin. - self comment: ' direction ' with: fillColor direction. - self fill: fillColor asColor! Item was removed: - ----- Method: PostscriptCanvas>>drawOval:color:borderWidth:borderColor: (in category 'balloon compatibility') ----- - drawOval: r color: c borderWidth: borderWidth borderColor: borderColor - | fillC | - fillC := self shadowColor ifNil:[c]. - ^ self fillOval: r color: fillC borderWidth: borderWidth borderColor: borderColor - - - - ! Item was removed: - ----- Method: PostscriptCanvas>>drawPage: (in category 'private') ----- - drawPage:aMorph - self fullDrawMorph:aMorph. - ! Item was removed: - ----- Method: PostscriptCanvas>>drawPages: (in category 'private') ----- - drawPages:collectionOfPages - collectionOfPages do:[ :page | - pages := pages + 1. - target print:'%%Page: '; write:pages; space; write:pages; cr. - self drawPage:page. - ]. - morphLevel = 0 ifTrue: [ self writeTrailer: pages ].! Item was removed: - ----- Method: PostscriptCanvas>>drawPolygon:color:borderWidth:borderColor: (in category 'drawing-polygons') ----- - drawPolygon: vertices color: aColor borderWidth: bw borderColor: bc - | fillC | - fillC := self shadowColor ifNil:[aColor]. - self - preserveStateDuring: [:pc | pc - outlinePolygon: vertices; - setLinewidth: bw; - - fill: fillC - andStroke: (bc isSymbol - ifTrue: [Color gray] - ifFalse: [bc])]! Item was removed: - ----- Method: PostscriptCanvas>>drawPostscriptContext: (in category 'private') ----- - drawPostscriptContext: subCanvas - | contents | - (contents := subCanvas contents) ifNil: [^ self]. - ^ target comment: ' sub-canvas start'; - preserveStateDuring: [:inner | inner print: contents]; - comment: ' sub-canvas stop'. - - ! Item was removed: - ----- Method: PostscriptCanvas>>drawRectangle:color:borderWidth:borderColor: (in category 'balloon compatibility') ----- - drawRectangle: r color: color borderWidth: borderWidth borderColor: borderColor - - | fillC | - fillC := self shadowColor - ifNil: [color]. - ^ self - frameAndFillRectangle: r - fillColor: fillC - borderWidth: borderWidth - borderColor: borderColor! Item was removed: - ----- Method: PostscriptCanvas>>drawString:from:to:in:font:color: (in category 'drawing-text') ----- - drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c - | fillC oldC | - fillC := self shadowColor - ifNil: [c]. - self setFont: (fontOrNil - ifNil: [self defaultFont]). - self comment: ' text color: ' , c printString. - oldC := currentColor. - self setColor: fillC. - self comment: ' boundsrect origin ' , boundsRect origin printString. - self comment: ' origin ' , origin printString. - self moveto: boundsRect origin. - target print: ' ('; - print: (s asString copyFrom: firstIndex to: lastIndex) asPostscript; - print: ') show'; - cr. - self setColor: oldC.! Item was removed: - ----- Method: PostscriptCanvas>>drawString:from:to:in:font:color:background: (in category 'drawing-text') ----- - drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c background: b - target preserveStateDuring: [ :t | self fillRectangle: boundsRect color: b ]. - self drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c ! Item was removed: - ----- Method: PostscriptCanvas>>endGStateForMorph: (in category 'private') ----- - endGStateForMorph: aMorph - - morphLevel = 1 - ifTrue: [ target showpage; print: 'grestore'; cr ]! Item was removed: - ----- Method: PostscriptCanvas>>fill: (in category 'private') ----- - fill: fillColor - fillColor isSolidFill - ifTrue: [self paint: fillColor asColor operation: #eofill] - ifFalse: [self preserveStateDuring: [:inner | inner clip; drawGradient: fillColor]]! Item was removed: - ----- Method: PostscriptCanvas>>fill:andStroke: (in category 'private') ----- - fill: fillColor andStroke: strokeColor - self preserveStateDuring: [:inner | inner fill: fillColor]; - stroke: strokeColor. - ! Item was removed: - ----- Method: PostscriptCanvas>>fillColor: (in category 'drawing') ----- - fillColor:aColor - self rect:clipRect; fill:aColor. - ! Item was removed: - ----- Method: PostscriptCanvas>>fillOval:color:borderWidth:borderColor: (in category 'drawing-ovals') ----- - fillOval: r color: c borderWidth: borderWidth borderColor: borderColor - self preserveStateDuring: - [:inner | - inner oval: r; - setLinewidth: borderWidth; - fill: c andStroke: borderColor]. - - - - - ! Item was removed: - ----- Method: PostscriptCanvas>>fillRectangle:color: (in category 'drawing-rectangles') ----- - fillRectangle: r color: c - self rect:r; fill:c.! Item was removed: - ----- Method: PostscriptCanvas>>fillRectangle:fillStyle: (in category 'drawing-rectangles') ----- - fillRectangle: aRectangle fillStyle: aFillStyle - "Fill the given rectangle." - | pattern | - - (aFillStyle isKindOf: InfiniteForm) ifTrue: [ - ^self infiniteFillRectangle: aRectangle fillStyle: aFillStyle - ]. - - aFillStyle isSolidFill ifTrue:[^self fillRectangle: aRectangle color: aFillStyle asColor]. - - "We have a very special case for filling with infinite forms" - (aFillStyle isBitmapFill and:[aFillStyle origin = (0 at 0)]) ifTrue:[ - pattern := aFillStyle form. - (aFillStyle direction = (pattern width @ 0) - and:[aFillStyle normal = (0 at pattern height)]) ifTrue:[ - "Can use an InfiniteForm" - ^self fillRectangle: aRectangle color: (InfiniteForm with: pattern)]. - ]. - - "Use a BalloonCanvas instead PROBABLY won't work here" - "self balloonFillRectangle: aRectangle fillStyle: aFillStyle." - - ^self fillRectangle: aRectangle color: aFillStyle asColor! Item was removed: - ----- Method: PostscriptCanvas>>frameAndFillRectangle:fillColor:borderWidth:borderColor: (in category 'drawing-rectangles') ----- - frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth borderColor: borderColor - "since postscript strokes on the line and squeak strokes inside, we need - to adjust inwards" - self - preserveStateDuring: [:pc | pc - - rect: (r insetBy: borderWidth / 2); - setLinewidth: borderWidth; - fill: fillColor andStroke: borderColor]! Item was removed: - ----- Method: PostscriptCanvas>>frameAndFillRectangle:fillColor:borderWidth:topLeftColor:bottomRightColor: (in category 'drawing-rectangles') ----- - frameAndFillRectangle: r fillColor: fillColor borderWidth: borderWidth topLeftColor: topLeftColor bottomRightColor: bottomRightColor - self - preserveStateDuring: [:pc | - target newpath. - pc setLinewidth: 0. - pc outlinePolygon: {r origin. r topRight. r topRight + (borderWidth negated @ borderWidth). r origin + (borderWidth @ borderWidth). r bottomLeft + (borderWidth @ borderWidth negated). r bottomLeft. r origin}; - fill: topLeftColor andStroke: topLeftColor. - target newpath. - pc outlinePolygon: {r topRight. r bottomRight. r bottomLeft. r bottomLeft + (borderWidth @ borderWidth negated). r bottomRight - (borderWidth @ borderWidth). r topRight + (borderWidth negated @ borderWidth). r topRight}; - fill: bottomRightColor andStroke: bottomRightColor]! Item was removed: - ----- Method: PostscriptCanvas>>frameRectangle:width:color: (in category 'drawing-rectangles') ----- - frameRectangle: r width: w color: c - self rect:r; stroke:c. - - ! Item was removed: - ----- Method: PostscriptCanvas>>fullDraw: (in category 'drawing-general') ----- - fullDraw: aMorph - self comment: 'start morph: ' with: aMorph. - self comment: 'level: ' with: morphLevel. - self comment: 'bounds: ' with: aMorph bounds. - self comment: 'corner: ' with: aMorph bounds corner. - morphLevel := morphLevel + 1. - self setupGStateForMorph: aMorph. - aMorph fullDrawPostscriptOn: self. - self endGStateForMorph: aMorph. - morphLevel := morphLevel - 1. - self comment: 'end morph: ' with: aMorph. - self comment: 'level: ' with: morphLevel. - ! Item was removed: - ----- Method: PostscriptCanvas>>fullDrawBookMorph: (in category 'drawing-general') ----- - fullDrawBookMorph:aBookMorph - ^aBookMorph fullDrawOn:self. - ! Item was removed: - ----- Method: PostscriptCanvas>>image:at:sourceRect:rule: (in category 'private') ----- - image: form at: aPoint sourceRect: sourceRect rule: rule - | aForm | - self preserveStateDuring: - [:inner | inner translate: aPoint + self origin. - aForm := form depth <= 8 ifTrue: [form asFormOfDepth: 32] ifFalse: [form]. - target write: ((aForm colorsUsed includes: Color transparent) - ifTrue: [| top f2 c2 offset | - "tfel: This was taken from SketchMorph, but is actually needed for all - forms that use transparency" - offset := currentTransformation ifNil: [0 at 0] ifNotNil: [:t | t offset]. - top := self topLevelMorph. - f2 := Form extent: aForm extent depth: self depth. - c2 := f2 getCanvas. - c2 fillColor: Color white. - c2 - translateBy: offset - self origin - aPoint - clippingTo: f2 boundingBox - during: [:c | top fullDrawOn: c]. - f2] - ifFalse: [aForm])]. - ! Item was removed: - ----- Method: PostscriptCanvas>>infiniteFillRectangle:fillStyle: (in category 'balloon compatibility') ----- - infiniteFillRectangle: aRectangle fillStyle: aFillStyle - - self flag: #bob. "need to fix this" - - "^aFillStyle - displayOnPort: (port clippedBy: aRectangle) - at: aRectangle origin - origin" - ! Item was removed: - ----- Method: PostscriptCanvas>>isPostscriptCanvas (in category 'testing') ----- - isPostscriptCanvas - ^true! Item was removed: - ----- Method: PostscriptCanvas>>isShadowDrawing (in category 'accessing') ----- - isShadowDrawing - ^shadowColor notNil! Item was removed: - ----- Method: PostscriptCanvas>>line:to:brushForm: (in category 'drawing') ----- - line: pt1 to: pt2 brushForm: brush - " to do: set brushform " - self moveto:pt1; lineto:pt2; stroke:currentColor. - - ! Item was removed: - ----- Method: PostscriptCanvas>>line:to:width:color: (in category 'drawing') ----- - line: pt1 to: pt2 width: w color: c - self setLinewidth:w; moveto:pt1; lineto:pt2; stroke:c. - ! Item was removed: - ----- Method: PostscriptCanvas>>lineto: (in category 'private') ----- - lineto:aPoint - ^target lineto:aPoint. - - - ! Item was removed: - ----- Method: PostscriptCanvas>>moveto: (in category 'private') ----- - moveto:aPoint - ^target moveto:aPoint. - - - ! Item was removed: - ----- Method: PostscriptCanvas>>origin (in category 'accessing') ----- - origin - ^origin. - ! Item was removed: - ----- Method: PostscriptCanvas>>outlinePolygon: (in category 'private') ----- - outlinePolygon: vertices - target moveto: (vertices first). - 2 to: vertices size do: [:i | target lineto: (vertices at: i)]. - target closepath! Item was removed: - ----- Method: PostscriptCanvas>>outlineQuadraticBezierShape: (in category 'private') ----- - outlineQuadraticBezierShape: vertices - | where | - 3 - to: vertices size - by: 3 - do: [:i | - | v1 v2 v3 | - v1 := (vertices at: i - 2) roundTo: 0.001. - v2 := (vertices at: i - 1) roundTo: 0.001. - v3 := (vertices at: i) roundTo: 0.001. - (v1 = v2 - or: [v2 = v3]) - ifTrue: [target lineto: v3] - ifFalse: [target - curvetoQuadratic: v3 - from: v1 - via: v2]. - where := v3]. - ^where! Item was removed: - ----- Method: PostscriptCanvas>>oval: (in category 'private') ----- - oval:aPoint - ^target oval:aPoint.! Item was removed: - ----- Method: PostscriptCanvas>>paint:operation: (in category 'private') ----- - paint:color operation:operation - self setColor:color. - currentColor isTransparent ifFalse:[target perform:operation] ifTrue:[target newpath]. - - ! Item was removed: - ----- Method: PostscriptCanvas>>paragraph:bounds:color: (in category 'drawing') ----- - paragraph: para bounds: bounds color: c - | displayablePara | - self comment:'paragraph with bounds: ' with:bounds. - displayablePara := para asParagraphForPostscript. - self preserveStateDuring: - [:inner | - displayablePara displayOn: inner - using: (PostscriptCharacterScanner - scannerWithCanvas: self paragraph: displayablePara bounds: bounds) - at: bounds topLeft] - ! Item was removed: - ----- Method: PostscriptCanvas>>postscriptFontNameForFont: (in category 'private') ----- - postscriptFontNameForFont: font - - ^(self class postscriptFontInfoForFont: font) first - ! Item was removed: - ----- Method: PostscriptCanvas>>preserveStateDuring: (in category 'drawing-support') ----- - preserveStateDuring: aBlock - ^target preserveStateDuring: [ :innerTarget | - | retval saveClip saveTransform | - saveClip := clipRect. - saveTransform := currentTransformation. - gstateStack addLast: currentFont. - gstateStack addLast: currentColor. - gstateStack addLast: shadowColor. - retval := aBlock value: self. - shadowColor := gstateStack removeLast. - currentColor := gstateStack removeLast. - currentFont := gstateStack removeLast. - clipRect := saveClip. - currentTransformation := saveTransform. - retval - ].! Item was removed: - ----- Method: PostscriptCanvas>>printContentsOn: (in category 'private') ----- - printContentsOn: aStream - ^ aStream nextPutAll: target contents! Item was removed: - ----- Method: PostscriptCanvas>>psSize (in category 'private') ----- - psSize - ^ target size! Item was removed: - ----- Method: PostscriptCanvas>>rect: (in category 'private') ----- - rect:aRect - ^target rect:aRect. - ! Item was removed: - ----- Method: PostscriptCanvas>>reset (in category 'initialization') ----- - reset - super reset. - origin := 0 @ 0. "origin of the top-left corner of this canvas" - clipRect := 0 @ 0 corner: 10000 @ 10000. "default clipping rectangle" - currentTransformation := nil. - morphLevel := 0. - pages := 0. - gstateStack := OrderedCollection new. - usedFonts := Dictionary new. - initialScale := 1.0. - shadowColor := nil. - currentColor := nil! Item was removed: - ----- Method: PostscriptCanvas>>resetContentRotated: (in category 'private') ----- - resetContentRotated: rotateFlag - target := self class defaultTarget. - self writeHeaderRotated: rotateFlag. - ^self.! Item was removed: - ----- Method: PostscriptCanvas>>setColor: (in category 'private') ----- - setColor: color - (color notNil and: [ currentColor ~= color ]) ifTrue: - [ target write: color asColor. - currentColor := color ]! Item was removed: - ----- Method: PostscriptCanvas>>setFont: (in category 'private') ----- - setFont:aFont - - | fInfo | - - aFont = currentFont ifTrue: [^self]. - currentFont := aFont. - self defineFont: aFont. - fInfo := self class postscriptFontInfoForFont: aFont. - - target - selectflippedfont: fInfo first - size: (aFont pixelSize * fInfo second) - ascent: aFont ascent. - ! Item was removed: - ----- Method: PostscriptCanvas>>setLinewidth: (in category 'private') ----- - setLinewidth: width - target setLinewidth: width. - ! Item was removed: - ----- Method: PostscriptCanvas>>setOrigin:clipRect: (in category 'balloon compatibility') ----- - setOrigin: aPoint clipRect: aRectangle - self comment:'new origin: ' with:aPoint. - target rectclip:aRectangle. - self translate:aPoint - origin. - - " self grestore; gsave. - - self write:aRectangle. - target print:' textclip'; cr. - target print:'% new offset '. - target write:aPoint. - target cr. - " super setOrigin: aPoint clipRect: aRectangle. - ! Item was removed: - ----- Method: PostscriptCanvas>>setupGStateForMorph: (in category 'private') ----- - setupGStateForMorph: aMorph - - morphLevel = 1 - ifTrue: [self writePageSetupFor: aMorph]! Item was removed: - ----- Method: PostscriptCanvas>>shadowColor (in category 'accessing') ----- - shadowColor - ^shadowColor! Item was removed: - ----- Method: PostscriptCanvas>>shadowColor: (in category 'accessing') ----- - shadowColor: aColor - shadowColor := aColor.! Item was removed: - ----- Method: PostscriptCanvas>>stencil:at:color: (in category 'drawing-images') ----- - stencil: stencilForm at: aPoint color: aColor - target comment:' imagemask'. - ! Item was removed: - ----- Method: PostscriptCanvas>>stroke: (in category 'private') ----- - stroke: strokeColor - strokeColor ifNil: [^self]. - strokeColor isSymbol - ifTrue: [^self paint: Color gray operation: #stroke "punt"]. - strokeColor isSolidFill - ifTrue: [^self paint: strokeColor asColor operation: #stroke]. - self preserveStateDuring: - [:inner | - inner - strokepath; - fill: strokeColor]! Item was removed: - ----- Method: PostscriptCanvas>>strokepath (in category 'private') ----- - strokepath - ^target strokepath. - - - ! Item was removed: - ----- Method: PostscriptCanvas>>text:at:font:color:spacePad: (in category 'private') ----- - text: s at: point font: fontOrNil color: c spacePad: pad - "Potentially deprecated, no senders in 5.3, seems to have been replaced by textStyled:..." - | fillC oldC | - fillC := self shadowColor - ifNil: [c]. - self - setFont: (fontOrNil - ifNil: [self defaultFont]). - self comment: ' text color: ' , c printString. - oldC := currentColor. - self setColor: fillC. - self comment: ' origin ' , origin printString. - self moveto: point. - target write: pad; - print: ' 0 32 ('; - print: s asPostscript; - print: ') widthshow'; - cr. - self setColor: oldC.! Item was removed: - ----- Method: PostscriptCanvas>>textStyled:at:font:color:justified:parwidth: (in category 'private') ----- - textStyled: s at: ignored0 font: ignored1 color: c justified: justify parwidth: parwidth - | fillC oldC | - fillC := c. - self shadowColor - ifNotNil: [:sc | - self comment: ' shadow color: ' , sc printString. - fillC := sc]. - self comment: ' text color: ' , c printString. - oldC := currentColor. - self setColor: fillC. - self comment: ' origin ' , origin printString. - "self moveto: point." - "now done by sender" - target print: ' ('; - print: s asPostscript; - print: ') '. - justify - ifTrue: [target write: parwidth; - print: ' jshow'; - cr] - ifFalse: [target print: 'show']. - target cr. - self setColor: oldC.! Item was removed: - ----- Method: PostscriptCanvas>>topLevelMorph (in category 'private') ----- - topLevelMorph - ^topLevelMorph - ! Item was removed: - ----- Method: PostscriptCanvas>>topLevelMorph: (in category 'private') ----- - topLevelMorph:newMorph - topLevelMorph := newMorph. - ! Item was removed: - ----- Method: PostscriptCanvas>>transformBy: (in category 'balloon compatibility') ----- - transformBy:aMatrix - ("aMatrix isPureTranslation" false) ifTrue:[ - target translate:aMatrix offset negated. - ] ifFalse:[ - target concat:aMatrix. - ]. - ^self. - ! Item was removed: - ----- Method: PostscriptCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') ----- - transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize - | retval oldShadow | - oldShadow := shadowColor. - self comment: 'drawing clipped ' with: aClipRect. - self comment: 'drawing transformed ' with: aDisplayTransform. - retval := self - preserveStateDuring: [:inner | - currentTransformation - ifNil: [currentTransformation := aDisplayTransform] - ifNotNil: [currentTransformation := currentTransformation composedWithLocal: aDisplayTransform]. - aClipRect - ifNotNil: [clipRect := aDisplayTransform - globalBoundsToLocal: (clipRect intersect: aClipRect). - inner rect: aClipRect; - clip]. - inner transformBy: aDisplayTransform. - aBlock value: inner]. - self comment: 'end of drawing clipped ' with: aClipRect. - shadowColor := oldShadow. - ^ retval! Item was removed: - ----- Method: PostscriptCanvas>>transformBy:during: (in category 'balloon compatibility') ----- - transformBy:aTransform during:aBlock - ^self transformBy:aTransform clippingTo: nil during:aBlock! Item was removed: - ----- Method: PostscriptCanvas>>translate: (in category 'private') ----- - translate:aPoint - ^target translate:aPoint. - - - ! Item was removed: - ----- Method: PostscriptCanvas>>translateBy:clippingTo:during: (in category 'other') ----- - translateBy: delta clippingTo: aRect during: aBlock - self comment:'translateBy: ' with:delta. - ^self transformBy:(MatrixTransform2x3 withOffset:delta) clippingTo:aRect during:aBlock. - - ! Item was removed: - ----- Method: PostscriptCanvas>>translateBy:during: (in category 'drawing-support') ----- - translateBy: delta during: aBlock - "Set a translation only during the execution of aBlock." - - | result oldShadow | - oldShadow := shadowColor. - self translate: delta. - result := aBlock value: self. - self translate: delta negated. - shadowColor := oldShadow. - ^ result - ! Item was removed: - ----- Method: PostscriptCanvas>>warpFrom:toRect: (in category 'balloon compatibility') ----- - warpFrom: sourceQuad toRect: innerRect - "^PostscriptDummyWarp canvas:self."! Item was removed: - ----- Method: PostscriptCanvas>>writeGlobalSetup: (in category 'private') ----- - writeGlobalSetup: rotateFlag - target print: '%%EndProlog'; - cr. - target print: '%%BeginSetup'; - cr. - target print: '% initialScale: '; - write: initialScale; - cr. - target print: '% pageBBox: '; write: self pageBBox; cr. - - target print: '% pageOffset'; - cr. - target translate: self pageOffset. - rotateFlag - ifTrue: ["no translate needed for 0,0 = upper LH corner of page" - target print: '90 rotate'; - cr; - print: '0 0 translate'; - cr] - ifFalse: [target write: 0 @ topLevelMorph height * initialScale; - print: ' translate'; - cr]. - target print: '% flip'; - cr. - target scale: initialScale @ initialScale negated; - print: ' [ {true setstrokeadjust} stopped ] pop'; - cr. - target print: '%%EndSetup'; - cr! Item was removed: - ----- Method: PostscriptCanvas>>writeHeaderRotated: (in category 'private') ----- - writeHeaderRotated: rotateFlag - self writePSIdentifierRotated: rotateFlag. - self writeProcset. - self writeGlobalSetup: rotateFlag.! Item was removed: - ----- Method: PostscriptCanvas>>writePSIdentifierRotated: (in category 'private') ----- - writePSIdentifierRotated: rotateFlag - "NB: rotation not yet supported" - - target print:'%!!'; cr.! Item was removed: - ----- Method: PostscriptCanvas>>writePageSetupFor: (in category 'private') ----- - writePageSetupFor: aMorph - - target print: '%%BeginPageSetup'; cr. - target print: 'gsave'; cr. - target translate: aMorph bounds origin negated. - target print: '%%EndPageSetup'; - cr! Item was removed: - ----- Method: PostscriptCanvas>>writeProcset (in category 'private') ----- - writeProcset - target print:' - - %%BeginProcset: Squeak-Level2-Emulation - /level1 /languagelevel where { - pop languagelevel 2 lt - } {true } ifelse def - level1 - { - /rectclip { - 4 2 roll moveto - 1 index 0 rlineto - 0 exch rlineto - neg 0 rlineto closepath - clip newpath - } bind def - /setcolorspace { pop } bind def - /makeDict { - counttomark 2 idiv dup dict begin - { def } repeat - currentdict end exch pop - } bind def - /defaultDict [ /MultipleDataSources false makeDict def - /image { - dup type /dicttype eq { - defaultDict begin - begin - Width - Height - BitsPerComponent - ImageMatrix - /DataSource load MultipleDataSources { aload pop } if MultipleDataSources - Decode length 2 idiv - end - end - } if - colorimage - currentfile ( ) readstring pop pop - } bind def - - /_imagemask /imagemask load def - /imagemask { - dup type /dicttype eq { - begin - Width - Height - Decode 0 get 1 eq - ImageMatrix - /DataSource load - end - } if - _imagemask - currentfile ( ) readstring pop pop - } bind def - /transparentimage { - pop image - } bind def - - } { - /makeDict { >> } bind def - /transparentimage { - gsave - 32 dict begin - /tinteger exch def - /transparent 1 string def - transparent 0 tinteger put - /olddict exch def - olddict /DataSource get dup type /filetype ne { - olddict /DataSource 3 -1 roll 0 () /SubFileDecode filter put - } { - pop - } ifelse - /newdict olddict maxlength dict def - olddict newdict copy pop - /w newdict /Width get def - /str w string def - /substrlen 2 w log 2 log div floor exp cvi def - /substrs [ - { - substrlen string - 0 1 substrlen 1 sub { - 1 index exch tinteger put - } for - /substrlen substrlen 2 idiv def - substrlen 0 eq {exit} if - } loop - ] def - /h newdict /Height get def - 1 w div 1 h div matrix scale - olddict /ImageMatrix get exch matrix concatmatrix - matrix invertmatrix concat - newdict /Height 1 put - newdict /DataSource str put - /mat [w 0 0 h 0 0] def - newdict /ImageMatrix mat put - 0 1 h 1 sub { - mat 5 3 -1 roll neg put - olddict /DataSource get str readstring pop pop - /tail str def - /x 0 def - { - tail transparent search dup /done exch not def - {exch pop exch pop} if - /w1 1 index length def - w1 0 ne { - newdict /DataSource 3 -1 roll put - newdict /Width w1 put - mat 4 x neg put - /x x w1 add def - newdict image - /tail tail w1 tail length w1 sub getinterval def - } if - done {exit} if - tail substrs { - anchorsearch {pop} if - } forall - /tail exch def - tail length 0 eq {exit} if - /x w tail length sub def - } loop - } for - end - grestore - } bind def - } ifelse - - %%EndProcset - %%BeginProcset: Squeak-Printing - /_showpageSqueak /showpage load def - /showpage { gsave _showpageSqueak grestore } bind def - /countspaces { - [ exch { dup 32 ne { pop } if } forall ] length - } bind def - /jshow { - 10 dict begin - /width exch def - /str exch def - str length 0 gt { - str dup length 1 sub get 32 eq { /str str dup length 1 sub 0 exch getinterval def } if - /strw str stringwidth pop def - /diffwidth width strw sub def - /numspaces str countspaces def - numspaces 0 eq { /numspaces 1 def } if - /adjspace width strw sub numspaces div def - /adjchar 0 def - diffwidth 0 lt { - /adjspace adjspace 0.2 mul def - /adjchar diffwidth str length div 0.8 mul def - } if - adjspace 0 32 adjchar 0 str awidthshow - - } if - end - } bind def - - /copydict { - dup length dict begin - { 1 index /FID eq 2 index /UniqueID eq and {pop pop} { def } ifelse } forall - currentdict end - } bind def - /getSymbolcharproc { - 1 dict begin - /charstring exch def - [ 550 0 0 0 650 600 /setcachedevice cvx 50 100 /translate cvx /pop cvx - 1 dict begin /setbbox { pop pop pop } bind def currentdict end /begin cvx - - gsave /Symbol 600 selectfont 0 0 moveto charstring false charpath false upath grestore - - /exec cvx /fill cvx /end cvx ] cvx bind - end - } bind def - /adjustFontForSqueak % converts _ to left-arrow, ^to upArrow and tab -> 4 spaces - { - gsave dup 1000 selectfont - dup dup findfont copydict - begin - CharStrings - /CharStrings exch copydict - dup /leftarrow (\254) getSymbolcharproc put - dup /uparrow (\255) getSymbolcharproc put - dup /tab [ /pop cvx ( ) stringwidth pop 6 mul 0 0 0 0 0 /setcachedevice cvx ] cvx bind put - def - /Encoding Encoding dup length array copy - dup 94 /uparrow put - dup 95 /leftarrow put - dup 9 /tab put - def - currentdict end definefont pop pop - grestore - } bind def - - %%EndProcset - '. - ! Item was removed: - ----- Method: PostscriptCanvas>>writeTrailer: (in category 'morph drawing') ----- - writeTrailer: somePages - target - print: '%%Trailer'; - cr. - usedFonts isEmpty - ifFalse: - [target print: '%%DocumentFonts:'. - usedFonts values asSet do: - [:f | - target - space; - print: f]. - target cr]. - target print:'%%Pages: '; write: somePages; cr. - target - print: '%%EOF'; - cr! Item was removed: - Object subclass: #PostscriptCharacterScanner - instanceVariableNames: 'canvas paragraph bounds curPos font foregroundColor emphasis' - classVariableNames: '' - poolDictionaries: 'TextConstants' - category: 'MorphicExtras-Postscript Canvases'! - - !PostscriptCharacterScanner commentStamp: '<historical>' prior: 0! - I am a simple character scanner that forwards text-drawing commands to my canvas. Despite the name, it should also work with other Canvases that actually implement the text-drawing commands (which the basic FormCanvas does not). - - Style text support currently includes color, centering, fonts and emphasis. Not yet supported are embedded objects, full justification and probably some others as well. - - Tabs aren't supported properly, but rather hacked in the Postscript Header provided by PostscriptCanvas to be equivalent to 4 space. - - mpw. - ! Item was removed: - ----- Method: PostscriptCharacterScanner class>>scannerWithCanvas:paragraph:bounds: (in category 'instance creation') ----- - scannerWithCanvas:aCanvas paragraph:aParagraph bounds:newBounds - ^self new canvas:aCanvas; paragraph:aParagraph; bounds:newBounds. - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>addEmphasis: (in category 'textstyle support') ----- - addEmphasis: emphasisCode - - emphasis := emphasis bitOr: emphasisCode.! Item was removed: - ----- Method: PostscriptCharacterScanner>>addKern: (in category 'textstyle support') ----- - addKern: kern - " canvas comment:'kern now: ',kern printString. " - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>bounds: (in category 'accessing') ----- - bounds:newBounds - bounds:=newBounds. - curPos:=newBounds origin. - - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>canvas (in category 'accessing') ----- - canvas - ^canvas. - - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>canvas: (in category 'accessing') ----- - canvas:newCanvas - canvas:=newCanvas. - - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>defaultFont (in category 'accessing') ----- - defaultFont - ^ TextStyle defaultFont! Item was removed: - ----- Method: PostscriptCharacterScanner>>displayLine:offset:leftInRun: (in category 'displaying') ----- - displayLine: line offset: baseOffset leftInRun: leftInRun - | offset aText string doJustified | - - self setTextStylesForOffset: ((line first) + 1). " sets up various instance vars from text styles " - offset := baseOffset. - offset := offset + (line left @ (line top + line baseline - self font ascent )). - offset := offset + ((self textStyle alignment caseOf:{ - [Centered] -> [ line paddingWidth /2 ]. - [RightFlush] -> [ line paddingWidth ] } otherwise:[0]) @ 0). - - canvas moveto: offset. - - aText := paragraph text copyFrom: line first to: line last. - doJustified := (paragraph textStyle alignment = Justified) - and: [ (paragraph text at:line last) ~= Character cr - and: [aText runs runs size = 1]]. - string := aText string. - aText runs withStartStopAndValueDo: [:start :stop :attributes | | s drawFont | - self setTextStylesForOffset: (start + line first - 1). " sets up inst vars from text styles " - s := string copyFrom: start to: stop. - drawFont := self font. - canvas setFont: drawFont. - canvas - textStyled: s - at: offset "<--now ignored" - font: drawFont "<--now ignored" - color: foregroundColor - justified: doJustified "<-can't do this now for multi-styles" - parwidth: line right - line left. - ]. - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>font (in category 'accessing') ----- - font - ^ font ifNil:[self defaultFont].! Item was removed: - ----- Method: PostscriptCharacterScanner>>indentationLevel: (in category 'textstyle support') ----- - indentationLevel: amount - " canvas comment:'indentation level ',amount printString. " - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>paragraph (in category 'accessing') ----- - paragraph - ^paragraph. - - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>paragraph: (in category 'accessing') ----- - paragraph:newPara - paragraph:=newPara. - - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>setActualFont: (in category 'textstyle support') ----- - setActualFont: newFont - font := newFont.! Item was removed: - ----- Method: PostscriptCharacterScanner>>setAlignment: (in category 'textstyle support') ----- - setAlignment: alignment - self paragraph textStyle alignment: alignment.! Item was removed: - ----- Method: PostscriptCharacterScanner>>setDestForm: (in category 'accessing') ----- - setDestForm:destForm - "dummy" - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>setFont: (in category 'textstyle support') ----- - setFont: fontNumber - self setActualFont:(self textStyle fontAt:fontNumber). - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>setTextStylesForOffset: (in category 'textstyle support') ----- - setTextStylesForOffset:offset - " default text style " - font := self textStyle defaultFont. - emphasis := 0. - foregroundColor := Color black. - - " set text styles defined at this point, these methods will set instance vars of myself " - (paragraph text attributesAt: offset forStyle: paragraph textStyle) do: - [:att | att emphasizeScanner: self]. - - " post-processing of 'emphasis' " - self setActualFont: (font emphasized: emphasis)! Item was removed: - ----- Method: PostscriptCharacterScanner>>textColor: (in category 'textstyle support') ----- - textColor: aColor - foregroundColor := aColor. - ! Item was removed: - ----- Method: PostscriptCharacterScanner>>textStyle (in category 'accessing') ----- - textStyle - ^paragraph textStyle. - ! Item was removed: - Object subclass: #PostscriptDummyWarp - instanceVariableNames: 'canvas subCanvas transform' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! - - !PostscriptDummyWarp commentStamp: '<historical>' prior: 0! - I simulate the effects of having a WarpBlit done in Postscript, by simply adjusting the coordinate system. - ! Item was removed: - ----- Method: PostscriptDummyWarp class>>canvas: (in category 'instance creation') ----- - canvas:aCanvas - ^self new canvas:aCanvas.! Item was removed: - ----- Method: PostscriptDummyWarp>>canvas (in category 'dummy') ----- - canvas - ^canvas - ! Item was removed: - ----- Method: PostscriptDummyWarp>>canvas: (in category 'dummy') ----- - canvas:newCanvas - canvas := newCanvas. - ! Item was removed: - ----- Method: PostscriptDummyWarp>>cellSize: (in category 'dummy') ----- - cellSize:newCellSize - ^self.! Item was removed: - ----- Method: PostscriptDummyWarp>>colorMap: (in category 'dummy') ----- - colorMap:aMap - ! Item was removed: - ----- Method: PostscriptDummyWarp>>combinationRule: (in category 'dummy') ----- - combinationRule:newRule - ^self.! Item was removed: - ----- Method: PostscriptDummyWarp>>drawPostscriptContext: (in category 'dummy') ----- - drawPostscriptContext:aCanvas - canvas drawPostscriptContext:aCanvas. - - - ! Item was removed: - ----- Method: PostscriptDummyWarp>>preserveStateDuring: (in category 'dummy') ----- - preserveStateDuring: aBlock - - ^ canvas preserveStateDuring: - "Note block arg must be self so various things get overridden properly" - [:inner | aBlock value: self] - - ! Item was removed: - ----- Method: PostscriptDummyWarp>>sourceForm: (in category 'dummy') ----- - sourceForm:newForm - ^self.! Item was removed: - ----- Method: PostscriptDummyWarp>>sourceQuad:destRect: (in category 'dummy') ----- - sourceQuad:aQuad destRect:aRect - ! Item was removed: - ----- Method: PostscriptDummyWarp>>subCanvas: (in category 'dummy') ----- - subCanvas:patchRect - subCanvas ifNil: - [ subCanvas := PostscriptCanvas new reset setOrigin:patchRect topLeft clipRect: (-10000 @ -10000 extent: 20000 @ 20000)]. - ^subCanvas. - - ! Item was removed: - ----- Method: PostscriptDummyWarp>>transform (in category 'dummy') ----- - transform - ^transform. - ! Item was removed: - ----- Method: PostscriptDummyWarp>>transform: (in category 'dummy') ----- - transform:newTransform - transform := newTransform. - ^self. - ! Item was removed: - ----- Method: PostscriptDummyWarp>>transformBy: (in category 'dummy') ----- - transformBy:aTransform - canvas transformBy:aTransform. - - - ! Item was removed: - ----- Method: PostscriptDummyWarp>>warpBits (in category 'dummy') ----- - warpBits - canvas preserveStateDuring: - [:inner | - transform ifNotNil: [inner transformBy: transform]. - inner drawPostscriptContext:subCanvas]. - ! Item was removed: - PrintableEncoder subclass: #PostscriptEncoder - instanceVariableNames: '' - classVariableNames: 'MacToPSCharacterMappings' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! - - !PostscriptEncoder commentStamp: '<historical>' prior: 0! - I translate the message protocol generated by PostscriptCanvas that represents the Postscript imaging model into an actual stream of ASCII-encoded Postscript Level 2. - - Alternative implementations might provide binary representations, Level I or Level III or even PDF. - - - ! Item was removed: - ----- Method: PostscriptEncoder class>>clearCharacterMappings (in category 'configuring') ----- - clearCharacterMappings - - MacToPSCharacterMappings := nil.! Item was removed: - ----- Method: PostscriptEncoder class>>filterSelector (in category 'configuring') ----- - filterSelector - ^#encodePostscriptOn:.! Item was removed: - ----- Method: PostscriptEncoder class>>macToPSCharacterChart (in category 'configuring') ----- - macToPSCharacterChart - "mac char code, PS char code" - ^#( - (128 999) "Ä" - (129 999) "Å" - (130 999) "Ç" - (131 999) "É" - (132 999) "Ñ" - (133 999) "Ö" - (134 999) "Ü" - (135 999) "á" - (136 999) "à" - (137 999) "â" - (138 999) "ä" - (139 999) "ã" - (140 999) "å" - (141 999) "ç" - (142 999) "é" - (143 999) "è" - (144 999) "ê" - (145 999) "ë" - (146 999) "í" - (147 999) "ì" - (148 999) "î" - (149 999) "ï" - (150 999) "ñ" - (151 999) "ó" - (152 999) "ò" - (153 999) "ô" - (154 999) "ö" - (155 999) "õ" - (156 999) "ú" - (157 999) "ù" - (158 999) "û" - (159 999) "ü" - (160 999) "†" - (161 202) "°" - (162 162) "¢" - (163 163) "£" - (164 167) "§" - (165 183) "·" - (166 182) "¶" - (167 251) "ß" - (168 999) "®" - (169 999) "©" - (170 999) "™" - (171 999) "´" - (172 999) "¨" - (173 999) "€" - (174 225) "Æ" - (175 999) "Ø" - (176 999) "" - (177 999) "±" - (178 999) "Š" - (179 999) "" - (180 165) "¥" - (181 999) "µ" - (182 999) "Ž" - (183 999) "" - (184 999) "" - (185 999) "š" - (186 999) "" - (187 227) "ª" - (188 235) "º" - (189 999) "ž" - (190 241) "æ" - (191 999) "ø" - (192 191) "¿" - (193 166) "¡" - (194 999) "¬" - (195 999) "¦" - (196 999) "ƒ" - (197 999) "" - (198 999) "²" - (199 171) "«" - (200 187) "»" - (201 188) "…" - (202 999) " " - (203 999) "À" - (204 999) "Ã" - (205 999) "Õ" - (206 234) "Œ" - (207 250) "œ" - (208 999) "–" - (209 999) "—" - (210 999) "“" - (211 999) "”" - (212 999) "‘" - (213 999) "’" - (214 999) "÷" - (215 999) "³" - (216 999) "ÿ" - (217 999) "Ÿ" - (218 999) "¹" - (219 999) "¤" - (220 999) "‹" - (221 999) "›" - (222 999) "¼" - (223 999) "½" - (224 999) "‡" - (225 999) "·" - (226 999) "‚" - (227 999) "„" - (228 999) "‰" - (229 999) "Â" - (230 999) "Ê" - (231 999) "Á" - (232 999) "Ë" - (233 999) "È" - (234 999) "Í" - (235 999) "Î" - (236 999) "Ï" - (237 999) "Ì" - (238 999) "Ó" - (239 999) "Ô" - (240 999) "¾" - (241 999) "Ò" - (242 999) "Ú" - (243 999) "Û" - (244 999) "Ù" - (245 999) "Ð" - (246 999) "ˆ" - (247 999) "˜" - (248 999) "¯" - (249 999) "×" - (250 999) "Ý" - (251 999) "Þ" - (252 999) "¸" - (253 999) "ð" - (254 999) "ý" - (255 999) "þ" - )! Item was removed: - ----- Method: PostscriptEncoder class>>mapMacStringToPS: (in category 'configuring') ----- - mapMacStringToPS: aString - - | copy | - MacToPSCharacterMappings ifNil: [ - MacToPSCharacterMappings := Array new: 256. - self macToPSCharacterChart do: [ :pair | - pair second = 999 ifFalse: [MacToPSCharacterMappings at: pair first put: pair second] - ]. - ]. - copy := aString copy. - copy withIndexDo: [ :ch :index | - | val | - (val := ch asciiValue) > 127 ifTrue: [ - | newVal | - (newVal := MacToPSCharacterMappings at: val) ifNotNil: [ - copy at: index put: newVal asCharacter - ]. - ]. - ]. - ^copy! Item was removed: - ----- Method: PostscriptEncoder>>clip (in category 'Postscript generation') ----- - clip - self print: 'clip'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>closepath (in category 'Postscript generation') ----- - closepath - self print:'closepath'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>comment: (in category 'Postscript generation') ----- - comment:aString - self print:'%'; print:aString; cr. - - ! Item was removed: - ----- Method: PostscriptEncoder>>comment:with: (in category 'Postscript generation') ----- - comment:aString with:anObject - self print:'%'; print:aString; print:' '; write:anObject; cr. - - ! Item was removed: - ----- Method: PostscriptEncoder>>concat: (in category 'Postscript generation') ----- - concat:aMatrix - self write:aMatrix asMatrixTransform2x3; print:' concat'; cr. - - ! Item was removed: - ----- Method: PostscriptEncoder>>curvetoQuadratic:from:via: (in category 'Postscript generation') ----- - curvetoQuadratic:targetPoint from:sourcePoint via:offPoint - self write:(sourcePoint + offPoint) / 2; print:' '; - write:(offPoint + targetPoint) / 2; print:' '; - write:targetPoint; - print:' curveto'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>eofill (in category 'Postscript generation') ----- - eofill - self print: 'eofill'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>fill (in category 'Postscript generation') ----- - fill - self print:'fill'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>lineto: (in category 'Postscript generation') ----- - lineto:aPoint - self write:aPoint; print:' lineto'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>moveto: (in category 'Postscript generation') ----- - moveto:aPoint - self write:aPoint; print:' moveto'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>newpath (in category 'Postscript generation') ----- - newpath - self print: 'newpath'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>oval: (in category 'Postscript generation') ----- - oval: aPoint - self print: 'matrix currentmatrix'; cr; - write: (aPoint extent // 2); space; - write: aPoint topLeft; - print: ' newpath translate scale 1 1 1 0 360 arc setmatrix'; cr - ! Item was removed: - ----- Method: PostscriptEncoder>>preserveStateDuring: (in category 'Postscript generation') ----- - preserveStateDuring: aBlock - "Note that this method supplies self, an encoder, to the block" - | retval | - self print: 'gsave'; - cr. - retval := aBlock value: self. - self print: 'grestore'; - cr. - ^ retval! Item was removed: - ----- Method: PostscriptEncoder>>rect: (in category 'Postscript generation') ----- - rect: aRect - - self newpath. - self - moveto:aRect topLeft; - lineto:aRect topRight x @ aRect topRight y; - lineto:aRect bottomRight x @ aRect bottomRight y; - lineto:aRect bottomLeft x @ aRect bottomLeft y; - closepath. - ! Item was removed: - ----- Method: PostscriptEncoder>>rectclip: (in category 'Postscript generation') ----- - rectclip:aRect - self write:aRect; print:' rectclip'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>rectfill: (in category 'Postscript generation') ----- - rectfill:aRect - self write:aRect; print:' rectfill'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>remapFontForSqueak: (in category 'Postscript generation') ----- - remapFontForSqueak:aFontName - self print:'/'; print:aFontName; print:' adjustFontForSqueak'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>safeGrestore (in category 'Postscript generation') ----- - safeGrestore - self print:'{ grestore } stopped pop'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>scale: (in category 'Postscript generation') ----- - scale:aPoint - self write:aPoint; print:' scale'; cr. - - ! Item was removed: - ----- Method: PostscriptEncoder>>selectflippedfont:size: (in category 'Postscript generation') ----- - selectflippedfont:fontname size:size - self selectflippedfont:fontname size:size ascent:size. - - ! Item was removed: - ----- Method: PostscriptEncoder>>selectflippedfont:size:ascent: (in category 'Postscript generation') ----- - selectflippedfont:fontname size:size ascent:ascent - self print:'/'; print:fontname; space; - print:'[ '; write:size; print:' 0 0 ';write:size negated; print:' 0 '; write:ascent; print:'] selectfont'; cr. - - ! Item was removed: - ----- Method: PostscriptEncoder>>selectfont:size: (in category 'Postscript generation') ----- - selectfont:fontname size:size - self print:'/'; print:fontname; space; write:size; print:' selectfont'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>setLinewidth: (in category 'Postscript generation') ----- - setLinewidth:width - self write:width; print:' setlinewidth';cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>setrgbcolor: (in category 'Postscript generation') ----- - setrgbcolor:aColor - self write:aColor red; space; - write:aColor green; space; - write:aColor blue; - print:' setrgbcolor'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>showpage (in category 'Postscript generation') ----- - showpage - self print:'showpage'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>stroke (in category 'Postscript generation') ----- - stroke - self print:'stroke'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>strokepath (in category 'Postscript generation') ----- - strokepath - self print:'strokepath'; cr. - ! Item was removed: - ----- Method: PostscriptEncoder>>translate: (in category 'Postscript generation') ----- - translate:aPoint - self write:aPoint; print:' translate'; cr. - - ! Item was removed: - ----- Method: PostscriptEncoder>>writeMatrix: (in category 'Postscript generation') ----- - writeMatrix:m - self print:'['; - write:m a11; print:' '; - write:m a21; print:' '; - write:m a12; print:' '; - write:m a22; print:' '; - write:m a13; print:' '; - write:m a23; print:'] '. - - ! Item was removed: - ----- Method: PostscriptEncoder>>writeNumber: (in category 'writing') ----- - writeNumber:aNumber - super writeNumber:(aNumber isInteger ifTrue:[aNumber] ifFalse:[aNumber roundTo:0.001]). - ! Item was removed: - ----- Method: PostscriptEncoder>>writePoint: (in category 'Postscript generation') ----- - writePoint:aPoint - self write:aPoint x; space; write:aPoint y. - ! Item was removed: - PostscriptEncoder subclass: #PostscriptEncoderToDisk - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Canvases'! Item was removed: - ----- Method: PostscriptEncoderToDisk class>>stream (in category 'creation') ----- - stream - - ^self new initWithTarget: PickAFileToWriteNotification signal - ! Item was removed: - ----- Method: Preferences class>>rotationAndScaleHandlesInPaintBox (in category '*morphicextras') ----- - rotationAndScaleHandlesInPaintBox - ^ true! Item was removed: - Object subclass: #PrintSpecifications - instanceVariableNames: 'landscapeFlag drawAsBitmapFlag scaleToFitPage' - classVariableNames: 'DefaultSpecs' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: PrintSpecifications class>>defaultSpecs (in category 'accessing') ----- - defaultSpecs - - DefaultSpecs ifNil: [DefaultSpecs := self new]. - ^DefaultSpecs copy! Item was removed: - ----- Method: PrintSpecifications class>>defaultSpecs: (in category 'accessing') ----- - defaultSpecs: aPrintSpecification - - DefaultSpecs := aPrintSpecification! Item was removed: - ----- Method: PrintSpecifications>>drawAsBitmapFlag (in category 'acccessing') ----- - drawAsBitmapFlag - - ^drawAsBitmapFlag ifNil: [false]! Item was removed: - ----- Method: PrintSpecifications>>drawAsBitmapFlag: (in category 'acccessing') ----- - drawAsBitmapFlag: aBoolean - - drawAsBitmapFlag := aBoolean! Item was removed: - ----- Method: PrintSpecifications>>initialize (in category 'initialize-release') ----- - initialize - - landscapeFlag := false. - scaleToFitPage := false. - drawAsBitmapFlag := false. - ! Item was removed: - ----- Method: PrintSpecifications>>landscapeFlag (in category 'acccessing') ----- - landscapeFlag - - ^landscapeFlag ifNil: [false]! Item was removed: - ----- Method: PrintSpecifications>>landscapeFlag: (in category 'acccessing') ----- - landscapeFlag: aBoolean - - landscapeFlag := aBoolean! Item was removed: - ----- Method: PrintSpecifications>>scaleToFitPage (in category 'acccessing') ----- - scaleToFitPage - - ^scaleToFitPage ifNil: [false]! Item was removed: - ----- Method: PrintSpecifications>>scaleToFitPage: (in category 'acccessing') ----- - scaleToFitPage: aBoolean - - scaleToFitPage := aBoolean! Item was removed: - ByteEncoder subclass: #PrintableEncoder - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Postscript Filters'! Item was removed: - ----- Method: PrintableEncoder>>writeNumber:base: (in category 'writing') ----- - writeNumber:aNumber base:aBase - aBase ~= self numberDefaultBase ifTrue:[ self write:aBase; print:'r']. - ^super writeNumber:aNumber base:aBase. - ! Item was removed: - BorderedMorph subclass: #ProgressBarMorph - instanceVariableNames: 'value progressColor lastValue' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: ProgressBarMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu addList: { - {'progress color...' translated. #changeProgressColor:}. - {'progress value...' translated. #changeProgressValue:}. - }! Item was removed: - ----- Method: ProgressBarMorph>>changeProgressColor: (in category 'menu') ----- - changeProgressColor: evt - | aHand | - aHand := evt ifNotNil: [evt hand] ifNil: [self primaryHand]. - self changeColorTarget: self selector: #progressColor: originalColor: self progressColor hand: aHand.! Item was removed: - ----- Method: ProgressBarMorph>>changeProgressValue: (in category 'menu') ----- - changeProgressValue: evt - | answer | - answer := UIManager default - request: 'Enter new value (0 - 1.0)' - initialAnswer: self value contents asString. - answer isEmptyOrNil ifTrue: [^ self]. - self value contents: answer asNumber! Item was removed: - ----- Method: ProgressBarMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | width inner | - super drawOn: aCanvas. - inner := self innerBounds. - width := (inner width * lastValue) truncated min: inner width. - aCanvas fillRectangle: (inner origin extent: width @ inner height) color: progressColor.! Item was removed: - ----- Method: ProgressBarMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - self setDefaultParameters. - self value: (ValueHolder new contents: 0.0). - lastValue := 0.0! Item was removed: - ----- Method: ProgressBarMorph>>progressColor (in category 'accessing') ----- - progressColor - ^progressColor! Item was removed: - ----- Method: ProgressBarMorph>>progressColor: (in category 'accessing') ----- - progressColor: aColor - progressColor = aColor - ifFalse: - [progressColor := aColor. - self changed]! Item was removed: - ----- Method: ProgressBarMorph>>setDefaultParameters (in category 'initialization') ----- - setDefaultParameters - - self - borderColor: ((UserInterfaceTheme current get: #borderColor for: SystemProgressBarMorph) ifNil: [Color black]); - borderWidth: ((UserInterfaceTheme current get: #borderWidth for: SystemProgressBarMorph) ifNil: [2]); - color: ((UserInterfaceTheme current get: #color for: SystemProgressBarMorph) ifNil: [Color white]); - progressColor: ((UserInterfaceTheme current get: #barColor for: SystemProgressBarMorph) ifNil: [Color green]).! Item was removed: - ----- Method: ProgressBarMorph>>update: (in category 'updating') ----- - update: aSymbol - aSymbol == #contents - ifTrue: - [lastValue := value contents. - self changed]! Item was removed: - ----- Method: ProgressBarMorph>>value (in category 'accessing') ----- - value - ^value! Item was removed: - ----- Method: ProgressBarMorph>>value: (in category 'accessing') ----- - value: aModel - value ifNotNil: [value removeDependent: self]. - value := aModel. - value ifNotNil: [value addDependent: self]! Item was removed: - RectangleMorph subclass: #ProgressMorph - instanceVariableNames: 'labelMorph subLabelMorph progress' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: ProgressMorph class>>example (in category 'example') ----- - example - "ProgressMorph example" - - | progress | - progress := ProgressMorph label: 'Test progress'. - progress subLabel: 'this is the subheading'. - progress openInWorld. - [10 timesRepeat: - [(Delay forMilliseconds: 200) wait. - progress incrDone: 0.1]. - progress delete] fork! Item was removed: - ----- Method: ProgressMorph class>>label: (in category 'instance creation') ----- - label: aString - ^self new label: aString! Item was removed: - ----- Method: ProgressMorph>>done (in category 'accessing') ----- - done - ^self progress value contents! Item was removed: - ----- Method: ProgressMorph>>done: (in category 'accessing') ----- - done: amountDone - self progress value contents: ((amountDone min: 1.0) max: 0.0). - self currentWorld displayWorld! Item was removed: - ----- Method: ProgressMorph>>fontOfPointSize: (in category 'private') ----- - fontOfPointSize: size - ^ (TextConstants at: Preferences standardEToysFont familyName ifAbsent: [TextStyle default]) fontOfPointSize: size! Item was removed: - ----- Method: ProgressMorph>>incrDone: (in category 'accessing') ----- - incrDone: incrDone - self done: self done + incrDone! Item was removed: - ----- Method: ProgressMorph>>initLabelMorph (in category 'initialization') ----- - initLabelMorph - ^ labelMorph := (StringMorph contents: '') - font: ((UserInterfaceTheme current get: #font for: SystemProgressMorph) ifNil: [TextStyle defaultFont]); - color: ((UserInterfaceTheme current get: #textColor for: SystemProgressMorph) ifNil: [Color black]); - yourself! Item was removed: - ----- Method: ProgressMorph>>initProgressMorph (in category 'initialization') ----- - initProgressMorph - progress := ProgressBarMorph new. - progress borderColor: ((UserInterfaceTheme current get: #borderColor for: SystemProgressBarMorph) ifNil: [Color black]). - progress borderWidth: ((UserInterfaceTheme current get: #borderWidth for: SystemProgressBarMorph) ifNil: [1]). - progress color: ((UserInterfaceTheme current get: #color for: SystemProgressBarMorph) ifNil: [Color white]). - progress progressColor: ((UserInterfaceTheme current get: #barColor for: SystemProgressBarMorph) ifNil: [Color gray]). - progress extent: 200 @ 15. - ! Item was removed: - ----- Method: ProgressMorph>>initSubLabelMorph (in category 'initialization') ----- - initSubLabelMorph - ^ subLabelMorph := (StringMorph contents: '') - font: ((UserInterfaceTheme current get: #font for: PluggableButtonMorph) ifNil: [TextStyle defaultFont]); - color: ((UserInterfaceTheme current get: #textColor for: PluggableButtonMorph) ifNil: [Color black]); - yourself! Item was removed: - ----- Method: ProgressMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - self setupMorphs! Item was removed: - ----- Method: ProgressMorph>>label (in category 'accessing') ----- - label - ^self labelMorph contents! Item was removed: - ----- Method: ProgressMorph>>label: (in category 'accessing') ----- - label: aString - self labelMorph contents: aString. - self currentWorld displayWorld! Item was removed: - ----- Method: ProgressMorph>>labelMorph (in category 'private') ----- - labelMorph - ^labelMorph ifNil: [self initLabelMorph]! Item was removed: - ----- Method: ProgressMorph>>progress (in category 'accessing') ----- - progress - ^progress ifNil: [self initProgressMorph]! Item was removed: - ----- Method: ProgressMorph>>setupMorphs (in category 'initialization') ----- - setupMorphs - | | - self initProgressMorph. - self - layoutPolicy: TableLayout new; - listDirection: #topToBottom; - cellPositioning: #topCenter; - listCentering: #center; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - color: Color transparent. - - self addMorphBack: self labelMorph. - self addMorphBack: self subLabelMorph. - self addMorphBack: self progress. - - self borderWidth: ((UserInterfaceTheme current get: #borderWidth for: SystemProgressMorph) ifNil: [2]). - self borderColor: ((UserInterfaceTheme current get: #borderColor for: SystemProgressMorph) ifNil: [Color black]). - - self color: ((UserInterfaceTheme current get: #color for: SystemProgressMorph) ifNil: [Color veryLightGray]). - self align: self fullBounds center with: Display boundingBox center - ! Item was removed: - ----- Method: ProgressMorph>>subLabel (in category 'accessing') ----- - subLabel - ^self subLabelMorph contents! Item was removed: - ----- Method: ProgressMorph>>subLabel: (in category 'accessing') ----- - subLabel: aString - self subLabelMorph contents: aString. - self currentWorld displayWorld! Item was removed: - ----- Method: ProgressMorph>>subLabelMorph (in category 'private') ----- - subLabelMorph - ^subLabelMorph ifNil: [self initSubLabelMorph]! Item was removed: - AlignmentMorphBob1 subclass: #ProjectNavigationMorph - instanceVariableNames: 'mouseInside soundSlider' - classVariableNames: 'LastManualPlacement' - poolDictionaries: '' - category: 'MorphicExtras-Navigators'! - - !ProjectNavigationMorph commentStamp: 'sm 8/12/2009 22:42' prior: 0! - A ProjectNavigationMorph is the standard panel of buttons for navigating and managing projects. It appears, usually at bottom left, when the classicNavigatorEnabled and showProjectNavigator preferences are enabled. - ! Item was removed: - ----- Method: ProjectNavigationMorph class>>preferredNavigator (in category 'navigation') ----- - preferredNavigator - - "Preferences eToyFriendly ifTrue: [^KidNavigationMorph]." - ^ProjectNavigationMorph! Item was removed: - ----- Method: ProjectNavigationMorph>>addButtons (in category 'buttons') ----- - addButtons - - self orientedVertically ifTrue: [ - self addAColumn: ( - self makeTheButtons collect: [ :x | self inAColumn: {x}] - ) - ] ifFalse: [ - self addARow: ( - self makeTheButtons collect: [ :x | self inAColumn: {x}] - ) - ]. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aMenu hand: aHandMorph - - "Add further items to the menu as appropriate" - - super addCustomMenuItems: aMenu hand: aHandMorph. - aMenu - addUpdating: #orientationString - action: #toggleOrientation. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>amountToShowWhenSmall (in category 'private - ui') ----- - amountToShowWhenSmall - - ^7 "if no part of the buttons is visible, we chew up fewer cycles"! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonFind (in category 'the buttons') ----- - buttonFind - "Answer a button for finding/loading projects" - - ^ self makeButton: 'FIND' balloonText: 'Click here to find a project. Hold down this button to reveal additional options.' translated for: #findAProjectSimple - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') ----- - buttonFlaps - - ^self inFlapsSuppressedMode ifTrue: [ - self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed - ] ifFalse: [ - self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed - ]. - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') ----- - buttonFullScreen - - ^self inFullScreenMode ifTrue: [ - self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff - ] ifFalse: [ - self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn - ] - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') ----- - buttonGoTo - - ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonLanguage (in category 'the buttons') ----- - buttonLanguage - "Answer a button for finding/loading projects" - ^ SimpleButtonDelayedMenuMorph new target: self; - borderStyle: BorderStyle raised; - color: self colorForButtons; - label: Project current naturalLanguage font: self fontForButtons; - setBalloonText: 'Click here to choose your language.' translated; - actionSelector: #chooseLanguage! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') ----- - buttonNewProject - - ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') ----- - buttonNewer - - ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') ----- - buttonNext - - ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') ----- - buttonPaint - - | pb oldArgs brush myButton m | - - myButton := self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting. - pb := PaintBoxMorph new submorphNamed: #paint:. - pb ifNil: [ - (brush := Form extent: 16 at 16 depth: 16) fillColor: Color red - ] ifNotNil: [ - oldArgs := pb arguments. - brush := oldArgs third. - brush := brush copy: (2 at 0 extent: 42 at 38). - brush := brush scaledToSize: brush extent // 2. - ]. - myButton addMorph: (m := brush asMorph lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - - ^myButton - - "brush := (ScriptingSystem formAtKey: 'Painting')." - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') ----- - buttonPrev - - ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonPublish (in category 'the buttons') ----- - buttonPublish - "Answer a button for publishing the project" - - ^ self makeButton: 'PUBLISH IT!!' translated balloonText: 'Click here to save a project. Hold down this button to reveal additional publishing options' translated for: #publishProject! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') ----- - buttonQuit - "Make and answer a button whose pressing will result in quitting out of Squeak." - - ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonSound (in category '*MorphicExtras-Sound') ----- - buttonSound - - | myButton m | - - myButton := RectangleMorph new - cornerStyle: #rounded; - borderStyle: (BorderStyle raised width: 1); - color: self colorForButtons; - setBalloonText: 'Change sound volume' translated; - on: #mouseDown send: #soundDownEvt:morph: to: self; - on: #mouseStillDown send: #soundStillDownEvt:morph: to: self; - on: #mouseUp send: #soundUpEvt:morph: to: self; - yourself. - - myButton addMorph: (m := self speakerIcon lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - ^myButton - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') ----- - buttonTell - - ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonUndo (in category 'the buttons') ----- - buttonUndo - "Build and return a fresh Undo button for me." - - ^ self makeUpdatingButtonWithBalloonText: 'Undo or redo the last undoable action' actionSelector: #undoOrRedoLastCommand wordingSelector: #undoButtonWording - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>checkForRebuild (in category 'private') ----- - checkForRebuild - | lastScreenMode flapsSuppressed | - - lastScreenMode := DisplayScreen displayIsFullScreen. - flapsSuppressed := Project current flapsSuppressed. - ((self valueOfProperty: #currentNavigatorVersion) = self currentNavigatorVersion - and: [lastScreenMode = self inFullScreenMode - and: [flapsSuppressed = self inFlapsSuppressedMode - and: [(self valueOfProperty: #includeSoundControlInNavigator) = - Preferences includeSoundControlInNavigator]]]) ifFalse: [ - self - setProperty: #includeSoundControlInNavigator - toValue: Preferences includeSoundControlInNavigator. - self setProperty: #flapsSuppressedMode toValue: flapsSuppressed. - self setProperty: #showingFullScreenMode toValue: lastScreenMode. - self setProperty: #currentNavigatorVersion toValue: self currentNavigatorVersion. - self removeAllMorphs. - self addButtons. - ]. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>chooseLanguage (in category 'the actions') ----- - chooseLanguage - - Project current chooseNaturalLanguage! Item was removed: - ----- Method: ProjectNavigationMorph>>color: (in category 'accessing') ----- - color: newColor - - | buttonColor | - - super color: newColor. - buttonColor := color darker. - self submorphsDo: [:m | m submorphsDo: [:n | n color: buttonColor]]! Item was removed: - ----- Method: ProjectNavigationMorph>>colorForButtons (in category 'buttons') ----- - colorForButtons - - ^color darker! Item was removed: - ----- Method: ProjectNavigationMorph>>currentNavigatorVersion (in category 'private') ----- - currentNavigatorVersion - "Answer the current navigator version." - - ^ 31 "since these guys get saved, we fix them up if they are older versions"! Item was removed: - ----- Method: ProjectNavigationMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color orange! Item was removed: - ----- Method: ProjectNavigationMorph>>doFindButtonMenuEvent: (in category 'the actions') ----- - doFindButtonMenuEvent: evt - - | selection | - selection := UIManager default chooseFrom:{ - 'find a project' translated. - 'find a project (more places)' translated. - 'find any file' translated. - 'search the SuperSwiki' translated. - } values: { - [self findAProjectSimple]. - [self findAProject]. - [self findAnything]. - [self findSomethingOnSuperSwiki]. - } title: 'Find options' translated. - selection ifNil: [^self]. - selection value. - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>doNewPainting (in category 'the actions') ----- - doNewPainting - - | w f | - - w := self world. - w assureNotPaintingElse: [^ self]. - (f := self owner flapTab) ifNotNil: [f hideFlap]. - w makeNewDrawing: (self primaryHand lastEvent copy setPosition: w center) - ! Item was removed: - ----- Method: ProjectNavigationMorph>>doPublishButtonMenuEvent: (in category 'the actions') ----- - doPublishButtonMenuEvent: evt - - | selection | - selection := UIManager default chooseFrom: { - 'Publish' translated. - 'Publish As...' translated. - 'Publish to Different Server' translated. - 'edit project info' translated. - } values: { - [self publishProject]. - [self publishProjectAs]. - [self publishDifferent]. - [self editProjectInfo]. - } title: 'Publish options' translated. - selection ifNil: [^self]. - selection value. - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>editProjectInfo (in category 'the actions') ----- - editProjectInfo - - Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| - aClass - getFullInfoFor: (self world ifNil: [^self]) project - ifValid: [] - expandedFormat: true - ].! Item was removed: - ----- Method: ProjectNavigationMorph>>findAProject (in category 'the actions') ----- - findAProject - - FileList2 - morphicViewProjectLoader2InWorld: self world - reallyLoad: true - dirFilterType: #initialDirectoryList! Item was removed: - ----- Method: ProjectNavigationMorph>>findAProjectSimple (in category 'the actions') ----- - findAProjectSimple - - FileList2 - morphicViewProjectLoader2InWorld: self world - reallyLoad: true - dirFilterType: #limitedSuperSwikiDirectoryList! Item was removed: - ----- Method: ProjectNavigationMorph>>findAnything (in category 'the actions') ----- - findAnything - - FileList2 morphicViewGeneralLoaderInWorld: self world! Item was removed: - ----- Method: ProjectNavigationMorph>>findSomethingOnSuperSwiki (in category 'the buttons') ----- - findSomethingOnSuperSwiki - - | projectServers server index | - projectServers := ServerDirectory projectServers. - projectServers isEmpty - ifTrue: [^self]. - projectServers size = 1 - ifTrue: [server := projectServers first] - ifFalse: [index := Project uiManager - chooseOptionFrom: (projectServers collect: [:each | (ServerDirectory nameForServer: each) translatedIfCorresponds]) - title: 'Choose a super swiki:' translated. - index > 0 - ifTrue: [server := projectServers at: index] - ifFalse: [^self]]. - Smalltalk at: #EToyProjectQueryMorph ifPresent:[:aClass| aClass onServer: server].! Item was removed: - ----- Method: ProjectNavigationMorph>>fontForButtons (in category 'buttons') ----- - fontForButtons - ^ Preferences standardButtonFont! Item was removed: - ----- Method: ProjectNavigationMorph>>fullScreenOff (in category 'the actions') ----- - fullScreenOff - - self setProperty: #showingFullScreenMode toValue: false. - DisplayScreen fullScreenOff. - self removeProperty: #currentNavigatorVersion. - mouseInside := false. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>fullScreenOn (in category 'the actions') ----- - fullScreenOn - - self setProperty: #showingFullScreenMode toValue: true. - DisplayScreen fullScreenOn. - self removeProperty: #currentNavigatorVersion. - mouseInside := false. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>getNewerVersionIfAvailable (in category 'the actions') ----- - getNewerVersionIfAvailable - - (self world ifNil: [^Beeper beep]) project loadFromServer: true. - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>getSoundVolume (in category '*MorphicExtras-Sound') ----- - getSoundVolume - - ^SoundPlayer soundVolume average! Item was removed: - ----- Method: ProjectNavigationMorph>>gotoAnother (in category 'the actions') ----- - gotoAnother - - Smalltalk at: #EToyProjectHistoryMorph ifPresent:[:aClass| aClass new openInWorld].! Item was removed: - ----- Method: ProjectNavigationMorph>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - - ^true! Item was removed: - ----- Method: ProjectNavigationMorph>>inFlapsSuppressedMode (in category 'testing') ----- - inFlapsSuppressedMode - - ^(self valueOfProperty: #flapsSuppressedMode) == true! Item was removed: - ----- Method: ProjectNavigationMorph>>inFullScreenMode (in category 'testing') ----- - inFullScreenMode - - ^(self valueOfProperty: #showingFullScreenMode) == true! Item was removed: - ----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self layoutInset: 6; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - useRoundedCorners. - mouseInside := false. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - justDroppedInto: aMorph event: anEvent - - self setProperty: #stickToTop toValue: nil. - self positionVertically. - LastManualPlacement := {self position. self valueOfProperty: #stickToTop}. - super justDroppedInto: aMorph event: anEvent. - self step! Item was removed: - ----- Method: ProjectNavigationMorph>>languageIcon (in category 'the buttons') ----- - languageIcon - ^ (ColorForm - extent: 19 at 18 - depth: 4 - fromArray: #( 4294967295 4294967295 4293918720 4294967206 2183331839 4293918720 4294946286 3972145919 4293918720 4294631150 3430031919 4293918720 4289588973 3396477476 4293918720 4292799965 3399692836 4293918720 4208913868 724784466 804257792 4141735107 858993445 804257792 4140616899 1127429205 804257792 4174171340 3006481493 804257792 4174171340 3274982741 804257792 4170435788 3409204562 804257792 4280497100 1429493074 4293918720 4280431429 1429558562 4293918720 4294059093 1431654959 4293918720 4294919237 1431446271 4293918720 4294967074 572719103 4293918720 4294967295 4294967295 4293918720) - offset: 0 at 0) - colorsFromArray: #(#(0.0 0.0 0.0) #(1.0 1.0 1.0) #(0.376 0.376 0.784) #(0.357 0.357 0.733) #(0.231 0.231 0.474) #(0.494 0.494 0.964) #(0.498 0.498 0.933) #(0.376 0.376 0.706) #(0.419 0.419 0.78) #(0.415 0.415 0.776) #(0.595 0.595 0.972) #(0.638 0.638 0.968) #(0.654 0.654 0.96) #(0.686 0.686 0.96) #(0.71 0.71 0.964) #( ) )! Item was removed: - ----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'buttons') ----- - makeButton: aString balloonText: anotherString for: aSymbol - - ^ SimpleButtonDelayedMenuMorph new target: self; - borderStyle: BorderStyle raised; - color: self colorForButtons; - label: aString font: self fontForButtons; - setBalloonText: anotherString; - actionSelector: aSymbol! Item was removed: - ----- Method: ProjectNavigationMorph>>makeTheAdvancedButtons (in category 'buttons') ----- - makeTheAdvancedButtons - - ^{ - self buttonNewProject. - self buttonShare. - self buttonPrev. - self buttonNext. - self buttonPublish. - self buttonNewer. - self buttonTell. - self buttonFind. - self buttonFullScreen. - "self buttonFlaps." - self buttonPaint. - }, - ( - Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] - ), - { - self buttonLanguage. - self buttonUndo. - self buttonQuit. - } - ! Item was removed: - ----- Method: ProjectNavigationMorph>>makeTheButtons (in category 'buttons') ----- - makeTheButtons - ^ Preferences showAdvancedNavigatorButtons - ifTrue: [self makeTheAdvancedButtons] - ifFalse: [self makeTheSimpleButtons]! Item was removed: - ----- Method: ProjectNavigationMorph>>makeTheSimpleButtons (in category 'buttons') ----- - makeTheSimpleButtons - - ^{ - self buttonNewProject. - - self buttonPrev. - self buttonNext. - self buttonPublish. - self buttonFind. - self buttonFullScreen. - - self buttonPaint. - }, - ( - Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] - ), - { - self buttonLanguage. - self buttonUndo. - self buttonQuit. - } - ! Item was removed: - ----- Method: ProjectNavigationMorph>>makeUpdatingButtonWithBalloonText:actionSelector:wordingSelector: (in category 'buttons') ----- - makeUpdatingButtonWithBalloonText: balloonString actionSelector: actionSymbol wordingSelector: wordingSymbol - "Answer a button whose target is the receiver (i.e. a ProjectNavigationMorph), who gets its wording by sending the wordingSelector to me. The given string" - - | aButton | - aButton := UpdatingSimpleButtonMorph new. - aButton - target: self; - borderStyle: BorderStyle raised; - color: self colorForButtons; - label: '-' font: self fontForButtons; - setBalloonText: balloonString translated; - actionSelector: actionSymbol; - wordingSelector: wordingSymbol. - aButton step. - ^ aButton - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>morphicLayerNumber (in category 'submorphs - layers') ----- - morphicLayerNumber - - ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]! Item was removed: - ----- Method: ProjectNavigationMorph>>mouseEnter: (in category 'event handling') ----- - mouseEnter: evt - - (self worldBounds containsPoint: evt cursorPoint) ifFalse: [^self]. - mouseInside := true. - self positionVertically. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>mouseLeave: (in category 'event handling') ----- - mouseLeave: evt - - self world ifNil: [^self]. "can happen after delete from control menu" - (self worldBounds containsPoint: evt cursorPoint) ifFalse: [^self]. - mouseInside := false. - self positionVertically. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>newProject (in category 'the actions') ----- - newProject - - MorphicProject openViewOn: nil - ! Item was removed: - ----- Method: ProjectNavigationMorph>>nextProject (in category 'the actions') ----- - nextProject - - Project advanceToNextProject. - Beeper beep.! Item was removed: - ----- Method: ProjectNavigationMorph>>openInWorld: (in category 'initialization') ----- - openInWorld: aWorld - - LastManualPlacement ifNotNil: [ - self position: LastManualPlacement first. - self setProperty: #stickToTop toValue: LastManualPlacement second. - ]. - super openInWorld: aWorld.! Item was removed: - ----- Method: ProjectNavigationMorph>>orientationString (in category 'private - ui') ----- - orientationString - ^ (self orientedVertically - ifTrue: ['<yes>'] - ifFalse: ['<no>']) - , 'vertical orientation' translated! Item was removed: - ----- Method: ProjectNavigationMorph>>orientedVertically (in category 'private - ui') ----- - orientedVertically - - ^self valueOfProperty: #orientedVertically ifAbsent: [false] - ! Item was removed: - ----- Method: ProjectNavigationMorph>>positionVertically (in category 'the actions') ----- - positionVertically - - | wb stickToTop | - - owner == self world ifFalse: [^self]. - wb := self worldBounds. - stickToTop := self valueOfProperty: #stickToTop. - stickToTop ifNil: [ - stickToTop := (self top - wb top) abs < (self bottom - wb bottom) abs. - self setProperty: #stickToTop toValue: stickToTop. - ]. - mouseInside == true ifTrue: [ - stickToTop ifTrue: [ - self top: wb top - ] ifFalse: [ - self bottom: wb bottom - ]. - ] ifFalse: [ - stickToTop ifTrue: [ - self bottom: wb top + self amountToShowWhenSmall - ] ifFalse: [ - self top: wb bottom - self amountToShowWhenSmall - ]. - ]. - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>previousProject (in category 'the actions') ----- - previousProject - - Project returnToPreviousProject. - Project current exit. "go to parent if no previous" - Beeper beep.! Item was removed: - ----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') ----- - publishDifferent - - self - publishStyle: #initialDirectoryListForProjects - forgetURL: true - withRename: false - ! Item was removed: - ----- Method: ProjectNavigationMorph>>publishProject (in category 'the actions') ----- - publishProject - - self world paintBoxOrNil ifNotNil: [ - (self confirm: 'You seem to be painting a sketch. - Do you continue and publish the project with the paint tool?' translated) ifFalse: [^ self]. - ]. - self - publishStyle: #limitedSuperSwikiPublishDirectoryList - forgetURL: false - withRename: false! Item was removed: - ----- Method: ProjectNavigationMorph>>publishProjectAs (in category 'the actions') ----- - publishProjectAs - - self - publishStyle: #limitedSuperSwikiPublishDirectoryList - forgetURL: false - withRename: true! Item was removed: - ----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') ----- - publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean - - | w saveOwner primaryServer rename | - - w := self world ifNil: [^Beeper beep]. - w setProperty: #SuperSwikiPublishOptions toValue: aSymbol. - - primaryServer := w project primaryServerIfNil: [nil]. - rename := ((primaryServer notNil - and: [primaryServer acceptsUploads]) not) - or: [renameBoolean]. - rename := rename or: [Smalltalk globals at: #DAVMultiUserServerDirectory ifPresent: [:c | primaryServer isKindOf: c] ifAbsent: [false]]. - w setProperty: #SuperSwikiRename toValue: rename. - - saveOwner := owner. - self delete. - [w project - storeOnServerShowProgressOn: self - forgetURL: aBoolean | rename] - ensure: [saveOwner addMorphFront: self]! Item was removed: - ----- Method: ProjectNavigationMorph>>quitSqueak (in category 'the actions') ----- - quitSqueak - "Obtain a confirmation from the user, and if the answer is true, quite Squeak summarily" - - (self confirm: 'Are you sure you want to Quit Squeak?' translated) ifFalse: [^ self]. - - Smalltalk snapshot: false andQuit: true - ! Item was removed: - ----- Method: ProjectNavigationMorph>>retractIfAppropriate (in category 'ui') ----- - retractIfAppropriate - - mouseInside := false. - self positionVertically. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>setSoundVolume: (in category '*MorphicExtras-Sound') ----- - setSoundVolume: x - - SoundPlayer setVolumeLeft: x volumeRight: x. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>showMenuFor:event: (in category 'menus') ----- - showMenuFor: aSymbol event: evt - - (aSymbol == #publishProject or: [aSymbol == #publishProjectSimple]) ifTrue: [ - self doPublishButtonMenuEvent: evt. - ^true "we did show the menu" - ]. - (aSymbol == #findAProject or: [aSymbol == #findAProjectSimple]) ifTrue: [ - self doFindButtonMenuEvent: evt. - ^true "we did show the menu" - ]. - ^false - ! Item was removed: - ----- Method: ProjectNavigationMorph>>soundDownEvt:morph: (in category '*MorphicExtras-Sound') ----- - soundDownEvt: a morph: b - - soundSlider ifNotNil: [soundSlider delete]. - (soundSlider := RectangleMorph new) - morphicLayerNumber: self class frontmostLayer; - extent: b width @ (b width * 3); - color: self colorForButtons; - borderStyle: BorderStyle raised; - bottomLeft: b boundsInWorld origin. - soundSlider addMorph: ( - RectangleMorph new - color: self colorForButtons; - borderColor: #raised; - extent: b width @ 8; - center: soundSlider center x @ - (soundSlider bottom - (soundSlider height * self getSoundVolume) asInteger) - ). - soundSlider openInWorld.! Item was removed: - ----- Method: ProjectNavigationMorph>>soundStillDownEvt:morph: (in category '*MorphicExtras-Sound') ----- - soundStillDownEvt: evt morph: b - - | y pct | - - soundSlider ifNil: [^self]. - y := evt hand position y. - (y between: soundSlider top and: soundSlider bottom) ifTrue: [ - pct := (soundSlider bottom - y) asFloat / soundSlider height. - self setSoundVolume: pct. - soundSlider firstSubmorph top: y - 5. - ]. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>soundUpEvt:morph: (in category '*MorphicExtras-Sound') ----- - soundUpEvt: a morph: b - - soundSlider ifNotNil: [soundSlider delete]. - soundSlider := nil. - Beeper beep ! Item was removed: - ----- Method: ProjectNavigationMorph>>speakerIcon (in category '*MorphicExtras-Sound') ----- - speakerIcon - - - ^ImageMorph new - image: ( - (Form - extent: 19 at 18 - depth: 8 - fromArray: #( 0 0 1493172224 0 0 0 0 1493172224 0 0 0 138 1493172224 0 0 0 35509 2315255808 0 0 0 9090522 2315255808 0 0 0 2327173887 2315255819 0 0 138 3051028442 2315255819 0 0 1505080590 4294957786 2315255808 184549376 0 3053453311 4292532917 1493172224 184549376 0 1505080714 3048584629 1493172224 184549376 0 9079434 3048584629 1493172224 184549376 0 138 2327164341 1493172235 0 0 0 2324346293 1493172235 0 0 0 9079477 1493172224 0 0 0 35466 1493172224 0 0 0 138 0 0 0 0 0 0 0 0 0 0 0 0 0) - offset: 0 at 0) - ); - setBalloonText: 'Quiet'; - on: #mouseUp send: #yourself to: 1 - ! Item was removed: - ----- Method: ProjectNavigationMorph>>step (in category 'stepping and presenter') ----- - step - | wb | - - owner ifNil: [^ self]. - (self ownerThatIsA: HandMorph) ifNotNil: [^self]. - self checkForRebuild. - owner == self world ifTrue: [ - owner addMorphInLayer: self. - wb := self worldBounds. - self left < wb left ifTrue: [self left: wb left]. - self right > wb right ifTrue: [self right: wb right]. - self positionVertically. - ].! Item was removed: - ----- Method: ProjectNavigationMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^1000! Item was removed: - ----- Method: ProjectNavigationMorph>>tellAFriend (in category 'the actions') ----- - tellAFriend - - self world project tellAFriend! Item was removed: - ----- Method: ProjectNavigationMorph>>toggleFlapsSuppressed (in category 'the actions') ----- - toggleFlapsSuppressed - - Project current toggleFlapsSuppressed! Item was removed: - ----- Method: ProjectNavigationMorph>>toggleOrientation (in category 'the actions') ----- - toggleOrientation - - self setProperty: #orientedVertically toValue: self orientedVertically not. - self setProperty: #currentNavigatorVersion toValue: self currentNavigatorVersion - 1. - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>undoButtonWording (in category 'stepping and presenter') ----- - undoButtonWording - "Answer the wording for the Undo button." - - | wdng | - wdng := Project current world commandHistory undoOrRedoMenuWording. - (wdng endsWith: ' (z)') ifTrue: [ - wdng := wdng copyFrom: 1to: wdng size - 4]. - ^ wdng! Item was removed: - ----- Method: ProjectNavigationMorph>>undoLastCommand (in category 'the actions') ----- - undoLastCommand - - self world commandHistory undoLastCommand! Item was removed: - ----- Method: ProjectNavigationMorph>>undoOrRedoLastCommand (in category 'the actions') ----- - undoOrRedoLastCommand - "Undo or redo the last command, as approrpiate." - - ^ Project current world commandHistory undoOrRedoCommand! Item was removed: - ----- Method: ProjectNavigationMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - - ^true! Item was removed: - BookPageSorterMorph subclass: #ProjectSorterMorph - instanceVariableNames: 'sizeOfEachMorph' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Navigators'! Item was removed: - ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') ----- - addControls - "Add the control bar at the top of the tool." - - | b r partsBinButton newButton aWrapper | - newButton := ImageMorph new image: (Project current makeThumbnail scaledToSize: 48 at 36). - newButton on: #mouseDown send: #insertNewProject: to: self. - newButton setBalloonText: 'Make a new Project' translated. - (partsBinButton := UpdatingThreePhaseButtonMorph checkBox) - target: self; - actionSelector: #togglePartsBinStatus; - arguments: #(); - getSelector: #getPartsBinStatus. - (r := AlignmentMorph newRow) - color: Color transparent; - borderWidth: 0; - layoutInset: 0; - cellInset: 10 at 0; - wrapCentering: #center; - cellPositioning: #leftCenter; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - extent: 5 at 5. - b := SimpleButtonMorph new target: self; color: self defaultColor darker; - borderColor: Color black. - r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)). - b := SimpleButtonMorph new target: self; color: self defaultColor darker; - borderColor: Color black. - r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)); - addTransparentSpacerOfSize: 8 @ 0; - addMorphBack: (self wrapperFor: (newButton)); - addTransparentSpacerOfSize: 8 @ 0. - - aWrapper := AlignmentMorph newRow beTransparent. - aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0. - aWrapper - addMorphBack: (self wrapperFor: partsBinButton); - addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock). - r addMorphBack: aWrapper. - - self addMorphFront: r. - ! Item was removed: - ----- Method: ProjectSorterMorph>>clickFromSorterEvent:morph: (in category 'event handling') ----- - clickFromSorterEvent: evt morph: aMorph - - | where what | - (aMorph bounds containsPoint: evt cursorPoint) ifFalse: [^self]. - evt isMouseUp ifFalse: [ - evt shiftPressed ifFalse: [^evt hand grabMorph: aMorph]. - ^self - ]. - - evt shiftPressed ifTrue: [ - where := aMorph owner submorphs indexOf: aMorph ifAbsent: [nil]. - what := book threadName. - WorldState addDeferredUIMessage: [ - InternalThreadNavigationMorph openThreadNamed: what atIndex: where - ]. - (Project named: (aMorph valueOfProperty: #nameOfThisProject)) enter. - ]. - ! Item was removed: - ----- Method: ProjectSorterMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 0 ! Item was removed: - ----- Method: ProjectSorterMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.365 - g: 0.634 - b: 0.729! Item was removed: - ----- Method: ProjectSorterMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - - super initialize. - self useRoundedCorners. - pageHolder useRoundedCorners; borderWidth: 0; - color: (self - gridFormOrigin: 0 @ 0 - grid: ScriptingSystem sorterGridSize - background: Color white - line: Color blue muchLighter)! Item was removed: - ----- Method: ProjectSorterMorph>>insertNewProject: (in category 'controls') ----- - insertNewProject: evt - - | newProj | - - [newProj := MorphicProject openViewOn: nil.] - on: ProjectViewOpenNotification - do: [ :ex | ex resume: false]. - - Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| - aClass - getFullInfoFor: newProj - ifValid: [ - evt hand attachMorph: (self sorterMorphForProjectNamed: newProj name) - ] - expandedFormat: false. - ].! Item was removed: - ----- Method: ProjectSorterMorph>>morphsForMyContentsFrom:sizedTo: (in category 'private') ----- - morphsForMyContentsFrom: listOfPages sizedTo: sz - - | morphsForPageSorter | - - 'Assembling thumbnail images...' - displayProgressFrom: 0 to: listOfPages size - during: [:bar | - morphsForPageSorter := listOfPages withIndexCollect: [ :each :index | - bar value: index. - self sorterMorphForProjectNamed: each first - ]. - ]. - ^morphsForPageSorter - ! Item was removed: - ----- Method: ProjectSorterMorph>>navigator:listOfPages: (in category 'initialization') ----- - navigator: aThreadNavigator listOfPages: listOfPages - - | morphsForPageSorter pixelsAvailable pixelsNeeded scale | - - "a bit of fudging to try to outguess the layout mechanism and get best possible scale" - pixelsAvailable := Display extent - 130. - pixelsAvailable := pixelsAvailable x * pixelsAvailable y. - pixelsNeeded := 100 at 75. - pixelsNeeded := pixelsNeeded x * pixelsNeeded y * listOfPages size. - scale := (pixelsAvailable / pixelsNeeded min: 1) sqrt. - sizeOfEachMorph := (100 at 75 * scale) rounded. - - morphsForPageSorter := self morphsForMyContentsFrom: listOfPages sizedTo: sizeOfEachMorph. - morphsForPageSorter := morphsForPageSorter reject: [ :each | each isNil]. - self changeExtent: Display extent. - - self - book: aThreadNavigator - morphsToSort: morphsForPageSorter. - pageHolder - cursor: aThreadNavigator currentIndex; - fullBounds; - hResizing: #rigid. - - ! Item was removed: - ----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'private') ----- - sorterMorphForProjectNamed: projName - - | pvm proj | - - (proj := Project named: projName) ifNil: [^nil]. - pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph. - pvm setProperty: #nameOfThisProject toValue: projName. - pvm isOpaque: true. - pvm setBalloonText: projName. - pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self. - pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self. - ^pvm - - ! Item was removed: - ----- Method: ProjectViewMorph>>fullDrawPostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - fullDrawPostscriptOn: aCanvas - - | f | - "handle the fact that we have the squished text within" - - f := self imageForm. - f offset: 0 at 0. - aCanvas paintImage: f at: bounds origin. - ! Item was removed: - ----- Method: ProjectViewMorph>>handlesMouseStillDown: (in category '*MorphicExtras-event handling') ----- - handlesMouseStillDown: evt - ^true! Item was removed: - ----- Method: ProjectViewMorph>>mouseStillDown: (in category '*MorphicExtras-event handling') ----- - mouseStillDown: evt - - (self containsPoint: evt cursorPoint) ifFalse: [ - self showMouseState: 3. - ^self - ]. - self showMouseState: 2. - - - ! Item was removed: - ----- Method: RealEstateAgent class>>reduceByFlaps: (in category '*MorphicExtras-utilities') ----- - reduceByFlaps: aScreenRect - "Return a rectangle that won't interfere with default shared flaps" - - | top bottom left right | - Flaps sharedFlapsAllowed ifFalse: [^ aScreenRect copy]. - - top := bottom := left := right := 0. - Flaps globalFlapTabs do: [ :ft | | w h | - w := ft width. - h := ft height. - ft edgeToAdhereTo - caseOf: { - [ #top ] -> [ top := top max: h ]. - [ #bottom ] -> [ bottom := bottom max: h ] . - [ #left ] -> [ left := left max: w ] . - [ #right ] -> [ right := right max: w ] . - } - otherwise: [] ]. - ^ Rectangle - origin: aScreenRect origin + (left @ top) - extent: aScreenRect extent - (bottom @ right). - ! Item was removed: - AlignmentMorph subclass: #RecordingControlsMorph - instanceVariableNames: 'recorder recordingStatusLight recordMeter' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: RecordingControlsMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'SoundRecorder' - categories: #('Multimedia') - documentation: 'A device for making sound recordings.'! Item was removed: - ----- Method: RecordingControlsMorph class>>extraExample (in category '*MorphicExtras-examples') ----- - extraExample - "RecordingControlsMorph extraExample openInWorld" - - | example | - example := self new. - example recorder clearRecordedSound. - example recorder recordedSound add: SampledSound exampleBach. - ^ example! Item was removed: - ----- Method: RecordingControlsMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'} - forFlapNamed: 'Widgets'.]! Item was removed: - ----- Method: RecordingControlsMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') ----- - addButtonRows - - | r fullWidth | - r := AlignmentMorph newRow vResizing: #shrinkWrap. - - - r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). - r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). - r addMorphBack: (self buttonName: 'Trim' translated action: #trim). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). - r addMorphBack: (self buttonName: 'Show' translated action: #showEditor). - self addMorphBack: r. - r layoutChanged. - fullWidth := r fullBounds width. - - r := AlignmentMorph newRow vResizing: #shrinkWrap. - r addMorphBack: (self buttonName: 'Record' translated action: #record). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). - r addMorphBack: (self buttonName: 'Stop' translated action: #stop). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). - r addMorphBack: (self buttonName: 'Play' translated action: #playback). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). - r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec). - r addMorphBack: self makeStatusLight. - self addMorphBack: r. - Smalltalk at: #OggSpeexCodec ifPresent: [:c | - self changeCodec: c name: 'Speex']. - r layoutChanged. - fullWidth := fullWidth max: r fullBounds width. - ^ fullWidth@(r fullBounds height). - ! Item was removed: - ----- Method: RecordingControlsMorph>>addRecordLevelSlider (in category 'other') ----- - addRecordLevelSlider - - | levelSlider r | - levelSlider := SimpleSliderMorph new - color: color; - extent: 100 at 2; - target: recorder; - actionSelector: #recordLevel:; - adjustToValue: recorder recordLevel. - r := AlignmentMorph newRow - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #shrinkWrap; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: '0 '). - r addMorphBack: levelSlider. - r addMorphBack: (StringMorph contents: ' 10'). - self addMorphBack: r. - ! Item was removed: - ----- Method: RecordingControlsMorph>>addRecordLevelSliderIn: (in category 'other') ----- - addRecordLevelSliderIn: aPoint - - | levelSlider r | - levelSlider := SimpleSliderMorph new - color: color darker; - extent: (aPoint x * 0.75) asInteger@(aPoint y*0.6) asInteger; - target: recorder; - actionSelector: #recordLevel:; - adjustToValue: recorder recordLevel. - r := AlignmentMorph newRow - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #shrinkWrap; - vResizing: #rigid; - height: aPoint y + 2. - r addMorphBack: (StringMorph contents: '0 ' font: Preferences standardButtonFont). - r addMorphBack: levelSlider. - r addMorphBack: (StringMorph contents: ' 10' font: Preferences standardButtonFont). - self addMorphBack: r. - ! Item was removed: - ----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') ----- - buttonName: aString action: aSymbol - - ^ SimpleButtonMorph new - target: self; - label: aString font: Preferences standardButtonFont; - actionSelector: aSymbol - ! Item was removed: - ----- Method: RecordingControlsMorph>>changeCodec:name: (in category 'button commands') ----- - changeCodec: aClass name: aString - | button newLabel | - (aClass notNil - and: [aClass isAvailable]) - ifTrue: [recorder codec: aClass new. - newLabel := aString] - ifFalse: [newLabel := 'None']. - self submorphs - do: [:raw | raw submorphs - do: [:each | ((each isKindOf: SimpleButtonMorph) - and: [each actionSelector = #chooseCodec]) - ifTrue: [button := each]]]. - button labelString: newLabel! Item was removed: - ----- Method: RecordingControlsMorph>>chooseCodec (in category 'button commands') ----- - chooseCodec - | menu | - menu := MenuMorph new defaultTarget: self. - Smalltalk at: #OggDriver ifPresent: [:oggDriver | - oggDriver isAvailable - ifTrue: [menu - add: 'Speex' - target: self - selector: #changeCodec:name: - argumentList: {Smalltalk at: #OggSpeexCodec. 'Speex'}. - menu - add: 'Vorbis' - target: self - selector: #changeCodec:name: - argumentList: {Smalltalk at: #OggVorbisCodec. 'Vorbis'}]]. - menu - add: 'GSM' - target: self - selector: #changeCodec:name: - argumentList: {GSMCodec. 'GSM'}. - menu - add: 'None' - target: self - selector: #changeCodec:name: - argumentList: {nil. 'None'}. - menu popUpInWorld! Item was removed: - ----- Method: RecordingControlsMorph>>done (in category 'button commands') ----- - done - - recorder stopRecording. - self makeTile. - self delete. - ! Item was removed: - ----- Method: RecordingControlsMorph>>initialize (in category 'initialization') ----- - initialize - - | r full | - super initialize. - self hResizing: #shrinkWrap; vResizing: #shrinkWrap. - self borderWidth: 2. - self listDirection: #topToBottom. - recorder := SoundRecorder new. - full := self addButtonRows. - self addRecordLevelSliderIn: full. - - r := AlignmentMorph newRow vResizing: #shrinkWrap. - r addMorphBack: (self makeRecordMeterIn: full). - self addMorphBack: r. - self extent: 10 at 10. "make minimum size" - ! Item was removed: - ----- Method: RecordingControlsMorph>>makeRecordMeter (in category 'other') ----- - makeRecordMeter - - | outerBox | - outerBox := Morph new extent: 102 at 18; color: Color gray. - recordMeter := Morph new extent: 1 at 16; color: Color yellow. - recordMeter position: outerBox topLeft + (1 at 1). - outerBox addMorph: recordMeter. - ^ outerBox - ! Item was removed: - ----- Method: RecordingControlsMorph>>makeRecordMeterIn: (in category 'other') ----- - makeRecordMeterIn: aPoint - - | outerBox h | - h := (aPoint y * 0.6) asInteger. - outerBox := Morph new extent: (aPoint x) asInteger at h; color: Color gray. - recordMeter := Morph new extent: 1 at h; color: Color yellow. - recordMeter position: outerBox topLeft + (1 at 1). - outerBox addMorph: recordMeter. - ^ outerBox - ! Item was removed: - ----- Method: RecordingControlsMorph>>makeSoundMorph (in category 'button commands') ----- - makeSoundMorph - - | m | - recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. - - recorder pause. - m := SoundEventMorph new sound: recorder recordedSound. - self world firstHand attachMorph: m. - ! Item was removed: - ----- Method: RecordingControlsMorph>>makeStatusLight (in category 'other') ----- - makeStatusLight - - recordingStatusLight := Morph new extent: 18 at 18. - recordingStatusLight color: Color transparent. - ^ recordingStatusLight - ! Item was removed: - ----- Method: RecordingControlsMorph>>makeTile (in category 'button commands') ----- - makeTile - "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known." - - | newStyleTile sndName tile tileClass | - tileClass := Smalltalk at: #SoundTile ifAbsent:[nil]. - recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. - recorder pause. - newStyleTile := tileClass notNil. - newStyleTile - ifTrue: - [sndName := UIManager default - request: 'Please name your new sound' translated - initialAnswer: 'sound' translated. - sndName isEmpty ifTrue: [^ self]. - - sndName := SampledSound unusedSoundNameLike: sndName. - SampledSound - addLibrarySoundNamed: sndName - samples: recorder condensedSamples - samplingRate: recorder samplingRate. - tile := tileClass new literal: sndName] - ifFalse: - [tile := InterimSoundMorph new sound: - (SampledSound - samples: recorder condensedSamples - samplingRate: recorder samplingRate)]. - - tile bounds: tile fullBounds. - tile openInHand! Item was removed: - ----- Method: RecordingControlsMorph>>playback (in category 'button commands') ----- - playback - "The user hit the playback button" - - recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. - recorder pause. - recorder playback. - ! Item was removed: - ----- Method: RecordingControlsMorph>>record (in category 'button commands') ----- - record - - recorder clearRecordedSound. - recorder resumeRecording. - ! Item was removed: - ----- Method: RecordingControlsMorph>>recorder (in category 'accessing') ----- - recorder - - ^ recorder - ! Item was removed: - ----- Method: RecordingControlsMorph>>show (in category 'button commands') ----- - show - "Show my samples in a WaveEditor." - - | ed w | - recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. - recorder pause. - ed := WaveEditor new. - ed data: recorder condensedSamples. - ed samplingRate: recorder samplingRate. - w := self world. - w activeHand - ifNil: [w addMorph: ed] - ifNotNil: [w activeHand attachMorph: ed]. - - ! Item was removed: - ----- Method: RecordingControlsMorph>>showEditor (in category 'button commands') ----- - showEditor - "Show my samples in a WaveEditor." - - | ed w | - recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. - recorder pause. - ed := WaveEditor new. - ed data: recorder condensedSamples. - ed samplingRate: recorder samplingRate. - w := self world. - w activeHand - ifNil: [w addMorph: ed] - ifNotNil: [w activeHand attachMorph: ed]. - - ! Item was removed: - ----- Method: RecordingControlsMorph>>startStepping (in category 'stepping and presenter') ----- - startStepping - "Make the level meter active when dropped into the world. Do nothing if already recording. Note that this will cause other recorders to stop recording..." - - super startStepping. - recorder isPaused ifTrue: [ - SoundRecorder allSubInstancesDo: [:r | r stopRecording]. "stop all other sound recorders" - recorder pause]. "meter is updated while paused" - ! Item was removed: - ----- Method: RecordingControlsMorph>>step (in category 'stepping and presenter') ----- - step - - recorder isPaused - ifTrue: [recordingStatusLight color: Color transparent] - ifFalse: [recordingStatusLight color: Color red]. - recordMeter extent: (recorder meterLevel + 1) @ recordMeter height. - ! Item was removed: - ----- Method: RecordingControlsMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^ 50 - ! Item was removed: - ----- Method: RecordingControlsMorph>>stop (in category 'stepping and presenter') ----- - stop - - recorder pause. - ! Item was removed: - ----- Method: RecordingControlsMorph>>stopStepping (in category 'stepping and presenter') ----- - stopStepping - "Turn off recording." - - super stopStepping. - recorder stopRecording. - ! Item was removed: - ----- Method: RecordingControlsMorph>>trim (in category 'button commands') ----- - trim - "Show my samples in a GraphMorph." - - recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. - recorder pause. - recorder trim: 1400 normalizedVolume: 80.0. - ! Item was removed: - ----- Method: RecordingControlsMorph>>updateReferencesUsing: (in category 'copying') ----- - updateReferencesUsing: aDictionary - "Copy my recorder." - - super updateReferencesUsing: aDictionary. - recorder := SoundRecorder new. - ! Item was removed: - ----- Method: Rectangle>>encodePostscriptOn: (in category '*MorphicExtras-Postscript Canvases') ----- - encodePostscriptOn:aStream - aStream write:self origin; print:' '; write:self extent; print:' '.! Item was removed: - ----- Method: RectangleMorph class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop} - forFlapNamed: 'PlugIn Supplies'.]! Item was removed: - ----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - ^ {DescriptionForPartsBin - formalName: 'RoundRect' translatedNoop - categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop} - documentation: 'A rectangle with rounded corners' translatedNoop - globalReceiverSymbol: #RectangleMorph - nativitySelector: #roundRectPrototype. - - DescriptionForPartsBin - formalName: 'Gradient' translatedNoop - categoryList: #() - documentation: 'A rectangle with a horizontal gradient' translatedNoop - globalReceiverSymbol: #RectangleMorph - nativitySelector: #gradientPrototype. - - DescriptionForPartsBin - formalName: 'Gradient (slanted)' translatedNoop - categoryList: #() - documentation: 'A rectangle with a diagonal gradient' translatedNoop - globalReceiverSymbol: #RectangleMorph - nativitySelector: #diagonalPrototype}! Item was removed: - ----- Method: RectangleMorph class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - BorderedMorph subclass: #ReferenceMorph - instanceVariableNames: 'referent isHighlighted' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Palettes'! - - !ReferenceMorph commentStamp: '<historical>' prior: 0! - Serves as a reference to any arbitrary morph; used, for example, as the tab in a tabbed palette The wrapper intercepts mouse events and fields them, passing them on to their referent morph.! Item was removed: - ----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'ref' translatedNoop! Item was removed: - ----- Method: ReferenceMorph class>>forMorph: (in category 'instance creation') ----- - forMorph: aMorph - "Create a new tab consisting of a string holding the morph's name" - ^ self new morphToInstall: aMorph! Item was removed: - ----- Method: ReferenceMorph class>>forMorph:font: (in category 'instance creation') ----- - forMorph: aMorph font: aFont - "Create a new tab consisting of a string holding the morph's name" - ^ self new morphToInstall: aMorph font: aFont! Item was removed: - ----- Method: ReferenceMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - "Add morph-specific items to the menu for the hand" - - | sketch | - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu addLine. - self isCurrentlyTextual - ifTrue: - [aCustomMenu add: 'change label wording...' translated action: #changeTabText. - aCustomMenu add: 'use graphical label' translated action: #useGraphicalTab] - ifFalse: - [aCustomMenu add: 'use textual label' translated action: #useTextualTab. - aCustomMenu add: 'choose graphic...' translated action: #changeTabGraphic. - (sketch := self findA: SketchMorph) ifNotNil: - [aCustomMenu add: 'repaint' translated target: sketch action: #editDrawing]]! Item was removed: - ----- Method: ReferenceMorph>>allNonSubmorphMorphs (in category 'submorphs - accessing') ----- - allNonSubmorphMorphs - "we hold extra morphs" - - ^ Array with: referent! Item was removed: - ----- Method: ReferenceMorph>>borderWidth: (in category 'accessing') ----- - borderWidth: aWidth - "Set the receiver's border width as indicated, and trigger a fresh layout" - - super borderWidth: aWidth. - self layoutChanged! Item was removed: - ----- Method: ReferenceMorph>>changeTabGraphic (in category 'menu') ----- - changeTabGraphic - submorphs first chooseNewGraphicCoexisting: true! Item was removed: - ----- Method: ReferenceMorph>>changeTabText (in category 'menu') ----- - changeTabText - | reply | - reply := UIManager default - request: 'new wording for this tab:' - initialAnswer: submorphs first contents. - reply isEmptyOrNil ifFalse: [submorphs first contents: reply]! Item was removed: - ----- Method: ReferenceMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 0! Item was removed: - ----- Method: ReferenceMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color transparent! Item was removed: - ----- Method: ReferenceMorph>>doButtonAction (in category 'button') ----- - doButtonAction - self tabSelected! Item was removed: - ----- Method: ReferenceMorph>>existingWording (in category 'menu') ----- - existingWording - ^ submorphs first contents asString! Item was removed: - ----- Method: ReferenceMorph>>fitContents (in category 'layout') ----- - fitContents - submorphs size = 1 ifTrue: - [self extent: submorphs first extent + (2 * self borderWidth). - submorphs first position: self position + self borderWidth]! Item was removed: - ----- Method: ReferenceMorph>>graphicalMorphForTab (in category 'menu') ----- - graphicalMorphForTab - | formToUse | - formToUse := self valueOfProperty: #priorGraphic ifAbsent: [ScriptingSystem formAtKey: 'squeakyMouse']. - ^ SketchMorph withForm: formToUse! Item was removed: - ----- Method: ReferenceMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^ true - ! Item was removed: - ----- Method: ReferenceMorph>>handlesMouseMove: (in category 'event handling') ----- - handlesMouseMove: anEvent - ^true! Item was removed: - ----- Method: ReferenceMorph>>highlight (in category 'accessing') ----- - highlight - | str | - isHighlighted := true. - submorphs notEmpty - ifTrue: - [((str := submorphs first) isKindOf: StringMorph) - ifTrue: [str color: self highlightColor] - ifFalse: - [self - borderWidth: 1; - borderColor: self highlightColor]]! Item was removed: - ----- Method: ReferenceMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - isHighlighted := false. - referent := nil! Item was removed: - ----- Method: ReferenceMorph>>isCurrentlyGraphical (in category 'accessing') ----- - isCurrentlyGraphical - "Answer whether the receiver is currently showing a graphical face" - - | first | - ^submorphs notEmpty and: - [((first := submorphs first) isKindOf: ImageMorph) - or: [first isSketchMorph]]! Item was removed: - ----- Method: ReferenceMorph>>isCurrentlyTextual (in category 'menu') ----- - isCurrentlyTextual - | first | - ^((first := submorphs first) isKindOf: StringMorph) - or: [first isTextMorph]! Item was removed: - ----- Method: ReferenceMorph>>isHighlighted (in category 'misc') ----- - isHighlighted - ^ isHighlighted == true! Item was removed: - ----- Method: ReferenceMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - self fitContents. - super layoutChanged! Item was removed: - ----- Method: ReferenceMorph>>morphToInstall (in category 'accessing') ----- - morphToInstall - ^ referent! Item was removed: - ----- Method: ReferenceMorph>>morphToInstall: (in category 'misc') ----- - morphToInstall: aMorph - "Create a new tab consisting of a string holding the morph's name" - | aLabel nameToUse | - aLabel := StringMorph new contents: (nameToUse := aMorph externalName). - self addMorph: aLabel. - aLabel lock. - self referent: aMorph. - self setNameTo: nameToUse. - self fitContents.! Item was removed: - ----- Method: ReferenceMorph>>morphToInstall:font: (in category 'misc') ----- - morphToInstall: aMorph font: aFont - "Create a new tab consisting of a string holding the morph's name" - | aLabel nameToUse | - aLabel := StringMorph contents: (nameToUse := aMorph externalName) font: aFont. - self addMorph: aLabel. - aLabel lock. - self referent: aMorph. - self setNameTo: nameToUse. - self fitContents.! Item was removed: - ----- Method: ReferenceMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - self setProperty: #oldColor toValue: color! Item was removed: - ----- Method: ReferenceMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - "The mouse moved while the butten was down in the receiver" - - | aForm | - aForm := self imageForm. - (self containsPoint: evt cursorPoint) - ifTrue: - [aForm reverse displayOn: Display] - ifFalse: - [aForm displayOn: Display]! Item was removed: - ----- Method: ReferenceMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - "The mouse came up in the receiver; If the mouse is still within the receiver at this point, do the corresponding action" - - | aColor | - (aColor := self valueOfProperty: #oldColor) ifNotNil: [self color: aColor]. - (self containsPoint: evt cursorPoint) - ifTrue: [self doButtonAction]. - super mouseUp: evt "send to evt handler if any" - ! Item was removed: - ----- Method: ReferenceMorph>>preserveDetails (in category 'menu') ----- - preserveDetails - "The receiver is being switched to use a different format. Preserve the existing details (e.g. wording if textual, grapheme if graphical) so that if the user reverts back to the current format, the details will be right" - - self isCurrentlyTextual - ifTrue: - [self setProperty: #priorWording toValue: self existingWording. - self setProperty: #priorColor toValue: self color. - self setProperty: #priorBorderWidth toValue: self borderWidth] - ifFalse: - [self setProperty: #priorGraphic toValue: self firstSubmorph form]! Item was removed: - ----- Method: ReferenceMorph>>referent (in category 'accessing') ----- - referent - ^ referent! Item was removed: - ----- Method: ReferenceMorph>>referent: (in category 'accessing') ----- - referent: m - referent := m! Item was removed: - ----- Method: ReferenceMorph>>setLabelFontTo: (in category 'menu') ----- - setLabelFontTo: aFont - "Change the receiver's label font to be as indicated" - - | aLabel oldLabel | - aLabel := StringMorph contents: (oldLabel := self findA: StringMorph) contents font: aFont. - self replaceSubmorph: oldLabel by: aLabel. - aLabel position: self position. - aLabel highlightColor: self highlightColor; regularColor: self regularColor. - aLabel lock. - self fitContents. - self layoutChanged. - (owner isKindOf: IndexTabs) ifTrue: - [self borderWidth: 0. - owner laySubpartsOutInOneRow. - isHighlighted ifTrue: - [self highlight]]! Item was removed: - ----- Method: ReferenceMorph>>setNameTo: (in category 'naming') ----- - setNameTo: aString - super setNameTo: aString. - (submorphs notEmpty and: [submorphs first isKindOf: StringMorph]) - ifTrue: [submorphs first contents: aString]! Item was removed: - ----- Method: ReferenceMorph>>sorterToken (in category 'misc') ----- - sorterToken - ^ SorterTokenMorph new forMorph: self! Item was removed: - ----- Method: ReferenceMorph>>tabSelected (in category 'events') ----- - tabSelected - "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette. Note that the 'opening' script concept has been left behind here." - | gramps | - (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. - ((gramps := owner owner) isKindOf: TabbedPalette) ifTrue: - [gramps selectTab: self]! Item was removed: - ----- Method: ReferenceMorph>>unHighlight (in category 'accessing') ----- - unHighlight - | str | - isHighlighted := false. - self borderWidth: 0. - submorphs notEmpty - ifTrue: - [((str := submorphs first) isKindOf: StringMorph orOf: RectangleMorph) - ifTrue: [str color: self regularColor]]! Item was removed: - ----- Method: ReferenceMorph>>useGraphicalTab (in category 'menu') ----- - useGraphicalTab - | aGraphic | - self preserveDetails. - self color: Color transparent. - aGraphic := self graphicalMorphForTab. - self borderWidth: 0. - self removeAllMorphs. - self addMorphBack: aGraphic. - aGraphic position: self position. - aGraphic lock. - self fitContents. - self layoutChanged. - (owner isKindOf: IndexTabs) ifTrue: - [owner laySubpartsOutInOneRow. - isHighlighted ifTrue: [self highlight]].! Item was removed: - ----- Method: ReferenceMorph>>useTextualTab (in category 'menu') ----- - useTextualTab - "Use a textually-emblazoned tab" - - | aLabel stringToUse font aColor | - self preserveDetails. - stringToUse := self valueOfProperty: #priorWording ifAbsent: [self externalName]. - font := self valueOfProperty: #priorFont ifAbsent: [Preferences standardButtonFont]. - aColor := self valueOfProperty: #priorColor ifAbsent: [Color green darker]. - aLabel := StringMorph contents: stringToUse font: font. - self replaceSubmorph: submorphs first by: aLabel. - aLabel position: self position. - self color: aColor. - aLabel highlightColor: self highlightColor; regularColor: self regularColor. - aLabel lock. - self fitContents. - self layoutChanged. - (owner isKindOf: IndexTabs) ifTrue: - [self borderWidth: 0. - owner laySubpartsOutInOneRow. - isHighlighted ifTrue: - [self highlight]]! Item was removed: - ----- Method: RemoteFileStream>>url (in category '*MorphicExtras-as yet unclassified') ----- - url - ^ remoteFile url! Item was removed: - HandMorph subclass: #RemoteHandMorph - instanceVariableNames: 'remoteWorldExtent remoteAddress sendSocket sendBuffer sendState socket waitingForConnection receiveBuffer' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalSupport'! Item was removed: - ----- Method: RemoteHandMorph class>>ensureNetworkConnected (in category 'utilities') ----- - ensureNetworkConnected - "Try to ensure that an intermittent network connection, such as a dialup or ISDN line, is actually connected. This is necessary to make sure a server is visible in order to accept an incoming connection. If the network connection does not work - the user has given up - return false. Otherwise, return true." - "RemoteHandMorph ensureNetworkConnected" - | address | - UIManager default - informUser: 'Ensuring your network connection works...' - during: [ - address := (NetNameResolver - addressForName: 'squeak.org' - timeout: 30)]. - ^ address notNil.! Item was removed: - ----- Method: RemoteHandMorph>>appendNewDataToReceiveBuffer (in category 'private') ----- - appendNewDataToReceiveBuffer - "Append all available raw data to my receive buffer. Assume that my socket is not nil." - - | newData tempBuf bytesRead | - socket dataAvailable ifTrue: [ - "get all the data currently available" - newData := WriteStream on: (String new: receiveBuffer size + 1000). - newData nextPutAll: receiveBuffer. - tempBuf := String new: 1000. - [socket dataAvailable] whileTrue: [ - bytesRead := socket receiveDataInto: tempBuf. - 1 to: bytesRead do: [:i | newData nextPut: (tempBuf at: i)]]. - receiveBuffer := newData contents]. - ! Item was removed: - ----- Method: RemoteHandMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "For remote cursors, always draw the hand itself (i.e., the cursor)." - - super drawOn: aCanvas. - aCanvas paintImage: NormalCursor at: self position. - ! Item was removed: - ----- Method: RemoteHandMorph>>getNextRemoteEvent (in category 'private') ----- - getNextRemoteEvent - "Return the next remote event, or nil if the receive buffer does not contain a full event record. An event record is the storeString for a MorphicEvent terminated by a <CR> character." - - | i s evt | - self receiveData. - receiveBuffer isEmpty ifTrue: [^ nil]. - - i := receiveBuffer indexOf: Character cr ifAbsent: [^ nil]. - s := receiveBuffer copyFrom: 1 to: i - 1. - receiveBuffer := receiveBuffer copyFrom: i + 1 to: receiveBuffer size. - evt := (MorphicEvent readFromString: s). - evt ifNil:[^nil]. - evt setHand: self. - evt isKeyboard ifTrue:[evt setPosition: self position]. - ^evt resetHandlerFields! Item was removed: - ----- Method: RemoteHandMorph>>handleListenEvent: (in category 'events-processing') ----- - handleListenEvent: anEvent - "Transmit the event to interested listeners" - | currentExtent | - currentExtent := self worldBounds extent. - self lastWorldExtent ~= currentExtent ifTrue: [ - self transmitEvent: (MorphicUnknownEvent new setType: #worldExtent argument: currentExtent). - self lastWorldExtent: currentExtent]. - self transmitEvent: anEvent.! Item was removed: - ----- Method: RemoteHandMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - remoteWorldExtent := 100 at 100. "initial guess" - socket := nil. - waitingForConnection := false. - receiveBuffer := ''. - sendState := #unconnected.! Item was removed: - ----- Method: RemoteHandMorph>>lastEventTransmitted (in category 'connections') ----- - lastEventTransmitted - ^self valueOfProperty: #lastEventTransmitted! Item was removed: - ----- Method: RemoteHandMorph>>lastEventTransmitted: (in category 'connections') ----- - lastEventTransmitted: anEvent - ^self setProperty: #lastEventTransmitted toValue: anEvent! Item was removed: - ----- Method: RemoteHandMorph>>lastWorldExtent (in category 'connections') ----- - lastWorldExtent - ^self valueOfProperty: #lastWorldExtent! Item was removed: - ----- Method: RemoteHandMorph>>lastWorldExtent: (in category 'connections') ----- - lastWorldExtent: extent - ^self setProperty: #lastWorldExtent toValue: extent! Item was removed: - ----- Method: RemoteHandMorph>>needsToBeDrawn (in category 'drawing') ----- - needsToBeDrawn - - ^true! Item was removed: - ----- Method: RemoteHandMorph>>processEvents (in category 'event handling') ----- - processEvents - "Process user input events from the remote input devices." - - | evt | - evt := self getNextRemoteEvent. - [evt notNil] whileTrue: - [evt type == #worldExtent - ifTrue: - [remoteWorldExtent := evt argument. - ^self]. - self handleEvent: evt. - evt := self getNextRemoteEvent]! Item was removed: - ----- Method: RemoteHandMorph>>readyToTransmit (in category 'connections') ----- - readyToTransmit - "Return true if the receiver is ready to send." - - (sendState == #connected) ifTrue:[ - sendSocket sendDone ifFalse:[^false]. - ^true]. - - sendState == #opening ifTrue:[ - sendSocket isConnected ifTrue:[^true]. - sendSocket isWaitingForConnection ifFalse:[ - Transcript show: 'trying connection again...'; cr. - sendSocket destroy. - sendSocket := Socket new. - sendSocket connectTo: self remoteHostAddress port: 54323]]. - - sendState == #closing ifTrue:[ - sendSocket isUnconnectedOrInvalid ifTrue:[ - sendSocket destroy. - sendState := #unconnected]]. - - ^false! Item was removed: - ----- Method: RemoteHandMorph>>receiveData (in category 'private') ----- - receiveData - "Check my connection status and withdraw from the world if the connection has been broken. Append any data that has arrived to receiveBuffer. " - - socket ifNotNil: [ - socket isConnected - ifTrue: [ "connected" - waitingForConnection ifTrue: [ - Transcript show: 'Remote hand ', userInitials, ' connected'; cr. - waitingForConnection := false]. - self appendNewDataToReceiveBuffer] - ifFalse: [ "not connected" - waitingForConnection ifFalse: [ - "connection was established, then broken" - self withdrawFromWorld. - receiveBuffer := '']]]. - ! Item was removed: - ----- Method: RemoteHandMorph>>remoteHostAddress (in category 'connections') ----- - remoteHostAddress - "Return the address of the remote host or zero if not connected." - ^remoteAddress ifNil:[0]! Item was removed: - ----- Method: RemoteHandMorph>>startListening (in category 'connections') ----- - startListening - "Create a socket and start listening for a connection." - - self stopListening. - Transcript show: 'My address is ', NetNameResolver localAddressString; cr. - Transcript show: 'Remote hand ', self userInitials, ' waiting for a connection...'; cr. - socket := Socket new. - socket listenOn: 54323. - waitingForConnection := true. - ! Item was removed: - ----- Method: RemoteHandMorph>>startTransmittingEvents (in category 'connections') ----- - startTransmittingEvents - "Attempt to broadcast events from this hand to a remote hand on the host with the given address. This method just creates the new socket and initiates a connection; it does not wait for the other end to answer." - (sendSocket notNil and:[sendSocket isConnected]) ifTrue:[^self]. - Transcript - show: 'Connecting to remote WorldMorph at '; - show: (NetNameResolver stringFromAddress: self remoteHostAddress), ' ...'; cr. - sendSocket := Socket newTCP. - sendSocket connectTo: self remoteHostAddress port: 54323. - sendState := #opening. - owner primaryHand addEventListener: self.! Item was removed: - ----- Method: RemoteHandMorph>>startTransmittingEventsTo: (in category 'connections') ----- - startTransmittingEventsTo: remoteAddr - "Attempt to broadcast events from this hand to a remote hand on the host with the given address. This method just creates the new socket and initiates a connection; it does not wait for the other end to answer." - remoteAddress := remoteAddr. - (sendSocket notNil and:[sendSocket isConnected]) ifTrue:[^self]. - Transcript - show: 'Connecting to remote WorldMorph at '; - show: (NetNameResolver stringFromAddress: self remoteHostAddress), ' ...'; cr. - sendSocket := Socket newTCP. - sendSocket connectTo: self remoteHostAddress port: 54323. - sendState := #opening. - owner primaryHand addEventListener: self.! Item was removed: - ----- Method: RemoteHandMorph>>stopListening (in category 'connections') ----- - stopListening - "Destroy the socket, if any, terminating the connection." - - socket ifNotNil: [ - socket destroy. - socket := nil]. - ! Item was removed: - ----- Method: RemoteHandMorph>>stopTransmittingEvents (in category 'connections') ----- - stopTransmittingEvents - "Stop broadcasting events from this world's cursor to a remote cursor on the host with the given address. This method issues a 'close' but does not destroy the socket; it will be destroyed when the other end reads the last data and closes the connection." - (sendSocket isUnconnectedOrInvalid) ifFalse:[ - sendSocket close. - sendState := #closing]. - owner primaryHand removeEventListener: self.! Item was removed: - ----- Method: RemoteHandMorph>>transmitEvent: (in category 'event handling') ----- - transmitEvent: aMorphicEvent - "Transmit the given event to all remote connections." - | firstEvt | - self readyToTransmit ifFalse: [^ self]. - self lastEventTransmitted = aMorphicEvent ifTrue: [^ self]. - sendBuffer ifNil: [sendBuffer := WriteStream on: (String new: 10000)]. - sendBuffer nextPutAll: aMorphicEvent storeString; cr. - self lastEventTransmitted: aMorphicEvent. - - sendSocket isConnected ifTrue:[ - sendState = #opening ifTrue: [ - "connection established; disable TCP delays on sends" - sendSocket setOption: 'TCP_NODELAY' value: true. - "send worldExtent as first event" - firstEvt := MorphicUnknownEvent type: #worldBounds argument: self worldBounds extent. - sendSocket sendData: firstEvt storeString, (String with: Character cr). - Transcript - show: 'Connection established with remote WorldMorph at '; - show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. - sendState := #connected]. - sendSocket sendData: sendBuffer contents. - ] ifFalse: [ - owner primaryHand removeEventListener: self. - sendState = #connected ifTrue: [ - "other end has closed; close our end" - Transcript - show: 'Closing connection with remote WorldMorph at '; - show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr. - sendSocket close. - sendState := #closing]]. - - sendBuffer reset. - ! Item was removed: - ----- Method: RemoteHandMorph>>withdrawFromWorld (in category 'other') ----- - withdrawFromWorld - "Close the socket, if any, and remove this hand from the world." - | addr | - addr := self remoteHostAddress. - addr = 0 ifFalse: [self stopTransmittingEvents]. - self stopListening. - Transcript show: 'Remote hand ', self userInitials, ' closed'; cr. - owner ifNotNil: [owner removeHand: self]. - ! Item was removed: - ----- Method: RemoteHandMorph>>worldBounds (in category 'geometry') ----- - worldBounds - - ^ 0 at 0 extent: remoteWorldExtent - ! Item was removed: - Morph subclass: #RotaryDialMorph - instanceVariableNames: 'startAngle stopAngle startValue stopValue needleMorph needleRotationCenter dialCenter currentValue' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !RotaryDialMorph commentStamp: 'tpr 4/13/2017 16:58' prior: 0! - RotaryDialMorph is the beginnings of a suite of morphs to display values in a round dial manner. Things like pressure, speed, time, voltage etc are al well absorbed from a rotary display. - - Instance Variables - dialCenter: <Point> - usuall the centre of the dial but consider VU meters where the pivot is pretty much at an edge. - needleMorph: <TransformationMorph> - wrapped around the morphs that make up the value indicating needle. This might a simple rectanglemorph, a composite like an ArrowMorph, an ImageMorph , whatever. - startAngle: <Number> - the start & stop angles are given in degrees from vertical up; although this causes much fun in working out the geometry it is much easier to think of a barometer going from -150 to +150 than -4.1887902047863905 to 1.0471975511965976 radians. The stopAngle needs to be further clockwise than the startAngle. - startValue: <Number> - the start & stopValues tell us what input data we must handle. It is possible to have the stopValue smaller than the startValue and effectively have the needle move backwards. This can be useful for dial where the pivot is at the top and the needle waggles around at the bottom. - stopAngle: <Number> - stopValue: <Number> - ! Item was removed: - ----- Method: RotaryDialMorph>>allaroundometer (in category 'examples') ----- - allaroundometer - "set up as an all-round type display like a clock or compass" - "RotaryDialMorph new allaroundometer openInWorld" - | pointerMorph | - self startAngle: 0 stopAngle: 360; - startValue: 0 stopValue: 1. - self extent: 200 at 200; - color: Color transparent. - dialCenter := self center. - self addMorph: (CircleMorph new extent: self extent). - pointerMorph := LineMorph from: 0 at 0 to: 0@ (self height // 2) color: Color red width: 2. - pointerMorph bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self inputValue: 0.25 - - ! Item was removed: - ----- Method: RotaryDialMorph>>backwardsometer (in category 'examples') ----- - backwardsometer - "set up as a backwards type display, ie +1 to left, -1 to right" - "RotaryDialMorph new backwardsometer openInWorld" - | pointerMorph | - self startAngle: -90 stopAngle: 90; - startValue: 1 stopValue: -1. - self extent: 200 at 200; - color: Color transparent. - dialCenter := self center. - - self addMorph: (CircleMorph new extent: self extent). - pointerMorph := LineMorph from: 0 at 0 to: 0@ (self height // 2) color: Color red width: 2. - pointerMorph bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self inputValue: 0 - - - ! Item was removed: - ----- Method: RotaryDialMorph>>backwardsupsidedownometer (in category 'examples') ----- - backwardsupsidedownometer - "set up as upsidedown backwards type display, ie -1 to left, 1 to right" - "RotaryDialMorph new backwardsupsidedownometer openInWorld" - | pointerMorph | - self startAngle: 110 stopAngle: -110; - startValue: -1 stopValue: 1. - self extent: 200 at 200; - color: Color transparent. - dialCenter := self center. - - self addMorph: (CircleMorph new extent: self extent). - pointerMorph := LineMorph from: 0 at 0 to: 0@ (self height // 2) color: Color blue width: 2. - pointerMorph bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self inputValue: 0 - - ! Item was removed: - ----- Method: RotaryDialMorph>>basicNeedleOfLength:width:color: (in category 'needle graphics') ----- - basicNeedleOfLength: nLength width: nWidth color: aColor - "make a really trivial needle as a colored rectangle" - ^RectangleMorph new extent: nWidth @ nLength; color: aColor; borderWidth: 1! Item was removed: - ----- Method: RotaryDialMorph>>basicometer (in category 'examples') ----- - basicometer - "set up as a forwards type display, ie 1 to left, +1 to right" - "RotaryDialMorph new basicometer openInWorld" - | pointerMorph | - self startAngle: -90 stopAngle: 90; - startValue: -1 stopValue: 1. - self extent: 200 at 200; - color: Color transparent. - dialCenter := self center. - - self addMorph: (CircleMorph new extent: self extent). - pointerMorph := LineMorph from: 0 at 0 to: 0@ (self height // 2) color: Color red width: 2. - pointerMorph bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self inputValue: 0 - - - ! Item was removed: - ----- Method: RotaryDialMorph>>buildDial (in category 'dial drawing') ----- - buildDial - "attempt a plausible default dial" - |outerRadius destForm canvas tickLabel tickLength beginAngle endAngle tickAngle tickLabelSize maxTicks | - outerRadius := self height - 1. - destForm := Form extent: self extent * 2 depth: 32. - (canvas := destForm getCanvas) fillOval: (0 at 0 extent: self extent * 2) color: Color white. - "outer ring" - self drawArcAt: destForm center radius: outerRadius thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - - beginAngle := startAngle -360. "needs cleaning up about this" - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.8 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.73 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - "Since this is a wild-guess default we'll try having 1 tick per integer value" - maxTicks := stopValue - startValue. - tickAngle := endAngle - beginAngle / maxTicks. - tickLength := outerRadius * 0.07. - startValue to: stopValue do: [:tick| - tickLabel := nil. - tickLabel := tick asString. - tickLabelSize := 24. - self drawTickRadius: outerRadius * 0.73 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - "self tickLabel1." - self tickLabel: tickLabel fontSize: tickLabelSize color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) + tickLength angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - ]. - - self addMorph: (destForm magnify: destForm boundingBox by: 0.5 smoothing: 2) asMorph! Item was removed: - ----- Method: RotaryDialMorph>>colorfulBasicometer (in category 'examples') ----- - colorfulBasicometer - "set up as a forwards type display, ie 1 to left, +1 to right" - "RotaryDialMorph new colorfulBasicometer openInWorld" - | pointerMorph textM | - self startAngle: -120 stopAngle: 120; - startValue: -1 stopValue: 1. - self extent: 300 at 300; - color: GradientFillStyle sample. - dialCenter := self center. - - self addMorph: (textM := TextMorph fancyPrototype). - textM extent: 250 at 30; contents: 'Wild colored RotaryDial HippieLand!!'; fontName: 'Darkmap DejuVu Sans' size: 22. - textM align: textM topCenter with: self topCenter. - pointerMorph := CurveMorph new vertices: {0 at 0. -10@ -50. 10@ -100} color: Color yellow borderWidth: 5 borderColor: Color blue. - pointerMorph makeOpen; makeForwardArrow.. - pointerMorph bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self inputValue: 0 - - - ! Item was removed: - ----- Method: RotaryDialMorph>>drawArcAt:radius:thickness:color:beginAngle:endAngle:onForm: (in category 'dial drawing') ----- - drawArcAt: arcCenter radius: arcRadius thickness: arcThickness color: arcColor beginAngle: beginAngle endAngle: endAngle onForm: dest - "angles clockwise from North in degrees; the endAngle must be clockwise of beginAngle. - To make life more fun we then convert to anti-clockwise-from-east radians for the geometry." - - | angle lw2 stop step newPt c diff form rho cell endRho | - - form := Form extent: dest extent depth: 32. - lw2 := arcThickness * 0.5. - angle := (90 - endAngle) degreesToRadians. - stop := (90 - beginAngle) degreesToRadians min: angle + Float twoPi. - step := 0.9 / arcRadius. - [ - rho := arcRadius - lw2 - 0.5. - endRho := arcRadius + lw2 + 0.5. - [rho <= endRho] whileTrue: [ - cell := (rho * angle cos) rounded @ (rho * angle sin) rounded negated. - newPt := arcCenter + cell. - diff := (cell r - arcRadius) abs. - c := diff <= lw2 ifTrue: [arcColor] ifFalse: [arcColor alpha: 1.0 - (diff - lw2)]. - form colorAt: newPt put: c. - rho := rho + 0.5. - ]. - (angle := angle + step) <= stop - ] whileTrue. - dest getCanvas translucentImage: form at: 0 at 0. - ! Item was removed: - ----- Method: RotaryDialMorph>>drawTickRadius:length:thickness:color:angle:onCanvas: (in category 'dial drawing') ----- - drawTickRadius: radius length: length thickness: thickness color: color angle: angle onCanvas: canvas - "angles clockwise from North in degrees" - - | newPt cell pts rads | - rads := (90 - angle) degreesToRadians. - pts := {radius. radius + length + 0.5} collect: [ :rho | - cell := (rho * rads cos) rounded @ (rho * rads sin) rounded negated. - newPt := dialCenter * 2 + cell. - ]. - canvas line: pts first to: pts second width: thickness color: color - ! Item was removed: - ----- Method: RotaryDialMorph>>fancyNeedleOfLength: (in category 'needle graphics') ----- - fancyNeedleOfLength: aNumber - "we can make a fancy-schmancy barometer type needle with a curly arrow and moon-shaped tail and then scale it to a length" - ^self fancyNeedleOfLength: aNumber color: Color black! Item was removed: - ----- Method: RotaryDialMorph>>fancyNeedleOfLength:color: (in category 'needle graphics') ----- - fancyNeedleOfLength: aNumber color: aColor - "we can make a fancy-schmancy barometer type needle with a curly arrow and moon-shaped tail and then scale it to a length" - | fancy smaller | - - fancy := Form extent: 100 at 500 depth: 32. - fancy fillColor: Color white. - fancy getCanvas - fillOval: (5 at 405 extent: 90 at 90) color: aColor; - fillOval: (15 at 430 extent: 70 at 70) color: Color white; - fillRectangle: (20 at 40 extent: 60 at 60) color: aColor; - fillOval: (-348@ -200 extent: 400 at 400) color: Color white; - fillOval: (48@ -200 extent: 400 at 400) color: Color white; - fillRectangle: (48 at 10 extent: 4 at 400) color: aColor. - fancy replaceColor: Color white withColor: Color transparent. - - smaller := fancy magnify: fancy boundingBox by: (aNumber / fancy boundingBox height) smoothing: 2. - ^smaller asMorph. - ! Item was removed: - ----- Method: RotaryDialMorph>>initialExtent (in category 'initialize-release') ----- - initialExtent - - ^ ((200 at 200) * RealEstateAgent scaleFactor) rounded! Item was removed: - ----- Method: RotaryDialMorph>>inputValue: (in category 'updating') ----- - inputValue: aNumber - "move the needleMorph to display the value; we clamp it to the range - [startValue, stopValue]" - | input newDegrees | - stopValue > startValue - ifTrue: [input := aNumber min: stopValue max: startValue] - ifFalse: [input := aNumber min: startValue max: stopValue]. - currentValue := input. - newDegrees := currentValue - startValue / (stopValue - startValue) * ((stopAngle - startAngle)\\360) + startAngle. - needleMorph rotationDegrees: newDegrees \\ 360! Item was removed: - ----- Method: RotaryDialMorph>>simpleNeedleOfLength: (in category 'needle graphics') ----- - simpleNeedleOfLength: aNumber - - ^self simpleNeedleOfLength: aNumber color: Color black! Item was removed: - ----- Method: RotaryDialMorph>>simpleNeedleOfLength:color: (in category 'needle graphics') ----- - simpleNeedleOfLength: aNumber color: aColor - "we can make a simpler type needle with a curly arrow and no tail and then scale it to a length" - | fancy smaller | - - fancy := Form extent: 100 at 500 depth: 32. - fancy fillColor: Color white. - fancy getCanvas - fillRectangle: (20 at 40 extent: 60 at 60) color: aColor; - fillOval: (-348@ -200 extent: 400 at 400) color: Color white; - fillOval: (48@ -200 extent: 400 at 400) color: Color white; - fillRectangle: (48 at 10 extent: 4 at 490) color: aColor. - fancy replaceColor: Color white withColor: Color transparent. - - smaller := fancy magnify: fancy boundingBox by: (aNumber / fancy boundingBox height) smoothing: 2. - ^smaller asMorph. - ! Item was removed: - ----- Method: RotaryDialMorph>>startAngle:stopAngle: (in category 'accessing') ----- - startAngle: angle1 stopAngle: angle2 - "set the start and stop angles of the dial; we modulo them with 360 to keep things logical" - startAngle := angle1 \\ 360. - stopAngle := angle2 \\ 360. - - "if the two angles end up the same then we will guess that in fact the user wants a full-rotation rather than nothing. " - startAngle = stopAngle ifTrue:[ - angle1 < angle2 ifTrue:[stopAngle := (startAngle +359.9) \\360]. - angle2 < angle1 ifTrue:[stopAngle := (startAngle - 359.9) \\360]] - "if the input angles actually were the same then the user has made a mistake and we can't really solve it. Install a better user?"! Item was removed: - ----- Method: RotaryDialMorph>>startValue:stopValue: (in category 'accessing') ----- - startValue: value1 stopValue: value2 - "set the start and stop values for the dial readings. Note that they can be backwards to allow the needle to rotate counter clockwise for increasing inputs" - startValue := value1. - stopValue := value2! Item was removed: - ----- Method: RotaryDialMorph>>tickInnerLabel:fontSize:color:centeredAt:radius:angle:onCanvas: (in category 'dial drawing') ----- - tickInnerLabel: aString fontSize: fSize color: aColor centeredAt: aPoint radius: radius angle: angle onCanvas: canvas - "draw the label string centered on the point radius from the centre point, at the angle. Long strings will almost certainly cause problems" - | cell font pos rads rho stringExtent f rot | - aString ifNil: [^self]. - font := TextStyle default fontOfSize: fSize. - "draw the string and rotate it; we flip the angle to keep the letters kinda-sorta the right way up to read easily" - stringExtent := (StringMorph contents: aString font: font ) imageForm boundingBox extent. - f := Form extent: stringExtent depth: 32. - f getCanvas drawString: aString in: (0 at 0 extent: stringExtent) font: font color: aColor. - (angle \\ 360 between: 90.5 and: 269.5) ifTrue:[ - rot := angle - 180] ifFalse: [ - rot := angle ]. - f := f rotateBy: rot smoothing: 2. - - "the radius is reduced by a bit more than half the string height to fit it reasonably neatly inside the radius" - rho := radius - (stringExtent y /1.7). - rads := (90 - angle) degreesToRadians. - cell := (rho * rads cos) rounded @ (rho * rads sin) rounded negated. - pos := aPoint * 2 + cell - (f extent // 2). - canvas translucentImage: f at: pos! Item was removed: - ----- Method: RotaryDialMorph>>tickLabel:fontSize:color:centeredAt:radius:angle:onCanvas: (in category 'dial drawing') ----- - tickLabel: aString fontSize: fSize color: aColor centeredAt: aPoint radius: radius angle: angle onCanvas: canvas - "draw the label string unrotated outside the radius centered on the centre point. We try to get the center of the string bounds on the relevant point but it may look odd for certain strings" - | cell font pos rads rho stringExtent | - aString ifNil: [^self]. - - font := TextStyle default fontOfSize: fSize. - stringExtent := (StringMorph contents: aString font: font ) imageForm boundingBox extent. - rho := radius + (stringExtent r /2). - rads := (90 - angle) degreesToRadians. - cell := (rho * rads cos) rounded @ (rho * rads sin) rounded negated. - pos := aPoint * 2 + cell - (stringExtent // 2). - canvas drawString: aString in: (pos extent: stringExtent) font: font color: aColor! Item was removed: - ----- Method: RotaryDialMorph>>upsidedownometer (in category 'examples') ----- - upsidedownometer - "set up as a forwards but upside-down type display, ie 1 to left, +1 to right" - "RotaryDialMorph new upsidedownometer openInWorld" - | pointerMorph | - self startAngle: 100 stopAngle: -100; - startValue: -1 stopValue: 1. - self extent: 200 at 200; - color: Color transparent. - dialCenter := self center. - - self addMorph: (CircleMorph new extent: self extent). - pointerMorph := LineMorph from: 0 at 0 to: 0@ (self height // 2) color: Color red width: 2. - pointerMorph bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self inputValue: 0 - - - ! Item was removed: - ----- Method: RotaryDialMorph>>vumeter (in category 'examples') ----- - vumeter - "set up as a VU meter type display" - "RotaryDialMorph new vumeter openInWorld" - | pointerMorph | - self startAngle: 35 stopAngle: 145; - startValue: -10 stopValue: 10. - self extent: 100 at 200. - dialCenter := -60 at 100. - pointerMorph := RectangleMorph new extent: 4 at 150; color: Color black; bottomRight: 0 at 0. - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - self addMorph: (CircleMorph new extent: 200 at 200; center: dialCenter). - self inputValue: 0. - self color: Color white; borderWidth: 3; borderColor: Color black; clipSubmorphs: true - - ! Item was removed: - ----- Method: SampledSound class>>exampleBach (in category '*MorphicExtras-examples') ----- - exampleBach - "SampledSound exampleBach" - - | url | - url := 'http://upload.wikimedia.org/wikipedia/commons/4/4e/Bach_Brandenburg_4_coda_to_the_3rd_movement.wav'. - - ^ Imports default imports - at: #exampleBach - ifAbsentPut: [ - self notify: ('This action will download the following content:\\{1}\\Do you want to proceed?' translated withCRs format: {url}). - self fromWaveStream: (HTTPSocket httpGet: url)]! Item was removed: - RectangleMorph subclass: #ScaleMorph - instanceVariableNames: 'caption start stop minorTick minorTickLength majorTick majorTickLength tickPrintBlock labelsAbove captionAbove' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !ScaleMorph commentStamp: '<historical>' prior: 0! - Rewrite of ScaleMorph - March 2000 (Russell Swan). Added accessors. Added two Booleans, labelsAbove and captionAbove. Determines where the labels and captions print, if they exist. Tick marks can either go up or down. For ticks going up, put in majorTickLength > 0. Negative value will make ticks go down. Examples on Class side.! Item was removed: - ----- Method: ScaleMorph class>>example1 (in category 'examples') ----- - example1 - "Example 1 captions and labels above, ticks point up" - ^ (self new - start: 0 - stop: 150 - minorTick: 1 - minorTickLength: 2 - majorTick: 10 - majorTickLength: 10 - caption: 'Example 1' - tickPrintBlock: [:v | v printString]; - width: 300) openInWorld! Item was removed: - ----- Method: ScaleMorph class>>example2 (in category 'examples') ----- - example2 - "Example 2 captions and labels above, ticks point down" - ^ (self new - start: 0 - stop: 150 - minorTick: 1 - minorTickLength: 2 - majorTick: 10 - majorTickLength: -10 - caption: 'Example 2' - tickPrintBlock: [:v | v printString]; - width: 300) openInWorld! Item was removed: - ----- Method: ScaleMorph class>>example3 (in category 'examples') ----- - example3 - "Example 3 caption above, labels below, ticks point down" - ^ (self new - start: -23 - stop: 47 - minorTick: 1 - minorTickLength: 2 - majorTick: 10 - majorTickLength: -10 - caption: 'Example 3' - tickPrintBlock: [:v | v printString] - labelsAbove: false - captionAbove: true; - color: Color lightBlue; - width: 300) openInWorld! Item was removed: - ----- Method: ScaleMorph class>>example4 (in category 'examples') ----- - example4 - "Example 4 caption below, labels above, ticks point up" - ^ (self new - start: 100000 - stop: 300000 - minorTick: 5000 - minorTickLength: 2 - majorTick: 50000 - majorTickLength: 10 - caption: 'Example 4' - tickPrintBlock: [:v | '$' , v printString] - labelsAbove: true - captionAbove: false; - color: Color lightOrange; - width: 300) openInWorld! Item was removed: - ----- Method: ScaleMorph>>buildLabels (in category 'drawing') ----- - buildLabels - | scale x1 y1 y2 captionMorph loopStart offset | - majorTickLength * minorTickLength < 0 - ifTrue: [minorTickLength := 0 - minorTickLength]. - self removeAllMorphs. - caption ifNotNil: - [captionMorph := StringMorph contents: caption. - offset := captionAbove - ifTrue: [majorTickLength abs + captionMorph height + 7] - ifFalse: [2]. - captionMorph align: captionMorph bounds bottomCenter - with: self bounds bottomCenter - (0 @ offset). - self addMorph: captionMorph]. - tickPrintBlock ifNotNil: - ["Calculate the offset for the labels, depending on whether or not - 1) there's a caption - below, 2) the labels are above or below the ticks, and 3) the - ticks go up or down" - - offset := labelsAbove - ifTrue: [majorTickLength abs + minorTickLength abs + 2] - ifFalse: [2]. - caption - ifNotNil: [captionAbove ifFalse: [offset := offset + captionMorph height + 2]]. - scale := (self innerBounds width - 1) / (stop - start) asFloat. - x1 := self innerBounds left. - y1 := self innerBounds bottom. - y2 := y1 - offset. - "Start loop on multiple of majorTick" - loopStart := (start / majorTick) ceiling * majorTick. - loopStart to: stop - by: majorTick - do: - [:v | | x tickMorph | - x := x1 + (scale * (v - start)). - tickMorph := StringMorph contents: (tickPrintBlock value: v). - tickMorph align: tickMorph bounds bottomCenter with: x @ y2. - tickMorph left < self left - ifTrue: [tickMorph position: self left @ tickMorph top]. - tickMorph right > self right - ifTrue: [tickMorph position: (self right - tickMorph width) @ tickMorph top]. - self addMorph: tickMorph]]! Item was removed: - ----- Method: ScaleMorph>>caption (in category 'accessing') ----- - caption - ^ caption.! Item was removed: - ----- Method: ScaleMorph>>caption: (in category 'accessing') ----- - caption: aString - caption := aString.! Item was removed: - ----- Method: ScaleMorph>>captionAbove: (in category 'accessing') ----- - captionAbove: aBoolean - captionAbove := aBoolean! Item was removed: - ----- Method: ScaleMorph>>checkExtent: (in category 'geometry') ----- - checkExtent: newExtent - | pixPerTick newWidth | - pixPerTick := newExtent x - (self borderWidth * 2) - 1 / ((stop - start) asFloat / minorTick). - pixPerTick := pixPerTick - detentBy: 0.1 - atMultiplesOf: 1.0 - snap: false. - newWidth := pixPerTick * ((stop - start) asFloat / minorTick) + (self borderWidth * 2) + 1. - ^ (newWidth @ newExtent y).! Item was removed: - ----- Method: ScaleMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - - labelsAbove ifNil: [labelsAbove := true]. - captionAbove ifNil: [captionAbove := true]. - ^super convertToCurrentVersion: varDict refStream: smartRefStrm. - ! Item was removed: - ----- Method: ScaleMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 0! Item was removed: - ----- Method: ScaleMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGreen! Item was removed: - ----- Method: ScaleMorph>>drawMajorTicksOn: (in category 'drawing') ----- - drawMajorTicksOn: aCanvas - | scale x1 y1 y2 y3 loopStart checkStart yoffset randomLabel even | - scale := (self innerBounds width - 1) / (stop - start) asFloat. - yoffset := majorTickLength < 0 - ifTrue: [ majorTickLength abs + 1] - ifFalse: [1]. - caption ifNotNil: - [captionAbove - ifFalse: - [randomLabel := StringMorph contents: 'Foo'. - yoffset := yoffset + randomLabel height + 2]]. - tickPrintBlock ifNotNil: - [labelsAbove - ifFalse: - [randomLabel := StringMorph contents: '50'. - yoffset := yoffset + randomLabel height + 2]]. - x1 := self innerBounds left. - y1 := self innerBounds bottom - yoffset. - y2 := y1 - majorTickLength. - y3 := y1 - ((minorTickLength + majorTickLength) // 2). - even := true. - "Make sure major ticks start drawing on a multiple of majorTick" - loopStart := (start / majorTick) ceiling * majorTick. - checkStart := (start / (majorTick / 2.0)) ceiling * majorTick. - "Check to see if semimajor tick should be drawn before majorTick" - checkStart = (loopStart * 2) - ifFalse: - [loopStart := checkStart / 2.0. - even := false]. - loopStart to: stop - by: majorTick / 2.0 - do: - [:v | | yy x | - x := x1 + (scale * (v - start)). - yy := even ifTrue: [y2] ifFalse: [y3]. - aCanvas - line: x @ y1 - to: x @ yy - width: 1 - color: Color black. - even := even not]! Item was removed: - ----- Method: ScaleMorph>>drawMinorTicksOn: (in category 'drawing') ----- - drawMinorTicksOn: aCanvas - | scale x1 y1 y2 loopStart yoffset randomLabel | - scale := (self innerBounds width - 1) / (stop - start) asFloat. - yoffset := majorTickLength < 0 - ifTrue: [majorTickLength abs + 1] - ifFalse: [1]. - caption ifNotNil: - [captionAbove - ifFalse: - [randomLabel := StringMorph contents: 'Foo'. - yoffset := yoffset + randomLabel height + 2]]. - tickPrintBlock ifNotNil: - [labelsAbove - ifFalse: - [randomLabel := StringMorph contents: '50'. - yoffset := yoffset + randomLabel height + 2]]. - x1 := self innerBounds left. - y1 := self innerBounds bottom - yoffset. - y2 := y1 - minorTickLength. - loopStart := (start / minorTick) ceiling * minorTick. - loopStart to: stop - by: minorTick - do: - [:v | | x | - x := x1 + (scale * (v - start)). - aCanvas - line: x @ y1 - to: x @ y2 - width: 1 - color: Color black]! Item was removed: - ----- Method: ScaleMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | | - super drawOn: aCanvas. - - self drawTicksOn: aCanvas.! Item was removed: - ----- Method: ScaleMorph>>drawTicksOn: (in category 'drawing') ----- - drawTicksOn: aCanvas - self drawMajorTicksOn: aCanvas. - self drawMinorTicksOn: aCanvas! Item was removed: - ----- Method: ScaleMorph>>extent: (in category 'geometry') ----- - extent: newExtent - | modExtent | - modExtent := self checkExtent: newExtent. - super extent: modExtent. - self buildLabels! Item was removed: - ----- Method: ScaleMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - start := 0. - stop := 100. - minorTick := 1. - majorTick := 10. - minorTickLength := 3. - majorTickLength := 10. - caption := nil. - tickPrintBlock := [:v | v printString]. - labelsAbove := true. - captionAbove := true! Item was removed: - ----- Method: ScaleMorph>>labelsAbove: (in category 'accessing') ----- - labelsAbove: aBoolean - labelsAbove := aBoolean.! Item was removed: - ----- Method: ScaleMorph>>majorTickLength: (in category 'accessing') ----- - majorTickLength: anInteger - majorTickLength := anInteger! Item was removed: - ----- Method: ScaleMorph>>minorTickLength: (in category 'accessing') ----- - minorTickLength: anInteger - minorTickLength := anInteger.! Item was removed: - ----- Method: ScaleMorph>>start (in category 'stepping and presenter') ----- - start - ^ start! Item was removed: - ----- Method: ScaleMorph>>start: (in category 'accessing') ----- - start: aNumber - start := aNumber.! Item was removed: - ----- Method: ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength: (in category 'initialization') ----- - start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen - - self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: nil tickPrintBlock: nil - ! Item was removed: - ----- Method: ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock: (in category 'initialization') ----- - start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk - self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: true captionAbove: true. - ! Item was removed: - ----- Method: ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock:labelsAbove:captionAbove: (in category 'initialization') ----- - start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: aBoolean captionAbove: notherBoolean - start := strt. - stop := stp. - minorTick := mnt. - minorTickLength := mntLen. - majorTick := mjt. - majorTickLength := mjtLen. - caption := cap. - tickPrintBlock := blk. - labelsAbove := aBoolean. - captionAbove := notherBoolean. - self buildLabels! Item was removed: - ----- Method: ScaleMorph>>stop (in category 'stepping and presenter') ----- - stop - ^ stop! Item was removed: - ----- Method: ScaleMorph>>stop: (in category 'accessing') ----- - stop: aNumber - stop := aNumber.! Item was removed: - ----- Method: ScaleMorph>>tickPrintBlock: (in category 'accessing') ----- - tickPrintBlock: aBlock - tickPrintBlock := aBlock.! Item was removed: - AlignmentMorph subclass: #ScorePlayerMorph - instanceVariableNames: 'scorePlayer trackInstNames instrumentSelector scrollSlider' - classVariableNames: 'LastMIDIPort' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! - - !ScorePlayerMorph commentStamp: '<historical>' prior: 0! - A ScorePlayerMorph mediates between a score such as a MIDIScore, a PianoRollScoreMorph, and the actual SoundPlayer synthesizer. - - It provides control over volume, tempo, instrumentation, and location in the score.! Item was removed: - ----- Method: ScorePlayerMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'ScorePlayer' - categories: #('Multimedia') - documentation: ' Mediates between a score such as a MIDIScore, a PianoRollScoreMorph, and the actual SoundPlayer synthesizer'! Item was removed: - ----- Method: ScorePlayerMorph class>>extraExample (in category '*MorphicExtras-examples') ----- - extraExample - "ScorePlayerMorph extraExample openInHand" - - ^ self on: MIDIScore extraExample! Item was removed: - ----- Method: ScorePlayerMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^(suffix = 'mid') | (suffix = '*') - ifTrue: [ self services] - ifFalse: [#()] - ! Item was removed: - ----- Method: ScorePlayerMorph class>>initialize (in category 'class initialization') ----- - initialize - - FileServices registerFileReader: self! Item was removed: - ----- Method: ScorePlayerMorph class>>on: (in category 'system hookup') ----- - on: aScore - - | player | - player := ScorePlayer onScore: aScore. - ^ self new onScorePlayer: player! Item was removed: - ----- Method: ScorePlayerMorph class>>onMIDIFileNamed: (in category 'system hookup') ----- - onMIDIFileNamed: fileName - "Return a ScorePlayerMorph on the score from the MIDI file of the given name." - - | score player | - score := MIDIFileReader scoreFromFileNamed: fileName . - player := ScorePlayer onScore: score. - ^ self new onScorePlayer: player title: fileName - ! Item was removed: - ----- Method: ScorePlayerMorph class>>openOn: (in category 'system hookup') ----- - openOn: aScore - - (self on: aScore) openInWorld.! Item was removed: - ----- Method: ScorePlayerMorph class>>openOn:title: (in category 'system hookup') ----- - openOn: aScore title: aString - - | player | - player := ScorePlayer onScore: aScore. - (self new onScorePlayer: player title: aString) openInWorld. - ! Item was removed: - ----- Method: ScorePlayerMorph class>>playMidiFile: (in category 'class initialization') ----- - playMidiFile: fullName - "Play a MIDI file." - - Smalltalk at: #MIDIFileReader ifPresent: [:midiReader | - | f score | - f := (FileStream oldFileNamed: fullName) binary. - score := (midiReader new readMIDIFrom: f) asScore. - f close. - self openOn: score title: (FileDirectory localNameFor: fullName)] - ! Item was removed: - ----- Method: ScorePlayerMorph class>>servicePlayMidiFile (in category 'class initialization') ----- - servicePlayMidiFile - "Answer a service for opening player on a midi file" - - ^ SimpleServiceEntry - provider: self - label: 'open in midi player' - selector: #playMidiFile: - description: 'open the midi-player tool on this file' - buttonLabel: 'open'! Item was removed: - ----- Method: ScorePlayerMorph class>>services (in category 'fileIn/Out') ----- - services - - ^ Array with: self servicePlayMidiFile - - ! Item was removed: - ----- Method: ScorePlayerMorph class>>unload (in category 'initialize-release') ----- - unload - - FileServices unregisterFileReader: self ! Item was removed: - ----- Method: ScorePlayerMorph>>addNewScore (in category 'menu') ----- - addNewScore - "Open a MIDI score and re-init controls..." - | score player | - - score := MIDIScore new. - score tracks: (Array with: Array new). - score trackInfo: #('Instrument'). - player := ScorePlayer onScore: score. - ^self onScorePlayer: player! Item was removed: - ----- Method: ScorePlayerMorph>>addTrackToScore (in category 'menu') ----- - addTrackToScore - "add a instrument track to the current score" - | score tracks trackInfo player | - score := scorePlayer score. - tracks := score tracks copyWith:#(). - score tracks: tracks. - trackInfo := score trackInfo copyWith: 'Instrument'. - score trackInfo: trackInfo. - player := ScorePlayer onScore: score. - ^self onScorePlayer: player! Item was removed: - ----- Method: ScorePlayerMorph>>atTrack:from:selectInstrument: (in category 'controls') ----- - atTrack: trackIndex from: aPopUpChoice selectInstrument: selection - | oldSnd name snd | - oldSnd := scorePlayer instrumentForTrack: trackIndex. - (selection beginsWith: 'edit ') - ifTrue: - [name := selection copyFrom: 6 to: selection size. - aPopUpChoice contentsClipped: name. - (oldSnd isKindOf: FMSound) | (oldSnd isKindOf: LoopedSampledSound) - ifTrue: [EnvelopeEditorMorph openOn: oldSnd title: name]. - (oldSnd isKindOf: SampledInstrument) - ifTrue: [EnvelopeEditorMorph openOn: oldSnd allNotes first title: name]. - ^self]. - snd := nil. - 1 to: instrumentSelector size - do: - [:i | - (trackIndex ~= i and: [selection = (instrumentSelector at: i) contents]) - ifTrue: [snd := scorePlayer instrumentForTrack: i]]. "use existing instrument prototype" - snd ifNil: - [snd := (selection = 'clink' - ifTrue: - [(SampledSound samples: SampledSound coffeeCupClink - samplingRate: 11025) ] - ifFalse: [(AbstractSound soundNamed: selection)]) copy]. - scorePlayer instrumentForTrack: trackIndex put: snd. - (instrumentSelector at: trackIndex) contentsClipped: selection! Item was removed: - ----- Method: ScorePlayerMorph>>closeMIDIPort (in category 'initialization') ----- - closeMIDIPort - - scorePlayer closeMIDIPort. - LastMIDIPort := nil. - ! Item was removed: - ----- Method: ScorePlayerMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 2! Item was removed: - ----- Method: ScorePlayerMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color veryLightGray! Item was removed: - ----- Method: ScorePlayerMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self listDirection: #topToBottom; - wrapCentering: #center; - cellPositioning: #topCenter; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 3; - onScorePlayer: ScorePlayer new initialize; - extent: 20 @ 20 ! Item was removed: - ----- Method: ScorePlayerMorph>>instrumentChoicesForTrack: (in category 'menu') ----- - instrumentChoicesForTrack: trackIndex - | names | - names := AbstractSound soundNames asOrderedCollection. - names := names collect: [:n | - | inst | - inst := AbstractSound soundNamed: n. - (inst isKindOf: UnloadedSound) - ifTrue: [n, '(out)'] - ifFalse: [n]]. - names add: 'clink'. - names add: 'edit ', (instrumentSelector at: trackIndex) contents. - ^ names asArray - ! Item was removed: - ----- Method: ScorePlayerMorph>>invokeMenu (in category 'menu') ----- - invokeMenu - "Invoke a menu of additonal functions for this ScorePlayer." - | aMenu | - aMenu := MenuMorph new defaultTarget: self. - aMenu add: 'add a new score' translated action: #addNewScore. - aMenu add: 'add a new track to score' translated action: #addTrackToScore. - aMenu add: 'open a MIDI file' translated action: #openMIDIFile. - aMenu addList: {#-. {'save as AIFF file' translated. #saveAsAIFF}. {'save as WAV file' translated. #saveAsWAV}. {'save as Sun AU file' translated. #saveAsSunAudio}. #-}. - aMenu - add: 'reload instruments' translated - target: AbstractSound - selector: #updateScorePlayers. - aMenu addLine. - scorePlayer midiPort - ifNil: [aMenu add: 'play via MIDI' translated action: #openMIDIPort] - ifNotNil: [aMenu add: 'play via built in synth' translated action: #closeMIDIPort. - aMenu add: 'new MIDI controller' translated action: #makeMIDIController:]. - aMenu addLine. - aMenu add: 'make a pause marker' translated action: #makeAPauseEvent:. - aMenu popUpInWorld: self world! Item was removed: - ----- Method: ScorePlayerMorph>>makeAPauseEvent: (in category 'menu') ----- - makeAPauseEvent: evt - - | newWidget | - - newWidget := AlignmentMorph newRow. - newWidget - color: Color orange; - borderWidth: 0; - layoutInset: 0; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - extent: 5 at 5; - addMorph: (StringMorph contents: '[pause]' translated) lock; - addMouseUpActionWith: ( - MessageSend receiver: self selector: #showResumeButtonInTheWorld - ). - - evt hand attachMorph: newWidget.! Item was removed: - ----- Method: ScorePlayerMorph>>makeControls (in category 'layout') ----- - makeControls - - | bb r reverbSwitch repeatSwitch | - r := AlignmentMorph newRow. - r color: color; borderWidth: 0; layoutInset: 0. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - bb := SimpleButtonMorph new target: self; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Menu' translated; actWhen: #buttonDown; - actionSelector: #invokeMenu). - bb := SimpleButtonMorph new target: self; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Piano Roll' translated; actionSelector: #makePianoRoll). - bb := SimpleButtonMorph new target: self; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Rewind' translated; actionSelector: #rewind). - bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Play' translated; actionSelector: #resumePlaying). - bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Pause' translated; actionSelector: #pause). - reverbSwitch := SimpleSwitchMorph new - offColor: color; - onColor: (Color r: 1.0 g: 0.6 b: 0.6); - borderWidth: 2; - label: 'Reverb Disable' translated; - actionSelector: #disableReverb:; - target: scorePlayer; - setSwitchState: SoundPlayer isReverbOn not. - r addMorphBack: reverbSwitch. - scorePlayer ifNotNil: - [repeatSwitch := SimpleSwitchMorph new - offColor: color; - onColor: (Color r: 1.0 g: 0.6 b: 0.6); - borderWidth: 2; - label: 'Repeat' translated; - actionSelector: #repeat:; - target: scorePlayer; - setSwitchState: scorePlayer repeat. - r addMorphBack: repeatSwitch]. - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>makeMIDIController: (in category 'layout') ----- - makeMIDIController: evt - - self world activeHand attachMorph: - (MIDIControllerMorph new midiPort: scorePlayer midiPort). - ! Item was removed: - ----- Method: ScorePlayerMorph>>makePianoRoll (in category 'layout') ----- - makePianoRoll - "Create a piano roll viewer for this score player." - - | pianoRoll hand | - pianoRoll := PianoRollScoreMorph new on: scorePlayer. - hand := self world activeHand. - hand ifNil: [self world addMorph: pianoRoll] - ifNotNil: [hand attachMorph: pianoRoll. - hand lastEvent shiftPressed ifTrue: - ["Special case for NOBM demo" - pianoRoll contractTime; contractTime; enableDragNDrop]]. - pianoRoll startStepping. - ! Item was removed: - ----- Method: ScorePlayerMorph>>makeRow (in category 'layout') ----- - makeRow - - ^ AlignmentMorph newRow - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #spaceFill; - vResizing: #shrinkWrap - ! Item was removed: - ----- Method: ScorePlayerMorph>>onScorePlayer: (in category 'initialization') ----- - onScorePlayer: aScorePlayer - - self onScorePlayer: aScorePlayer title: 'untitled'.! Item was removed: - ----- Method: ScorePlayerMorph>>onScorePlayer:title: (in category 'initialization') ----- - onScorePlayer: aScorePlayer title: scoreName - | divider col r | - scorePlayer := aScorePlayer. - scorePlayer ifNotNil: - [scorePlayer reset. - instrumentSelector := Array new: scorePlayer score tracks size]. - - self removeAllMorphs. - self addMorphBack: self makeControls. - scorePlayer ifNil: [^ self]. - - r := self makeRow - hResizing: #spaceFill; - vResizing: #shrinkWrap. - r addMorphBack: self rateControl; - addMorphBack: (Morph newBounds: (0 at 0 extent: 20 at 0) color: Color transparent); - addMorphBack: self volumeControl. - self addMorphBack: r. - self addMorphBack: self scrollControl. - - col := AlignmentMorph newColumn color: color; layoutInset: 0. - self addMorphBack: col. - 1 to: scorePlayer trackCount do: [:trackIndex | - divider := AlignmentMorph new - extent: 10 at 1; - layoutInset: 0; - borderStyle: (BorderStyle raised width: 1); - color: color; - hResizing: #spaceFill; - vResizing: #rigid. - col addMorphBack: divider. - col addMorphBack: (self trackControlsFor: trackIndex)]. - - LastMIDIPort ifNotNil: [ - "use the most recently set MIDI port" - scorePlayer openMIDIPort: LastMIDIPort]. - ! Item was removed: - ----- Method: ScorePlayerMorph>>openMIDIFile (in category 'initialization') ----- - openMIDIFile - "Open a MIDI score and re-init controls..." - | score fileName f player | - fileName := UIManager default chooseFileMatchingSuffixes: #('mid' 'midi') label: 'Choose a MIDI file to open' translated. - fileName isNil - ifTrue: [^ self ]. - - f := FileStream readOnlyFileNamed: fileName. - score := (MIDIFileReader new readMIDIFrom: f binary) asScore. - f close. - player := ScorePlayer onScore: score. - self onScorePlayer: player title: fileName! Item was removed: - ----- Method: ScorePlayerMorph>>openMIDIPort (in category 'initialization') ----- - openMIDIPort - - | portNum | - portNum := SimpleMIDIPort outputPortNumFromUser. - portNum ifNil: [^ self]. - scorePlayer openMIDIPort: portNum. - LastMIDIPort := portNum. - ! Item was removed: - ----- Method: ScorePlayerMorph>>panAndVolControlsFor: (in category 'layout') ----- - panAndVolControlsFor: trackIndex - - | volSlider panSlider c r middleLine pianoRollColor | - pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. - volSlider := SimpleSliderMorph new - color: color; - sliderColor: pianoRollColor; - extent: 101 at 6; - target: scorePlayer; - arguments: (Array with: trackIndex); - actionSelector: #volumeForTrack:put:; - minVal: 0.0; - maxVal: 1.0; - adjustToValue: (scorePlayer volumeForTrack: trackIndex). - panSlider := SimpleSliderMorph new - color: color; - sliderColor: pianoRollColor; - extent: 101 at 6; - target: scorePlayer; - arguments: (Array with: trackIndex); - actionSelector: #panForTrack:put:; - minVal: 0.0; - maxVal: 1.0; - adjustToValue: (scorePlayer panForTrack: trackIndex). - c := AlignmentMorph newColumn - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #topCenter; - hResizing: #spaceFill; - vResizing: #shrinkWrap. - middleLine := Morph new "center indicator for pan slider" - color: (Color r: 0.4 g: 0.4 b: 0.4); - extent: 1@(panSlider height - 4); - position: panSlider center x@(panSlider top + 2). - panSlider addMorphBack: middleLine. - r := self makeRow. - r addMorphBack: (StringMorph contents: '0'). - r addMorphBack: volSlider. - r addMorphBack: (StringMorph contents: '10'). - c addMorphBack: r. - r := self makeRow. - r addMorphBack: (StringMorph contents: 'L' translated). - r addMorphBack: panSlider. - r addMorphBack: (StringMorph contents: 'R' translated). - c addMorphBack: r. - ^ c - ! Item was removed: - ----- Method: ScorePlayerMorph>>rateControl (in category 'layout') ----- - rateControl - - | rateSlider middleLine r | - rateSlider := SimpleSliderMorph new - color: color; - sliderColor: Color gray; - extent: 180 at 12; - target: self; - actionSelector: #setLogRate:; - minVal: -1.0; - maxVal: 1.0; - adjustToValue: 0.0. - middleLine := Morph new "center indicator for pan slider" - color: (Color r: 0.4 g: 0.4 b: 0.4); - extent: 1@(rateSlider height - 4); - position: rateSlider center x@(rateSlider top + 2). - rateSlider addMorphBack: middleLine. - r := self makeRow - hResizing: #spaceFill; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: 'slow ' translated). - r addMorphBack: rateSlider. - r addMorphBack: (StringMorph contents: ' fast' translated). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>rewind (in category 'controls') ----- - rewind - - scorePlayer pause; reset. - ! Item was removed: - ----- Method: ScorePlayerMorph>>saveAsAIFF (in category 'menu') ----- - saveAsAIFF - "Create a stereo AIFF audio file with the result of performing my score." - - | fileName | - fileName := UIManager default request: 'New file name?' translated. - fileName isEmpty ifTrue: [^ self]. - (fileName asLowercase endsWith: '.aif') ifFalse: [ - fileName := fileName, '.aif']. - - scorePlayer storeAIFFOnFileNamed: fileName. - ! Item was removed: - ----- Method: ScorePlayerMorph>>saveAsSunAudio (in category 'menu') ----- - saveAsSunAudio - "Create a stereo Sun audio file with the result of performing my score." - - | fileName | - fileName := UIManager default request: 'New file name?' translated. - fileName isEmpty ifTrue: [^ self]. - (fileName asLowercase endsWith: '.au') ifFalse: [ - fileName := fileName, '.au']. - - scorePlayer storeSunAudioOnFileNamed: fileName. - ! Item was removed: - ----- Method: ScorePlayerMorph>>saveAsWAV (in category 'menu') ----- - saveAsWAV - "Create a stereo WAV audio file with the result of performing my score." - - | fileName | - fileName := UIManager default request: 'New file name?' translated. - fileName isEmpty ifTrue: [^ self]. - (fileName asLowercase endsWith: '.wav') ifFalse: [ - fileName := fileName, '.wav']. - - scorePlayer storeWAVOnFileNamed: fileName. - ! Item was removed: - ----- Method: ScorePlayerMorph>>scorePlayer (in category 'accessing') ----- - scorePlayer - - ^ scorePlayer - ! Item was removed: - ----- Method: ScorePlayerMorph>>scrollControl (in category 'layout') ----- - scrollControl - - | r | - scrollSlider := SimpleSliderMorph new - color: color; - sliderColor: Color gray; - extent: 360 at 12; - target: scorePlayer; - actionSelector: #positionInScore:; - adjustToValue: scorePlayer positionInScore. - r := self makeRow - hResizing: #spaceFill; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: 'start ' translated). - r addMorphBack: scrollSlider. - r addMorphBack: (StringMorph contents: ' end' translated). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>setLogRate: (in category 'controls') ----- - setLogRate: logOfRate - - scorePlayer rate: (3.5 raisedTo: logOfRate). - ! Item was removed: - ----- Method: ScorePlayerMorph>>showResumeButtonInTheWorld (in category 'layout') ----- - showResumeButtonInTheWorld - WorldState addDeferredUIMessage: [ - | w | - w := self world. - w ifNotNil: [ - w addMorphFront: - (self standaloneResumeButton position: (w right - 100) @ (w top + 10)). - scorePlayer pause. - ]. - ] - ! Item was removed: - ----- Method: ScorePlayerMorph>>standaloneResumeButton (in category 'layout') ----- - standaloneResumeButton - - | r | - - r := AlignmentMorph newRow. - r color: Color red; borderWidth: 0; layoutInset: 6; useRoundedCorners. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. - r addMorphBack: ( - SimpleButtonMorph new - target: [ - scorePlayer resumePlaying. - r delete - ]; - borderStyle: (BorderStyle raised width: 2); - color: Color green; - label: 'Continue' translated; - actionSelector: #value - ). - r setBalloonText: 'Continue playing a paused presentation' translated. - ^r - - - ! Item was removed: - ----- Method: ScorePlayerMorph>>step (in category 'stepping and presenter') ----- - step - - scrollSlider adjustToValue: scorePlayer positionInScore. - - ! Item was removed: - ----- Method: ScorePlayerMorph>>trackControlsFor: (in category 'layout') ----- - trackControlsFor: trackIndex - - | r | - r := self makeRow - hResizing: #spaceFill; - vResizing: #shrinkWrap. - r addMorphBack: (self trackNumAndMuteButtonFor: trackIndex). - r addMorphBack: (Morph new extent: 10 at 5; color: color). "spacer" - r addMorphBack: (self panAndVolControlsFor: trackIndex). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>trackNumAndMuteButtonFor: (in category 'layout') ----- - trackNumAndMuteButtonFor: trackIndex - - | muteButton instSelector pianoRollColor r | - muteButton := SimpleSwitchMorph new - onColor: (Color r: 1.0 g: 0.6 b: 0.6); - offColor: color; - color: color; - label: 'Mute' translated; - target: scorePlayer; - actionSelector: #mutedForTrack:put:; - arguments: (Array with: trackIndex). - instSelector := PopUpChoiceMorph new - extent: 95 at 14; - contentsClipped: 'oboe1'; - target: self; - actionSelector: #atTrack:from:selectInstrument:; - getItemsSelector: #instrumentChoicesForTrack:; - getItemsArgs: (Array with: trackIndex). - instSelector arguments: - (Array with: trackIndex with: instSelector). - instrumentSelector at: trackIndex put: instSelector. - - "select track color using same color list as PianoRollScoreMorph" - pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. - - r := self makeRow - hResizing: #spaceFill; - vResizing: #spaceFill; - extent: 70 at 10. - r addMorphBack: - ((StringMorph - contents: trackIndex printString - font: (TextStyle default fontOfSize: 24)) color: pianoRollColor). - trackIndex < 10 - ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 at 8)] "spacer" - ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 at 8)]. "spacer" - r addMorphBack: - (StringMorph new - extent: 80 at 14; - contentsClipped: (scorePlayer infoForTrack: trackIndex)). - r addMorphBack: (Morph new color: color; extent: 8 at 8). "spacer" - r addMorphBack: instSelector. - r addMorphBack: (AlignmentMorph newRow color: color). "spacer" - r addMorphBack: muteButton. - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>updateInstrumentsFromLibraryExcept: (in category 'menu') ----- - updateInstrumentsFromLibraryExcept: soundsBeingEdited - "The instrument library has been modified. Update my instruments with the new versions from the library. Use a single instrument prototype for all parts with the same name; this allows the envelope editor to edit all the parts by changing a single sound prototype." - - "soundsBeingEdited is a collection of sounds being edited (by an EnvelopeEditor). If any of my instruments share one of these, then they will be left alone so as not to disturb that dynamic linkage." - - | unloadPostfix myInstruments name displaysAsUnloaded isUnloaded | - unloadPostfix := '(out)'. - myInstruments := Dictionary new. - 1 to: instrumentSelector size do: [:i | - name := (instrumentSelector at: i) contents. - displaysAsUnloaded := name endsWith: unloadPostfix. - displaysAsUnloaded ifTrue: [ - name := name copyFrom: 1 to: name size - unloadPostfix size]. - (myInstruments includesKey: name) ifFalse: [ - myInstruments at: name put: - (name = 'clink' - ifTrue: [ - (SampledSound - samples: SampledSound coffeeCupClink - samplingRate: 11025) copy] - ifFalse: [ - (AbstractSound - soundNamed: name - ifAbsent: [ - (instrumentSelector at: i) contentsClipped: 'default'. - FMSound default]) copy])]. - (soundsBeingEdited includes: (scorePlayer instrumentForTrack: i)) ifFalse: - ["Do not update any instrument that is currently being edited" - scorePlayer instrumentForTrack: i put: (myInstruments at: name)]. - - "update loaded/unloaded status in instrumentSelector if necessary" - isUnloaded := (myInstruments at: name) isKindOf: UnloadedSound. - (displaysAsUnloaded and: [isUnloaded not]) - ifTrue: [(instrumentSelector at: i) contentsClipped: name]. - (displaysAsUnloaded not and: [isUnloaded]) - ifTrue: [(instrumentSelector at: i) contentsClipped: name, unloadPostfix]]. - ! Item was removed: - ----- Method: ScorePlayerMorph>>volumeControl (in category 'layout') ----- - volumeControl - - | volumeSlider r | - volumeSlider := SimpleSliderMorph new - color: color; - sliderColor: Color gray; - extent: 80 at 12; - target: scorePlayer; - actionSelector: #overallVolume:; - adjustToValue: scorePlayer overallVolume. - r := self makeRow - hResizing: #spaceFill; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: 'soft ' translated). - r addMorphBack: volumeSlider. - r addMorphBack: (StringMorph contents: ' loud' translated). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>wantsRoundedCorners (in category 'rounding') ----- - wantsRoundedCorners - ^ SystemWindow roundedWindowCorners or: [super wantsRoundedCorners]! Item was removed: - Object subclass: #ScrapBook - instanceVariableNames: 'book' - classVariableNames: 'Default' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !ScrapBook commentStamp: 'fbs 5/18/2013 23:01' prior: 0! - I provide a holding place for Morphs deleted through the pink halo button or being dragged onto the trashcan.! Item was removed: - ----- Method: ScrapBook class>>cleanUp: (in category 'initialize-release') ----- - cleanUp: aggressive - "Nuke the scraps book when cleaning aggressively" - - aggressive ifTrue: [Default := nil].! Item was removed: - ----- Method: ScrapBook class>>default (in category 'accessing') ----- - default - ^ Default ifNil: [Default := ScrapBook new].! Item was removed: - ----- Method: ScrapBook>>addToTrash: (in category 'scraps') ----- - addToTrash: aMorph - "Paste the object onto a page of the system Trash book, unless the preference is set to empty the trash immediately." - - | aPage | - TrashCanMorph preserveTrash ifFalse: [^ self]. - - aMorph position: book pages first position + (0 at 40). - book pages do: [:pp | - (pp submorphs size = 1 and: [pp hasProperty: #trash]) ifTrue: "perhaps remove that property here" - ["page is blank" - ^ pp addMorph: aMorph]]. - aPage := book insertPageLabel: ('{1} {2}' format: Time dateAndTimeNow) - morphs: (Array with: aMorph). - aPage setProperty: #trash toValue: true! Item was removed: - ----- Method: ScrapBook>>emptyScrapBook (in category 'scraps') ----- - emptyScrapBook - | oldScraps | - oldScraps := book. - book := nil. "Creates it afresh" - book := self scrapBook. - (oldScraps notNil and: [oldScraps owner notNil]) - ifTrue: - [book position: oldScraps position. - oldScraps owner replaceSubmorph: oldScraps by: book. - book changed; layoutChanged]! Item was removed: - ----- Method: ScrapBook>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - book := self scrapBook.! Item was removed: - ----- Method: ScrapBook>>maybeEmptyTrash (in category 'scraps') ----- - maybeEmptyTrash - (self confirm: 'Do you really want to empty the trash?' translated) - ifTrue: [self emptyScrapBook]! Item was removed: - ----- Method: ScrapBook>>scrapBook (in category 'scraps') ----- - scrapBook - | header aButton label | - ^ book ifNil: [ - book := BookMorph new pageSize: 300 at 300; setNameTo: 'scraps' translated. - book addCornerGrips. - book color: Color yellow muchLighter. - book borderColor: Color darkGray; borderWidth: 2. - book removeEverything; showPageControls; insertPage. - - header := AlignmentMorph newRow wrapCentering: #center; cellPositioning: #leftCenter. - header setProperty: #header toValue: true. - header addMorph: (aButton := ThreePhaseButtonMorph labelSymbol: #'Halo-Collapse'). - aButton target: book; - actionSelector: #delete; - setBalloonText: 'Close the trashcan.\(to view again later, click on any trashcan).' translated withCRs. - header addMorphBack: AlignmentMorph newVariableTransparentSpacer beSticky. - header addMorphBack: (label := UpdatingStringMorph new target: self) beSticky. - label getSelector: #trashTitle; useStringFormat; step. - header addMorphBack: AlignmentMorph newVariableTransparentSpacer beSticky. - header addMorphBack: (aButton := ThreePhaseButtonMorph labelSymbol: #'Halo-Dismiss'). - aButton target: self; - actionSelector: #maybeEmptyTrash; - setBalloonText: 'Click here to empty the trash.' translated. - book currentPage - layoutPolicy: TableLayout new; - addMorph: (TextMorph new - contents: 'Objects you drag into the trash will automatically be saved here, one object per page, in case you need them later. To disable this feature set the "preserveTrash" Preference to false.\\You can individually expunge objects by hitting the "-" control (behind "..."). You can empty out all the objects in the trash can by hitting the "X" button at top right.' translated withCRs; - hResizing: #spaceFill). - - book addMorphFront: header. - book setProperty: #scraps toValue: true. - book].! Item was removed: - ----- Method: ScrapBook>>trashTitle (in category 'scraps') ----- - trashTitle - - ^ 'T R A S H' translated! Item was removed: - Morph subclass: #ScreeningMorph - instanceVariableNames: 'screenForm displayMode passingColor passElseBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !ScreeningMorph commentStamp: '<historical>' prior: 0! - ScreeningMorph uses its first submorph as a screen, and its second submorph as a source. It also wants you to choose (when showing only the screen) the passing color in the screen. It then makes up a 1-bit mask which clips the source, and displays transparently outside it.! Item was removed: - ----- Method: ScreeningMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - submorphs isEmpty ifTrue: - [^ aCustomMenu add: '*Please add a source morph*' translated action: #itself]. - submorphs size = 1 ifTrue: - [^ aCustomMenu add: '*Please add a screen morph*' translated action: #itself]. - submorphs size > 2 ifTrue: - [^ aCustomMenu add: '*I have too many submorphs*' translated action: #itself]. - aCustomMenu add: 'show screen only' translated action: #showScreenOnly. - aCustomMenu add: 'show source only' translated action: #showSourceOnly. - aCustomMenu add: 'show screen over source' translated action: #showScreenOverSource. - aCustomMenu add: 'show source screened' translated action: #showScreened. - aCustomMenu add: 'exchange source and screen' translated action: #exchange. - displayMode == #showScreenOnly ifTrue: - [aCustomMenu add: 'choose passing color' translated action: #choosePassingColor. - aCustomMenu add: 'choose blocking color' translated action: #chooseBlockingColor]. - ! Item was removed: - ----- Method: ScreeningMorph>>addMorph: (in category 'submorphs - add/remove') ----- - addMorph: aMorph - - | f | - super addMorph: aMorph. - submorphs size <= 2 ifTrue: - [self bounds: submorphs last bounds]. - submorphs size = 2 ifTrue: - ["The screenMorph has just been added. - Choose as the passingColor the center color of that morph" - f := self screenMorph imageForm. - passingColor := f colorAt: f boundingBox center. - passElseBlock := true]! Item was removed: - ----- Method: ScreeningMorph>>chooseBlockingColor (in category 'menu') ----- - chooseBlockingColor - passingColor := Color fromUser. - passElseBlock := false. - self layoutChanged! Item was removed: - ----- Method: ScreeningMorph>>choosePassingColor (in category 'menu') ----- - choosePassingColor - passingColor := Color fromUser. - passElseBlock := true. - self layoutChanged! Item was removed: - ----- Method: ScreeningMorph>>containsPoint: (in category 'geometry testing') ----- - containsPoint: aPoint - submorphs size = 2 ifFalse: [^ super containsPoint: aPoint]. - ^ self screenMorph containsPoint: aPoint! Item was removed: - ----- Method: ScreeningMorph>>exchange (in category 'menu') ----- - exchange - submorphs swap: 1 with: 2. - self changed! Item was removed: - ----- Method: ScreeningMorph>>fullDrawOn: (in category 'drawing') ----- - fullDrawOn: aCanvas - | mergeForm | - submorphs isEmpty ifTrue: [^super fullDrawOn: aCanvas]. - (aCanvas isVisible: self fullBounds) ifFalse: [^self]. - (submorphs size = 1 or: [displayMode == #showScreenOnly]) - ifTrue: [^aCanvas fullDrawMorph: self screenMorph]. - displayMode == #showSourceOnly - ifTrue: [^aCanvas fullDrawMorph: self sourceMorph]. - displayMode == #showScreenOverSource - ifTrue: - [aCanvas fullDrawMorph: self sourceMorph. - ^aCanvas fullDrawMorph: self screenMorph]. - displayMode == #showScreened - ifTrue: - [aCanvas fullDrawMorph: self screenMorph. - self flag: #fixCanvas. "There should be a more general way than this" - mergeForm := self sourceMorph - imageFormForRectangle: self screenMorph bounds. - (BitBlt toForm: mergeForm) - copyForm: self screenForm - to: 0 @ 0 - rule: Form and - colorMap: (Bitmap with: 0 with: 4294967295). - aCanvas paintImage: mergeForm at: self screenMorph position]! Item was removed: - ----- Method: ScreeningMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - passingColor := Color black. - passElseBlock := true. - displayMode := #showScreened. - self enableDragNDrop! Item was removed: - ----- Method: ScreeningMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - - screenForm := nil. - submorphs size >= 2 - ifTrue: [self disableDragNDrop] - ifFalse: [self enableDragNDrop]. - submorphs size = 2 ifTrue: - [bounds := ((self sourceMorph bounds merge: self screenMorph bounds) expandBy: 4)]. - ^ super layoutChanged! Item was removed: - ----- Method: ScreeningMorph>>passElseBlock: (in category 'accessing') ----- - passElseBlock: aBool - passElseBlock := aBool.! Item was removed: - ----- Method: ScreeningMorph>>passingColor: (in category 'accessing') ----- - passingColor: aColor - passingColor := aColor.! Item was removed: - ----- Method: ScreeningMorph>>removedMorph: (in category 'private') ----- - removedMorph: aMorph - - submorphs size = 1 ifTrue: - [self bounds: submorphs first bounds]. - super removedMorph: aMorph.! Item was removed: - ----- Method: ScreeningMorph>>screenForm (in category 'private') ----- - screenForm - | screenImage colorMap pickValue elseValue | - screenForm ifNotNil: [^screenForm]. - passElseBlock ifNil: [passElseBlock := true]. - passingColor ifNil: [passingColor := Color black]. - elseValue := passElseBlock - ifTrue: - [pickValue := 4294967295. - 0] - ifFalse: - [pickValue := 0. - 4294967295]. - screenImage := self screenMorph - imageFormForRectangle: self screenMorph bounds. - colorMap := screenImage newColorMap atAllPut: elseValue. - colorMap at: (passingColor indexInMap: colorMap) put: pickValue. - screenForm := Form extent: screenImage extent. - screenForm - copyBits: screenForm boundingBox - from: screenImage - at: 0 @ 0 - colorMap: colorMap. - ^screenForm! Item was removed: - ----- Method: ScreeningMorph>>screenMorph (in category 'private') ----- - screenMorph - ^submorphs first! Item was removed: - ----- Method: ScreeningMorph>>showScreenOnly (in category 'menu') ----- - showScreenOnly - displayMode := #showScreenOnly. - self changed! Item was removed: - ----- Method: ScreeningMorph>>showScreenOverSource (in category 'menu') ----- - showScreenOverSource - displayMode := #showScreenOverSource. - self changed! Item was removed: - ----- Method: ScreeningMorph>>showScreened (in category 'menu') ----- - showScreened - displayMode := #showScreened. - self changed! Item was removed: - ----- Method: ScreeningMorph>>showSourceOnly (in category 'menu') ----- - showSourceOnly - displayMode := #showSourceOnly. - self changed! Item was removed: - ----- Method: ScreeningMorph>>sourceMorph (in category 'private') ----- - sourceMorph - ^submorphs second! Item was removed: - ----- Method: ScreeningMorph>>wantsRecolorHandle (in category 'e-toy support') ----- - wantsRecolorHandle - "Answer whether the receiver would like a recolor handle to be - put up for it. We'd want to disable this but for the moment - that would cut off access to the button part of the properties - sheet. So this remains a loose end." - ^ false! Item was removed: - PluggableTextMorphWithModel subclass: #ScrollableField - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Info for build parts-bin entries." - - ^ self partName: 'Scrolling Text' translatedNoop - categories: #(Basic) - documentation: 'A scrollable, editable body of text' translatedNoop! Item was removed: - ----- Method: ScrollableField class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop} - forFlapNamed: 'Stack Tools'.]! Item was removed: - ----- Method: ScrollableField class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: ScrollableField>>adjustTextAnchor: (in category 'accessing') ----- - adjustTextAnchor: aMorph - textMorph - ifNotNil: [textMorph adjustTextAnchor: aMorph]! Item was removed: - ----- Method: ScrollableField>>anchorMorph:at:type: (in category 'editing') ----- - anchorMorph: aMorph at: aPoint type: anchorType - textMorph anchorMorph: aMorph at: aPoint type: anchorType ! Item was removed: - ----- Method: ScrollableField>>changed (in category 'updating') ----- - changed - super changed. - textMorph changed.! Item was removed: - ----- Method: ScrollableField>>chooseEmphasisOrAlignment (in category 'editing') ----- - chooseEmphasisOrAlignment - textMorph chooseEmphasisOrAlignment! Item was removed: - ----- Method: ScrollableField>>chooseFont (in category 'editing') ----- - chooseFont - textMorph chooseFont! Item was removed: - ----- Method: ScrollableField>>chooseStyle (in category 'editing') ----- - chooseStyle - textMorph chooseStyle! Item was removed: - ----- Method: ScrollableField>>contents (in category 'accessing') ----- - contents - ^ textMorph contents! Item was removed: - ----- Method: ScrollableField>>cursor (in category 'accessing') ----- - cursor - "Answer the receiver's logical cursor position" - ^ textMorph cursor! Item was removed: - ----- Method: ScrollableField>>cursorWrapped: (in category 'accessing') ----- - cursorWrapped: aNumber - "Set the cursor as indicated" - textMorph cursorWrapped: aNumber! Item was removed: - ----- Method: ScrollableField>>editor (in category 'accessing') ----- - editor - ^ textMorph editor! Item was removed: - ----- Method: ScrollableField>>elementCount (in category 'accessing') ----- - elementCount - "Answer how many sub-objects are within me" - ^ textMorph elementCount! Item was removed: - ----- Method: ScrollableField>>getAllButFirstCharacter (in category 'accessing') ----- - getAllButFirstCharacter - "Obtain all but the first character from the receiver; if that - would be empty, return a black dot" - ^ textMorph getAllButFirstCharacter ! Item was removed: - ----- Method: ScrollableField>>getCharacters (in category 'accessing') ----- - getCharacters - "obtain a string value from the receiver" - ^ textMorph getCharacters! Item was removed: - ----- Method: ScrollableField>>getFirstCharacter (in category 'accessing') ----- - getFirstCharacter - "obtain the first character from the receiver if it is empty, - return a black dot" - ^ textMorph getFirstCharacter! Item was removed: - ----- Method: ScrollableField>>getLastCharacter (in category 'accessing') ----- - getLastCharacter - "obtain the last character from the receiver if it is empty, - return a black dot" - ^ textMorph getLastCharacter ! Item was removed: - ----- Method: ScrollableField>>getMenu: (in category 'menu') ----- - getMenu: shiftKeyState - ^ (shiftKeyState not - or: [Preferences noviceMode]) - ifTrue: [TextEditor yellowButtonMenu] - ifFalse: [TextEditor shiftedYellowButtonMenu]! Item was removed: - ----- Method: ScrollableField>>getNumericValue (in category 'accessing') ----- - getNumericValue - "Obtain a numeric value from the receiver; if no digits, return - zero" - ^ textMorph getNumericValue ! Item was removed: - ----- Method: ScrollableField>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - super initializeToStandAlone. - self color: (Color r: 0.972 g: 0.972 b: 0.662). - self retractable: false; scrollBarOnLeft: false. - - self wantsFrameAdornments: false.! Item was removed: - ----- Method: ScrollableField>>insertCharacters: (in category 'accessing') ----- - insertCharacters: aString - "Insert the characters from the given source at my current - cursor position" - textMorph insertCharacters: aString ! Item was removed: - ----- Method: ScrollableField>>insertContentsOf: (in category 'accessing') ----- - insertContentsOf: aPlayer - "Insert the characters from the given player at my current - cursor position" - textMorph insertContentsOf: aPlayer ! Item was removed: - ----- Method: ScrollableField>>isTextMorph (in category 'classification') ----- - isTextMorph - ^ true! Item was removed: - ----- Method: ScrollableField>>isWrapped (in category 'accessing') ----- - isWrapped - ^ textMorph isWrapped! Item was removed: - ----- Method: ScrollableField>>margins (in category 'accessing') ----- - margins - ^ textMorph margins! Item was removed: - ----- Method: ScrollableField>>paragraph (in category 'accessing') ----- - paragraph - ^ textMorph paragraph! Item was removed: - ----- Method: ScrollableField>>releaseParagraph (in category 'private') ----- - releaseParagraph - textMorph releaseParagraph ! Item was removed: - ----- Method: ScrollableField>>setCharacters: (in category 'accessing') ----- - setCharacters: chars - "obtain a string value from the receiver" - textMorph setCharacters: chars ! Item was removed: - ----- Method: ScrollableField>>setContainer: (in category 'containment') ----- - setContainer: newContainer - self changed. - textMorph setContainer: newContainer. - self releaseParagraph! Item was removed: - ----- Method: ScrollableField>>setMyText: (in category 'contents') ----- - setMyText: someText - "Set my text, as indicated" - - | toUse | - toUse := someText ifNil: ['']. - myContents := toUse. - self setText: toUse. - ^ true! Item was removed: - ----- Method: ScrollableField>>setNumericValue: (in category 'accessing') ----- - setNumericValue: aValue - "Set the contents of the receiver to be a string obtained from - aValue" - textMorph setNumericValue: aValue ! Item was removed: - ----- Method: ScrollableField>>text:textStyle: (in category 'private') ----- - text: aText textStyle: aTextStyle - textMorph text: aText textStyle: aTextStyle ! Item was removed: - ----- Method: ScrollableField>>textStyle (in category 'accessing') ----- - textStyle - ^ textMorph textStyle! Item was removed: - ----- Method: ScrollableField>>updateFromParagraph (in category 'accessing') ----- - updateFromParagraph - "A change has taken place in my paragraph, as a result of - editing and I must be updated. If a line break causes - recomposition of the current paragraph, or it the selection has - entered a different paragraph, then the current editor will be - released, and must be reinstalled with the resulting new - paragraph, while retaining any editor state, such as selection, - undo state, and current typing emphasis." - textMorph updateFromParagraph ! Item was removed: - ----- Method: ScrollableField>>wantsYellowButtonMenu (in category 'menu') ----- - wantsYellowButtonMenu - "Answer true if the receiver wants a yellow button menu" - ^ true! Item was removed: - Object subclass: #ScrollingToolHolder - instanceVariableNames: 'pickupButtons stampButtons stamps thumbnailPics start' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !ScrollingToolHolder commentStamp: '<historical>' prior: 0! - Used to hold stamp images in the PaintBox. Displays a small number of the available stamps and allows scrolling to access the others. One stamp is always kept blank as a way to create new stamps. - - Note: - stamps are the full size Forms - thumbnailPics are the shrunken ones - nil in both lists means no stamp yet, so user can create one - ! Item was removed: - ----- Method: ScrollingToolHolder class>>newPrototype (in category 'instance creation') ----- - newPrototype - ^self new buildAPrototype! Item was removed: - ----- Method: ScrollingToolHolder class>>newPrototypeFor: (in category 'instance creation') ----- - newPrototypeFor: aPaintBoxMorph - ^self new buildAPrototypeFor: aPaintBoxMorph! Item was removed: - ----- Method: ScrollingToolHolder>>buildAPrototypeFor: (in category 'initialize-release') ----- - buildAPrototypeFor: aPaintBoxMorph - pickupButtons := (aPaintBoxMorph submorphNamed: 'stamps') submorphs select: [:e | e externalName = 'pickup:']. - stampButtons := (aPaintBoxMorph submorphNamed: 'stamps') submorphs select: [:e | e externalName = 'stamp:']. - stamps := OrderedCollection ofSize: 3. - thumbnailPics := OrderedCollection ofSize: 3. - start := 3.! Item was removed: - ----- Method: ScrollingToolHolder>>clear (in category 'accessing') ----- - clear - "wipe out all existing stamps" - - stamps := OrderedCollection new: 16. - thumbnailPics := OrderedCollection new: 16. - stampButtons do: [:each | - stamps addLast: nil. "hold a space" - thumbnailPics addLast: nil]. - start := 1. - self normalize.! Item was removed: - ----- Method: ScrollingToolHolder>>normalize (in category 'accessing') ----- - normalize - "Correspondence between buttons and stamp forms has changed. Make all thumbnails show up right." - - | shrunkForm button trans | - 1 to: stampButtons size do: [:ind | - shrunkForm := thumbnailPics atWrap: ind+start-1. - button := stampButtons at: ind. - shrunkForm - ifNil: [trans := Form extent: button extent depth: 8. - trans fill: trans boundingBox fillColor: Color transparent. - button onImage: trans] - ifNotNil: [button onImage: shrunkForm]. - button offImage: shrunkForm; pressedImage: shrunkForm. "later modify them" - ].! Item was removed: - ----- Method: ScrollingToolHolder>>otherButtonFor: (in category 'accessing') ----- - otherButtonFor: aButton - "Find the corresponding button for either a pickup or a stamp button" - - | ii | - (ii := pickupButtons indexOf: aButton) > 0 ifTrue: [^ stampButtons at: ii]. - (ii := stampButtons indexOf: aButton) > 0 ifTrue: [^ pickupButtons at: ii]. - self error: 'stamp button not found'.! Item was removed: - ----- Method: ScrollingToolHolder>>pickupButtons (in category 'accessing') ----- - pickupButtons - - ^ pickupButtons! Item was removed: - ----- Method: ScrollingToolHolder>>pickupButtons: (in category 'accessing') ----- - pickupButtons: anArray - "Save the list of buttons that are for making a new stamp. Left to right" - - pickupButtons := anArray! Item was removed: - ----- Method: ScrollingToolHolder>>remove: (in category 'accessing') ----- - remove: tool - "Remove a stamp. Make this stamp blank. OK to have a bunch of blank ones." - - | which | - which := stampButtons indexOf: tool ifAbsent: [ - pickupButtons indexOf: tool ifAbsent: [^ self]]. - stamps atWrap: which+start-1 put: nil. - thumbnailPics atWrap: which+start-1 put: nil. - self normalize. "show them"! Item was removed: - ----- Method: ScrollingToolHolder>>scroll: (in category 'accessing') ----- - scroll: amt - "Move the stamps over" - - start := start - 1 + amt \\ stamps size + 1. - self normalize. "show them"! Item was removed: - ----- Method: ScrollingToolHolder>>stampButtons (in category 'accessing') ----- - stampButtons - - ^ stampButtons! Item was removed: - ----- Method: ScrollingToolHolder>>stampButtons: (in category 'accessing') ----- - stampButtons: anArray - "Pop in a new list of buttons that are the tools for stamping. Left to right" - - stampButtons := anArray. - self clear.! Item was removed: - ----- Method: ScrollingToolHolder>>stampForm:for: (in category 'accessing') ----- - stampForm: stampForm for: aPickupButton - "Install this form to stamp. Find its index. Make a thumbnail." - - | which scale shrunkForm stampBtn mini | - which := pickupButtons indexOf: aPickupButton. - which = 0 ifTrue: [which := stampButtons indexOf: aPickupButton]. - stamps atWrap: which+start-1 put: stampForm. - - "Create the thumbnail" - stampBtn := stampButtons at: which. - scale := stampBtn width / (stampForm extent x max: stampForm extent y). - scale := scale min: 1.0. "do not expand it" - mini := stampForm magnify: stampForm boundingBox by: scale smoothing: 1. - shrunkForm := mini class extent: stampBtn extent depth: stampForm depth. - mini displayOn: shrunkForm at: (stampBtn extent - mini extent)//2. - thumbnailPics atWrap: which+start-1 put: shrunkForm. - stampBtn offImage: shrunkForm; onImage: shrunkForm; pressedImage: shrunkForm. - "Emphasis is done by border of enclosing layoutMorph, not modifying image" - - (stamps indexOf: nil) = 0 ifTrue: ["Add an extra blank place" - "Keep stamp we just installed in the same location!!" - start+which-1 > stamps size ifTrue: [start := start + 1]. - stamps addLast: nil. - thumbnailPics addLast: nil. - self normalize]. - ! Item was removed: - ----- Method: ScrollingToolHolder>>stampFormFor: (in category 'accessing') ----- - stampFormFor: aButton - - | which | - which := stampButtons indexOf: aButton ifAbsent: [1]. - ^ stamps atWrap: which+start-1! Item was removed: - ----- Method: ScrollingToolHolder>>updateReferencesUsing: (in category 'accessing') ----- - updateReferencesUsing: aDictionary - "Fix up the Morphs I own" - "Note: Update this method when adding new inst vars that could contain Morphs." - - stampButtons := stampButtons collect: - [:old | aDictionary at: old ifAbsent: [old]]. - pickupButtons := pickupButtons collect: - [:old | aDictionary at: old ifAbsent: [old]]. - ! Item was removed: - ----- Method: SelectorBrowser class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop} - forFlapNamed: 'Tools'] - ! Item was removed: - ----- Method: SelectorBrowser class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: ServerDirectory>>url (in category '*MorphicExtras-accessing') ----- - url - "This was mis-named at the beginning. Eventually convert over to altUrl and use this for the real url." - ^ self realUrl! Item was removed: - ----- Method: SimpleButtonMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - target := target adaptedToWorld: aWorld.! Item was removed: - ----- Method: SimpleButtonMorph>>updateReferencesUsing: (in category '*MorphicExtras-copying') ----- - updateReferencesUsing: aDictionary - "If the arguments array points at a morph we are copying, then point at the new copy. And also copies the array, which is important!!" - - super updateReferencesUsing: aDictionary. - arguments := arguments collect: - [:old | aDictionary at: old ifAbsent: [old]]. - ! Item was removed: - Slider subclass: #SimpleSliderMorph - instanceVariableNames: 'target arguments minVal maxVal truncate' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: SimpleSliderMorph class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - | aSlider nominalColor | - "self currentHand attachMorph: SimpleSliderMorph authoringPrototype" - - aSlider := super authoringPrototype beSticky. - aSlider extent: 14 at 120. - nominalColor := Color r: 0.4 g: 0.86 b: 0.7. - aSlider color: nominalColor. - aSlider sliderColor: nominalColor muchLighter. - aSlider descending: true. - aSlider setScaledValue: 0.3. - ^ aSlider! Item was removed: - ----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - "Answer a basis for names of default instances of the receiver" - ^ 'Slider' translatedNoop! Item was removed: - ----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Slider' translatedNoop - categories: {'Basic' translatedNoop} - documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop! Item was removed: - ----- Method: SimpleSliderMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop} - forFlapNamed: 'Scripting']! Item was removed: - ----- Method: SimpleSliderMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: SimpleSliderMorph>>actionSelector (in category 'accessing') ----- - actionSelector - - ^ setValueSelector - ! Item was removed: - ----- Method: SimpleSliderMorph>>actionSelector: (in category 'accessing') ----- - actionSelector: aSymbolOrString - - (nil = aSymbolOrString or: - ['nil' = aSymbolOrString or: - [aSymbolOrString isEmpty]]) - ifTrue: [^ setValueSelector := nil]. - - setValueSelector := aSymbolOrString asSymbol. - ! Item was removed: - ----- Method: SimpleSliderMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - "To all the other Custom menu items add slider and targeting items." - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - self addSliderMenuItems: aCustomMenu hand: aHandMorph . - self addTargetingMenuItems: aCustomMenu hand: aHandMorph .! Item was removed: - ----- Method: SimpleSliderMorph>>addSliderMenuItems:hand: (in category 'menu') ----- - addSliderMenuItems: aCustomMenu hand: aHandMorph - "Add items to set slider parameters" - aCustomMenu addLine. - "" - aCustomMenu add: 'set action selector' translated action: #setActionSelector. - aCustomMenu add: 'change arguments' translated action: #setArguments. - "" - aCustomMenu add: 'set minimum value' translated action: #setMinVal. - aCustomMenu add: 'set maximum value' translated action: #setMaxVal. - "" - aCustomMenu addUpdating: #descendingString action: #toggleDescending. - aCustomMenu addUpdating: #truncateString action: #toggleTruncate. - ! Item was removed: - ----- Method: SimpleSliderMorph>>addTargetingMenuItems:hand: (in category 'menu') ----- - addTargetingMenuItems: aCustomMenu hand: aHandMorph - "Add targeting menu items" - aCustomMenu addLine. - - aCustomMenu add: 'set target' translated action: #targetWith:. - aCustomMenu add: 'sight target' translated action: #sightTargets:. - target - ifNotNil: [aCustomMenu add: 'clear target' translated action: #clearTarget]! Item was removed: - ----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') ----- - adjustToValue: aNumber - "Adjust the position of this slider to correspond to the given value in the range minVal..maxVal." - "Details: Internal values are normalized to the range 0..1." - - | toUse | - toUse := minVal = maxVal - ifTrue: - [minVal] - ifFalse: - [(aNumber - minVal) asFloat / (maxVal - minVal)]. - self value: toUse - ! Item was removed: - ----- Method: SimpleSliderMorph>>arguments (in category 'accessing') ----- - arguments - - ^ arguments - ! Item was removed: - ----- Method: SimpleSliderMorph>>arguments: (in category 'accessing') ----- - arguments: aCollection - - arguments := aCollection asArray copy. - ! Item was removed: - ----- Method: SimpleSliderMorph>>clearTarget (in category 'menu') ----- - clearTarget - - target := nil. - ! Item was removed: - ----- Method: SimpleSliderMorph>>descendingString (in category 'menu') ----- - descendingString - ^ (self descending - ifTrue: ['switch to ascending' translatedNoop] - ifFalse: ['switch to descending' translatedNoop]) translated! Item was removed: - ----- Method: SimpleSliderMorph>>getScaledValue (in category 'private') ----- - getScaledValue - | aValue | - aValue := (value * (maxVal - minVal)) + minVal. - ^ truncate ifTrue: [aValue truncated] ifFalse: [aValue]! Item was removed: - ----- Method: SimpleSliderMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - target := nil. - arguments := Array empty. - minVal := 0.0. - maxVal := 1.0. - truncate := false. - ! Item was removed: - ----- Method: SimpleSliderMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - | nominalColor | - - self initialize. - self beSticky. - self extent: 14 at 120. - nominalColor := Color r: 0.452 g: 0.645 b: 0.935. - self color: nominalColor. - self borderColor: Color veryDarkGray. - self sliderColor: nominalColor muchLighter. - self descending: true. - self setScaledValue: 0.3! Item was removed: - ----- Method: SimpleSliderMorph>>isLikelyRecipientForMouseOverHalos (in category 'e-toy support') ----- - isLikelyRecipientForMouseOverHalos - - self player ifNil: [^ false]. - self player getHeading = 0.0 ifTrue: [^ false]. - ^ true. - ! Item was removed: - ----- Method: SimpleSliderMorph>>maxVal (in category 'accessing') ----- - maxVal - - ^ maxVal - ! Item was removed: - ----- Method: SimpleSliderMorph>>maxVal: (in category 'accessing') ----- - maxVal: aNumber - - maxVal := aNumber. - ! Item was removed: - ----- Method: SimpleSliderMorph>>minVal (in category 'accessing') ----- - minVal - - ^ minVal - ! Item was removed: - ----- Method: SimpleSliderMorph>>minVal: (in category 'accessing') ----- - minVal: aNumber - - minVal := aNumber. - ! Item was removed: - ----- Method: SimpleSliderMorph>>setActionSelector (in category 'menu') ----- - setActionSelector - | oldSel newSel | - oldSel := setValueSelector isNil ifTrue: [''] ifFalse: [setValueSelector]. - newSel := UIManager default - request: 'Please type the selector to be sent to - the target when this slider is changed' translated - initialAnswer: oldSel. - newSel isEmpty ifFalse: [self actionSelector: newSel]! Item was removed: - ----- Method: SimpleSliderMorph>>setArguments (in category 'menu') ----- - setArguments - - | s newArgs newArgsArray | - s := WriteStream on: ''. - arguments do: [:arg | arg printOn: s. s nextPutAll: '. ']. - newArgs := UIManager default - request: - 'Please type the arguments to be sent to the target - when this button is pressed separated by periods' translated - initialAnswer: s contents. - newArgs isEmpty ifFalse: [ - newArgsArray := Compiler evaluate: '{', newArgs, '}' for: self. - self arguments: newArgsArray]. - ! Item was removed: - ----- Method: SimpleSliderMorph>>setLabel (in category 'menu') ----- - setLabel - - | newLabel | - newLabel := UIManager default - request: - 'Please a new label for this button' - initialAnswer: self label. - newLabel isEmpty ifFalse: [self label: newLabel]. - ! Item was removed: - ----- Method: SimpleSliderMorph>>setMaxVal (in category 'menu') ----- - setMaxVal - - | newMaxVal | - newMaxVal := UIManager default - request: 'Maximum value?' - initialAnswer: maxVal printString. - newMaxVal isEmpty ifFalse: [ - maxVal := newMaxVal asNumber. - minVal := minVal min: maxVal]. - ! Item was removed: - ----- Method: SimpleSliderMorph>>setMaxVal: (in category 'private') ----- - setMaxVal: newMaxVal - maxVal := newMaxVal asNumber. - minVal := maxVal min: minVal - ! Item was removed: - ----- Method: SimpleSliderMorph>>setMinVal (in category 'menu') ----- - setMinVal - - | newMinVal | - newMinVal := UIManager default - request: 'Minimum value?' - initialAnswer: minVal printString. - newMinVal isEmpty ifFalse: [ - minVal := newMinVal asNumber. - maxVal := maxVal max: minVal]. - ! Item was removed: - ----- Method: SimpleSliderMorph>>setMinVal: (in category 'menu') ----- - setMinVal: newMinVal - minVal := newMinVal asNumber. - maxVal := maxVal max: minVal - ! Item was removed: - ----- Method: SimpleSliderMorph>>setScaledValue: (in category 'private') ----- - setScaledValue: aNumber - | denom | - (denom := maxVal - minVal) > 0 - ifTrue: - [self setValue: (aNumber - minVal) / denom] - ifFalse: - [self setValue: maxVal] - "If minVal = maxVal, that value is the only one this (rather unuseful!!) slider can bear"! Item was removed: - ----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') ----- - setTarget: evt - | rootMorphs | - rootMorphs := self world rootMorphsAt: evt targetPoint. - target := rootMorphs size > 1 - ifTrue: [rootMorphs second]! Item was removed: - ----- Method: SimpleSliderMorph>>setValue: (in category 'model access') ----- - setValue: newValue - "Update the target with this sliders new value." - - | scaledValue | - self value: newValue. - scaledValue := newValue * (maxVal - minVal) + minVal. - truncate ifTrue: [scaledValue := scaledValue truncated]. - (target notNil and: [setValueSelector notNil]) - ifTrue: - [Cursor normal showWhile: - [target perform: setValueSelector - withArguments: (arguments copyWith: scaledValue)]]! Item was removed: - ----- Method: SimpleSliderMorph>>target (in category 'accessing') ----- - target - - ^ target - ! Item was removed: - ----- Method: SimpleSliderMorph>>target: (in category 'accessing') ----- - target: anObject - - target := anObject - ! Item was removed: - ----- Method: SimpleSliderMorph>>toggleDescending (in category 'menu') ----- - toggleDescending - - descending := self descending not - ! Item was removed: - ----- Method: SimpleSliderMorph>>toggleTruncate (in category 'menu') ----- - toggleTruncate - - truncate := truncate not. - ! Item was removed: - ----- Method: SimpleSliderMorph>>truncate (in category 'private') ----- - truncate - ^ truncate == true! Item was removed: - ----- Method: SimpleSliderMorph>>truncate: (in category 'private') ----- - truncate: aBoolean - truncate := aBoolean! Item was removed: - ----- Method: SimpleSliderMorph>>truncateString (in category 'menu') ----- - truncateString - ^ (truncate - ifTrue: ['turn off truncation' translatedNoop] - ifFalse: ['turn on truncation' translatedNoop]) translated! Item was removed: - ----- Method: SimpleSliderMorph>>updateReferencesUsing: (in category 'copying') ----- - updateReferencesUsing: aDictionary - "Copy and update references in the arguments array during copying." - - super updateReferencesUsing: aDictionary. - arguments := arguments collect: - [:old | aDictionary at: old ifAbsent: [old]]. - ! Item was removed: - ----- Method: SimpleSliderMorph>>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. - target := deepCopier references at: target ifAbsent: [target]. - arguments := arguments collect: [:each | - deepCopier references at: each ifAbsent: [each]]. - ! Item was removed: - ----- Method: SimpleSliderMorph>>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. - "target := target. Weakly copied" - "arguments := arguments. All weakly copied" - minVal := minVal veryDeepCopyWith: deepCopier. "will be fast if integer" - maxVal := maxVal veryDeepCopyWith: deepCopier. - truncate := truncate veryDeepCopyWith: deepCopier. - ! Item was removed: - SimpleButtonMorph subclass: #SimpleSwitchMorph - instanceVariableNames: 'onColor offColor' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !SimpleSwitchMorph commentStamp: 'apb 5/3/2006 16:04' prior: 0! - I represent a switch that can be either on or off. I chnage my state in response to a mouse click. When clicked, I also send my actionSelector to my target, just like a SimpleButtonMorph.! Item was removed: - ----- Method: SimpleSwitchMorph>>doButtonAction (in category 'button') ----- - doButtonAction - "Perform the action of this button. The last argument of the message sent to the target is the new state of this switch." - - | newState | - (target notNil and: [actionSelector notNil]) - ifTrue: - [newState := color = onColor. - target perform: actionSelector - withEnoughArguments: (arguments copyWith: newState)]! Item was removed: - ----- Method: SimpleSwitchMorph>>initialize (in category 'initialization') ----- - initialize - - ^ self initializeWithLabel: 'Toggle' - ! Item was removed: - ----- Method: SimpleSwitchMorph>>initializeWithLabel: (in category 'initialization') ----- - initializeWithLabel: labelString - - super initializeWithLabel: labelString. - self borderWidth: 3. - self extent: self extent + 2. - onColor := Color r: 1.0 g: 0.6 b: 0.6. - offColor := Color lightGray. - - self turnOff.! Item was removed: - ----- Method: SimpleSwitchMorph>>isOff (in category 'switching') ----- - isOff - ^ color ~= onColor! Item was removed: - ----- Method: SimpleSwitchMorph>>isOn (in category 'switching') ----- - isOn - ^ color = onColor! Item was removed: - ----- Method: SimpleSwitchMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - oldColor := self fillStyle.! Item was removed: - ----- Method: SimpleSwitchMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - (self containsPoint: evt cursorPoint) - ifTrue: [self setSwitchState: (oldColor = offColor)] - ifFalse: [self setSwitchState: (oldColor = onColor)]. - ! Item was removed: - ----- Method: SimpleSwitchMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - (self containsPoint: evt cursorPoint) - ifTrue: [ "toggle and do action" - self setSwitchState: (oldColor = offColor). - self doButtonAction] - ifFalse: [ "restore old appearance" - self setSwitchState: (oldColor = onColor)]. - ! Item was removed: - ----- Method: SimpleSwitchMorph>>offColor (in category 'switching') ----- - offColor - - ^ offColor - ! Item was removed: - ----- Method: SimpleSwitchMorph>>offColor: (in category 'switching') ----- - offColor: aColor - - offColor := aColor. - ! Item was removed: - ----- Method: SimpleSwitchMorph>>onColor (in category 'switching') ----- - onColor - - ^ onColor - ! Item was removed: - ----- Method: SimpleSwitchMorph>>onColor: (in category 'switching') ----- - onColor: aColor - - onColor := aColor. - ! Item was removed: - ----- Method: SimpleSwitchMorph>>setSwitchState: (in category 'switching') ----- - setSwitchState: aBoolean - - aBoolean - ifTrue: [self turnOn] - ifFalse: [self turnOff]. - ! Item was removed: - ----- Method: SimpleSwitchMorph>>toggleState (in category 'switching') ----- - toggleState - self isOn - ifTrue: [self turnOff] - ifFalse: [self turnOn]! Item was removed: - ----- Method: SimpleSwitchMorph>>turnOff (in category 'switching') ----- - turnOff - self borderRaised. - self color: offColor! Item was removed: - ----- Method: SimpleSwitchMorph>>turnOn (in category 'switching') ----- - turnOn - self borderInset. - self color: onColor! Item was removed: - ----- Method: SimpleSwitchMorph>>updateReferencesUsing: (in category 'copying') ----- - updateReferencesUsing: aDictionary - "Copy and update references in the arguments array during copying." - - super updateReferencesUsing: aDictionary. - arguments := arguments collect: - [:old | aDictionary at: old ifAbsent: [old]]. - ! Item was removed: - Morph subclass: #SketchEditorMorph - instanceVariableNames: 'hostView palette ticksToDwell rotationCenter registrationPoint newPicBlock emptyPicBlock paintingForm dimForm formCanvas rotationButton scaleButton cumRot cumMag undoBuffer enclosingPasteUpMorph forEachHand' - classVariableNames: 'SketchTimes' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !SketchEditorMorph commentStamp: '<historical>' prior: 0! - Inst vars (converting to morphic events) - hostView -- SketchMorph we are working on. - stampForm -- Stamp is stored here. - canvasRectangle -- later use bounds - palette -- the PaintBox interface Morph - dirty -- not used - currentColor - ticksToDwell rotationCenter registrationPoint - newPicBlock -- do this after painting - action -- selector of painting action - paintingForm -- our copy - composite -- now paintArea origin. world relative. stop using it. - dimForm -- SketchMorph of the dimmed background. Opaque. - installed behind the editor morph. - buff - brush -- 1-bit Form of the brush, - paintingFormPen - formCanvas -- Aim it at paintingForm to allow it to draw ovals, rectangles, lines, etc. - picToComp dimToComp compToDisplay -- used to composite -- obsolete - picToBuff brushToBuff buffToBuff buffToPic - rotationButton scaleButton -- submorphs, handles to do these actions. - strokeOrigin -- During Pickup, origin of rect. - cumRot cumMag -- cumulative for multiple operations from same original - undoBuffer - lastEvent - currentNib -- 1 bit deep form. - - - For now, we do not carry the SketchMorph's registration point, rotation center, or ticksToDwell. - - New -- using transform morphs to rotate the finished player. How get it rotated back and the rotationDegrees to be right? We cancel out rotationDegrees, so how remember it? - - Registration point convention: - In a GraphicFrame, reg point is relative to this image's origin. - During painting, it is relative to canvasRectangle origin, and thus us absolute within the canvas. To convert back, subract newBox origin. - - Be sure to convert back and forth correctly. In deliverPainting. initializeFromFrame:inView: ! Item was removed: - ----- Method: SketchEditorMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Not to be instantiated from the menu" - ^ false! Item was removed: - ----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') ----- - addRotationScaleHandles - - "Rotation and scaling handles" - - rotationButton := SketchMorph withForm: (palette rotationTabForm). - rotationButton position: bounds topCenter - (6 at 0). - rotationButton on: #mouseDown send: #rotateScalePrep: to: self. - rotationButton on: #mouseMove send: #rotateBy: to: self. - rotationButton on: #mouseUp send: #rotateDone: to: self. - rotationButton on: #mouseEnter send: #mouseLeave: to: self. - "Put cursor back" - rotationButton on: #mouseLeave send: #mouseEnter: to: self. - Preferences rotationAndScaleHandlesInPaintBox ifTrue: - [self addMorph: rotationButton]. - rotationButton setBalloonText: 'Drag me sideways to - rotate your - picture.' translated. - - scaleButton := SketchMorph withForm: (palette scaleTabForm). - scaleButton position: bounds rightCenter - ((scaleButton width)@6). - scaleButton on: #mouseDown send: #rotateScalePrep: to: self. - scaleButton on: #mouseMove send: #scaleBy: to: self. - scaleButton on: #mouseEnter send: #mouseLeave: to: self. - "Put cursor back" - scaleButton on: #mouseLeave send: #mouseEnter: to: self. - Preferences rotationAndScaleHandlesInPaintBox ifTrue: - [self addMorph: scaleButton]. - scaleButton setBalloonText: 'Drag me up and down to change - the size - of your picture.' translated. - - "REMOVED: - fwdButton := PolygonMorph new. - pt := bounds topCenter. - fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor: - (Color r: 0 g: 0.8 b: 0). - fwdButton removeHandles; setVertices: (Array with: pt+(0 at 7) with: - pt+(0 at 22)). - fwdButton on: #mouseMove send: #forward:direction: to: self. - fwdButton on: #mouseEnter send: #mouseLeave: to: self. - fwdButton on: #mouseLeave send: #mouseEnter: to: self. - self setProperty: #fwdButton toValue: fwdButton. - self addMorph: fwdButton. - fwdButton setBalloonText: 'Drag me around to point - in the direction - I go forward.' translated. - - toggle := EllipseMorph - newBounds: (Rectangle center: fwdButton vertices last + - (-4 at 4) extent: 8 at 8) - color: Color gray. - toggle on: #mouseUp send: #toggleDirType:in: to: self. - toggle on: #mouseEnter send: #mouseLeave: to: self. - toggle on: #mouseLeave send: #mouseEnter: to: self. - self setProperty: #fwdToggle toValue: toggle. - fwdButton addMorph: toggle. - toggle setBalloonText: 'When your object turns, - how should its - picture change? - It can rotate, face left or right, - face up or down, or not - change.' translated. - " - self setProperty: #rotationStyle toValue: hostView rotationStyle. - " self forward: hostView setupAngle direction: fwdButton. " - "Set to its current value" - - ! Item was removed: - ----- Method: SketchEditorMorph>>afterNewPicDo:ifNoBits: (in category 'start & finish') ----- - afterNewPicDo: goodBlock ifNoBits: badBlock - "If the user said 'Save' at the end of drawing, do this block to save the picture. - goodBlock takes 2 args, the painted form and the bounding rectangle of its bits. - badBlock takes no args. " - - newPicBlock := goodBlock. - emptyPicBlock := badBlock.! Item was removed: - ----- Method: SketchEditorMorph>>cancel: (in category 'start & finish') ----- - cancel: evt - "Palette is telling us that the use wants to end the painting session. " - - Cursor normal show. - self deliverPainting: #cancel evt: evt.! Item was removed: - ----- Method: SketchEditorMorph>>cancelOutOfPainting (in category 'start & finish') ----- - cancelOutOfPainting - "The user requested to back out of a painting session without saving" - - self deleteSelfAndSubordinates. - emptyPicBlock ifNotNil: [emptyPicBlock value]. "note no args to block!!" - hostView ifNotNil: [hostView changed]. - Project current world resumeScriptsPausedByPainting. - ^ nil! Item was removed: - ----- Method: SketchEditorMorph>>cancelPainting:evt: (in category 'palette handling') ----- - cancelPainting: aPaintBoxMorph evt: evt - "Undo the operation after user issued #cancel in aPaintBoxMorph" - ^self cancel: evt! Item was removed: - ----- Method: SketchEditorMorph>>clear (in category 'actions & preps') ----- - clear - "wipe out all the paint" - - self polyFreeze. "end polygon mode" - paintingForm fillWithColor: Color transparent. - self invalidRect: bounds.! Item was removed: - ----- Method: SketchEditorMorph>>clearPainting: (in category 'palette handling') ----- - clearPainting: aPaintBoxMorph - "Clear the image after user issued #clear in aPaintBoxMorph" - ^self clear! Item was removed: - ----- Method: SketchEditorMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white alpha: 0.5! Item was removed: - ----- Method: SketchEditorMorph>>deleteSelfAndSubordinates (in category 'start & finish') ----- - deleteSelfAndSubordinates - "Delete the receiver and, if it has one, its subordinate dimForm" - self delete. - dimForm ifNotNil: [dimForm delete]! Item was removed: - ----- Method: SketchEditorMorph>>deliverPainting:evt: (in category 'start & finish') ----- - deliverPainting: result evt: evt - "Done painting. May come from resume, or from original call. Execute user's post painting instructions in the block. Always use this standard one. 4/21/97 tk" - - | newBox newForm ans | - palette ifNotNil: "nil happens" [palette setAction: #paint: evt: evt]. "Get out of odd modes" - "rot := palette getRotations." "rotate with heading, or turn to and fro" - "palette setRotation: #normal." - result == #cancel ifTrue: [ - ans := Project uiManager - chooseOptionFrom: - { 'throw it away' translated. - 'keep painting it' translated} - title: 'Do you really want to throw away - what you just painted?' translated. - ^ ans = 1 - ifTrue: [self cancelOutOfPainting] - ifFalse: [nil]]. "cancelled out of cancelling." - - "hostView rotationStyle: rot." "rotate with heading, or turn to and fro" - newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. - registrationPoint ifNotNil: - [registrationPoint := registrationPoint - newBox origin]. "relative to newForm origin" - newForm := Form extent: newBox extent depth: paintingForm depth. - newForm copyBits: newBox from: paintingForm at: 0 at 0 - clippingBox: newForm boundingBox rule: Form over fillColor: nil. - newForm isAllWhite ifTrue: - [(self valueOfProperty: #background) == true ifFalse: - [^ self cancelOutOfPainting]]. - - newForm fixAlpha. "so alpha channel stays intact for 32bpp" - - self delete. "so won't find me again" - dimForm ifNotNil: - [dimForm delete]. - newPicBlock value: newForm value: (newBox copy translateBy: bounds origin). - Project current world resumeScriptsPausedByPainting.! Item was removed: - ----- Method: SketchEditorMorph>>dimTheWindow (in category 'palette handling') ----- - dimTheWindow - - "Updated to use TranslucentColor by kfr 10/5 00" - "Do not call twice!! Installs a morph with an 'onion-skinned' copy of the pixels behind me." - - "create an 'onion-skinned' version of the stuff on the screen" - owner outermostMorphThat: [:morph | morph resumeAfterDrawError. false]. - - "an experiment for Nebraska to see if opaque background speeds things up" - - "----- now using the color variable to control background - bgColor := false ifTrue: [TranslucentColor r:1.0 g:1.0 b:1.0 alpha:0.5] ifFalse: [Color white]. - dimForm := (RectangleMorph new color: bgColor; bounds: self bounds; borderWidth: 0). - dimForm position: self position. - owner - privateAddMorph: dimForm - atIndex: (owner submorphs indexOf: self) + 1. - -----" - ! Item was removed: - ----- Method: SketchEditorMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Put the painting on the display" - - color isTransparent ifFalse: [ - aCanvas fillRectangle: bounds color: color - ]. - paintingForm ifNotNil: [ - aCanvas paintImage: paintingForm at: bounds origin]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>ellipse: (in category 'actions & preps') ----- - ellipse: evt - "Draw an ellipse from the center. " - - | rect oldRect ww ext oldExt cColor sOrigin priorEvt | - - sOrigin := self get: #strokeOrigin for: evt. - cColor := self getColorFor: evt. - ext := (sOrigin - evt cursorPoint) abs * 2. - evt shiftPressed ifTrue: [ext := self shiftConstrainPoint: ext]. - rect := Rectangle center: sOrigin extent: ext. - ww := (self getNibFor: evt) width. - (priorEvt := self get: #lastEvent for: evt) ifNotNil: [ - oldExt := (sOrigin - priorEvt cursorPoint) abs + ww * 2. - priorEvt shiftPressed ifTrue: [oldExt := self shiftConstrainPoint: oldExt]. - (oldExt < ext) ifFalse: ["Last draw sticks out, must erase the area" - oldRect := Rectangle center: sOrigin extent: oldExt. - self restoreRect: oldRect]]. - cColor == Color transparent - ifFalse: - [formCanvas fillOval: rect color: Color transparent borderWidth: ww borderColor: cColor] - ifTrue: - [formCanvas fillOval: rect color: cColor borderWidth: ww borderColor: Color black]. - - self invalidRect: rect. - - ! Item was removed: - ----- Method: SketchEditorMorph>>enclosingPasteUpMorph (in category 'access') ----- - enclosingPasteUpMorph - ^ enclosingPasteUpMorph! Item was removed: - ----- Method: SketchEditorMorph>>erase: (in category 'actions & preps') ----- - erase: evt - "Pen is set up to draw transparent squares" - self paint: evt - ! Item was removed: - ----- Method: SketchEditorMorph>>erasePrep: (in category 'actions & preps') ----- - erasePrep: evt - "Transparent paint, square brush. Be careful not to let this be undone by asking palette for brush and color." - - | size pfPen myBrush | - - pfPen := self get: #paintingFormPen for: evt. - size := (self getNibFor: evt) width. - self set: #brush for: evt to: (myBrush := Form extent: size at size depth: 1). - myBrush offset: (0 at 0) - (myBrush extent // 2). - myBrush fillWithColor: Color black. - pfPen sourceForm: myBrush. - "transparent" - pfPen combinationRule: Form erase1bitShape. - pfPen color: Color black. - ! Item was removed: - ----- Method: SketchEditorMorph>>extent: (in category 'morphic') ----- - extent: aPoint - | form | - paintingForm ifNil: [^super extent: aPoint]. - - super extent: aPoint. - form := Form extent: self extent depth: paintingForm depth. - paintingForm displayOn: form. - paintingForm := form. - forEachHand do: [:i | i at: #changed put: true]. - rotationButton position: bounds topCenter - (6 at 0). - scaleButton position: bounds rightCenter - ((scaleButton width)@6). - - ! Item was removed: - ----- Method: SketchEditorMorph>>fill: (in category 'actions & preps') ----- - fill: evt - "Find the area that is the same color as where you clicked. Fill it with - the current paint color." - evt isMouseUp - ifFalse: [^ self]. - "Only fill upon mouseUp" - "would like to only invalidate the area changed, but can't find out what it is." - Cursor execute - showWhile: [ - | box | - box := paintingForm - floodFill: (self getColorFor: evt) - at: evt cursorPoint - bounds origin. - self render: (box translateBy: bounds origin)]! Item was removed: - ----- Method: SketchEditorMorph>>flipHoriz: (in category 'actions & preps') ----- - flipHoriz: evt - "Flip the image" - | temp myBuff | - - myBuff := self get: #buff for: evt. - temp := myBuff deepCopy flipBy: #horizontal centerAt: myBuff center. - temp offset: 0 @ 0. - paintingForm fillWithColor: Color transparent. - temp displayOn: paintingForm at: paintingForm center - myBuff center + myBuff offset. - rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. - self render: bounds! Item was removed: - ----- Method: SketchEditorMorph>>flipVert: (in category 'actions & preps') ----- - flipVert: evt - "Flip the image" - | temp myBuff | - - myBuff := self get: #buff for: evt. - temp := myBuff deepCopy flipBy: #vertical centerAt: myBuff center. - temp offset: 0 @ 0. - paintingForm fillWithColor: Color transparent. - temp displayOn: paintingForm at: paintingForm center - myBuff center + myBuff offset. - rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. - self render: bounds! Item was removed: - ----- Method: SketchEditorMorph>>forward:direction: (in category 'actions & preps') ----- - forward: evt direction: button - "Move the forward direction arrow of this painting. When the user - says forward:, the object moves in the direction of the arrow. evt may be - an Event (from the user moving the arrow), or an initial number ofdegrees." - - | center dir ww ff | - center := bounds center. "+ (rotationButton width - 6 @ 0)" - dir := evt isNumber - ifTrue: - [Point r: 100 degrees: evt - 90.0 - "convert to 0 on X axis"] - ifFalse: [evt cursorPoint - center]. - ww := (bounds height min: bounds width) // 2 - 7. - button - setVertices: (Array with: center + (Point r: ww degrees: dir degrees) - with: center + (Point r: ww - 15 degrees: dir degrees)). - (ff := self valueOfProperty: #fwdToggle) - position: center + (Point r: ww - 7 degrees: dir degrees + 6.5) - - (ff extent // 2). - self showDirType! Item was removed: - ----- Method: SketchEditorMorph>>forwardDirection (in category 'accessing') ----- - forwardDirection - "The direction object will go when issued a sent forward:. Up is - zero. Clockwise like a compass. From the arrow control." - ^ hostView forwardDirection! Item was removed: - ----- Method: SketchEditorMorph>>get:for: (in category 'Nebraska support') ----- - get: aSymbol for: anEventOrHand - - | valuesForHand | - - valuesForHand := self valuesForHand: anEventOrHand. - ^valuesForHand at: aSymbol ifAbsent: [nil]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>getActionFor: (in category 'Nebraska support') ----- - getActionFor: anEventOrHand - - ^(self get: #action for: anEventOrHand) ifNil: [ - self set: #action for: anEventOrHand to: palette action - ]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>getBrushFor: (in category 'Nebraska support') ----- - getBrushFor: anEventOrHand - - ^(self get: #brush for: anEventOrHand) ifNil: [ - self set: #brush for: anEventOrHand to: palette getNib - ]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>getColorFor: (in category 'Nebraska support') ----- - getColorFor: anEventOrHand - - ^(self get: #currentColor for: anEventOrHand) ifNil: [ - self set: #currentColor for: anEventOrHand to: palette getColor - ]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>getCursorFor: (in category 'Nebraska support') ----- - getCursorFor: anEventOrHand - - | plainCursor | - plainCursor := (self get: #currentCursor for: anEventOrHand) ifNil: [ - self set: #currentCursor for: anEventOrHand to: palette plainCursor - ]. - ^palette - cursorFor: (self getActionFor: anEventOrHand) - oldCursor: plainCursor - currentNib: (self getNibFor: anEventOrHand) - color: (self getColorFor: anEventOrHand) - - ! Item was removed: - ----- Method: SketchEditorMorph>>getNibFor: (in category 'Nebraska support') ----- - getNibFor: anEventOrHand - - ^(self get: #currentNib for: anEventOrHand) ifNil: [ - self set: #currentNib for: anEventOrHand to: palette getNib - ]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ true - ! Item was removed: - ----- Method: SketchEditorMorph>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - ^true! Item was removed: - ----- Method: SketchEditorMorph>>handlesMouseOverDragging: (in category 'event handling') ----- - handlesMouseOverDragging: evt - ^true! Item was removed: - ----- Method: SketchEditorMorph>>hostView (in category 'access') ----- - hostView - ^ hostView! Item was removed: - ----- Method: SketchEditorMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - forEachHand := Dictionary new.! Item was removed: - ----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') ----- - initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph - "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph." - - | paintBoxBounds worldBounds | - self world paintingFlapTab ifNotNil: [:tab | - tab showFlap. - ^ self - initializeFor: aSketchMorph - inBounds: boundsToUse - pasteUpMorph: aPasteUpMorph - paintBoxPosition: nil]. - - self setProperty: #recipientPasteUp toValue: aPasteUpMorph. - - paintBoxBounds := self world paintBox bounds. - worldBounds := self world bounds. - - aPasteUpMorph standardPalette ifNotNil: [:palette | palette showNoPalette]. - - self initializeFor: aSketchMorph inBounds: boundsToUse - pasteUpMorph: aPasteUpMorph - paintBoxPosition: ((boundsToUse topRight extent: paintBoxBounds extent) - translatedToBeWithin: worldBounds) topLeft. - ! Item was removed: - ----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph:paintBoxPosition: (in category 'initialization') ----- - initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: aPosition - "NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case. The palette needs already to be in the world for this to work." - | w | - (w := aPasteUpMorph world) addMorphInLayer: self. "in back of palette" - enclosingPasteUpMorph := aPasteUpMorph. - hostView := aSketchMorph. "may be ownerless" - self bounds: boundsToUse. - palette := w paintBox focusMorph: self. - palette beStatic. "give Nebraska whatever help we can" - palette addWeakDependent: self. - self morphicLayerNumber: self class dialogLayer + 1. - palette morphicLayerNumber: self class dialogLayer. - aPosition ifNotNil: - [w addMorphFront: palette. "bring to front" - palette position: aPosition. - palette beSupersized. - self flag: #hacky. "mt: That super-sizing with a flex shell is awkward. Need to fix." - palette owner bounds: (palette owner bounds translatedToBeWithin: self world bounds)]. - paintingForm := Form extent: bounds extent depth: w assuredCanvas depth. - self dimTheWindow. - self addRotationScaleHandles. - aSketchMorph ifNotNil: - [ - aSketchMorph form - displayOn: paintingForm - at: (hostView boundsInWorld origin - bounds origin - hostView form offset) - clippingBox: (0 at 0 extent: paintingForm extent) - rule: Form over - fillColor: nil. "assume they are the same depth". - undoBuffer := paintingForm deepCopy. - rotationCenter := aSketchMorph rotationCenter]! Item was removed: - ----- Method: SketchEditorMorph>>line: (in category 'actions & preps') ----- - line: evt - "Draw a line on the paintingForm using formCanvas aimed at it." - | rect oldRect ww now diff cor cColor sOrigin priorEvt | - sOrigin := self get: #strokeOrigin for: evt. - rect := sOrigin rect: (now := evt cursorPoint). - evt shiftPressed - ifTrue: [diff := evt cursorPoint - sOrigin. - now := sOrigin - + (Point r: diff r degrees: diff degrees + 22.5 // 45 * 45). - rect := sOrigin rect: now]. - ww := (self getNibFor: evt) width. - (priorEvt := self get: #lastEvent for: evt) - ifNotNil: [oldRect := sOrigin rect: priorEvt cursorPoint. - priorEvt shiftPressed - ifTrue: [diff := priorEvt cursorPoint - sOrigin. - cor := sOrigin - + (Point r: diff r degrees: diff degrees + 22.5 // 45 * 45). - oldRect := sOrigin rect: cor]. - oldRect := oldRect expandBy: ww @ ww. - "Last draw will always stick out, must erase the area" - self restoreRect: oldRect]. - cColor := self getColorFor: evt. - formCanvas - line: sOrigin - to: now - width: ww - color: cColor. - self invalidRect: rect! Item was removed: - ----- Method: SketchEditorMorph>>mouseDown: (in category 'morphic') ----- - mouseDown: evt - "Start a new stroke. Check if any palette setting have changed. 6/11/97 20:30 tk" - | cur pfPen myAction | - "verify that we are in a good state" - self verifyState: evt. "includes prepareToPaint and #scalingOrRotate" - pfPen := self get: #paintingFormPen for: evt. - paintingForm extent = undoBuffer extent ifTrue: [ - paintingForm displayOn: undoBuffer at: 0 at 0 rule: Form over. - ] ifFalse: [ - undoBuffer := paintingForm deepCopy. "know we will draw something" - ]. - pfPen place: (evt cursorPoint - bounds origin). - myAction := self getActionFor: evt. - palette colorable ifTrue:[ - palette recentColor: (self getColorFor: evt)]. - self set: #strokeOrigin for: evt to: evt cursorPoint. - "origin point for pickup: rect: ellispe: polygon: line: star:. Always take it." - myAction == #pickup: ifTrue: [ - cur := Cursor corner shallowCopy. - cur offset: 0 at 0 "cur offset abs". - evt hand showTemporaryCursor: cur]. - myAction == #polygon: ifTrue: [self polyNew: evt]. "a mode lets you drag vertices" - self mouseMove: evt.! Item was removed: - ----- Method: SketchEditorMorph>>mouseEnter: (in category 'event handling') ----- - mouseEnter: evt - "Set the cursor. Reread colors if embedded editable polygon needs it." - - | poly cColor | - super mouseEnter: evt. - (self get: #action for: evt) == #scaleOrRotate ifTrue: [ - self set: #action for: evt to: (self get: #priorAction for: evt). - ]. "scale and rotate are not real modes. If we enter with one, wear the previous tool." - evt hand showTemporaryCursor: (self getCursorFor: evt). - palette getSpecial == #polygon: ifFalse: [^self]. - (poly := self valueOfProperty: #polygon) ifNil: [^ self]. - cColor := self getColorFor: evt. - poly borderColor: cColor; borderWidth: (self getNibFor: evt) width. - poly changed.! Item was removed: - ----- Method: SketchEditorMorph>>mouseEnterDragging: (in category 'event handling') ----- - mouseEnterDragging: evt - "Test button state elsewhere if at all" - ^ self mouseEnter: evt! Item was removed: - ----- Method: SketchEditorMorph>>mouseLeave: (in category 'event handling') ----- - mouseLeave: evt - "Revert to the normal hand cursor." - - super mouseLeave: evt. - evt hand showTemporaryCursor: nil. "back to normal" - "If this is modified to close down the SketchEditorMorph in any way, watch out for how it is called when entering a rotationButton and a scaleButton." - ! Item was removed: - ----- Method: SketchEditorMorph>>mouseLeaveDragging: (in category 'event handling') ----- - mouseLeaveDragging: evt - "Test button state elsewhere if at all" - ^ self mouseLeave: evt! Item was removed: - ----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - "In the middle of drawing a stroke. 6/11/97 19:51 tk" - - | pt priorEvt | - WorldState canSurrenderToOS: false. "we want maximum responsiveness" - pt := evt cursorPoint. - priorEvt := self get: #lastEvent for: evt. - (priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self]. - self perform: (self getActionFor: evt) with: evt. - "Each action must do invalidRect:" - self - set: #lastEvent - for: evt - to: evt. - false - ifTrue: - ["So senders will find the things performed here" - - self - paint: nil; - fill: nil; - erase: nil; - pickup: nil; - stamp: nil. - self - rect: nil; - ellipse: nil; - polygon: nil; - line: nil; - star: nil]! Item was removed: - ----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - | myAction | - "Do nothing except those that work on mouseUp." - - myAction := self getActionFor: evt. - myAction == #fill: ifTrue: [ - self perform: myAction with: evt. - "Each action must do invalidRect:" - ]. - myAction == #pickup: ifTrue: [ - self pickupMouseUp: evt]. - myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices" - self set: #lastEvent for: evt to: nil. - ! Item was removed: - ----- Method: SketchEditorMorph>>notes (in category 'actions & preps') ----- - notes - " - Singleton costumes. - Registration points - "! Item was removed: - ----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') ----- - paint: evt - "While the mouse is down, lay down paint, but only within window bounds. - 11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up" - - | mousePoint startRect endRect startToEnd pfPen myBrush | - - pfPen := self get: #paintingFormPen for: evt. - myBrush := self getBrushFor: evt. - mousePoint := evt cursorPoint. - startRect := pfPen location + myBrush offset extent: myBrush extent. - pfPen goto: mousePoint - bounds origin. - endRect := pfPen location + myBrush offset extent: myBrush extent. - "self render: (startRect merge: endRect). Show the user what happened" - startToEnd := startRect merge: endRect. - self invalidRect: (startToEnd translateBy: bounds origin). - ! Item was removed: - ----- Method: SketchEditorMorph>>paintBoxChanged: (in category 'palette handling') ----- - paintBoxChanged: arguments - - self set: arguments first for: arguments second to: arguments third. - ! Item was removed: - ----- Method: SketchEditorMorph>>painting (in category 'access') ----- - painting - ^ paintingForm! Item was removed: - ----- Method: SketchEditorMorph>>palette (in category 'access') ----- - palette - ^palette! Item was removed: - ----- Method: SketchEditorMorph>>paletteAttached: (in category 'palette handling') ----- - paletteAttached: aPaintBoxMorph - "A new palette has been attached to the receiver. - Don't know what to do here..."! Item was removed: - ----- Method: SketchEditorMorph>>paletteDetached: (in category 'palette handling') ----- - paletteDetached: aPaintBoxMorph - "The palette has been detached to the receiver. - Don't know what to do here...."! Item was removed: - ----- Method: SketchEditorMorph>>pickup: (in category 'actions & preps') ----- - pickup: evt - "Grab a part of the picture (or screen) and store it in a known place. Note where we started. Use a rubberband rectangle to show what is being selected." - - | rect oldRect sOrigin priorEvt | - sOrigin := self get: #strokeOrigin for: evt. - rect := sOrigin rect: evt cursorPoint + (14 @ 14). - (priorEvt := self get: #lastEvent for: evt) isNil - ifFalse: - ["Last draw will stick out, must erase the area" - - oldRect := sOrigin rect: priorEvt cursorPoint + (14 @ 14). - self restoreRect: (oldRect insetBy: -2)]. - formCanvas - frameAndFillRectangle: (rect insetBy: -2) - fillColor: Color transparent - borderWidth: 2 - borderColor: Color gray. - self invalidRect: (rect insetBy: -2)! Item was removed: - ----- Method: SketchEditorMorph>>pickupMouseUp: (in category 'actions & preps') ----- - pickupMouseUp: evt - "Grab a part of the picture (or screen) and store it in a known place. Like Copy on the Mac menu. Then switch to the stamp tool." - - | rr pForm ii oldRect sOrigin priorEvt | - sOrigin := self get: #strokeOrigin for: evt. - (priorEvt := self get: #lastEvent for: evt) isNil - ifFalse: - ["Last draw will stick out, must erase the area" - - oldRect := sOrigin rect: priorEvt cursorPoint + (14 @ 14). - self restoreRect: (oldRect insetBy: -2)]. - self primaryHand showTemporaryCursor: nil. "later get rid of this" - rr := sOrigin rect: evt cursorPoint + (14 @ 14). - ii := rr translateBy: 0 @ 0 - bounds origin. - (rr intersects: bounds) - ifTrue: - [pForm := paintingForm copy: ii. - pForm isAllWhite - ifFalse: - ["means transparent" - - "normal case. Can be transparent in parts" - - ] - ifTrue: - [pForm := nil - "Get an un-dimmed picture of other objects on the playfield" - "don't know how yet"]]. - pForm ifNil: [pForm := Form fromDisplay: rr]. "Anywhere on the screen" - palette pickupForm: pForm evt: evt. - evt hand showTemporaryCursor: (self getCursorFor: evt)! Item was removed: - ----- Method: SketchEditorMorph>>polyEdit: (in category 'actions & preps') ----- - polyEdit: evt - "Add handles and let user drag'em around" - | poly | - poly := self valueOfProperty: #polygon. - poly ifNil:[^self]. - poly addHandles. - self polyEditing: true. - self setProperty: #polyCursor toValue: palette plainCursor. - palette plainCursor: Cursor normal event: evt.! Item was removed: - ----- Method: SketchEditorMorph>>polyEditing (in category 'actions & preps') ----- - polyEditing - ^self valueOfProperty: #polyEditing ifAbsent:[false]! Item was removed: - ----- Method: SketchEditorMorph>>polyEditing: (in category 'actions & preps') ----- - polyEditing: aBool - aBool - ifTrue:[self setProperty: #polyEditing toValue: aBool] - ifFalse:[self removeProperty: #polyEditing]! Item was removed: - ----- Method: SketchEditorMorph>>polyFreeze (in category 'actions & preps') ----- - polyFreeze - "A live polygon is on the painting. Draw it into the painting and - delete it." - - | poly | - self polyEditing ifFalse:[^self]. - (poly := self valueOfProperty: #polygon) - ifNil: - [self polyEditing: false. - ^ self]. - poly drawOn: formCanvas. - poly delete. - self setProperty: #polygon toValue: nil. - self polyEditing: false.! Item was removed: - ----- Method: SketchEditorMorph>>polyNew: (in category 'actions & preps') ----- - polyNew: evt - "Create a new polygon. Add it to the sketch, and let the user drag - its vertices around!! Freeze it into the painting when the user chooses - another tool." - - | poly cColor | - self polyEditing ifTrue:[ - self polyFreeze. - (self hasProperty: #polyCursor) - ifTrue:[palette plainCursor: (self valueOfProperty: #polyCursor) event: evt. - self removeProperty: #polyCursor]. - ^self]. - cColor := self getColorFor: evt. - self polyFreeze. "any old one we were working on" - poly := PolygonMorph new "addHandles". - poly referencePosition: poly bounds origin. - poly align: poly bounds center with: evt cursorPoint. - poly borderWidth: (self getNibFor: evt) width. - poly borderColor: (cColor isTransparent ifTrue: [Color black] ifFalse: [cColor]). - poly color: Color transparent. - self addMorph: poly. - poly changed. - self setProperty: #polygon toValue: poly.! Item was removed: - ----- Method: SketchEditorMorph>>polygon: (in category 'actions & preps') ----- - polygon: evt - | poly | - poly := self valueOfProperty: #polygon. - poly ifNil:[^self]. - evt cursorPoint > poly bounds origin ifTrue:[ - poly extent: ((evt cursorPoint - poly bounds origin) max: 5 at 5)].! Item was removed: - ----- Method: SketchEditorMorph>>prepareToPaint: (in category 'start & finish') ----- - prepareToPaint: evt - "Figure out what the current brush, fill, etc is. Return an action to take every mouseMove. Set up instance variable and pens. Prep for normal painting is inlined here. tk 6/14/97 21:11" - - | specialMode pfPen cColor cNib myBrush | - "Install the brush, color, (replace mode), and cursor." - specialMode := self getActionFor: evt. - cColor := self getColorFor: evt. - cNib := self getNibFor: evt. - self set: #brush for: evt to: (myBrush := cNib). - self set: #paintingFormPen for: evt to: (pfPen := Pen newOnForm: paintingForm). - self set: #stampForm for: evt to: nil. "let go of stamp" - formCanvas := paintingForm getCanvas. "remember to change when undo" - formCanvas := formCanvas - copyOrigin: self topLeft negated - clipRect: (0 at 0 extent: bounds extent). - - specialMode == #paint: ifTrue: [ - "get it to one bit depth. For speed, instead of going through a colorMap every time ." - self set: #brush for: evt to: (myBrush := Form extent: myBrush extent depth: 1). - myBrush offset: (0 at 0) - (myBrush extent // 2). - cNib displayOn: myBrush at: (0 at 0 - cNib offset). - - pfPen sourceForm: myBrush. - pfPen combinationRule: Form paint. - pfPen color: cColor. - cColor isTransparent ifTrue: [ - pfPen combinationRule: Form erase1bitShape. - pfPen color: Color black]. - ^ #paint:]. - - specialMode == #erase: ifTrue: [ - self erasePrep: evt. - ^ #erase:]. - specialMode == #stamp: ifTrue: [ - self set: #stampForm for: evt to: palette stampForm. "keep it" - ^ #stamp:]. - - (self respondsTo: specialMode) - ifTrue: [^ specialMode] "fill: areaFill: pickup: (in mouseUp:) - rect: ellipse: line: polygon: star:" - ifFalse: ["Don't recognise the command" - palette setAction: #paint: evt: evt. "set it to Paint" - ^ self prepareToPaint: evt].! Item was removed: - ----- Method: SketchEditorMorph>>rect: (in category 'actions & preps') ----- - rect: evt - "While moving corner, just write on the canvas. When done, write on the paintingForm" - - | rect oldRect now diff cor cColor sOrigin priorEvt | - sOrigin := self get: #strokeOrigin for: evt. - rect := sOrigin rect: (now := evt cursorPoint). - cColor := self getColorFor: evt. - evt shiftPressed - ifTrue: [diff := evt cursorPoint - sOrigin. - now := sOrigin - + (Point r: (diff x abs min: diff y abs) - * 2 degrees: diff degrees // 90 * 90 + 45). - rect := sOrigin rect: now]. - (priorEvt := self get: #lastEvent for: evt) isNil - ifFalse: [oldRect := sOrigin rect: priorEvt cursorPoint. - priorEvt shiftPressed - ifTrue: [diff := priorEvt cursorPoint - sOrigin. - cor := sOrigin - + (Point r: (diff x abs min: diff y abs) - * 2 degrees: diff degrees // 90 * 90 + 45). - oldRect := sOrigin rect: cor]. - self restoreRect: oldRect]. "Last draw will stick out, must erase the area" - - cColor == Color transparent - ifTrue: [formCanvas - frameAndFillRectangle: rect - fillColor: Color transparent - borderWidth: (self getNibFor: evt) width - borderColor: Color black] - ifFalse: [formCanvas - frameAndFillRectangle: rect - fillColor: Color transparent - borderWidth: (self getNibFor: evt) width - borderColor: cColor]. - self invalidRect: rect! Item was removed: - ----- Method: SketchEditorMorph>>registrationPoint (in category 'access') ----- - registrationPoint - ^ registrationPoint! Item was removed: - ----- Method: SketchEditorMorph>>registrationPoint: (in category 'access') ----- - registrationPoint: aPoint - registrationPoint := aPoint! Item was removed: - ----- Method: SketchEditorMorph>>render: (in category 'actions & preps') ----- - render: damageRect - "Compose the damaged area again and store on the display. damageRect is relative to paintingForm origin. 3/19/97 tk" - - self invalidRect: damageRect. "Now in same coords as self bounds" - ! Item was removed: - ----- Method: SketchEditorMorph>>replaceOnly: (in category 'actions & preps') ----- - replaceOnly: initialMousePoint - "Paint replacing only one color!! Call this each stroke. Also works for replacing all but one color. " - - ! Item was removed: - ----- Method: SketchEditorMorph>>restoreRect: (in category 'actions & preps') ----- - restoreRect: oldRect - "Restore the given rectangular area of the painting Form from the undo buffer." - - formCanvas drawImage: undoBuffer - at: oldRect origin - sourceRect: (oldRect translateBy: self topLeft negated). - self invalidRect: oldRect. - ! Item was removed: - ----- Method: SketchEditorMorph>>rotateBy: (in category 'actions & preps') ----- - rotateBy: evt - "Left-right is rotation. 3/26/97 tk Slider at top of window. 4/3/97 tk" - | pt temp amt smooth myBuff | - - myBuff := self get: #buff for: evt. - evt cursorPoint x - self left < 20 - ifTrue: [^ self flipHoriz: evt]. - "at left end flip horizontal" - evt cursorPoint x - self right > -20 - ifTrue: [^ self flipVert: evt]. - "at right end flip vertical" - pt := evt cursorPoint - bounds center. - smooth := 2. - "paintingForm depth > 8 ifTrue: [2] ifFalse: [1]." - "Could go back to 1 for speed" - amt := pt x abs < 12 - ifTrue: ["detent" - 0] - ifFalse: [pt x - (12 * pt x abs // pt x)]. - amt := amt * 1.8. - temp := myBuff - rotateBy: amt - magnify: cumMag - smoothing: smooth. - temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset. - rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. - self render: bounds. - cumRot := amt! Item was removed: - ----- Method: SketchEditorMorph>>rotateDone: (in category 'actions & preps') ----- - rotateDone: evt - "MouseUp, snap box back to center." - - " - self render: rotationButton bounds. - rotationButton position: (canvasRectangle width // 2 + composite x) @ rotationButton position y. - self render: rotationButton bounds. - " "Not snap back..."! Item was removed: - ----- Method: SketchEditorMorph>>rotateScalePrep: (in category 'actions & preps') ----- - rotateScalePrep: evt - "Make a source that is the paintingForm. Work from that. 3/26/97 tk" - - | newBox myBuff | - - (self getActionFor: evt) == #scaleOrRotate ifTrue: [^ self]. "Already doing it" - paintingForm width > 120 - ifTrue: [newBox := paintingForm rectangleEnclosingPixelsNotOfColor: Color transparent. - "minimum size" - newBox := newBox insetBy: - ((18 - newBox width max: 0)//2) @ ((18 - newBox height max: 0)//2) * -1] - ifFalse: [newBox := paintingForm boundingBox]. - newBox := newBox expandBy: 1. - self set: #buff for: evt to: (myBuff := Form extent: newBox extent depth: paintingForm depth). - myBuff offset: newBox center - paintingForm center. - myBuff copyBits: newBox from: paintingForm at: 0 at 0 - clippingBox: myBuff boundingBox rule: Form over fillColor: nil. - "Could just run up owner chain asking colorUsed, but may not be embedded" - cumRot := 0.0. cumMag := 1.0. "start over" - self set: #changed for: evt to: true. - self set: #action for: evt to: #scaleOrRotate. - "Only changed by mouseDown with tool in paint area"! Item was removed: - ----- Method: SketchEditorMorph>>rotationStyle (in category 'e-toy support') ----- - rotationStyle - - ^ (self valueOfProperty: #rotationStyle) ifNil: [#normal]! Item was removed: - ----- Method: SketchEditorMorph>>save: (in category 'start & finish') ----- - save: evt - "Palette is telling us that the use wants to end the painting session. " - - Cursor blank show. - (self getActionFor: evt) == #polygon: ifTrue: [self polyFreeze]. "end polygon mode" - ^ self deliverPainting: #okay evt: evt.! Item was removed: - ----- Method: SketchEditorMorph>>savePainting:evt: (in category 'palette handling') ----- - savePainting: aPaintBoxMorph evt: evt - "Save the image after user issued #keep in aPaintBoxMorph" - ^self save: evt! Item was removed: - ----- Method: SketchEditorMorph>>scaleBy: (in category 'actions & preps') ----- - scaleBy: evt - "up-down is scale. 3/26/97 tk Now a slider on the right." - | pt temp cy oldRect amt myBuff | - - myBuff := self get: #buff for: evt. - pt := evt cursorPoint - bounds center. - cy := bounds height * 0.5. - oldRect := myBuff boundingBox expandBy: myBuff extent * cumMag / 2. - amt := pt y abs < 12 - ifTrue: ["detent" - 1.0] - ifFalse: [pt y - (12 * pt y abs // pt x)]. - amt := amt asFloat / cy + 1.0. - temp := myBuff - rotateBy: cumRot - magnify: amt - smoothing: 2. - cumMag > amt - ifTrue: ["shrinking" - oldRect := oldRect translateBy: paintingForm center - oldRect center + myBuff offset. - paintingForm - fill: (oldRect expandBy: 1 @ 1) - rule: Form over - fillColor: Color transparent]. - temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset. - scaleButton position: scaleButton position x @ (evt cursorPoint y - 6). - self render: bounds. - cumMag := amt! Item was removed: - ----- Method: SketchEditorMorph>>set:for:to: (in category 'Nebraska support') ----- - set: aSymbol for: anEventOrHand to: anObject - - | valuesForHand | - - valuesForHand := self valuesForHand: anEventOrHand. - aSymbol == #action ifTrue: [ - valuesForHand at: #priorAction put: (valuesForHand at: #action ifAbsent: [#paint:]). - (anObject ~~ #polygon: and:[self polyEditing]) ifTrue:[self polyFreeze]. - ]. - valuesForHand at: aSymbol put: anObject. - ^anObject - - ! Item was removed: - ----- Method: SketchEditorMorph>>setExtentFromHalo: (in category 'morphic') ----- - setExtentFromHalo: anExtent - "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed" - super setExtentFromHalo: ((anExtent x max: paintingForm width) @ (anExtent y max: paintingForm height)). - ! Item was removed: - ----- Method: SketchEditorMorph>>setRotations: (in category 'start & finish') ----- - setRotations: num - "Tell the palette what number of rotations (or background) to show. " - - | key | - key := 'ItTurns'. "default and value for num > 1" - num = 1 ifTrue: [key := 'JustAsIs']. - num = 18 ifTrue: [key := 'ItTurns']. - num = 99 ifTrue: [key := 'ToAndFro']. - num == #Background ifTrue: [key := 'Background']. - num == #Repeated ifTrue: [key := 'Repeated']. - palette setRotations: (palette contentsAtKey: key).! Item was removed: - ----- Method: SketchEditorMorph>>shiftConstrainPoint: (in category 'actions & preps') ----- - shiftConstrainPoint: aPoint - - "answer a point with x and y equal for shift-constrained drawing" - - ^aPoint max: aPoint transposed! Item was removed: - ----- Method: SketchEditorMorph>>showDirType (in category 'actions & preps') ----- - showDirType - "Display the proper symbol for this direction type. rotationStyle - is one of #(normal leftRight upDown none)." - - | rr poly | - rr := self rotationStyle. - poly := self valueOfProperty: #fwdButton. - rr == #normal ifTrue: [^ poly makeBackArrow]. - rr == #leftRight ifTrue: [ - poly makeBothArrows. - ^ poly setVertices: (Array with: poly center - (7 at 0) with: poly - center + (7 at 0))]. - rr == #upDown ifTrue: [ - poly makeBothArrows. - ^ poly setVertices: (Array with: poly center - (0 at 7) with: poly - center + (0 at 7))]. - rr == #none ifTrue: [ - poly makeNoArrows. - ^ poly setVertices: (Array with: poly center - (7 at 0) with: poly - center + (7 at 0) - with: poly center with: poly center - (0 at 7) with: poly - center + (0 at 7))]. - ! Item was removed: - ----- Method: SketchEditorMorph>>stamp: (in category 'actions & preps') ----- - stamp: evt - "plop one copy of the user's chosen Form down." - - "Check depths" - | pt sForm | - - sForm := self get: #stampForm for: evt. - pt := evt cursorPoint - (sForm extent // 2). - sForm displayOn: paintingForm - at: pt - bounds origin - clippingBox: paintingForm boundingBox - rule: Form paint - fillColor: nil. - self render: (pt extent: sForm extent). - ! Item was removed: - ----- Method: SketchEditorMorph>>star: (in category 'actions & preps') ----- - star: evt - "Draw an star from the center." - | poly ext ww rect oldExt oldRect oldR verts pt cColor sOrigin priorEvt | - sOrigin := self get: #strokeOrigin for: evt. - cColor := self getColorFor: evt. - ww := (self getNibFor: evt) width. - ext := (pt := sOrigin - evt cursorPoint) r + ww * 2. - rect := Rectangle center: sOrigin extent: ext. - (priorEvt := self get: #lastEvent for: evt) - ifNotNil: [oldExt := (sOrigin - priorEvt cursorPoint) r + ww * 2. - "Last draw sticks out, must erase the area" - oldRect := Rectangle center: sOrigin extent: oldExt. - self restoreRect: oldRect]. - ext := pt r. - oldR := ext. - verts := (0 to: 350 by: 36) - collect: [:angle | (Point r: (oldR := oldR = ext - ifTrue: [ext * 5 // 12] - ifFalse: [ext]) degrees: angle + pt degrees) - + sOrigin]. - poly := PolygonMorph new addHandles. - poly borderColor: (cColor isTransparent ifTrue: [Color black] ifFalse: [cColor]). - poly borderWidth: (self getNibFor: evt) width. - poly fillStyle: Color transparent. - - "can't handle thick brushes" - self invalidRect: rect. - "self addMorph: poly." - poly privateOwner: self. - poly - bounds: (sOrigin extent: ext). - poly setVertices: verts. - poly drawOn: formCanvas. - "poly delete." - self invalidRect: rect! Item was removed: - ----- Method: SketchEditorMorph>>ticksToDwell (in category 'access') ----- - ticksToDwell - ticksToDwell isNil ifTrue: [ticksToDwell := 1]. - ^ticksToDwell! Item was removed: - ----- Method: SketchEditorMorph>>ticksToDwell: (in category 'access') ----- - ticksToDwell: t - ticksToDwell := t! Item was removed: - ----- Method: SketchEditorMorph>>toggleDirType:in: (in category 'actions & preps') ----- - toggleDirType: evt in: handle - "Toggle from 'rotate' to 'to and fro' to 'up and down' to 'none' - for the kind of rotation the object does. An actor's rotationStyle is one - of #(normal leftRight upDown none)." - - | rr ii | - "Clear the indicator" - - "Find new style, store it, install the indicator" - rr := self rotationStyle. - ii := #(normal leftRight upDown none) indexOf: rr. - self setProperty: #rotationStyle toValue: - (#(leftRight upDown none normal) at: ii). - ii = 4 ifTrue: ["normal" self forward: self forwardDirection - direction: (self valueOfProperty: #fwdButton)] - ifFalse: [self showDirType.].! Item was removed: - ----- Method: SketchEditorMorph>>undo: (in category 'start & finish') ----- - undo: evt - "revert to a previous state. " - - | temp poly pen | - self flag: #bob. "what is undo in multihand environment?" - undoBuffer ifNil: [^Beeper beep]. "nothing to go back to" - (poly := self valueOfProperty: #polygon) ifNotNil: - [poly delete. - self setProperty: #polygon toValue: nil. - self polyEditing: false. - ^self]. - temp := paintingForm. - paintingForm := undoBuffer. - undoBuffer := temp. "can get back to what you had by undoing again" - pen := self get: #paintingFormPen for: evt. - pen ifNil: [^Beeper beep]. - pen setDestForm: paintingForm. - formCanvas := paintingForm getCanvas. "used for lines, ovals, etc." - formCanvas := formCanvas copyOrigin: self topLeft negated - clipRect: (0 @ 0 extent: bounds extent). - self render: bounds! Item was removed: - ----- Method: SketchEditorMorph>>undoPainting:evt: (in category 'palette handling') ----- - undoPainting: aPaintBoxMorph evt: evt - "Undo the operation after user issued #undo in aPaintBoxMorph" - ^self undo: evt! Item was removed: - ----- Method: SketchEditorMorph>>valuesForHand: (in category 'Nebraska support') ----- - valuesForHand: anEventOrHand - - | hand valuesForHand | - forEachHand ifNil: [forEachHand := IdentityDictionary new]. - hand := (anEventOrHand isKindOf: HandMorph) - ifTrue: [anEventOrHand] ifFalse: [anEventOrHand hand]. - valuesForHand := forEachHand at: hand ifAbsentPut: [Dictionary new]. - ^valuesForHand - - ! Item was removed: - ----- Method: SketchEditorMorph>>valuesForHandIfPresent: (in category 'Nebraska support') ----- - valuesForHandIfPresent: anEventOrHand - | hand | - forEachHand ifNil: [forEachHand := IdentityDictionary new]. - hand := (anEventOrHand isHandMorph) - ifTrue: [anEventOrHand] - ifFalse: [anEventOrHand hand]. - ^forEachHand at: hand ifAbsent: [nil]! Item was removed: - ----- Method: SketchEditorMorph>>verifyState: (in category 'start & finish') ----- - verifyState: evt - | myAction | - "We are sure we will make a mark now. Make sure the palette has not changed state while we were away. If so, end this action and start another one. 6/11/97 19:52 tk action, currentColor, brush" - - "Install the brush, color, (replace mode), and cursor." - palette isInWorld ifFalse: - [self world addMorphFront: palette]. "It happens. might want to position it also" - myAction := self getActionFor: evt. - (self get: #changed for: evt) == false ifFalse: [ - self set: #changed for: evt to: false. - self invalidRect: rotationButton bounds. "snap these back" - rotationButton position: bounds topCenter - (6 at 0). "later adjust by button width?" - self invalidRect: rotationButton bounds. - self invalidRect: scaleButton bounds. - scaleButton position: bounds rightCenter - ((scaleButton width)@6). - self invalidRect: scaleButton bounds. - myAction == #polygon: ifFalse: [self polyFreeze]. "end polygon mode" - ^ self set: #action for: evt to: (self prepareToPaint: evt)]. - - ! Item was removed: - ----- Method: SketchEditorMorph>>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. - hostView := deepCopier references at: hostView ifAbsent: [hostView]. - enclosingPasteUpMorph := deepCopier references at: enclosingPasteUpMorph - ifAbsent: [enclosingPasteUpMorph].! Item was removed: - ----- Method: SketchEditorMorph>>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. - "hostView := hostView. Weakly copied" - "stampForm := stampForm veryDeepCopyWith: deepCopier." - "canvasRectangle := canvasRectangle veryDeepCopyWith: deepCopier." - palette := palette veryDeepCopyWith: deepCopier. - "currentColor := currentColor veryDeepCopyWith: deepCopier." - ticksToDwell := ticksToDwell veryDeepCopyWith: deepCopier. - rotationCenter := rotationCenter veryDeepCopyWith: deepCopier. - registrationPoint := registrationPoint veryDeepCopyWith: deepCopier. - newPicBlock := newPicBlock veryDeepCopyWith: deepCopier. - emptyPicBlock := emptyPicBlock veryDeepCopyWith: deepCopier. - "action := action veryDeepCopyWith: deepCopier." - paintingForm := paintingForm veryDeepCopyWith: deepCopier. - dimForm := dimForm veryDeepCopyWith: deepCopier. - "buff := buff veryDeepCopyWith: deepCopier." - "brush := brush veryDeepCopyWith: deepCopier." - "paintingFormPen := paintingFormPen veryDeepCopyWith: deepCopier." - formCanvas := formCanvas veryDeepCopyWith: deepCopier. - "picToBuff := picToBuff veryDeepCopyWith: deepCopier." - "brushToBuff := brushToBuff veryDeepCopyWith: deepCopier." - "buffToBuff := buffToBuff veryDeepCopyWith: deepCopier." - "buffToPic := buffToPic veryDeepCopyWith: deepCopier." - rotationButton := rotationButton veryDeepCopyWith: deepCopier. - scaleButton := scaleButton veryDeepCopyWith: deepCopier. - "strokeOrigin := strokeOrigin veryDeepCopyWith: deepCopier." - cumRot := cumRot veryDeepCopyWith: deepCopier. - cumMag := cumMag veryDeepCopyWith: deepCopier. - undoBuffer := undoBuffer veryDeepCopyWith: deepCopier. - "lastEvent := lastEvent veryDeepCopyWith: deepCopier." - "currentNib := currentNib veryDeepCopyWith: deepCopier." - enclosingPasteUpMorph := enclosingPasteUpMorph. "weakly copied" - forEachHand := nil. "hmm..." ! Item was removed: - ----- Method: SketchEditorMorph>>wantsHaloFromClick (in category 'e-toy support') ----- - wantsHaloFromClick - - ^ Preferences eToyFriendly not. - ! Item was removed: - ----- Method: SketchMorph class>>exampleMouseUpAction (in category '*MorphicExtras-examples') ----- - exampleMouseUpAction - "SketchMorph exampleMouseUpAction openInWorld" - - ^ (self withForm: Form squeakLogo) - addMouseUpActionWith: 'self inform: ''Carpe Squeak!!'''; - yourself! Item was removed: - ----- Method: SketchMorph class>>extraExampleCook (in category '*MorphicExtras-examples') ----- - extraExampleCook - "SketchMorph extraExampleCook openInWorld" - - ^ (self withForm: Form extraCook) - addMouseUpActionWith: 'Display restoreAfter: [Form toothpaste: 30]'; - balloonText: 'Click me and then drag the cursor over the screen'; - yourself! Item was removed: - ----- Method: SketchMorph class>>extraExampleWizard (in category '*MorphicExtras-examples') ----- - extraExampleWizard - "SketchMorph extraExampleWizard openInWorld" - - ^ (self withForm: Form extraWizard) - addMouseUpActionWith: - (MessageSend receiver: Display selector: #restoreAfter: argument: [Pen new web]); - balloonText: 'Click me and then drag the cursor over the screen\(Trust me, I won''t turn you into a toad!!)' withCRs; - yourself! Item was removed: - ----- Method: SketchMorph>>canDrawAtHigherResolution (in category '*MorphicExtras-testing') ----- - canDrawAtHigherResolution - - | pt | - pt := self scalePoint. - ^pt x < 1.0 or: [pt y < 1.0]! Item was removed: - BorderedMorph subclass: #SorterTokenMorph - instanceVariableNames: 'morphRepresented' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Palettes'! Item was removed: - ----- Method: SorterTokenMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color blue! Item was removed: - ----- Method: SorterTokenMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: SorterTokenMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color transparent! Item was removed: - ----- Method: SorterTokenMorph>>fitContents (in category 'layout') ----- - fitContents - submorphs size = 1 ifTrue: [self bounds: (submorphs first bounds insetBy: (-1 @ -1))]! Item was removed: - ----- Method: SorterTokenMorph>>forMorph: (in category 'initialization') ----- - forMorph: aMorph - | it | - morphRepresented := aMorph. - aMorph submorphs notEmpty - ifTrue: - [self addMorphBack: (it := aMorph submorphs first veryDeepCopy). - it position: self position + (1 @ 1). - it lock]. - self fitContents! Item was removed: - ----- Method: SorterTokenMorph>>morphRepresented (in category 'thumbnail') ----- - morphRepresented - ^ morphRepresented! Item was removed: - AbstractMediaEventMorph subclass: #SoundEventMorph - instanceVariableNames: 'sound' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: SoundEventMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'piano rolls') ----- - addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime - - | startX lengthInTicks endX | - - startTimeInScore > rightTime ifTrue: [^ self]. - lengthInTicks := pianoRoll scorePlayer ticksForMSecs: sound duration * 1000.0. - startTimeInScore + lengthInTicks < leftTime ifTrue: [^ self]. - startX := pianoRoll xForTime: startTimeInScore. - endX := pianoRoll xForTime: startTimeInScore + lengthInTicks. - morphList add: - (self left: startX; width: endX - startX). - - ! Item was removed: - ----- Method: SoundEventMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGreen! Item was removed: - ----- Method: SoundEventMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - - "hack... since we are called from within the SoundPlayer loop, the Semaphore will - block attempts to play directly from here" - WorldState addDeferredUIMessage: [sound play].! Item was removed: - ----- Method: SoundEventMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self height: 10! Item was removed: - ----- Method: SoundEventMorph>>justDroppedIntoPianoRoll:event: (in category 'piano rolls') ----- - justDroppedIntoPianoRoll: newOwner event: evt - - | startX lengthInTicks endX | - - super justDroppedIntoPianoRoll: newOwner event: evt. - - startTimeInScore := newOwner timeForX: self left. - lengthInTicks := newOwner scorePlayer ticksForMSecs: sound duration * 1000.0. - endTimeInScore := startTimeInScore + lengthInTicks. - - endTimeInScore > newOwner scorePlayer durationInTicks ifTrue: - [newOwner scorePlayer updateDuration]. - - startX := newOwner xForTime: startTimeInScore. - endX := newOwner xForTime: endTimeInScore. - self width: endX - startX. - - ! Item was removed: - ----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') ----- - releaseCachedState - - super releaseCachedState. - sound isCompressed - ifFalse: [sound := sound compressWith: GSMCodec]. - ! Item was removed: - ----- Method: SoundEventMorph>>sound: (in category 'accessing') ----- - sound: aSound - - sound := aSound. - self setBalloonText: 'a sound of duration ',(sound duration printShowingMaxDecimalPlaces: 1),' seconds'.! Item was removed: - RectangleMorph subclass: #SoundLoopMorph - instanceVariableNames: 'samplesUntilNextControl seqSound cursor controlIndex' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: SoundLoopMorph>>addCursorMorph (in category 'initialization') ----- - addCursorMorph - self addMorph: - (cursor := (RectangleMorph - newBounds: (self innerBounds topLeft extent: 1 at self innerBounds height) - color: Color red) - borderWidth: 0)! Item was removed: - ----- Method: SoundLoopMorph>>allowSubmorphExtraction (in category 'dropping/grabbing') ----- - allowSubmorphExtraction - - ^ true! Item was removed: - ----- Method: SoundLoopMorph>>buildSound (in category 'playing') ----- - buildSound - "Build a compound sound for the next iteration of the loop." - - | mixer soundMorphs | - mixer := MixedSound new. - mixer add: (RestSound dur: (self width - (2 * self borderWidth)) / 128.0). - soundMorphs := self submorphs select: [:m | m respondsTo: #sound]. - soundMorphs do: [:m | - | startTime pan | - startTime := (m position x - (self left + self borderWidth)) / 128.0. - pan := (m position y - (self top + self borderWidth)) asFloat / (self height - (2 * self borderWidth) - m height). - mixer add: ((RestSound dur: startTime), m sound copy) pan: pan]. - ^ mixer - ! Item was removed: - ----- Method: SoundLoopMorph>>controlRate (in category 'playing') ----- - controlRate - "Answer the number of control changes per second." - - ^ 32 - ! Item was removed: - ----- Method: SoundLoopMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: SoundLoopMorph>>defaultBounds (in category 'initialization') ----- - defaultBounds - "answer the default bounds for the receiver" - ^ 0 @ 0 corner: 128 @ 128 + (self defaultBorderWidth * 2)! Item was removed: - ----- Method: SoundLoopMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightBlue! Item was removed: - ----- Method: SoundLoopMorph>>doControl (in category 'playing') ----- - doControl - - seqSound doControl. - controlIndex := controlIndex + 1. - controlIndex >= (self controlRate * (self innerBounds width // 128)) - ifTrue: [controlIndex := 0]. - ! Item was removed: - ----- Method: SoundLoopMorph>>extent: (in category 'geometry') ----- - extent: newExtent - super extent: (newExtent truncateTo: 128 at 128) + (self borderWidth*2)! Item was removed: - ----- Method: SoundLoopMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - controlIndex := 0. - self addCursorMorph! Item was removed: - ----- Method: SoundLoopMorph>>mixSampleCount:into:startingAt:leftVol:rightVol: (in category 'playing') ----- - mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol - "Repeatedly play my sounds." - - | i count samplesNeeded | - i := startIndex. - samplesNeeded := n. - [samplesNeeded > 0] whileTrue: [ - count := seqSound samplesRemaining min: samplesNeeded. - count = 0 ifTrue: [ - self reset. - count := seqSound samplesRemaining min: samplesNeeded. - count = 0 ifTrue: [^ self]]. "zero length sound" - seqSound mixSampleCount: count into: aSoundBuffer startingAt: i leftVol: leftVol rightVol: rightVol. - i := i + count. - samplesNeeded := samplesNeeded - count]. - ! Item was removed: - ----- Method: SoundLoopMorph>>play (in category 'playing') ----- - play - "Play this sound to the sound ouput port in real time." - - self reset. - SoundPlayer playSound: self. - ! Item was removed: - ----- Method: SoundLoopMorph>>playSampleCount:into:startingAt: (in category 'playing') ----- - playSampleCount: n into: aSoundBuffer startingAt: startIndex - "Mixes the next count samples of this sound into the given buffer starting at the given index, updating the receiver's control parameters at periodic intervals." - - | fullVol samplesBetweenControlUpdates pastEnd i remainingSamples count | - fullVol := AbstractSound scaleFactor. - samplesBetweenControlUpdates := self samplingRate // self controlRate. - pastEnd := startIndex + n. "index just index of after last sample" - i := startIndex. - [i < pastEnd] whileTrue: [ - remainingSamples := self samplesRemaining. - remainingSamples <= 0 ifTrue: [^ self]. - count := pastEnd - i. - samplesUntilNextControl < count ifTrue: [count := samplesUntilNextControl]. - remainingSamples < count ifTrue: [count := remainingSamples]. - self mixSampleCount: count into: aSoundBuffer startingAt: i leftVol: fullVol rightVol: fullVol. - samplesUntilNextControl := samplesUntilNextControl - count. - samplesUntilNextControl <= 0 ifTrue: [ - self doControl. - samplesUntilNextControl := samplesBetweenControlUpdates]. - i := i + count]. - ! Item was removed: - ----- Method: SoundLoopMorph>>positionCursor (in category 'playing') ----- - positionCursor - | x | - x := controlIndex * 128 // self controlRate. - cursor position: self innerBounds topLeft + (x at 0) - ! Item was removed: - ----- Method: SoundLoopMorph>>reset (in category 'playing') ----- - reset - "Reset my internal state for a replay." - - seqSound := self buildSound reset. - samplesUntilNextControl := (self samplingRate // self controlRate). - controlIndex := 0. - self positionCursor! Item was removed: - ----- Method: SoundLoopMorph>>samplesRemaining (in category 'playing') ----- - samplesRemaining - - ^ 1000000 - ! Item was removed: - ----- Method: SoundLoopMorph>>samplingRate (in category 'playing') ----- - samplingRate - "Answer the sampling rate in samples per second." - - ^ SoundPlayer samplingRate! Item was removed: - ----- Method: SoundLoopMorph>>step (in category 'stepping and presenter') ----- - step - self positionCursor! Item was removed: - ----- Method: SoundLoopMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^ 50 - ! Item was removed: - ----- Method: SoundLoopMorph>>stop (in category 'stepping and presenter') ----- - stop - "Stop playing this sound." - - SoundPlayer pauseSound: self. - ! Item was removed: - ----- Method: SoundLoopMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - - ^ aMorph respondsTo: #sound - ! Item was removed: - Morph subclass: #SpeakerMorph - instanceVariableNames: 'bufferSize buffer lastConePosition sound' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! Item was removed: - ----- Method: SpeakerMorph>>addGraphic (in category 'initialization') ----- - addGraphic - - | graphic | - graphic := self world drawingClass withForm: self speakerGraphic. - graphic position: bounds center - (graphic extent // 2). - self addMorph: graphic. - ! Item was removed: - ----- Method: SpeakerMorph>>appendSample: (in category 'speaker') ----- - appendSample: aFloat - "Append the given sample, a number between -100.0 and 100.0, to my buffer. Flush the buffer if it is full." - - lastConePosition := aFloat. - lastConePosition := lastConePosition min: 100.0. - lastConePosition := lastConePosition max: -100.0. - buffer nextPut: (327.67 * lastConePosition) truncated. - buffer position >= bufferSize ifTrue: [self flushBuffer] - ! Item was removed: - ----- Method: SpeakerMorph>>conePosition (in category 'speaker') ----- - conePosition - - ^ lastConePosition - ! Item was removed: - ----- Method: SpeakerMorph>>conePosition: (in category 'speaker') ----- - conePosition: aNumber - - self appendSample: aNumber asFloat. "sets lastConePosition" - ! Item was removed: - ----- Method: SpeakerMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 1.0 - g: 0.484 - b: 0.258! Item was removed: - ----- Method: SpeakerMorph>>flushBuffer (in category 'speaker') ----- - flushBuffer - - | buf | - buf := buffer contents. - buffer resetContents. - sound isPlaying ifFalse: [sound := SequentialSound new]. - sound add: (SampledSound samples: buf samplingRate: 11025). - sound isPlaying - ifTrue: [sound pruneFinishedSounds] - ifFalse: [sound play]. - ! Item was removed: - ----- Method: SpeakerMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self addGraphic. - bufferSize := 5000. - buffer := WriteStream - on: (SoundBuffer newMonoSampleCount: bufferSize). - lastConePosition := 0. - sound := SequentialSound new! Item was removed: - ----- Method: SpeakerMorph>>speakerGraphic (in category 'initialization') ----- - speakerGraphic - - ^ Form - extent: 19 at 18 - depth: 8 - fromArray: #(0 0 1493172224 2816 0 0 0 1493172224 11 0 0 138 1493172224 184549376 184549376 0 35509 2315255808 720896 720896 0 9090522 2315255808 2816 720896 0 2327173887 2315255819 2816 720896 138 3051028442 2315255819 2816 2816 1505080590 4294957786 2315255808 184549387 2816 3053453311 4292532917 1493172224 184549387 2816 1505080714 3048584629 1493172224 184549387 2816 9079434 3048584629 1493172224 184549387 2816 138 2327164341 1493172235 2816 2816 0 2324346293 1493172235 2816 720896 0 9079477 1493172224 2816 720896 0 35466 1493172224 720896 720896 0 138 0 184549376 184549376 0 0 0 11 0 0 0 0 2816 0) - offset: 0 at 0 - ! Item was removed: - ----- Method: SpeakerMorph>>stopSound (in category 'speaker') ----- - stopSound - - sound pause. - buffer resetContents. - ! Item was removed: - Object subclass: #SqueakPage - instanceVariableNames: 'url title comment thumbnail contentsMorph creationTime creationAuthor lastChangeTime lastChangeAuthor policy dirty' - classVariableNames: 'MaxThumbnailWidthOrHeight RecentMaxNum RecentStem' - poolDictionaries: '' - category: 'MorphicExtras-SqueakPage'! - - !SqueakPage commentStamp: '<historical>' prior: 0! - A SqueakPage is holder for a page of morphs that live on the disk or on a server. - A URLMorph is a thumbnail sized stand-in for the page. Clicking on it gets the page. - An ObjectOut is a fake object that stands for an object that is out on the disk. (Like ObjectTracer or ObjectViewer.) - A MorphObjectOut is a subclass that stands for a Morph that is out on the disk. - - To find out how to make the pages of any BookMorph go out to the disk (or a server), see http://minnow.cc.gatech.edu/SqueakDoc.1 then go to 'SqueakPages'. - - A SqueakPage is always in-memory. Its contentsMorph will be 'become-ed' to a MorphObjectOut tombstone when it goes out. (A page may or may not be in the cache. First put it in, then ask it for the data.) Sending any message to the contentsMorph triggers the fetch. Many URLMorphs may hold onto one page. A page has a thumbnail. A URLMorph points at its page object. - - States of a SqueakPage, and the transitions to another state: - 1) have a url as a string. Then: (URLMorph grabURL: 'file://Ted''s/books/tryThis/p1'). - Drop it into any morph. - 2) have a URLMorph, with page==nil. Click it. (makes an empty page, installs - it in the global page cache) - 3) have a URLMorph with a SqueakPage, with contentsMorph==nil, - but page is not in the cache (this is a rare case). ask page contentsMorph. - 4) OUT: have a URLMorph with a SqueakPage, with contentsMorph being a MorphObjectOut, - and its page is in the cache. Sending the contentsMorph any message brings it in and - becomes it to the morph. (fix up morph's pointer to the page.) - 5) Totally IN: a morph, owned by a SqueakPage, has a page in the cache. - The morph is clean. - Whenever someone triggers a purge (when?), contentsMorph is becomed - to a MorphObjectOut. (go to 4) - Causing the morph to execute layoutChanged marks the morph as dirty. - (morph's property #pageDirty is set to true) (go to 6) - 6) Totally IN and dirty. - Whenever any other page is fetched from the disk or the net, all other - dirty pages are written and marked clean. (go to 5) - - Note that the entire tree of submorphs goes out -- hundreds of objects. Bringing the object back in brings in the SqueakPage, installs it in the cache. Classes other than PasteUpMorph can easily be made to send their contents out if there is any need. - - Note that every book is now automatically a WebBook. We simply give a page a url and tell it to purge. - - url a string - title - comment - thumbnail - contentsMorph (1) a pasteUpMorph with other morphs in it. - (2) a MorphObjectOut. Sending any message brings it in. - (3) nil if the page has never been in this image. - creationTime - creationAuthor - lastChangeTime - lastChangeAuthor - policy #alwaysWrite, #neverWrite, #ask. (cache can override with a global policy) - (Explicit writing by user has policy #neverWrite) - dirty (Morph>>layoutChanged sends changed: #SqueakPage. If policy==#check, - then the page sets dirty_true.) - (If policy==#alwaysWrite, then set dirty when the page is retrieved from the cache.) - - Class MorphObjectOut has an instance variable called page. - All messages to an MorphObjectOut cause it to be brought in. Except the messages needed to write the MorphObjectOut on the disk as part of a parent's being sent out. (size, class, instSize, instVar:at:. Can rename these and call from its own version of the writing routine.) - To purge, go through the clean pages, and any that have world not equal to this world, entomb them. - (If an object in the subtree is held by an object outside the tree, it will remain, And will be duplicated when the tree comes back in. This is a problem already in normal uses of SmartRefStream.) - - - ! Item was removed: - ----- Method: SqueakPage class>>initialize (in category 'class initialization') ----- - initialize - "SqueakPage initialize" - - MaxThumbnailWidthOrHeight := 60. - ! Item was removed: - ----- Method: SqueakPage class>>newURLAndPageFor: (in category 'instance creation') ----- - newURLAndPageFor: aMorph - "Create a new SqueakPage whose contents is the given morph. Assign a URL for that page, record it in the page cache, and answer its URL." - - | pg newURL stamp | - pg := self new. - stamp := Utilities authorInitialsPerSe. - stamp isEmptyOrNil ifTrue: [ stamp := '*' ]. - pg saveMorph: aMorph author: stamp. - newURL := SqueakPageCache generateURL. - SqueakPageCache atURL: newURL put: pg. - ^ newURL! Item was removed: - ----- Method: SqueakPage class>>stemUrl: (in category 'utilties') ----- - stemUrl: aUrlString - "Peel off the 'x5.sp' or '.bo' from the end of a url of a SqueakPage or a BookMorph index file" - - | ll aUrl | - ll := aUrlString findLast: [:char | char == $.]. - ll = 0 - ifTrue: [aUrl := aUrlString] - ifFalse: [aUrl := aUrlString copyFrom: 1 to: ll-1]. "remove .sp" - aUrl := (aUrl stemAndNumericSuffix) at: 1. - "remove trailing number" - aUrl size = 0 ifTrue: [^ aUrl]. "empty" - [aUrl last == $x] whileTrue: [aUrl := aUrl allButLast]. - ^ aUrl! Item was removed: - ----- Method: SqueakPage>>asMorph (in category 'accessing') ----- - asMorph - ^ self fetchContents! Item was removed: - ----- Method: SqueakPage>>comment (in category 'accessing') ----- - comment - - comment ifNil: [^ ''] ifNotNil: [^ comment]. - ! Item was removed: - ----- Method: SqueakPage>>comment: (in category 'accessing') ----- - comment: aString - - aString isEmpty - ifTrue: [comment := nil] - ifFalse: [comment := aString]. - ! Item was removed: - ----- Method: SqueakPage>>computeThumbnail (in category 'private') ----- - computeThumbnail - "Make a thumbnail from my morph." - - (contentsMorph isKindOf: PasteUpMorph) - ifTrue: [thumbnail := contentsMorph smallThumbnailForPageSorter] - ifFalse: [self updateThumbnail]! Item was removed: - ----- Method: SqueakPage>>contentsMorph (in category 'accessing') ----- - contentsMorph - "Return what it is now. If the morph is out on the disk, return nil. Use fetchContents to get the data for sure." - - ^ contentsMorph - ! Item was removed: - ----- Method: SqueakPage>>contentsMorph: (in category 'accessing') ----- - contentsMorph: aPasteUpMorph - - contentsMorph := aPasteUpMorph! Item was removed: - ----- Method: SqueakPage>>copyForSaving (in category 'accessing') ----- - copyForSaving - "Make a copy and configure me to be put out on the disk. When it is brought in and touched, it will turn into the object at the url." - - | forDisk holder | - forDisk := self shallowCopy. - holder := MorphObjectOut new xxxSetUrl: url page: forDisk. - forDisk contentsMorph: holder. - ^ holder "directly representing the object"! Item was removed: - ----- Method: SqueakPage>>dirty: (in category 'saving') ----- - dirty: aBool - dirty := aBool! Item was removed: - ----- Method: SqueakPage>>fetchContents (in category 'accessing') ----- - fetchContents - "Make every effort to get contentsMorph." - - self isContentsInMemory ifTrue: [^ contentsMorph]. - ^ self fetchInformIfError! Item was removed: - ----- Method: SqueakPage>>fetchContentsIfAbsent: (in category 'accessing') ----- - fetchContentsIfAbsent: failBlock - "Make every effort to get contentsMorph. Assume I am in the cache already." - | strm page temp temp2 | - SqueakPageCache write. "sorry about the pause" - strm := Cursor wait showWhile: [ - (ServerFile new fullPath: url) asStream]. - strm isString ifTrue: [^ failBlock value]. - page := strm fileInObjectAndCode. - page isMorph ifTrue: [contentsMorph := page]. "may be a bare morph" - "copy over the state" - temp := url. - temp2 := policy. - self copyAddedStateFrom: page. - url := temp. "don't care what it says" - temp2 ifNotNil: [policy := temp2]. "use mine" - contentsMorph setProperty: #pageDirty toValue: nil. - self dirty: false. - ^ contentsMorph! Item was removed: - ----- Method: SqueakPage>>fetchInformIfError (in category 'accessing') ----- - fetchInformIfError - "Make every effort to get contentsMorph. Put up a good notice if can't get it. Assume page is in the cache already. Overwrite the contentsMorph no matter what." - | strm page temp temp2 | - - SqueakPageCache write. "sorry about the pause" - strm := Cursor wait showWhile: [ - (ServerFile new fullPath: url) asStream]. - strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil]. "<<<<< Note Diff" - (url beginsWith: 'file:') ifTrue: [Transcript show: 'Fetching ', url; cr]. - page := strm fileInObjectAndCode. - page isMorph - ifTrue: [contentsMorph := page] "may be a bare morph" - ifFalse: ["copy over the state" - temp := url. - temp2 := policy. - self copyFrom: page. "including contentsMorph" - url := temp. "I know best!!" - temp2 ifNotNil: [policy := temp2]]. "use mine" - contentsMorph setProperty: #pageDirty toValue: nil. - contentsMorph setProperty: #SqueakPage toValue: self. - self dirty: false. - ^ contentsMorph! Item was removed: - ----- Method: SqueakPage>>isContentsInMemory (in category 'accessing') ----- - isContentsInMemory - "Is my contentsMorph in memory, or is it an ObjectOut tombstone? Be careful not to send it any message." - - ^ (contentsMorph xxxClass inheritsFrom: Object) and: [(contentsMorph == nil) not]! Item was removed: - ----- Method: SqueakPage>>lastChangeTime (in category 'accessing') ----- - lastChangeTime - ^ lastChangeTime! Item was removed: - ----- Method: SqueakPage>>policy (in category 'saving') ----- - policy - ^ policy! Item was removed: - ----- Method: SqueakPage>>policy: (in category 'saving') ----- - policy: aSymbol - policy := aSymbol! Item was removed: - ----- Method: SqueakPage>>postChangeNotification (in category 'private') ----- - postChangeNotification - "Inform all thumbnails and books that this page has been updated." - - URLMorph allSubInstancesDo: [:m | m pageHasChanged: self]. - ! Item was removed: - ----- Method: SqueakPage>>prePurge (in category 'saving') ----- - prePurge - "Return self if ready to be purged, or nil if not" - - self isContentsInMemory ifFalse: [^ nil]. - contentsMorph ifNil: [^ nil]. "out already" - url ifNil: [^ nil]. "just to be safe" - ^ (Project current world ~~ nil and: [contentsMorph world == Project current world]) - ifTrue: [nil "showing now"] ifFalse: [self]! Item was removed: - ----- Method: SqueakPage>>purge (in category 'saving') ----- - purge - "Replace my morph with a tombstone, if I am not in a world that is being shown." - - (self prePurge) ifNotNil: [ - contentsMorph becomeForward: (MorphObjectOut new xxxSetUrl: url page: self)]. - "Simple, isn't it!!"! Item was removed: - ----- Method: SqueakPage>>saveMorph:author: (in category 'accessing') ----- - saveMorph: aMorph author: authorString - "Save the given morph as this page's contents. Update its thumbnail and inform references to this URL that the page has changed." - "Details: updateThumbnail releases the cached state of the saved page contents after computing the thumbnail." - - | n | - contentsMorph := aMorph. - n := aMorph knownName. - n ifNotNil: [self title: n]. - creationAuthor ifNil: [ - creationAuthor := authorString. - creationTime := Time totalSeconds]. - " lastChangeAuthor := authorString. - lastChangeTime := Time totalSeconds. do it when actually write" - self computeThumbnail. - self postChangeNotification. - ! Item was removed: - ----- Method: SqueakPage>>thumbnail (in category 'accessing') ----- - thumbnail - - ^ thumbnail - ! Item was removed: - ----- Method: SqueakPage>>title (in category 'accessing') ----- - title - - title ifNil: [^ ''] ifNotNil: [^ title]. - ! Item was removed: - ----- Method: SqueakPage>>title: (in category 'accessing') ----- - title: aString - - aString isEmpty - ifTrue: [title := nil] - ifFalse: [title := aString]. - ! Item was removed: - ----- Method: SqueakPage>>updateThumbnail (in category 'private') ----- - updateThumbnail - "Update my thumbnail from my morph." - - | f scale scaleX scaleY shrunkF | - contentsMorph ifNil: [thumbnail := nil. ^ self]. - f := contentsMorph imageForm. - scaleX := MaxThumbnailWidthOrHeight asFloat / f height. - scaleY := MaxThumbnailWidthOrHeight asFloat/ f width. - scale := scaleX min: scaleY. "choose scale that maintains aspect ratio" - shrunkF := (f magnify: f boundingBox by: scale at scale smoothing: 2). - thumbnail := Form extent: shrunkF extent depth: 8. "force depth to be 8" - shrunkF displayOn: thumbnail. - contentsMorph allMorphsDo: [:m | m releaseCachedState]. - ! Item was removed: - ----- Method: SqueakPage>>url (in category 'accessing') ----- - url - - ^ url! Item was removed: - ----- Method: SqueakPage>>url: (in category 'accessing') ----- - url: aString - - | sd | - aString isEmpty ifTrue: [url := nil. ^ self]. - - "Expand ./ and store as an absolute url" - sd := ServerFile new. - sd fullPath: aString. - url := sd realUrl.! Item was removed: - ----- Method: SqueakPage>>urlNoOverwrite: (in category 'saving') ----- - urlNoOverwrite: suggested - "Look in the directory. If there is a file of this name, create a new name. Keep track of highest numbers used as a hint." - - | dir ll stem num local trial suffix | - (suggested endsWith: '.sp') ifTrue: [suffix := '.sp']. - (suggested endsWith: '.bo') ifTrue: [suffix := '.bo']. - suffix ifNil: [self error: 'unknown suffix']. - dir := ServerFile new fullPath: suggested. - (dir includesKey: dir fileName) ifFalse: [^ url := suggested]. - "File already exists!! Create a new name" - "Find the stem file name" - stem := SqueakPage stemUrl: suggested. - num := stem = RecentStem ifTrue: [RecentMaxNum+1] ifFalse: [1]. - - local := dir fileName. "ugh, take stem again..." - ll := local findLast: [:char | char == $.]. - ll = 0 ifFalse: [local := local copyFrom: 1 to: ll-1]. "remove .sp" - local := (local splitInteger) at: 1. "remove trailing number" - local last == $x ifFalse: [local := local , 'x']. - [trial := local, num printString, suffix. - dir includesKey: trial] whileTrue: [num := num + 1]. - RecentStem := stem. RecentMaxNum := num. - ^ url := stem, 'x', num printString, suffix! Item was removed: - ----- Method: SqueakPage>>write (in category 'saving') ----- - write - "Decide whether to write this page on the disk." - | sf | - policy == #neverWrite ifTrue: [^ self]. - "demo mode, or write only when user explicitly orders it" - - "All other policies do write: #now" - contentsMorph ifNil: [^ self]. - dirty := dirty | ((contentsMorph valueOfProperty: #pageDirty) == true). - "set by layoutChanged" - dirty == true ifTrue: [ - sf := ServerDirectory new fullPath: url. - "check for shared password" - "contentsMorph allMorphsDo: [:m | m prepareToBeSaved]. - done in objectToStoreOnDataStream" - lastChangeAuthor := Utilities authorInitialsPerSe. - lastChangeAuthor isEmptyOrNil ifTrue: [ lastChangeAuthor := '*']. - lastChangeTime := Time totalSeconds. - Cursor wait showWhile: [ | remoteFile | - remoteFile := sf fileNamed: url. "no notification when overwriting" - remoteFile dataIsValid. - remoteFile fileOutClass: nil andObject: self. - "remoteFile close"]. - contentsMorph setProperty: #pageDirty toValue: nil. - dirty := false].! Item was removed: - Object subclass: #SqueakPageCache - instanceVariableNames: '' - classVariableNames: 'GlobalPolicy PageCache' - poolDictionaries: '' - category: 'MorphicExtras-SqueakPage'! - - !SqueakPageCache commentStamp: '<historical>' prior: 0! - A global cache of web pages known to this Squeak image. Since there is a single, global page cache, it is implemented entirely as class methods. - - Once a page has an entry, keep it. (url string -> A SqueakPage) The SqueakPage has a thumbnail and other info, but may not have the contentsMorph. The morph is purged when space is needed, and fetched from the server as needed. - - See SqueakPage's comment for the stages of in/out.! Item was removed: - ----- Method: SqueakPageCache class>>allURLs (in category 'cache access') ----- - allURLs - "Answer a collection of URLs for all pages in the cache." - - ^ PageCache keys - - ! Item was removed: - ----- Method: SqueakPageCache class>>atURL: (in category 'cache access') ----- - atURL: aURLString - "Answer the page corresponding to this URL. Evaluate the given block if there is no entry for the given URL." - - - ^ PageCache at: aURLString ifAbsent: [ | pg | - pg := SqueakPage new. - "stamp := Utilities authorInitialsPerSe ifNil: ['*']." - "pg author: stamp." - "Need to deal with inst vars if we turn out to be new!!" - "pg url: aURLString. done by atURL:put:" - self atURL: aURLString put: pg. - pg] - ! Item was removed: - ----- Method: SqueakPageCache class>>atURL:ifAbsent: (in category 'cache access') ----- - atURL: aURLString ifAbsent: failBlock - "Answer the page corresponding to this URL. Evaluate the given block if there is no entry for the given URL." - - self halt. "use atURL:" - ! Item was removed: - ----- Method: SqueakPageCache class>>atURL:oldPage: (in category 'cache access') ----- - atURL: aURLString oldPage: aPage - "Bring in page and return the object. First try looking up my url in the pageCache. Then try the page (and install it, under its url). Then start from scratch with the url." - - | myPage | - (myPage := PageCache at: aURLString ifAbsent: [nil]) ifNotNil: [ - ^ myPage]. - aPage url: aURLString. "for consistancy" - PageCache at: aPage url put: aPage. - ^ aPage! Item was removed: - ----- Method: SqueakPageCache class>>atURL:put: (in category 'cache access') ----- - atURL: aURLString put: aSqueakPage - "Store the given page in the cache entry for the given URL." - - aSqueakPage url: aURLString. - aSqueakPage contentsMorph isInMemory ifTrue: [ - aSqueakPage contentsMorph ifNotNil: [ - aSqueakPage contentsMorph setProperty: #SqueakPage - toValue: aSqueakPage]]. - PageCache at: aURLString put: aSqueakPage. - ! Item was removed: - ----- Method: SqueakPageCache class>>deleteUnreferencedPages (in category 'housekeeping') ----- - deleteUnreferencedPages - "Remove any pages that are not current referred to by any book or URL morph." - "Details: Since unreferenced pages could refer to other pages, this process is iterated until no unreferenced pages can be found. It currently does not collect cycles." - "SqueakPageCache deleteUnreferencedPages" - - | unreferenced | - [ - Smalltalk garbageCollect. - unreferenced := PageCache keys asSet. - URLMorph allSubInstancesDo: [:m | unreferenced remove: m url ifAbsent: []]. - MorphObjectOut allInstancesDo: [:ticklish | - unreferenced remove: ticklish url ifAbsent: []]. - unreferenced size = 0 ifTrue: [^ self]. - unreferenced do: [:url | PageCache removeKey: url ifAbsent: []]] repeat - ! Item was removed: - ----- Method: SqueakPageCache class>>doPagesInMemory: (in category 'cache access') ----- - doPagesInMemory: aBlock - "Evaluate aBlock for each page whose contentsMorph is in-memory. Don't add or remove pages while in this loop." - - PageCache do: [:sqkPage | - sqkPage isContentsInMemory ifTrue: [aBlock value: sqkPage]].! Item was removed: - ----- Method: SqueakPageCache class>>generateURL (in category 'cache access') ----- - generateURL - "Generate an unused URL for an in-memory page." - "SqueakPageCache generateURL" - - | sd | - sd := ServerFile new on: 'file:./'. - sd fileName: 'page1.sp'. - ^ SqueakPage new urlNoOverwrite: sd pathForFile - ! Item was removed: - ----- Method: SqueakPageCache class>>includesMorph: (in category 'cache access') ----- - includesMorph: aPasteUp - - PageCache do: [:squeakPage | - squeakPage contentsMorph == aPasteUp ifTrue: [^ true]]. - ^ false! Item was removed: - ----- Method: SqueakPageCache class>>initialize (in category 'class initialization') ----- - initialize - "SqueakPageCache initialize" - - GlobalPolicy := #neverWrite. - PageCache := Dictionary new: 100. - "forgets urls of pages, but ObjectOuts still remember them" - ! Item was removed: - ----- Method: SqueakPageCache class>>pageCache (in category 'cache access') ----- - pageCache - - ^ PageCache! Item was removed: - ----- Method: SqueakPageCache class>>pageForMorph: (in category 'cache access') ----- - pageForMorph: aPasteUp - - PageCache do: [:squeakPage | - squeakPage contentsMorph == aPasteUp ifTrue: [^ squeakPage]]. - ^ nil! Item was removed: - ----- Method: SqueakPageCache class>>purge (in category 'cache access') ----- - purge - "Replace morphs with tombstones in all pages that are clean and not being shown. Write any dirty ones first, if allowed to." - - | list | - list := OrderedCollection new. - GlobalPolicy == #neverWrite - ifTrue: [PageCache doPagesInMemory: [:aPage | list add: aPage prePurge]] - "Writing only done by user's command" - ifFalse: [ - PageCache doPagesInMemory: [:aPage | aPage write - list add: aPage prePurge]]. - list := list select: [:each | each notNil]. - "do bulk become:" - (list collect: [:each | each contentsMorph]) - elementsExchangeIdentityWith: - (list collect: [:pg | MorphObjectOut new xxxSetUrl: pg url page: pg]) - ! Item was removed: - ----- Method: SqueakPageCache class>>purge: (in category 'cache access') ----- - purge: megs - "Replace morphs with tombstones in all pages that are clean and not being shown. Do this until megs of new memory have been recovered. Write any dirty ones first, if allowed to." - - | goal | - goal := Smalltalk garbageCollect + (megs * 1000000) asInteger. - PageCache doPagesInMemory: [:aPage | - GlobalPolicy == #neverWrite ifFalse: [aPage write]. - aPage purge. - Smalltalk garbageCollect > goal ifTrue: [^ true]]. "got enough" - ^ false "caller may want to tell the user to write out more pages"! Item was removed: - ----- Method: SqueakPageCache class>>releaseCachedStateOfPages (in category 'housekeeping') ----- - releaseCachedStateOfPages - "Note: This shouldn't be necessary if we are doing a good job of releasing cached state as we go. If running this doesn't do very much, we're doing well!!" - "SqueakPageCache releaseCachedStateOfPages" - - | memBytes | - memBytes := Smalltalk garbageCollect. - PageCache do: [:pg | - pg contentsMorph allMorphsDo: [:m | m releaseCachedState]]. - ^ (Smalltalk garbageCollect - memBytes) printString, ' bytes recovered' - ! Item was removed: - ----- Method: SqueakPageCache class>>removeURL: (in category 'cache access') ----- - removeURL: aURLString - "Remove the cache entry for the given URL. Do nothing if it has no cache entry." - - PageCache removeKey: aURLString ifAbsent: []. - ! Item was removed: - ----- Method: SqueakPageCache class>>write (in category 'cache access') ----- - write - "Write out all dirty pages" - GlobalPolicy == #neverWrite ifTrue: [^ self]. - self doPagesInMemory: [:aPage | aPage write].! Item was removed: - Morph subclass: #SquishedNameMorph - instanceVariableNames: 'target getSelector setSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Navigators'! Item was removed: - ----- Method: SquishedNameMorph>>colorAroundName (in category 'drawing') ----- - colorAroundName - - ^Color gray: 0.8! Item was removed: - ----- Method: SquishedNameMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - | font stringToShow nameForm rectForName | - - super drawOn: aCanvas. - self isEditingName ifTrue: [^self]. - - font := self fontForName. - stringToShow := self stringToShow. - nameForm := (StringMorph contents: stringToShow font: font) imageForm. - nameForm := nameForm scaledToSize: (self extent - (4 at 2) min: nameForm extent). - rectForName := self bottomLeft + - (self width - nameForm width // 2 @ (nameForm height + 2) negated) - extent: nameForm extent. - rectForName topLeft eightNeighbors do: [ :pt | - aCanvas - stencil: nameForm - at: pt - color: self colorAroundName. - ]. - aCanvas - stencil: nameForm - at: rectForName topLeft - color: Color black. - - - - ! Item was removed: - ----- Method: SquishedNameMorph>>fontForName (in category 'drawing') ----- - fontForName - - ^(TextStyle default fontOfSize: 15) emphasized: 1 - ! Item was removed: - ----- Method: SquishedNameMorph>>isEditingName (in category 'drawing') ----- - isEditingName - - ^((self findA: UpdatingStringMorph) ifNil: [^false]) hasFocus - ! Item was removed: - ----- Method: SquishedNameMorph>>stringToShow (in category 'drawing') ----- - stringToShow - - (target isNil or: [getSelector isNil]) ifTrue: [^'????']. - ^target perform: getSelector! Item was removed: - ----- Method: SquishedNameMorph>>target:getSelector:setSelector: (in category 'initialization') ----- - target: aTarget getSelector: symbol1 setSelector: symbol2 - - target := aTarget. - getSelector := symbol1. - setSelector := symbol2.! Item was removed: - ----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop} - forFlapNamed: 'Widgets'.]! Item was removed: - ----- Method: StandardScriptingSystem class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: ScriptingSystem] ! Item was removed: - PolygonMorph subclass: #StarMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !StarMorph commentStamp: 'wiz 9/6/2005 12:30' prior: 0! - I am a very flexible star.. - - Grab me from the supplies flap or from the graphic objects. - Add my handles and you can move and resize me. - The up and down arrows increase or reduce the number of my sides. - The right and left arrows cycle thru different amounts of pointiness. - - - Use the arrows right and left of my center or get stars with a specific amount of pointyness. The left side goes from fat to thin and then cycles around again. The right goes from thin to fat. Hold down the shift key if you wish to stop the cycling at the extremes. - - Use the arrows up and down to change the number of sides if you would like a different number of points. - - To add or remove just one side hold the shift key down as you use the arrows or use the menu items for that purpose. - - - If you add or remove just one point I will have an odd number of sides. When that happens I can only look like a regular polygon. The right and left arrows will have no effect. Add or remove just one more side and you can shift drag the outer handle or use the arrows to restore my pointiness. - - That was too complicated. It is gone. You can get regular polygon shapes by adjusting my pointiness. For example the extreme of a five pointed star is a dodecahedron (10 sided regular polygon) and one step less extreme is a pentagon (5 sided regular polygon). - - - At some time you will probably shift drag the outer handle thru the center handle. - While I looked round as you shrunk me, I will look very much like an asterisk as you pull me away. What happens is that inside bend shrunk on the way down because it can never be larger than the outer point (or it wouldn't be the innerbend would it). - But on the way out it is perfectly happy to remain small. So I look like an asterisk. - - To fatten me up (if you haven't already figured this out by fooling around) hold the shift down an move the outer handle towards the center (but not quite all the way) then let the shift up and move the outer handle away. A couple of cycles like this and I'll be looking fat and jolly again. Or you can now just use the right arrow to make me fatter. - - This is also the reason I don't let the inside bend get larger than the outer point. - If I did the same process that fattened me when I was an asterisk would also grow an asterisk so large squeak would complain about not having enough memory. - - Historical note: - - The former star had two bugs that are fixed here. - The outer handle now no longer jumps from one point to another. - The other bug prevented some higher order stars from looking right. - Which is why the former star didn't allow you to change the number of points. ! Item was removed: - ----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Star' translatedNoop - categories: {'Graphics' translatedNoop} - documentation: 'A symmetrical polygon in the shape of a star' translatedNoop! Item was removed: - ----- Method: StarMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop} - forFlapNamed: 'Supplies'.]! Item was removed: - ----- Method: StarMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: StarMorph>>addChangeSidesMenuItems:hand: (in category 'menu') ----- - addChangeSidesMenuItems: aCustomMenu hand: aHandMorph - "Menu items to change number of sides." - aCustomMenu addLine. - aCustomMenu add: 'more sides' translated action: #moreVertices. - aCustomMenu add: 'fewer sides' translated action: #lessVertices. - " Regular polygons can be simulated with the one of the skip stars - and it would confuse users to have stars be limited to Regular polygons. - So we've removed those menu items - wiz" - " aCustomMenu add: 'one more side' translated action: #oneMoreVertex. - aCustomMenu add: 'one fewer side' translated action: #oneLessVertex"! Item was removed: - ----- Method: StarMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - self addChangeSidesMenuItems: aCustomMenu hand: aHandMorph. - self addTwinkleMenuItems: aCustomMenu hand: aHandMorph. - ! Item was removed: - ----- Method: StarMorph>>addHandles (in category 'editing') ----- - addHandles - self addStarHandles! Item was removed: - ----- Method: StarMorph>>addStarHandles (in category 'editing') ----- - addStarHandles - "Outer handle must not be blocked so it comes first. - The editing routine expects to find the center handle second. - The side and shape changing handles follow these." - | center | - self removeHandles. - "Check for old stars and correct order of vertices." - self insureCompatability . - handles := OrderedCollection new. - center := vertices average rounded. - self withCenterOuterHandles; withUpDownLeftRightHandlesAround: 6 center: center. - self placeHandles. - self changed. - ! Item was removed: - ----- Method: StarMorph>>addTwinkleMenuItems:hand: (in category 'menu') ----- - addTwinkleMenuItems: aCustomMenu hand: aHandMorph - "Menu items to change the sharpness of the star." - aCustomMenu addLine. - aCustomMenu add: 'twinkle fatter' translated action: #nextTwinkle. - aCustomMenu add: 'twinkle thinner' translated action: #prevTwinkle. - " aCustomMenu add: 'fatter star' translated action: #nextFatter. - aCustomMenu add: 'thinner star' translated action: #prevThinner" - - - - - ! Item was removed: - ----- Method: StarMorph>>changeVertices:event:fromHandle: (in category 'editing') ----- - changeVertices: label event: evt fromHandle: handle - | | - label == #more - ifTrue: [evt shiftPressed - ifTrue: [self moreVertices "not oneMoreVertex"] - ifFalse: [self moreVertices]]. - label == #less - ifTrue: [evt shiftPressed - ifTrue: [self lessVertices "not oneLessVertex"] - ifFalse: [self lessVertices]]. - label == #next - ifTrue: [evt shiftPressed - ifTrue: [self makeVertices: vertices size starRatio: self nextSkip] - ifFalse: [self makeVertices: vertices size starRatio: self nextTwinkleSkip]]. - label == #prev - ifTrue: [evt shiftPressed - ifTrue: [self makeVertices: vertices size starRatio: self prevSkip] - ifFalse: [self makeVertices: vertices size starRatio: self prevTwinkleSkip]]. - self computeBounds! Item was removed: - ----- Method: StarMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color black! Item was removed: - ----- Method: StarMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: StarMorph>>defaultCenter (in category 'initialization') ----- - defaultCenter - "answer the default center for the receiver" - ^ 0 asPoint! Item was removed: - ----- Method: StarMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightBlue! Item was removed: - ----- Method: StarMorph>>defaultFirstVertex (in category 'initialization') ----- - defaultFirstVertex - "answer the default first outer point for the receiver. - This with the center determines the angle and size of the outer radius." - ^ 10 asPoint! Item was removed: - ----- Method: StarMorph>>defaultSides (in category 'initialization') ----- - defaultSides - "answer the default number of sides for the receiver" - ^ 10! Item was removed: - ----- Method: StarMorph>>defaultStarRatio (in category 'initialization') ----- - defaultStarRatio - "answer the default ratio of outer radius to inner radius for the receiver" - ^ 5.0 / 12.0! Item was removed: - ----- Method: StarMorph>>dragVertex:event:fromHandle: (in category 'editing') ----- - dragVertex: label event: evt fromHandle: handle - | center r1 rN rNext a1 rTotal | - label == #outside - ifTrue: [center := handles second center. - r1 := center dist: vertices first. - "Rounding and what happens as the outer handle - approached the center, - requires we guard the inner radius - from becoming larger than the outer radius." - rN := r1 - min: (center dist: vertices last). - rNext := 1 - max: (center dist: evt cursorPoint). - a1 := 270.0 - + (center bearingToPoint: evt cursorPoint). - rTotal := vertices size even - ifTrue: [evt shiftPressed - ifTrue: [rNext + rNext min: rNext + rN] - ifFalse: [r1 + rN * rNext / r1]] - ifFalse: [rNext + rNext]. - rNext := rTotal - rNext. - vertices := ((a1 to: a1 + 359.999 by: 360.0 / vertices size) - collect: [:angle | center - + (Point r: (rNext := rTotal - rNext) degrees: angle)]) . - handle align: handle center with: evt cursorPoint]. - label == #center - ifTrue: [evt shiftPressed - ifTrue: [self updateFormFromUser] - ifFalse: [self position: self position + (evt cursorPoint - handle center)]]. - self computeBounds! Item was removed: - ----- Method: StarMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - self - makeVertices: self defaultSides - starRatio: self defaultStarRatio - withCenter: self defaultCenter - withPoint: self defaultFirstVertex. - self computeBounds! Item was removed: - ----- Method: StarMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - ^ self initialize removeHandles! Item was removed: - ----- Method: StarMorph>>insureCompatability (in category 'initialization') ----- - insureCompatability - "The old stars had the point on the second not the first vertex. So we need to check for this special case." - | c v1 v2 | - c := vertices average rounded. - v1 := vertices first . - v2 := vertices second . - (c dist: v1) + 0.001 < (c dist: v2) ifTrue: [vertices := vertices allButFirst copyWith: v1] - - ! Item was removed: - ----- Method: StarMorph>>lessVertices (in category 'menus') ----- - lessVertices - "Reduce the number of points by one until we are a diamond. If odd reduce the number of sides by two until we become a triangle. See class comment." - | nVerts | - ( nVerts := 2 negated + vertices size) < 3 ifFalse: [ - self - makeVertices: nVerts]! Item was removed: - ----- Method: StarMorph>>makeVertices: (in category 'initialization') ----- - makeVertices: nSides - "Assuming vertices has at least one point, make a new star - or regular polygon (for odd sided polygons). - The center of the polygon and the first vertex remain in - place. The inner distances for stars remain the same also if - possible." - | center r1 rN rNext a1 rTotal | - center := vertices average rounded. - r1 := center dist: vertices first. - rN := center dist: vertices last. - rNext := 1 max: r1. - a1 := 270.0 - + (center bearingToPoint: vertices first). - rTotal := nSides even - ifTrue: [rNext + rNext min: rNext + rN] - ifFalse: [rNext + rNext]. - rNext := rTotal - rNext. - self changed . - vertices := (a1 to: a1 + 359.999 by: 360.0 / nSides) - collect: [:angle | center - + (Point r: (rNext := rTotal - rNext) degrees: angle)]. - self computeBounds. - self changed! Item was removed: - ----- Method: StarMorph>>makeVertices:starRatio: (in category 'initialization') ----- - makeVertices: nSides starRatio: fraction - "Assuming vertices has at least one point, make a new star - or regular polygon (for odd sided polygons). - The center of the polygon and the first vertex remain in - place. The inner distances for stars remain the same also if - possible." - | center r1 rN rNext a1 rTotal | - center := vertices average rounded. - r1 := center dist: vertices first. - rNext := 1 max: r1. - rN := (1.0 min: fraction) * rNext. - a1 := 270.0 - + (center bearingToPoint: vertices first). - rTotal := nSides even - ifTrue: [rNext + rNext min: rNext + rN] - ifFalse: [rNext + rNext]. - rNext := rTotal - rNext. - self changed . - vertices := (a1 to: a1 + 359.999 by: 360.0 / nSides) - collect: [:angle | center - + (Point r: (rNext := rTotal - rNext) degrees: angle)]. - self computeBounds. - self changed! Item was removed: - ----- Method: StarMorph>>makeVertices:starRatio:withCenter:withPoint: (in category 'initialization') ----- - makeVertices: nSides starRatio: fraction withCenter: center withPoint: aPoint - "Make a new star or regular polygon (for odd sided polygons). - This makes star vertices from scratch without any feedback from existing vertices." - | r1 rN rNext a1 rTotal | - r1 := center dist: aPoint. - rNext := 1 max: r1. - rN := (1.0 min: fraction) - * rNext. - a1 := 270.0 - + (center bearingToPoint: aPoint). - rTotal := nSides even - ifTrue: [rNext + rNext min: rNext + rN] - ifFalse: [rNext + rNext]. - rNext := rTotal - rNext. - self changed. - vertices := (a1 to: a1 + 359.999 by: 360.0 / nSides) - collect: [:angle | center - + (Point r: (rNext := rTotal - rNext) degrees: angle)]. - self computeBounds. - self changed! Item was removed: - ----- Method: StarMorph>>moreVertices (in category 'menus') ----- - moreVertices - self makeVertices: 2+ vertices size! Item was removed: - ----- Method: StarMorph>>nextSkip (in category 'geometry') ----- - nextSkip - "Set starRatio to next skip wrapping if needed." - | skips n c r1 rN | - c := vertices average rounded. - r1 := (c dist: vertices first) truncated asFloat. - rN := c dist: vertices last. - skips := self skipRatios. - n := skips * r1 - findFirst: [:r | r > (rN + 1.0)]. - "n = 0 - ifTrue: [n := skips size]." - ^ skips atWrap: n! Item was removed: - ----- Method: StarMorph>>nextTwinkle (in category 'menus') ----- - nextTwinkle - self makeVertices: vertices size starRatio: self nextTwinkleSkip . - self computeBounds.! Item was removed: - ----- Method: StarMorph>>nextTwinkleSkip (in category 'geometry') ----- - nextTwinkleSkip - "Set starRatio to next skip wrapping if needed." - | skips n c r1 rN | - c := vertices average rounded. - r1 := (c dist: vertices first) truncated asFloat. - rN := c dist: vertices last. - skips := self skipRatios. - n := skips * r1 - findFirst: [:r | r > (rN + 1.0)]. - n = 0 - ifTrue: [ n := 1]. - ^ skips atWrap: n! Item was removed: - ----- Method: StarMorph>>oneLessVertex (in category 'menu') ----- - oneLessVertex - self - makeVertices: (3 max: 1 negated + vertices size)! Item was removed: - ----- Method: StarMorph>>oneMoreVertex (in category 'menu') ----- - oneMoreVertex - self makeVertices: 1 + vertices size! Item was removed: - ----- Method: StarMorph>>placeHandles (in category 'editing') ----- - placeHandles - "Add the handles to my submorphs." - handles reverseDo: [:each | self addMorphFront: each ] . - - ! Item was removed: - ----- Method: StarMorph>>prevSkip (in category 'geometry') ----- - prevSkip - "Set starRatio to next skip wrapping if necessary" - | skips n c r1 rN | - c := vertices average rounded. - r1 := c dist: vertices first. - rN := (c dist: vertices last) truncated asFloat. - skips := self skipRatios. - n := skips * r1 - findLast: [:r | r + 1.0 < rN]. - n = 0 - ifTrue: [n := 1]. - ^ skips at: n! Item was removed: - ----- Method: StarMorph>>prevTwinkle (in category 'menus') ----- - prevTwinkle - self makeVertices: vertices size starRatio: self prevTwinkleSkip . - self computeBounds.! Item was removed: - ----- Method: StarMorph>>prevTwinkleSkip (in category 'geometry') ----- - prevTwinkleSkip - "Set starRatio to next skip wrapping if necessary" - | skips n c r1 rN | - c := vertices average rounded. - r1 := c dist: vertices first. - rN := (c dist: vertices last) truncated asFloat. - skips := self skipRatios. - n := skips * r1 - findLast: [:r | r + 1.0 < rN]. - "n = 0 - ifTrue: [^ oldR]." - ^ skips atWrap: n! Item was removed: - ----- Method: StarMorph>>skipRatios (in category 'access') ----- - skipRatios - "Return an array of ratios of the inner radius to the outer radius. - Ratios are in ascending order from 0.0 to 1.0." - "Assume we have at least one vertex. - All ways return a number <= 1.0" - - | n alpha | - "Odd vertices sizes can not be stars only regular polygons" - n:= vertices size . n odd ifTrue: [ ^ #( 1.0) ] . - - alpha := Float pi / (n//2) asFloat . - - ^ (((( Float halfPi -alpha to: alpha /2.0 by: alpha negated ) - collect: [:angle |( (angle) sin )/ - (angle + alpha ) sin ] - ) copyWith: 0.0) copyWithFirst: 1.0) reversed .! Item was removed: - ----- Method: StarMorph>>starRatio (in category 'access') ----- - starRatio - "Return the ratio of the inner radius to the outer radius." - "Assume we have at least one vertex. - All ways return a number <= 1.0" - | r c | - c := vertices average rounded . - r := (c dist: vertices last) / (c dist: vertices first) . - ^ r > 1.0 ifTrue: [ r reciprocal ] ifFalse: [r ] .! Item was removed: - ----- Method: StarMorph>>starRatio: (in category 'accessing') ----- - starRatio: r - "Set the star s.t. the ratio of the inner radius to the outer radius is r. - If r is > 1 use the reciprocal to keep the outer radius first." - "Assume we have at least one vertex. - set - All ways return a number <= 1.0" - self makeVertices: vertices size starRatio:( r > 1.0 ifTrue: [ r reciprocal ] ifFalse: [r ] ).! Item was removed: - ----- Method: StarMorph>>updateFormFromUser (in category 'menus') ----- - updateFormFromUser - "Does nothing here. Overridden in subclasses e.g. Kaleidoscope." - ^ self.! Item was removed: - ----- Method: StarMorph>>updateHandles (in category 'editing') ----- - updateHandles! Item was removed: - ----- Method: StarMorph>>withCenterOuterHandles (in category 'editing') ----- - withCenterOuterHandles - "Add to our handles the center positioning and outer resizing - handles. Outer handle must not be blocked so it comes first. - The editing routine expects to find the center handle second. - The side and shape changing handles follow these." - | center v1 hExtent holder | - center := vertices average rounded. - hExtent := 8 @ 8. - v1 := vertices first. - holder := {(EllipseMorph - newBounds: (Rectangle center: v1 extent: hExtent) - color: Color yellow) - setBalloonText: 'Move me to adjust size. Shift move to adjust pointiness'. (EllipseMorph - newBounds: (Rectangle center: center extent: hExtent) - color: Color yellow) - setBalloonText: 'Move me to adjust position'}. - holder - with: {#outside. #center} - do: [:handle :which | handle - on: #mouseDown - send: #dragVertex:event:fromHandle: - to: self - withValue: which; - - on: #mouseMove - send: #dragVertex:event:fromHandle: - to: self - withValue: which]. - handles addAll: holder! Item was removed: - ----- Method: StarMorph>>withUpDownLeftRightHandlesAround:center: (in category 'editing') ----- - withUpDownLeftRightHandlesAround: radius center: center - "Add to our handles the side and shape changing handles." - | tri above holder triAbove triBelow triRight triLeft | - above := 0 @ radius negated. - - tri := Array - with: 0 @ -5 - with: 4 @ 3 - with: -4 @ 3. - triAbove := tri + (center + above). - triBelow := triAbove - collect: [:pt | pt rotateBy: #pi centerAt: center]. - triRight := triAbove - collect: [:pt | pt rotateBy: #right centerAt: center]. - triLeft := triAbove - collect: [:pt | pt rotateBy: #left centerAt: center]. - - holder := { (PolygonMorph - vertices: triAbove - color: Color green - borderWidth: 1 - borderColor: Color black) - setBalloonText: 'More points.'. - - (PolygonMorph - vertices: triBelow - color: Color magenta - borderWidth: 1 - borderColor: Color black) - setBalloonText: 'Fewer points.'. - - (PolygonMorph - vertices: triRight - color: Color green - borderWidth: 1 - borderColor: Color black) - setBalloonText: 'Twinkle fatter.'. - - (PolygonMorph - vertices: triLeft - color: Color magenta - borderWidth: 1 - borderColor: Color black) - setBalloonText: 'Twinkle thinner.'}. - - holder - with: {#more. #less. #next. #prev} - do: [:handle :which | handle - on: #mouseDown - send: #changeVertices:event:fromHandle: - to: self - withValue: which; - - on: #mouseMove - send: #changeVertices:event:fromHandle: - to: self - withValue: which]. - ^ handles addAll: holder! Item was removed: - RectangleMorph subclass: #StickyPadMorph - instanceVariableNames: '' - classVariableNames: 'Colors LastColorIndex' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !StickyPadMorph commentStamp: 'sw 3/3/2004 13:31' prior: 0! - A custom item for the Squeakland Supplies bin, as defined by Kim Rose and BJ Con.A parts bin will deliver up translucent, borderless Rectangles in a sequence of 6 colors. It offers some complication to the parts-bin protocols in two ways:: - * The multi-colored icon seen in the parts bin is not a thumbnail of any actual instance, all of which are monochrome - * New instances need to be given default names that are not the same as the name seen in the parts bin.! Item was removed: - ----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') ----- - defaultNameStemForInstances - "Answer the default name stem to use" - - ^ 'tear off' translatedNoop - ! Item was removed: - ----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - "Answer a description of the receiver for use in a parts bin" - - ^ self partName: 'Sticky Pad' translatedNoop - categories: {'Just for Fun' translatedNoop} - documentation: 'A translucent, borderless rectangle of a standard size, delivered in a predictable sequence of pastel colors' translatedNoop - sampleImageForm: (Form extent: 50 at 40 depth: 16 - fromArray: #( 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 17 36271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 173627174 1 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 14614 09563 1461409563 1461409563 1461409563 1461409563 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461414680 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1796762392 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461414680 1796762392 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1 461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1796762392 1796762392 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461409563 1461414680 1796762392 1796762392 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1723098804 1723098804 1723098804 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521903284 1723098804 1723098804 1723096921 1736271741 17362717 41 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1723098804 1723098804 1723098804 1599692633 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521903284 1723098804 1723098804 1723096921 1599692633 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1521900214 1723098804 1723098804 1723098804 1599692633 1599692633 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1521900214 1521 900214 1521900214 1521903284 1723098804 1723098804 1723096921 1599692633 1599692633 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1322274512 1322274512 1322274512 1389318863 1389318863 1389318863 1328697138 1328697138 1328697138 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1322274512 1322274512 1322275535 1389318863 1389318863 1389317938 1328697138 1328697138 1328702226 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1322274512 1322274512 1389318863 1389318863 1389318863 1328697138 1328697138 1328697138 1662149394 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1322274512 1322275535 1389318863 1389318863 1389317938 1328697138 1328697138 1328702226 1662149394 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1322274512 1389318863 1389318863 1389318863 1328697138 1328697138 1328697138 1662149394 1662149394 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1322275535 1389318863 1389318863 1389317938 1328697138 1328697138 1328702226 1662149394 1662149394 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521900214 1389318863 1389318863 1389318863 1460426508 1460426508 1460426508 1659658988 1659658 988 1659658988 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1521903284 1389318863 1389318863 1389317938 1460426508 1460426508 1460429548 1659658988 1659658988 1659660157 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521900214 1723098804 1389318863 1389318863 1328697138 1460426508 1460426508 1659658988 1659658988 1659658988 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 1521903284 1723098804 1389318863 1389317938 1328697138 1460426508 1460429548 1659658988 1659658988 1659660157 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521900214 172 3098804 1723098804 1389318863 1328697138 1328697138 1460426508 1659658988 1659658988 1659658988 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1521903284 1723098804 1723098804 1389317938 1328697138 1328697138 1460429548 1659658988 1659658988 1659660157 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461409563 1723098804 1723098804 1723098804 1328697138 1328697138 1328697138 1659658988 1659658988 1659658988 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1461414680 1723098804 1723098804 1723096921 1328697138 1328697138 1328702226 1659658988 1659658988 1659660157 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461409563 1796762392 1723098804 1723098804 1599692633 1328697138 1328697138 1662149394 1659658988 1659658988 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1461414680 1796762392 1723098804 1723096921 1599692633 1328697138 1328702226 1662149394 1659658988 1659660157 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461409563 1796762392 1796762392 1723098804 1599692633 1599692633 1328697138 1662149394 1662149394 1659658988 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1736271741 1461414680 1796762392 1796762392 1723096921 1599692633 1599692633 1328702226 1662149394 1662149394 1659660157 173627 1741 1736271741 1736271741 1736271741 1736271741) - offset: 0 at 0)! Item was removed: - ----- Method: StickyPadMorph class>>initialize (in category 'class initialization') ----- - initialize - "Class initialization" - - LastColorIndex := 0. - Colors := { - TranslucentColor r: 0.0 g: 0.0 b: 0.839 alpha: 0.267. - TranslucentColor r: 0.484 g: 1.0 b: 0.452 alpha: 0.706. - TranslucentColor r: 1.0 g: 0.355 b: 0.71 alpha: 0.569. - TranslucentColor r: 1.0 g: 1.0 b: 0.03 alpha: 0.561. - TranslucentColor r: 0.484 g: 0.161 b: 1.0 alpha: 0.529. - TranslucentColor r: 0.097 g: 0.097 b: 0.097 alpha: 0.192. - }. - - self registerInFlapsRegistry. - - "StickyPadMorph initialize"! Item was removed: - ----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') ----- - launchPartVia: aSelector label: aString - "Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types" - - | aMorph | - aMorph := self perform: aSelector. - aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case" - aMorph setProperty: #beFullyVisibleAfterDrop toValue: true. - aMorph openInHand. - ^ aMorph! Item was removed: - ----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop} - forFlapNamed: 'PlugIn Supplies'.]! Item was removed: - ----- Method: StickyPadMorph>>canHaveFillStyles (in category 'visual properties') ----- - canHaveFillStyles - "Return true if the receiver can have general fill styles; not just - colors. This method is for gradually converting old morphs." - ^ true! Item was removed: - ----- Method: StickyPadMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - "Initialize the receiver to stand alone. Use the next color in the standard sequence." - - Colors ifNil: [self initialize]. - LastColorIndex := - LastColorIndex - ifNil: - [1] - ifNotNil: - [(LastColorIndex \\ Colors size) + 1]. - super initializeToStandAlone. - self assureExternalName. - self color: (Colors at: LastColorIndex). - self extent: 100 at 80. - self borderWidth: 0 - ! Item was removed: - BookMorph subclass: #StoryboardBookMorph - instanceVariableNames: 'alansSliders panAndTiltFactor zoomFactor zoomController' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Books'! - - !StoryboardBookMorph commentStamp: 'kfr 5/17/2015 23:37' 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. - - StoryboardBookMorph new openInWorld - - Drop an picture at the book. - - Mouse - - drag up and down to tilt - - drag left and right to pan - - shift-drag up and down to zoom in and out - - Keyboard - Arrow keys pan and tilts the image - X and Z zoom in and out - - From top left in control panel you pull out stills from diffrent zoom, tilt and pan posititons. - Drop these after eachother to make an animation script. - The numbers between the stills are playback speed, that can be edited. - Save script from the scripts halo menu. - - Playback script from controll panels halo menu. - - ! Item was removed: - ----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Storyboard' translatedNoop - categories: #() - documentation: 'A storyboard authoring tool' translatedNoop! Item was removed: - ----- Method: StoryboardBookMorph>>changeTiltFactor: (in category 'private') ----- - changeTiltFactor: x - - currentPage changeTiltFactor: x. - panAndTiltFactor := x. - - ! Item was removed: - ----- Method: StoryboardBookMorph>>changeZoomFactor: (in category 'private') ----- - changeZoomFactor: x - - currentPage changeZoomFactor: x. - zoomFactor := x.! Item was removed: - ----- Method: StoryboardBookMorph>>getTiltFactor (in category 'private') ----- - getTiltFactor - - ^panAndTiltFactor ifNil: [panAndTiltFactor := 0.5].! Item was removed: - ----- Method: StoryboardBookMorph>>getZoomFactor (in category 'private') ----- - getZoomFactor - - ^zoomFactor ifNil: [zoomFactor := 0.5]! Item was removed: - ----- Method: StoryboardBookMorph>>initialize (in category 'initialization') ----- - initialize - - newPagePrototype := ZoomAndScrollMorph new extent: 300 at 300. - zoomController := ZoomAndScrollControllerMorph new - setBalloonText: 'Drag in here to zoom, tilt and pan the page above'; - extent: 246 at 147. - - super initialize. - - "tool := RectangleMorph new extent: 250 at 170; layoutPolicy: TableLayout new. - tool addMorph: 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 | tool addMorphBack: each first]. - tool openInWorld" - ! Item was removed: - ----- 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. - - ! Item was removed: - ----- Method: StoryboardBookMorph>>intoWorld: (in category 'initialization') ----- - intoWorld: world - - zoomController openInWorld.! Item was removed: - ----- Method: StoryboardBookMorph>>offsetX (in category 'accessing') ----- - offsetX - - ^currentPage offsetX! Item was removed: - ----- Method: StoryboardBookMorph>>offsetX: (in category 'accessing') ----- - offsetX: aNumber - - currentPage offsetX: aNumber! Item was removed: - ----- Method: StoryboardBookMorph>>offsetY (in category 'accessing') ----- - offsetY - - ^currentPage offsetY! Item was removed: - ----- Method: StoryboardBookMorph>>offsetY: (in category 'accessing') ----- - offsetY: aNumber - - currentPage offsetY: aNumber! Item was removed: - ----- Method: StoryboardBookMorph>>scale (in category 'accessing') ----- - scale - - ^currentPage scale! Item was removed: - ----- Method: StoryboardBookMorph>>scale: (in category 'accessing') ----- - scale: aValue - - currentPage scale: aValue! Item was removed: - ----- Method: String>>asPostscript (in category '*MorphicExtras-Postscript Canvases') ----- - asPostscript - - | temp | - temp := self asString copyReplaceAll: '(' with: '\('. - temp := temp copyReplaceAll: ')' with: '\)'. - temp := temp copyReplaceAll: ' - ' - with: ''. - ^ PostscriptEncoder mapMacStringToPS: temp! Item was removed: - StringMorph subclass: #StringButtonMorph - instanceVariableNames: 'target actionSelector arguments actWhen oldColor' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'SButton' translatedNoop! Item was removed: - ----- Method: StringButtonMorph>>actWhen: (in category 'submorphs - add/remove') ----- - actWhen: aSymbol - "Set the condition under which to invoke my action to one of: #buttonDown, #buttonUp, and #whilePressed." - - actWhen := aSymbol. - ! Item was removed: - ----- Method: StringButtonMorph>>actionSelector (in category 'accessing') ----- - actionSelector - - ^ actionSelector - ! Item was removed: - ----- Method: StringButtonMorph>>actionSelector: (in category 'accessing') ----- - actionSelector: aSymbolOrString - - (nil = aSymbolOrString or: - ['nil' = aSymbolOrString or: - [aSymbolOrString isEmpty]]) - ifTrue: [^ actionSelector := nil]. - - actionSelector := aSymbolOrString asSymbol. - ! Item was removed: - ----- Method: StringButtonMorph>>adaptToWorld: (in category 'e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - target := target adaptedToWorld: aWorld.! Item was removed: - ----- Method: StringButtonMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'change label' translated action: #setLabel. - aCustomMenu add: 'change action selector' translated action: #setActionSelector. - aCustomMenu add: 'change arguments' translated action: #setArguments. - aCustomMenu add: 'change when to act' translated action: #setActWhen. - self addTargetingMenuItems: aCustomMenu hand: aHandMorph .! Item was removed: - ----- Method: StringButtonMorph>>addTargetingMenuItems:hand: (in category 'menu') ----- - addTargetingMenuItems: aCustomMenu hand: aHandMorph - "Add targeting menu items" - aCustomMenu addLine. - - aCustomMenu add: 'set target' translated action: #targetWith:. - aCustomMenu add: 'sight target' translated action: #sightTargets:. - target - ifNotNil: [aCustomMenu add: 'clear target' translated action: #clearTarget]! Item was removed: - ----- Method: StringButtonMorph>>arguments (in category 'accessing') ----- - arguments - - ^ arguments - ! Item was removed: - ----- Method: StringButtonMorph>>arguments: (in category 'accessing') ----- - arguments: aCollection - - arguments := aCollection asArray copy. - ! Item was removed: - ----- Method: StringButtonMorph>>clearTarget (in category 'menu') ----- - clearTarget - - target := nil. - ! Item was removed: - ----- Method: StringButtonMorph>>doButtonAction (in category 'button') ----- - doButtonAction - "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments." - - (target notNil and: [actionSelector notNil]) - ifTrue: - [Cursor normal - showWhile: [target perform: actionSelector withArguments: arguments]]! Item was removed: - ----- Method: StringButtonMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ true - ! Item was removed: - ----- Method: StringButtonMorph>>handlesMouseStillDown: (in category 'event handling') ----- - handlesMouseStillDown: evt - ^actWhen == #whilePressed! Item was removed: - ----- Method: StringButtonMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - target := nil. - actionSelector := #flash. - arguments := Array empty. - actWhen := #buttonUp. - self contents: 'Flash'! Item was removed: - ----- Method: StringButtonMorph>>isButton (in category 'classification') ----- - isButton - - ^ true! Item was removed: - ----- Method: StringButtonMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - oldColor := color. - actWhen == #buttonDown - ifTrue: [self doButtonAction]. - ! Item was removed: - ----- Method: StringButtonMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - actWhen == #buttonDown ifTrue: [^ self]. - (self containsPoint: evt cursorPoint) - ifTrue:[self color: (oldColor alphaMixed: 1/2 with: Color white)] - ifFalse: [self color: oldColor]. - ! Item was removed: - ----- Method: StringButtonMorph>>mouseStillDown: (in category 'event handling') ----- - mouseStillDown: evt - actWhen == #whilePressed ifFalse: [^ self]. - (self containsPoint: evt cursorPoint) ifTrue:[self doButtonAction].! Item was removed: - ----- Method: StringButtonMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - self color: oldColor. - (actWhen == #buttonUp and: [self containsPoint: evt cursorPoint]) - ifTrue: [self doButtonAction]. - ! Item was removed: - ----- Method: StringButtonMorph>>setActWhen (in category 'menu') ----- - setActWhen - - | selections | - selections := #(buttonDown buttonUp whilePressed). - actWhen := UIManager default - chooseFrom: (selections collect: [:t | t translated]) - values: selections - title: 'Choose one of the following conditions' translated. - ! Item was removed: - ----- Method: StringButtonMorph>>setActionSelector (in category 'menu') ----- - setActionSelector - - | newSel | - newSel := UIManager default - request: - 'Please type the selector to be sent to - the target when this button is pressed' translated - initialAnswer: actionSelector. - newSel isEmpty ifFalse: [self actionSelector: newSel]. - ! Item was removed: - ----- Method: StringButtonMorph>>setArguments (in category 'menu') ----- - setArguments - - | s newArgs newArgsArray | - s := WriteStream on: ''. - arguments do: [:arg | arg printOn: s. s nextPutAll: '. ']. - newArgs := UIManager default - request: - 'Please type the arguments to be sent to the target - when this button is pressed separated by periods' translated - initialAnswer: s contents. - newArgs isEmpty ifFalse: [ - newArgsArray := Compiler evaluate: '{', newArgs, '}' for: self. - self arguments: newArgsArray]. - ! Item was removed: - ----- Method: StringButtonMorph>>setLabel (in category 'menu') ----- - setLabel - - | newLabel | - newLabel := UIManager default - request: - 'Please type a new label for this button' - initialAnswer: self contents. - newLabel isEmpty ifFalse: [self contents: newLabel]. - ! Item was removed: - ----- Method: StringButtonMorph>>setTarget: (in category 'menu') ----- - setTarget: evt - | rootMorphs | - rootMorphs := self world rootMorphsAt: evt targetPoint. - target := rootMorphs size > 1 - ifTrue: [rootMorphs second] - ifFalse: [nil]! Item was removed: - ----- Method: StringButtonMorph>>target (in category 'accessing') ----- - target - - ^ target - ! Item was removed: - ----- Method: StringButtonMorph>>target: (in category 'accessing') ----- - target: anObject - - target := anObject - ! Item was removed: - ----- Method: StringButtonMorph>>updateReferencesUsing: (in category 'copying') ----- - updateReferencesUsing: aDictionary - "If the arguments array points at a morph we are copying, then point at the new copy. And also copies the array, which is important!!" - - super updateReferencesUsing: aDictionary. - arguments := arguments collect: - [:old | aDictionary at: old ifAbsent: [old]]. - ! Item was removed: - ----- Method: StringButtonMorph>>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. - target := deepCopier references at: target ifAbsent: [target]. - arguments := arguments collect: [:each | - deepCopier references at: each ifAbsent: [each]]. - ! Item was removed: - ----- Method: StringButtonMorph>>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. - "target := target. Weakly copied" - "actionSelector := actionSelector. a Symbol" - "arguments := arguments. All weakly copied" - actWhen := actWhen veryDeepCopyWith: deepCopier. - oldColor := oldColor veryDeepCopyWith: deepCopier.! Item was removed: - ----- Method: StringMorph>>getCharacters (in category '*MorphicExtras-accessing') ----- - getCharacters - "obtain a string value from the receiver." - - ^ self contents! Item was removed: - ----- Method: StringMorph>>handsWithMeForKeyboardFocus (in category '*MorphicExtras-accessing') ----- - handsWithMeForKeyboardFocus - "Answer the hands that have me as their keyboard focus" - - hasFocus ifFalse: [^ #()]. - ^ self currentWorld hands select: - [:aHand | - | foc | - (foc := aHand keyboardFocus) notNil and: [foc owner == self]]! Item was removed: - StringButtonMorph subclass: #TabMorph - instanceVariableNames: 'morphToInstall' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Palettes'! - - !TabMorph commentStamp: '<historical>' prior: 0! - A tab in a palette. The contents is the name to be shown. If it represents a book, that book is pointed to in my morphToInstall.! Item was removed: - ----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'tab' translatedNoop! Item was removed: - ----- Method: TabMorph>>convertToReferenceMorph (in category 'converting') ----- - convertToReferenceMorph - | aMorph | - aMorph := ReferenceMorph new referent: morphToInstall. - aMorph position: self position. - self becomeForward: aMorph.! Item was removed: - ----- Method: TabMorph>>isHighlighted (in category 'testing') ----- - isHighlighted - ^ false! Item was removed: - ----- Method: TabMorph>>morphToInstall (in category 'accessing') ----- - morphToInstall - ^ morphToInstall! Item was removed: - ----- Method: TabMorph>>morphToInstall: (in category 'accessing') ----- - morphToInstall: m - morphToInstall := m. - self contents: m externalName. - self actionSelector: #tabSelected. - self target: self! Item was removed: - ----- Method: TabMorph>>tabSelected (in category 'tabs') ----- - tabSelected - "Called when the receiver is hit. First, bulletproof against someone having taken the structure apart. My own action basically requires that my grand-owner be a TabbedPalette" - self player ifNotNil: [self player runAllOpeningScripts ifTrue: [^ self]]. - (owner isKindOf: IndexTabs) ifFalse: [^ Beeper beep]. - (owner owner isKindOf: TabbedPalette) ifFalse: [^ Beeper beep]. - owner owner selectTab: self! Item was removed: - ----- Method: TabMorph>>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. - morphToInstall := deepCopier references at: morphToInstall ifAbsent: [morphToInstall].! Item was removed: - ----- Method: TabMorph>>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. - morphToInstall := morphToInstall. "Weakly copied"! Item was removed: - BookPageSorterMorph subclass: #TabSorterMorph - instanceVariableNames: 'originalTabs' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Palettes'! - - !TabSorterMorph commentStamp: '<historical>' prior: 0! - A sorter for the tabs of a TabbedPalette! Item was removed: - ----- Method: TabSorterMorph>>acceptSort (in category 'buttons') ----- - acceptSort - "Reconstitute the palette based on what is found in the sorter" - - | rejects oldOwner tabsToUse oldTop | - tabsToUse := OrderedCollection new. - rejects := OrderedCollection new. - pageHolder submorphs withIndexDo: - [:m :i | | appearanceMorph toAdd aMenu | - toAdd := nil. - (m isKindOf: BookMorph) ifTrue: [toAdd := SorterTokenMorph forMorph: m]. - (m isKindOf: SorterTokenMorph) - ifTrue: - [toAdd := m morphRepresented. - (toAdd referent isKindOf: MenuMorph) - ifTrue: - [(aMenu := toAdd referent) setProperty: #paletteMenu toValue: true. - (aMenu submorphs size > 1 and: - [(aMenu submorphs second isKindOf: MenuItemMorph) - and: [aMenu submorphs second contents = 'dismiss this menu']]) - ifTrue: - [aMenu submorphs first delete. "delete title" - aMenu submorphs first delete. "delete stay-up item" - (aMenu submorphs first knownName = #line) - ifTrue: [aMenu submorphs first delete]]]. - toAdd removeAllMorphs. - toAdd addMorph: (appearanceMorph := m submorphs first). - appearanceMorph position: toAdd position. - appearanceMorph lock. - toAdd fitContents]. - toAdd ifNil: [rejects add: m] ifNotNil: [tabsToUse add: toAdd]]. - tabsToUse isEmpty - ifTrue: [^self inform: 'Sorry, must have at least one tab']. - book newTabs: tabsToUse. - book tabsMorph color: pageHolder color. - oldTop := self topRendererOrSelf. "in case some maniac has flexed the sorter" - oldOwner := oldTop owner. - oldTop delete. - oldOwner addMorphFront: book! Item was removed: - ----- Method: TabSorterMorph>>addControls (in category 'initialization') ----- - addControls - "Add the control bar at the top of the tool." - - | b r | - 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: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort). - b := SimpleButtonMorph new target: self; borderColor: Color black. - r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort). - self addMorphFront: r. - ! Item was removed: - ----- Method: TabSorterMorph>>cancelSort (in category 'buttons') ----- - cancelSort - | oldOwner | - oldOwner := owner. - self delete. - oldOwner addMorphFront: book! Item was removed: - ----- Method: TabSorterMorph>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver." - - super initialize. - self removeAllMorphs. - - self extent: 300 at 100. - pageHolder := PasteUpMorph new. - pageHolder vResizeToFit: true; autoLineLayout: true. - pageHolder extent: self extent - self borderWidth. - pageHolder padding: 8. - pageHolder cursor: 0. - pageHolder wantsMouseOverHalos: false. - self addControls. - self addMorphBack: pageHolder! Item was removed: - ----- Method: TabSorterMorph>>sortTabsFor: (in category 'sorting') ----- - sortTabsFor: aTabbedPalette - | actualTabs | - actualTabs := aTabbedPalette tabMorphs. - self book: aTabbedPalette morphsToSort: - (actualTabs collect: [:aTab | aTab sorterToken]). - pageHolder color: aTabbedPalette tabsMorph color. - - self position: aTabbedPalette position. - pageHolder extent: self extent. - self setNameTo: 'Tab Sorter for ', aTabbedPalette externalName. - aTabbedPalette owner addMorphFront: self! Item was removed: - BookMorph subclass: #TabbedPalette - instanceVariableNames: 'tabsMorph' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Palettes'! - - !TabbedPalette commentStamp: '<historical>' prior: 0! - A structure of tabs and associated books. Pressing a tab brings into focus the associated book. Some tabs can have simple actions rather than books as their focus -- in this case, the palette is cleared and the action taken. ! Item was removed: - ----- Method: TabbedPalette class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - | aTabbedPalette aBook aTab | - aTabbedPalette := self new markAsPartsDonor. - aTabbedPalette pageSize: 200 @ 300. - aTabbedPalette tabsMorph highlightColor: Color red regularColor: Color blue. - aTabbedPalette addMenuTab. - - aBook := BookMorph new setNameTo: 'one'; pageSize: aTabbedPalette pageSize. - aBook color: Color blue muchLighter. - aBook removeEverything; insertPage; showPageControls. - aBook currentPage addMorphBack: (Project current world drawingClass withForm: ScriptingSystem squeakyMouseForm). - aTab := aTabbedPalette addTabForBook: aBook. - - aBook := BookMorph new setNameTo: 'two'; pageSize: aTabbedPalette pageSize. - aBook color: Color red muchLighter. - aBook removeEverything; insertPage; showPageControls. - aBook currentPage addMorphBack: CurveMorph authoringPrototype. - aTabbedPalette addTabForBook: aBook. - - aTabbedPalette selectTab: aTab. - - aTabbedPalette beSticky. - aTabbedPalette tabsMorph hResizing: #spaceFill. - ^ aTabbedPalette! Item was removed: - ----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'tabbedPalette' translatedNoop! Item was removed: - ----- Method: TabbedPalette class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ DescriptionForPartsBin - formalName: 'TabbedPalette' - categoryList: #('Presentation') - documentation: 'A tabbed palette of books' - globalReceiverSymbol: #TabbedPalette - nativitySelector: #authoringPrototype! Item was removed: - ----- Method: TabbedPalette class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: TabbedPalette class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: #(TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs') - forFlapNamed: 'Supplies'.]! Item was removed: - ----- Method: TabbedPalette class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: TabbedPalette>>addBookMenuItemsTo:hand: (in category 'palette menu') ----- - addBookMenuItemsTo: aCustomMenu hand: aHandMorph - aCustomMenu add: 'add palette menu' translated action: #addMenuTab. - aCustomMenu add: 'become the Standard palette' translated action: #becomeStandardPalette! Item was removed: - ----- Method: TabbedPalette>>addMenuTab (in category 'palette menu') ----- - addMenuTab - "Add the menu tab. This is ancient code, not much in the spirit of anything current" - - | aMenu aTab aGraphic sk | - aMenu := MenuMorph new defaultTarget: self. - aMenu stayUp: true. - "aMenu add: 'clear' translated action: #showNoPalette." - aMenu add: 'sort tabs' translated action: #sortTabs:. - aMenu add: 'choose new colors for tabs' translated action: #recolorTabs. - aMenu setProperty: #paletteMenu toValue: true. - "aMenu add: 'make me the Standard palette' translated action: #becomeStandardPalette." - aTab := self addTabForBook: aMenu withBalloonText: 'a menu of palette-related controls' translated. - aTab highlightColor: tabsMorph highlightColor; regularColor: tabsMorph regularColor. - tabsMorph laySubpartsOutInOneRow; layoutChanged. - - aGraphic := ScriptingSystem formAtKey: 'TinyMenu'. - aGraphic ifNotNil: - [aTab removeAllMorphs. - aTab addMorph: (sk := Project current world drawingClass withForm: aGraphic). - sk position: aTab position. - sk lock. - aTab fitContents]. - self layoutChanged! Item was removed: - ----- Method: TabbedPalette>>addTabFor:font: (in category 'initialization') ----- - addTabFor: aReferent font: aFont - | aTab | - aTab := tabsMorph addTabFor: aReferent font: aFont. - pages add: aReferent. - currentPage ifNil: [currentPage := aReferent]. - ^ aTab! Item was removed: - ----- Method: TabbedPalette>>addTabForBook: (in category 'initialization') ----- - addTabForBook: aBook - | aTab | - aTab := tabsMorph addTabForBook: aBook. - pages add: aBook. - currentPage ifNil: [currentPage := aBook]. - ^ aTab! Item was removed: - ----- Method: TabbedPalette>>addTabForBook:withBalloonText: (in category 'initialization') ----- - addTabForBook: aBook withBalloonText: text - | aTab | - aTab := tabsMorph addTabForBook: aBook. - pages add: aBook. - currentPage ifNil: [currentPage := aBook]. - text ifNotNil: [aTab setBalloonText: text]. - ^ aTab! Item was removed: - ----- Method: TabbedPalette>>becomeStandardPalette (in category 'misc menu items') ----- - becomeStandardPalette - self presenter standardPalette: self! Item was removed: - ----- Method: TabbedPalette>>currentPalette (in category 'miscellaneous') ----- - currentPalette - "A stylistic convenience to reduce confusion caused by the fact that a palette is a book of books" - ^ currentPage! Item was removed: - ----- Method: TabbedPalette>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color transparent! Item was removed: - ----- Method: TabbedPalette>>defaultPageSize (in category 'initialization') ----- - defaultPageSize - ^ 156 @ 232! Item was removed: - ----- Method: TabbedPalette>>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) - and: [currentPage defersHaloOnClickTo: aSubMorph]] - ! Item was removed: - ----- Method: TabbedPalette>>hasScrapsTab (in category 'scraps tab') ----- - hasScrapsTab - pages detect: [:p | (p hasProperty: #scraps)] ifNone: [^ false]. - ^ true! Item was removed: - ----- Method: TabbedPalette>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver, which was just created via a call to the - class's #basicNew" - super initialize. - "" - pageSize := self defaultPageSize. - self removeEverything. - - tabsMorph := IndexTabs new. - self addMorph: tabsMorph! Item was removed: - ----- Method: TabbedPalette>>newTabs: (in category 'initialization') ----- - newTabs: tabsList - "Reconstitute the palette based on info in the tabs list" - - | color1 color2 color3 | - pages := pages species new. - tabsMorph ifNotNil: - [color1 := tabsMorph highlightColor. - color2 := tabsMorph regularColor. - color3 := tabsMorph color. - tabsMorph delete]. - tabsMorph := IndexTabs new. - self addMorphFront: tabsMorph. - color1 ifNotNil: - [tabsMorph highlightColor: color1 regularColor: color2; color: color3]. - currentPage ifNotNil: - [currentPage delete. - currentPage := nil]. - tabsList do: - [:aTab | | itsBook | - tabsMorph addTab: aTab. - aTab unHighlight. - (itsBook := aTab morphToInstall) ifNotNil: - [pages add: itsBook. - currentPage ifNil: [currentPage := itsBook]]]. - tabsMorph position: self position + self borderWidth! Item was removed: - ----- Method: TabbedPalette>>recolorTabs (in category 'misc menu items') ----- - recolorTabs - "Prompt the user for new on and off colors for tabs" - - | onColor offColor | - self inform: 'Choose the ''on'' color'. - onColor := Color fromUser. - - self inform: - 'Okay, now please choose - the ''off'' color'. - offColor := Color fromUser. - - tabsMorph highlightColor: onColor regularColor: offColor. - currentPage ifNotNil: - [tabsMorph highlightTabFor: currentPage]! Item was removed: - ----- Method: TabbedPalette>>replaceSubmorph:by: (in category 'submorphs - add/remove') ----- - replaceSubmorph: oldMorph by: newMorph - super replaceSubmorph: oldMorph by: newMorph. - oldMorph == currentPage ifTrue: - [currentPage := newMorph]! Item was removed: - ----- Method: TabbedPalette>>scrapsBook (in category 'scraps tab') ----- - scrapsBook - ^ pages detect: [:p | p hasProperty: #scraps] ifNone: [nil]! Item was removed: - ----- Method: TabbedPalette>>selectTab: (in category 'user-interface') ----- - selectTab: aTab - | currentPalette morphToInstall oldTab aSketchEditor | - currentPage ifNotNil: - [self currentPalette currentPlayerDo: - [:aPlayer | aPlayer runAllClosingScripts]]. - oldTab := tabsMorph highlightedTab. - (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) - ifTrue: - [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: - [aSketchEditor cancelOutOfPainting]. - morphToInstall delete]. - - tabsMorph selectTab: aTab. - morphToInstall := aTab morphToInstall. - - (morphToInstall isKindOf: PaintBoxMorph) "special case, maybe generalize this need?" - ifFalse: - [self goToPageMorph: morphToInstall] - ifTrue: - [self showNoPaletteAndHighlightTab: aTab. - self world addMorphFront: morphToInstall. - morphToInstall position: ((self left max: 90) "room for the pop-out-to-left panel" - @ (tabsMorph bottom))]. - - (currentPalette := self currentPalette) ifNotNil: - [currentPalette layoutChanged. - currentPalette currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts]]. - self snapToEdgeIfAppropriate! Item was removed: - ----- Method: TabbedPalette>>selectTabNamed: (in category 'user-interface') ----- - selectTabNamed: aName - "If the receiver has a tab with the given name, select it" - - | aTab | - aTab := self tabNamed: aName. - aTab ifNotNil: [self selectTab: aTab]! Item was removed: - ----- Method: TabbedPalette>>selectTabOfBook: (in category 'user-interface') ----- - selectTabOfBook: aBook - self tabMorphs do: - [:aTab | aTab morphToInstall == aBook ifTrue: [^ self selectTab: aTab]]! Item was removed: - ----- Method: TabbedPalette>>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 setExtentFromHalo: ((anExtent x @ (anExtent y - (self innerBounds height - currentPage height))) - (2 * (self borderWidth @ self borderWidth))). - self maintainsUniformPageSize ifTrue: - [self setProperty: #uniformPageSize toValue: currentPage extent]]! Item was removed: - ----- Method: TabbedPalette>>setInitialState (in category 'initialization') ----- - setInitialState - super setInitialState. - "" - self layoutInset: 0. - pageSize := 156 @ 232! Item was removed: - ----- Method: TabbedPalette>>showNoPalette (in category 'misc menu items') ----- - showNoPalette - self showNoPaletteAndHighlightTab: nil! Item was removed: - ----- Method: TabbedPalette>>showNoPaletteAndHighlightTab: (in category 'misc menu items') ----- - showNoPaletteAndHighlightTab: aTab - - | oldTab morphToInstall aSketchEditor | - oldTab := tabsMorph highlightedTab. - (oldTab notNil and: [(morphToInstall := oldTab morphToInstall) isKindOf: PaintBoxMorph]) - ifTrue: - [(aSketchEditor := self world submorphOfClass: SketchEditorMorph) ifNotNil: - [aSketchEditor cancelOutOfPainting]. - morphToInstall delete]. - - currentPage ifNotNil: [currentPage delete]. - currentPage := nil. - submorphs size > 1 ifTrue: "spurious submorphs, yecch" - [(submorphs copyFrom: 2 to: submorphs size) do: [:m | m delete]]. - tabsMorph highlightTab: aTab! Item was removed: - ----- Method: TabbedPalette>>showScrapsTab (in category 'scraps tab') ----- - showScrapsTab - self selectTabOfBook: self scrapsBook! Item was removed: - ----- Method: TabbedPalette>>sortTabs: (in category 'misc menu items') ----- - sortTabs: evt - TabSorterMorph new sortTabsFor: self. "it directly replaces me" - self delete - ! Item was removed: - ----- Method: TabbedPalette>>tabMorphs (in category 'user-interface') ----- - tabMorphs - ^ tabsMorph tabMorphs! Item was removed: - ----- Method: TabbedPalette>>tabNamed: (in category 'user-interface') ----- - tabNamed: aName - "Answer the tab of the given name, or nil if none" - - ^ self tabMorphs detect: [:m | ((m isKindOf: StringMorph) and: [m contents = aName]) - or: [(m isKindOf: ReferenceMorph) and: [(m firstSubmorph isKindOf: StringMorph) and: - [m firstSubmorph contents = aName]]]] ifNone: [nil]! Item was removed: - ----- Method: TabbedPalette>>tabsMorph (in category 'miscellaneous') ----- - tabsMorph - ^ tabsMorph! Item was removed: - ----- Method: TabbedPalette>>transitionSpecFor: (in category 'navigation') ----- - transitionSpecFor: aMorph - ^ aMorph valueOfProperty: #transitionSpec " check for special propety" - ifAbsent: [Array with: 'silence' " ... otherwise this is the default" - with: #none - with: #none]! Item was removed: - ----- Method: TabbedPalette>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - (tabsMorph bounds containsPoint: (self pointFromWorld: evt cursorPoint)) - ifTrue: [^false "unless it's a book, perhaps, someday"]. - ^currentPage isNil or: [currentPage wantsDroppedMorph: aMorph event: evt]! Item was removed: - PolygonMorph subclass: #TetrisPieceMorph - instanceVariableNames: '' - classVariableNames: 'Colors Shapes Vertices' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !TetrisPieceMorph commentStamp: 'ct 10/1/2019 23:34' prior: 0! - I display a Tetris piece. By calling TetrisPieceMorph random, you can generate a new instance of me that is random in terms of shape, color, and rotation. - - My shapes are: #(i j l o s t z).! Item was removed: - ----- Method: TetrisPieceMorph class>>initialize (in category 'class initialization') ----- - initialize - - super initialize. - Vertices := Dictionary new - at: #i put: { 0 @ 0. 0 @ 4. 1 @ 4. 1 @ 0 }; - at: #j put: { 1 @ 0. 1 @ 2. 0 @ 2. 0 @ 3. 2 @ 3. 2 @ 0 }; - at: #o put: { 0 @ 0. 0 @ 2. 2 @ 2. 2 @ 0 }; - at: #s put: { 0 @ 0. 0 @ 2. 1 @ 2. 1 @ 3. 2 @ 3. 2 @ 1. 1 @ 1. 1 @ 0 }; - at: #t put: { 1 @ 0. 1 @ 1. 0 @ 1. 0 @ 2. 3 @ 2. 3 @ 1. 2 @ 1. 2 @ 0 }; - yourself. - Vertices - at: #l put: ((Vertices at: #j) * (-1 @ 1)); - at: #z put: ((Vertices at: #s) * (-1 @ 1)). - Shapes := Vertices keys. - Colors := #(red green blue orange grape yellow) - collect: [:color | color -> (Color in: color) lighter paler] - as: Dictionary.! Item was removed: - ----- Method: TetrisPieceMorph class>>random (in category 'instance creation') ----- - random - "TetrisPieceMorph random openInHand" - - ^ self - shape: Shapes atRandom - color: Colors atRandom - rotationDegrees: Random new next * 360! Item was removed: - ----- Method: TetrisPieceMorph class>>shape:color:rotationDegrees: (in category 'instance creation') ----- - shape: aShapeSymbol color: aColor rotationDegrees: degrees - - ^ self new - shape: aShapeSymbol; - color: aColor; - rotationDegrees: degrees; - yourself! Item was removed: - ----- Method: TetrisPieceMorph>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - self borderStyle: (RaisedBorder new width: 3).! Item was removed: - ----- Method: TetrisPieceMorph>>shape: (in category 'initialize-release') ----- - shape: aShapeSymbol - - self setVertices: (Vertices at: aShapeSymbol) * 20 * RealEstateAgent scaleFactor.! Item was removed: - ----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" - - ^ { - DescriptionForPartsBin - formalName: 'Text (border)' translatedNoop - categoryList: #() - documentation: 'A text field with border' translatedNoop - globalReceiverSymbol: #TextMorph - nativitySelector: #borderedPrototype. - - " DescriptionForPartsBin - formalName: 'Text (fancy)' translatedNoop - categoryList: {'Text' translatedNoop} - documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop - globalReceiverSymbol: #TextMorph - nativitySelector: #fancyPrototype." - - DescriptionForPartsBin - formalName: 'Text' translatedNoop - categoryList: {'Basic' translatedNoop} - documentation: - 'A raw piece of text which you can edit into anything you want' translatedNoop - globalReceiverSymbol: #TextMorph - nativitySelector: #nonwrappingPrototype. - } - ! Item was removed: - ----- Method: TextMorph>>getCharacters (in category '*MorphicExtras-accessing') ----- - getCharacters - "obtain a string value from the receiver" - - ^ self text string copy! Item was removed: - ----- Method: TextMorph>>updateReferencesUsing: (in category '*MorphicExtras-copying') ----- - updateReferencesUsing: refDict - | anchors | - super updateReferencesUsing: refDict. - "Update any anchors in the text of a newly copied morph" - anchors := IdentityDictionary new. - text runs withStartStopAndValueDo: - [:start :stop :attributes | - attributes do: [:att | (att isMemberOf: TextAnchor) - ifTrue: [anchors at: att put: (start to: stop)]]]. - anchors isEmpty ifTrue: [^ self]. - anchors keysDo: - [:old | | range new | - range := anchors at: old. - text removeAttribute: old from: range first to: range last. - new := TextAnchor new anchoredMorph: - (refDict at: old anchoredMorph). - text addAttribute: new from: range first to: range last]. - self layoutChanged "for good measure"! Item was removed: - NewParagraph subclass: #TextOnCurve - instanceVariableNames: 'lastCharacterIndex curve' - classVariableNames: 'CachedWarpColor CachedWarpDepth CachedWarpMap' - poolDictionaries: '' - category: 'MorphicExtras-Text Support'! - - !TextOnCurve commentStamp: '<historical>' prior: 0! - This subclass of Paragraph composes and displays text along a segmented line or curve. It does this by using all the normal text composition machinery, but just to lay text out for each segment of the curve in question. The display process is somewhat complicated, as it involves rotating the text for each segment, and then merging it into the destination Form with background, selection highlight, and transparency all handled correctly. - - Because TextMorph flushes its paragraph to save space, the enduring specification of curve layout (direction, baseline, and margin) must be stored in the container.! Item was removed: - ----- Method: TextOnCurve class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Flush caches" - - self reset.! Item was removed: - ----- Method: TextOnCurve class>>reset (in category 'accessing') ----- - reset - "TextOnCurve reset" - CachedWarpMap := CachedWarpDepth := CachedWarpColor := nil! Item was removed: - ----- Method: TextOnCurve>>adjustRightX (in category 'private') ----- - adjustRightX - "No-op for this class. TextOnCurve have computes bounds differently"! Item was removed: - ----- Method: TextOnCurve>>adjustRightXDownTo: (in category 'private') ----- - adjustRightXDownTo: minWidth - "No-op for this class. TextOnCurve have computes bounds differently"! Item was removed: - ----- Method: TextOnCurve>>asParagraphForPostscript (in category 'display') ----- - asParagraphForPostscript - - ^ self as: TextOnCurvePS! Item was removed: - ----- Method: TextOnCurve>>characterBlockAtPoint: (in category 'selection') ----- - characterBlockAtPoint: aPoint - "Answer a CharacterBlock for the character in the text at aPoint." - | curvePoint cb | - self textSegmentsDo: - [:line :destRect :segStart :segAngle | | sourcePoint | - (destRect containsPoint: aPoint) ifTrue: - ["It's in the destRect; now convert to source coords" - sourcePoint := self pointInLine: line forDestPoint: aPoint - segStart: segStart segAngle: segAngle. - cb := (CharacterBlockScanner new text: text textStyle: textStyle) - characterBlockAtPoint: (sourcePoint adhereTo: line rectangle) - index: nil in: line. - (sourcePoint x between: line left and: line right) ifTrue: - ["Definitely in this segment" - ^ cb]]]. - "Point is off curve -- try again with closest point on curve" - curvePoint := curve closestPointTo: aPoint. - curvePoint = aPoint ifFalse: - [^ self characterBlockAtPoint: curvePoint]. - "If all else fails, at least return something acceptable." - ^ cb ifNil: [self defaultCharacterBlock]! Item was removed: - ----- Method: TextOnCurve>>composeAll (in category 'composition') ----- - composeAll - self composeLinesFrom: firstCharacterIndex - withLines: OrderedCollection new - atY: container top.! Item was removed: - ----- Method: TextOnCurve>>composeLinesFrom:to:delta:into:priorLines:atY: (in category 'composition') ----- - composeLinesFrom: start to: stop delta: delta into: newLines priorLines: priorLines - atY: startingY - - ^ self composeLinesFrom: start withLines: newLines atY: startingY! Item was removed: - ----- Method: TextOnCurve>>composeLinesFrom:withLines:atY: (in category 'composition') ----- - composeLinesFrom: startingIndex withLines: startingLines atY: startingY - "Here we determine the 'lines' of text that will fit along each segment of the curve. For each line, we determine its rectangle, then the dest wuadrilateral that it willbe rotated to. Then, we take the outer hull to determine a dest rectangle for WarpBlt. In addition we need the segment pivot point and angle, from which the source quadrilateral may be computed." - - | charIndex scanner line firstLine curveSegments segIndex pa pb segLen lineRect textSegments segDelta segAngle destRect destQuad i oldBounds | - (oldBounds := container bounds) ifNotNil: [curve invalidRect: oldBounds]. - charIndex := startingIndex. - lines := startingLines. - curveSegments := curve lineSegments. - container textDirection < 0 - ifTrue: - [curveSegments := curveSegments reversed - collect: [:seg | Array with: (seg second) with: seg first]]. - textSegments := OrderedCollection new. - scanner := SegmentScanner new text: text textStyle: textStyle. - segIndex := 1. "For curves, segIndex is just an index." - firstLine := true. - pa := curveSegments first first. - [charIndex <= text size and: [segIndex <= curveSegments size]] whileTrue: - [curve isCurve ifFalse: [pa := (curveSegments at: segIndex) first]. - pb := (curveSegments at: segIndex) last. - segDelta := pb - pa. "Direction of this segment" - segLen := segDelta r. - lineRect := 0 @ 0 extent: segLen asInteger @ textStyle lineGrid. - line := scanner - composeFrom: charIndex - inRectangle: lineRect - firstLine: firstLine - leftSide: true - rightSide: true. - line setRight: scanner rightX. - line width > 0 - ifTrue: - [lines addLast: line. - segAngle := segDelta theta. - destQuad := line rectangle corners collect: - [:p | - (p translateBy: pa - (0 @ (line baseline + container baseline))) - rotateBy: segAngle negated - about: pa]. - destRect := Rectangle encompassing: destQuad. - textSegments addLast: (Array - with: destRect truncated - with: pa - with: segAngle). - pa := pa + ((pb - pa) * line width / segLen). - charIndex := line last + 1]. - segIndex := segIndex + 1. - firstLine := false]. - lines isEmpty - ifTrue: - ["No space in container or empty text" - - line := (TextLine - start: startingIndex - stop: startingIndex - 1 - internalSpaces: 0 - paddingWidth: 0) - rectangle: (0 @ 0 extent: 10 @ textStyle lineGrid); - lineHeight: textStyle lineGrid baseline: textStyle baseline. - lines := Array with: line. - textSegments addLast: (Array - with: (curve vertices first extent: line rectangle extent) - with: curve vertices first - with: 0.0)]. - "end of segments, now attempt word break." - lines last last < text size - ifTrue: - [ - [lines size > 1 - and: [(text at: (i := lines last last) + 1) ~= Character space]] - whileTrue: - [i = lines last first - ifTrue: - [lines removeLast. - textSegments removeLast] - ifFalse: [lines last stop: i - 1]]]. - lines := lines asArray. - container textSegments: textSegments asArray. - curve invalidRect: container bounds. - ^maxRightX! Item was removed: - ----- Method: TextOnCurve>>containsPoint: (in category 'selection') ----- - containsPoint: aPoint - "Return true if aPoint is in the actual text areas." - self textSegmentsDo: - [:line :destRect :segStart :segAngle | - (destRect containsPoint: aPoint) ifTrue: - ["It's in the destRect; now check if really in text area" - (line rectangle containsPoint: - (self pointInLine: line forDestPoint: aPoint - segStart: segStart segAngle: segAngle)) - ifTrue: [^ true]]]. - ^ false! Item was removed: - ----- Method: TextOnCurve>>displayOn:using:at: (in category 'display') ----- - displayOn: aCanvas using: displayScanner at: somePosition - "Send all visible lines to the displayScanner for display" - | warp lineRect lineCanvas backgroundColor lineForm leftInRun sourceQuad maxExtent | - "most of these temps are initialized lazily and need to be at the method level - do not move into the block below!!" - warp := nil. - self textSegmentsDo: - [:line :destRect :segStart :segAngle | - false ifTrue: - ["Show the dest rects for debugging..." - aCanvas frameRectangle: destRect width: 1 color: Color black]. - (aCanvas isVisible: destRect) ifTrue: - [warp ifNil: - ["Lazy initialization because may not have to display at all." - maxExtent := lines inject: lines first rectangle extent - into: [:maxWid :lin | maxWid max: lin rectangle extent]. - lineForm := Form extent: maxExtent depth: aCanvas depth. - displayScanner setDestForm: lineForm. - lineRect := lineForm boundingBox. - leftInRun := 0. - backgroundColor := (curve borderWidth > 10 - ifTrue: [curve color] - ifFalse: [curve owner isHandMorph - ifTrue: [curve owner owner color] - ifFalse: [curve owner color]]) dominantColor. - warp := (aCanvas warpFrom: lineRect corners toRect: lineRect) - cellSize: 2; "installs a colormap if smoothing > 1" - sourceForm: lineForm. - warp colorMap: (self warpMapForDepth: aCanvas depth - withTransparentFor: backgroundColor). - lineCanvas := lineForm getCanvas]. - sourceQuad := destRect innerCorners collect: - [:p | self pointInLine: line forDestPoint: p - segStart: segStart segAngle: segAngle]. - lineForm fill: lineForm boundingBox fillColor: backgroundColor. - self displaySelectionInLine: line on: lineCanvas. - leftInRun := displayScanner displayLine: line offset: 0 at 0 leftInRun: leftInRun. - warp sourceQuad: sourceQuad destRect: (destRect translateBy: aCanvas origin). - warp warpBits]]. - ! Item was removed: - ----- Method: TextOnCurve>>extent (in category 'accessing') ----- - extent - ^ curve bounds extent! Item was removed: - ----- Method: TextOnCurve>>moveBy: (in category 'private') ----- - moveBy: delta - positionWhenComposed := (positionWhenComposed ifNil: [ container origin ]) + delta. - container := container translateBy: delta - ! Item was removed: - ----- Method: TextOnCurve>>pointInLine:forDestPoint:segStart:segAngle: (in category 'private') ----- - pointInLine: line forDestPoint: p segStart: segStart segAngle: segAngle - ^ (p rotateBy: segAngle about: segStart) - translateBy: (0@(line baseline + container baseline)) - segStart! Item was removed: - ----- Method: TextOnCurve>>releaseCachedState (in category 'caching') ----- - releaseCachedState - super releaseCachedState. - CachedWarpMap := CachedWarpDepth := CachedWarpColor := nil! Item was removed: - ----- Method: TextOnCurve>>selectionRectsFrom:to: (in category 'selection') ----- - selectionRectsFrom: characterBlock1 to: characterBlock2 - "Return an array of rectangles encompassing the area - between the two character blocks, presumably a selection." - | rects | - rects := OrderedCollection new. - self textSegmentsDo: - [:line :destRect :segStart :segAngle | - (characterBlock1 stringIndex <= line last - and: [characterBlock2 stringIndex >= line first]) ifTrue: - [rects addLast: destRect]. - line first > characterBlock2 stringIndex ifTrue: - [^ rects]]. - ^ rects! Item was removed: - ----- Method: TextOnCurve>>textOwner: (in category 'accessing') ----- - textOwner: theCurve - curve := theCurve! Item was removed: - ----- Method: TextOnCurve>>textSegmentsDo: (in category 'private') ----- - textSegmentsDo: blockForLineDestPivotAngle - | segments segSpec | - (segments := container textSegments) ifNil: [^self]. - 1 to: lines size - do: - [:i | - segSpec := segments at: i. - blockForLineDestPivotAngle - value: (lines at: i) - value: (segSpec first) - value: (segSpec second) - value: (segSpec third)]! Item was removed: - ----- Method: TextOnCurve>>warpMapForDepth:withTransparentFor: (in category 'private') ----- - warpMapForDepth: destDepth withTransparentFor: bkgndColor - (CachedWarpDepth = destDepth and: [CachedWarpColor = bkgndColor]) - ifTrue: - ["Map is OK as is -- return it" - - ^CachedWarpMap]. - (CachedWarpMap isNil or: [CachedWarpDepth ~= destDepth]) - ifTrue: - ["Have to recreate the map" - - CachedWarpMap := Color computeColormapFrom: 32 to: destDepth. - CachedWarpDepth := destDepth] - ifFalse: - ["Map is OK, if we restore prior color substiution" - - CachedWarpMap at: (CachedWarpColor indexInMap: CachedWarpMap) - put: (CachedWarpColor pixelValueForDepth: destDepth)]. - "Now map the background color into transparent, and return the new map" - CachedWarpColor := bkgndColor. - CachedWarpMap at: (CachedWarpColor indexInMap: CachedWarpMap) put: 0. - ^CachedWarpMap! Item was removed: - Object subclass: #TextOnCurveContainer - instanceVariableNames: 'baseline inset textDirection textSegments' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Text Support'! - - !TextOnCurveContainer commentStamp: 'ct 12/2/2021 21:52' prior: 0! - I am not really a container in the sense of TextContainer. However, I get stored in the same field of a textMorph. My baseline specifies the vertical displacement of the character baselines from the curve center (0 means on center, 5 would mean, eg, the character baselines are 5 pixels above the curve center). This is essential enduring information. I also cache temporary layout information, including the locations, angles and bounding boxes of each of the characters as displayed.! Item was removed: - ----- Method: TextOnCurveContainer>>baseline (in category 'accessing') ----- - baseline - baseline ifNil: [^ 0]. - ^ baseline! Item was removed: - ----- Method: TextOnCurveContainer>>baseline: (in category 'accessing') ----- - baseline: newBaseline - baseline := newBaseline! Item was removed: - ----- Method: TextOnCurveContainer>>bounds (in category 'accessing') ----- - bounds - textSegments ifNil: [^nil]. - ^textSegments inject: (textSegments first first) - into: [:bnd :each | bnd merge: (each first)]! Item was removed: - ----- Method: TextOnCurveContainer>>paragraphClass (in category 'accessing') ----- - paragraphClass - ^ TextOnCurve! Item was removed: - ----- Method: TextOnCurveContainer>>releaseCachedState (in category 'caching') ----- - releaseCachedState - textSegments := nil.! Item was removed: - ----- Method: TextOnCurveContainer>>textDirection (in category 'accessing') ----- - textDirection - ^ textDirection! Item was removed: - ----- Method: TextOnCurveContainer>>textDirection: (in category 'accessing') ----- - textDirection: plusOrMinusOne - textDirection := plusOrMinusOne! Item was removed: - ----- Method: TextOnCurveContainer>>textSegments (in category 'accessing') ----- - textSegments - ^ textSegments! Item was removed: - ----- Method: TextOnCurveContainer>>textSegments: (in category 'accessing') ----- - textSegments: segments - textSegments := segments! Item was removed: - ----- Method: TextOnCurveContainer>>top (in category 'accessing') ----- - top - ^ 1 "for compatibility"! Item was removed: - ----- Method: TextOnCurveContainer>>translateBy: (in category 'transforming') ----- - translateBy: delta - textSegments isNil ifTrue: [^self]. - textSegments := textSegments collect: - [:ls | - Array - with: (ls first translateBy: delta) - with: (ls second translateBy: delta) - with: ls third]! Item was removed: - TextOnCurve subclass: #TextOnCurvePS - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Text Support'! Item was removed: - ----- Method: TextOnCurvePS>>displayOn:using:at: (in category 'display') ----- - displayOn: aCanvas using: displayScanner at: somePosition - "Send all visible lines to the displayScanner for display" - - self textSegmentsDo: - [:line :destRect :segStart :segAngle | - self displaySelectionInLine: line on: aCanvas. - line first <= line last ifTrue: - [displayScanner displayLine: line offset: destRect topLeft leftInRun: 999]] - - ! Item was removed: - TextAction subclass: #TextPlusJumpEnd - instanceVariableNames: 'jumpLabel' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: TextPlusJumpEnd>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - - "none for me, thanks"! Item was removed: - ----- Method: TextPlusJumpEnd>>jumpLabel (in category 'accessing') ----- - jumpLabel - - ^jumpLabel! Item was removed: - ----- Method: TextPlusJumpEnd>>jumpLabel: (in category 'accessing') ----- - jumpLabel: aString - - jumpLabel := aString! Item was removed: - TextAction subclass: #TextPlusJumpStart - instanceVariableNames: 'jumpLabel' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: TextPlusJumpStart>>actOnClickFor: (in category 'mouse events') ----- - actOnClickFor: model - "Subclasses may override to provide, eg, hot-spot actions" - - model doJumpTo: jumpLabel. - ^ true! Item was removed: - ----- Method: TextPlusJumpStart>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Set the emphasist for text scanning" - scanner addEmphasis: 4! Item was removed: - ----- Method: TextPlusJumpStart>>jumpLabel (in category 'accessing') ----- - jumpLabel - - ^jumpLabel! Item was removed: - ----- Method: TextPlusJumpStart>>jumpLabel: (in category 'accessing') ----- - jumpLabel: aString - - jumpLabel := aString! Item was removed: - TextMorph subclass: #TextPlusMorph - instanceVariableNames: 'scrollerOwner ignoreNextUp' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: TextPlusMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^ false! Item was removed: - ----- Method: TextPlusMorph>>addAlansAnchorFor: (in category 'menus') ----- - addAlansAnchorFor: aMorph - - | ed attribute selRects | - - self removeAlansAnchorFor: aMorph. - ed := self editor. - attribute := TextAnchor new anchoredMorph: aMorph. - aMorph setProperty: #geeMailLeftOffset toValue: aMorph left - self left. - ed replaceSelectionWith: (ed selection addAttribute: attribute). - selRects := self paragraph selectionRects. - selRects isEmpty ifFalse: [ - aMorph top: selRects first top - ]. - self releaseParagraphReally. - self layoutChanged. - - ! Item was removed: - ----- Method: TextPlusMorph>>addColumnBreak (in category 'menus') ----- - addColumnBreak - - | ed old new break | - - ed := self editor. - old := ed selection. - break := Character characterForColumnBreak asString. - break := Text string: break attributes: {}. - new := old ,break. - ed replaceSelectionWith: new. - self releaseParagraphReally. - self layoutChanged. - - ! Item was removed: - ----- Method: TextPlusMorph>>addItem: (in category 'add/remove') ----- - addItem: classAndMethod - "Make a linked message list and put this method in it" - - Model new addItem: classAndMethod "let him do all the work"! Item was removed: - ----- Method: TextPlusMorph>>addJumpBeginning (in category 'menus') ----- - addJumpBeginning - - | ed attribute jumpEnd mySelection a1 ax | - - ed := self editor. - (mySelection := ed selection) isEmpty ifTrue: [^self inform: 'Please select something first']. - jumpEnd := self chooseOneJumpEnd. - jumpEnd isEmptyOrNil ifTrue: [^self]. - - attribute := TextPlusJumpStart new jumpLabel: jumpEnd. - a1 := (mySelection attributesAt: 1) reject: [ :each | each isKindOf: TextPlusJumpStart]. - ax := (mySelection attributesAt: mySelection size) reject: [ :each | each isKindOf: TextPlusJumpStart]. - ed replaceSelectionWith: - (Text string: '*' attributes: a1), - (mySelection addAttribute: attribute), - (Text string: '*' attributes: ax). - self releaseParagraphReally. - self layoutChanged. - - ! Item was removed: - ----- Method: TextPlusMorph>>addJumpEnd (in category 'menus') ----- - addJumpEnd - - | ed attribute jumpLabel selectedString | - - ed := self editor. - selectedString := ed selection asString. - selectedString isEmpty ifTrue: [^self inform: 'Please select something first']. - jumpLabel := UIManager default request: 'Name this place' initialAnswer: selectedString. - jumpLabel isEmpty ifTrue: [^self]. - self removeJumpEndFor: jumpLabel. - attribute := TextPlusJumpEnd new jumpLabel: jumpLabel. - ed replaceSelectionWith: (ed selection addAttribute: attribute). - - ! Item was removed: - ----- Method: TextPlusMorph>>addSuccessor: (in category 'linked frames') ----- - addSuccessor: evt - - evt hand attachMorph: self makeSuccessorMorph! Item was removed: - ----- Method: TextPlusMorph>>allJumpEndStrings (in category 'private - menus') ----- - allJumpEndStrings - - | answer | - - answer := OrderedCollection new. - text runs withStartStopAndValueDo: [:start :stop :attributes | - attributes do: [:att | - (att isMemberOf: TextPlusJumpEnd) ifTrue: [ - (answer includes: att jumpLabel) ifFalse: [answer add: att jumpLabel]. - ] - ] - ]. - ^answer - - ! Item was removed: - ----- Method: TextPlusMorph>>chooseOneJumpEnd (in category 'private - menus') ----- - chooseOneJumpEnd - - ^UIManager default - chooseFrom: self allJumpEndStrings - values: self allJumpEndStrings - title: 'Possible jump ends'. - - ! Item was removed: - ----- Method: TextPlusMorph>>convertToCurrentVersion:refStream: (in category 'objects from disk') ----- - convertToCurrentVersion: varDict refStream: smartRefStrm - "Fix up misaligned entries from varDict in old project" - varDict at: 'slotName' ifPresent: [ :x | text:= x]. "Not sure why the text is in 'slotName'" - varDict at: 'model' ifPresent: [ :x | textStyle:= x]."Or why textStyle is in 'model'" - self releaseParagraphReally. - ^ super convertToCurrentVersion: varDict refStream: smartRefStrm. - - ! Item was removed: - ----- Method: TextPlusMorph>>doJumpTo: (in category 'jumping') ----- - doJumpTo: aString - - | myStart myStop | - myStart := myStop := nil. - text runs withStartStopAndValueDo: [:start :stop :attributes | - attributes do: [:att | - ((att isMemberOf: TextPlusJumpEnd) and: [att jumpLabel = aString]) ifTrue: [ - myStart - ifNil: [myStart := start. myStop := stop] - ifNotNil: [myStart := myStart min: start. myStop := myStop max: stop]. - ] - ] - ]. - myStart ifNil: [^self]. - - self editor selectFrom: myStart to: myStop. - ignoreNextUp := true. - self changed. - self scrollSelectionToTop. - ! Item was removed: - ----- Method: TextPlusMorph>>doYellowButtonPress: (in category 'menus') ----- - doYellowButtonPress: evt - - | menu | - - menu := MenuMorph new. - menu - add: 'Go to top of document' action: [self jumpToDocumentTop]; - add: 'Move selection to top of page' action: [self scrollSelectionToTop]; - add: 'Add column break' action: [self addColumnBreak]; - add: 'Define as jump start' action: [self addJumpBeginning]; - add: 'Define as jump end' action: [self addJumpEnd]. - menu title: 'Text navigation options'. - menu invokeModal. - ! Item was removed: - ----- Method: TextPlusMorph>>fixAllLeftOffsets (in category 'private - linked frames') ----- - fixAllLeftOffsets - - - - text runs withStartStopAndValueDo: [:start :stop :attributes | - attributes do: [:att | | am | - (att isMemberOf: TextAnchor) ifTrue: [ - am := att anchoredMorph. - (am isNil or: [am world isNil]) ifFalse: [ - am - valueOfProperty: #geeMailLeftOffset - ifAbsent: [ - am setProperty: #geeMailLeftOffset toValue: am left - self left - ] - ] - ] - ] - ]. - - ! Item was removed: - ----- Method: TextPlusMorph>>handleInteraction:fromEvent: (in category 'editing') ----- - handleInteraction: interactionBlock fromEvent: evt - - super handleInteraction: interactionBlock fromEvent: evt. - (self parentGeeMail ifNil: [^self]) - scrollSelectionIntoView: evt - alignTop: false - inTextMorph: self. - ! Item was removed: - ----- Method: TextPlusMorph>>jumpToDocumentTop (in category 'jumping') ----- - jumpToDocumentTop - - self editor selectFrom: 1 to: 0. - self changed. - self scrollSelectionToTop. - ! Item was removed: - ----- Method: TextPlusMorph>>keyboardFocusChange: (in category 'event handling') ----- - keyboardFocusChange: aBoolean - - | parent | - - "we basically ignore loss of focus unless it is going to one of our siblings" - aBoolean ifFalse: [^self]. - - paragraph isNil ifFalse:[paragraph focused: aBoolean]. - - "A hand is wanting to send us characters..." - self hasFocus ifFalse: [self editor "Forces install"]. - - "Inform our siblings we have taken the focus" - parent := self parentGeeMail ifNil: [^self]. - parent allTextPlusMorphs do: [ :each | - each == self ifFalse: [each keyboardFocusLostForSure] - ]. - - ! Item was removed: - ----- Method: TextPlusMorph>>keyboardFocusLostForSure (in category 'private') ----- - keyboardFocusLostForSure - - editor ifNotNil: [ - self selectionChanged. - self paragraph selectionStart: nil selectionStop: nil. - editor := nil - ]. - - - ! Item was removed: - ----- Method: TextPlusMorph>>linkNewlyDroppedMorph: (in category 'private') ----- - linkNewlyDroppedMorph: aMorph - - | ed para lineToUse | - - ed := self editor. - para := self paragraph. - lineToUse := para lines detect: [ :each | each bottom > aMorph top] ifNone: [para lines last]. - ed selectFrom: lineToUse first to: lineToUse last. - self addAlansAnchorFor: aMorph. - - ! Item was removed: - ----- Method: TextPlusMorph>>makeSuccessorMorph (in category 'private - linked frames') ----- - makeSuccessorMorph - - | newMorph | - self fixAllLeftOffsets. - newMorph := self copy predecessor: self successor: successor. - newMorph extent: self width @ 100. - successor ifNotNil: [successor setPredecessor: newMorph]. - self setSuccessor: newMorph. - successor recomposeChain. - ^newMorph! Item was removed: - ----- Method: TextPlusMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - ignoreNextUp := false. - evt yellowButtonPressed ifTrue: [ - ^self doYellowButtonPress: evt - ]. - ^super mouseDown: evt - ! Item was removed: - ----- Method: TextPlusMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - ignoreNextUp == true ifTrue: [^self]. - ^super mouseMove: evt - ! Item was removed: - ----- Method: TextPlusMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - ignoreNextUp == true ifTrue: [ignoreNextUp := false. ^self]. - ^super mouseUp: evt - ! Item was removed: - ----- Method: TextPlusMorph>>parentGeeMail (in category 'private') ----- - parentGeeMail - - ^self ownerThatIsA: GeeMailMorph - ! Item was removed: - ----- Method: TextPlusMorph>>predecessorChanged (in category 'private') ----- - predecessorChanged - - super predecessorChanged. - self repositionAnchoredMorphs. - ! Item was removed: - ----- Method: TextPlusMorph>>recomposeChain (in category 'linked frames') ----- - recomposeChain - "Recompose this textMorph and all that follow it." - self withSuccessorsDo: - [:m | m text: text textStyle: textStyle; "Propagate new style if any" - releaseParagraphReally; "Force recomposition" - fit "and propagate the change"] - ! Item was removed: - ----- Method: TextPlusMorph>>releaseEditor (in category 'private') ----- - releaseEditor! Item was removed: - ----- Method: TextPlusMorph>>releaseParagraph (in category 'private') ----- - releaseParagraph! Item was removed: - ----- Method: TextPlusMorph>>releaseParagraphReally (in category 'private') ----- - releaseParagraphReally - "Paragraph instantiation is lazy -- it will be created only when needed" - - editor ifNotNil: [ - self selectionChanged. - self paragraph selectionStart: nil selectionStop: nil. - editor := nil]. - paragraph ifNotNil: [paragraph := nil]. - container ifNotNil: [container releaseCachedState]! Item was removed: - ----- Method: TextPlusMorph>>removeAlansAnchorFor: (in category 'menus') ----- - removeAlansAnchorFor: aMorph - - | anchors | - - anchors := OrderedCollection new. - text runs withStartStopAndValueDo: [:start :stop :attributes | - attributes do: [:att | - (att isMemberOf: TextAnchor) ifTrue: [ - (att anchoredMorph isNil or: [ - att anchoredMorph == aMorph or: [att anchoredMorph world isNil]]) ifTrue: [ - anchors add: {att. start. stop} - ] - ] - ] - ]. - anchors do: [ :old | - text removeAttribute: old first from: old second to: old third. - ]. - - ! Item was removed: - ----- Method: TextPlusMorph>>removeJumpEndFor: (in category 'private - menus') ----- - removeJumpEndFor: aString - - | anchors | - - anchors := OrderedCollection new. - text runs withStartStopAndValueDo: [:start :stop :attributes | - attributes do: [:att | - (att isMemberOf: TextPlusJumpEnd) ifTrue: [ - att jumpLabel == aString ifTrue: [ - anchors add: {att. start. stop} - ] - ] - ] - ]. - anchors do: [ :old | - text removeAttribute: old first from: old second to: old third. - ]. - - ! Item was removed: - ----- Method: TextPlusMorph>>repositionAnchoredMorphs (in category 'private') ----- - repositionAnchoredMorphs - - | firstCharacterIndex lastCharacterIndex | - - firstCharacterIndex := self paragraph firstCharacterIndex. - lastCharacterIndex := paragraph lastCharacterIndex. - text runs withStartStopAndValueDo: [:start :stop :attributes | - attributes do: [:att | | leftShift am cBlock | - (att isMemberOf: TextAnchor) ifTrue: [ - am := att anchoredMorph. - (am isNil or: [am world isNil]) ifFalse: [ - (stop between: firstCharacterIndex and: lastCharacterIndex) ifTrue: [ - cBlock := self paragraph characterBlockForIndex: stop. - leftShift := am valueOfProperty: #geeMailLeftOffset ifAbsent: [0]. - am position: (self left + leftShift) @ cBlock origin y. - ]. - ] - ] - ] - ]. - ! Item was removed: - ----- Method: TextPlusMorph>>scrollSelectionToTop (in category 'menus') ----- - scrollSelectionToTop - - (self parentGeeMail ifNil: [^self]) - scrollSelectionIntoView: nil - alignTop: true - inTextMorph: self. - ! Item was removed: - ----- Method: TextPlusMorph>>textPlusMenuFor: (in category 'menus') ----- - textPlusMenuFor: aMorph - - | menu | - menu := MenuMorph new. - menu - add: 'Link to text selection' - target: [self addAlansAnchorFor: aMorph] - selector: #value; - - add: 'Unlink from text selection' - target: [self removeAlansAnchorFor: aMorph] - selector: #value; - - add: 'Delete' - target: [ - self removeAlansAnchorFor: aMorph. - aMorph delete. - ] - selector: #value. - ^menu - ! Item was removed: - ----- Method: TextPlusMorph>>updateFromParagraph (in category 'private') ----- - updateFromParagraph - - super updateFromParagraph. - self repositionAnchoredMorphs. - ! Item was removed: - PasteUpMorph subclass: #TextPlusPasteUpMorph - instanceVariableNames: 'theTextMorph showPageBreaks' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-GeeMail'! Item was removed: - ----- Method: TextPlusPasteUpMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - - ^ false! Item was removed: - ----- Method: TextPlusPasteUpMorph>>acceptDroppingMorph:event: (in category 'layout') ----- - acceptDroppingMorph: aMorph event: evt - - | allTextPlus | - - (aMorph isKindOf: NewHandleMorph) ifTrue: [^self]. - (aMorph isKindOf: GeeBookMorph) ifTrue: [^self]. "avoid looping" - (aMorph isKindOf: TextPlusMorph) ifTrue: [ - ^self addMorphBack: aMorph. - ]. - self addMorph: aMorph. - - allTextPlus := self allTextPlusMorphs. - aMorph allMorphsDo: [ :each | - allTextPlus do: [ :e2 | e2 removeAlansAnchorFor: each]. - ]. - (self nearestTextPlusMorphTo: aMorph) linkNewlyDroppedMorph: aMorph! Item was removed: - ----- Method: TextPlusPasteUpMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu addUpdating: #showPageBreaksString action: #togglePageBreaks. - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>allTextPlusMorphs (in category 'private') ----- - allTextPlusMorphs - - ^submorphs select: [ :each | each isKindOf: TextPlusMorph] - - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>disablePageBreaksWhile: (in category 'drawing') ----- - disablePageBreaksWhile: aBlock - - | save result | - - save := showPageBreaks. - showPageBreaks := false. - result := aBlock value. - showPageBreaks := save. - ^result - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - | clip rects | - super drawOn: aCanvas. - showPageBreaks == false ifTrue: [^self]. - - clip := aCanvas clipRect. - rects := self printer pageRectangles. - rects do: [ :each | - each bottom > clip bottom ifTrue: [^self]. - aCanvas - fillRectangle: (self left @ each bottom corner: self right @ each bottom + 1) - color: Color red - ].! Item was removed: - ----- Method: TextPlusPasteUpMorph>>fullDrawForPrintingOn: (in category 'postscript canvases') ----- - fullDrawForPrintingOn: aCanvas - - self disablePageBreaksWhile: [self fullDrawOn: aCanvas]. - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>initialize (in category 'initialization') ----- - initialize - - super initialize. - showPageBreaks := true. - self addMorphBack: (TextPlusMorph new position: 4 at 4). - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>nearestTextPlusMorphTo: (in category 'private') ----- - nearestTextPlusMorphTo: aMorph - - ^self allTextPlusMorphs inject: nil into: [ :best :each | - self select: best or: each asClosestTo: aMorph - ]! Item was removed: - ----- Method: TextPlusPasteUpMorph>>printer (in category 'drawing') ----- - printer - - ^GeePrinter new - pasteUp: self; - printSpecs: self printSpecs! Item was removed: - ----- Method: TextPlusPasteUpMorph>>select:or:asClosestTo: (in category 'private') ----- - select: bestPrevious or: current asClosestTo: aMorph - - bestPrevious ifNil: [^current]. - (bestPrevious bounds intersects: aMorph bounds) ifTrue: [^bestPrevious]. - (current bounds intersects: aMorph bounds) ifTrue: [^current]. - bestPrevious left < current left ifTrue: [ - ^aMorph left < current left ifTrue: [bestPrevious] ifFalse: [current] - ]. - ^aMorph left < bestPrevious left ifTrue: [current] ifFalse: [bestPrevious] - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>showPageBreaksString (in category 'menus') ----- - showPageBreaksString - ^ (showPageBreaks - ifTrue: ['<on>'] - ifFalse: ['<off>']) - , 'show page breaks' translated! Item was removed: - ----- Method: TextPlusPasteUpMorph>>textPlusMenuFor: (in category 'menus') ----- - textPlusMenuFor: aMorph - - ^(self nearestTextPlusMorphTo: aMorph) textPlusMenuFor: aMorph - ! Item was removed: - ----- Method: TextPlusPasteUpMorph>>togglePageBreaks (in category 'menus') ----- - togglePageBreaks - - showPageBreaks := showPageBreaks not. - self changed! Item was removed: - ----- Method: TextPlusPasteUpMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - "Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. The default implementation returns false. - NOTE: the event is assumed to be in global (world) coordinates." - - (aMorph isKindOf: NewHandleMorph) ifTrue: [^false]. - (aMorph isKindOf: GeeBookMorph) ifTrue: [^false]. "avoid looping" - ^super wantsDroppedMorph: aMorph event: evt! Item was removed: - ----- Method: TheWorldMenu>>adaptToWorld: (in category '*MorphicExtras-mechanics') ----- - adaptToWorld: aWorld - - myWorld := aWorld. - myProject := nil. "figure it out if and when needed. maybe make it easier to find" - myHand := aWorld primaryHand.! Item was removed: - ----- Method: TheWorldMenu>>createStandardPartsBin (in category '*MorphicExtras-action') ----- - createStandardPartsBin - "A dead branch -- only reachable now from pre-existing menus that the user may have kept up" - - ObjectsTool newStandAlone openInHand! Item was removed: - ----- Method: TheWorldMenu>>flapsDo (in category '*MorphicExtras-windows & flaps menu') ----- - flapsDo - "Put up the flaps menu for the world." - - self doPopUp: self flapsMenu! Item was removed: - ----- Method: TheWorldMenu>>flapsMenu (in category '*MorphicExtras-windows & flaps menu') ----- - flapsMenu - "Build the flaps menu for the world." - - | aMenu | - aMenu := UpdatingMenuMorph new updater: self updateSelector: #formulateFlapsMenu:. - self formulateFlapsMenu: aMenu. - ^ aMenu! Item was removed: - ----- Method: TheWorldMenu>>formulateFlapsMenu: (in category '*MorphicExtras-windows & flaps menu') ----- - formulateFlapsMenu: aMenu - "Fill aMenu with appropriate content" - - aMenu addTitle: 'flaps' translated. - aMenu addStayUpItem. - Preferences classicNavigatorEnabled ifTrue: - [aMenu - addUpdating: #navigatorShowingString - enablementSelector: #enableProjectNavigator - target: Preferences - selector: #toggle: - argumentList: #(showProjectNavigator). - aMenu balloonTextForLastItem: (Preferences preferenceAt: #showProjectNavigator) helpString translated]. - - Flaps sharedFlapsAllowed - ifTrue: - [self fillIn: aMenu from: - {{#suppressFlapsString. - {Project current. #toggleFlapsSuppressed}. - 'Whether prevailing flaps should be shown in the project right now or not.'}}. - - aMenu addUpdating: #automaticFlapLayoutString target: Preferences selector: #toggle: argumentList: #(automaticFlapLayout). - aMenu balloonTextForLastItem: (Preferences preferenceAt: #automaticFlapLayout) helpString translated. - - aMenu addLine. - Flaps addIndividualGlobalFlapItemsTo: aMenu]. - - self fillIn: aMenu from: { - nil. - - {'make a new flap'. - {Flaps. #addLocalFlap}. - 'Create a new flap. You can later make it into a shared flap is you wish.'}. - - nil.}. - Flaps sharedFlapsAllowed - ifTrue: - [aMenu addWithLabel: 'put shared flaps on bottom' translated enablementSelector: #showSharedFlaps - target: Flaps selector: #sharedFlapsAlongBottom argumentList: #(). - aMenu balloonTextForLastItem: 'Group all the standard shared flaps along the bottom edge of the screen' translated. - - self fillIn: aMenu from: { - {'destroy all shared flaps'. - {Flaps. #disableGlobalFlaps}. - 'Destroy all the shared flaps and disable their use in all projects.'}}] - ifFalse: - [aMenu add: 'install default shared flaps' translated target: Flaps action: #enableGlobalFlaps. - aMenu balloonTextForLastItem: 'Create the default set of shared flaps' translated. - aMenu add: 'install etoy flaps' translated target: Flaps action: #enableEToyFlaps. - aMenu balloonTextForLastItem: 'Put up the default etoy flaps: a custom Suplies flap and the Navigator flap' translated. - aMenu addLine]. - - self fillIn: aMenu from: { - nil. - {'about flaps...'. - {Flaps . #explainFlaps}. - 'Gives a window full of details about how to use flaps.'}}! Item was removed: - ----- Method: TheWorldMenu>>globalFlapsEnabled (in category '*MorphicExtras-windows & flaps menu') ----- - globalFlapsEnabled - "Answer whether global flaps are enabled. Retained for the benefit of preexisting menus/butons that may call this" - - ^ Flaps sharedFlapsAllowed! Item was removed: - ----- Method: TheWorldMenu>>launchCustomPartsBin (in category '*MorphicExtras-action') ----- - launchCustomPartsBin - "A dead branch -- only reachable now from pre-existing menus that the user may have kept up" - - ObjectsTool newStandAlone openInHand! Item was removed: - ----- Method: TheWorldMenu>>myMenuColor (in category '*MorphicExtras-construction') ----- - myMenuColor - - | c | - c := myWorld color. - c isColor ifTrue: [^c atLeastAsLuminentAs: 0.2]. - ^Color white! Item was removed: - ----- Method: TheWorldMenu>>newGlobalFlapString (in category '*MorphicExtras-windows & flaps menu') ----- - newGlobalFlapString - "Answer a string for the new-global-flap item in the flap menu. Obsolete; retained momentarily for the benefit of preexisting persistent menus." - - self flag: #toRemove. - ^ 'make a new shared flap'! Item was removed: - ----- Method: TheWorldMenu>>printWorldOnFile (in category '*MorphicExtras-Postscript Canvases') ----- - printWorldOnFile - "Ask the user for a filename and print the world as postscript." - - myWorld printPSToFileNamed: 'SqueakScreen' - ! Item was removed: - ----- Method: TheWorldMenu>>toggleFlapSuppressionInProject (in category '*MorphicExtras-action') ----- - toggleFlapSuppressionInProject - "Toggle whether global flaps are suppressed in this project. Obsolete, retained for bkwrd compatibility with preexisting persistent menus." - - self flag: #toRemove. - self inform: 'This is an obsolete menu -- please delete it'! Item was removed: - RotaryDialMorph subclass: #ThermometerDialMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !ThermometerDialMorph commentStamp: 'tpr 6/29/2017 13:29' prior: 0! - A ThermometerDialMorph is a rotary thermometer; the default is to set the range to typical outdoor temperatures but of course that can be altered with the normal #startValue:stopValue: message! Item was removed: - ----- Method: ThermometerDialMorph>>buildDial (in category 'dial drawing') ----- - buildDial - "start by making a damn big Form, twice the size we want to end up with" - |outerRadius destForm canvas tickLabel tickLength beginAngle endAngle tickAngle tickLabelSize maxTicks | - outerRadius := self height - 1. - destForm := Form extent: self extent * 2 depth: 32. - (canvas := destForm getCanvas) fillOval: (0 at 0 extent: self extent * 2) color: Color white. - "outer ring" - self drawArcAt: destForm center radius: outerRadius thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - "inner ring" - self drawArcAt: destForm center radius: outerRadius * 0.97 thickness: 1 color: Color black beginAngle: 0 endAngle: 360 onForm: destForm. - - "outer scale for Fahrenheit" - beginAngle := startAngle -360. "needs cleaning up about this" - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.8 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.73 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - - maxTicks := stopValue - startValue / 5 * 9 . - tickAngle := endAngle - beginAngle / maxTicks. - (startValue / 5 * 9 +32) to: (stopValue / 5 * 9 +32) do: [:tick| - tickLength := outerRadius * 0.07. - tickLabel := nil. - tick \\ 10 = 0 ifTrue: [ - tickLabel := tick asString. - tickLabelSize := 24 - ] ifFalse: [ - tick \\ 2 = 0 ifTrue:[ - tickLabel := (tick \\ 10) asString. - tickLabelSize := 18 - ] ifFalse: [ - tickLength := tickLength * 2 - ] - ]. - self drawTickRadius: outerRadius * 0.73 length: tickLength thickness: 2 color: Color black angle: beginAngle + (tick - (startValue / 5 * 9 +32) * tickAngle) onCanvas: canvas. - self tickLabel: tickLabel fontSize: tickLabelSize color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) + tickLength angle: beginAngle + (tick - (startValue / 5 * 9 +32) * tickAngle) onCanvas: canvas. - ]. - - self tickInnerLabel: (String with: (Unicode value: 16rB0) with: $C) fontSize: 36 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) angle: 180 onCanvas: canvas. - - "inner scale for Celsius" - beginAngle := startAngle -360. "needs cleaning up about this" - endAngle := stopAngle. - - self drawArcAt: destForm center radius: outerRadius * 0.71 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - self drawArcAt: destForm center radius: outerRadius * 0.63 thickness: 1 color: Color black beginAngle:beginAngle endAngle: stopAngle onForm: destForm. - maxTicks := stopValue - startValue. - tickAngle := endAngle - beginAngle / maxTicks. - tickLength := outerRadius * 0.07. - startValue to: stopValue do: [ :tick ||tickThickness| - tickLabel := nil. - tick \\ 5 = 0 ifTrue: [ - tickLabelSize := 20. - tickThickness := 3. - tickLabel := tick asString. - ] ifFalse: [ - tickThickness := 2. - ]. - self drawTickRadius: outerRadius * 0.63 length: tickLength thickness: tickThickness color: Color black angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - self tickInnerLabel: tickLabel fontSize: tickLabelSize color: Color black centeredAt: dialCenter radius: (outerRadius * 0.63) angle: beginAngle + (tick - startValue * tickAngle) onCanvas: canvas. - - ]. - - self tickLabel: (String with: (Unicode value: 16rB0) with: $F) fontSize: 36 color: Color black centeredAt: dialCenter radius: (outerRadius * 0.73) angle: 180 onCanvas: canvas. - - self addMorph: (destForm magnify: destForm boundingBox by: 0.5 smoothing: 2) asMorph! Item was removed: - ----- Method: ThermometerDialMorph>>initialize (in category 'initialize-release') ----- - initialize - "Build a thermometer. The background is an ImageMorph showing a dial derived from the same general principles as the BarometerMorph. - The temperature scale is fixed for now at -5C to 30C but ought to be parameterised someday. We'll have the Celcius scale as the inner and a conversion to Fahrenheit as the outer" - | pointerMorph | - super initialize. - - self startAngle: -140 stopAngle: 140; - startValue: -10 stopValue: 35. - self extent: self initialExtent; color: Color transparent; borderWidth: 0. - dialCenter := self center. - - self buildDial. - - "build our fancy needle as an ImageMorph, set the position to horizontal centre and about 2/3 down so that it rotates about that point when inside the TransformationMorph" - pointerMorph := self fancyNeedleOfLength: (self height * 0.65) rounded. - pointerMorph - position: pointerMorph extent * ( -0.5@ -0.65); - rotationCenter: 0.5 @ 0.65. - - "we keep track of the TransformationMorph since that is what we have to rotate as the incoming pressure values change" - needleMorph := TransformationMorph new position: dialCenter; addMorph: pointerMorph. - self addMorph: needleMorph. - - "add a central colored dot. Because we just do." - self addMorph: (CircleMorph new extent: 20 at 20; color: Color black; center: dialCenter) - ! Item was removed: - AlignmentMorphBob1 subclass: #ThreadNavigationMorph - instanceVariableNames: 'listOfPages currentIndex loadedProject' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Navigators'! Item was removed: - ----- Method: ThreadNavigationMorph class>>example1 (in category 'examples') ----- - example1 - " - ThreadNavigationMorph example1 - " - self new - listOfPages: #( - ('ftp://209.143.91.36/Drive A Car') - ('ftp://209.143.91.36/Teachers & NewTech' 1) - ('ftp://209.143.91.36/Teachers & NewTech' 2) - ('ftp://209.143.91.36/Lander') - ); - openInWorld! Item was removed: - ----- Method: ThreadNavigationMorph>>addButtons (in category 'initialization') ----- - addButtons - - self addARow: { - self inAColumn: {self buttonFirst}. - self inAColumn: {self buttonPrevious}. - self inAColumn: {self buttonForward}. - self inAColumn: {self buttonLast}. - self inAColumn: {self buttonExit}. - }. - ! Item was removed: - ----- Method: ThreadNavigationMorph>>buttonExit (in category 'buttons') ----- - buttonExit - - ^self makeButton: 'Exit' balloonText: 'Exit the sequence' for: #exitTheSequence. - - - ! Item was removed: - ----- Method: ThreadNavigationMorph>>buttonFirst (in category 'buttons') ----- - buttonFirst - - ^self makeButton: 'First' balloonText: 'First page in sequence' for: #firstPage - ! Item was removed: - ----- Method: ThreadNavigationMorph>>buttonForward (in category 'buttons') ----- - buttonForward - - ^self makeButton: 'Forward >' balloonText: 'Next page in sequence' for: #nextPage - - ! Item was removed: - ----- Method: ThreadNavigationMorph>>buttonLast (in category 'buttons') ----- - buttonLast - - ^self makeButton: 'Last' balloonText: 'Last page in sequence' for: #lastPage - - ! Item was removed: - ----- Method: ThreadNavigationMorph>>buttonPrevious (in category 'buttons') ----- - buttonPrevious - - ^self makeButton: '< Back' balloonText: 'Previous page in sequence' for: #previousPage - ! Item was removed: - ----- Method: ThreadNavigationMorph>>colorForButtons (in category 'initialization') ----- - colorForButtons - - ^color darker! Item was removed: - ----- Method: ThreadNavigationMorph>>currentIndex (in category 'private') ----- - currentIndex - - ^currentIndex! Item was removed: - ----- Method: ThreadNavigationMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color red lighter! Item was removed: - ----- Method: ThreadNavigationMorph>>deleteCurrentPage (in category 'navigation') ----- - deleteCurrentPage - - | outerWrapper | - - loadedProject ifNil: [^self]. - outerWrapper := loadedProject world ownerThatIsA: EmbeddedWorldBorderMorph. - outerWrapper ifNil: [^self]. - outerWrapper delete. - loadedProject := nil. - - ! Item was removed: - ----- Method: ThreadNavigationMorph>>ensureSuitableDefaults (in category 'navigation') ----- - ensureSuitableDefaults - - listOfPages ifNil: [listOfPages := OrderedCollection new]. - currentIndex ifNil: [currentIndex := 0]. - - ! Item was removed: - ----- Method: ThreadNavigationMorph>>exitTheSequence (in category 'navigation') ----- - exitTheSequence - - self deleteCurrentPage. - self delete.! Item was removed: - ----- Method: ThreadNavigationMorph>>firstPage (in category 'navigation') ----- - firstPage - - listOfPages isEmpty ifTrue: [^Beeper beep]. - currentIndex := 1. - self loadPageWithProgress.! Item was removed: - ----- Method: ThreadNavigationMorph>>fontForButtons (in category 'initialization') ----- - fontForButtons - - ^TextStyle defaultFont! Item was removed: - ----- Method: ThreadNavigationMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self layoutInset: 6; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - useRoundedCorners; - ensureSuitableDefaults; - addButtons! Item was removed: - ----- Method: ThreadNavigationMorph>>lastPage (in category 'navigation') ----- - lastPage - - listOfPages isEmpty ifTrue: [^Beeper beep]. - currentIndex := listOfPages size. - self loadPageWithProgress.! Item was removed: - ----- Method: ThreadNavigationMorph>>listOfPages: (in category 'private') ----- - listOfPages: aCollection - - listOfPages := aCollection! Item was removed: - ----- Method: ThreadNavigationMorph>>makeButton:balloonText:for: (in category 'initialization') ----- - makeButton: aString balloonText: anotherString for: aSymbol - ^ SimpleButtonDelayedMenuMorph new target: self; - borderStyle: BorderStyle raised; - color: self colorForButtons; - label: aString translated font: self fontForButtons; - setBalloonText: anotherString translated; - actionSelector: aSymbol! Item was removed: - ----- Method: ThreadNavigationMorph>>morphicLayerNumber (in category 'submorphs - layers') ----- - morphicLayerNumber - - ^ self valueOfProperty: #morphicLayerNumber ifAbsent: [self class navigatorLayer]! Item was removed: - ----- Method: ThreadNavigationMorph>>navigateFromKeystroke: (in category 'navigation') ----- - navigateFromKeystroke: aChar - "A character was typed in an effort to do interproject navigation along the receiver's thread" - - | ascii | - ascii := aChar asciiValue. - (#(29 31 32) includes: ascii) ifTrue: [^self nextPage]. "right arrow, down arrow, space" - (#(8 28 30) includes: ascii) ifTrue: [^self previousPage]. "left arrow, up arrow, backspace" - (#(1) includes: ascii) ifTrue: [^self firstPage]. - (#(4) includes: ascii) ifTrue: [^self lastPage]. - Beeper beep! Item was removed: - ----- Method: ThreadNavigationMorph>>nextPage (in category 'navigation') ----- - nextPage - - self currentIndex >= listOfPages size ifTrue: [^Beeper beep]. - currentIndex := self currentIndex + 1. - self loadPageWithProgress.! Item was removed: - ----- Method: ThreadNavigationMorph>>previousPage (in category 'navigation') ----- - previousPage - - self currentIndex <= 1 ifTrue: [^Beeper beep]. - currentIndex := self currentIndex - 1. - self loadPageWithProgress.! Item was removed: - ----- Method: ThreadNavigationMorph>>showMenuFor:event: (in category 'menu') ----- - showMenuFor: actionSelector event: evt - - "no-op here"! Item was removed: - ----- Method: ThreadNavigationMorph>>step (in category 'stepping') ----- - step - - | delta | - - owner == self world ifFalse: [^ self]. - owner addMorphInLayer: self. - delta := self bounds amountToTranslateWithin: self worldBounds. - delta = (0 @ 0) ifFalse: [self position: self position + delta]. - ! Item was removed: - ----- Method: ThreadNavigationMorph>>stepTime (in category 'stepping') ----- - stepTime - - ^250! Item was removed: - ----- Method: ThreadNavigationMorph>>wantsSteps (in category 'stepping') ----- - wantsSteps - - ^true! Item was removed: - ----- Method: ThreePhaseButtonMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - self target: (target adaptedToWorld: aWorld).! Item was removed: - ----- Method: ThreePhaseButtonMorph>>authorModeOwner: (in category '*MorphicExtras-accessing') ----- - authorModeOwner: aMorph - AuthorModeOwner := aMorph! Item was removed: - ----- Method: ThreePhaseButtonMorph>>dragIfAuthoring: (in category '*MorphicExtras-accessing') ----- - dragIfAuthoring: evt - "Allow simple dragging if the class var is set to my owner." - owner == AuthorModeOwner ifTrue: [ - self center: evt cursorPoint]. - ^ owner == AuthorModeOwner! Item was removed: - ----- Method: ThreePhaseButtonMorph>>updateReferencesUsing: (in category '*MorphicExtras-copying') ----- - updateReferencesUsing: aDictionary - "If the arguments array points at a morph we are copying, then update it to point to the new copy. This method also copies the arguments array itself, which is important!!" - - super updateReferencesUsing: aDictionary. - arguments := arguments collect: - [:old | aDictionary at: old ifAbsent: [old]]. - ! Item was removed: - SketchMorph subclass: #Thumbnail - instanceVariableNames: 'maximumWidth minimumHeight' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-PartsBin'! - - !Thumbnail commentStamp: '<historical>' prior: 0! - A morph that serves as a thumbnail of a given form.! Item was removed: - ----- Method: Thumbnail>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver" - - super initialize. - self setStandardDefaultMetrics! Item was removed: - ----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') ----- - makeThumbnailFromForm: aForm - "Make a thumbnail from the form provided, obeying my min and max width and height preferences" - - | scaleX scaleY margin opaque nominalWidth minimumWidth | - minimumWidth := self minimumWidth. - scaleY := minimumHeight / aForm height. "keep height invariant" - - scaleX := ((nominalWidth := aForm width * scaleY) <= maximumWidth) - ifTrue: - [(nominalWidth < minimumWidth) - ifFalse: - [scaleY] "the usual case; same scale factor, to preserve aspect ratio" - ifTrue: - [minimumWidth / aForm width]] - ifFalse: - [scaleY := maximumWidth / aForm width]. - - "self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)." - "Note: A problem with magnify:by: fails to reproduce borders properly. - The following code does a better job..." - margin := 1.0 / (scaleX at scaleY) // 2 max: 0 at 0. "Extra margin around border" - opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite". - aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better" - self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha). - - self extent: originalForm extent! Item was removed: - ----- Method: Thumbnail>>maxWidth:minHeight: (in category 'initialization') ----- - maxWidth: maxWidth minHeight: minHeight - "Set the min and max heights and widths as indicated" - - maximumWidth := maxWidth. - minimumHeight := minHeight! Item was removed: - ----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') ----- - setStandardDefaultMetrics - "Provide the current choices for min.max width/height for thumbnails" - - self maxWidth: 60 minHeight: 32. - self setProperty: #minimumWidth toValue: 16! Item was removed: - RectangleMorph subclass: #ThumbnailMorph - instanceVariableNames: 'objectToView viewSelector lastSketchForm lastFormShown drawTime' - classVariableNames: 'EccentricityThreshhold RecursionDepth RecursionMax' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !ThumbnailMorph commentStamp: 'sw 1/6/2005 03:47' prior: 0! - A Morph that views another morph, its objectToView.! Item was removed: - ----- Method: ThumbnailMorph class>>initialize (in category 'class initialization') ----- - initialize - "Initialize the class variables of ThumbnailMorph" - - RecursionMax := 2. - RecursionDepth := 0. - EccentricityThreshhold := Float pi - - "ThumbnailMorph initialize"! Item was removed: - ----- Method: ThumbnailMorph class>>recursionReset (in category 'maintenance') ----- - recursionReset - "ThumbnailMorph recursionReset" - "Reset the RecursionDepth counter in case the user interrupted - during a thumbnail being drawn. Do this just once in a while when no - drawOn: is being called. tk 9/8/97" - - RecursionDepth := 0.! Item was removed: - ----- Method: ThumbnailMorph>>actualViewee (in category 'what to view') ----- - actualViewee - "Return the actual morph to be viewed, or nil if there isn't an appropriate morph to view." - - | aMorph actualViewee | - aMorph := self morphToView ifNil: [^ nil]. - aMorph isInWorld ifFalse: [^ nil]. - actualViewee := viewSelector ifNil: [aMorph] ifNotNil: [objectToView perform: viewSelector]. - actualViewee == 0 ifTrue: [^ nil]. "valueAtCursor result for an empty HolderMorph" - actualViewee ifNil: [actualViewee := objectToView]. - (actualViewee isPlayerLike) ifTrue: [actualViewee := actualViewee costume]. - (actualViewee isMorph and: - [actualViewee isFlexMorph and: [actualViewee submorphs size = 1]]) - ifTrue: [actualViewee := actualViewee firstSubmorph]. - ^ actualViewee! Item was removed: - ----- Method: ThumbnailMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: ThumbnailMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.781 - g: 0.781 - b: 0.781! Item was removed: - ----- Method: ThumbnailMorph>>drawForForm:on: (in category 'display') ----- - drawForForm: aForm on: aCanvas - "Draw a small view of the given form on the canvas" - - | scale shrunkForm viewedObjectBox interimCanvas | - viewedObjectBox := aForm boundingBox. - scale := self scaleFor: viewedObjectBox in: self innerBounds. - interimCanvas := Display defaultCanvasClass extent: viewedObjectBox extent depth: aCanvas depth. - interimCanvas translateBy: viewedObjectBox topLeft negated - during: [:tempCanvas | tempCanvas drawImage: aForm at: 0 at 0]. - shrunkForm := interimCanvas form magnify: interimCanvas form boundingBox by: scale smoothing: 1. - lastFormShown := shrunkForm. - - aCanvas paintImage: shrunkForm at: self center - shrunkForm boundingBox center! Item was removed: - ----- Method: ThumbnailMorph>>drawMeOn: (in category 'display') ----- - drawMeOn: aCanvas - "Draw a small view of a morph in another place. Guard against infinite recursion if that morph has a thumbnail of itself inside. Now also works if the thing to draw is a plain Form rather than a morph." - - | viewedMorphBox scale c shrunkForm aWorld aFormOrMorph | - super drawOn: aCanvas. - ((aFormOrMorph := self formOrMorphToView) isForm) - ifTrue: [^self drawForForm: aFormOrMorph on: aCanvas]. - (((aFormOrMorph notNil and: [(aWorld := aFormOrMorph world) notNil]) - and: [aWorld ~~ aFormOrMorph or: [lastFormShown isNil]]) - and: [RecursionDepth + 1 < RecursionMax]) - ifTrue: - [RecursionDepth := RecursionDepth + 1. - viewedMorphBox := aFormOrMorph fullBounds. - scale := self scaleFor: viewedMorphBox in: self innerBounds. - c := Display defaultCanvasClass extent: viewedMorphBox extent - depth: aCanvas depth. - c translateBy: viewedMorphBox topLeft negated - during: - [:tempCanvas | - "recursion happens here" - tempCanvas fullDrawMorph: aFormOrMorph]. - shrunkForm := c form - magnify: c form boundingBox - by: scale - smoothing: 1. - lastFormShown := shrunkForm. - RecursionDepth := RecursionDepth - 1] - ifFalse: - ["This branch used if we've recurred, or if the thumbnail views a World that's already been rendered once, or if the referent is not in a world at the moment" - lastFormShown ifNotNil: [shrunkForm := lastFormShown]]. - shrunkForm ifNotNil: - [aCanvas paintImage: shrunkForm - at: self center - shrunkForm boundingBox center]! Item was removed: - ----- Method: ThumbnailMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Draw a small view of a morph in another place. Guard against infinite recursion if that morph has a thumbnail of itself inside." - | time | - time := Time millisecondClockValue. - self drawMeOn: aCanvas. - drawTime := Time millisecondClockValue - time. - drawTime < 0 ifTrue:[drawTime := nil]. - ! Item was removed: - ----- Method: ThumbnailMorph>>formOrMorphToView (in category 'what to view') ----- - formOrMorphToView - "Answer the form to be viewed, or the morph to be viewed, or nil" - - | actualViewee | - (objectToView isForm) ifTrue: [^objectToView]. - actualViewee := viewSelector ifNil: [objectToView] - ifNotNil: [objectToView perform: viewSelector]. - ^actualViewee == 0 - ifTrue: [nil "valueAtCursor result for an empty HolderMorph"] - ifFalse: - [(actualViewee isPlayerLike) - ifTrue: [actualViewee costume] - ifFalse: [actualViewee]]! Item was removed: - ----- Method: ThumbnailMorph>>getSelector (in category 'accessing') ----- - getSelector - "Answer the selector I send to my target to retrieve my value" - - ^ viewSelector! Item was removed: - ----- Method: ThumbnailMorph>>getSelector: (in category 'accessing') ----- - getSelector: aSelector - "Set the selector used to obtain my value" - - self objectToView: objectToView viewSelector: aSelector! Item was removed: - ----- Method: ThumbnailMorph>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver, obeying a #nominalExtent property if I - have one" - | anExtent | - super initialize. - "" - anExtent := self - valueOfProperty: #nominalExtent - ifAbsent: [((32 @ 32) * RealEstateAgent scaleFactor) truncated]. - self - extent: (anExtent - )! Item was removed: - ----- Method: ThumbnailMorph>>installAsWonderlandTextureOn: (in category 'texture support') ----- - installAsWonderlandTextureOn: anActor - "Make the receiver a texture for the given actor" - self morphRepresented installAsWonderlandTextureOn: anActor! Item was removed: - ----- Method: ThumbnailMorph>>isEtoyReadout (in category 'scripting') ----- - isEtoyReadout - "Answer whether the receiver can serve as an etoy readout" - - ^ true! Item was removed: - ----- Method: ThumbnailMorph>>morphToView (in category 'what to view') ----- - morphToView - "If the receiver is viewing some object, answer a morph can be thought of as being viewed; A gesture is made toward generalizing this beyond the morph/player regime, in that a plain blue rectangle is returned rather than simply failing if the referent is not itself displayable." - - objectToView ifNil: [^ nil]. - ^ objectToView isMorph - ifTrue: - [objectToView] - ifFalse: - [(objectToView isPlayerLike) - ifTrue: - [objectToView costume] - ifFalse: - [RectangleMorph new color: Color blue]] - ! Item was removed: - ----- Method: ThumbnailMorph>>objectToView: (in category 'initialization') ----- - objectToView: objectOrNil - (objectOrNil isMorph and: [objectOrNil allMorphs includes: self]) ifTrue: - ["cannot view a morph containing myself or drawOn: goes into infinite recursion" - objectToView := nil. - ^ self]. - objectToView := objectOrNil! Item was removed: - ----- Method: ThumbnailMorph>>objectToView:viewSelector: (in category 'initialization') ----- - objectToView: objectOrNil viewSelector: aSelector - self objectToView: objectOrNil. - viewSelector := aSelector! Item was removed: - ----- Method: ThumbnailMorph>>putSelector (in category 'accessing') ----- - putSelector - "Answer the selector used for the receiver to send a fresh value back to its target" - - ^ nil! Item was removed: - ----- Method: ThumbnailMorph>>releaseCachedState (in category 'caching') ----- - releaseCachedState - super releaseCachedState. - lastSketchForm := lastFormShown := nil.! Item was removed: - ----- Method: ThumbnailMorph>>scaleFor:in: (in category 'display') ----- - scaleFor: viewedMorphBox in: myBox - "Compute the proper scale for the thumbnail." - - | scale scaleX scaleY ratio factor | - scaleX := myBox width asFloat / viewedMorphBox width. - scaleY := myBox height asFloat / viewedMorphBox height. - ratio := scaleX / scaleY. - factor := 1.0 / EccentricityThreshhold. - ratio < factor - ifTrue: - [scale := (scaleX) @ (factor * scaleY)] - ifFalse: - [ratio > EccentricityThreshhold - ifTrue: - [scale := (factor * scaleX) @ scaleY] - ifFalse: - [scale := scaleX min: scaleY]]. - ^ scale - ! Item was removed: - ----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') ----- - step - "Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed." - - | viewee f | - viewee := self actualViewee. - viewee ifNil: [self stopStepping. ^ self]. - viewee isSketchMorph - ifTrue: - [f := viewee rotatedForm. - f == lastSketchForm ifTrue: [^ self]. "The optimization" - lastSketchForm := f] - ifFalse: - [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in" - self changed - ! Item was removed: - ----- Method: ThumbnailMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Adjust my step time to the time it takes drawing my referent" - drawTime ifNil:[^ 250]. - ^(objectToView updateThresholdForGraphicInViewerTab * drawTime) max: 250.! Item was removed: - ----- Method: ThumbnailMorph>>target (in category 'accessing') ----- - target - "Answer the object on which I act" - - ^ objectToView! Item was removed: - ----- Method: ThumbnailMorph>>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. - objectToView := deepCopier references at: objectToView ifAbsent: [objectToView].! Item was removed: - ----- Method: ThumbnailMorph>>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. - "objectToView := objectToView. Weakly copied" - viewSelector := viewSelector veryDeepCopyWith: deepCopier. - lastSketchForm := lastSketchForm veryDeepCopyWith: deepCopier. - lastFormShown := lastFormShown veryDeepCopyWith: deepCopier. - drawTime := drawTime veryDeepCopyWith: deepCopier. - ! Item was removed: - EllipseMorph subclass: #TickIndicatorMorph - instanceVariableNames: 'stepTime corners index range isTicking lastTick' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! Item was removed: - ----- Method: TickIndicatorMorph>>color: (in category 'accessing') ----- - color: aColor - super color: aColor. - self borderColor: aColor darker.! Item was removed: - ----- Method: TickIndicatorMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ self defaultColor darker - ! Item was removed: - ----- Method: TickIndicatorMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color - r: 0.767 - g: 0.767 - b: 1.0! Item was removed: - ----- Method: TickIndicatorMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - | r center cc deg | - super drawOn: aCanvas. - corners ifNil:[ - r := (bounds topCenter - bounds center) r - 2. - corners := Array new: 32. - 1 to: corners size do:[:i| - deg := 360.0 / corners size * (i-1). - corners at: i put: (Point r: r degrees: deg-90) asIntegerPoint]]. - index := index \\ corners size. - cc := color darker. - center := bounds center. - 1 to: corners size by: 4 do:[:i| - aCanvas fillRectangle: (center + (corners at: i)-2 extent: 4 at 4) color: cc. - ]. - cc := cc darker. - aCanvas line: center to: center + (corners at: index + 1) width: 2 color: cc.! Item was removed: - ----- Method: TickIndicatorMorph>>extent: (in category 'geometry') ----- - extent: aPoint - super extent: ((aPoint x max: aPoint y) asInteger bitClear: 3) asPoint. - corners := nil.! Item was removed: - ----- Method: TickIndicatorMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - self extent: 30 @ 30. - index := 0! Item was removed: - ----- Method: TickIndicatorMorph>>isTicking (in category 'accessing') ----- - isTicking - ^isTicking ifNil:[false].! Item was removed: - ----- Method: TickIndicatorMorph>>isTicking: (in category 'accessing') ----- - isTicking: aBool - isTicking := aBool.! Item was removed: - ----- Method: TickIndicatorMorph>>privateMoveBy: (in category 'private') ----- - privateMoveBy: delta - corners := nil. - super privateMoveBy: delta! Item was removed: - ----- Method: TickIndicatorMorph>>stepAt: (in category 'stepping and presenter') ----- - stepAt: nowTick - | delta | - self isTicking - ifTrue: - [(lastTick isNil or: [nowTick < lastTick]) ifTrue: [lastTick := nowTick]. - delta := (nowTick - lastTick) // self stepTime. - delta > 0 - ifTrue: - [index := index + delta. - lastTick := nowTick. - self changed]]! Item was removed: - ----- Method: TickIndicatorMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^(stepTime ifNil:[125]) max: 50! Item was removed: - ----- Method: TickIndicatorMorph>>stepTime: (in category 'accessing') ----- - stepTime: aNumber - stepTime := aNumber max: 1.! Item was removed: - ----- Method: TickIndicatorMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - ^true! Item was removed: - ----- Method: TransformMorph>>quickAddAllMorphs: (in category '*MorphicExtras-accessing') ----- - quickAddAllMorphs: aCollection - "A fast add of all the morphs for the PluggableListMorph>>list: method to use -- assumes that fullBounds will get called later by the sender, so it avoids doing any updating on the morphs in aCol or updating layout of this scroller. So the sender should handle those tasks as appropriate" - - | myWorld | - myWorld := self world. - aCollection do: [:m | | itsWorld | - m owner ifNotNil: [ - itsWorld := m world. - itsWorld == myWorld ifFalse: [m outOfWorld: itsWorld]. - m owner privateRemoveMorph: m]. - m privateOwner: self. - "inWorld ifTrue: [self addedOrRemovedSubmorph: m]." - itsWorld == myWorld ifFalse: [m intoWorld: myWorld]. - ]. - submorphs := aCollection. - "self layoutChanged." - - ! Item was removed: - TransformationMorph subclass: #TransformationB2Morph - instanceVariableNames: 'worldBoundsToShow useRegularWarpBlt' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !TransformationB2Morph commentStamp: '<historical>' prior: 0! - A transformation which: - - - is content to let someone else decide my bounds (I do not try to minimally enclose my submorphs) - - can use bi-linear interpolation! Item was removed: - ----- Method: TransformationB2Morph>>adjustAfter: (in category 'private') ----- - adjustAfter: changeBlock - - "same as super, but without reference position stuff" - - changeBlock value. - self chooseSmoothing. - self layoutChanged. - owner ifNotNil: [owner invalidRect: bounds] - ! Item was removed: - ----- Method: TransformationB2Morph>>computeBounds (in category 'geometry') ----- - computeBounds - - "the transform bounds must remain under the control of the owner in this case"! Item was removed: - ----- Method: TransformationB2Morph>>drawSubmorphsOn: (in category 'drawing') ----- - drawSubmorphsOn: aCanvas - - | r1 fullG r2 newClip deferredMorphs | - (self innerBounds intersects: aCanvas clipRect) ifFalse: [^self]. - useRegularWarpBlt == true ifTrue: [ - ^aCanvas - transformBy: transform - clippingTo: ((self innerBounds intersect: aCanvas clipRect) expandBy: 1) rounded - during: [:myCanvas | - submorphs reverseDo:[:m | myCanvas fullDrawMorph: m] - ] - smoothing: smoothing - ]. - r1 := self innerBounds intersect: aCanvas clipRect. - r1 area = 0 ifTrue: [^self]. - fullG := (transform localBoundsToGlobal: self firstSubmorph fullBounds) rounded. - r2 := r1 intersect: fullG. - r2 area = 0 ifTrue: [^self]. - newClip := (r2 expandBy: 1) rounded intersect: self innerBounds rounded. - deferredMorphs := #(). - aCanvas - transform2By: transform "#transformBy: for pure WarpBlt" - clippingTo: newClip - during: [:myCanvas | | actualCanvas | - self scale > 1.0 ifTrue: [ - actualCanvas := MultiResolutionCanvas new initializeFrom: myCanvas. - actualCanvas deferredMorphs: (deferredMorphs := OrderedCollection new). - ] ifFalse: [ - actualCanvas := myCanvas. - ]. - submorphs reverseDo:[:m | actualCanvas fullDrawMorph: m]. - ] - smoothing: smoothing. - - deferredMorphs do: [ :each | | where case | - where := each bounds: each fullBounds in: self. - case := 2. - case = 1 ifTrue: [where := where origin rounded extent: where extent rounded]. - case = 2 ifTrue: [where := where rounded]. - each drawHighResolutionOn: aCanvas in: where. - ]. - - ! Item was removed: - ----- Method: TransformationB2Morph>>extent: (in category 'geometry') ----- - extent: aPoint - - | newExtent | - - newExtent := aPoint truncated. - bounds extent = newExtent ifTrue: [^self]. - bounds := bounds topLeft extent: newExtent. - "self recomputeExtent." - - ! Item was removed: - ----- Method: TransformationB2Morph>>useRegularWarpBlt: (in category 'accessing') ----- - useRegularWarpBlt: aBoolean - - useRegularWarpBlt := aBoolean! Item was removed: - Morph subclass: #TransitionMorph - instanceVariableNames: 'startMorph endMorph startBlock completionBlock stepNumber nSteps stepTime startForm endForm effect direction' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !TransitionMorph commentStamp: '<historical>' prior: 0! - A transitionMorph inserts itself in the morphic object structure during a visual transition. It has a stepNumber that runs from 1 to nSteps. This class handles a large family of wipe-like transitions by itself. Subclasses may implement other transitions such as dissolves and zooms.! Item was removed: - ----- Method: TransitionMorph class>>allEffects (in category 'available effects') ----- - allEffects - #('none' 'slide over' 'slide both' 'slide away' 'slide border' - 'page forward' 'page back' - 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop. - ^ #(none - slideOver slideBoth slideAway slideBorder - pageForward pageBack - frenchDoor - zoomFrame zoom - dissolve)! Item was removed: - ----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') ----- - directionsForEffect: eff - "All these arrays are ordered so inverse is atWrap: size//2." - #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right' - 'in' 'in h' 'out' 'out h') translatedNoop. - - (#(slideOver slideBoth slideAway slideBorder) includes: eff) - ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)]. - (#(pageForward pageBack) includes: eff) - ifTrue: [^ #(right down left up)]. - (#(frenchDoor) includes: eff) - ifTrue: [^ #(in inH out outH)]. - (#(zoomFrame zoom) includes: eff) - ifTrue: [^ #(in out)]. - ^ Array new! Item was removed: - ----- Method: TransitionMorph class>>effect:direction: (in category 'initialization') ----- - effect: effectSymbol direction: dirSymbol - ^ self new effect: effectSymbol direction: dirSymbol! Item was removed: - ----- Method: TransitionMorph class>>effect:direction:inverse: (in category 'initialization') ----- - effect: effectSymbol direction: dirSymbol inverse: inverse - | invEffect invDir i dirSet | - inverse ifFalse: [^ self effect: effectSymbol direction: dirSymbol]. - - invEffect := effectSymbol. - effectSymbol = #pageForward ifTrue: [invEffect := #pageBack]. - effectSymbol = #pageBack ifTrue: [invEffect := #pageForward]. - effectSymbol = #slideOver ifTrue: [invEffect := #slideAway]. - effectSymbol = #slideAway ifTrue: [invEffect := #slideOver]. - - invDir := dirSymbol. - dirSet := self directionsForEffect: effectSymbol. - (i := dirSet indexOf: dirSymbol) > 0 - ifTrue: [invDir := dirSet atWrap: i + (dirSet size // 2)]. - - ^ self effect: invEffect direction: invDir! Item was removed: - ----- Method: TransitionMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Transitions aren't meaningful without initializations" - ^ false! Item was removed: - ----- Method: TransitionMorph>>areasRemainingToFill: (in category 'drawing') ----- - areasRemainingToFill: aRectangle - "May be overridden by any subclasses with opaque regions" - - ^ aRectangle areasOutside: self bounds! Item was removed: - ----- Method: TransitionMorph>>changed (in category 'updating') ----- - changed - "The default (super) method is, generally much slower than need be, since many transitions only change part of the screen on any given step of the animation. The purpose of this method is to effect some of those savings." - | loc box boxPrev h w | - (stepNumber between: 1 and: nSteps) ifFalse: [^ super changed]. - effect = #slideBoth ifTrue: [^ super changed]. - effect = #slideOver ifTrue: - [loc := self stepFrom: self position - (self extent * direction) to: self position. - ^ self invalidRect: (((loc extent: self extent) expandBy: 1) intersect: bounds)]. - effect = #slideAway ifTrue: - [loc := self prevStepFrom: self position to: self position + (self extent * direction). - ^ self invalidRect: (((loc extent: self extent) expandBy: 1) intersect: bounds)]. - effect = #slideBorder ifTrue: - [box := endForm boundingBox translateBy: - (self stepFrom: self topLeft - (self extent * direction) to: self topLeft). - boxPrev := endForm boundingBox translateBy: - (self prevStepFrom: self topLeft - (self extent * direction) to: self topLeft). - ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. - effect = #pageForward ifTrue: - [loc := self prevStepFrom: 0 at 0 to: self extent * direction. - ^ self invalidRect: (((bounds translateBy: loc) expandBy: 1) intersect: bounds)]. - effect = #pageBack ifTrue: - [loc := self stepFrom: self extent * direction negated to: 0 at 0. - ^ self invalidRect: (((bounds translateBy: loc) expandBy: 1) intersect: bounds)]. - effect = #frenchDoor ifTrue: - [h := self height. w := self width. - direction = #in ifTrue: - [box := Rectangle center: self center - extent: (self stepFrom: 0 at h to: self extent). - boxPrev := Rectangle center: self center - extent: (self prevStepFrom: 0 at h to: self extent). - ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. - direction = #out ifTrue: - [box := Rectangle center: self center - extent: (self stepFrom: self extent to: 0 at h). - boxPrev := Rectangle center: self center - extent: (self prevStepFrom: self extent to: 0 at h). - ^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]. - direction = #inH ifTrue: - [box := Rectangle center: self center - extent: (self stepFrom: w at 0 to: self extent). - boxPrev := Rectangle center: self center - extent: (self prevStepFrom: w at 0 to: self extent). - ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. - direction = #outH ifTrue: - [box := Rectangle center: self center - extent: (self stepFrom: self extent to: w at 0). - boxPrev := Rectangle center: self center - extent: (self prevStepFrom: self extent to: w at 0). - ^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]]. - effect = #zoomFrame ifTrue: - [direction = #in ifTrue: - [box := Rectangle center: self center - extent: (self stepFrom: 0 at 0 to: self extent). - boxPrev := Rectangle center: self center - extent: (self prevStepFrom: 0 at 0 to: self extent). - ^ self invalidate: (box expandBy: 1) areasOutside: boxPrev]. - direction = #out ifTrue: - [box := Rectangle center: self center - extent: (self stepFrom: self extent to: 0 at 0). - boxPrev := Rectangle center: self center - extent: (self prevStepFrom: self extent to: 0 at 0). - ^ self invalidate: (boxPrev expandBy: 1) areasOutside: box]]. - effect = #zoom ifTrue: - [box := Rectangle center: self center extent: - (direction = #in - ifTrue: [self stepFrom: 0 at 0 to: self extent] - ifFalse: [self prevStepFrom: self extent to: 0 at 0]). - ^ self invalidRect: ((box expandBy: 1) intersect: bounds)]. - ^ super changed - ! Item was removed: - ----- Method: TransitionMorph>>completeReplacement (in category 'initialization') ----- - completeReplacement - - self delete. - completionBlock value! Item was removed: - ----- Method: TransitionMorph>>drawDissolveOn: (in category 'drawing') ----- - drawDissolveOn: aCanvas - "startForm and endFrom are both fixed, but the dissolve ration changes." - - startForm copyBits: endForm at: 0 at 0 translucent: stepNumber asFloat / (nSteps*2). - - aCanvas drawImage: startForm at: self position. - ! Item was removed: - ----- Method: TransitionMorph>>drawFrenchDoorOn: (in category 'drawing') ----- - drawFrenchDoorOn: aCanvas - "startForm and endFrom are both fixed, but a border expands out from a vertical (or H) slit, revealing endForm. - It's like opening a pair of doors." - | box innerForm outerForm boxExtent h w | - h := self height. w := self width. - direction = #in ifTrue: [innerForm := endForm. outerForm := startForm. - boxExtent := self stepFrom: 0 at h to: self extent]. - direction = #out ifTrue: [innerForm := startForm. outerForm := endForm. - boxExtent := self stepFrom: self extent to: 0 at h]. - direction = #inH ifTrue: [innerForm := endForm. outerForm := startForm. - boxExtent := self stepFrom: w at 0 to: self extent]. - direction = #outH ifTrue: [innerForm := startForm. outerForm := endForm. - boxExtent := self stepFrom: self extent to: w at 0]. - - aCanvas drawImage: outerForm at: self position. - - box := Rectangle center: self center extent: boxExtent. - aCanvas drawImage: innerForm at: box topLeft sourceRect: (box translateBy: self position negated). - - ((box expandBy: 1) areasOutside: box) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "During the transition process, the reveal and obscure areas will be invalidated, - so we should be drawing on a canvas that clips to only the changing region." - - (stepNumber between: 1 and: nSteps) ifFalse: [^ self]. - effect = #slideOver ifTrue: [^ self drawSlideOverOn: aCanvas]. - effect = #slideBoth ifTrue: [^ self drawSlideBothOn: aCanvas]. - effect = #slideAway ifTrue: [^ self drawSlideAwayOn: aCanvas]. - effect = #slideBorder ifTrue: [^ self drawSlideBorderOn: aCanvas]. - effect = #pageForward ifTrue: [^ self drawPageForwardOn: aCanvas]. - effect = #pageBack ifTrue: [^ self drawPageBackOn: aCanvas]. - effect = #frenchDoor ifTrue: [^ self drawFrenchDoorOn: aCanvas]. - effect = #zoomFrame ifTrue: [^ self drawZoomFrameOn: aCanvas]. - effect = #zoom ifTrue: [^ self drawZoomOn: aCanvas]. - effect = #dissolve ifTrue: [^ self drawDissolveOn: aCanvas]. - ! Item was removed: - ----- Method: TransitionMorph>>drawPageBackOn: (in category 'drawing') ----- - drawPageBackOn: aCanvas - "endForm grows in the given direction, overlaying endForm." - | offset growRect scale | - aCanvas drawImage: startForm at: self position. - - offset := self stepFrom: self extent * direction negated to: 0 at 0. - growRect := (bounds translateBy: offset) intersect: bounds. - scale := growRect extent asFloatPoint / bounds extent. - aCanvas drawImage: (endForm magnify: endForm boundingBox by: scale smoothing: 1) - at: growRect topLeft. - - ((growRect translateBy: direction) areasOutside: growRect) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawPageForwardOn: (in category 'drawing') ----- - drawPageForwardOn: aCanvas - "startForm shrinks in the given direction, revealing endForm." - | offset shrinkRect scale | - aCanvas drawImage: endForm at: self position. - - offset := self stepFrom: 0 at 0 to: self extent * direction. - shrinkRect := (bounds translateBy: offset) intersect: bounds. - scale := shrinkRect extent asFloatPoint / bounds extent. - aCanvas drawImage: (startForm magnify: startForm boundingBox by: scale smoothing: 1) - at: shrinkRect topLeft. - - ((shrinkRect translateBy: direction negated) areasOutside: shrinkRect) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawSlideAwayOn: (in category 'drawing') ----- - drawSlideAwayOn: aCanvas - "startMorph slides away in the given direction, revealing up the endMorph." - | startLoc moveRect | - startLoc := self stepFrom: self position to: self position + (self extent * direction). - moveRect := startForm boundingBox translateBy: startLoc. - - aCanvas drawImage: endForm at: self position. - aCanvas drawImage: startForm at: startLoc. - - ((moveRect translateBy: direction negated) areasOutside: moveRect) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawSlideBorderOn: (in category 'drawing') ----- - drawSlideBorderOn: aCanvas - "startForm and endFrom are both fixed, but a border slides in the given direction, revealing endForm. (It's like opening a can of sardines ;-)." - | endRect box sourceRect boxLoc | - box := endForm boundingBox. - boxLoc := self stepFrom: box topLeft - (box extent * direction) to: box topLeft. - sourceRect := box translateBy: boxLoc. - endRect := sourceRect translateBy: self position. - - ((endRect expandBy: 1) containsRect: aCanvas clipRect) ifFalse: - [aCanvas drawImage: startForm at: self position]. - aCanvas drawImage: endForm at: self position + boxLoc sourceRect: sourceRect. - - ((endRect translateBy: direction) areasOutside: endRect) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawSlideBothOn: (in category 'drawing') ----- - drawSlideBothOn: aCanvas - "endMorph slides in the given direction, as startMorph slides out of its way." - | endLoc endRect startLoc | - startLoc := self stepFrom: self position to: self position + (self extent * direction). - aCanvas drawImage: startForm at: startLoc. - - endLoc := self stepFrom: self position - (self extent * direction) to: self position. - aCanvas drawImage: endForm at: endLoc. - - endRect := endForm boundingBox translateBy: endLoc. - ((endRect translateBy: direction) areasOutside: endRect) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawSlideOverOn: (in category 'drawing') ----- - drawSlideOverOn: aCanvas - "endMorph slides in the given direction, covering up the startMorph." - | endLoc endRect | - endLoc := self stepFrom: self position - (self extent * direction) to: self position. - endRect := endForm boundingBox translateBy: endLoc. - - ((endRect expandBy: 1) containsRect: aCanvas clipRect) ifFalse: - [aCanvas drawImage: startForm at: self position]. - aCanvas drawImage: endForm at: endLoc. - - ((endRect translateBy: direction) areasOutside: endRect) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawZoomFrameOn: (in category 'drawing') ----- - drawZoomFrameOn: aCanvas - "startForm and endFrom are both fixed, but a square border expands out from the center (or back), revealing endForm. - It's like passing through a portal." - | box innerForm outerForm boxExtent | - direction = #in - ifTrue: [innerForm := endForm. outerForm := startForm. - boxExtent := self stepFrom: 0 at 0 to: self extent] - ifFalse: [innerForm := startForm. outerForm := endForm. - boxExtent := self stepFrom: self extent to: 0 at 0]. - - aCanvas drawImage: outerForm at: self position. - - box := Rectangle center: self center extent: boxExtent. - aCanvas drawImage: innerForm at: box topLeft sourceRect: (box translateBy: self position negated). - - ((box expandBy: 1) areasOutside: box) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>drawZoomOn: (in category 'drawing') ----- - drawZoomOn: aCanvas - "Zoom in: endForm expands overlaying startForm. - Zoom out: startForm contracts revealing endForm." - | box innerForm outerForm boxExtent scale | - direction = #in - ifTrue: [innerForm := endForm. outerForm := startForm. - boxExtent := self stepFrom: 0 at 0 to: self extent] - ifFalse: [innerForm := startForm. outerForm := endForm. - boxExtent := self stepFrom: self extent to: 0 at 0]. - - aCanvas drawImage: outerForm at: self position. - - box := Rectangle center: self center extent: boxExtent. - scale := box extent asFloatPoint / bounds extent. - aCanvas drawImage: (innerForm magnify: innerForm boundingBox by: scale smoothing: 1) - at: box topLeft. - - ((box expandBy: 1) areasOutside: box) do: - [:r | aCanvas fillRectangle: r color: Color black]. - ! Item was removed: - ----- Method: TransitionMorph>>effect:direction: (in category 'private') ----- - effect: effectSymbol direction: dirSymbol - | i | - effect := effectSymbol. - - "Default directions" - (#(#zoom #zoomFrame #frenchDoor) includes: effectSymbol) - ifTrue: - [direction := (#(#in #out #inH #outH) includes: dirSymbol) - ifTrue: [dirSymbol] - ifFalse: [#in]] - ifFalse: - [i := #(#right #downRight #down #downLeft #left #upLeft #up #upRight) - indexOf: dirSymbol - ifAbsent: [5]. - direction := (0 @ 0) eightNeighbors at: i]! Item was removed: - ----- Method: TransitionMorph>>initiateReplacement (in category 'initialization') ----- - initiateReplacement - | n | - startForm := effect = #dissolve - ifTrue: [(startMorph imageForm: 16 forRectangle: bounds) offset: 0 @ 0] - ifFalse: [(startMorph imageFormForRectangle: bounds) offset: 0 @ 0]. - endForm := (endMorph imageFormForRectangle: bounds) offset: 0 @ 0. - nSteps isNil - ifTrue: - [self nSteps: 30 stepTime: 10. - (#(#zoom #pageForward #pageBack) includes: effect) - ifTrue: - [n := 20 * 100000 // self bounds area min: 20 max: 4. - self nSteps: n stepTime: 10]. - #dissolve = effect - ifTrue: - [n := 20 * 50000 // self bounds area min: 20 max: 4. - self nSteps: n stepTime: 10]]. - startBlock value. "with forms in place there should b no further delay." - self arrangeToStartStepping! Item was removed: - ----- Method: TransitionMorph>>invalidate:areasOutside: (in category 'change reporting') ----- - invalidate: box1 areasOutside: box2 - - ((box1 intersect: bounds) areasOutside: (box2 intersect: bounds)) - do: [:r | self invalidRect: r]! Item was removed: - ----- Method: TransitionMorph>>nSteps:stepTime: (in category 'initialization') ----- - nSteps: n stepTime: msPerStep - nSteps := n. - stepTime := msPerStep! Item was removed: - ----- Method: TransitionMorph>>prevStepFrom:to: (in category 'private') ----- - prevStepFrom: p1 to: p2 - "Used for recalling dimensions from previous step." - - ^ (p2-p1) * (stepNumber-1) // nSteps + p1! Item was removed: - ----- Method: TransitionMorph>>showTransitionFrom:to:in:whenStart:whenDone: (in category 'initialization') ----- - showTransitionFrom: startingMorph to: endingMorph in: containingMorph - whenStart: firstBlock whenDone: doneBlock - - effect == #none ifTrue: [firstBlock value. ^ doneBlock value]. - - self startMorph: startingMorph endMorph: endingMorph - startBlock: firstBlock completionBlock: doneBlock. - stepNumber := 0. - - self bounds: startingMorph bounds. - endingMorph privateOwner: self. "Allows test of transition in progress" - containingMorph owner privateAddMorph: self atIndex: - (containingMorph owner submorphs indexOf: containingMorph). - - self initiateReplacement! Item was removed: - ----- Method: TransitionMorph>>startMorph:endMorph:startBlock:completionBlock: (in category 'initialization') ----- - startMorph: start endMorph: end startBlock: firstBlock completionBlock: aBlock - startMorph := start. - endMorph := end. - startBlock := firstBlock. - completionBlock := aBlock! Item was removed: - ----- Method: TransitionMorph>>step (in category 'stepping and presenter') ----- - step - (stepNumber := stepNumber + 1) <= nSteps - ifTrue: [self changed] - ifFalse: [self completeReplacement]! Item was removed: - ----- Method: TransitionMorph>>stepFrom:to: (in category 'private') ----- - stepFrom: p1 to: p2 - "This gives p1 for stepCount = 0, moving to p2 for stepCount = nSteps" - - ^ (p2-p1) * stepNumber // nSteps + p1! Item was removed: - ----- Method: TransitionMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - ^ stepTime! Item was removed: - ThreePhaseButtonMorph subclass: #TrashCanMorph - instanceVariableNames: '' - classVariableNames: 'PreserveTrash SlideDismissalsToTrash TrashPic TrashPicOn' - poolDictionaries: '' - category: 'MorphicExtras-AdditionalWidgets'! Item was removed: - ----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') ----- - descriptionForPartsBin - ^ self partName: 'Trash' translatedNoop - categories: { 'Basic' translatedNoop} - documentation: 'a tool for discarding objects' translatedNoop - sampleImageForm: (Form extent: 42 at 54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2 829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 5223 97440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 28319 84801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0 at 0)! Item was removed: - ----- Method: TrashCanMorph class>>initialize (in category 'class initialization') ----- - initialize - "initialize the receiver" - - self registerInFlapsRegistry. - - self initializePictures. - ! Item was removed: - ----- Method: TrashCanMorph class>>initializePictures (in category 'class initialization') ----- - initializePictures - " - TrashCanMorph initializePictures. - " - TrashPicOn := self initializeTrashPicOn. - TrashPic := self initializeTrashPic! Item was removed: - ----- Method: TrashCanMorph class>>initializeTrashPic (in category 'class initialization') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: TrashCanMorph class>>initializeTrashPicOn (in category 'class initialization') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: TrashCanMorph class>>moveToTrash: (in category 'miscellaneous') ----- - moveToTrash: aMorph - SoundService soundEnabled ifTrue: - [TrashCanMorph preserveTrash - ifFalse: [self playSoundNamed: 'scratch'] - ifTrue: [self playDeleteSound]]. - - aMorph delete. - aMorph == ScrapBook default scrapBook ifFalse: - [ScrapBook default addToTrash: aMorph]! Item was removed: - ----- Method: TrashCanMorph class>>playDeleteSound (in category 'sound playing') ----- - playDeleteSound - "TrashCanMorph playDeleteSound" - - SoundService default playSampledSound: self samplesForDelete rate: 22050! Item was removed: - ----- Method: TrashCanMorph class>>playMouseEnterSound (in category 'sound playing') ----- - playMouseEnterSound - "TrashCanMorph playMouseEnterSound" - - SoundService default playSampledSound: self samplesForMouseEnter rate: 22050! Item was removed: - ----- Method: TrashCanMorph class>>playMouseLeaveSound (in category 'sound playing') ----- - playMouseLeaveSound - "TrashCanMorph playMouseLeaveSound" - - SoundService default playSampledSound: self samplesForMouseLeave rate: 22050! Item was removed: - ----- Method: TrashCanMorph class>>preserveTrash (in category 'preferences') ----- - preserveTrash - <preference: 'Preserve trash' category: 'morphic' description: 'If true, morphs dismissed via halo or dragged into the Trash will be preserved in the TrashCan for possible future retrieval.' type: #Boolean> - ^ PreserveTrash ifNil: [false].! Item was removed: - ----- Method: TrashCanMorph class>>preserveTrash: (in category 'preferences') ----- - preserveTrash: aBoolean - PreserveTrash := aBoolean.! Item was removed: - ----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop} - forFlapNamed: 'Scripting']! Item was removed: - ----- Method: TrashCanMorph class>>samplesForDelete (in category 'sound samples') ----- (excessive size, no diff calculated) Item was removed: - ----- Method: TrashCanMorph class>>samplesForMouseEnter (in category 'sound samples') ----- - samplesForMouseEnter - - ^ #(-37 -24 -30 -30 -25 -23 -11 -8 -38 -40 -34 -21 -18 -27 -34 -20 2 11 8 10 5 7 10 14 34 28 34 54 59 47 54 25 27 43 33 48 23 40 59 63 47 46 27 47 43 41 46 50 64 57 46 57 44 48 12 17 24 28 18 23 27 -7 -17 2 4 1 -4 18 12 11 34 25 43 18 11 20 43 43 11 12 31 -5 -11 -43 -41 -17 -23 -28 -38 -33 -48 -64 -61 -53 -61 -54 -56 -73 -73 -48 -48 -63 -92 -102 -90 -92 -115 -93 -90 -109 -120 -112 -119 -141 -136 -128 -146 -143 -141 -129 -118 -139 -132 -120 -103 -100 -96 -79 -71 -83 -79 -77 -87 -73 -73 -43 -24 -5 -10 20 23 -5 -4 0 28 20 -11 20 4 -11 -23 20 27 7 8 -2 -7 -15 -27 4 0 -8 -34 -31 -38 -34 -50 -40 -64 -46 -59 -51 -82 -80 -82 -80 -89 -95 -122 -89 -97 -67 -64 -31 -21 -34 -56 -25 -35 -48 -63 -37 -54 -34 8 40 82 161 306 503 921 1638 2549 3458 4074 4290 3947 2988 1528 -293 -2417 -4592 -6693 -8734 -10727 -12641 -14255 -15466 -16249 -16383 -15965 -15159 -14019 -12574 -10934 -9124 -7214 -5191 -3092 -856 1418 3639 5667 7543 9156 10532 11608 12361 12795 12922 12755 12307 11574 10473 8964 7129 5084 2911 596 -1773 -4103 -6374 -8593 -10593 -12355 -13748 -14599 -14866 -14527 -13593 -12109 -10146 -7697 -4933 -2022 881 3689 6302 8638 10580 12067 13052 13602 13774 13543 13046 12276 11271 9965 8426 6677 4771 2731 607 -1469 -3420 -5217 -6790 -8196 -9401 -10377 -11001 -11242 -11095 -10600 -9729 -8581 -7114 -5423 -3563 -1566 488 2577 4556 6448 8234 9786 11143 12136 12756 13034 12936 12489 11744 10678 9320 7673 5775 3813 1813 -182 -2113 -3924 -5606 -7123 -8439 -9477 -10213 -10688 -10855 -10663 -10109 -9278 -8125 -6682 -5004 -3147 -1171 791 2762 4655 6386 7944 9222 10201 10800 11120 11163 10885 10313 9434 8363 7050 5604 4048 2395 711 -872 -2376 -3707 -4894 -5875 -6667 -7214 -7489 -7480 -7251 -6739 -6039 -5102 -3987 -2754 -1475 -207 1094 2392 3590 4686 5639 6469 7178 7758 8142 8273 8187 7883 7398 6803 6056 5188 4152 3075 1968 866 -184 -1197 -2143 -2964 -3615 -4163 -4572 -4907 -5100 -5141 -5018 -4723 -4288 -3725 -3031 -2198 -1246 -276 704 1661 2529 3377 4140 4835 5333 5721 5941 6098 6048 58 46 5498 5047 4467 3816 3131 2444 1659 856 57 -636 -1301 -1946 -2549 -3099 -3548 -3871 -4057 -4143 -4153 -3999 -3753 -3380 -2893 -2338 -1742 -1098 -391 380 1111 1822 2543 3206 3784 4283 4638 4868 4955 4894 4713 4385 3938 3365 2679 1910 1089 272 -564 -1379 -2145 -2902 -3583 -4127 -4562 -4866 -5010 -4949 -4785 -4468 -4026 -3463 -2817 -2070 -1256 -398 462 1297 2147 2922 3613 4211 4732 5178 5449 5617 5608 5456 5168 4727 4120 3404 2561 1646 706 -218 -1212 -2160 -3018 -3688 -4293 -4726 -5015 -5195 -5231 -5096 -4788 -4321 -3754 -3057 -2240 -1363 -433 515 1446 2340 3118 3820 4401 4851 5133 5256 5195 5011 4696 4209 3627 2934 2168 1334 434 -475 -1357 -2211 -2981 -3669 -4285 -4771 -5116 -5322 -5382 -5315 -5067 -4701 -4169 -3518 -2775 -1937 -1036 -165 735 1626 2440 3115 3681 4154 4467 4625 4681 4589 4344 4008 3583 3008 2353 1615 777 -57 -872 -1713 -2486 -3206 -3843 -4391 -4840 -5116 -5273 -5277 -5128 -4831 -4418 -3868 -3252 -2533 -1744 -898 -67 780 1570 2300 2913 3463 3874 4159 4331 4353 4248 40 28 3668 3184 2633 1949 1216 426 -341 -1109 -1852 -2512 -3102 -3597 -3983 -4224 -4349 -4339 -4183 -3910 -3520 -3065 -2510 -1885 -1242 -588 54 685 1249 1839 2352 2777 3106 3327 3466 3488 3417 3234 2948 2617 2185 1671 1117 564 -15 -608 -1174 -1700 -2196 -2650 -3039 -3296 -3481 -3587 -3568 -3460 -3273 -2983 -2614 -2156 -1658 -1154 -626 -89 421 921 1413 1865 2266 2602 2818 3004 3090 3036 2944 2824 2565 2214 1837 1422 954 469 -15 -490 -960 -1413 -1806 -2139 -2421 -2703 -2877 -2949 -2974 -2964 -2820 -2608 -2340 -1972 -1592 -1154 -680 -190 267 745 1183 1592 1947 2225 2473 2624 2696 2723 2692 2565 2408 2219 1916 1579 1200 797 368 -115 -549 -994 -1408 -1767 -2037 -2241 -2394 -2469 -2497 -2427 -2317 -2150 -1887 -1551 -1197 -778 -346 103 544 942 1390 1766 2077 2353 2535 2657 2697 2700 2615 2473 2257 1980 1677 1287 871 466 21 -377 -757 -1134 -1464 -1713 -1932 -2096 -2208 -2243 -2235 -2168 -2051 -1854 -1566 -1229 -888 -499 -100 319 719 1124 1481 1801 2084 2306 2434 2469 2476 2431 2287 2101 1825 1 527 1194 836 483 123 -231 -593 -931 -1251 -1541 -1796 -1978 -2122 -2188 -2162 -2106 -1903 -1717 -1467 -1140 -814 -463 -115 254 617 950 1284 1550 1753 1880 1992 1988 1930 1829 1695 1475 1226 924 603 293 -27 -345 -640 -954 -1217 -1471 -1687 -1832 -1917 -1985 -1960 -1900 -1750 -1546 -1356 -1092 -771 -469 -135 200 555 895 1176 1429 1628 1786 1920 1968 1966 1924 1842 1704 1464 1200 922 600 285 -21 -348 -614 -840 -1073 -1266 -1397 -1501 -1595 -1635 -1638 -1585 -1464 -1311 -1151 -971 -735 -501 -267 -43 210 398 643 865 1050 1206 1333 1419 1418 1410 1383 1281 1147 996 803 621 437 226 23 -148 -309 -466 -611 -748 -849 -912 -964 -1016 -1039 -1032 -990 -868 -757 -621 -440 -256 -118 43 194 354 470 564 653 718 780 809 793 748 672 587 453 321 151 8 -142 -308 -499 -647 -819 -950 -1073 -1169 -1243 -1276 -1282 -1262 -1219 -1140 -1016 -921 -809 -624 -475 -335 -142 25 182 339 483 613 702 796 856 899 898 902 858 826 735 656 529 395 263 146 -14 -167 -346 -480 -633 -715 -806 -878 -955 -958 -978 -930 -891 - 794 -705 -616 -477 -336 -243 -112 4 109 205 276 332 430 480 519 508 521 513 518 463 384 319 227 112 -8 -100 -202 -348 -505 -596 -725 -833 -906 -951 -940 -927 -883 -806 -692 -542 -365 -207 -60 80 249 400 483 584 626 650 657 634 585 493 443 351 238 158 63 -30 -123 -185 -279 -359 -400 -470 -529 -570 -561 -594 -601 -588 -570 -524 -477 -414 -328 -236 -141 -37 48 99 204 287 391 441 472 495 516 476 418 371 292 204 99 -10 -43 -118 -207 -253 -303 -341 -349 -359 -342 -338 -305 -264 -227 -164 -119 -46 38 99 138 174 227 234 215 231 262 234 227 237 273 218 198 192 192 135 119 90 44 -27 -40 -73 -99 -132 -149 -154 -128 -92 -46 -23 38 59 59 51 57 50 28 17 37 -10 2 -4 -40 -71 -96 -126 -142 -194 -227 -274 -300 -345 -362 -369 -357 -345 -335 -303 -256 -223 -191 -141 -116 -71 -80 -96 -74 -86 -120 -141 -181 -249 -315 -372 -388 -397 -430 -449 -460 -462 -417 -391 -357 -299 -253 -175 -119 -34 43 128 198 241 282 357 410 436 444 472 473 441 413 358 260 191 96 -12 -74 -164 -270 -346 -437 -513 -594 -652 -704 -7 28 -750 -735 -668 -626 -544 -456 -341 -244 -138 -34 89 195 293 381 459 476 549 597 600 620 601 572 532 475 417 351 233 135 63 -44 -142 -230 -295 -385 -405 -450 -472 -492 -463 -482 -477 -460 -440 -393 -339 -326 -257 -190 -126 -35 63 146 201 283 355 393 401 427 441 411 382 335 282 241 200 133 90 30 -8 -64 -116 -142 -175 -213 -223 -244 -274 -280 -272 -280 -264 -241 -262 -249 -228 -211 -156 -128 -64 -21 43 80 129 142 187 215 227 230 237 243 254 266 267 273 256 254 251 253 236 208 164 128 69 54 30 -18 -69 -86 -106 -143 -167 -188 -218 -246 -247 -233 -220 -169 -138 -95 -44 -23 18 69 116 188 236 298 380 440 503 516 538 544 516 485 475 427 374 310 292 220 109 57 5 -100 -184 -276 -362 -436 -480 -512 -539 -531 -524 -511 -452 -371 -302 -260 -169 -95 -46 59 156 208 262 336 397 421 436 441 427 427 414 368 332 298 237 197 145 93 46 0 -48 -89 -112 -138 -132 -118 -73 -23 0). - ! Item was removed: - ----- Method: TrashCanMorph class>>samplesForMouseLeave (in category 'sound samples') ----- - samplesForMouseLeave - - ^ #(230 254 256 242 234 246 206 211 179 175 133 111 106 91 46 53 35 54 17 40 67 98 79 114 127 167 162 133 130 119 91 82 98 90 75 87 45 19 -17 1 -16 -1 8 12 -1 53 71 85 109 117 106 159 138 154 133 161 122 138 85 72 67 51 46 20 6 3 -8 8 -8 -4 -1 22 38 53 43 85 71 103 88 87 45 51 43 59 16 -9 -17 1 -45 -20 -32 -8 -38 3 -20 20 43 53 43 37 24 54 30 58 59 32 20 33 17 8 -30 -56 -72 -111 -133 -127 -122 -111 -129 -111 -108 -112 -108 -111 -135 -100 -130 -111 -158 -125 -121 -104 -96 -111 -135 -106 -111 -104 -133 -111 -143 -137 -140 -130 -109 -103 -119 -62 -59 -67 -62 -33 -41 -12 -43 -46 -43 -38 -71 -87 -100 -80 -125 -124 -145 -132 -145 -111 -148 -106 -95 -79 -51 -14 -17 8 22 85 93 111 116 127 138 133 96 67 53 72 45 -22 -30 -20 -33 16 27 121 177 335 500 756 1023 1362 1738 2131 2465 2769 2932 3032 2951 2609 1980 1102 -43 -1326 -2769 -4181 -5598 -6852 -7906 -8630 -9014 -8982 -8390 -7257 -5645 -3637 -1415 1029 3476 5953 8267 10196 11595 12386 12531 12089 10938 9187 6826 4120 1124 -1933 -4946 -769 9 -10138 -12005 -13244 -13719 -13418 -12384 -10706 -8485 -5808 -2796 421 3640 6629 9344 11524 13121 14054 14261 13735 12528 10643 8209 5307 2125 -1265 -4592 -7693 -10426 -12683 -14290 -15200 -15273 -14514 -12881 -10583 -7628 -4171 -448 3303 6911 10154 12921 14914 16133 16383 15750 14259 12040 9164 5772 2083 -1721 -5395 -8751 -11629 -13799 -15261 -15758 -15399 -14104 -11989 -9176 -5801 -2022 1844 5593 9006 11905 14064 15405 15842 15387 13957 11834 9005 5754 2215 -1402 -4888 -8044 -10744 -12739 -14054 -14519 -14216 -13070 -11186 -8680 -5729 -2501 789 4023 6924 9450 11320 12489 12920 12629 11614 9949 7764 5214 2411 -495 -3327 -5845 -8006 -9690 -10820 -11288 -11133 -10271 -8914 -6992 -4820 -2357 174 2643 4910 6853 8361 9360 9729 9537 8811 7573 5908 3939 1799 -448 -2695 -4641 -6343 -7628 -8525 -8926 -8785 -8177 -7118 -5640 -3861 -1943 43 2047 3813 5332 6502 7292 7601 7455 6837 5872 4578 3054 1305 -482 -2228 -3781 -5133 -6187 -6850 -7136 -7039 -6529 -5688 -4489 -3071 -1489 109 1726 3166 4 447 5398 6034 6235 6151 5651 4847 3747 2483 997 -464 -1915 -3221 -4323 -5159 -5708 -5929 -5812 -5328 -4601 -3635 -2478 -1165 75 1324 2432 3366 4011 4423 4557 4439 3961 3326 2470 1494 422 -616 -1596 -2506 -3267 -3797 -4124 -4258 -4142 -3740 -3235 -2527 -1702 -832 43 919 1718 2391 2820 3151 3276 3206 2988 2569 1983 1321 587 -125 -837 -1516 -2112 -2554 -2854 -2951 -2883 -2669 -2285 -1771 -1186 -539 119 779 1363 1889 2223 2457 2528 2451 2177 1776 1271 681 88 -500 -1079 -1592 -2009 -2283 -2420 -2354 -2230 -1904 -1460 -942 -385 198 766 1263 1660 1967 2138 2185 2094 1889 1518 1102 577 56 -463 -971 -1423 -1799 -2070 -2222 -2244 -2112 -1910 -1554 -1166 -679 -162 353 797 1195 1505 1733 1844 1863 1696 1489 1144 731 267 -201 -706 -1157 -1525 -1834 -2036 -2089 -2033 -1893 -1644 -1281 -865 -367 85 572 968 1342 1591 1783 1812 1699 1481 1186 811 413 -66 -534 -965 -1333 -1699 -1920 -2046 -2022 -1964 -1721 -1410 -989 -505 -14 471 929 1337 1673 1863 1989 1993 1854 1634 1318 898 477 -50 -484 -940 -1320 -1657 -1852 -1978 -1928 -1778 -1531 -1199 -785 -316 174 634 1092 1470 1789 2022 2107 2081 1999 1715 1374 939 488 -27 -493 -953 -1326 -1644 -1880 -1997 -1960 -1875 -1639 -1345 -927 -511 -85 342 834 1202 1570 1801 1938 1989 1893 1721 1436 1068 663 216 -185 -632 -1040 -1384 -1625 -1783 -1857 -1836 -1659 -1466 -1131 -748 -359 46 476 852 1200 1445 1600 1678 1710 1544 1297 1003 676 246 -175 -621 -990 -1353 -1628 -1855 -1947 -1965 -1851 -1639 -1341 -973 -524 -106 376 776 1160 1492 1715 1815 1838 1738 1589 1279 979 559 106 -285 -731 -1128 -1450 -1731 -1922 -2001 -2005 -1863 -1636 -1316 -948 -545 -137 306 755 1126 1466 1717 1893 1955 1915 1760 1531 1190 844 384 -61 -511 -921 -1299 -1584 -1773 -1889 -1880 -1730 -1520 -1152 -716 -256 156 622 1057 1437 1709 1873 1925 1902 1718 1431 1103 706 272 -164 -563 -915 -1224 -1450 -1592 -1642 -1596 -1441 -1194 -879 -527 -133 274 705 1015 1294 1515 1610 1671 1592 1412 1195 876 556 214 -153 -495 -800 -1037 -1189 -1307 -1308 -1260 -1087 -879 -626 -335 8 32 1 651 900 1137 1299 1402 1387 1341 1165 950 689 388 50 -266 -572 -823 -1028 -1203 -1287 -1265 -1197 -1052 -847 -539 -253 72 411 708 976 1236 1404 1470 1433 1350 1181 965 679 366 71 -217 -547 -789 -971 -1039 -1082 -1008 -884 -726 -476 -185 104 403 697 939 1097 1232 1247 1257 1124 955 756 534 224 -38 -332 -537 -731 -889 -981 -992 -937 -839 -747 -547 -324 -111 116 343 547 724 847 924 910 902 777 676 482 301 85 -104 -272 -445 -597 -702 -779 -782 -800 -766 -653 -500 -390 -187 -59 114 259 417 508 603 643 676 626 572 463 366 200 54 -119 -237 -398 -501 -637 -698 -731 -722 -714 -624 -519 -369 -246 -82 54 248 372 492 540 592 589 526 426 358 211 56 -90 -206 -372 -476 -592 -640 -666 -661 -598 -487 -367 -211 -66 151 290 430 526 663 695 753 719 724 629 563 430 300 153 20 -85 -158 -251 -296 -309 -301 -269 -217 -153 -51 33 151 230 345 429 495 527 558 568 572 508 421 321 240 111 43 -114 -175 -232 -267 -288 -305 -300 -214 -180 -79 4 104 206 324 403 511 555 580 585 618 563 498 458 382 308 279 198 148 108 95 51 51 50 66 91 104 116 162 183 214 195 253 261 274 279 267 266 285 266 285 254 258 254 243 269 235 180 175 154 179 159 119 164 216 227 274 314 371 398 461 495 532 509 485 498 401 325 271 164 100 -27 -116 -166 -204 -230 -227 -222 -166 -106 -4 127 258 364 485 577 663 708 753 743 718 608 547 440 298 188 75 -71 -153 -204 -227 -246 -208 -198 -140 -85 43 137 254 343 438 524 593 610 631 605 572 511 456 338 250 154 62 -17 -33 -103 -77 -114 -69 -38 59 117 193 288 369 390 429 438 456 408 353 303 235 140 80 -29 -95 -164 -192 -208 -185 -166 -119 -58 95 198 288 371 488 519 563 598 582 547 482 387 277 112 4 -132 -179 -319 -376 -447 -416 -416 -382 -298 -169 -80 69 211 364 490 624 718 774 789 811 768 721 601 509 384 271 154 33 -95 -138 -216 -259 -253 -237 -198 -171 -109 -22 56 167 264 374 450 530 551 584 595 553 500 458 348 275 146 51 -62 -166 -201 -254 -295 -266 -253 -164 -137 -59 11 98 214 343 403 514 550 603 632 593 543 509 405 337 196 111 17 -61 -146 -188 -242 -229 -224 -201 -187 -129 -1 04 -37 77 112 166 237 275 311 292 292 290 235 162 111 43 4 -59 -72 -124 -140 -140 -117 -108 -61 -24 56 109 158 169 240 264 284 292 275 266 256 185 124 109 64 1 -41 -72 -87 -80 -77 -46 -35 -11 41 43 56 69 101 116 119 133 108 51 56 53 59 9 43 32 67 95 104 109 150 167 171 183 204 213 190 171 172 122 130 98 95 30 16 -20 -46 -88 -83 -74 -56 -19 33 85 119 201 272 279 319 342 364 369 376 335 325 282 213 158 108 8 -30 -116 -130 -169 -182 -164 -140 -137 -82 -54 32 116 175 225 284 317 379 369 377 342 314). - ! Item was removed: - ----- Method: TrashCanMorph class>>slideDismissalsToTrash (in category 'preferences') ----- - slideDismissalsToTrash - <preference: 'Slide dismissals to trash' category: 'morphic' description: 'If true, when you dismiss a Morph it will slide to the TrashCan.' type: #Boolean> - ^ SlideDismissalsToTrash ifNil: [false].! Item was removed: - ----- Method: TrashCanMorph class>>slideDismissalsToTrash: (in category 'preferences') ----- - slideDismissalsToTrash: aBoolean - SlideDismissalsToTrash := aBoolean.! Item was removed: - ----- Method: TrashCanMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: TrashCanMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') ----- - acceptDroppingMorph: aMorph event: evt - SoundService soundEnabled - ifTrue: [TrashCanMorph preserveTrash - ifTrue: [self class playDeleteSound] - ifFalse: [self playSoundNamed: 'scratch']]. - evt hand visible: true. - self state: #off. - aMorph delete. - aMorph == ScrapBook default scrapBook - ifFalse: [ScrapBook default addToTrash: aMorph removeHalo]! Item was removed: - ----- Method: TrashCanMorph>>doubleClick: (in category 'event handling') ----- - doubleClick: evt - | palette | - palette := self standardPalette. - ((palette notNil and: [palette isInWorld]) and: [palette hasScrapsTab]) - ifTrue: - [palette showScrapsTab] - ifFalse: - [self world openScrapsBook: evt].! Item was removed: - ----- Method: TrashCanMorph>>findActivePaintBox (in category 'private') ----- - findActivePaintBox - "If painting, return the active PaintBoxMorph. If not painting, or if the paint box cannot be found, return nil." - - | w m | - w := self world. - w ifNil: [^ nil]. - (w findA: SketchEditorMorph) ifNil: [^ nil]. "not painting" - (m := w findA: PaintBoxMorph) ifNotNil: [^ m]. - ^ nil - ! Item was removed: - ----- Method: TrashCanMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ self inPartsBin not! Item was removed: - ----- Method: TrashCanMorph>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - - ^ self inPartsBin not - ! Item was removed: - ----- Method: TrashCanMorph>>handlesMouseOverDragging: (in category 'event handling') ----- - handlesMouseOverDragging: evt - - ^ self inPartsBin not - ! Item was removed: - ----- Method: TrashCanMorph>>initialize (in category 'initialization') ----- - initialize - "Initialize the receiver's graphics, name, and balloon-help" - - super initialize. - self offImage: TrashPic; - pressedImage: TrashPicOn; - image: TrashPicOn. - self setNameTo: 'Trash' translated. - self setBalloonText: - 'To remove an object, drop it on any trash can. To view, and maybe retrieve, items that have been thrown away, double-click on any trash-can. Things are retained in the trash-can if the "preserveTrash" preference is set, otherwise they are purged immediately' translated. - ! Item was removed: - ----- Method: TrashCanMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - "Bypass ImageMorph's intervention" - - self initialize! Item was removed: - ----- Method: TrashCanMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - | paintBox | - evt hand visible: true. - "See if a stamp is being dropped into the trash. It is not held by the hand." - (paintBox := self findActivePaintBox) ifNotNil: [ - paintBox getSpecial == #stamp: ifTrue: [ - paintBox deleteCurrentStamp: evt. "throw away stamp..." - self primaryHand showTemporaryCursor: nil. - ^ self]]. "... and don't open trash" - evt hand waitForClicksOrDrag: self event: evt. - ! Item was removed: - ----- Method: TrashCanMorph>>mouseEnter: (in category 'event handling') ----- - mouseEnter: event - "Present feedback for potential deletion." - | hand firstSub | - hand := event hand. - ((hand submorphCount > 0 - and: [(firstSub := hand submorphs first) ~~ self]) - and: [self wantsDroppedMorph: firstSub event: event]) - ifTrue: [SoundService soundEnabled - ifTrue: [self class playMouseEnterSound]. - "hand visible: false." "This leads to confusion. Let morph and hand appear til dropped." - "self world abandonAllHalos." - "hand halo: nil." - self state: #pressed] - ifFalse: [self showStampIn: hand]! Item was removed: - ----- Method: TrashCanMorph>>mouseEnterDragging: (in category 'event handling') ----- - mouseEnterDragging: evt - "Test button state elsewhere if at all" - ^ self mouseEnter: evt! Item was removed: - ----- Method: TrashCanMorph>>mouseLeave: (in category 'event handling') ----- - mouseLeave: event - "Present feedback for aborted deletion." - | hand | - hand := event hand. - ((hand submorphCount > 0) and: - [hand submorphs first ~~ self]) - ifTrue: - [SoundService soundEnabled ifTrue: [self class playMouseLeaveSound]. - hand visible: true. - self state: #off] - ifFalse: - [self stopShowingStampIn: hand]. - ! Item was removed: - ----- Method: TrashCanMorph>>mouseLeaveDragging: (in category 'event handling') ----- - mouseLeaveDragging: evt - "Test button state elsewhere if at all" - ^ self mouseLeave: evt! Item was removed: - ----- Method: TrashCanMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - | hand firstSub | - hand := evt hand. - (((hand submorphCount > 0) and: [(firstSub := hand submorphs first) ~~ self]) and: - [self wantsDroppedMorph: firstSub event: evt]) - ifTrue: - [super mouseMove: evt] - ! Item was removed: - ----- Method: TrashCanMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - "Close the lid when you're through!!" - - self state: #off. - ! Item was removed: - ----- Method: TrashCanMorph>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: 'a TrashCanMorph'! Item was removed: - ----- Method: TrashCanMorph>>showStampIn: (in category 'private') ----- - showStampIn: aHand - "If painting and in stamp mode, show the stamp that is about to be thrown away." - - | paintBox curs | - paintBox := self findActivePaintBox. - paintBox ifNotNil: [ - "See if a stamp is being dropped into the trash. It is not actually held by the hand." - paintBox getSpecial == #stamp: ifTrue: [ - curs := paintBox actionCursor. - aHand showTemporaryCursor: curs hotSpotOffset: curs center]]. - ! Item was removed: - ----- Method: TrashCanMorph>>startDrag: (in category 'event handling') ----- - startDrag: evt - evt hand grabMorph: self.! Item was removed: - ----- Method: TrashCanMorph>>stopShowingStampIn: (in category 'private') ----- - stopShowingStampIn: aHand - "Revert to the normal cursor." - - aHand showTemporaryCursor: nil. - ! Item was removed: - ----- Method: TrashCanMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - - ^ ((aMorph ~~ self) and: [aMorph ~~ ScrapBook default scrapBook]) and: - [aMorph willingToBeDiscarded]! Item was removed: - MorphicModel subclass: #TwoWayScrollPane - instanceVariableNames: 'getMenuSelector getMenuTitleSelector xScrollBar yScrollBar scroller' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Obsolete'! - - !TwoWayScrollPane commentStamp: '<historical>' prior: 0! - TwoWayScrollPane is now obsolete. You should be able to use ScrollPane to do both vertical and horizontal scrolling. - - As an example, see Morph>>inATwoWayScrollPane and change the first line to create a ScrollPane instead of a TwoWayScrollPane. It will still work. - - (EllipseMorph new extent: 200 at 150) inATwoWayScrollPane openInWorld - - Note that user preferences for ScrollPane may be geared toward text scrolling, so that the horizontal scrollbar may be hidden when not needed, while the vertical scrollbar is always shown. Use ScrollPane>>alwaysShowHScrollbar: or its variants to adjust this if you want the vertical & horizontal scrollbars to be shown consistently. - ! Item was removed: - ----- Method: TwoWayScrollPane class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "OK to instantiate" - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>colorForInsets (in category 'accessing') ----- - colorForInsets - "My submorphs use the surrounding color" - owner notNil and: - [ owner color isColor ifTrue: [ ^ owner color ] ]. - ^ Color white! Item was removed: - ----- Method: TwoWayScrollPane>>containsPoint: (in category 'geometry testing') ----- - containsPoint: aPoint - (super containsPoint: aPoint) ifTrue: [^ true]. - "Also include scrollbar when it is extended..." - "used to handle retractable scrolbar" - ^ false! Item was removed: - ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category 'initialization') ----- - createScrollBarNamed: aString - "creates a scroll bar named as aString" - | result | - result := ScrollBar new model: self slotName: aString. - result borderStyle: (BorderStyle inset width: 2). - ^ result! Item was removed: - ----- Method: TwoWayScrollPane>>createScroller (in category 'initialization') ----- - createScroller - "create a scroller" - | result | - result := TransformMorph new color: Color transparent. - result offset: 0 @ 0. - ^ result! Item was removed: - ----- Method: TwoWayScrollPane>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - ^ Color transparent! Item was removed: - ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category 'initialization') ----- - defaultBorderStyle - ^ BorderStyle inset! Item was removed: - ----- Method: TwoWayScrollPane>>doLayoutIn: (in category 'layout') ----- - doLayoutIn: layoutBounds - "layout has changed. update scroll deltas or whatever else" - - (owner notNil and: [owner hasProperty: #autoFitContents]) - ifTrue: [self fitContents]. - super doLayoutIn: layoutBounds.! Item was removed: - ----- Method: TwoWayScrollPane>>extent: (in category 'geometry') ----- - extent: newExtent - bounds extent = newExtent ifTrue: [^ self]. - super extent: (newExtent max: 36 at 32). - self resizeScrollBar; resizeScroller; setScrollDeltas. - ! Item was removed: - ----- Method: TwoWayScrollPane>>fitContents (in category 'layout') ----- - fitContents - "Adjust my size to fit my contents reasonably snugly" - - self extent: scroller submorphBounds extent - + (yScrollBar width @ xScrollBar height) - + (self borderWidth*2) - ! Item was removed: - ----- Method: TwoWayScrollPane>>getMenu: (in category 'menu') ----- - getMenu: shiftKeyState - "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." - - | menu aMenu aTitle | - getMenuSelector isNil ifTrue: [^nil]. - menu := MenuMorph new defaultTarget: model. - aTitle := getMenuTitleSelector - ifNotNil: [model perform: getMenuTitleSelector]. - getMenuSelector numArgs = 1 - ifTrue: - [aMenu := model perform: getMenuSelector with: menu. - aTitle ifNotNil: [aMenu addTitle: aTitle]. - ^aMenu]. - getMenuSelector numArgs = 2 - ifTrue: - [aMenu := model - perform: getMenuSelector - with: menu - with: shiftKeyState. - aTitle ifNotNil: [aMenu addTitle: aTitle]. - ^aMenu]. - ^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! Item was removed: - ----- Method: TwoWayScrollPane>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar (in category 'retractable scroll bar') ----- - hideOrShowScrollBar - - ^self "we don't support retractable at the moment"! Item was removed: - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar:forRange: (in category 'retractable scroll bar') ----- - hideOrShowScrollBar: scrollBar forRange: range - - (self hasProperty: #hideUnneededScrollbars) ifFalse: [^ self]. - (submorphs includes: scrollBar) - ifTrue: [range <= 0 ifTrue: [scrollBar model: nil; delete]] - ifFalse: [range > 0 ifTrue: [scrollBar model: self. self resizeScrollBar; addMorph: scrollBar]] - ! Item was removed: - ----- Method: TwoWayScrollPane>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self addMorph: (yScrollBar := self createScrollBarNamed: 'yScrollBar'); - addMorph: (xScrollBar := self createScrollBarNamed: 'xScrollBar'); - addMorph: (scroller := self createScroller). - "" - self extent: 150 @ 120! Item was removed: - ----- Method: TwoWayScrollPane>>keyStroke: (in category 'event handling') ----- - keyStroke: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - - scroller submorphs last keyStroke: evt! Item was removed: - ----- Method: TwoWayScrollPane>>leftOrRight (in category 'menu') ----- - leftOrRight "Change scroll bar location" - - "used to handle left vs right scrollbar"! Item was removed: - ----- Method: TwoWayScrollPane>>leftoverScrollRange (in category 'geometry') ----- - leftoverScrollRange - "Return the entire scrolling range minus the currently viewed area." - ^ self totalScrollRange - (self innerBounds extent * 3 // 4) max: 0 at 0 - ! Item was removed: - ----- Method: TwoWayScrollPane>>menuSelector: (in category 'menu') ----- - menuSelector: aSelector - getMenuSelector := aSelector! Item was removed: - ----- Method: TwoWayScrollPane>>menuTitleSelector: (in category 'menu') ----- - menuTitleSelector: aSelector - getMenuTitleSelector := aSelector! Item was removed: - ----- Method: TwoWayScrollPane>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - evt yellowButtonPressed "First check for option (menu) click" - ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]! Item was removed: - ----- Method: TwoWayScrollPane>>mouseEnter: (in category 'event handling') ----- - mouseEnter: event - - "used to handle retractable scrolbar"! Item was removed: - ----- Method: TwoWayScrollPane>>mouseLeave: (in category 'event handling') ----- - mouseLeave: event - - "used to handle retractable scrolbar"! Item was removed: - ----- Method: TwoWayScrollPane>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]! Item was removed: - ----- Method: TwoWayScrollPane>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]! Item was removed: - ----- Method: TwoWayScrollPane>>rejectsEvent: (in category 'events-processing') ----- - rejectsEvent: anEvent - - scroller submorphs isEmpty ifTrue: [^true]. "something messed up here" - scroller firstSubmorph isSyntaxMorph ifTrue: [^ super rejectsEvent: anEvent]. - ^self visible not "ignore locked status"! Item was removed: - ----- Method: TwoWayScrollPane>>resizeScrollBar (in category 'geometry') ----- - resizeScrollBar - "used to handle left vs right scrollbar" - yScrollBar bounds: (bounds topLeft extent: 16 @ (bounds height - 16)). - xScrollBar bounds: ((bounds left + 16) @ (bounds bottom - 16) extent: (bounds width - 16) @ 16). - ! Item was removed: - ----- Method: TwoWayScrollPane>>resizeScroller (in category 'geometry') ----- - resizeScroller - | inner | - "used to handle left vs right scrollbar" - inner := self innerBounds. - scroller bounds: (inner topLeft + (yScrollBar width at 0) corner: (inner bottomRight - (0 at xScrollBar height)))! Item was removed: - ----- Method: TwoWayScrollPane>>retractableOrNot (in category 'menu') ----- - retractableOrNot "Change scroll bar operation" - - "used to handle retractable scrolbar"! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarFills: (in category 'geometry') ----- - scrollBarFills: aRectangle - "Return true if a flop-out scrollbar fills the rectangle" - "used to handle retractable scrolbar" - ^ false! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - scrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarOnLeft: (in category 'menu') ----- - scrollBarOnLeft: aBoolean - - "used to handle left vs right scrollbar"! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBy: (in category 'geometry') ----- - scrollBy: delta - "Move the contents in the direction delta." - "For now, delta is assumed to have a zero x-component. Used by scrollIntoView:" - | r newOffset | - - newOffset := (scroller offset - delta max: 0 at 0) min: self leftoverScrollRange. - scroller offset: newOffset. - - r := self leftoverScrollRange. - r y = 0 - ifTrue: [yScrollBar value: 0.0] - ifFalse: [yScrollBar value: newOffset y asFloat / r y]. - r x = 0 - ifTrue: [xScrollBar value: 0.0] - ifFalse: [xScrollBar value: newOffset x asFloat / r x]. - ! Item was removed: - ----- Method: TwoWayScrollPane>>scrollIntoView:extra: (in category 'geometry') ----- - scrollIntoView: desiredRectangle extra: anumber - | shift | - - shift := desiredRectangle deltaToEnsureInOrCentered: ( - scroller offset extent: scroller bounds extent - ) extra: anumber. - shift = (0 @ 0) ifFalse: [self scrollBy: (0 at 0) - shift]. - ! Item was removed: - ----- Method: TwoWayScrollPane>>scroller (in category 'access') ----- - scroller - ^ scroller! Item was removed: - ----- Method: TwoWayScrollPane>>setScrollDeltas (in category 'geometry') ----- - setScrollDeltas - | range scrollDelta totalRange innerBounds | - totalRange := self totalScrollRange ifNil: [^ self]. - range := self leftoverScrollRange. - innerBounds := self innerBounds. - scrollDelta := 10 @ 10. - - self hideOrShowScrollBar: xScrollBar - forRange: totalRange x - (innerBounds width - yScrollBar width). - range x <= 0 - ifTrue: [xScrollBar scrollDelta: 0.02 pageDelta: 0.2. - xScrollBar interval: 1.0] - ifFalse: [xScrollBar scrollDelta: (scrollDelta x / range x) asFloat - pageDelta: (innerBounds width - scrollDelta x / range x) asFloat. - xScrollBar interval: (innerBounds width - scrollDelta x / totalRange x) asFloat]. - - self hideOrShowScrollBar: yScrollBar - forRange: totalRange y - (innerBounds height - xScrollBar height). - range y <= 0 - ifTrue: [yScrollBar scrollDelta: 0.02 pageDelta: 0.2. - yScrollBar interval: 1.0] - ifFalse: [yScrollBar scrollDelta: (scrollDelta y / range y) asFloat - pageDelta: (innerBounds height - scrollDelta y / range y) asFloat. - yScrollBar interval: (innerBounds height - scrollDelta y / totalRange y) asFloat]! Item was removed: - ----- Method: TwoWayScrollPane>>shiftedYellowButtonActivity (in category 'scroll bar events') ----- - shiftedYellowButtonActivity - ^ self yellowButtonActivity: true! Item was removed: - ----- Method: TwoWayScrollPane>>totalScrollRange (in category 'geometry') ----- - totalScrollRange - - "Return the entire scrolling range." - ^ ((scroller localSubmorphBounds ifNil: [^nil]) encompass: 0 at 0) extent - - ! Item was removed: - ----- Method: TwoWayScrollPane>>unshiftedYellowButtonActivity (in category 'scroll bar events') ----- - unshiftedYellowButtonActivity - ^ self yellowButtonActivity: false! Item was removed: - ----- Method: TwoWayScrollPane>>wantsSlot (in category 'access') ----- - wantsSlot - "For now do it the old way, until we sort this out" - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>wantsYellowButtonMenu (in category 'menu') ----- - wantsYellowButtonMenu - "Answer true if the receiver wants a yellow button menu" - ^ getMenuSelector notNil! Item was removed: - ----- Method: TwoWayScrollPane>>xScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - xScrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed! Item was removed: - ----- Method: TwoWayScrollPane>>xScrollBarValue: (in category 'scroll bar events') ----- - xScrollBarValue: scrollValue - - "although there appear to be no senders, see Slider>>setValue:" - - scroller hasSubmorphs ifFalse: [^ self]. - scroller offset: self leftoverScrollRange x * scrollValue @ scroller offset y! Item was removed: - ----- Method: TwoWayScrollPane>>xScrollerHeight (in category 'retractable scroll bar') ----- - xScrollerHeight - - (submorphs includes: xScrollBar) "Sorry the logic is reversed :( " - ifFalse: [^ 0 @ 0] "already included" - ifTrue: [^ 0 @ xScrollBar height] "leave space for it" - ! Item was removed: - ----- Method: TwoWayScrollPane>>yScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - yScrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed! Item was removed: - ----- Method: TwoWayScrollPane>>yScrollBarValue: (in category 'scroll bar events') ----- - yScrollBarValue: scrollValue - - "although there appear to be no senders, see Slider>>setValue:" - - scroller hasSubmorphs ifFalse: [^ self]. - scroller offset: scroller offset x @ (self leftoverScrollRange y * scrollValue)! Item was removed: - ----- Method: TwoWayScrollPane>>yellowButtonActivity: (in category 'scroll bar events') ----- - yellowButtonActivity: shiftKeyState - | menu | - (menu := self getMenu: shiftKeyState) ifNotNil: - [menu setInvokingView: self. - menu popUpEvent: self activeHand lastEvent in: self world]! Item was removed: - BasicButton subclass: #URLMorph - instanceVariableNames: 'url page isBookmark book' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SqueakPage'! - - !URLMorph commentStamp: '<historical>' prior: 0! - This morph represents a URL for a SqueakPage. It displays the thumbnail for the associated page, if available. Used in page sorters and for bookmarks. - - This morph has several options: - a. It can act like a thumbnail for sorting (in which case it can be picked up and dragged) or it acts as a bookmark (in which case shift clicking on it activates it). - b. If it has book set to true, it is a page in a book. Clicking fetches the index of the book, opens it to the first page, and puts it in the hand. - - A thumbnail on a known book: - (URLMorph grabURL: 'ftp://doltest1.disney.com/squeak/test/p1.sp') - book: true. - - A thumbnail on a single PasteUpMorph: - Make a PasteUpMorph with any morphs in it. - Decide where it should live, make a url string, and copy it. - 'file://HardDisk/books/book1/myPage.sp' - 'ftp://doltest1.disney.com/squeak/test/p1.sp' - Choose 'Save as Web Morph' - Paste in the url. - Drop the resulting thumbnail into some morph. - - See SqueakPage's comment for the stages of in/out. - - url - page A SqueakPage - isBookmark Boolean - book A Boolean -- whether I represent a whole book or a page. - ! Item was removed: - ----- Method: URLMorph class>>grabForBook: (in category 'instance creation') ----- - grabForBook: bookMorph - "Create a URLMorph for this book. Put it into the hand." - - | um bookUrl pageUrl pg | - bookUrl := bookMorph valueOfProperty: #url. - pageUrl := bookMorph currentPage url. "should have one!!" - pg := SqueakPageCache atURL: pageUrl. - (SqueakPage stemUrl: bookUrl) = (SqueakPage stemUrl: pageUrl) - ifTrue: [bookUrl := true]. "not a shared book" - um := URLMorph newForURL: pageUrl. - um setURL: pageUrl page: pg. - pg isContentsInMemory ifTrue: [pg computeThumbnail]. - um isBookmark: true. - um book: bookUrl. - um removeAllMorphs. - um color: Color transparent. - Smalltalk currentHand attachMorph: um. - ^ um! Item was removed: - ----- Method: URLMorph class>>grabURL: (in category 'instance creation') ----- - grabURL: aURLString - "Create a URLMorph for this url. Drop it and click it to get the SqueakPage." - - | um | - (um := self new) isBookmark: true; setURL: aURLString page: nil. - HandMorph attach: um. - ^ um! Item was removed: - ----- Method: URLMorph class>>newBookmarkForURL: (in category 'instance creation') ----- - newBookmarkForURL: aURLString - - ^ (self newForURL: aURLString) isBookmark: true - ! Item was removed: - ----- Method: URLMorph class>>newForURL: (in category 'instance creation') ----- - newForURL: aURLString - - | pg | - pg := SqueakPageCache atURL: aURLString. - ^ self new setURL: aURLString page: pg - ! Item was removed: - ----- Method: URLMorph>>book (in category 'accessing') ----- - book - - ^ book - ! Item was removed: - ----- Method: URLMorph>>book: (in category 'accessing') ----- - book: aUrl - "A notation about what book this page is in. true means page is in same book as url strm says. Set to the url of the Book if the book has a different stem url. nil or false if not for a book page at all." - - book := aUrl! Item was removed: - ----- Method: URLMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was removed: - ----- Method: URLMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - "Draw thumbnail for my page, if it is available. Otherwise, just draw a rectangle." - - | thumbnail oldExt | - self color == Color transparent - ifTrue: ["show thumbnail" - thumbnail := self thumbnailOrNil. - thumbnail - ifNil: [aCanvas frameRectangle: self bounds width: self borderWidth - color: self borderColor. - aCanvas fillRectangle: (self bounds insetBy: self borderWidth) color: self color] - ifNotNil: [oldExt := self bounds extent. - bounds := self bounds origin extent: thumbnail extent + (2 at 2). - aCanvas frameRectangle: self bounds width: self borderWidth color: self borderColor. - aCanvas paintImage: thumbnail at: self bounds origin + self borderWidth. - oldExt = thumbnail extent ifFalse: [self layoutChanged]]] - ifFalse: ["show labeled button" - ^ super drawOn: aCanvas] - ! Item was removed: - ----- Method: URLMorph>>enclosingBook (in category 'private') ----- - enclosingBook - "rethink this since class WebBookMorph is gone"! Item was removed: - ----- Method: URLMorph>>enclosingPage (in category 'private') ----- - enclosingPage - "Answer the inner-most SqueakPage contents that contains this morph, or nil if there isn't one." - - self allOwnersDo: - [:m | (m isKindOf: PasteUpMorph) - ifTrue: [(SqueakPageCache pageForMorph: m) ifNotNil: [:pg | ^ pg]]]. - ^ nil - ! Item was removed: - ----- Method: URLMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: event - - ^ isBookmark & event shiftPressed - ! Item was removed: - ----- Method: URLMorph>>handlesMouseUp: (in category 'event handling') ----- - handlesMouseUp: evt - - ^ isBookmark - ! Item was removed: - ----- Method: URLMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - - isBookmark := false! Item was removed: - ----- Method: URLMorph>>isBookmark (in category 'accessing') ----- - isBookmark - - ^ isBookmark - ! Item was removed: - ----- Method: URLMorph>>isBookmark: (in category 'accessing') ----- - isBookmark: aBoolean - "Make this morph behave as a clickable bookmark if the argument is true." - - isBookmark := aBoolean. - ! Item was removed: - ----- Method: URLMorph>>label:font: (in category 'private') ----- - label: aString font: aFontOrNil - - | oldLabel m aFont | - (oldLabel := self findA: StringMorph) - ifNotNil: [oldLabel delete]. - (oldLabel := self findA: TextMorph) - ifNotNil: [oldLabel delete]. - aFont := aFontOrNil ifNil: [Preferences standardButtonFont]. - m := TextMorph new contents: aString; beAllFont: aFont. - self extent: (m width + 6) @ (m height + 6). - m position: self center - (m extent // 2). - self addMorph: m. - m lock - ! Item was removed: - ----- Method: URLMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - "do nothing" - ! Item was removed: - ----- Method: URLMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - | pg ow newPage mm bookUrl bk | - "If url of a book, open it to that page, or bring it in and open to that page." - book ifNotNil: [book == false ifFalse: [ - (bookUrl := book) isString ifFalse: [ - bookUrl := (SqueakPage stemUrl: url), '.bo']. - (bk := BookMorph isInWorld: self world withUrl: bookUrl) isSymbol - ifFalse: [^ bk goToPageUrl: url]. - bk == #conflict ifTrue: [ - ^ self inform: 'This book is already open in some other project']. - (bk := BookMorph new fromURL: bookUrl) ifNil: [^ self]. - bk goToPageUrl: url. "turn to the page" - ^ HandMorph attach: bk]]. - - "If inside a SqueakPage, replace it!!" - pg := self enclosingPage. - pg ifNotNil: [ - (ow := pg contentsMorph owner) ifNotNil: [ - pg contentsMorph delete. "from its owner" - newPage := SqueakPageCache atURL: url. - mm := newPage fetchContents. - mm ifNotNil: [ow addMorph: mm. - page := newPage]. - ^ self]]. - "If I am a project, jump -- not done yet" - - "For now, just put new page on the hand" - newPage := SqueakPageCache atURL: url. - mm := newPage fetchInformIfError. - mm ifNotNil: [self primaryHand attachMorph: mm. - page := newPage]. - - ! Item was removed: - ----- Method: URLMorph>>page (in category 'accessing') ----- - page - "Answer the cached page that this morph represents." - - ^ page - ! Item was removed: - ----- Method: URLMorph>>pageHasChanged: (in category 'updating') ----- - pageHasChanged: aSqueakPage - "The given page has changed. Update this morph if it refers to the given page." - - | thumbnail | - page == aSqueakPage ifFalse: [^ self]. "this change does not affect me" - thumbnail := self thumbnailOrNil. - thumbnail ifNotNil: [ - self extent: (thumbnail extent + 2). - self changed]. - ! Item was removed: - ----- Method: URLMorph>>setURL:page: (in category 'private') ----- - setURL: aURLString page: aSqueakPage - "Initialize the receiver for the given URL and page." - - url := aURLString. - page := aSqueakPage. - page ifNotNil: [self pageHasChanged: page]. - ! Item was removed: - ----- Method: URLMorph>>thumbnailOrNil (in category 'private') ----- - thumbnailOrNil - "Answer the thumbnail Form for the page this morph represents. Answer nil if no thumbnail is available." - - | thum | - page ifNil: [page := SqueakPageCache atURL: url]. - (thum := page thumbnail) ifNil: [^nil]. - ^(thum isForm) - ifTrue: [thum] - ifFalse: [thum form "a BookPageThumbnailMorph"]! Item was removed: - ----- Method: URLMorph>>url (in category 'accessing') ----- - url - "Answer the URL for the page that this morph represents." - - ^ url - ! Item was removed: - ----- Method: UpdatingMenuItemMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - wordingProvider := wordingProvider adaptedToWorld: aWorld.! Item was removed: - RectangleMorph subclass: #UpdatingRectangleMorph - instanceVariableNames: 'target lastValue getSelector putSelector contents' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Support'! - - !UpdatingRectangleMorph commentStamp: '<historical>' prior: 0! - Intended for use as a color swatch coupled to a color obtained from the target, but made just slightly more general than that.! Item was removed: - ----- Method: UpdatingRectangleMorph>>contents (in category 'accessing') ----- - contents - ^ contents! Item was removed: - ----- Method: UpdatingRectangleMorph>>contents: (in category 'accessing') ----- - contents: c - contents := c! Item was removed: - ----- Method: UpdatingRectangleMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color lightGray lighter! Item was removed: - ----- Method: UpdatingRectangleMorph>>getSelector (in category 'accessing') ----- - getSelector - "Answer the getSelector" - - ^ getSelector! Item was removed: - ----- Method: UpdatingRectangleMorph>>getSelector: (in category 'accessing') ----- - getSelector: aSymbol - - getSelector := aSymbol. - ! Item was removed: - ----- Method: UpdatingRectangleMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^putSelector notNil! Item was removed: - ----- Method: UpdatingRectangleMorph>>isEtoyReadout (in category 'accessing') ----- - isEtoyReadout - "Answer whether the receiver can serve as an etoy readout" - - ^ true! Item was removed: - ----- Method: UpdatingRectangleMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - self changeColorTarget: self selector: #setTargetColor: originalColor: color hand: evt hand.! Item was removed: - ----- Method: UpdatingRectangleMorph>>putSelector (in category 'accessing') ----- - putSelector - ^ putSelector! Item was removed: - ----- Method: UpdatingRectangleMorph>>putSelector: (in category 'accessing') ----- - putSelector: aSymbol - putSelector := aSymbol! Item was removed: - ----- Method: UpdatingRectangleMorph>>readFromTarget (in category 'target access') ----- - readFromTarget - "Read the color value from my target" - - | v | - (target isNil or: [getSelector isNil]) ifTrue: [^contents]. - target isMorph ifTrue: [target isInWorld ifFalse: [^contents]]. - v := self valueProvider perform: getSelector. - lastValue := v. - ^v! Item was removed: - ----- Method: UpdatingRectangleMorph>>setTargetColor: (in category 'setting') ----- - setTargetColor: aColor - "Set my target's color as indicated" - - putSelector ifNotNil: - [self color: aColor. - contents := aColor. - self valueProvider perform: self putSelector withArguments: (Array with: aColor)] - ! Item was removed: - ----- Method: UpdatingRectangleMorph>>step (in category 'stepping and presenter') ----- - step - | s | - super step. - s := self readFromTarget. - s = contents ifFalse: - [self contents: s. - self color: s] - ! Item was removed: - ----- Method: UpdatingRectangleMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^ 50! Item was removed: - ----- Method: UpdatingRectangleMorph>>target (in category 'accessing') ----- - target - - ^ target - ! Item was removed: - ----- Method: UpdatingRectangleMorph>>target: (in category 'accessing') ----- - target: anObject - - target := anObject. - ! Item was removed: - ----- Method: UpdatingRectangleMorph>>userEditsAllowed (in category 'accessing') ----- - userEditsAllowed - "Answer whether it is suitable for a user to change the value represented by this readout" - - ^ putSelector notNil! Item was removed: - ----- Method: UpdatingRectangleMorph>>valueProvider (in category 'setting') ----- - valueProvider - "Answer the object to which my get/set messages should be sent. This is inefficient and contorted in order to support grandfathered content for an earlier design" - - ^ target isMorph - ifTrue: - [target topRendererOrSelf player ifNil: [target]] - ifFalse: - [target]! Item was removed: - ----- Method: UpdatingRectangleMorph>>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. - target := deepCopier references at: target ifAbsent: [target].! Item was removed: - ----- Method: UpdatingRectangleMorph>>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. - "target := target. Weakly copied" - lastValue := lastValue veryDeepCopyWith: deepCopier. - "getSelector := getSelector. a Symbol" - "putSelector := putSelector. a Symbol" - contents := contents veryDeepCopyWith: deepCopier.! Item was removed: - ----- Method: UpdatingStringMorph>>floatPrecision: (in category '*MorphicExtras-accessing') ----- - floatPrecision: aPrecision - "Set the receiver's number of decimal places to correspond with the given precision. The preferred protocol here is #decimalPlaces:, which conforms to the UI for this, but #floatPrecision: is retained for backward compatibility." - - self decimalPlaces: (Utilities decimalPlacesForFloatPrecision: aPrecision)! Item was removed: - FlapTab subclass: #ViewerFlapTab - instanceVariableNames: 'scriptedPlayer' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Flaps'! - - !ViewerFlapTab commentStamp: 'kfr 10/28/2003 06:31' prior: 0! - ViewerFlapTab are flap tabs for etoy scripting viewers.! Item was removed: - ----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'viewerFlapTab' translatedNoop! Item was removed: - ----- Method: ViewerFlapTab class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Not to be instantiated from the menu" - ^ false! Item was removed: - ----- Method: ViewerFlapTab>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - "Add further items to the menu as appropriate. NB: Cannot call super here." - - aMenu add: 'flap color...' translated target: self action: #changeFlapColor. - aMenu addLine. - aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo. - aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior. - aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior. - aMenu addLine. - aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap. - - aMenu add: 'destroy this flap' translated action: #destroyFlap! Item was removed: - ----- Method: ViewerFlapTab>>adjustPositionAfterHidingFlap (in category 'show & hide') ----- - adjustPositionAfterHidingFlap - "we add the width of flap itself to our referent, to reflect the actual width from the edge of the screen, including the space we leave for other flaps. see also ViewerFlapTab>>fitOnScreen" - self flag: #todo. - self referent width: self referent width + self width. - super adjustPositionAfterHidingFlap.! Item was removed: - ----- Method: ViewerFlapTab>>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." - - ^ flapShowing - ifTrue: [#()] - ifFalse: [Array with: referent]! Item was removed: - ----- Method: ViewerFlapTab>>changeCompactFlap (in category 'compact') ----- - changeCompactFlap - self makeFlapCompact: self isFlapCompact not.! Item was removed: - ----- Method: ViewerFlapTab>>compactFlapString (in category 'compact') ----- - compactFlapString - ^ (self isFlapCompact - ifTrue: ['<on>compact flap'] - ifFalse: ['<off>']), 'compact flap' translated! Item was removed: - ----- Method: ViewerFlapTab>>fitOnScreen (in category 'positioning') ----- - fitOnScreen - | constrainer | - super fitOnScreen. - "We want to leave a margin for the flaps on the side and for the global flaps at the top (like the Sugar navbar) so we reduce the referents top and its width. We undo this before hiding the flap in ViewerFlapTab>>adjustPositionAfterHidingFlap" - self flag: #todo. - constrainer := (owner ifNil: [self]) clearArea. - self flapShowing ifTrue: [ - Flaps globalFlapTabsIfAny - do: [:each | - (each edgeToAdhereTo = #top and: [each bottom > self referent top]) - ifTrue: [self referent top: each bottom]. - (each edgeToAdhereTo = #top and: [each bottom > self top]) - ifTrue: [self top: each bottom]]. - self referent width: constrainer right - self width - self right].! Item was removed: - ----- Method: ViewerFlapTab>>graphicalMorphForTab (in category 'menu') ----- - graphicalMorphForTab - "Answer a graphical morph to serve as my tab's display" - - ^ ThumbnailMorph new objectToView: scriptedPlayer viewSelector: #graphicForViewerTab! Item was removed: - ----- Method: ViewerFlapTab>>hibernate (in category 'transition') ----- - hibernate - "drop my viewer to save space when writing to the disk." - - referent submorphs do: - [:m | (m isViewer) ifTrue: [m delete]]! Item was removed: - ----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') ----- - initializeFor: aPlayer topAt: aTop - - scriptedPlayer := aPlayer. - self useGraphicalTab. - self top: aTop! Item was removed: - ----- Method: ViewerFlapTab>>isCurrentlyGraphical (in category 'accessing') ----- - isCurrentlyGraphical - ^ true! Item was removed: - ----- Method: ViewerFlapTab>>isFlapCompact (in category 'compact') ----- - isFlapCompact - "Return true if the referent of the receiver represents a 'compact' flap" - referent layoutPolicy ifNil:[^false]. - referent layoutPolicy isTableLayout ifFalse:[^false]. - referent vResizing == #shrinkWrap ifFalse:[^false]. - ^true! Item was removed: - ----- Method: ViewerFlapTab>>makeFlapCompact: (in category 'compact') ----- - makeFlapCompact: aBool - "Return true if the referent of the receiver represents a 'compact' flap" - aBool ifTrue:[ - referent - layoutPolicy: TableLayout new; - vResizing: #shrinkWrap; - useRoundedCorners. - ] ifFalse:[ - referent - layoutPolicy: nil; - vResizing: #rigid; - useSquareCorners. - ].! Item was removed: - ----- Method: ViewerFlapTab>>scriptedPlayer (in category 'access') ----- - scriptedPlayer - ^ scriptedPlayer! Item was removed: - ----- Method: ViewerFlapTab>>unhibernate (in category 'transition') ----- - unhibernate - "recreate my viewer" - - | wasShowing viewer | - referent ifNotNil: [referent isViewer ifTrue: [^self]]. - wasShowing := flapShowing. - "guard against not-quite-player-players" - viewer := ((scriptedPlayer respondsTo: #costume) - and: [scriptedPlayer costume isMorph]) - ifTrue: [self presenter viewMorph: scriptedPlayer costume] - ifFalse: [self presenter viewObjectDirectly: scriptedPlayer]. - wasShowing ifFalse: [self hideFlap]. - ^viewer! Item was removed: - AlignmentMorph subclass: #WaveEditor - instanceVariableNames: 'graph samplingRate perceivedFrequency loopEnd loopLength loopCycles possibleLoopStarts keyboard' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-SoundInterface'! - - !WaveEditor commentStamp: '<historical>' prior: 0! - This tool was created to aid in the preparation of LoopedSampledSound objects. It includes support for finding good loop points with a little help from the user. Namely, the user must identify a good ending point for the loop (typically just before the decay phase begins) and identify one cycle of the waveform. After that, the "choose loop point" menu command can be invoked to search backwards to find and rank all possible loop starting points. Some experimentation is usually required to find a loop that "breaths" in a natural way. - - This tool can also be used as a general viewer of numerical sequences of any kind, such as time-varying functions, FFT data, etc.! Item was removed: - ----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'WaveEditor' translatedNoop - categories: {'Multimedia' translatedNoop} - documentation: 'A workbench for seing and editing wave forms' translatedNoop! Item was removed: - ----- Method: WaveEditor class>>openOn: (in category 'instance creation') ----- - openOn: dataCollection - "Open a new WaveEditor on the given sequencable collection of data." - - ^ (self new data: dataCollection) openInWorld - ! Item was removed: - ----- Method: WaveEditor>>addControls (in category 'initialization') ----- - addControls - | slider aWrapper m aButton | - aWrapper := AlignmentMorph newRow. - aWrapper color: Color transparent; - borderWidth: 0; - layoutInset: 0. - aWrapper hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - extent: 5 @ 5. - aWrapper wrapCentering: #topLeft. - aButton := self buttonName: 'X' action: #delete. - aButton setBalloonText: 'Close WaveEditor' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Menu' translated action: #invokeMenu. - aButton setBalloonText: 'Open a menu' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Play' translated action: #play. - aButton setBalloonText: 'Play sound' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor. - aButton setBalloonText: 'Play before cursor' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Play After' translated action: #playAfterCursor. - aButton setBalloonText: 'Play after cursor' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Play Loop' translated action: #playLoop. - aButton setBalloonText: 'Play the loop' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Test' translated action: #playTestNote. - aButton setBalloonText: 'Test the note' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Save' translated action: #saveInstrument. - aButton setBalloonText: 'Save the sound' translated. - aWrapper addMorphBack: aButton. - - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd. - aButton setBalloonText: 'Set loop end at cursor' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle. - aButton setBalloonText: 'Set one cycle' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart. - aButton setBalloonText: 'Set the loop start at cursor' translated. - aWrapper addMorphBack: aButton. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - self addMorphBack: aWrapper. - aWrapper := AlignmentMorph newRow. - aWrapper color: self color; - borderWidth: 0; - layoutInset: 0. - aWrapper hResizing: #spaceFill; - vResizing: #rigid; - extent: 5 @ 20; - wrapCentering: #center; - cellPositioning: #leftCenter. - m := StringMorph new contents: 'Index: ' translated; - font: Preferences standardEToysButtonFont. - aWrapper addMorphBack: m. - m := UpdatingStringMorph new target: graph; - getSelector: #cursor; - putSelector: #cursor:; - font: Preferences standardEToysButtonFont; - growable: false; - width: 71; - step. - aWrapper addMorphBack: m. - m := StringMorph new contents: 'Value: ' translated; - font: Preferences standardEToysButtonFont. - aWrapper addMorphBack: m. - m := UpdatingStringMorph new target: graph; - getSelector: #valueAtCursor; - putSelector: #valueAtCursor:; - font: Preferences standardEToysButtonFont; - growable: false; - width: 50; - step. - aWrapper addMorphBack: m. - slider := SimpleSliderMorph new color: color; - extent: 200 @ 10; - target: self; - actionSelector: #scrollTime:. - aWrapper addMorphBack: slider. - m := Morph new color: aWrapper color; - extent: 10 @ 5. - "spacer" - aWrapper addMorphBack: m. - m := UpdatingStringMorph new target: graph; - getSelector: #startIndex; - putSelector: #startIndex:; - font: Preferences standardEToysButtonFont; - width: 40; - step. - aWrapper addMorphBack: m. - self addMorphBack: aWrapper! Item was removed: - ----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') ----- - addLoopPointControls - - | m aWrapper | - aWrapper := AlignmentMorph newRow. - aWrapper color: self color; borderWidth: 0; layoutInset: 0. - aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5 at 20; wrapCentering: #center; cellPositioning: #leftCenter. - - m := StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont. - aWrapper addMorphBack: m. - m := UpdatingStringMorph new - target: self; getSelector: #loopEnd; putSelector: #loopEnd:; - font: Preferences standardEToysButtonFont; - growable: false; width: 100; step. - aWrapper addMorphBack: m. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - m := StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont. - aWrapper addMorphBack: m. - m := UpdatingStringMorph new - target: self; getSelector: #loopLength; putSelector: #loopLength:; - floatPrecision: 0.001; - font: Preferences standardEToysButtonFont; - growable: false; width: 100; step. - aWrapper addMorphBack: m. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - m := StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont. - aWrapper addMorphBack: m. - m := UpdatingStringMorph new - target: self; getSelector: #loopCycles; putSelector: #loopCycles:; - floatPrecision: 0.001; - font: Preferences standardEToysButtonFont; - growable: false; width: 100; step. - aWrapper addMorphBack: m. - aWrapper addTransparentSpacerOfSize: 4 @ 1. - m := StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont. - aWrapper addMorphBack: m. - m := UpdatingStringMorph new - target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:; - floatPrecision: 0.001; - font: Preferences standardEToysButtonFont; - growable: false; width: 100; step. - aWrapper addMorphBack: m. - - self addMorphBack: aWrapper - ! Item was removed: - ----- Method: WaveEditor>>autoCorrolationBetween:and:length: (in category 'other') ----- - autoCorrolationBetween: index1 and: index2 length: length - "Answer the cummulative error between the portions of my waveform starting at the given two indices and extending for the given length. The larger this error, the greater the difference between the two waveforms." - - | data error i1 e | - data := graph data. - error := 0. - i1 := index1. - index2 to: (index2 + length - 1) do: [:i2 | - e := (data at: i1) - (data at: i2). - e < 0 ifTrue: [e := 0 - e]. - error := error + e. - i1 := i1 + 1]. - ^ error - ! Item was removed: - ----- Method: WaveEditor>>chooseLoopStart (in category 'menu') ----- - chooseLoopStart - - | bestLoops choice start labels values | - possibleLoopStarts ifNil: [ - UIManager default - informUser: 'Finding possible loop points...' translated - during: [possibleLoopStarts := self findPossibleLoopStartsFrom: graph cursor]]. - bestLoops := possibleLoopStarts copyFrom: 1 to: (100 min: possibleLoopStarts size). - labels := OrderedCollection new. - values := OrderedCollection new. - bestLoops do: [:entry | - | secs | - secs := ((loopEnd - entry first) asFloat / self samplingRate) printShowingMaxDecimalPlaces: 2. - labels add: ('{1} cycles; {2} secs' translated format:{entry third. secs}). - values add: entry]. - choice := UIManager default chooseFrom: labels values: values. - choice ifNil: [^ self]. - loopCycles := choice third. - start := self fractionalLoopStartAt: choice first. - self loopLength: (loopEnd asFloat - start) + 1.0. - ! Item was removed: - ----- Method: WaveEditor>>data: (in category 'accessing') ----- - data: newData - - graph data: newData. - ! Item was removed: - ----- Method: WaveEditor>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 2! Item was removed: - ----- Method: WaveEditor>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was removed: - ----- Method: WaveEditor>>errorBetween:and: (in category 'other') ----- - errorBetween: sampleArray1 and: sampleArray2 - "Answer the cummulative error between the two sample arrays, which are assumed to be the same size." - - | error e | - error := 0. - 1 to: sampleArray1 size do: [:i | - e := (sampleArray1 at: i) - (sampleArray2 at: i). - e < 0 ifTrue: [e := 0 - e]. - error := error + e]. - ^ error - ! Item was removed: - ----- Method: WaveEditor>>findPossibleLoopStartsFrom: (in category 'other') ----- - findPossibleLoopStartsFrom: index - "Assume loopEnd is one sample before a zero-crossing." - - | r postLoopCycleStart i postLoopCycleLength cycleLength cycleCount err oldI | - r := OrderedCollection new. - - "Record the start and length of the first cycle after the loop endpoint." - postLoopCycleStart := loopEnd + 1. "Assumed to be a zero-crossing." - i := self zeroCrossingAfter: postLoopCycleStart - + (0.9 * samplingRate / perceivedFrequency) asInteger. - postLoopCycleLength := i - loopEnd - 1. - - "Step backwards one cycle at a time, using zero-crossings to find the - beginning of each cycle, and record the auto-corrolation error between - each cycle and the cycle following the loop endpoint. Assume pitch may shift gradually." - i := self zeroCrossingAfter: postLoopCycleStart - - (1.1 * postLoopCycleLength) asInteger. - cycleLength := postLoopCycleStart - i. - cycleCount := 1. - [cycleLength > 0] whileTrue: - [err := self - autoCorrolationBetween: i - and: postLoopCycleStart - length: postLoopCycleLength. - r add: (Array - with: i - with: err - with: cycleCount - with: ((loopEnd - i) asFloat / self samplingRate roundTo: 0.01)). - oldI := i. - i := self zeroCrossingAfter: oldI - (1.1 * cycleLength) asInteger. - cycleLength := oldI - i. "will be zero when start of data is encountered" - cycleCount := cycleCount + 1]. - ^r asArray sort: [:e1 :e2 | e1 second < e2 second]! Item was removed: - ----- Method: WaveEditor>>fractionalLoopStartAt: (in category 'other') ----- - fractionalLoopStartAt: index - "Answer the fractional index starting point near the given integral index that results in the closest match with the cycle following the loop end." - "Note: could do this more efficiently by sliding downhill on the error curve to find lowest error." - - | oneCycle w1 minErr w2 err bestIndex | - oneCycle := (samplingRate / perceivedFrequency) rounded. - w1 := self interpolatedWindowAt: loopEnd + 1 width: oneCycle. - minErr := SmallInteger maxVal. - ((index - 2) max: 1) to: ((index + 2) min: graph data size) by: 0.01 do: [:i | - w2 := self interpolatedWindowAt: i width: oneCycle. - err := self errorBetween: w1 and: w2. - err < minErr ifTrue: [ - bestIndex := i. - minErr := err]]. - ^ bestIndex - ! Item was removed: - ----- Method: WaveEditor>>graph (in category 'accessing') ----- - graph - - ^ graph - ! Item was removed: - ----- Method: WaveEditor>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - samplingRate := SoundPlayer samplingRate. - loopEnd := loopLength := 0. - loopCycles := 1. - perceivedFrequency := 0. - "zero means unknown" - self extent: 5 @ 5; - listDirection: #topToBottom; - wrapCentering: #topLeft; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 3. - graph := GraphMorph new extent: 450 @ 100. - - graph cursor: 0. - graph cursorColorAtZeroCrossings: Color blue. - self addControls. - self addLoopPointControls. - self addMorphBack: graph. - self - addMorphBack: (Morph - newBounds: (0 @ 0 extent: 0 @ 3) - color: Color transparent). - self addMorphBack: (keyboard := PianoKeyboardMorph new). - "self sound: (SampledSound soundNamed: 'croak')." - ! Item was removed: - ----- Method: WaveEditor>>interpolatedWindowAt:width: (in category 'other') ----- - interpolatedWindowAt: index width: nSamples - "Return an array of N samples starting at the given index in my data." - - | scale data baseIndex scaledFrac scaledOneMinusFrac prevSample | - scale := 10000. - data := graph data. - index isInteger - ifTrue: [^ (index to: index + nSamples - 1) collect: [:i | data at: i]]. - baseIndex := index truncated. - scaledFrac := ((index asFloat - baseIndex) * scale) truncated. - scaledOneMinusFrac := scale - scaledFrac. - prevSample := data at: baseIndex. - ^ (baseIndex + 1 to: baseIndex + nSamples) collect: [:i | | v nextSample | - nextSample := data at: i. - v := ((nextSample * scaledFrac) + (prevSample * scaledOneMinusFrac)) // scale. - prevSample := nextSample. - v]. - ! Item was removed: - ----- Method: WaveEditor>>invokeMenu (in category 'menu') ----- - invokeMenu - "Invoke a menu of additonal functions for this WaveEditor." - - | aMenu | - aMenu := MenuMorph new. - aMenu addList: { - {'play straight through' translated. #play}. - {'play before cursor' translated. #playBeforeCursor}. - {'play after cursor' translated. #playAfterCursor}. - {'play test note' translated. #playTestNote}. - {'play loop' translated. #playLoop}. - {'trim before cursor' translated. #trimBeforeCursor}. - {'trim after cursor' translated. #trimAfterCursor}. - {'choose loop start' translated. #chooseLoopStart}. - {'jump to loop start' translated. #jumpToLoopStart}. - {'jump to loop end' translated. #jumpToLoopEnd}. - {'make unlooped' translated. #setUnlooped}. - {'make unpitched' translated. #setUnpitched}. - {'show envelope' translated. #showEnvelope}. - {'show FFT' translated. #showFFTAtCursor}}. - aMenu invokeModal.! Item was removed: - ----- Method: WaveEditor>>jumpToLoopEnd (in category 'menu') ----- - jumpToLoopEnd - - graph cursor: loopEnd; centerCursor. - ! Item was removed: - ----- Method: WaveEditor>>jumpToLoopStart (in category 'menu') ----- - jumpToLoopStart - - graph cursor: (loopEnd - loopLength) truncated; centerCursor. - ! Item was removed: - ----- Method: WaveEditor>>loopCycles (in category 'accessing') ----- - loopCycles - - ^ loopCycles - ! Item was removed: - ----- Method: WaveEditor>>loopCycles: (in category 'accessing') ----- - loopCycles: aNumber - - loopCycles := aNumber. - self loopLength: loopLength. "updates frequency" - ! Item was removed: - ----- Method: WaveEditor>>loopEnd (in category 'accessing') ----- - loopEnd - - ^ loopEnd - ! Item was removed: - ----- Method: WaveEditor>>loopEnd: (in category 'accessing') ----- - loopEnd: aNumber - - loopEnd := (aNumber asInteger max: 1) min: graph data size. - possibleLoopStarts := nil. - ! Item was removed: - ----- Method: WaveEditor>>loopLength (in category 'accessing') ----- - loopLength - - ^ loopLength - ! Item was removed: - ----- Method: WaveEditor>>loopLength: (in category 'accessing') ----- - loopLength: aNumber - - loopLength := aNumber. - ((loopCycles > 0) and: [loopLength > 0]) ifTrue: [ - perceivedFrequency := samplingRate asFloat * loopCycles / loopLength]. - - ! Item was removed: - ----- Method: WaveEditor>>loopStart (in category 'accessing') ----- - loopStart - - ^ (loopEnd - loopLength) truncated + 1 - ! Item was removed: - ----- Method: WaveEditor>>loopStart: (in category 'accessing') ----- - loopStart: index - - | start len | - start := self fractionalLoopStartAt: index. - len := (loopEnd asFloat - start) + 1.0. - loopCycles := (len / (samplingRate / perceivedFrequency)) rounded. - self loopLength: len. - ! Item was removed: - ----- Method: WaveEditor>>makeLoopedSampledSound (in category 'menu') ----- - makeLoopedSampledSound - | data end snd basePitch | - data := graph data. - snd := (loopEnd = 0 or: [loopLength = 0]) - ifTrue: - ["save as unlooped" - - basePitch := perceivedFrequency = 0 - ifTrue: [100.0] - ifFalse: [perceivedFrequency]. - LoopedSampledSound new - unloopedSamples: data - pitch: basePitch - samplingRate: samplingRate] - ifFalse: - [end := (loopEnd min: data size) max: 1. - basePitch := samplingRate * loopCycles / loopLength. - LoopedSampledSound new - samples: data - loopEnd: end - loopLength: end - pitch: basePitch - samplingRate: samplingRate]. - snd addReleaseEnvelope. - ^snd! Item was removed: - ----- Method: WaveEditor>>normalize: (in category 'other') ----- - normalize: sampleArray - "Return a copy of the given sample array scaled to use the maximum 16-bit sample range. Remove any D.C. offset." - - | max scale out | - max := 0. - sampleArray do: - [:s | - max := max max: s abs]. - scale := ((1 << 15) - 1) asFloat / max. - out := sampleArray species new: sampleArray size. - 1 to: sampleArray size - do: [:i | out at: i put: (scale * (sampleArray at: i)) truncated]. - ^out! Item was removed: - ----- Method: WaveEditor>>perceivedFrequency (in category 'accessing') ----- - perceivedFrequency - - ^ perceivedFrequency - - ! Item was removed: - ----- Method: WaveEditor>>perceivedFrequency: (in category 'accessing') ----- - perceivedFrequency: aNumber - - perceivedFrequency := aNumber. - (loopCycles > 0) ifTrue: [ - loopLength := samplingRate asFloat * loopCycles / perceivedFrequency]. - ! Item was removed: - ----- Method: WaveEditor>>play (in category 'menu') ----- - play - - graph data size < 2 ifTrue: [^ self]. - (SampledSound samples: graph data samplingRate: samplingRate) play. - - ! Item was removed: - ----- Method: WaveEditor>>playAfterCursor (in category 'menu') ----- - playAfterCursor - - self playFrom: graph cursor to: graph data size. - ! Item was removed: - ----- Method: WaveEditor>>playBeforeCursor (in category 'menu') ----- - playBeforeCursor - - self playFrom: 1 to: graph cursor. - ! Item was removed: - ----- Method: WaveEditor>>playFrom:to: (in category 'menu') ----- - playFrom: start to: end - - | sz i1 i2 snd | - sz := graph data size. - i1 := ((start + 1) min: sz) max: 1. - i2 := ((end + 1) min: sz) max: i1. - (i1 + 2) >= i2 ifTrue: [^ self]. - snd := SampledSound - samples: (graph data copyFrom: i1 to: i2) - samplingRate: samplingRate. - snd play. - ! Item was removed: - ----- Method: WaveEditor>>playLoop (in category 'menu') ----- - playLoop - - | sz i1 i2 snd len | - sz := graph data size. - i1 := ((loopEnd - loopLength) truncated min: sz) max: 1. - i2 := (loopEnd min: sz) max: i1. - len := (i2 - i1) + 1. - len < 2 ifTrue: [^ self]. - - snd := LoopedSampledSound new - samples: (graph data copyFrom: i1 to: i2) - loopEnd: len - loopLength: loopLength - pitch: 100.0 - samplingRate: samplingRate. - - "sustain for the longer of four loops or two seconds" - snd setPitch: 100.0 - dur: (((4.0 * loopLength) / samplingRate) max: 2.0) - loudness: 0.5. - snd play. - ! Item was removed: - ----- Method: WaveEditor>>playTestNote (in category 'menu') ----- - playTestNote - - | data end snd loopDur dur | - (loopEnd = 0 or: [loopLength = 0]) ifTrue: [^ self]. - data := graph data. - end := (loopEnd min: data size) max: 1. - snd := LoopedSampledSound new - samples: data loopEnd: end loopLength: loopLength - pitch: 100.0 samplingRate: samplingRate. - - loopDur := (4.0 * loopLength / samplingRate) max: 2.0. "longer of 4 loops or 2 seconds" - dur := (data size / samplingRate) + loopDur. - (snd - addReleaseEnvelope; - setPitch: 100.0 dur: dur loudness: 0.5) play. - ! Item was removed: - ----- Method: WaveEditor>>samplingRate (in category 'accessing') ----- - samplingRate - - ^ samplingRate - - ! Item was removed: - ----- Method: WaveEditor>>samplingRate: (in category 'accessing') ----- - samplingRate: samplesPerSecond - - samplingRate := samplesPerSecond. - ! Item was removed: - ----- Method: WaveEditor>>saveInstrument (in category 'menu') ----- - saveInstrument - - | name | - name := UIManager default request: 'Instrument name?' translated. - name isEmpty ifTrue: [^ self]. - AbstractSound soundNamed: name put: self makeLoopedSampledSound. - ! Item was removed: - ----- Method: WaveEditor>>scrollTime: (in category 'other') ----- - scrollTime: relativeValue - - graph startIndex: relativeValue * (graph data size - (graph width // 2)). - ! Item was removed: - ----- Method: WaveEditor>>setLoopEnd (in category 'menu') ----- - setLoopEnd - - graph cursor: (self zeroCrossingAfter: graph cursor) - 1. - self loopEnd: graph cursor. - - ! Item was removed: - ----- Method: WaveEditor>>setLoopStart (in category 'menu') ----- - setLoopStart - "Assuming that the loop end and approximate frequency have been set, this method uses the current cursor position to determine the loop length and the number of cycles." - - | start len | - start := graph cursor. - ((start >= loopEnd) or: [perceivedFrequency = 0]) ifTrue: [ - ^ self inform: - 'Please set the loop end and the approximate frequency - first, then position the cursor one or more cycles - before the loop end and try this again.' translated]. - len := (loopEnd - start) + 1. - loopCycles := (len / (samplingRate / perceivedFrequency)) rounded. - self loopLength: len. - - ! Item was removed: - ----- Method: WaveEditor>>setOneCycle (in category 'menu') ----- - setOneCycle - "Set the approximate frequency based on a single cycle specified by the user. To use this, first set the loop end, then place the cursor one full cycle before the loop end and invoke this method." - - | len | - len := loopEnd - graph cursor. - len > 0 ifTrue: [ - loopCycles := 1. - self loopLength: len]. - ! Item was removed: - ----- Method: WaveEditor>>setUnlooped (in category 'menu') ----- - setUnlooped - "Make this sound play straight through without looping." - - loopLength := 0. - loopCycles := 1. - ! Item was removed: - ----- Method: WaveEditor>>setUnpitched (in category 'menu') ----- - setUnpitched - "Make this instrument be unpitched and unlooped. Suitable for percussive sounds that should not be pitch-shifted when played. By convention, such sounds are played at a pitch of 100.0 to obtain their original pitch." - - loopLength := 0. - loopCycles := 0. - perceivedFrequency := 100.0. - ! Item was removed: - ----- Method: WaveEditor>>showEnvelope (in category 'menu') ----- - showEnvelope - "Show an envelope wave constructed by collecting the maximum absolute value of the samples in fixed-size time windows of mSecsPerQuantum." - - | data mSecsPerQuantum samplesPerQuantum result endOfQuantum maxThisQuantum s nSamples | - data := graph data. - mSecsPerQuantum := 10. - samplesPerQuantum := (mSecsPerQuantum / 1000.0) * self samplingRate. - result := WriteStream on: (Array new: data size // samplesPerQuantum). - endOfQuantum := samplesPerQuantum. - maxThisQuantum := 0. - nSamples := (data isKindOf: SoundBuffer) - ifTrue: [data monoSampleCount] - ifFalse: [data size]. - 1 to: nSamples do: [:i | - i asFloat > endOfQuantum ifTrue: [ - result nextPut: maxThisQuantum. - maxThisQuantum := 0. - endOfQuantum := endOfQuantum + samplesPerQuantum]. - s := data at: i. - s < 0 ifTrue: [s := 0 - s]. - s > maxThisQuantum ifTrue: [maxThisQuantum := s]]. - WaveEditor openOn: result contents. - ! Item was removed: - ----- Method: WaveEditor>>showFFTAtCursor (in category 'menu') ----- - showFFTAtCursor - - | data start availableSamples nu n fft r | - data := graph data. - start := graph cursor max: 1. - availableSamples := (data size - start) + 1. - nu := 12. - nu > (availableSamples highBit - 1) ifTrue: - [^ self inform: 'Too few samples after the cursor to take an FFT.' translated]. - n := 2 raisedTo: nu. - fft := FFT new nu: nu. - fft realData: ((start to: start + n - 1) collect: [:i | data at: i]). - fft transformForward: true. - r := (1 to: n // 2) collect: - [:i | ((fft realData at: i) squared + (fft imagData at: i) squared) sqrt]. - WaveEditor openOn: r. - - ! Item was removed: - ----- Method: WaveEditor>>sound: (in category 'accessing') ----- - sound: aSound - | buffer | - buffer := aSound samples mergeStereo. - graph data: buffer. - loopLength := loopEnd := buffer size. - self samplingRate: aSound originalSamplingRate. - loopCycles := buffer size / aSound originalSamplingRate * 400. - perceivedFrequency := 400. - ! Item was removed: - ----- Method: WaveEditor>>step (in category 'stepping and presenter') ----- - step - - keyboard soundPrototype: self makeLoopedSampledSound! Item was removed: - ----- Method: WaveEditor>>stretch:by: (in category 'other') ----- - stretch: sampleArray by: stretchFactor - "Return an array consisting of the given samples \stretched in time by the given factor." - - | out end incr i frac index | - out := OrderedCollection new: (stretchFactor * sampleArray size) asInteger + 1. - end := (sampleArray size - 1) asFloat. - incr := 1.0 / stretchFactor. - i := 1.0. - [i < end] whileTrue: [ - frac := i fractionPart. - index := i truncated. - i := i + incr. - out addLast: - (((1.0 - frac) * (sampleArray at: index)) + (frac * (sampleArray at: index + 1))) rounded]. - ^ out asArray - ! Item was removed: - ----- Method: WaveEditor>>trimAfterCursor (in category 'menu') ----- - trimAfterCursor - - graph data: (graph data copyFrom: 1 to: graph cursor). - ! Item was removed: - ----- Method: WaveEditor>>trimBeforeCursor (in category 'menu') ----- - trimBeforeCursor - - graph data: (graph data copyFrom: graph cursor to: graph data size). - graph cursor: 1. - - ! Item was removed: - ----- Method: WaveEditor>>zeroCrossingAfter: (in category 'other') ----- - zeroCrossingAfter: index - "Find the index of the next negative-to-non-negative transition at or after the current index. The result is the index, i, of a zero crossing such that the sample at i-1 is negative and the sample at i is zero or positive. Answer the index of the last sample if the end of the array is encountered before finding a zero crossing." - - | data end i | - data := graph data. - end := data size. - index <= 1 ifTrue: [^ 1]. - i := index - 1. - [(i <= end) and: [(data at: i) >= 0]] whileTrue: [i := i + 1]. "find next negative sample" - i >= end ifTrue: [^ end]. - - i := i + 1. - [(i <= end) and: [(data at: i) < 0]] whileTrue: [i := i + 1]. "find next non-negative sample" - ^ i - ! Item was removed: - RectangleMorph subclass: #WebCamMorph - instanceVariableNames: 'camNum camIsOn frameExtent displayForm resolution useFrameSize captureDelayMs showFPS framesSinceLastDisplay lastDisplayTime fps orientation' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-WebCam'! - - !WebCamMorph commentStamp: '<historical>' prior: 0! - INTRODUCTION - ========= - - WebCamMorph together with CameraPlugin (originally from MIT Scratch) provides an easy and cross platform way to use webcam input in Squeak and Etoys. The first version has been created specifically with Etoys in mind. To view a live feed simply drag a "WebCam" tile from the "WebCam" category in the objects tool. Open up a viewer on the morph and display the "camera settings" category to explore the following basic settings: - - "camera is on": turn the camera on/off. - - "camera number": usually the default of "1" is ok but if you have more than one camera connected then adjust between 1 and 9 for other instances of WebCamMorph. - - "max fps": leave as is for now. It is unusual for webcams to capture at higher than 30fps. See later for further explanation of how fps is controlled. - - "actual fps": read-only. Indicates the actual fps being achieved which can depend significantly on lighting conditions and capture resolution... - - "resolution": webcams can have a range of resolutions but for simplicity three are supported: "low" (160x120), "medium" (320x240) and "high" (640x480). Adjust in good lighting to see if "actual fps" increases. - - "use frame size": the resolution used for capturing can differ from the resolution used for display. If this setting is true then WebCamMorph is resized to match the camera resolution. If false then you are free to resize it however you want (via the "resize" halo button, use shift to preserve aspect ratio) - - - Beyond viewing a live feed WebCamMorph has been designed to support different uses including simple effects, time-lapse photography, stop-motion animation, character recognition, motion detection and more complex processing of every frame for feature detection. The following information is to help you understand how and why WebCamMorph operates so you can adjust it for your particular needs. - - - "FRAMES PER SECOND", LIGHTING & CAMERA RESOLUTION - ================================== - - The maximum possible frame rate depends on many factors, some of which are outside of our control. Frame rates differ between cameras and usually depend significantly on chosen resolution and lighting conditions. To ensure a balance between capturing every available frame and keeping everything else responsive, WebCamMorph dynamically adjusts the delay between capturing one frame and the next (does not apply when in "manual capture" mode, see later). - - WebCams often include automatic compensation for lighting conditions. In low lighting it takes significantly more time for the camera to get a picture than it does in good lighting conditions. For example 30fps may be possible with good lighting compared to 7fps in low lighting. So for best capture rates ensure you have good lighting!! - - Cameras have a "native" resolution at which frame rates are usually better than for other resolutions. Note though that the native resolution might be *higher* - than the *minimum* resolution available. It pays to experiment with different resolutions to find which one results in the highest frame rate. Use good lighting conditions when experimenting with resolutions. - - - "MANUAL CAPTURE" MODE - =============== - - In simply usage WebCamMorph automatically captures a frame and displays it. To support Etoys scripting a "manual capture" mode is provided where you or your script determines when to capture, when to apply effects (or not) and when to update the display. In between these steps you can do anything you want. Note that frames rates will be lower than that in automatic capture mode and that "skip frames" (described next) will need adjusting at very low capture rates. - - Tip: In manual mode the camera can be turned off. It will be turned on automatically when required and return to it's previous state after a frame has been captured. For capture periods of five seconds or more turning the camera off may save power, which can especially useful when running off batteries. For smaller periods leaving the camera on will avoid some delays and could help speed up webcam related scripts. - - - "SKIP FRAMES" - ======== - - Webcams and their drivers are typically designed for streaming live video and use internal buffering to help speed things up. At low capture rates the picture can appear to lag real-time because what you see is the next available buffer not the *latest* buffer. So for example if you capture a frame every ten seconds and there are three buffers being used then what you actually see may be thirty seconds old. We have little/no control over the number of buffers used and the actual number can vary between cameras and under different circumstances for the same camera. "skip frames" is provided to compensate for buffering so increase it when doing "manual" capturing until you see what you expect to see. Typically a setting of 8 is enough but I have had to use 20 with one particular camera in low lighting. - - - "SNAPSHOTS" - ======== - - Where as "capturing" is the process of getting an image from the Camera into Squeak/Etoys, a "snapshot" preserves whatever is currently displayed (which may be the captured image after effects have been applied). To store snapshots you need to designate a "holder" which at the moment can be either a "holder" morph or a "movie" morph. Create one of these before proceeding. To assign a holder open up a viewer for WebCamMorph, display the "snapshot" category and click in the box at the right of the entry called "snapshot holder". The cursor will now resemble a cross-hair and can be clicked on the target holder/movie morph. To take a single snapshot at any time click (!!) on the left of "take snapshot". In auto-capture mode WebCamMorph can also be set to take multiple consecutive snapshots . First, before turning the camera on, set a sensible limit using "snapshot limit" (to avoid using all the computers memory) then set "auto snapshot" to true. When the camera is next turned on then s napshots are taken for every frame until "snapshot limit" becomes zero. "snapshot limit" is automatically decremented but not reset to avoid problems (although you are free to reset it manually or via a script). - - - "EFFECTS" - WIP - ========= - - Similar to snapshots, a holder can be designated as the "effects holder". This holder is intended to be populated with "fx" morphs (coming soon) which will operate on captured frames prior to displaying. Stay tuned ;-) - - - CLEARING SNAPSHOT & EFFECTS HOLDERS - ========================= - - Keeping a link to snapshot or effects holders can tie up resources even after the target holders have been deleted and are no longer visible. To ensure this does not happen designate the WebCamMorph itself as the holder (for method see "snapshots" section above). - - - COMING SOON!! - ========= - - - Built-in basic effects such as brightness, contrast and hue. - - Image "fx" morphs for effects such as those found in MIT Scratch and many other types of effects/ image processing. - - More snapshot options, eg, store to file - - Demo projects - - ! Item was removed: - ----- Method: WebCamMorph class>>additionsToViewerCategories (in category 'scripting') ----- - 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." - ^ #( - - (#'camera' ( - (slot resolution '160x120, 320x240, 640x480 or 1280x960' - WebCamResolution readWrite Player getWebCamResolution Player setWebCamResolution:) - (slot orientation 'Natural (mirrored) or navtive (as from the camera' - WebCamOrientation readWrite Player getWebCamOrientation Player setWebCamOrientation:) - (slot cameraIsOn 'Whether the camera is on/off' Boolean readWrite Player getWebCamIsOn Player setWebCamIsOn:) - (slot useFrameSize 'Resize the player to match the camera''s frame size' - Boolean readWrite Player getUseFrameSize Player setUseFrameSize:) - (slot lastFrame 'A player with the last frame' Player readOnly Player getLastFrame unused unused) - (slot showFPS 'Whether to show the samera''s frames per second' Boolean readWrite Player getShowFPS Player setShowFPS:) - )) - ) - ! Item was removed: - ----- Method: WebCamMorph class>>allOff (in category 'accessing') ----- - allOff - self allInstancesDo: [:each | each off].! Item was removed: - ----- Method: WebCamMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self - partName: 'Camera' translatedNoop - categories: {'Multimedia' translatedNoop} - documentation: 'Web camera player.' translatedNoop - sampleImageForm: self icon! Item was removed: - ----- Method: WebCamMorph class>>icon (in category 'parts bin') ----- - icon - "Original file: imagecodericon.png" - - ^ (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: - 'iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAABmJLR0QA/wD/AP+gvaeTAAAA - CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1wIECy0ZfllfzgAAAB10RVh0Q29tbWVudABD - cmVhdGVkIHdpdGggVGhlIEdJTVDvZCVuAAAgAElEQVR42uW7yZNsV37f9znDnTOzMrOGrPHh - oR7mBtAC0BPAbpJqEpQ4tNkSF3JYbdMOLWhHmOEI/wE2rFCEubFX3lgOO+wQg3bYEbQtyaRE - kGx2mw12kw00UOjG9F7VG+rVkDXkeO/NO57jxc33RMlaOGjvfHKRmXc4957fPHyP+Dv/zj/E - sdhagBYGi4MUFolFIkCCxGIRSAwIiUCCAOzynBCAQNm6uUtUWCTWSoTNUEgqdHOLfTRbCbam - RpFkKZ6nUQgMCmyJNGCExVpBbS3SGmorELYGSoy1CGupLUhbUloJFszyY2uohUEYS2UBarCG - wkgsIGyFsUZojbRGShQgmvUiEGhoFokAFFIYpBXUQiKxCGGQFuzyv0GBUGByhHARGIwpSIuS - dtBCGwXUGCqsUFgcjHBRtsZBUywKoqCFFBZhFIYKZfVjwhs0ippHbyix1ABIauEgLECFxCBs - hRVgLYBFixprGiao5VVWgMVYDQ6KZvUKg6DhKlIgl48DgUWjhEFhG7pYgRUSjcBikLJGGkuF - beZDkBUZ8eyalhdRlTEC0I7PxeiM3kqPoqxx3YiqzkizGLCsBC0qKaA0CCkBBcKiqBsiYxHW - wYoKg2iOGIm1AgtYKkrhNdIpDJYKYxWCumGlsAhbUyGRgNYIpBAI7HKxEiXA0nBWCttw2QqU - kA0XhUJhANlQXgiEtRgMZVkjVEpRg60LlK2Zzy6oqoLuyiZlWTKbXSAxeG5IWlRkWYanFZ52 - QGjmkzOEgDDwwBYIYRHSRS7F3oqaGom2GqippMDaRn0NEtcajKgwVoBt2AHgILBU1Ev1NVai - lZCNbi8pIgQIIUFKpAGExcFihGhURAgU9rFcIFhyxzJLZmBKLscz8ioj8kOqyuBqn9n0iqLI - KaqS4fkdiixlc+MGV+NzHOkQ2xzX8UC7aKk4v3zIk0+sEsdX+F6EK10QAiNV857WYoWlRqNZ - ijxgoBF1C5ICKy1YSy0bRRXmEbMVyAopRSOyWliUACUaCXCsQUvQAqQERxq0MEghkEiUkIgq - BVNhASksgeuySFMUFbYqUNLB1CUtP2Rz7QlG4zPydIKQBmtKTs8Pub6+x2h6CqYkTWY8PDsE - BHsbW8wn51RFxWg8BGq0AFdWCCGRj5gkDA4GJcWSORIXs7zGQ+IihUQh0VaiUDi2+a2RaEmz - wEb3xVIJQEiLwGIBhcCKxjgKDGU5o6wsk+k5SrlEviYMutR5ChhGk3MCNyJfzFGipqoLfM9F - K5duu890dkGezVnkCVWdM48nbHQ3efDwIzqtNYoiazyBkCRZwqC3g5Ye2haUVi91W6JsI4VW - iMbjCNNwG3AaX4BFIIBqadCNhUq4SFsBoJVkabQatydFI9ZFkVOWC9phCyldhGgmSpIpR/d/ - TLc7IJ5PUMphNitZ6WR4TkgcT5jPr1Adje8HXIwvaUc9JtNrdtc2OXr4Ma52OLs+pt/qc3Jx - j+2NZ5inY3ylqcuUdDFllgwpixypFIPVHYQtQEhcaowFI0xjjqWiQqKoHou6tBZhDLUQGGPB - SrQwGKuQ1CBKrBBIC+r1V/7WW1I0oi6URC5FvioWXF+fEkVtfO0iqUmTGXmRcXZ+iKM1ZTFD - Cpd7Jx8RxxMc7aNsjudFFEXCfD7m+PxjrmdD+p0+dW1oeS1m8ZjpfIhUCoVlkceMp+dEUZu8 - WOC7HvFihrRwNTppRFsI+lEPgUQLixCWLJsihcB9ZL8AtZQOxCNpNs0ZIUGYxk3SSDcIpFrq - vhCicXNLmxAGEZiS+fgSCSySGKqClh/R66wSuS5aaabTM4TJOb28w+XoHoEX0o1Wmc0uOR5+ - ylp3hyydoRHMZ1dIoBVEtPw2UNHvDMiLFN8NKPI5eRajpaTltijrnCjoMJmeU1YFQoBDSVXO - mUwvWSySJiCSoKRFSIEUEkfUuFhcajTNurS1zW/AEQIlNFqAVkIg5FL/xTIAMjVxnhLogNB3 - GY/PqKuKukjprQ7otlYpyhRfubitLteTh7hSMb4+pi4yJAYpNRu9deqqwpic0+EhWvkoDKEO - cLXDZD5kc3eT46EhcgKm8zFrK1ucX92jHXYwVY7jKOrasN3fwFeSqqwYja65ml3Q767SUgKE - xRqDEBprLYgm0JG4CFmBlVgJ1jTnKmwTqFGjvvbq336rsf6NLZBCohRUZUEcT4njMdPpBVJY - LkZnFMWCPI1RWjKaXBEEAZur27ScFq52UBLKfMFad51FNsXVDtP4ErC4Ggb9XXbW9ji/uk8Y - tJjGUwLPxwiLVopeq8/V5JQsT3Edj+l8RDvq4iqP0PNBaLI8JcnGVKZmFk+IXI1GNMZcNqG6 - xiKpEcJipUSbZQBHoz5N0G2QjftrQkstLBqLIwT9Voubm0+glWTQ26KuYm5t3+L0/A5Iw/X4 - go3uCot0xjwZE0ZtQrdFWS6acKPKGaxs4igXR2usKZknU1yt6LU6+MrHc1xGsyGzZEw36NBy - QtLFGK01Hb/DbD5id32fyA3whebq4kETUdqSoki4uLjPeHrG8dk9FsUCIQRagCMMUoKWAo3C - txWOBEc1a9NC4gqJQqMf6bxYuj8pl+GwkHQin5dvvcTl+JyyiLi4PmGwukm3tUKxmHNycY/9 - radJ85ittU2uhGCWXFDZnNOruzjKxdoaRzi42seRikF7jXQxYX11lSxbgKjZXbtBVWTUpiZO - p4RuSOD5VKagKjMQhrPRPbZWb1DnKWk6pswykmxCKwg4vbyP6wZsSkEr6oK0YAwGqJXFGNV4 - CCtQyqCsxViJEjXq577wzbe0AC1ByiajE0qghQVrsKZGAaVJKRcJiyKl47fxPAdpJdZWTJMR - ZZUx6G7iSoWQNU8NnsbXktpWlFXOjY09snyBi0ucXbO3sc3xxSGB26LthjjaoaJiHDeGshNG - zBdzZukEsIRuQD9skS1S0sWMvExJypg4S1jr9HGlizA1i0WMIw2OUkglcaARdcEylwEl6ia5 - w6K1oElwpEAIQ5WVuNJBWnjw8Ihuq8UiqxClYLXXo7zKuJpc0otcZsmUss4xdUboubQ9h0R7 - YAxX8yGBdmnrkGF5wmR6xXwx4Xh0xLO7+yTzKXEWo7XDRmeNoig4m5wyjScEXR9hJL7jYUzN - Wtgjy2fcPvmUyIsYxZdcxRM810FYhWmvkmdj3nv4Y3Y3bjC8hhf3X6ItQyoJ5lGwbgRI0YTK - dY1RNdp55AaXkWBexDw4HSKVRBrLw7MjdreepBV1uJ6coZSlH4RM4xFrgU9mHKZpSpbOGE8u - GHR7dALNdz7+HqtRj7ossLZif3WX3zv9iEWR4GDwgogb3W3uX58QxxPSKqMfdHhgDD2/TWUW - hL6HwLDie8xyQ1UVTOMFpoa0mBP5GyihMLYmSSbE+RhP3aQoFtRZiuOHaAtG1djaUisLpqkv - NFohUb/05V99S0lw1NJ4CIGUEqEsrdAn9AMm41M67ZB2GOIKwyyZ8tz2La6nF4znVyyyBEdK - 7p7fIXAUW911bnQ3OZ2c4TmKk9GQMAjJ8pzQcYlCn4fXD6nKglf3X8BFIxQ8GD3kmc2bICX3 - Lx6w0V5lu7+FsSVX0wvWW32m2RSLYbyYUpmKylTUVcE4HSMEJIuUtVaH0A1YaXVwl7GBlGJp - 5E2j6tgmzf43vvyrbzlS4GDR0uC7DqHjoAV0oxDqgpVul8n1OdViQTsIuD+8hyfBmgrX0fSi - DmkxZ5RM6YdtIsej31vhfHyKL33W2n1Oxhf0/BYPRycE2iHwAna66+xF69xYWyMUko+Gd+j4 - LR5cnvDKzeeR1nJ69ZBaQNePaLsBtiq5jK9pBSFaCF4Y3OIyGYGtWQm7hK5GW4GWkp3+Gq5W - aGnRsEyYmqhXLb+1Lw1SNimxpMn4XMdyfO8+4eYWg3aIp10iUzNfzEizhLxaEAU+T63uMk5G - 3B7eZ6Pdp+9HjJMRq60VeoXHemeFjtNivb1K9dmfc+fihMDxuHP5gBsrm8x1yMyb4juSOxf3 - qA0MZ5e4jiKvcrbaHS6mV3R8j74KyaqCnU6fu/MLpDVsdda4Tsa0HYdZluJhqIuctf42HjUu - NZ5svJsVYKyhXn5bYzGA+jtv/MpbjgRXGHwloS5ZJDMklvfvfEjkeswmlyghCTXcXN/k5d1b - /MmP32E+n7HZ7fP01i5SSm50VzHS8uLOPi3fI88WzNMFz6xu8PDyIVVR4TseJ7MRT3f7CCu5 - udKjqzU/vrjLVTzm5uoAW5aMkxkv7OwDhtDxeGp1i6LKmeUJJSWOdhhEK0SeR1HmFGXBatjG - mhpBzVee/jwtz4UyRguL6zRBmjIlWoMSjUqov/tT33jLV+Zf6IetKRYJVZYQKknX83CEoCxm - FGXJs9vbpEnMiutzdPWQqlpwdHaPQMD+1ja9MGJRxmxGbZJswV/c+YDQwuX0kid7A6yjuH35 - EMf1eXF9k9PJJVIKPro85rUbt1j12/zk7AghLWWWk9cFz/c2uTc+Z80NOLi4h9IKH8l1Nqcy - FdbUbLV6SGNouQ6rXoteELLiOSySmLJc0I0CsmTGLJ2xEgS4SqCUQEYSAqlwTEWVJbi2YHOl - jY/BGENRpjx3Y4/nt3fZ6XW4fe8Tyjpj0O7wpZv7nCcjWqGHq2CaTLkaDbl9/zYulhutDl/b - f44fDY/Qrssbt55jMR+x3e7ytSee4cfDB0Seyx/eeZ8vbN1AmMY/f2H7JoF06XkO2tZ8NryP - omIaTxFSEiI5T8b0XZdt6fLKxi55lZKbjMBx0LagymNG1+fE8TWT6TVUOapaEIkaX1kCDYEG - 9fd+plGB0NFoBXmaoJXA8TTClrQciawrrq6HPDHYZDqf4inBPJ3yzGCTLoLj8SVP9weIPOWJ - tQ3SPOeT40Oe7/fZ669wGU+Y5SkPL05JTMXh9ZCNbpcimfPj61Ne2drjfHxFUqUUZYWUlo52 - OYvnKCFouS7D+ZhZPqfn+Pzo8pgv7ezzQm/AzY0BabYgr0u2W108a/jcYJet9grHlw8RdU1c - ZWyELe6e3acXBgy6XbS0uBh0IC1aCKS0hI7LeriBsDVJbNlducU7H/wAbS2yLkimV/SUxKfG - 1YrT4we0sfybL73Gf//n32a6WPDqzpP0gpDzMiVPZuSzmj6aOZINz8cYQ1WVzGZTtjsrSMfh - 8701/qvDj9jo9XhxtcNuq829yYSXNrf4zuEnfFLl/PTuk1RVzZ+ePWA9iHClpRt6mKLk0+tT - nt/YJjCCjIKr2Yjjy4coxyFyHZ7qrfHg9AGDlR47a2sECmorqaVF/eZf/5W3PAmuErhS4Uvw - lKIqM7J4xvZKl1k845PTQ165cZNeOyLwAgKt6IYO4yRhOLrki3s3+OnnX+Sz82NO59f88N4R - n9vd4SvPPo2rNR+f3OfW2jpPr65xd3LJ5/sbfDYe8eLaGnVdMC1yvvHs8+y1Wvzw5Jjb4wu0 - gJ+78SQHF2eUxuC6DkVV8sbeTb564wk6QYt37n3KRhCx3+5ye3jKMJ1xEU+Y5QtCz2Oj28VW - OcpzeWFnB1drAtfBlRIpQf1HX/uFtxwl8ZXCU01AJIWlLhLmoyHnl+coUzOfTbl9ecbmSpfp - 9Tmj6RSpFVW+oBv6XM8mrGjJ87t7PLO2xsu7N/jdd7/P1mCbvEp5dvcG/+zDD3hqpcP3Tx9C - bZBaMZqO2dre4u//4q/w/mef8s/uHvELzz7Hz27v8cnogn9+7w43+j3+3dff4KX1DT69uGS7 - 1eZ0MuEnl6fMFgl7q6t8/eln2Ah8Pru+xHEUu2FIoAS7vT5Swl67Rb/TphOFBK5EKnAVaGVL - AsdFK4FUIKyhKjI8JfA9D6UNx1dDtgZrlEXGj48PeWZjg/l0xGV8Teh6jPI5/cCnMiU7qxGz - i4wnb+5y93SP3/vB9/hbr77Ca6++TJol3L+8pipKBqs+f3B8j19+8XP86v5T/N4Pf8A/PbyN - pzWfXg55dn2Nw9E1rz9xky9tbfHkxgb/+T/5xwzTmM3EY73b5c39Z3my3eLo4Ql/cPAeZ2nM - zVbE3SSmF0T0eisM+h12+32kqbHSUlcLWuFK0zuwoP79L3z5rVbooaRFO5IyHiFEjSlTtK1I - rye0PU0r8FgUJZ4j+f6dO2z3O0SeQxLH+FJSiBrlOMRxyuDpJ5CO4tUndvj9d3/E3/u3/jbJ - xTnrQvPe4R2MqQlaEWeTGYFyOE+mnM1TfutXf5kbvsu//dUvcTGf8+3PPuM/+eVfpCgL/ss/ - /iO+/sxT/Gd/829w//QMV0rKquDe+Tl3x2NOkjkvDdb5yv6TTEZXjBcJL+1ss+EqFumUzY0N - gkDT66+hXYHWEqUE6j/8wlfeWumvUGYpxmTMry6RWiERJNMxg0GfVhRSmop2d4W6KMjqnLwo - +NzNGzy1O+Dh1TXrg1XC0EeYgifX+6Aknz084fbJGT/1wrOY6yu07zFJY/74s7ucxTF//xf/ - BhUG8oJfe+VFHM/Bk4L/6d0D/ocf/Dk73S4nSco/evcvuNHtcj6f8979Y3ZXe7xxc4+B5zZN - O9flZ3c2KfMCKwWfXV7wTK9HMZ/w6fU1G0HA9fiaTuDhtyKUo5tkTwh0kU6g6BK1Q9I0JS0X - jE8mtFsReRFT2YoHp+d4gcdaN2LF6fDMzio/vH2XP//4U9aDgBtrK5TADz7+lJYfcng15rUn - d/nw6IhxuuDO0T32dzfo9Xr82s0d3r13zIM0A1ey1vJ589WXKX2HoL/Kx6Mr3v7kY0ZpwtO7 - 28yTOa+srvGzN3dZdTx29rYZXU84vb5m0G5xOZnw2pM3qdOMpzZX+fjskrVWxI/PzqiswdUe - sip549lnubwaobQGDK31Laraon7zi6+91e608FoBbhjgCKjqisl4Qif0CLtt1ntdopYPdU2J - ZTKPafkeoqrITcXO0/tMT4eUdcVsseCFZ27x4Z0jji+uEVh2Vnvo8ZTJyTntXofRdMp3Pzsi - Kwt+81e+Tr/fZn2wxvuf3uEff+8HLGrDRiviP/jGm1STKT+/u0XUDrl/fsHh6TllVXIj8HFt - zXlWshr4UJU8WOTcubzk2dU+z20OeGV3h0CARuL7EXlZ4GgXN2wvgzyDuPsn37Z5nqN9nwfH - x+xsbyKtxXMkWZEjtQLThMpCK6SgqbzamlmaEgUeVVlRFjlKSqJWwOX1CF9LxklCWpTsddso - a/B9F6kl5+MJV7OY9W6b7V6bui4ZzRPSPEMYw1WSMOi0kEKQ5hlVWRK5DspUuFqRlSWVtSRl - Tktpeq2IcZoQuJosy/BdtymJmWpZ3hN4rosBsBbXdXEcF2tBHz94wOdffomo2+bJm7sIAWW2 - aNqnwmLrkqoouLy6Ip7M8H2XwdaARRyjpc/qWp+6KqmKHGkNaMlKa8DZ5RVd6eMWAu3CE1sb - FHlT98syQVZLViOBFgWXsxGdwKUXeJxOJnQCCH1LVizY7bq0XZ/ZYsFlkrGoa0JXgTU82fEp - 64pFOcLVNZHnIykItaE2FfmScIuyQKLpBiEI8FyFVAV1VaHBYkzNu+++S3dlhfXVHmEY8tY/ - +C22tgb8tZc/xxuvf4GTHw/5H//n/41v/uLX+d6f/QV7N3c5v7hisNrl4KNP+dnXX2U6nZEl - Czr9DkmacvjghNB3iWdz9rc3iOcxYeTzv/z+n/Lrv/5LnE9jAlfzxMYaaZ4xTRKUUpRFTrxY - 0PFcitpwnZcsipJ+EFJh6Houi7JgukhZ8T08J2SyWJCVBd0oIitzlNSEWqKFZEVJpNQIAVo1 - UlzXNcYYZJomGFvRikLe/pPv4gYBytU8/exTfPWrX6asa6q64ktffIWbT+wQrbTxIp/LqxF3 - 795neD1io7/C//5P/4hPPj3kejzmu9//ET/zlc8zPLvk8y/c4qPb9/mLH31CVlZo3+OnvvgC - jtb02i1ubW9wMZkxmsckWYYFXtgasN9bYdCO2F3rE2rNahBQY+mFIcYYLBB6LnldM8sWrLci - Wq7LoshwpaLjB3Q9n07gEfk+SjbNXakUlqYHIaRA/cf/3q+/tbbWw0rJl7/8GlorHEexSFMW - acr+jV3agUddl0gpuXnzBhtrfTrtiHY7Yv+JHXY31xhs9Ol0WziOw4vP3OTw8D4vPHuTXq9D - aQzHD4c8c2uP1197gbt3T+ivd1jkOXGS0vYc2lHIJE3Z73eJfJd4sSApcsqixNqaeZFTVBVt - V4MUXMYx7TCgHfj4jmYlDKiqiq7vo6wBa6hN/ZcAHCClXC5cYu0SC/HhP/lde+vWTfxWhDX1 - EvxksHUFtqaqmmOysSZISVN0WJaXbFVRJHPm8xgd+AS+y/jqCkeC0ppFXXE9mTa1wrUeVZkz - iWNOxhNWo4Ab612yLOOT0yGb7ZC8KnEd1WABlCB0HbSEO+cXrPkuQgrujkf0WhGOtRhqAsfB - kZBmGSuei6kqLAZHK7R2KIoCpVRTG9R62QURGGvR/W6L8Xvv4yGa/pqWWGMpFylCaTA1Siuk - 1gjHBSmwVckjElpjqPMMqTWzJOU0TkEI1td6lFlGnC44vxrTW2njrMRgDUcn51RAq9vh4qTi - 9oMTirqm8Ga4UhK5DmEUMs8LYldTFSXX44REZ1xnOW3PRXYUqbGs+i2UVtRVgVM7pFJSVzVa - K0ohQQry3MEYg+f7LLtj1KbBIOmyLHHjmM7Xf4FFVdJe6WCMbRYJfOePvs3+E/tsbG42RFCS - ujZYY1BKI7VECEEynxNWBl3VJFnOWVmhlcJ3NDtVRW2hN1glSVM64xlGSNpRwEWc0H7qFVqu - y8ZaH08IbF3iOy61kJRlSVlXOGnGPMt51lHUpWFcFjyztornuiilAcizHD+MKPIM7biNC6fB - CFjbgD2ssVR1TVUvCSCUoKxqvv0nf8w0nrO5vc0iy/GkYDadYeqaq8tLHjx8wMXVFSiFpzV7 - T93ic8+/QJkXoBVhFGLKgjwriQIPIQRpVXI+mtHrtLgYTZglKZHrIIWkrA2TRcaiqhi0I57Y - HuAFAaYoKXJFssjwPJeqKBsbMhqz1elQGktqDXsrK+Rlhev5y+gOpCwxdXMMAaY2CKmQUmBs - I63GGqRSOFJSVBV6Po/x8gXCD7ixs4Mb+rRaIY72WOn2uB5dsbm7RZwmdFb7tPpdHh7eBWNQ - CoQjsXWFMVDUBuW5OJ6LsDW6VqystLm6HFEZuJwn9HcHDbBKS3zXwdGK7dUeZVmxKOdUWYFW - EiUleVZwnSRcpCmR55NXNZvtNnFeUCOpMWRFzTydoZVGKU26KHHdprdpRINis8ZQW6itpaoF - VV1SLYmhq6riahrzxBffwFeKKPAxSiEsOAKevHmToNViSwrKLEdKxc3BTiNauaEqDVjIyqZH - oLWmSHPKosJzNY4UbPZXuY4XVLVhOI6XZXgoqhpTG4bXMxyl8B0X13EbqBeSOE8ZxinacegG - bSxwleaU1uDTJGzzIsEYQ+QFRJ7G8wOWEDbk0kYVRYF2HIQQOAr0UmWsBf1wkWEqwyqayzTD - y0o8R9MLQgoEH3/0E2azOVVtKKqKPFvwpVdfYzIZY61FSEUQhkghWFlZ4eDDA37qq1/j9//5 - H/L8s88xmU5IFwsmZc725hZFXXNxecGDkxOkkOwGEXs3nyCZTHj1lVf44OBDur0eH9++jbfa - 42R4zlbUQWxtMVhfp7SN/i7qBZ0gwpUKJSRxvqC0NaGp8bSDBVwJxixtvrV4SmAt1BZMg5dF - a6lYYJkWBTWQW9BWMi9qlICtW89w50//lMpUUFSs9Ve5fe+YLFsgpWx6/9cjTG0bXasb8jva - ZWtnl08+u8Pp2RmjdMbO9i6udrj38CEgmE0mrODw3f/zzyiLgvbagKtZQlzUHJ2fEx/fJ5vO - eebNN4lWVpjlOQLIyoLAcZFYyqrCSE0nCClrS2klSZriCIkUFq29JivEUFXmMRZOLKve4n/9 - 7X9o+eiI9Z/7BSQCrSQdLyArS1wl8bSmrg3dMEAKiVCK4fmQ8/MzvvSlLyHlEolpDVVdN8Aj - CaZuYoisLImLnEVZkhQFSghmRQ7AXrdH6HhorRvElta8//77rN+8QVzk9MM273/wAa3eCv3V - VWpTN2BJa9BKsxqtYI2hrMsl0R0C18cs8ctK6UYNrG3C3iWWsDI1RVlijEHXtsZdtouU1Kz5 - AVYIjJQNGtPU+FpjTMV3v/cOe3s32NveYmvjc7jSgqgacZICXwqKoqBaVE3kZCyhI5FGoa1h - ktX4vo8pMlbDkLUwQEmFkIraNNCVzu4WRV3S9X1sXbD/zC0AKtOgUR2h8LXGkZo4Swi0S2UM - jpTLdFcv0V8NMFYs8YFSSYy1lGXJosgwxlAvwaDYJexcW8PVIiWvKzyliRyX3/0/fo+vvPYq - 3V6f89GIMGoxPD9ndH2N42harYj1tXWef/55iqLA2mWvUWgq08DVXdfFYAm0ZpQmj2wUtTEs - irxBsVk4mc1YVBXPrK9j6pq0KOl7Lq6UXGWLpqdnK6yRRFqTVzXalmRVQcsPQEBIRWFqIlfi - Ok3sX1uLEA2WNsOgK0NhDY6j0MbWRFriqwYd7iiBtJKOEnRDzTd/+ivs7e02Fnxvk1tP7ZEt - FqSbPTprfS7OhwQtj9Zqq8Hgul4TZRnTqEZdUZYF0jisSsv0IkMAviPx1jqsaAVlxe0Hp2gp - eHFvq0mrS8PG+jpFmlGVBWDISsmkKPGFQNgSJSw9T9F2gybLsxZjKwIt8bVAaoHWAqFUgyY3 - NdJqFJpFUS5dtTFoLIomtl9zHXIpaAdNMLG2tspkOicMfV7/6a/iei4Yi1ASW9fs33oaUxWN - blY1dZYhZPM7Sxe4WuF2WmgktrbcvbjGAiudDqHrUuU5RydDamO4ubGGpxykViRlTLooyRY5 - YHEch2lWLHGBkmzZ3Z1VjTGTxuA7DTrFEQ5pZZq2uARbW4w1VFVFVVoqoyiARZmhBYZJUeIY - gy8l10WFtRDHGZVpABO+1tGZ8eYAAAbgSURBVMzjAjPLMECoHW7fuYOjNZPr6yb2X1+jqCqu - r6546ulnOD09pb+2ysbGBu/+/rfptNtkZUG0t8v58QkP3vsRX/nq1zgbXXH/3gPGDx/yd7/1 - LeqqRioorUMyy9COxySeUZia0sLCGKqySdAqYxjlJUKIRmVdhe/5TNIcRzuoomn1C9HsEjHG - YEzd7EKhIaI0WApjyOqaaVlytVhwnWWM85zaNgjSvK6pjaUyFmMsxlo+/PCAs7MzhsMhvu9x - cHBAPJ1SLjJOj+/TbYf0WxGB67BIYyZpzMnlJQb49PanxLM5cVkghGQzCtkcrHPy4AG+q/G0 - xnc0vqsQpqLlNnbAk4KW08BmXNE0c5QQBErTcX0cYfGExZMQOgppKqSpcKXBkxZfWlwBylY4 - GLp+iPid/+6/sHxyTP/rf7MxTkKgxRInbgUtrREW+oGPsGCW+zIixwVriTxvubXG4rkuOvCR - vtdkklJQpilSSoypSWZzfvjwjMViQbVYsLW5yV+7eQPXbbI1qdRjY1XnJcl0gnJcsmxBXtVU - xjDLC4SSZFVF6DhkZUVLO3iObup+xuB7AWVVopTCcRzkMv9/JAWLvEBIQV3XTUnsLw+7hJsr - IaisYVY2+p0njR+tTI1EEOqSw6O7vP7Sy5hluLW4GjMajXj66adxXRetFe9/cEBVG6bTCc+/ - 9CIW8IKAXrvNjfYK8XhOEIbNxiubo5RuKrZFQVIY4vmEyjZSV5oaiyDOcjypyGuDkRKrJHlt - mcUp3SiiqOtH2HfK2kK9DAeXqbDWmrTIqGuDbgLvf5kIxjbp4yNuAJTWYOrmuBKC77/3Hu8f - HPDZe++xt7PN1tYmF1dXhK7DYpGwe2OP7Z0dtnY3uXP7DtrV+IGLnTfz3equIE2NBJQjm6xS - SrQW2ArSMifJF6RlU4lSS53Xstl1JptUH0cIPCVZFBVCWAJH4zoO4hEm3Db+nqU6W5pKkS8V - Vmn0v7L2fyEJS2l49Mc+2jwhJaUxdNbXef6lFxEIfnh0xOt7e6jBFscXQ04ur5kol0xojk5P - SGYxo+mEaGfn8fzDJCEpSlwhsOMxxlgKa3GlXD67IbojBFVVUizVTwtJx9NYA5EjKYylqgrm - RUHXb7CL3TBAa73cySKwtsZY0ewiUQ1RkjIHaxG/89/+luXTU/pf/yX+3wzx+Hv5EY9oZ5fb - 1xrq/+vo/WinShwntFutJakFzS7A//tQy80bj6RVy2YniK8kEkFtDUpIXCXJ6gb6G7oaY6C2 - BldKKmNIKkNDyr/CePvtt7l16xaHh4fcutWEq8PhkMFgwObGJod3Dx+rz/BiyP7+PlEUMRwO - ARgMBgwGA95++20ODg548803GQwGHB4dEicxSZxgsQyHQ15++fOAJY5jXn75ZY6OjnjnnXd4 - 442fejzfm2/+POeTKQcHH7K5OeDw8PDx+wwGA4bDIVEU8cYbb/DOO+9wcXHB/v7+cqec/atx - fWNjgyiKOD8/5/z8nHfeeYeDgwP+4A//gA8++IDz4TlP7j9JGIYcHh5ycHDwePGPxuuvv85v - /MZvLMVH8sGHP2E4HGKxRFHEYLDJ0dEhcRyTJMlSUmK+9a1vcXR0SBSFDIfnjwlxcPABh4eH - j58TRRFHR0ePn/donm9+85scHR0hfue/+QeWz4b0f+6X+f9uCB7vrf1XqPuIK/+6EccJrVb0 - /+gJR0dH7O/v/5Xf8NH9jRew9jFlhsMhrVaLKIpIkoQoioiiiIuLC4DHxx/9/sscHQ6Hj+9/ - RIjBYJM4mZPEMRsbGwC8886fcevW/uP5H92fJDEXF8PHnGo42Obi4hyA/f19jo6OHp87ODhY - EkHQarUeS0GSxI+vaf4nbGxskCTJv/TuBwcHqF/7xl9/i+uEn4xmjMdjXNdlNBrx7rvv4jgO - Dx8+xPM84jimKIpGTw8bkXx4csrBwQe8/PLLHBwccHR0xObmJufn58RxwtHRIUdHh7hOU5vf - 29vj6OgI1/M5OrpHURR85zvf5bnnnmM8HvP222/z3HPPcXx8zHg8Zji84NNPP37sjQaDAcfH - x7RaLT755BOSJFleN2Rvb4/f/u1/xPPPP0dZlhwfH3NwcPD42kd2oCgKer3eY2apX/vGz7zF - dcr2a19+fMHm5iZ7e3sAbG5uPub6I86WZUm/32dvd5dWq/XY0CRJwmg0otVq0e/3iaKIvb09 - XNelKAqiKKIsS4oiZ3OwQasVcetWYxz7/f5jbrmuS6vVYnNz8JiLrVbTdXrEpH6/j+u6PPfc - cwgh6PV69Pt9xuMxRVHQarW4desWrusSRRGtVgshxONzQghc10X8zn/9n8LtK9v/+W/w/8Mh - /i957VpDfrfOMwAAAABJRU5ErkJggg==' - readStream) readStream) nextImage - ! Item was removed: - ----- Method: WebCamMorph class>>initialize (in category 'class initialization') ----- - initialize - "CameraMorph initialize" - - - - ! Item was removed: - ----- Method: WebCamMorph class>>resolutionFor: (in category 'scripting') ----- - resolutionFor: aSymbol - (#(low medium high hd) includes: aSymbol) ifFalse: [^ 320 at 240]. - - ^ {160 @ 120. 320 @ 240. 640 @ 480. 1280 @ 960} - at: (WebCamResolution resolutions indexOf: aSymbol) - ! Item was removed: - ----- Method: WebCamMorph class>>shutDown (in category 'accessing') ----- - shutDown - self allOff. - ! Item was removed: - ----- Method: WebCamMorph class>>startUp (in category 'accessing') ----- - startUp - "Try to bring up any instances that were on before shutdown" - ! Item was removed: - ----- Method: WebCamMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - - super addCustomMenuItems: aMenu hand: aHandMorph. - aMenu - addUpdating: #cameraToggleString action: #toggleCameraOnOff; - addLine; - add: 'resolution...' translated subMenu: ([:menu | - WebCamResolution resolutions do: [:res | - menu - add: (resolution == res ifTrue: ['<on>'] ifFalse: ['<off>']), res translated - selector: #setWebCamResolution: - argument: res]. - menu] value: (aMenu class new defaultTarget: aMenu defaultTarget)); - add: 'orientation...' translated subMenu: ([:menu | - WebCamOrientation orientations do: [:ori | - menu - add: (orientation == ori ifTrue: ['<on>'] ifFalse: ['<off>']), ori translated - selector: #setWebCamOrientation: - argument: ori]. - menu] value: (aMenu class new defaultTarget: aMenu defaultTarget)); - addUpdating: #frameSizeToggleString action: #toggleUseFrameSize; - addUpdating: #showFPSToggleString action: #toggleShowFPS; - yourself - ! Item was removed: - ----- Method: WebCamMorph>>cameraIsOn (in category 'accessing') ----- - cameraIsOn - ^camIsOn! Item was removed: - ----- Method: WebCamMorph>>cameraNumber (in category 'accessing') ----- - cameraNumber - ^camNum! Item was removed: - ----- Method: WebCamMorph>>cameraNumber: (in category 'accessing') ----- - cameraNumber: anInteger - camNum ~= anInteger ifTrue: - [camNum := anInteger. - self initializeDisplayForm]! Item was removed: - ----- Method: WebCamMorph>>cameraToggleString (in category 'menu') ----- - cameraToggleString - - ^ camIsOn - ifTrue: ['<on>', 'turn camera off' translated] - ifFalse: ['<off>', 'turn camera on' translated]. - - - - ! Item was removed: - ----- Method: WebCamMorph>>decreaseCaptureDelay (in category 'accessing') ----- - decreaseCaptureDelay - - captureDelayMs := (captureDelayMs - 1) min: 200.! Item was removed: - ----- Method: WebCamMorph>>delete (in category 'submorphs - add/remove') ----- - delete - self off. - super delete! Item was removed: - ----- Method: WebCamMorph>>drawCameraImageOn: (in category 'drawing') ----- - drawCameraImageOn: aCanvas - | scale offset | - offset := 0 @ 0. - scale := 1 @ 1. - bounds extent = displayForm extent - ifFalse: [scale := bounds extent / displayForm extent]. - orientation == #natural - ifTrue: [ - scale := scale x negated @ scale y. - offset := bounds width @ 0]. - 1 @ 1 = scale - ifTrue: [aCanvas drawImage: displayForm at: bounds origin + offset] - ifFalse: [aCanvas - warpImage: displayForm - transform: (MatrixTransform2x3 withScale: scale) - at: bounds origin + offset]. - ! Item was removed: - ----- Method: WebCamMorph>>drawFPSOn: (in category 'drawing') ----- - drawFPSOn: aCanvas - showFPS ifFalse: [^self]. - aCanvas - drawString: 'FPS: ', fps asString - at: bounds bottomLeft + (5 @ -20) - font: Preferences windowTitleFont - color: Color white! Item was removed: - ----- Method: WebCamMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - camIsOn ifFalse: - [| turnOn | - turnOn := displayForm isNil. - self initializeDisplayForm. - turnOn ifTrue: [self on]]. - camIsOn ifTrue: - [(CameraInterface frameExtent: camNum) ~= displayForm extent ifTrue: - [self initializeDisplayForm]]. - displayForm ifNil: - [self initializeDisplayForm]. - useFrameSize ifTrue: [self extent: frameExtent]. - self drawCameraImageOn: aCanvas. - self drawFPSOn: aCanvas. - self drawOverlayTextOn: aCanvas! Item was removed: - ----- Method: WebCamMorph>>drawOverlayTextOn: (in category 'drawing') ----- - drawOverlayTextOn: aCanvas - camIsOn ifTrue: [^self]. - aCanvas - drawString: 'Camera is off' translated - at: bounds origin + (5 @ 2) - font: Preferences windowTitleFont - color: Color white.! Item was removed: - ----- Method: WebCamMorph>>frameSizeToggleString (in category 'menu') ----- - frameSizeToggleString - - ^ (useFrameSize ifTrue: ['<on>'] ifFalse: ['<off>']), 'use frame size' translated - - - ! Item was removed: - ----- Method: WebCamMorph>>getLastFrame (in category 'e-toy - settings') ----- - getLastFrame - - - ^ SketchMorph withForm: displayForm deepCopy! Item was removed: - ----- Method: WebCamMorph>>getShowFPS (in category 'e-toy - settings') ----- - getShowFPS - ^ showFPS - ! Item was removed: - ----- Method: WebCamMorph>>getUseFrameSize (in category 'e-toy - settings') ----- - getUseFrameSize - ^ useFrameSize - ! Item was removed: - ----- Method: WebCamMorph>>getWebCamIsOn (in category 'e-toy - settings') ----- - getWebCamIsOn - - ^ camIsOn! Item was removed: - ----- Method: WebCamMorph>>getWebCamResolution (in category 'e-toy - settings') ----- - getWebCamResolution - ^ resolution - - ! Item was removed: - ----- Method: WebCamMorph>>increaseCaptureDelay (in category 'accessing') ----- - increaseCaptureDelay - - captureDelayMs := (captureDelayMs + 1) max: 10.! Item was removed: - ----- Method: WebCamMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - camNum := 1. - camIsOn := false. - showFPS := false. - captureDelayMs := 16. "stepTime" - fps := 60. "guess." - lastDisplayTime := 0. - framesSinceLastDisplay := 0. - useFrameSize := false. - resolution := #medium. - orientation := #natural. - frameExtent := self class resolutionFor: resolution! Item was removed: - ----- Method: WebCamMorph>>initializeDisplayForm (in category 'initialization') ----- - initializeDisplayForm - | cameraExtent formExtent | - - cameraExtent := CameraInterface frameExtent: camNum. - cameraExtent isZero - ifTrue: [formExtent := frameExtent] - ifFalse: [ | camRatio frameRatio | - formExtent := cameraExtent. - camRatio := cameraExtent x / cameraExtent y. - frameRatio := frameExtent x / frameExtent y. - camRatio ~= frameRatio ifTrue: [frameExtent := frameExtent x @ (frameExtent x * camRatio reciprocal)]]. - displayForm := Form extent: formExtent depth: 32. - self extent: frameExtent. - ! Item was removed: - ----- Method: WebCamMorph>>intoWorld: (in category 'initialization') ----- - intoWorld: aWorld - - super intoWorld: aWorld. - camIsOn ifTrue: [self on] - ifFalse:[self off]. - self removeActionsForEvent: #aboutToEnterWorld. - aWorld - when: #aboutToLeaveWorld - send: #outOfWorld: - to: self - with: aWorld.! Item was removed: - ----- Method: WebCamMorph>>knownName (in category 'testing') ----- - knownName - - ^ CameraInterface cameraName: camNum ! Item was removed: - ----- Method: WebCamMorph>>nextFrame (in category 'stepping and presenter') ----- - nextFrame - - | frameCount | - frameCount := CameraInterface getFrameForCamera: camNum into: displayForm bits. - frameCount = 0 ifTrue: [self increaseCaptureDelay]. - frameCount > 2 ifTrue: [self decreaseCaptureDelay]. - framesSinceLastDisplay := framesSinceLastDisplay + frameCount! Item was removed: - ----- Method: WebCamMorph>>off (in category 'accessing') ----- - off - self stopStepping. - camIsOn := false. - "Be careful not to close the camera if any other morphs are using the same camera." - (self class allSubInstances anySatisfy: [:wcm| wcm cameraNumber = camNum and: [wcm cameraIsOn]]) ifFalse: - [CameraInterface closeCamera: camNum]. - self changed - - "self allInstances select: [:wcm| wcm cameraNumber = 1 and: [wcm cameraIsOn]]"! Item was removed: - ----- Method: WebCamMorph>>on (in category 'accessing') ----- - on - camIsOn ifTrue: [^true]. - (CameraInterface cameraIsOpen: camNum) ifFalse: - [| extent | - extent := self class resolutionFor: resolution. - (CameraInterface openCamera: camNum width: extent x height: extent y) ifNil: - [^false]]. - "The plugin/camera subsystem may end up choosing a different width and height. - So use the width and height it has selected; it may not be what was asked for." - self initializeDisplayForm. - CameraInterface waitForCameraStart: camNum. - camIsOn := true. - self startStepping! Item was removed: - ----- Method: WebCamMorph>>outOfWorld: (in category 'initialization') ----- - outOfWorld: aWorld - - super outOfWorld: aWorld. - camIsOn ifTrue: [self off. camIsOn := true]. - aWorld - when: #aboutToEnterWorld - send: #intoWorld: - to: self - with: aWorld.! Item was removed: - ----- Method: WebCamMorph>>setShowFPS: (in category 'e-toy - settings') ----- - setShowFPS: aBoolean - showFPS := aBoolean - ! Item was removed: - ----- Method: WebCamMorph>>setUseFrameSize: (in category 'e-toy - settings') ----- - setUseFrameSize: aBoolean - useFrameSize := aBoolean! Item was removed: - ----- Method: WebCamMorph>>setWebCamIsOn: (in category 'e-toy - settings') ----- - setWebCamIsOn: aBoolean - aBoolean ifTrue: [self on] ifFalse: [self off] - ! Item was removed: - ----- Method: WebCamMorph>>setWebCamOrientation: (in category 'e-toy - settings') ----- - setWebCamOrientation: aSymbol - - ((WebCamOrientation orientations) includes: aSymbol) ifFalse: [^ self]. - orientation := aSymbol. - - - ! Item was removed: - ----- Method: WebCamMorph>>setWebCamResolution: (in category 'e-toy - settings') ----- - setWebCamResolution: aSymbol - | wasOn | - "Failing silently here is awful; but that's what the code did :-(" - (WebCamResolution resolutions includes: aSymbol) ifFalse: [^ self]. - resolution := aSymbol. - - (wasOn := camIsOn) ifTrue: [self off]. - frameExtent := self class resolutionFor: aSymbol. - displayForm ifNotNil: - [displayForm := displayForm scaledToSize: frameExtent]. - self updateDisplay. - wasOn ifTrue: [self on] - ! Item was removed: - ----- Method: WebCamMorph>>showFPSToggleString (in category 'menu') ----- - showFPSToggleString - - ^ (showFPS ifTrue: ['<on>'] ifFalse: ['<off>']), 'show fps' translated - - - ! Item was removed: - ----- Method: WebCamMorph>>step (in category 'stepping and presenter') ----- - step - camIsOn ifFalse:[self stopStepping]. - self updateDisplay. - - ! Item was removed: - ----- Method: WebCamMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - "Answer the desired time between steps in milliseconds" - ^ captureDelayMs - ! Item was removed: - ----- Method: WebCamMorph>>toggleCameraOnOff (in category 'menu') ----- - toggleCameraOnOff - camIsOn - ifTrue:[self off] - ifFalse:[self on]! Item was removed: - ----- Method: WebCamMorph>>toggleShowFPS (in category 'menu') ----- - toggleShowFPS - - showFPS := showFPS not. - ! Item was removed: - ----- Method: WebCamMorph>>toggleUseFrameSize (in category 'menu') ----- - toggleUseFrameSize - - useFrameSize := useFrameSize not. - ! Item was removed: - ----- Method: WebCamMorph>>updateDisplay (in category 'stepping and presenter') ----- - updateDisplay - camIsOn ifTrue:[self nextFrame]. - self updateFPS. - self changed.! Item was removed: - ----- Method: WebCamMorph>>updateFPS (in category 'stepping and presenter') ----- - updateFPS - - | now mSecs | - now := Time millisecondClockValue. - mSecs := now - lastDisplayTime. - (mSecs > 500 or: [mSecs < 0 "clock wrap-around"]) - ifTrue: [ - fps := (framesSinceLastDisplay * 1000) // mSecs. - lastDisplayTime := now. - framesSinceLastDisplay := 0].! Item was removed: - SymbolListType subclass: #WebCamOrientation - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-WebCam'! Item was removed: - ----- Method: WebCamOrientation class>>initialize (in category 'class initialization') ----- - initialize - - self addStandardVocabulary: self new.! Item was removed: - ----- Method: WebCamOrientation class>>orientations (in category 'constants') ----- - orientations - ^ #( native natural )! Item was removed: - ----- Method: WebCamOrientation class>>unload (in category 'class initialization') ----- - unload - - self allStandardVocabularies removeKey: self class name ifAbsent: [].! Item was removed: - ----- Method: WebCamOrientation class>>vocabularyName (in category 'constants') ----- - vocabularyName - - ^ self name! Item was removed: - ----- Method: WebCamOrientation>>initialize (in category 'initialization') ----- - initialize - super initialize. - self vocabularyName: self class vocabularyName. - - self symbols: self class orientations.! Item was removed: - ----- Method: WebCamOrientation>>representsAType (in category 'tiles') ----- - representsAType - ^true! Item was removed: - SymbolListType subclass: #WebCamResolution - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-WebCam'! Item was removed: - ----- Method: WebCamResolution class>>initialize (in category 'class initialization') ----- - initialize - - self addStandardVocabulary: self new.! Item was removed: - ----- Method: WebCamResolution class>>resolutions (in category 'constants') ----- - resolutions - ^ #(#'low' #'medium' #'high' #'hd') - ! Item was removed: - ----- Method: WebCamResolution class>>vocabularyName (in category 'constants') ----- - vocabularyName - - ^ self name! Item was removed: - ----- Method: WebCamResolution>>initialize (in category 'initialization') ----- - initialize - super initialize. - self vocabularyName: self class vocabularyName. - - self symbols: self class resolutions - ! Item was removed: - ----- Method: WebCamResolution>>representsAType (in category 'tiles') ----- - representsAType - ^true! Item was removed: - ----- Method: Workspace class>>extraExample1 (in category '*MorphicExtras-examples') ----- - extraExample1 - "ToolBuilder open: Workspace extraExample1" - - | quoteAttributes | - quoteAttributes := {TextEmphasis bold. TextColor color: Color mocha}. - ^ Workspace new - contents: (Text streamContents: [:stream | ({ - '<i>"When in doubt, try it out!!"</i>' asTextFromHtml - addAllAttributes: quoteAttributes; - yourself. - '-- Dan Ingalls' asText - addAllAttributes: quoteAttributes; - addAttribute: TextAlignment rightFlush; - yourself. - String empty. } - , ((self class sourceCodeAt: #extraExampleContents1) asString lines allButFirst: 3) - do: [:line | stream nextPutAll: line] - separatedBy: [stream cr])]); - shouldStyle: false; - yourself! Item was removed: - ----- Method: Workspace class>>extraExample2 (in category '*MorphicExtras-examples') ----- - extraExample2 - "ToolBuilder open: Workspace extraExample2" - - ^ self new - contents: (((self class sourceCodeAt: #extraExampleContents2) - asString lines allButFirst: 3) - joinSeparatedBy: Character cr); - yourself! Item was removed: - ----- Method: Workspace class>>extraExampleContents1 (in category '*MorphicExtras-examples') ----- - extraExampleContents1 - "This is example code for #extraExample1" - - "Run the following lines by pressing <cmd>d:" - Transcript showln: 'Hello world!!'. - self inform: 'This is a dialog box. Quite easy, isn''t it?'. - - "Print the result of an expression using <cmd>p" - 6 * 7. - Float pi i exp stringForReadout. - (16 factorial + 1) isPrime. - (Smalltalk allClasses gather: #selectors) size.! Item was removed: - ----- Method: Workspace class>>extraExampleContents2 (in category '*MorphicExtras-examples') ----- - extraExampleContents2 - "This is example code for #extraExample2" - - "Inspect any (sub)expression result by pressing <cmd>i" - (20 to: 40 by: 2) asOrderedCollection - addFirst: 16; - addLast: 42; - sort: [:x | x \\ 3] descending; - yourself. - - "Explore any (sub)expression result by pressing <cmd>I" - Project current world. - - "Debug any (sub)expression using <cmd>D" - (1 to: 9) join asNumber sqrt truncateTo: 1e-3. - (SystemWindow windowsIn: self currentWorld) - select: [:window | window bounds isWide] - thenDo: [:window | window color: window color negated].! Item was removed: - ----- Method: Workspace class>>initialize (in category '*MorphicExtras-class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]! Item was removed: - ----- Method: Workspace class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: WorldState>>displayWorldAsTwoTone:submorphs:color: (in category '*MorphicExtras-update cycle') ----- - displayWorldAsTwoTone: aWorld submorphs: submorphs color: color - "Display the world in living black-and-white. (This is typically done to save space.)" - - | f | - f := ColorForm extent: aWorld viewBox extent depth: 1. - f colors: (Array with: color dominantColor with: Color black). - self canvas: f getCanvas. - - "force the entire canvas to be redrawn" - aWorld fullRepaintNeeded. - self drawWorld: aWorld submorphs: submorphs invalidAreasOn: canvas. "redraw on offscreen canvas" - canvas showAt: aWorld viewBox origin. "copy redrawn areas to Display" - Display forceDisplayUpdate. - self canvas: nil. "forget my canvas to save space" - ! Item was removed: - ----- Method: WorldState>>doOneCycleInBackground (in category '*MorphicExtras-update cycle') ----- - doOneCycleInBackground - "Do one cycle of the interactive loop. This method is called repeatedly when this world is not the active window but is running in the background." - - self halt. "not ready for prime time" - - "process user input events, but only for remote hands" - self handsDo: [:hand | - (hand isKindOf: RemoteHandMorph) ifTrue: [ - hand becomeActiveDuring: [ - hand processEvents]]]. - - self becomeActiveDuring: [ - self runStepMethods. - self displayWorldSafely].! Item was removed: - ----- Method: WorldState>>startBackgroundProcess (in category '*MorphicExtras-update cycle') ----- - startBackgroundProcess - "Start a process to update this world in the background. Return the process created." - - | p | - p := [[ - self doOneCycleInBackground. - (Delay forMilliseconds: 20) wait] repeat] newProcess. - p resume. - ^ p - ! Item was removed: - ----- Method: WorldState>>stepListSummary (in category '*MorphicExtras-initialization') ----- - stepListSummary - ^ String streamContents: - [:aStream | - aStream nextPutAll: stepList size printString, ' items in steplist:'. - stepList do: - [:anElement | aStream nextPutAll: anElement receiver printString]] - - "Transcript cr show: self currentWorld stepListSummary"! Item was removed: - AbstractMediaEventMorph subclass: #ZASMCameraMarkMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: ZASMCameraMarkMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - "Add custom halo menu items" - - aMenu add: 'Go to this mark' translated target: self action: #gotoMark. - aMenu add: 'Set transition' translated target: self action: #setTransition. - - super addCustomMenuItems: aMenu hand: aHandMorph - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'piano rolls') ----- - addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime - - | startX pseudoEndTime | - - startX := pianoRoll xForTime: startTimeInScore. - pseudoEndTime := pianoRoll timeForX: startX + self width. - startTimeInScore > rightTime ifTrue: [^ self]. - pseudoEndTime < leftTime ifTrue: [^ self]. - - morphList add: - (self align: self bottomLeft - with: startX @ self bottom). - - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>cameraController (in category 'camera') ----- - cameraController - - ^(self valueOfProperty: #cameraController)! Item was removed: - ----- Method: ZASMCameraMarkMorph>>cameraPoint:cameraScale:controller: (in category 'camera') ----- - cameraPoint: aPoint cameraScale: aNumber controller: aController - - self setProperty: #cameraPoint toValue: aPoint. - self setProperty: #cameraScale toValue: aNumber. - self setProperty: #cameraController toValue: aController. - self addMorph: ( - StringMorph contents: aPoint printString,' ',(aNumber printShowingMaxDecimalPlaces: 3) - ) lock.! Item was removed: - ----- Method: ZASMCameraMarkMorph>>cameraPoint:cameraScale:controller:page: (in category 'camera') ----- - cameraPoint: aPoint cameraScale: aNumber controller: aController page: aBookPage - - self setProperty: #cameraPoint toValue: aPoint. - self setProperty: #cameraScale toValue: aNumber. - self setProperty: #cameraController toValue: aController. - self setProperty: #bookPage toValue: aBookPage. - self addMorphBack: (ImageMorph new image: (aBookPage imageForm scaledToSize: 80 at 80)) lock. - self setBalloonText: aPoint rounded printString,' ',(aNumber printShowingMaxDecimalPlaces: 3)! Item was removed: - ----- Method: ZASMCameraMarkMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - - | nextAmbient m nextDurationInMs program now finalMark thisPage nextPage | - - self gotoMark. - nextAmbient := nil. - index to: track size do: [ :i | - (nextAmbient isNil and: [((m := track at: i) morph) isKindOf: self class]) ifTrue: [ - nextAmbient := m. - ]. - ]. - nextAmbient ifNil: [^self]. - nextDurationInMs := (nextAmbient time - ticks * secsPerTick * 1000) rounded. - finalMark := nextAmbient morph. - thisPage := self valueOfProperty: #bookPage. - nextPage := finalMark valueOfProperty: #bookPage. - (thisPage = nextPage or: [thisPage isNil | nextPage isNil]) ifFalse: [^finalMark gotoMark]. - now := Time millisecondClockValue. - program := Dictionary new. - program - at: #startTime put: now; - at: #endTime put: now + nextDurationInMs; - at: #startPoint put: (self valueOfProperty: #cameraPoint); - at: #endPoint put: (finalMark valueOfProperty: #cameraPoint); - at: #startZoom put: (self valueOfProperty: #cameraScale); - at: #endZoom put: (finalMark valueOfProperty: #cameraScale). - - self cameraController setProgrammedMoves: {program}. - - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>gotoMark (in category 'camera') ----- - gotoMark - - self cameraController - turnToPage: (self valueOfProperty: #bookPage) - position: (self valueOfProperty: #cameraPoint) - scale: (self valueOfProperty: #cameraScale) - transition: (self valueOfProperty: #transitionSpec). - self setCameraValues. - - - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^true - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - justDroppedInto: newOwner event: anEvent - - | holder | - - newOwner isWorldMorph ifTrue: [ - holder := ZASMScriptMorph new. - holder - position: self position; - setProperty: #cameraController toValue: self cameraController. - self world addMorph: holder. - holder addMorph: self. - holder startStepping. - ]. - super justDroppedInto: newOwner event: anEvent! Item was removed: - ----- Method: ZASMCameraMarkMorph>>menuPageVisualFor:event: (in category 'menu') ----- - menuPageVisualFor: target event: evt - - | tSpec menu | - - tSpec := self - valueOfProperty: #transitionSpec - ifAbsent: [ - (self valueOfProperty: #bookPage) - valueOfProperty: #transitionSpec - ifAbsent: [{ 'silence' . #none. #none}] - ]. - menu := (MenuMorph entitled: 'Choose an effect - (it is now ' , tSpec second , ')') defaultTarget: self. - TransitionMorph allEffects do: [:effect | | directionChoices subMenu | - directionChoices := TransitionMorph directionsForEffect: effect. - directionChoices isEmpty - ifTrue: [menu add: effect target: self - 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 target: self - selector: #setProperty:toValue: - argumentList: (Array with: #transitionSpec - with: (Array with: tSpec first with: effect with: dir))]. - menu add: effect subMenu: subMenu]]. - - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: ZASMCameraMarkMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - evt shiftPressed ifTrue: [^self]. - self isSticky ifTrue: [^self]. - evt hand grabMorph: self.! Item was removed: - ----- Method: ZASMCameraMarkMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - evt shiftPressed ifTrue: [^self gotoMark]. - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>pauseFrom: (in category 'piano rolls') ----- - pauseFrom: scorePlayer - - self cameraController pauseProgrammedMoves.! Item was removed: - ----- Method: ZASMCameraMarkMorph>>resumeFrom: (in category 'piano rolls') ----- - resumeFrom: scorePlayer - - self cameraController resumeProgrammedMoves! Item was removed: - ----- Method: ZASMCameraMarkMorph>>setCameraValues (in category 'camera') ----- - setCameraValues - - | camera | - camera := self cameraController. - - "ick... since one may fail to fully take due to constraints, retry" - 2 timesRepeat: [ - camera cameraPoint: (self valueOfProperty: #cameraPoint). - camera cameraScale: (self valueOfProperty: #cameraScale). - ]. - - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>setTransition (in category 'menu') ----- - setTransition - "Set the transition" - - ^ self setTransition: self currentEvent! Item was removed: - ----- Method: ZASMCameraMarkMorph>>setTransition: (in category 'menu') ----- - setTransition: evt - - | tSpec menu | - - tSpec := self - valueOfProperty: #transitionSpec - ifAbsent: [ - (self valueOfProperty: #bookPage) - valueOfProperty: #transitionSpec - ifAbsent: [{ 'silence' . #none. #none}] - ]. - menu := (MenuMorph entitled: 'Choose an effect - (it is now ' , tSpec second , ')') defaultTarget: self. - TransitionMorph allEffects do: [:effect | | subMenu directionChoices | - directionChoices := TransitionMorph directionsForEffect: effect. - directionChoices isEmpty - ifTrue: [menu add: effect target: self - 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 target: self - selector: #setProperty:toValue: - argumentList: (Array with: #transitionSpec - with: (Array with: tSpec first with: effect with: dir))]. - menu add: effect subMenu: subMenu]]. - - menu popUpEvent: evt in: self world! Item was removed: - ----- Method: ZASMCameraMarkMorph>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - | camera page | - "Keep the same camera???" - - (camera := self cameraController) ifNotNil: [ - (deepCopier references includesKey: camera) ifFalse: [ - "not recorded, outside our tree, use same camera" - deepCopier references at: camera put: camera]]. - (page := self valueOfProperty: #bookPage) ifNotNil: [ - (deepCopier references includesKey: page) ifFalse: [ - deepCopier references at: page put: page]]. - - ^ super veryDeepCopyWith: deepCopier - - ! Item was removed: - PasteUpMorph subclass: #ZASMScriptMorph - instanceVariableNames: 'somethingChanged' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: ZASMScriptMorph>>acceptDroppingMorph:event: (in category 'layout') ----- - acceptDroppingMorph: aMorph event: evt - - super acceptDroppingMorph: aMorph event: evt. - somethingChanged := true. - ! Item was removed: - ----- Method: ZASMScriptMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu addLine. - aCustomMenu add: 'save script' translated action: #saveScript. - - ! Item was removed: - ----- Method: ZASMScriptMorph>>compileScript (in category 'script compiling') ----- - compileScript - - | newScript prevMark prevSteps | - - self fixup. - newScript := OrderedCollection new. - prevMark := prevSteps := nil. - submorphs do: [ :each | | data | - (each isKindOf: ZASMCameraMarkMorph) ifTrue: [ - prevMark ifNotNil: [ - data := Dictionary new. - data - at: #steps put: prevSteps; - at: #startPoint put: (prevMark valueOfProperty: #cameraPoint); - at: #endPoint put: (each valueOfProperty: #cameraPoint); - at: #startZoom put: (prevMark valueOfProperty: #cameraScale); - at: #endZoom put: (each valueOfProperty: #cameraScale). - newScript add: data. - ]. - prevMark := each. - ]. - (each isKindOf: ZASMStepsMorph) ifTrue: [ - prevSteps := each getStepCount. - ]. - ]. - ^newScript - ! Item was removed: - ----- Method: ZASMScriptMorph>>decompileScript:named:for: (in category 'script compiling') ----- - decompileScript: aScript named: aString for: aController - - | newMorphs prevPt prevScale | - - self removeAllMorphs. - self setProperty: #cameraController toValue: aController. - self setProperty: #cameraScriptName toValue: aString. - - newMorphs := OrderedCollection new. - prevPt := prevScale := nil. - aScript do: [ :each | | cameraPoint mark cameraScale | - cameraPoint := each at: #startPoint ifAbsent: [nil]. - cameraScale := each at: #startZoom ifAbsent: [nil]. - (prevPt = cameraPoint and: [prevScale = cameraScale]) ifFalse: [ - mark := ZASMCameraMarkMorph new. - mark cameraPoint: cameraPoint cameraScale: cameraScale controller: aController. - newMorphs add: mark. - ]. - newMorphs add: (ZASMStepsMorph new setStepCount: (each at: #steps ifAbsent: [10])). - cameraPoint := each at: #endPoint ifAbsent: [nil]. - cameraScale := each at: #endZoom ifAbsent: [nil]. - mark := ZASMCameraMarkMorph new. - mark cameraPoint: cameraPoint cameraScale: cameraScale controller: aController. - newMorphs add: mark. - prevPt := cameraPoint. - prevScale := cameraScale. - ]. - self addAllMorphs: newMorphs. - ! Item was removed: - ----- Method: ZASMScriptMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color blue! Item was removed: - ----- Method: ZASMScriptMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 2! Item was removed: - ----- Method: ZASMScriptMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightBlue! Item was removed: - ----- Method: ZASMScriptMorph>>fixup (in category 'private') ----- - fixup - - | newMorphs state fixed | - - somethingChanged := false. - newMorphs := OrderedCollection new. - state := #new. - fixed := false. - submorphs do: [ :each | - (each isKindOf: ZASMCameraMarkMorph) ifTrue: [ - state == #mark ifTrue: [ - newMorphs add: ( - ZASMStepsMorph new setStepCount: 10 - ). - fixed := true. - ]. - newMorphs add: each. - state := #mark. - ]. - (each isKindOf: ZASMStepsMorph) ifTrue: [ - state == #steps ifTrue: [ - fixed := true. - ] ifFalse: [ - newMorphs add: each. - state := #steps. - ]. - ]. - ]. - fixed ifTrue: [ - self removeAllMorphs. - self addAllMorphs: newMorphs. - ].! Item was removed: - ----- Method: ZASMScriptMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - somethingChanged := true. - self dragEnabled: true; - layoutPolicy: TableLayout new; - listDirection: #topToBottom; - wrapCentering: #topLeft; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 6; - - rubberBandCells: true! Item was removed: - ----- Method: ZASMScriptMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - - super layoutChanged. - somethingChanged := true. - - ! Item was removed: - ----- Method: ZASMScriptMorph>>saveScript (in category 'menus') ----- - saveScript - - | newScript scriptName | - newScript := self compileScript. - scriptName := UIManager default - request: 'Name this script' - initialAnswer: (self valueOfProperty: #cameraScriptName ifAbsent: ['']). - scriptName isEmptyOrNil ifTrue: [^self]. - (self valueOfProperty: #cameraController) - saveScript: newScript - as: scriptName. - self delete.! Item was removed: - ----- Method: ZASMScriptMorph>>step (in category 'stepping and presenter') ----- - step - - super step. - somethingChanged ifFalse: [^self]. - self fixup. - ! Item was removed: - ----- Method: ZASMScriptMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^500! Item was removed: - ----- Method: ZASMScriptMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - - ^aMorph isKindOf: ZASMCameraMarkMorph! Item was removed: - ----- Method: ZASMScriptMorph>>wantsSteps (in category 'stepping and presenter') ----- - wantsSteps - - ^true! Item was removed: - StringMorph subclass: #ZASMStepsMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: ZASMStepsMorph>>getStepCount (in category 'accessing') ----- - getStepCount - - ^[self contents asNumber] ifError: [ :a :b | 10] - - ! Item was removed: - ----- Method: ZASMStepsMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ true! Item was removed: - ----- Method: ZASMStepsMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - "If the shift key is pressed, make this string the keyboard input focus." - - self launchMiniEditor: evt - ! Item was removed: - ----- Method: ZASMStepsMorph>>setStepCount: (in category 'accessing') ----- - setStepCount: n - - self contents: n printString. - - ! Item was removed: - RectangleMorph subclass: #ZoomAndScrollControllerMorph - instanceVariableNames: 'mouseDownPoint mouseMovePoint panAndTiltFactor zoomFactor target hasFocus currentKeyDown upDownCodes changeKeysState programmedMoves' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu addLine. - aCustomMenu add: 'change tilt and zoom keys' translated action: #changeKeys. - aCustomMenu add: 'run an existing camera script' translated action: #runAScript. - aCustomMenu add: 'edit an existing camera script' translated action: #editAScript. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>cameraPoint (in category 'accessing') ----- - cameraPoint - - target ifNil: [^0 at 0]. - ^target cameraPoint - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>cameraPoint: (in category 'accessing') ----- - cameraPoint: aPoint - - target ifNil: [^self]. - target cameraPoint: aPoint! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>cameraPointRounded (in category 'accessing') ----- - cameraPointRounded - - ^self cameraPoint rounded! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>cameraScale (in category 'accessing') ----- - cameraScale - - target ifNil: [^1.0]. - ^target scale - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>cameraScale: (in category 'accessing') ----- - cameraScale: aNumber - - target ifNil: [^self]. - target changeScaleTo: aNumber! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>changeKeys (in category 'as yet unclassified') ----- - changeKeys - - upDownCodes := Dictionary new. - changeKeysState := #(up down left right in out). - self changed.! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>currentCameraVersion (in category 'constants') ----- - currentCameraVersion - - ^2! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>deadZoneWidth (in category 'constants') ----- - deadZoneWidth - - ^8 - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color transparent! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 0! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightBlue! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>doProgrammedMoves (in category 'stepping and presenter') ----- - doProgrammedMoves - - | thisMove startPoint endPoint startZoom endZoom newScale newPoint fractionLeft | - - programmedMoves isEmptyOrNil ifTrue: [ - ^programmedMoves := nil - ]. - thisMove := programmedMoves first. - thisMove at: #pauseTime ifPresent: [ :ignore | ^self]. - - fractionLeft := self fractionLeftInMove: thisMove. - fractionLeft ifNil: [^programmedMoves := programmedMoves allButFirst]. - - startPoint := thisMove at: #startPoint ifAbsentPut: [self cameraPoint]. - endPoint := thisMove at: #endPoint ifAbsentPut: [self cameraPoint]. - - startZoom := thisMove at: #startZoom ifAbsentPut: [self cameraScale]. - endZoom := thisMove at: #endZoom ifAbsentPut: [self cameraScale]. - newScale := endZoom - (endZoom - startZoom * fractionLeft). - newPoint := (endPoint - (endPoint - startPoint * fractionLeft)) "rounded". - target changeScaleTo: newScale. - target cameraPoint: newPoint. - - fractionLeft <= 0 ifTrue: [^programmedMoves := programmedMoves allButFirst]. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - | dw bullsEye f | - - super drawOn: aCanvas. - changeKeysState ifNotNil: [ - f := ( - StringMorph contents: 'Press the key to be used for "',changeKeysState first,'"' - ) imageForm. - aCanvas paintImage: f at: self center - (f extent // 2). - ^self - ]. - mouseDownPoint ifNil: [^self]. - dw := self deadZoneWidth. - bullsEye := mouseDownPoint - (dw at dw//2) extent: dw at dw. - aCanvas - fillRectangle: (bullsEye left @ self top corner: bullsEye right @ self bottom) - color: (Color red alpha: 0.3). - aCanvas - fillRectangle: (self left @ bullsEye top corner: self right @ bullsEye bottom) - color: (Color red alpha: 0.3). - aCanvas - fillRectangle: bullsEye - color: (Color red alpha: 0.4). - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>editAScript (in category 'menus') ----- - editAScript - - | d names reply s | - d := self targetScriptDictionary. - names := d keys asArray sort. - reply := UIManager default chooseFrom: names values: names title: 'Script to edit?'. - reply ifNil: [^ self]. - (s := ZASMScriptMorph new) - decompileScript: (d at: reply) named: reply for: self; - fullBounds; - align: s center with: self center; - openInWorld - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>fractionLeftInMove: (in category 'private') ----- - fractionLeftInMove: thisMove - - | steps stepsRemaining fractionLeft endTime startTime | - - (thisMove includesKey: #steps) ifTrue: [ - steps := thisMove at: #steps ifAbsentPut: [1]. - stepsRemaining := thisMove at: #stepsRemaining ifAbsentPut: [steps]. - stepsRemaining < 1 ifTrue: [^nil]. - stepsRemaining := stepsRemaining - 1. - fractionLeft := stepsRemaining / steps. - thisMove at: #stepsRemaining put: stepsRemaining. - ] ifFalse: [ - endTime := thisMove at: #endTime ifAbsent: [^nil]. - startTime := thisMove at: #startTime ifAbsent: [^nil]. - fractionLeft := (endTime - Time millisecondClockValue) / (endTime - startTime). - ]. - ^fractionLeft max: 0 - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>grabCameraPositionEvent:morph: (in category 'camera') ----- - grabCameraPositionEvent: anEvent morph: aMorph - - | mark | - mark := ZASMCameraMarkMorph new. - mark - cameraPoint: self cameraPoint - cameraScale: self cameraScale - controller: self - page: target. - anEvent hand attachMorph: mark.! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>handlesKeyboard: (in category 'event handling') ----- - handlesKeyboard: evt - - ^true! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^true! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - - ^true! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>hasFocus (in category 'event handling') ----- - hasFocus - - ^ hasFocus! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - | displayer dataMorph | - super initialize. - "" - hasFocus := true. - currentKeyDown := Set new. - upDownCodes := Dictionary new. - upDownCodes at: 31 put: #up; "arrow keys" - at: 30 put: #down; - at: 29 put: #left; - at: 28 put: #right; - at: 88 put:#in; "x" - at: 90 put:#out. "y" - - self extent: 40 @ 40; - vResizing: #rigid; - hResizing: #spaceFill; - setBalloonText: 'Drag in here to zoom, tilt and pan the page above'. - dataMorph := AlignmentMorph newColumn. - dataMorph color: Color yellow; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap. - dataMorph - on: #mouseDown - send: #grabCameraPositionEvent:morph: - to: self. - displayer := UpdatingStringMorph new getSelector: #cameraPointRounded; - target: self; - growable: true; - putSelector: nil. - dataMorph addMorph: displayer lock. - displayer := UpdatingStringMorph new getSelector: #cameraScale; - target: self; - growable: true; - floatPrecision: 0.001; - putSelector: nil. - dataMorph addMorph: displayer lock. - self addMorph: dataMorph! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>keyDown: (in category 'event handling') ----- - keyDown: anEvent - - changeKeysState ifNotNil: [ - upDownCodes at: anEvent keyValue put: changeKeysState first. - changeKeysState := changeKeysState allButFirst. - changeKeysState isEmpty ifTrue: [changeKeysState := nil]. - currentKeyDown := Set new. - ^self changed - ]. - currentKeyDown add: anEvent keyValue. - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>keyStroke: (in category 'event handling') ----- - keyStroke: anEvent - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>keyUp: (in category 'event handling') ----- - keyUp: anEvent - - currentKeyDown remove: anEvent keyValue ifAbsent: [].! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - mouseDownPoint := evt cursorPoint. - self changed.! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>mouseEnter: (in category 'event handling') ----- - mouseEnter: evt - - evt hand newKeyboardFocus: self. - currentKeyDown := Set new. - hasFocus := true. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>mouseLeave: (in category 'event handling') ----- - mouseLeave: evt - - currentKeyDown := Set new. - hasFocus := false. - mouseMovePoint := mouseDownPoint := nil. - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - mouseMovePoint := evt cursorPoint. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - mouseMovePoint := mouseDownPoint := nil. - self changed.! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>patchOldVersion1 (in category 'private') ----- - patchOldVersion1 - - "hack.. use this as an opportunity to fix old versions" - self allMorphsDo: [:m | - ((m isKindOf: UpdatingStringMorph) and: [m getSelector == #cameraPoint]) ifTrue: [ - m getSelector: #cameraPointRounded - ]. - ]. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>pauseProgrammedMoves (in category 'piano rolls') ----- - pauseProgrammedMoves - - programmedMoves isEmptyOrNil ifTrue: [^self]. - programmedMoves first - at: #pauseTime - put: Time millisecondClockValue - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>resumeProgrammedMoves (in category 'piano rolls') ----- - resumeProgrammedMoves - - | thisStep | - - programmedMoves isEmptyOrNil ifTrue: [^self]. - (thisStep := programmedMoves first) - at: #pauseTime - ifPresent: [ :pauseTime | - thisStep - at: #startTime - put: (thisStep at: #startTime) + Time millisecondClockValue - pauseTime. - thisStep removeKey: #pauseTime ifAbsent: []. - ]. - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>runAScript (in category 'menus') ----- - runAScript - - | d names reply | - d := self targetScriptDictionary. - names := d keys asArray sort. - reply := UIManager default chooseFrom: names values: names title: 'Script to run?'. - reply ifNil: [^ self]. - programmedMoves := (d at: reply) veryDeepCopy.! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>saveScript:as: (in category 'menus') ----- - saveScript: newScript as: scriptName - - self targetScriptDictionary at: scriptName put: newScript. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>setProgrammedMoves: (in category 'menus') ----- - setProgrammedMoves: aCollection - - programmedMoves := aCollection - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>step (in category 'stepping and presenter') ----- - step - - | delta halfDW shift | - shift := false. - (self valueOfProperty: #currentCameraVersion ifAbsent: [0]) = - self currentCameraVersion ifFalse: [ - self patchOldVersion1. - self setProperty: #currentCameraVersion toValue: self currentCameraVersion. - ]. - super step. - self doProgrammedMoves. - - (currentKeyDown ifNil: [#()]) do: [ :each | | action | - action := upDownCodes at: each ifAbsent: [shift := true]. - action == #in ifTrue: [ - target scaleImageBy: -10. - ]. - action == #out ifTrue: [ - target scaleImageBy: 10. - ]. - action == #up ifTrue: [ - target panImageBy: 0@ -20. - ]. - action == #down ifTrue: [ - target panImageBy: 0 at 20. - ]. - action == #left ifTrue: [ - target panImageBy: -20 at 0. - ]. - action == #right ifTrue: [ - target panImageBy: 20 at 0. - ]. - ]. - mouseMovePoint ifNil: [^self]. - mouseDownPoint ifNil: [^self]. - target ifNil: [^self]. - halfDW := self deadZoneWidth // 2. - halfDW := self deadZoneWidth // 2. - delta := mouseMovePoint - mouseDownPoint. - delta x abs <= halfDW ifTrue: [delta := 0 at delta y]. - delta y abs <= halfDW ifTrue: [delta := delta x at 0]. - shift ifTrue:[^target scaleImageBy: delta x]. - target panImageBy: delta x @ delta y - - - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^10 - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>target: (in category 'accessing-backstop') ----- - target: x - - target := x. - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>targetScriptDictionary (in category 'accessing') ----- - targetScriptDictionary - - target ifNil: [^Dictionary new]. - ^target - valueOfProperty: #namedCameraScripts - ifAbsent: [ - | scriptDict | - scriptDict := Dictionary new. - target setProperty: #namedCameraScripts toValue: scriptDict. - scriptDict - ]. - - ! Item was removed: - ----- Method: ZoomAndScrollControllerMorph>>turnToPage:position:scale:transition: (in category 'camera') ----- - turnToPage: page position: aPoint scale: aNumber transition: aSpec - - | myBook | - - target == page ifTrue: [^false]. - page ifNil: [^false]. - myBook := (self ownerThatIsA: StoryboardBookMorph) ifNil: [^ false]. - 2 timesRepeat: [ - page - cameraPoint: aPoint; - changeScaleTo: aNumber - ]. - BookMorph turnOffSoundWhile: [ - myBook - goToPageMorph: page - transitionSpec: aSpec. - ]. - ^true! Item was removed: - PasteUpMorph subclass: #ZoomAndScrollMorph - instanceVariableNames: 'sourceRectangle usingBalloon panAndTiltFactor zoomFactor' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Demo'! - - !ZoomAndScrollMorph commentStamp: '<historical>' prior: 0! - I am the outer part of a transformed view of another pasteup. I know how to translate requests to pan, tilt and zoom into appropriate changes to the transformation! Item was removed: - ----- Method: ZoomAndScrollMorph>>acceptDroppingMorph:event: (in category 'layout') ----- - acceptDroppingMorph: morphToDrop event: evt - - ^morphToDrop rejectDropMorphEvent: evt. "put it back where it came from" - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>cameraPoint (in category 'scripting') ----- - cameraPoint - - ^self myTransformMorph transform globalPointToLocal: self innerBounds center - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>cameraPoint: (in category 'scripting') ----- - cameraPoint: newPt - - | transform | - - transform := self myTransformMorph. - self changeOffsetTo: newPt * transform scale - (transform innerBounds extent // 2) - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>changeOffsetBy: (in category 'accessing') ----- - changeOffsetBy: aPoint - - | transform rounder roundPt | - - "improve behavior at high magnification by rounding change to whole source pixels" - transform := self myTransformMorph. - rounder := [ :val | - "(val abs + (transform scale * 0.99) roundTo: transform scale) * val sign" - "looks like rounding wasn't a good solution" - val - ]. - roundPt := (rounder value: aPoint x) @ (rounder value: aPoint y). - - self changeOffsetTo: transform offset + roundPt. - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>changeOffsetTo: (in category 'accessing') ----- - changeOffsetTo: aPoint - - | transform trialOffset innerPasteup keepWidth keepHeight | - - transform := self myTransformMorph. - keepWidth := transform width "// 4". - keepHeight := transform height "// 4". - innerPasteup := transform firstSubmorph. - trialOffset := aPoint. - trialOffset := - (trialOffset x - min: (innerPasteup width * transform scale) - keepWidth - max: keepWidth - transform width) @ - (trialOffset y - min: (innerPasteup height * transform scale) - keepHeight - max: keepHeight - transform height). - transform offset: trialOffset. - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>changeScaleTo: (in category 'accessing') ----- - changeScaleTo: aNumber - - | transform innerPasteup min1 min2 newScale oldPoint | - - transform := self myTransformMorph. - "oldScale := transform scale." - innerPasteup := transform firstSubmorph. - - min1 := transform width / innerPasteup width asFloat. - min2 := transform height / innerPasteup height asFloat. - newScale := (aNumber max: min1) max: min2. - - oldPoint := self cameraPoint. - transform scale: newScale. - self cameraPoint: oldPoint. - - "scaleR := newScale / oldScale. - half := transform extent // 2. - half := 0 at 0. - self changeOffsetBy: scaleR * (transform offset + half) - half - transform offset." - - "==Alan's preferred factors - pan = 0.0425531914893617 - zoom = 0.099290780141844 - ===" - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>changeTiltFactor: (in category 'accessing') ----- - changeTiltFactor: x - - panAndTiltFactor := x! Item was removed: - ----- Method: ZoomAndScrollMorph>>changeZoomFactor: (in category 'accessing') ----- - changeZoomFactor: x - - zoomFactor := x! Item was removed: - ----- Method: ZoomAndScrollMorph>>createInteriorTransform (in category 'initialization') ----- - createInteriorTransform - - | innerPasteUp tm | - innerPasteUp := PasteUpMorph new. - innerPasteUp - borderWidth: 0; - minHeight: 100; - minWidth: 100; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - position: 0 at 0; - extent: 100 at 100. - tm := TransformationB2Morph new. - tm setProperty: #rotationCenter toValue: 0 at 0. - tm useRegularWarpBlt: usingBalloon not. - self addMorph: tm. - tm addMorph: innerPasteUp. - tm beSticky. - innerPasteUp beSticky. - tm - scale: 1.0; - offset: 0 at 0. - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - "answer the default border color/fill style for the receiver" - ^ Color red! Item was removed: - ----- Method: ZoomAndScrollMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color lightGray! Item was removed: - ----- Method: ZoomAndScrollMorph>>extent: (in category 'geometry') ----- - extent: extentPoint - - super extent: extentPoint. - self myTransformMorph bounds: self innerBounds. - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>getTiltFactor (in category 'accessing') ----- - getTiltFactor - - ^panAndTiltFactor ifNil: [panAndTiltFactor := 0.5]. - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>getZoomFactor (in category 'accessing') ----- - getZoomFactor - - ^zoomFactor ifNil: [zoomFactor := 0.5]. - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - usingBalloon := true. - self createInteriorTransform ! Item was removed: - ----- Method: ZoomAndScrollMorph>>myTransformMorph (in category 'scripting') ----- - myTransformMorph - - ^self firstSubmorph - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>offsetX (in category 'scripting') ----- - offsetX - - ^self myTransformMorph offset x - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>offsetX: (in category 'scripting') ----- - offsetX: aNumber - - | transform | - - transform := self myTransformMorph. - transform offset: aNumber @ transform offset y - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>offsetY (in category 'scripting') ----- - offsetY - - ^self myTransformMorph offset y - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>offsetY: (in category 'scripting') ----- - offsetY: aNumber - - | transform | - - transform := self myTransformMorph. - transform offset: transform offset x @ aNumber - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>panImageBy: (in category 'as yet unclassified') ----- - panImageBy: pixels - - self changeOffsetBy: (pixels x* self getTiltFactor * 0.1) @ (pixels y* self getTiltFactor * 0.1) - - "steps := (pixels abs / 6) exp rounded * pixels sign." - "==Alan's preferred factors - pan = 0.0425531914893617 - zoom = 0.099290780141844 - ===" - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>scale (in category 'scripting') ----- - scale - - ^self myTransformMorph scale - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>scale: (in category 'scripting') ----- - scale: aValue - - self myTransformMorph scale: aValue. - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>scaleImageBy: (in category 'transformations') ----- - scaleImageBy: pixels - - | scalePerPixel steps transform factor | - - transform := self myTransformMorph. - (steps := (pixels * self getZoomFactor * 0.2) rounded) = 0 ifTrue: [^self]. - scalePerPixel := 1.01. - factor := scalePerPixel raisedTo: steps abs. - steps > 0 ifTrue: [ - factor := 1.0 / factor. - ]. - self changeScaleTo: (transform scale * factor min: 10.0 max: 0.1). - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>step (in category 'stepping and presenter') ----- - step - - | innerPasteUp overlap | - - innerPasteUp := self myTransformMorph firstSubmorph. - overlap := (innerPasteUp submorphs - inject: 0 at 0 - into: [ :min :each | min min: each position]) rounded. - overlap = (0 at 0) ifFalse: [ - innerPasteUp submorphs do: [ :each | each position: each position - overlap]. - innerPasteUp layoutChanged. - ]. - - - - ! Item was removed: - ----- Method: ZoomAndScrollMorph>>stepTime (in category 'stepping and presenter') ----- - stepTime - - ^10 "ms"! Item was removed: - ----- Method: ZoomAndScrollMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') ----- - wantsDroppedMorph: aMorph event: evt - - "we don't, really, but it avoids problem of outer pasteup rejecting a drop for inner pasteup" - ^true! Item was removed: - (PackageInfo named: 'MorphicExtras') postscript: 'ScrapBook cleanUp: true.'!
More information about the Squeak-dev mailing list |