The Trunk: MorphicExtras-nice.64.mcz
Locked
 
|
Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-nice.64.mcz ==================== Summary ==================== Name: MorphicExtras-nice.64 Author: nice Time: 27 December 2009, 4:47:29 am UUID: 328f9863-9e23-4baa-b4eb-ca09575dc69d Ancestors: MorphicExtras-nice.63 Cosmetic: move or remove a few temps inside closures =============== Diff against MorphicExtras-nice.63 =============== Item was changed: ----- Method: ZASMScriptMorph>>decompileScript:named:for: (in category 'as yet unclassified') ----- decompileScript: aScript named: aString for: aController + | newMorphs prevPt prevScale | - | newMorphs prevPt prevScale cameraPoint cameraScale mark | self removeAllMorphs. self setProperty: #cameraController toValue: aController. self setProperty: #cameraScriptName toValue: aString. newMorphs := OrderedCollection new. prevPt := prevScale := nil. + aScript do: [ :each | | cameraPoint mark cameraScale | - aScript do: [ :each | 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 changed: ----- 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 itsWorld | myWorld := self world. + aCollection do: [:m | | itsWorld | - aCollection do: [:m | 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 changed: ----- Method: BookMorph>>morphsForPageSorter (in category 'sorting') ----- morphsForPageSorter + | thumbnails | - | i thumbnails | 'Assembling thumbnail images...' displayProgressAt: self cursorPoint from: 0 to: pages size during: + [:bar | | i | + i := 0. - [:bar | i := 0. thumbnails := pages collect: [:p | bar value: (i:= i+1). pages size > 40 ifTrue: [p smallThumbnailForPageSorter inBook: self] ifFalse: [p thumbnailForPageSorter inBook: self]]]. ^ thumbnails! Item was changed: ----- Method: PaintBoxMorph>>loadPressedForm: (in category 'initialization') ----- loadPressedForm: pic16Bit "Prototype loadPressedForm: (Smalltalk imageImports at: #pressedPaletteJapanese)" + | blt | - | blt on | AllPressedImage := AllPressedImage := Form extent: OriginalBounds extent depth: 16. blt := BitBlt current toForm: AllPressedImage. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0 @ 0; copyBits. AllPressedImage mapColor: Color black to: Color transparent. self + allMorphsDo: [:button | | on | + (button isKindOf: ThreePhaseButtonMorph) - allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [on := Form extent: button extent depth: 16. on copy: (0 @ 0 extent: button extent) from: button topLeft - self topLeft in: AllPressedImage rule: Form over. button pressedImage: on]]. AllPressedImage := nil. self invalidRect: bounds ! Item was changed: ----- 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 | - | where triplets groups g2 fillC | 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 - do: [:g1 | 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 changed: ----- Method: BouncingAtomsMorph>>transmitInfection (in category 'other') ----- transmitInfection + | count | + self collisionPairs do: [:pair | | infected | - | infected count | - self collisionPairs do: [:pair | 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 changed: ----- Method: TransformationB2Morph>>drawSubmorphsOn: (in category 'drawing') ----- drawSubmorphsOn: aCanvas + | r1 fullG r2 newClip deferredMorphs | - | r1 fullG r2 actualCanvas newClip where deferredMorphs case | (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 | - during: [:myCanvas | 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 | - deferredMorphs do: [ :each | 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 changed: ----- Method: BookMorph class>>makeBookOfProjects:named: (in category 'booksAsProjects') ----- makeBookOfProjects: aListOfProjects named: aString " BookMorph makeBookOfProjects: (Project allProjects select: [ :each | each world isMorph]) " + | book | - | book pvm page | book := self new. book setProperty: #transitionSpec toValue: {'silence'. #none. #none}. + aListOfProjects do: [ :each | | pvm page | - aListOfProjects do: [ :each | pvm := ProjectViewMorph on: each. page := PasteUpMorph new addMorph: pvm; extent: pvm extent. book insertPage: page pageSize: page extent ]. book goToPage: 1. book deletePageBasic. book setProperty: #nameOfThreadOfProjects toValue: aString. book removeProperty: #transitionSpec. book openInWorld! Item was changed: ----- Method: BookMorph>>acceptSortedContentsFrom: (in category 'sorting') ----- acceptSortedContentsFrom: aHolder "Update my page list from the given page sorter." + | goodPages rejects | - | goodPages rejects toAdd sqPage | goodPages := OrderedCollection new. rejects := OrderedCollection new. aHolder submorphs doWithIndex: + [:m :i | | toAdd sqPage | - [:m :i | toAdd := nil. (m isKindOf: PasteUpMorph) ifTrue: [toAdd := m]. (m isKindOf: BookPageThumbnailMorph) ifTrue: [toAdd := m page. m bookMorph == self ifFalse: ["borrowed from another book. preserve the original" toAdd := toAdd veryDeepCopy. "since we came from elsewhere, cached strings are wrong" self removeProperty: #allTextUrls. self removeProperty: #allText]]. toAdd isString ifTrue: ["a url" toAdd := pages detect: [:aPage | aPage url = toAdd] ifNone: [toAdd]]. toAdd isString ifTrue: [sqPage := SqueakPageCache atURL: toAdd. toAdd := sqPage contentsMorph ifNil: [sqPage copyForSaving "a MorphObjectOut"] ifNotNil: [sqPage contentsMorph]]. toAdd ifNil: [rejects add: m] ifNotNil: [goodPages add: toAdd]]. self newPages: goodPages. goodPages isEmpty ifTrue: [self insertPage]. rejects notEmpty ifTrue: [self inform: rejects size printString , ' objects vanished in this process.']! Item was changed: ----- Method: PaintBoxMorph>>loadCursors (in category 'initialization') ----- loadCursors "Display the form containing the cursors. Transparent is (Color r: 1.0 g: 0 b: 1.0). Grab the forms one at a time, and they are stored away. self loadCursors. " + | transp map | - | button transp cursor map | transp := Color r: 1.0 g: 0 b: 1.0. map := Color indexedColors copy. "just in case" 1 to: 256 do: [:ind | (map at: ind) = transp ifTrue: [map at: ind put: Color transparent]]. + #(erase: eyedropper: fill: paint: rect: ellipse: polygon: line: star: ) do: [:sel | | button cursor | - #(erase: eyedropper: fill: paint: rect: ellipse: polygon: line: star: ) do: [:sel | self inform: 'Rectangle for ',sel. cursor := ColorForm fromUser. cursor colors: map. "share it" button := self submorphNamed: sel. button arguments at: 3 put: cursor]. ! Item was changed: ----- Method: ZASMScriptMorph>>compileScript (in category 'as yet unclassified') ----- compileScript + | newScript prevMark prevSteps | - | newScript prevMark prevSteps data | self fixup. newScript := OrderedCollection new. prevMark := prevSteps := nil. + submorphs do: [ :each | | data | - submorphs do: [ :each | (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 changed: ----- 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." + - | e1 e2 t1 t2 e3 t3 | tape := Array streamContents: + [:tStream | | e1 t1 t2 e2 t3 e3 | - [:tStream | 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 changed: ----- 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 sf remoteFile strm remote pageURL num pre index after dict allText allTextUrls fName | mine := self valueOfProperty: #url. mine ifNil: [^ self saveIndexOnURL]. Cursor wait showWhile: [strm := (ServerFile new fullPath: mine)]. strm ifNil: [^ self saveIndexOnURL]. strm isString ifTrue: [^ self saveIndexOnURL]. strm exists ifFalse: [^ self saveIndexOnURL]. "write whole thing if missing" strm := strm asStream. strm isString ifTrue: [^ self saveIndexOnURL]. remote := strm fileInObjectAndCode. dict := remote first. allText := dict at: #allText ifAbsent: [nil]. "remote, not local" allTextUrls := dict at: #allTextUrls ifAbsent: [nil]. allText size + 1 ~= remote size ifTrue: [self error: '.bo size mismatch. Please tell Ted what you just did to this book.' translated]. (pageURL := aPage url) ifNil: [self error: 'just had one!!' translated]. fName := pageURL copyAfterLast: $/. 2 to: remote size do: [:ii | ((remote at: ii) url findString: fName startingAt: 1 caseSensitive: false) > 0 ifTrue: [index := ii]. "fast" (remote at: ii) xxxReset]. index ifNil: ["new page, what existing page does it follow?" num := self pageNumberOf: aPage. 1 to: num-1 do: [:ii | (pages at: ii) url ifNotNil: [pre := (pages at: ii) url]]. pre ifNil: [after := remote size+1] ifNotNil: ["look for it on disk, put me after" pre := pre copyAfterLast: $/. 2 to: remote size do: [:ii | ((remote at: ii) url findString: pre startingAt: 1 caseSensitive: false) > 0 ifTrue: [after := ii+1]]. after ifNil: [after := remote size+1]]. remote := remote copyReplaceFrom: after to: after-1 with: #(1). allText ifNotNil: [ dict at: #allText put: (allText copyReplaceFrom: after-1 to: after-2 with: #(())). dict at: #allTextUrls put: (allTextUrls copyReplaceFrom: after-1 to: after-2 with: #(()))]. index := after]. remote at: index put: (aPage sqkPage copyForSaving). (dict at: #modTime ifAbsent: [0]) < Time totalSeconds ifTrue: [dict at: #modTime put: Time totalSeconds]. allText ifNotNil: [ (dict at: #allText) at: index-1 put: (aPage allStringsAfter: nil). (dict at: #allTextUrls) at: index-1 put: pageURL]. sf := ServerDirectory new fullPath: mine. + Cursor wait showWhile: [ | remoteFile | - Cursor wait showWhile: [ remoteFile := sf fileNamed: mine. remoteFile fileOutClass: nil andObject: remote. "remoteFile close"]. ! Item was changed: ----- Method: SqueakPage>>write (in category 'saving') ----- write "Decide whether to write this page on the disk." + | sf | - | sf remoteFile | 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 ifNil: ['*']. lastChangeTime := Time totalSeconds. + Cursor wait showWhile: [ | remoteFile | - Cursor wait showWhile: [ 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 changed: ----- 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 good thisWord here fromHereOn startToHere oldContainer oldIndex otherKeys strings | allText := self valueOfProperty: #allText ifAbsent: [#()]. here := pages identityIndexOf: currentPage ifAbsent: [1]. fromHereOn := here+1 to: pages size. startToHere := 1 to: here. "repeat this page" (self valueOfProperty: #searchKey ifAbsent: [#()]) = wants ifTrue: [ "does page have all the other keys? No highlight if found!!" otherKeys := wants allButFirst. strings := allText at: here. good := true. + otherKeys do: [:searchString | | thisWord | "each key" - otherKeys do: [:searchString | "each key" good ifTrue: [thisWord := false. strings do: [:longString | (longString findString: searchString startingAt: 1 caseSensitive: false) > 0 ifTrue: [ thisWord := true]]. good := thisWord]]. good ifTrue: ["all are on this page. Look in rest for string again." oldContainer := self valueOfProperty: #searchContainer. oldIndex := self valueOfProperty: #searchOffset. (self findText: (OrderedCollection with: wants first) inStrings: strings startAt: oldIndex+1 container: oldContainer pageNum: here) ifTrue: [ self setProperty: #searchKey toValue: wants. ^ true]]] ifFalse: [fromHereOn := here to: pages size]. "do search this page" "other pages" allText ifNotEmpty: [ fromHereOn do: [:pageNum | (self findText: wants inStrings: (allText at: pageNum) startAt: 1 container: nil pageNum: pageNum) ifTrue: [^ true]]. startToHere do: [:pageNum | (self findText: wants inStrings: (allText at: pageNum) startAt: 1 container: nil pageNum: pageNum) ifTrue: [^ true]]]. "if fail" self setProperty: #searchContainer toValue: nil. self setProperty: #searchOffset toValue: nil. self setProperty: #searchKey toValue: nil. ^ false! Item was changed: ----- Method: PaintBoxMorph>>loadPressedImage: (in category 'initialization') ----- loadPressedImage: fileName "Read in and convert the image for the paintBox with the buttons on. A .bmp 24-bit image. For each button, cut that chunk out and save it." " self loadPressedImage: 'NoSh:=on.bmp'. AllPressedImage := nil. 'save space'. " + | pic16Bit blt aa type | - | pic16Bit blt aa on type | type := 'gif'. " gif or bmp " type = 'gif' ifTrue: [ pic16Bit "really 8" := GIFReadWriter formFromFileNamed: fileName. pic16Bit display. aa := AllPressedImage := Form extent: OriginalBounds extent depth: 8. blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. ]. type = 'bmp' ifTrue: [ pic16Bit := (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. pic16Bit display. aa := AllPressedImage := Form extent: OriginalBounds extent depth: 16. blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. aa mapColor: Color transparent to: Color black. ]. "Collect all the images for the buttons in the on state" + self allMorphsDo: [:button | | on | - self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ type = 'gif' ifTrue: [on := ColorForm extent: button extent depth: 8. on colors: pic16Bit colors] ifFalse: [on := Form extent: button extent depth: 16]. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button pressedImage: on]]. self invalidRect: bounds. ! Item was changed: ----- Method: PaintBoxMorph>>createButtons (in category 'initialization') ----- createButtons "Create buttons one at a time and let the user place them over the background. Later can move them again by turning on AuthorModeOwner in ThreePhaseButtonMorph. self createButtons. " + | rect button | - | rect button nib | #(erase: eyedropper: fill: paint: rect: ellipse: polygon: line: star: pickup: "pickup: pickup: pickup:" stamp: "stamp: stamp: stamp:" undo: keep: toss: prevStamp: nextStamp:) do: [:sel | (self submorphNamed: sel) ifNil: [self inform: 'Rectangle for ',sel. rect := Rectangle fromUser. button := ThreePhaseButtonMorph new. button onImage: nil; bounds: rect. self addMorph: button. button actionSelector: #tool:action:cursor:evt:; arguments: (Array with: button with: sel with: nil). button actWhen: #buttonUp; target: self]]. + #(brush1: brush2: brush3: brush4: brush5: brush6: ) doWithIndex: [:sel :ind | | nib | - #(brush1: brush2: brush3: brush4: brush5: brush6: ) doWithIndex: [:sel :ind | (self submorphNamed: sel) ifNil: [self inform: 'Rectangle for ',sel. rect := Rectangle fromUser. button := ThreePhaseButtonMorph new. button onImage: nil; bounds: rect. self addMorph: button. nib := Form dotOfSize: (#(1 2 3 6 11 26) at: ind). button actionSelector: #brush:action:nib:evt:; arguments: (Array with: button with: sel with: nib). button actWhen: #buttonUp; target: self]]. "stamp: Stamps are held in a ScrollingToolHolder. Pickups and stamps and brushes are id-ed by the button == with item from a list." ! Item was changed: ----- 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 p ms x points 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: - [: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: - [:env | 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 changed: ----- 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 | - | pg | - pages do: [:aPage | aPage yourself. "bring it into memory" (pg := aPage valueOfProperty: #SqueakPage) ifNotNil: [ SqueakPageCache removeURL: pg url. pg contentsMorph setProperty: #SqueakPage toValue: nil]]. self setProperty: #url toValue: nil.! Item was changed: ----- 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.)" + - | value newValue | #(mouseDownRecipient mouseStillDownRecipient mouseUpRecipient mouseEnterRecipient mouseLeaveRecipient mouseEnterDraggingRecipient mouseLeaveDraggingRecipient clickRecipient doubleClickRecipient startDragRecipient keyStrokeRecipient valueParameter) do: + [:aName | | value newValue | - [:aName | (value := self instVarNamed: aName asString) ifNotNil:[ newValue := value adaptedToWorld: aWorld. (newValue notNil and: [newValue ~~ value]) ifTrue: [self instVarNamed: aName asString put: newValue]]]! Item was changed: ----- Method: PaintBoxMorph>>noVeneer (in category 'initialization') ----- noVeneer "For a palette with a background (off) image, clear that image. But first, for each button, cut that chunk out and save it in the offImage part." " self noVeneer. AllOffImage := nil. 'save space. irreversible'. " + | aa | - | aa on | AllOffImage ifNil: [AllOffImage := image]. aa := AllOffImage. "Collect all the images for the buttons in the on state" + self allMorphsDo: [:button | | on | - self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ on := Form extent: button extent depth: 16. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button offImage: on]]. self image: (Form extent: AllOffImage extent depth: 1). self invalidRect: bounds. ! Item was changed: ----- Method: LedCharacterMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + | foregroundColor backgroundColor thickness hThickness vThickness hOffset vOffset i | - | foregroundColor backgroundColor thickness hThickness vThickness hOffset vOffset bOrigin 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 | - [:tOrigin :isLit | 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 changed: ----- Method: ScaleMorph>>drawMajorTicksOn: (in category 'drawing') ----- drawMajorTicksOn: aCanvas + | scale x1 y1 y2 y3 loopStart checkStart yoffset randomLabel even | - | scale x1 y1 y2 x y3 even yy loopStart checkStart 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 - 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 | - [:v | 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 changed: ----- Method: PostscriptCanvas class>>postscriptFontInfoForFont: (in category 'font mapping') ----- postscriptFontInfoForFont: font + | decoded decodedName keys match fontName | - | fontName decoded desired mask decodedName keys match | 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 | - match do: [ :key | | subD | 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. 1.0} ! Item was changed: ----- Method: PinMorph>>startWiring: (in category 'wires') ----- startWiring: event "Start wiring from this pin" + | origin candidates handle candidate | - | origin handle candidates candidate wiringColor wire | origin := self wiringEndPoint. candidates := OrderedCollection new. "Later this could be much faster if we define pinMorphsDo: so that it doesn't go too deep and bypasses non-widgets." self pasteUpMorph allMorphsDo: [:m | ((m isMemberOf: PinMorph) and: [m canDockWith: self]) ifTrue: [candidates add: m]]. handle := NewHandleMorph new followHand: event hand forEachPointDo: + [:newPoint | | wiringColor | - [:newPoint | candidate := candidates detect: [:m | m containsPoint: newPoint] ifNone: [nil]. wiringColor := candidate isNil ifTrue: [Color black] ifFalse: [Color red]. handle removeAllMorphs; addMorph: (PolygonMorph vertices: (Array with: origin with: newPoint) color: Color black borderWidth: 1 borderColor: wiringColor)] lastPointDo: + [:lastPoint | | wire | - [:lastPoint | (self wireTo: candidate) ifTrue: [wire := (WireMorph vertices: (Array with: origin with: lastPoint) color: Color black borderWidth: 1 borderColor: Color black) fromPin: self toPin: candidate. self pasteUpMorph addMorph: wire. self addWire: wire. candidate addWire: wire]]. event hand world addMorph: handle. handle startStepping! Item was changed: ----- Method: InternalThreadNavigationMorph>>addButtons (in category 'initialization') ----- addButtons + | marginPt i sz data images b1 b2 dot arrowWidth arrowHeight nameMorph sizeRatio controlsColor | - | marginPt i sz data images pageNumber f m b1 b2 dot arrowWidth arrowCenter vertices 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 | - images := data collect: [ :tuple | 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@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 changed: ----- Method: TextOnCurve>>characterBlockAtPoint: (in category 'selection') ----- characterBlockAtPoint: aPoint "Answer a CharacterBlock for the character in the text at aPoint." + | curvePoint cb | - | sourcePoint cb curvePoint | self textSegmentsDo: + [:line :destRect :segStart :segAngle | | sourcePoint | - [:line :destRect :segStart :segAngle | (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 changed: ----- Method: PaintBoxMorph>>init3 (in category 'initialization') ----- init3 "Just a record of how we loaded in the latest paintbox button images" + | bb pic16Bit aa blt rect thin | - | bb rect lay pic16Bit aa blt on thin | self loadoffImage: 'etoy_default.gif'. self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [button offImage: nil] ifFalse: [button position: button position + (100 @ 0)]]. (bb := self submorphNamed: #keep:) position: bb position + (100 @ 0). (bb := self submorphNamed: #toss:) position: bb position + (100 @ 0). (bb := self submorphNamed: #undo:) position: bb position + (100 @ 0). "Transparent is (Color r: 1.0 g: 0 b: 1.0)" self moveButtons. self loadOnImage: 'etoy_in.gif'. AllOnImage := nil. 'save space'. self loadPressedImage: 'etoy_in.gif'. AllPressedImage := nil. 'save space'. self loadCursors. "position the stamp buttons" stampHolder stampButtons owner last delete. stampHolder pickupButtons last delete. stampHolder stampButtons: (stampHolder stampButtons copyFrom: 1 to: 3). stampHolder pickupButtons: (stampHolder pickupButtons copyFrom: 1 to: 3). "| rect |" stampHolder pickupButtons do: [:button | "PopUpMenu notify: 'Rectangle for ',sel." rect := Rectangle fromUser. button bounds: rect "image is nil"]. "| rect lay |" stampHolder clear. stampHolder stampButtons do: + [:button | | lay | - [:button | button offImage: nil; pressedImage: nil. lay := button owner. "PopUpMenu notify: 'Rectangle for ',sel." rect := Rectangle fromUser. button image: (Form fromDisplay: (rect insetBy: 2)). lay borderWidth: 2. lay bounds: rect "image is nil"]. "| pic16Bit blt aa on |" pic16Bit := GIFReadWriter formFromFileNamed: 'etoy_in.gif'. "really 8" aa := Form extent: OriginalBounds extent depth: 8. blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0 @ 0; copyBits. "Collect all the images for the buttons in the on state" stampHolder pickupButtons do: + [:button | | on | - [:button | on := ColorForm extent: button extent depth: 8. on colors: pic16Bit colors. on copy: (0 @ 0 extent: button extent) from: button topLeft - self topLeft in: aa rule: Form over. button image: on; pressedImage: on; offImage: nil]. self invalidRect: bounds. ((self submorphNamed: #erase:) arguments third) offset: 12 @ 35. ((self submorphNamed: #eyedropper:) arguments third) offset: 0 @ 0. ((self submorphNamed: #fill:) arguments third) offset: 10 @ 44. ((self submorphNamed: #paint:) arguments third) offset: 3 @ 3. "unused" ((self submorphNamed: #rect:) arguments third) offset: 6 @ 17. ((self submorphNamed: #ellipse:) arguments third) offset: 5 @ 4. ((self submorphNamed: #polygon:) arguments third) offset: 5 @ 4. ((self submorphNamed: #line:) arguments third) offset: 5 @ 17. ((self submorphNamed: #star:) arguments third) offset: 2 @ 5. thumbnail delete. thumbnail := nil. (submorphs select: [:e | e class == RectangleMorph]) first bounds: Rectangle fromUser. ((submorphs select: [:e | e class == RectangleMorph]) first) borderWidth: 1; borderColor: Color black. "| thin |" submorphs do: [:ss | ss class == ImageMorph ifTrue: [thin := ss "first"]]. colorMemoryThin := thin! Item was changed: ----- 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 | - ^ PageCache at: aURLString ifAbsent: [ 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 changed: ----- Method: GraphMorph>>playOnce (in category 'commands') ----- playOnce + | scaledData scale | - | scale absV scaledData | data isEmpty ifTrue: [^ self]. "nothing to play" scale := 1. + data do: [:v | + | absV | + (absV := v abs) > scale ifTrue: [scale := absV]]. - data do: [:v | (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 changed: ----- Method: BookMorph>>revertToCheckpoint: (in category 'scripting') ----- revertToCheckpoint: secsSince1901 + - | cngRecord | "Put all scripts (that appear in MethodPanes) back to the way they were at an earlier time." + MethodHolders do: [:mh | | cngRecord | - MethodHolders do: [:mh | cngRecord := mh versions versionFrom: secsSince1901. cngRecord ifNotNil: [ (cngRecord stamp: Utilities changeStamp) fileIn]]. "does not delete method if no earlier version" ! Item was changed: ----- Method: BookMorph>>menuPageVisualFor:event: (in category 'menu') ----- menuPageVisualFor: target event: evt + | tSpec menu | - | tSpec menu subMenu directionChoices | tSpec := self transitionSpecFor: target. menu := (MenuMorph entitled: ('Choose an effect (it is now {1})' translated format:{tSpec second asString translated})) defaultTarget: target. TransitionMorph allEffects do: + [:effect | | subMenu directionChoices | - [:effect | directionChoices := TransitionMorph directionsForEffect: effect. directionChoices isEmpty ifTrue: [menu add: effect asString translated target: target selector: #setProperty:toValue: argumentList: (Array with: #transitionSpec with: (Array with: tSpec first with: effect with: #none))] ifFalse: [subMenu := MenuMorph new. directionChoices do: [:dir | subMenu add: dir asString translated target: target selector: #setProperty:toValue: argumentList: (Array with: #transitionSpec with: (Array with: tSpec first with: effect with: dir))]. menu add: effect asString translated subMenu: subMenu]]. menu popUpEvent: evt in: self world! Item was changed: ----- 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 oldStringLists allText allTextUrls aUrl which | oldUrls := self valueOfProperty: #allTextUrls ifAbsent: [#()]. oldStringLists := self valueOfProperty: #allText ifAbsent: [#()]. allText := pages collect: [:pg | OrderedCollection new]. allTextUrls := Array new: pages size. + pages doWithIndex: [:aPage :ind | | 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)]]]. - pages doWithIndex: [:aPage :ind | aUrl := aPage url. aPage isInMemory - ifTrue: [(allText at: ind) addAll: (aPage allStringsAfter: nil). - aUrl ifNil: [aUrl := ind]. - allTextUrls at: ind put: aUrl] - ifFalse: ["Order of pages on server may be different. (later keep up to date?)" - which := oldUrls indexOf: aUrl. - allTextUrls at: ind put: aUrl. - which = 0 ifFalse: [allText at: ind put: (oldStringLists at: which)]]]. self setProperty: #allText toValue: allText. self setProperty: #allTextUrls toValue: allTextUrls. ^ allText! Item was changed: ----- Method: TabSorterMorph>>acceptSort (in category 'as yet unclassified') ----- acceptSort "Reconstitute the palette based on what is found in the sorter" + | rejects oldOwner tabsToUse oldTop | - | rejects toAdd oldOwner tabsToUse appearanceMorph oldTop aMenu | tabsToUse := OrderedCollection new. rejects := OrderedCollection new. pageHolder submorphs doWithIndex: + [:m :i | | appearanceMorph toAdd aMenu | - [:m :i | 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 isKindOf: MenuLineMorph) 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 changed: ----- Method: EnvelopeEditorMorph>>addCurves (in category 'construction') ----- addCurves "Add the polyLine corresponding to the currently selected envelope, and possibly all the others, too." + - | verts aLine | sound envelopes do: + [:env | | aLine verts | - [:env | (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 changed: ----- Method: GraphMorph>>loadSoundData: (in category 'commands') ----- loadSoundData: aCollection + | newData scale | - | scale absV newData | scale := 0. + aCollection do: [:v | + | absV | + (absV := v abs) > scale ifTrue: [scale := absV]]. - aCollection do: [:v | (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 changed: ----- 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 thisWord index insideOf place container start wasIn strings old | good := true. start := startIndex. strings := oldContainer ifNil: ["normal case" rawStrings] ifNotNil: [(pages at: pageNum) isInMemory ifFalse: [rawStrings] ifTrue: [(pages at: pageNum) allStringsAfter: oldContainer]]. keys do: + [:searchString | | thisWord | - [:searchString | "each key" good ifTrue: [thisWord := false. strings do: + [:longString | | index | - [:longString | (index := longString findString: searchString startingAt: start caseSensitive: false) > 0 ifTrue: [thisWord not & (searchString == keys first) ifTrue: [insideOf := longString. place := index]. thisWord := true]. start := 1]. "only first key on first container" good := thisWord]]. good ifTrue: ["all are on this page" wasIn := (pages at: pageNum) isInMemory. self goToPage: pageNum. wasIn ifFalse: ["search again, on the real current text. Know page is in." ^self findText: keys inStrings: ((pages at: pageNum) allStringsAfter: nil) startAt: startIndex container: oldContainer pageNum: pageNum "recompute"]]. (old := self valueOfProperty: #searchContainer) ifNotNil: [(old respondsTo: #editor) ifTrue: [old editor selectFrom: 1 to: 0. "trying to remove the previous selection!!" old changed]]. good ifTrue: ["have the exact string object" (container := oldContainer) ifNil: [container := self highlightText: keys first at: place in: insideOf] ifNotNil: [container userString == insideOf ifFalse: [container := self highlightText: keys first at: place in: insideOf] ifTrue: [(container isTextMorph) ifTrue: [container editor selectFrom: place to: keys first size - 1 + place. container changed]]]. self setProperty: #searchContainer toValue: container. self setProperty: #searchOffset toValue: place. self setProperty: #searchKey toValue: keys. "override later" ActiveHand newKeyboardFocus: container. ^true]. ^false! Item was changed: ----- Method: TextPlusMorph>>repositionAnchoredMorphs (in category 'as yet unclassified') ----- repositionAnchoredMorphs + | firstCharacterIndex lastCharacterIndex | - | am cBlock leftShift firstCharacterIndex lastCharacterIndex | firstCharacterIndex := self paragraph firstCharacterIndex. lastCharacterIndex := paragraph lastCharacterIndex. text runs withStartStopAndValueDo: [:start :stop :attributes | + attributes do: [:att | | leftShift am cBlock | - attributes do: [:att | (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 changed: ----- Method: EventRecorderMorph>>convertV0Tape: (in category 'fileIn/Out') ----- convertV0Tape: anArray "Convert the tape into the new format" + | lastKey | - | lastKey evt | lastKey := 0. + ^anArray collect:[:assn| | evt | - ^anArray collect:[:assn| evt := assn value. evt setTimeStamp: (lastKey := lastKey + assn key). evt]! Item was changed: ----- Method: ScaleMorph>>drawMinorTicksOn: (in category 'drawing') ----- drawMinorTicksOn: aCanvas + | scale x1 y1 y2 loopStart yoffset randomLabel | - | scale x1 y1 y2 x 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 | - [:v | x := x1 + (scale * (v - start)). aCanvas line: x @ y1 to: x @ y2 width: 1 color: Color black]! Item was changed: ----- Method: TextPlusMorph>>fixAllLeftOffsets (in category 'as yet unclassified') ----- fixAllLeftOffsets + - | am | text runs withStartStopAndValueDo: [:start :stop :attributes | + attributes do: [:att | | am | - attributes do: [:att | (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 changed: ----- Method: BookMorph>>buildThreadOfProjects (in category 'menu') ----- buildThreadOfProjects + | projectNames threadName | - | thisPVM projectNames threadName | + projectNames := pages collect: [ :each | | thisPVM | - projectNames := pages collect: [ :each | (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 changed: ----- Method: GeePrinter>>doPrintPreview (in category 'as yet unclassified') ----- doPrintPreview + | pageDisplay sz | - | pageDisplay sz newPage subBounds pic align | 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 | - self allPages withIndexDo: [ :each :index | 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 changed: ----- Method: EventRecorderMorph>>readFromV0: (in category 'fileIn/Out') ----- readFromV0: aStream + | cr | - | cr line lineStream t evt | cr := Character cr. + ^Array streamContents:[:tStream | | evt line t lineStream | - ^Array streamContents:[:tStream | [aStream atEnd] whileFalse: [line := aStream upTo: cr. 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 changed: ----- Method: BookMorph>>methodHolderVersions (in category 'scripting') ----- methodHolderVersions + | arrayOfVersions vTimes | - | arrayOfVersions vTimes strings | "Create lists of times of older versions of all code in MethodMorphs in this book." arrayOfVersions := MethodHolders collect: [:mh | mh versions]. "equality, hash for MethodHolders?" vTimes := SortedCollection new. arrayOfVersions do: [:versionBrowser | + versionBrowser changeList do: [:cr | | strings | - versionBrowser changeList do: [:cr | (strings := cr stamp findTokens: ' ') size > 2 ifTrue: [ vTimes add: strings second asDate asSeconds + strings third asTime asSeconds]]]. VersionTimes := Time condenseBunches: vTimes. VersionNames := Time namesForTimes: VersionTimes. ! Item was changed: ----- Method: PaintBoxMorph>>fixupButtons (in category 'initialization') ----- fixupButtons + | changes answer | - | changes answer newSelector | changes := Dictionary new. changes at: #brush:action:nib: put: #brush:action:nib:evt:; at: #tool:action:cursor: put: #tool:action:cursor:evt:; at: #pickup:action:cursor: put: #pickup:action:cursor:evt:; at: #keep:with: put: #keep:with:evt:; at: #undo:with: put: #undo:with:evt:; at: #scrollStamps:action: put: #scrollStamps:action:evt:; at: #toss:with: put: #toss:with:evt:; at: #eyedropper:action:cursor: put: #eyedropper:action:cursor:evt:; at: #clear:with: put: #clear:with:evt:. answer := WriteStream on: String new. self allMorphsDo: + [:each | | newSelector | - [:each | (each isKindOf: ThreePhaseButtonMorph) ifTrue: [answer nextPutAll: each actionSelector. (changes includesKey: each actionSelector) ifTrue: [each actionSelector: (newSelector := changes at: each actionSelector). answer nextPutAll: ' <-- ' , newSelector]. answer cr]]. ^answer contents "StringHolder new contents: answer contents; openLabel: 'button fixups'"! Item was changed: ----- 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 | - | dict list mine sf remoteFile urlList | pages isEmpty ifTrue: [^self]. dict := Dictionary new. dict at: #modTime put: Time totalSeconds. "self getAllText MUST have been called at start of this operation." dict at: #allText put: (self valueOfProperty: #allText). #(#color #borderWidth #borderColor #pageSize) do: [:sel | dict at: sel put: (self perform: sel)]. self reserveUrlsIfNeeded. "should already be done" list := pages copy. "paste dict on front below" "Fix up the entries, should already be done" list doWithIndex: [:out :ind | out isInMemory ifTrue: [(out valueOfProperty: #SqueakPage) ifNil: [out saveOnURLbasic]. list at: ind put: out sqkPage copyForSaving]]. urlList := list collect: [:ppg | ppg url]. self setProperty: #allTextUrls toValue: urlList. dict at: #allTextUrls put: urlList. list := (Array with: dict) , list. mine := self valueOfProperty: #url. mine ifNil: [mine := self getStemUrl , '.bo'. self setProperty: #url toValue: mine]. sf := ServerDirectory new fullPath: mine. Cursor wait showWhile: + [ | remoteFile | + remoteFile := sf fileNamed: mine. - [remoteFile := sf fileNamed: mine. remoteFile dataIsValid. remoteFile fileOutClass: nil andObject: list "remoteFile close"]! Item was changed: ----- 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 col row b lastGuy | c := (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker]. col := AlignmentMorph newColumn. col color: c; borderWidth: 0; layoutInset: 0. col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5. row := AlignmentMorph newRow. row color: c; borderWidth: 0; layoutInset: 0. row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5. + controlSpecs do: [:spec | | lastGuy b | - controlSpecs do: [:spec | spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)] ifFalse: [spec == #variableSpacer ifTrue: [row addMorphBack: AlignmentMorph newVariableTransparentSpacer] ifFalse: [b := SimpleButtonMorph new target: self; borderWidth: 1; borderColor: Color veryLightGray; color: c. b label: spec first; actionSelector: spec second; borderWidth: 0; setBalloonText: spec third. row addMorphBack: b. (((lastGuy := spec last asLowercase) includesSubString: 'menu') or: [lastGuy includesSubString: 'designations']) ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown" col addMorphBack: row. ^ col! Item was changed: ----- Method: Flaps class>>removeDuplicateFlapTabs (in category 'shared flaps') ----- removeDuplicateFlapTabs "Remove flaps that were accidentally added multiple times" "Flaps removeDuplicateFlapTabs" + | tabs duplicates | - | tabs duplicates same | SharedFlapTabs copy ifNil: [^self]. tabs _ SharedFlapTabs copy. duplicates _ Set new. + tabs do: [:tab | | same | - tabs do: [:tab | same _ tabs select: [:each | each wording = tab wording]. same isEmpty not ifTrue: [ same removeFirst. duplicates addAll: same]]. SharedFlapTabs removeAll: duplicates! Item was changed: ----- Method: InternalThreadNavigationMorph>>triggerActionFromPianoRoll (in category 'piano rolls') ----- triggerActionFromPianoRoll + - | proj | WorldState addDeferredUIMessage: + [ | proj | + self currentIndex >= listOfPages size - [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 changed: ----- Method: ZoomAndScrollControllerMorph>>step (in category 'stepping and presenter') ----- step + | delta halfDW | - | delta halfDW action | (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 | - (currentKeyDown ifNil: [#()]) do: [ :each | action := upDownCodes at: each ifAbsent: [#fugeddaboutit]. action == #in ifTrue: [ target scaleImageBy: -10. ]. action == #out ifTrue: [ target scaleImageBy: 10. ]. action == #up ifTrue: [ target tiltImageBy: -20. ]. action == #down ifTrue: [ target tiltImageBy: 20. ]. ]. mouseMovePoint ifNil: [^self]. mouseDownPoint ifNil: [^self]. target ifNil: [^self]. halfDW := self deadZoneWidth // 2. delta := mouseMovePoint - mouseDownPoint. delta x abs <= halfDW ifTrue: [delta := 0@delta y]. delta y abs <= halfDW ifTrue: [delta := delta x@0]. target panImageBy: delta x. ! Item was changed: ----- Method: TextMorph>>updateReferencesUsing: (in category '*MorphicExtras-copying') ----- updateReferencesUsing: refDict + | anchors | - | anchors range new | 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. - [:old | 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 changed: ----- Method: InternalThreadNavigationMorph>>acceptSortedContentsFrom: (in category 'sorting') ----- acceptSortedContentsFrom: aHolder "Update my page list from the given page sorter." + - | nameOfThisProject cachedData proj | 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 doWithIndex: [:m :i | | cachedData proj nameOfThisProject | - aHolder submorphs doWithIndex: [:m :i | (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 changed: ----- Method: BookMorph>>abandon (in category 'submorphs-add/remove') ----- abandon "Like delete, but we really intend not to use this morph again. Make the page cache release the page object." + - | pg | self delete. + pages do: [:aPage | | pg | - pages do: [:aPage | (pg := aPage sqkPage) ifNotNil: [ pg contentsMorph == aPage ifTrue: [ pg contentsMorph: nil]]].! Item was changed: ----- Method: GeeMailMorph>>pageRectanglesForPrinting (in category 'as yet unclassified') ----- pageRectanglesForPrinting + | pageBreaks pageRects prevBottom | - | pageBreaks prevBottom pageRects r | pageBreaks := self valueOfProperty: #pageBreakRectangles ifAbsent: [^nil]. prevBottom := 0. + pageRects := pageBreaks collect: [ :each | | r | - pageRects := pageBreaks collect: [ :each | r := 0@prevBottom corner: self width @ each top. prevBottom := each bottom. r ]. pageRects add: (0@prevBottom corner: self width @ thePasteUp bottom). ^pageRects! Item was changed: ----- Method: TextOnCurve>>displayOn:using:at: (in category 'display') ----- displayOn: aCanvas using: displayScanner at: somePosition "Send all visible lines to the displayScanner for display" + | warp | - | maxExtent lineForm leftInRun lineRect warp sourceQuad backgroundColor lineCanvas | warp := nil. self textSegmentsDo: + [:line :destRect :segStart :segAngle | | lineRect lineCanvas backgroundColor lineForm leftInRun sourceQuad maxExtent | - [: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 hot 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@0 leftInRun: leftInRun. warp sourceQuad: sourceQuad destRect: (destRect translateBy: aCanvas origin). warp warpBits]]. ! Item was changed: ----- Method: ScaleMorph>>buildLabels (in category 'drawing') ----- buildLabels + | scale x1 y1 y2 captionMorph loopStart offset | - | scale x1 y1 y2 x captionMorph tickMorph 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 | - [:v | 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 changed: ----- 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 data baseIndex scaledFrac scaledOneMinusFrac prevSample nextSample v | 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 | - ^ (baseIndex + 1 to: baseIndex + nSamples) collect: [:i | nextSample := data at: i. v := ((nextSample * scaledFrac) + (prevSample * scaledOneMinusFrac)) // scale. prevSample := nextSample. v]. ! Item was changed: ----- Method: PostscriptCharacterScanner>>displayLine:offset:leftInRun: (in category 'displaying') ----- displayLine: line offset: baseOffset leftInRun: leftInRun + | offset aText string doJustified drawFont | - | drawFont offset aText string s doJustified | self setTextStylesForOffset: ((line first) + 1). " sets up various instance vars from text styles " drawFont := self font. offset := baseOffset. offset := offset + (line left @ (line top + line baseline - drawFont 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 | - aText runs withStartStopAndValueDo: [:start :stop :attributes | 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 changed: ----- Method: EnvelopeEditorMorph>>saveLibToDisk: (in category 'menu') ----- saveLibToDisk: evt "Save the library to disk" + | newName f | - | newName f snd | newName := UIManager default request: 'Please confirm name for library...' initialAnswer: 'MySounds'. newName isEmpty ifTrue: [^ self]. f := FileStream newFileNamed: newName , '.fml'. AbstractSound soundNames do: + [:name | | snd | + snd := AbstractSound soundNamed: name. - [:name | snd := AbstractSound soundNamed: name. "snd isStorable" true ifTrue: [f nextChunkPut: 'AbstractSound soundNamed: ' , name , ' put: ' , snd storeString; cr; cr] ifFalse: [self inform: name , ' is not currently storable']]. f close! Item was changed: ----- Method: PaintBoxMorph class>>new (in category 'instance creation') ----- new + | pb | - | pb button dualUse formCanvas rect | pb := 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 formCanvas rect button | - #(brush1: brush2: brush3: brush4: brush5: brush6:) do: [:sel | 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]. "force color maps for later mapping" button offImage. button onImage. button pressedImage. formCanvas := button onImage getCanvas. formCanvas := formCanvas copyOrigin: 0@0 clipRect: (rect := 0@0 extent: button onImage extent). (#(brush1: brush3:) includes: sel) ifTrue: [ rect := rect origin corner: rect corner - (2@2)]. (#brush2: == sel) ifTrue: [ rect := rect origin corner: rect corner - (2@4)]. formCanvas frameAndFillRectangle: rect fillColor: Color transparent borderWidth: 2 borderColor: (Color r: 0.599 g: 0.8 b: 1.0). ]. pb showColor. pb fixUpRecentColors. pb addLabels. ^ pb! Item was changed: ----- Method: ZASMCameraMarkMorph>>setTransition: (in category 'as yet unclassified') ----- setTransition: evt + | tSpec menu | - | tSpec menu subMenu directionChoices | 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 | - TransitionMorph allEffects do: [:effect | 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 changed: ----- Method: DropDownChoiceMorph>>maxExtent: (in category 'drawing') ----- maxExtent: listOfStrings + | h maxW | - | h w maxW f | maxW := 0. + listOfStrings do: [:str | | f w | - listOfStrings do: [:str | 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 changed: ----- 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 onServer onPgs sq 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 | - onPgs := onServer pages collect: [:out | sq := SqueakPageCache pageCache at: out url ifAbsent: [nil]. (sq notNil and: [sq contentsMorph isInMemory]) ifTrue: [((out sqkPage lastChangeTime > sq lastChangeTime) or: [sq contentsMorph isNil]) ifTrue: [SqueakPageCache atURL: out url put: out sqkPage. out] ifFalse: [sq contentsMorph]] ifFalse: [SqueakPageCache atURL: out url put: out sqkPage. out]]. which := (onPgs findFirst: [:pg | pg url = currentPage url]) max: 1. self newPages: onPgs currentIndex: which. "later stay at current page" self setProperty: #modTime toValue: (onServer valueOfProperty: #modTime). self setProperty: #allText toValue: (onServer valueOfProperty: #allText). self setProperty: #allTextUrls toValue: (onServer valueOfProperty: #allTextUrls). ! Item was changed: ----- Method: ZASMCameraMarkMorph>>menuPageVisualFor:event: (in category 'as yet unclassified') ----- menuPageVisualFor: target event: evt + | tSpec menu | - | tSpec menu subMenu directionChoices | 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 | - TransitionMorph allEffects do: [:effect | 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 changed: ----- Method: PaintBoxMorph>>addGraphicLabels (in category 'other') ----- addGraphicLabels "translate button labels" + | formTranslator | - | formTranslator ext pos newForm | 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 | 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 changed: ----- Method: PaintBoxMorph>>loadOnImage: (in category 'initialization') ----- loadOnImage: fileName "Read in and convert the image for the paintBox with the buttons on. A .bmp 24-bit image. For each button, cut that chunk out and save it." " self loadOnImage: 'NoSh:=on.bmp'. AllOnImage := nil. 'save space'. " + | pic16Bit blt aa type | - | pic16Bit blt aa on type | type := 'gif'. " gif or bmp " type = 'gif' ifTrue: [ pic16Bit "really 8" := GIFReadWriter formFromFileNamed: fileName. pic16Bit display. aa := AllOnImage := Form extent: OriginalBounds extent depth: 8. blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. ]. type = 'bmp' ifTrue: [ pic16Bit := (Form fromBMPFileNamed: fileName) asFormOfDepth: 16. pic16Bit display. aa := AllOnImage := Form extent: OriginalBounds extent depth: 16. blt := BitBlt current toForm: aa. blt sourceForm: pic16Bit; combinationRule: Form over; sourceRect: OriginalBounds; destOrigin: 0@0; copyBits. aa mapColor: Color transparent to: Color black. ]. "Collect all the images for the buttons in the on state" + self allMorphsDo: [:button | | on | - self allMorphsDo: [:button | (button isKindOf: ThreePhaseButtonMorph) ifTrue: [ type = 'gif' ifTrue: [on := ColorForm extent: button extent depth: 8. on colors: pic16Bit colors] ifFalse: [on := Form extent: button extent depth: 16]. on copy: (0@0 extent: button extent) from: (button topLeft - self topLeft) in: aa rule: Form over. button onImage: on]]. self invalidRect: bounds. ! Item was changed: ----- Method: TabbedPalette>>newTabs: (in category 'initialization') ----- newTabs: tabsList "Reconstitute the palette based on info in the tabs list" + | color1 color2 color3 | - | itsBook 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 | - [:aTab | tabsMorph addTab: aTab. aTab unHighlight. (itsBook := aTab morphToInstall) ifNotNil: [pages add: itsBook. currentPage ifNil: [currentPage := itsBook]]]. tabsMorph position: self position + self borderWidth! |
«
Return to Squeak - Dev
|
1 view|%1 views
| Free forum by Nabble | Edit this page |