Skip to content

Commit

Permalink
Morph, PasteUpMorph, World refactor
Browse files Browse the repository at this point in the history
  • Loading branch information
jvuletich committed Oct 24, 2020
1 parent a551528 commit ab7e033
Show file tree
Hide file tree
Showing 13 changed files with 3,461 additions and 233 deletions.
72 changes: 8 additions & 64 deletions CompatibilityPackages/Morphic-Deprecated.pck.st
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
'From Cuis 5.0 [latest update: #4413] on 15 October 2020 at 12:26:40 pm'!
'From Cuis 5.0 [latest update: #4425] on 24 October 2020 at 5:08:56 pm'!
'Description '!
!provides: 'Morphic-Deprecated' 1 1!
!provides: 'Morphic-Deprecated' 1 2!
SystemOrganization addCategory: 'Morphic-Deprecated'!


!classDefinition: #RectangleLikeMorph category: 'Morphic-Deprecated'!
Morph subclass: #RectangleLikeMorph
MovableMorph subclass: #RectangleLikeMorph
instanceVariableNames: 'extent color'
classVariableNames: ''
poolDictionaries: ''
Expand All @@ -24,16 +24,6 @@ RectangleLikeMorph subclass: #BorderedRectMorph
BorderedRectMorph class
instanceVariableNames: ''!

!classDefinition: #EllipseMorph category: 'Morphic-Deprecated'!
BorderedRectMorph subclass: #EllipseMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Deprecated'!
!classDefinition: 'EllipseMorph class' category: 'Morphic-Deprecated'!
EllipseMorph class
instanceVariableNames: ''!

!classDefinition: #StringMorph category: 'Morphic-Deprecated'!
RectangleLikeMorph subclass: #StringMorph
instanceVariableNames: 'font emphasis contents'
Expand Down Expand Up @@ -67,11 +57,6 @@ BorderedRectMorph subclasses can use a variety of border styles: simple, inset,
BorderedRectMorph new borderColor: Color red; borderWidth: 10; openInWorld.
BorderedRectMorph new borderColor: Color white; openInWorld!

!EllipseMorph commentStamp: '<historical>' prior: 0!
A round BorderedMorph. Supports borderWidth and borderColor.

EllipseMorph new borderWidth:10; borderColor: Color green; openInWorld.!

!StringMorph commentStamp: '<historical>' prior: 0!
StringMorph is a "lightweight" Morph to display a String. It supports only a single font, color, and emphasis combination. For multiple text styles, use TextModelMorph.

Expand Down Expand Up @@ -331,46 +316,12 @@ initialize
is: aSymbol
^ aSymbol == #BorderedRectMorph or: [ super is: aSymbol ]! !

!EllipseMorph methodsFor: 'drawing' stamp: 'jmv 4/9/2015 09:43'!
drawOn: aCanvas

| rx ry |
self revisar. "The morph should be specified better!!"
rx _ extent x //2.
ry _ extent y // 2.
aCanvas ellipseCenterX: rx y: ry rx: rx ry: ry borderWidth: borderWidth borderColor: borderColor fillColor: color! !

!EllipseMorph methodsFor: 'geometry testing' stamp: 'jmv 10/7/2009 23:21'!
isOrthoRectangularMorph
^false! !

!EllipseMorph methodsFor: 'geometry testing' stamp: 'pb 3/17/2020 13:36:07'!
morphContainsPoint: aLocalPoint

| radius other delta xOverY |
(self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [^ false]. "quick elimination"
extent > `1@1`
ifFalse: [^ true]. "Degenerate case -- code below fails by a bit"

radius _ extent y asFloat / 2.
other _ extent x asFloat / 2.
delta _ aLocalPoint - (other@radius).
xOverY _ extent x asFloat / extent y asFloat.
^ (delta x asFloat / xOverY) squared + delta y squared <= radius squared! !

!EllipseMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 22:37'!
defaultBorderWidth
"answer the default border width for the receiver"
^ 1! !

!EllipseMorph methodsFor: 'visual properties' stamp: 'jmv 3/10/2018 22:24:29'!
defaultColor
"Return the default fill style for the receiver"
^ `Color yellow`! !
!StringMorph methodsFor: 'printing' stamp: 'efc 2/22/2003 21:35'!
font: aFont
"Set the font my text will use. The emphasis remains unchanged."

!EllipseMorph class methodsFor: 'new-morph participation' stamp: 'pb 6/8/2017 23:50:14'!
categoryInNewMorphMenu
^ 'Basic'! !
font _ aFont.
^ self font: font emphasis: emphasis! !

!StringMorph methodsFor: 'accessing'!
contents
Expand Down Expand Up @@ -494,13 +445,6 @@ changeFont
newFont _ AbstractFont fromUser: self fontToUse.
newFont ifNotNil:[self font: newFont].! !

!StringMorph methodsFor: 'printing' stamp: 'efc 2/22/2003 21:35'!
font: aFont
"Set the font my text will use. The emphasis remains unchanged."

font _ aFont.
^ self font: font emphasis: emphasis! !

!StringMorph methodsFor: 'geometry' stamp: 'jmv 3/12/2018 15:56:36'!
fitContents
"Measures contents later at #minimumExtent"
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,112 @@
'From Cuis 5.0 [latest update: #4416] on 23 October 2020 at 4:14:51 pm'!
!classDefinition: #StringRequestMorph category: 'Morphic-Composite Widgets'!
LayoutMorph subclass: #StringRequestMorph
instanceVariableNames: 'response acceptBlock cancelBlock validationBlock '
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Composite Widgets'!

!LayoutMorph methodsFor: 'layout' stamp: 'jmv 10/23/2020 15:37:44'!
layoutBounds
"Return the bounds for laying out children of the receiver"

^ self morphLocalBounds insetBy: borderWidth! !


!StringRequestMorph methodsFor: 'initialization' stamp: 'jmv 10/23/2020 16:06:31'!
addTextPane
| result |
result _ (TextModelMorph
textProvider: self
textGetter: #response
textSetter: #response:
selectionGetter: #selectionInterval) emptyTextDisplayMessage: 'Enter response'.
self
valueOfProperty: #emptyTextDisplayMessage
ifPresentDo: [ :msg |
result emptyTextDisplayMessage: msg ].
result
hasUnacceptedEdits: true;
acceptOnCR: true;
escAction: [ self cancel ].
self addMorph: result layoutSpec: LayoutSpec useAll.! !

!StringRequestMorph methodsFor: 'initialization' stamp: 'jmv 10/23/2020 16:14:23'!
addTitle: aString
| titleMorph s pp w |
titleMorph _ WidgetMorph new noBorder.
titleMorph color: Theme current menuTitleBar.
pp _ `8@2`.
aString asString linesDo: [ :line |
s _ LabelMorph new
contents: line;
font: Preferences standardMenuFont bold.
titleMorph addMorphBack: s position: pp.
pp _ pp + (0@(s morphHeight+2)) ].
w _ titleMorph submorphs inject: 0 into: [ :prev :each |
prev max: each morphWidth ].
titleMorph morphExtent: (w + 24) @ (pp y).
self addMorphKeepMorphHeight: titleMorph.
^titleMorph morphWidth! !

!StringRequestMorph methodsFor: 'initialization' stamp: 'jmv 10/23/2020 15:45:59'!
defaultBorderWidth
"answer the default border width for the receiver"
^ 5! !

!StringRequestMorph methodsFor: 'initialization' stamp: 'jmv 10/23/2020 16:14:08'!
setQuery: queryString initialAnswer: initialAnswer
| lineCount newExtent w |
response _ initialAnswer.
w _ self addTitle: queryString.
self addTextPane.
"If the initial response is big or has multiple lines we make the text pane bigger and with scrollbars:"
lineCount _ response lineCount.
newExtent _ lineCount > 1
ifTrue: [ 40 @ (lineCount*2) * FontFamily defaultLineSpacing ]
ifFalse: [ (response size max: 12) @ 3.2 * FontFamily defaultLineSpacing ].
self morphExtent: (newExtent max: w@0)! !


!StringRequestMorph class methodsFor: 'instance creation' stamp: 'jmv 10/23/2020 15:32:25'!
request: queryString centeredAt: aPoint initialAnswer: defaultAnswer validationBlock: validationBlock acceptBlock: acceptBlock cancelBlock: cancelBlock
| answer |
answer _ self newColumn
setQuery: queryString
initialAnswer: defaultAnswer;
validationBlock: validationBlock;
acceptBlock: acceptBlock;
cancelBlock: cancelBlock.
self runningWorld addMorph: answer centeredNear: aPoint - self deltaToTextPane.
^ answer! !

!StringRequestMorph class methodsFor: 'instance creation' stamp: 'jmv 10/23/2020 15:32:30'!
request: queryString initialAnswer: defaultAnswer orCancel: cancelBlock

| morph world |

morph _ self newColumn
setQuery: queryString
initialAnswer: defaultAnswer.
(world _ self runningWorld) addMorph: morph centeredNear: world activeHand morphPosition - self deltaToTextPane.

^ morph getUserResponseOrCancel: cancelBlock! !

!StringRequestMorph class methodsFor: 'private' stamp: 'jmv 10/23/2020 15:54:06'!
deltaToTextPane
"Answer a distance to translate an instance of the receiver by when it is opened in the world in order to have the hand be over the text pane (so the text pane has focus).
Distance is relative to font size"
| e |
e _ Preferences windowTitleFont lineSpacing.
^ (0)@(0.5 * e)! !

!methodRemoval: StringRequestMorph #intoWorld: stamp: 'jmv 10/23/2020 16:05:21'!
StringRequestMorph removeSelector: #intoWorld:!
!methodRemoval: StringRequestMorph #adjustSubmorphsLayout stamp: 'jmv 10/23/2020 16:05:21'!
StringRequestMorph removeSelector: #adjustSubmorphsLayout!
!classDefinition: #StringRequestMorph category: 'Morphic-Composite Widgets'!
LayoutMorph subclass: #StringRequestMorph
instanceVariableNames: 'response acceptBlock cancelBlock validationBlock'
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Composite Widgets'!
Original file line number Diff line number Diff line change
@@ -0,0 +1,95 @@
'From Cuis 5.0 [latest update: #4414] on 21 October 2020 at 3:03:43 pm'!

!Morph commentStamp: 'jmv 10/21/2020 14:49:13' prior: 0!
A Morph (from the Greek "shape" or "form") is an interactive graphical object. General information on the Morphic system can be found at http://wiki.squeak.org/squeak/morph.

Morphs exist in a tree, rooted at a World (a WorldMorph). The morphs owned by a morph are its submorphs. Morphs are drawn recursively; if a Morph has no owner it never gets
drawn. To hide a Morph and its submorphs, send the #visible: message.

Every morph has a local coordinate system to interpret positions.
Local coordinates are used in the #drawOn: method (the Canvas understands positions in the local coordinate system), for the positions of submorphs (for example #morphPosition and #morphPosition:) and for positions carried by mouse events.

Events are delivered to morphs in Z-order, i.e. if a morph occludes another the event is only delivered to the foremost (just like physical objects). Events received by a morph carry positions in the local coordinate system.

Morphs can be translated by an offset, rotated around their center, orbited (rotated around the owner center), and zoomed (i.e. scaled).

Every morph has an associated transformation that defines the inner space where the morph is drawn and where the submorphs live. These transformations don't change anything from the internal point of view of the morph.
Structure:
instance var Type Description
owner Morph My parent Morph, or nil for the top-level Morph, which is a
or nil world, typically a PasteUpMorph.
submorphs Array My child Morphs.
location GeometryTransformation Specifies position (and possibly, angle of rotation and scale change) inside owner
See comment at GeometryTransformation!
!Morph methodsFor: 'geometry' stamp: 'jmv 10/21/2020 15:01:06'!
orbitBy: radians
"Change the scale of this morph. Arguments are an angle and a scale."
location _ (AffineTransformation withRadians: radians) composedWith: location.
owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ].
self redrawNeeded.! !
!Morph methodsFor: 'geometry' stamp: 'jmv 10/21/2020 14:56:59'!
rotation: radians
"Change the rotation of this morph. Argument is an angle to be taken as the new rotation."
self rotation: radians scale: location scale.! !
!Morph methodsFor: 'geometry' stamp: 'jmv 10/21/2020 14:56:28'!
rotation: radians scale: scale
"Change the rotation and scale of this morph. Arguments are an angle and a scale."
location _ location withRotation: radians scale: scale.
owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ].
self redrawNeeded.! !
!Morph reorganize!
('accessing' adoptWidgetsColor: beSticky color location lock morphId resistsRemoval taskbar toggleStickiness unlock unlockContents)
('accessing - flags' isLayoutNeeded isRedrawNeeded isSubmorphRedrawNeeded layoutNeeded: needsRedraw: submorphNeedsRedraw: visible)
('accessing - properties' hasProperty: isLocked isSticky lock: name name: removeProperty: setProperty:toValue: sticky: valueOfProperty: valueOfProperty:ifAbsent: valueOfProperty:ifPresentDo:)
('as yet unclassified' canDiscardEdits disregardUnacceptedEdits whenUIinSafeState:)
('caching' clearId fullReleaseCachedState releaseCachedState)
('change reporting' addedMorph: invalidateDisplayRect:fromSubmorph:for: invalidateLocalRect:)
('classification' isWorldMorph)
('copying' copy copyForClipboard duplicate)
('debug and other' addDebuggingItemsTo:hand: buildDebugMenu: inspectOwnerChain ownerChain resumeAfterDrawError resumeAfterStepError)
('drawing' addPossiblyUncoveredAreasIn:to: drawOn: drawingFails drawingFailsNot hide icon imageForm: imageForm:depth: isKnownFailing refreshWorld show visible:)
('dropping/grabbing' aboutToBeGrabbedBy: aboutToGrab: acceptDroppingMorph:event: dropFiles: justDroppedInto:event: justGrabbedFrom: rejectDropMorphEvent: wantsDroppedMorph:event: wantsToBeDroppedInto:)
('e-toy support' embeddedInMorphicWindowLabeled: unlockOneSubpart wantsRecolorHandle)
('events' click:localPosition: doubleClick:localPosition: dragEvent:localPosition: keyDown: keyStroke: keyUp: mouseButton1Down:localPosition: mouseButton1Up:localPosition: mouseButton2Down:localPosition: mouseButton2Up:localPosition: mouseButton3Down:localPosition: mouseButton3Up:localPosition: mouseEnter: mouseHover:localPosition: mouseLeave: mouseMove:localPosition: mouseScroll:localPosition: mouseStillDown windowEvent:)
('event handling testing' allowsFilesDrop allowsMorphDrop allowsSubmorphDrag handlesKeyboard handlesMouseDown: handlesMouseHover handlesMouseOver: handlesMouseScroll: handlesMouseStillDown:)
('event handling' mouseButton2Activity mouseStillDownStepRate mouseStillDownThreshold)
('events-alarms' addAlarm:after: addAlarm:with:after: addAlarm:withArguments:after: alarmScheduler removeAlarm:)
('events-processing' dispatchEvent:localPosition: focusKeyboardFor: handleFocusEvent: processDropFiles:localPosition: processDropMorph:localPosition: processKeyDown:localPosition: processKeyUp:localPosition: processKeystroke:localPosition: processMouseDown:localPosition: processMouseEnter:localPosition: processMouseLeave:localPosition: processMouseMove:localPosition: processMouseOver:localPosition: processMouseScroll:localPosition: processMouseStillDown processMouseUp:localPosition: processUnknownEvent:localPosition: processWindowEvent:localPosition: rejectsEvent: rejectsEventFully:)
('fileIn/out' prepareToBeSaved storeDataOn:)
('focus handling' hasKeyboardFocus hasMouseFocus keyboardFocusChange:)
('geometry' allocHeightForFactor: allocWidthForFactor: displayBounds displayBounds: displayBoundsForHalo displayBoundsOrBogus displayFullBounds extentBorder externalize: externalizeDisplayBounds: externalizeDistance: externalizeDistanceToWorld: externalizeToWorld: fontPreferenceChanged internalize: internalizeDistance: internalizeDistanceFromWorld: internalizeFromWorld: minimumExtent minimumLayoutExtent morphAlign:with: morphExtent morphExtent: morphExtentInWorld morphExtentInWorld: morphHeight morphLocalBounds morphPosition morphPosition: morphPositionInWorld morphPositionInWorld: morphTopLeft morphWidth orbitBy: rotateBy: rotation: rotation:scale: rotationDegrees: scaleBy:)
('geometry eToy' referencePosition referencePosition:)
('geometry testing' clipsLastSubmorph fullContainsGlobalPoint: fullContainsPoint: isOrthoRectangularMorph morphContainsPoint: requiresVectorCanvas submorphsMightProtrude)
('halos and balloon help' addHalo addHalo: addHandlesTo:box: addOptionalHandlesTo:box: balloonHelpDelayTime balloonText comeToFrontAndAddHalo deleteBalloon editBalloonHelpContent: editBalloonHelpText halo mouseDownOnHelpHandle: noHelpString okayToBrownDragEasily okayToResizeEasily okayToRotateEasily removeHalo setBalloonText: showBalloon: showBalloon:hand: transferHalo:from: wantsBalloon wantsHalo wantsHaloHandleWithSelector:inHalo:)
('initialization' inATwoWayScrollPane initialize intoWorld: openInHand openInWorld openInWorld:)
('iteration of all morphs' nextMorph nextMorphPart2 nextMorphThat: previousMorph previousMorphThat:)
('layout' layoutSubmorphs layoutSubmorphsIfNeeded minItemWidth minimumLayoutHeight minimumLayoutWidth minimumShrinkExtent minimumShrinkHeight minimumShrinkWidth someSubmorphPositionOrExtentChanged)
('layout-properties' layoutSpec layoutSpec: layoutSpecOrNil)
('macpal' flash flashWith:)
('menus' addAddHandMenuItemsForHalo:hand: addColorMenuItems:hand: addCopyItemsTo: addCustomHaloMenuItems:hand: addCustomMenuItems:hand: addExportMenuItems:hand: addHaloActionsTo: addStandardHaloMenuItemsTo:hand: addTitleForHaloMenu: addToggleItemsToHaloMenu: changeColor expand exportAsBMP exportAsJPEG lockUnlockMorph lockedString maybeAddCollapseItemTo: stickinessString)
('meta-actions' addEmbeddingMenuItemsTo:hand: buildHandleMenu: copyToClipboard: dismissMorph duplicateMorph: maybeDuplicateMorph potentialEmbeddingTargets)
('naming' label)
('object serialization' objectForDataStream:)
('player' okayToDuplicate)
('printing' printOn:)
('rotate scale and flex' rotationDegrees)
('stepping' shouldGetStepsFrom: startStepping startStepping: startStepping:in:stepTime: startStepping:stepTime: startSteppingStepTime: step stepAt: stopStepping stopStepping: wantsSteps)
('structure' allOwnersDo: allOwnersReverseDo: firstOwnerSuchThat: hasOwner: isInWorld owner owningWindow root veryLastLeaf withAllOwnersDo: withAllOwnersReverseDo: world)
('submorphs-accessing' allMorphsDo: clippedSubmorph findDeepSubmorphThat:ifAbsent: findSubmorphBinary: firstSubmorph hasSubmorphs lastSubmorph noteNewOwner: submorphBehind: submorphCount submorphInFrontOf: submorphs submorphsBehind:do: submorphsDo: submorphsDrawingOutsideReverseDo: submorphsInFrontOf:do: submorphsReverseDo: submorphsSatisfying: unclippedSubmorphsReverseDo:)
('submorphs-add/remove' addAllMorphs: addAllMorphs:after: addMorph: addMorph:behind: addMorph:inFrontOf: addMorph:position: addMorphBack: addMorphBack:position: addMorphFront: addMorphFront:position: addMorphFrontFromWorldPosition: atFront canAdd: comeToFront delete dismissViaHalo goBehind privateDelete removeAllMorphs removeAllMorphsIn: removeMorph: removedMorph: replaceSubmorph:by:)
('testing' hasModel is: isCollapsed isOwnedByHand isOwnedByWorld isProportionalHeight isProportionalWidth isReallyVisible stepTime)
('updating' invalidateBounds redrawNeeded)
('user interface' activateWindow activateWindowAndSendTopToBack: collapse showAndComeToFront toggleCollapseOrShow)
('private' privateAddAllMorphs:atIndex: privateAddMorph:atIndex: privateAddMorph:atIndex:position: privateAnyOwnerHandlesMouseScroll: privateFlagAt: privateFlagAt:put: privateMoveBackMorph: privateMoveFrontMorph: privateOwner: privatePosition: privateRemove: privateSubmorphs)
('previewing' beginPreview endPreview endPreviewAndToggleCollapseOrShow morphBehindBeforePreview morphBehindBeforePreview: previewing previewing: visibleBeforePreview visibleBeforePreview:)
!
Loading

0 comments on commit ab7e033

Please sign in to comment.