'From Squeak3.2alpha of 2 October 2001 [latest update: #4417] on 17 October 2001 at 12:00:09 pm'! "Change Set: LassoFromScreen Date: 17 October 2001 Author: Dan Ingalls Adds three new ways to grab a patch from the screen: By lasso -- lets you draw a freehand outline By rubber bands -- lets you draw an enclosing polygon By flood -- lets you seed a flood area The first two do no further work to trim the result, though this would be possible. "! !Form methodsFor: 'filling' stamp: 'di 10/17/2001 10:09'! eraseShape: bwForm "use bwForm as a mask to clear all pixels where bwForm has 1's" ((BitBlt current destForm: self sourceForm: bwForm fillColor: nil combinationRule: Form erase1bitShape "Cut a hole in the picture with my mask" destOrigin: bwForm offset sourceOrigin: 0@0 extent: self extent clipRect: self boundingBox) colorMap: (Bitmap with: 0 with: 16rFFFFFFFF)) copyBits. ! ! !Form methodsFor: 'filling' stamp: 'di 10/17/2001 10:10'! shapeFill: aColor interiorPoint: interiorPoint "Identify the shape (region of identical color) at interiorPoint, and then fill that shape with the new color, aColor : modified di's original method such that it returns the bwForm, for potential use by the caller" | bwForm interiorPixVal map ppd color ind | self depth = 1 ifTrue: [^ self shapeFill: aColor seedBlock: [:form | form pixelValueAt: interiorPoint put: 1]]. "First map this form into a B/W form with 0's in the interior region." "bwForm _ self makeBWForm: interiorColor." "won't work for two whites" interiorPixVal _ self pixelValueAt: interiorPoint. bwForm _ Form extent: self extent. map _ Bitmap new: (1 bitShift: (self depth min: 12)). "Not calling newColorMap. All non-foreground go to 0. Length is 2 to 4096." ppd _ self depth. "256 long color map in depth 8 is not one of the following cases" 3 to: 5 do: [:bitsPerColor | (2 raisedTo: bitsPerColor*3) = map size ifTrue: [ppd _ bitsPerColor*3]]. "ready for longer maps than 512" ppd <= 8 ifTrue: [map at: interiorPixVal+1 put: 1] ifFalse: [interiorPixVal = 0 ifFalse: [color _ Color colorFromPixelValue: interiorPixVal depth: self depth. ind _ color pixelValueForDepth: ppd. map at: ind+1 put: 1] ifTrue: [map at: 1 put: 1]]. bwForm copyBits: self boundingBox from: self at: 0@0 colorMap: map. bwForm reverse. "Make interior region be 0's" "Now fill the interior region and return that shape" bwForm _ bwForm findShapeAroundSeedBlock: [:form | form pixelValueAt: interiorPoint put: 1]. "Finally use that shape as a mask to flood the region with color" self eraseShape: bwForm. self fillShape: bwForm fillColor: aColor. ^ bwForm! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'di 10/17/2001 11:58'! grabFloodFromScreen: evt "Allow the user to plant a flood seed on the Display, and create a new drawing morph from the resulting region. Attach the result to the hand." | screenForm exterior p1 box | Cursor crossHair showWhile: [p1 _ Sensor waitButton]. box _ Display floodFill: Color transparent at: p1. exterior _ ((Display copy: box) makeBWForm: Color transparent) reverse. (exterior deepCopy reverse anyShapeFill reverse) "save interior bits" displayOn: exterior at: 0@0 rule: Form and. self world invalidRect: box; displayWorldSafely. screenForm _ Form fromDisplay: box. screenForm eraseShape: exterior. screenForm isAllWhite ifFalse: [evt hand attachMorph: (SketchMorph withForm: screenForm)]! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'di 10/17/2001 11:20'! grabLassoFromScreen: evt "Allow the user to specify a polygonal area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand." | poly screenForm outline topLeft innerForm exterior | poly _ PolygonMorph fromHandFreehand: evt hand. outline _ poly shadowForm. topLeft _ outline offset. exterior _ (outline offset: 0@0) anyShapeFill reverse. screenForm _ Form fromDisplay: (topLeft extent: outline extent). screenForm eraseShape: exterior. innerForm _ screenForm trimBordersOfColor: Color transparent. innerForm isAllWhite ifFalse: [evt hand attachMorph: (SketchMorph withForm: innerForm)]! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'di 10/17/2001 11:20'! grabRubberBandFromScreen: evt "Allow the user to specify a polygonal area of the Display, capture the pixels from that area, and use them to create a new drawing morph. Attach the result to the hand." | poly screenForm outline topLeft innerForm exterior | poly _ PolygonMorph fromHand: evt hand. outline _ poly shadowForm. topLeft _ outline offset. exterior _ (outline offset: 0@0) anyShapeFill reverse. screenForm _ Form fromDisplay: (topLeft extent: outline extent). screenForm eraseShape: exterior. innerForm _ screenForm trimBordersOfColor: Color transparent. innerForm isAllWhite ifFalse: [evt hand attachMorph: (SketchMorph withForm: innerForm)]! ! !PolygonMorph class methodsFor: 'instance creation' stamp: 'di 10/17/2001 11:02'! fromHand: hand "Let the user draw a polygon, clicking at each vertex, and ending by clicking within 5 of the first point..." | p1 poly oldVerts pN opposite | Cursor crossHair showWhile: [p1 _ Sensor waitButton]. opposite _ (Display colorAt: p1) negated. opposite = Color transparent ifTrue: [opposite _ Color red]. (poly _ LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld. oldVerts _ {p1}. self currentWorld displayWorldSafely; runStepMethods. [true] whileTrue: [[Sensor anyButtonPressed] whileTrue: [pN _ Sensor cursorPoint. poly setVertices: (oldVerts copyWith: pN). self currentWorld displayWorldSafely; runStepMethods]. (oldVerts size > 1 and: [(pN dist: p1) < 5]) ifTrue: ["Done" Sensor flushEvents. ^ (poly setVertices: (poly vertices copyWith: p1)) delete]. oldVerts _ poly vertices. [Sensor anyButtonPressed] whileFalse: [pN _ Sensor cursorPoint. poly setVertices: (oldVerts copyWith: pN). self currentWorld displayWorldSafely; runStepMethods]]. ! ! !PolygonMorph class methodsFor: 'instance creation' stamp: 'di 10/17/2001 11:08'! fromHandFreehand: hand "Let the user draw a polygon, holding the mouse down, and ending by clicking within 5 of the first point..." | p1 poly pN opposite | Cursor crossHair showWhile: [p1 _ Sensor waitButton]. opposite _ (Display colorAt: p1) negated. opposite = Color transparent ifTrue: [opposite _ Color red]. (poly _ LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld. self currentWorld displayWorldSafely; runStepMethods. [Sensor anyButtonPressed] whileTrue: [pN _ Sensor cursorPoint. (pN dist: poly vertices last) > 3 ifTrue: [poly setVertices: (poly vertices copyWith: pN). self currentWorld displayWorldSafely; runStepMethods]]. Sensor flushEvents. ^ (poly setVertices: (poly vertices copyWith: p1)) delete! ! !TheWorldMenu methodsFor: 'construction' stamp: 'di 10/17/2001 01:13'! newMorph "The user requested 'new morph' from the world menu. Put up a menu that allows many ways of obtaining new morphs. If the preference #classicNewMorphMenu is true, the full form of yore is used; otherwise, a much shortened form is used." | menu subMenu catDict shortCat class | menu _ self menu: 'Add a new morph'. menu add: 'from paste buffer' target: myHand action: #pasteMorph; add: 'from a file...' target: self action: #readMorphFromAFile. Preferences classicNewMorphMenu ifTrue: [menu add: 'from alphabetical list' subMenu: self alphabeticalMorphMenu]. menu addLine. menu add: 'grab rectangle from screen' target: myWorld action: #grabDrawingFromScreen:; add: 'grab with lasso from screen' target: myWorld action: #grabLassoFromScreen:; add: 'grab rubber band from screen' target: myWorld action: #grabRubberBandFromScreen:; add: 'grab flood area from screen' target: myWorld action: #grabFloodFromScreen:. menu addLine. menu add: 'make new drawing' target: myWorld action: #newDrawingFromMenu:; add: 'make link to project...' target: self action: #projectThumbnail. Preferences classicNewMorphMenu ifTrue: [menu addLine. catDict _ Dictionary new. SystemOrganization categories do: [:cat | ((cat beginsWith: 'Morphic-') and: [(#('Morphic-Menus' 'Morphic-Support') includes: cat) not]) ifTrue: [shortCat _ cat copyFrom: 'Morphic-' size+1 to: cat size. (SystemOrganization listAtCategoryNamed: cat) do: [:cName | class _ Smalltalk at: cName. ((class inheritsFrom: Morph) and: [class includeInNewMorphMenu]) ifTrue: [(catDict includesKey: shortCat) ifTrue: [(catDict at: shortCat) addLast: class] ifFalse: [catDict at: shortCat put: (OrderedCollection with: class)]]]]]. catDict keys asSortedCollection do: [:categ | subMenu _ MenuMorph new. ((catDict at: categ) asSortedCollection: [:c1 :c2 | c1 name < c2 name]) do: [:cl | subMenu add: cl name target: self selector: #newMorphOfClass:event: argument: cl]. menu add: categ subMenu: subMenu]]. self doPopUp: menu. ! !