CustomHelp subclass: #EdrxGuideHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !EdrxGuideHelp commentStamp: 'Edrx 3/2/2023 22:39' prior: 0! The EdrxGuideHelp is a modfied copy of the TerseGuideHelp. Try this: See edrxGuide.! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! EdrxGuideHelp class instanceVariableNames: ''! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/11/2023 02:25'! addAlarm "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #addAlarm" <generated> ^(HelpTopic title: 'How to use addAlarm' contents: '"This page: See edrxGuide: #addAlarm. This block creates a SimpleSwitchMorph with the label ''Toggle'' and a SimpleButtonMorph with the label ''Flash''. The button will be placed below the switch." sm := SimpleSwitchMorph new. sm openInWorld. bm := SimpleButtonMorph new. bm openInWorld. bm position: bm position + (0@32). "Here are three ways of toggling the color of the switch:" sm toggleState. bl := [ sm toggleState ]. bl value. bm target: bl. bm actionSelector: #value. bm doButtonAction. "Here are two ways of toggling the switch after 1000ms:" sm addAlarm: #toggleState after: 1000. bm addAlarm: #doButtonAction after: 1000. "Here is a low-level way of waiting 5 seconds and then saving the keyboard focus in the variable kf:" kf := 0. bl := [ sm toggleState ]. bl := [ kf := self currentHand keyboardFocus ]. bm target: bl. bm actionSelector: #value. bm addAlarm: #doButtonAction after: 5000. kf. "Here is a high-level way: See cm: (See class >> #run:after:) "!!' readStream nextChunkText) key: #addAlarm; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/16/2023 19:37'! drawOnAForm "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #drawOnAForm" <generated> ^(HelpTopic title: 'Draw on a Form' contents: '"This page: See edrxGuide: #drawOnAForm. Based on code that Karl Ramberg posted in 2023mar16. " brush := (Form extent: 1@1 depth: 32) fillBlack. form := (Form extent:500@500 depth:32) fillWhite. y := form extent y -60. x := form extent x -60. segments := 8 atRandom +3. points := OrderedCollection new. 1 to: segments do: [ :r | points add: (x atRandom @ (y atRandom)) + 30 ]. points add: (points first copy). 0 to: 1 by: 0.01 do: [ :j | 1 to: segments do: [ :i | form drawLine: brush from: (points at:i) to: (points at:i+1) clippingBox: form boundingBox rule: Form paint fillColor: nil ]. d := OrderedCollection new. 1 to: segments do: [ :a | d add: (points at: a) + (j * ((points at: a+1)-(points at: a))) ]. d add: (d first copy). p := OrderedCollection new. 1 to: segments do: [ :aa | p add: (d at: aa) +(j * ((d at: aa+1)-(d at: aa))) ]. p add: (p first copy). 1 to: segments do: [ :b | form drawLine: brush from: (p at:b) to: (p at:b+1) clippingBox: form boundingBox rule: Form paint fillColor: nil ]. form displayAt:10@60. (Delay forMilliseconds: 10) wait. ]. !!' readStream nextChunkText) key: #drawOnAForm; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/11/2023 02:28'! helpBrowserB "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #helpBrowserB" <generated> ^(HelpTopic title: 'What is HelpBrowserB' contents: '"This page: See edrxGuide: #helpBrowserB. See class: HelpBrowser. See class: HelpBrowserB. The standard HelpBrowser doesn''t support local bindings. The EdrxGuideHelp uses a modified HelpBrowser, called HelpBrowserB, that supports local bindings. TODO: better support for line wrapping. " See class: HelpBrowserB. !!' readStream nextChunkText) key: #helpBrowserB; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/11/2023 02:30'! saveKeystrokeEvents "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #saveKeystrokeEvents" <generated> ^(HelpTopic title: 'Hacking keystroke events' contents: '"This page: See edrxGuide: #saveKeystrokeEvents. See: See cm: (See class >> #keyboardFocus). See cm: (See class >> #keyboardFocus:). See cm: (See class >> #sendEvent:to:). See cm: (See class >> #sendEventDebug:to:). " save := [ :evt | ]. bl := [ :evt | Transcript show: evt; cr. save value: evt.]. eh := EventHandler new. eh on: #keyStroke send: #value: to: bl. rm := RectangleMorph new. rm openInWorld. rm color: Color red. rm eventHandler: eh. save := [ :evt | cr := evt ]. See keyboardFocus: rm. save := [ :evt | up := evt ]. See keyboardFocus: rm. save := [ :evt | dn := evt ]. See keyboardFocus: rm. { cr . up . dn }. See at: #cr put: cr. See at: #up put: up. See at: #dn put: dn. cr := See at: #cr. up := See at: #up. dn := See at: #dn. See run: [ kf := See keyboardFocus ] after: 5000. kf. See sendEvent: cr to: kf. See sendEventDebug: cr to: kf. !!' readStream nextChunkText) key: #saveKeystrokeEvents; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/10/2023 23:51'! searchBar "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #searchBar" <generated> ^(HelpTopic title: 'Hacking the search bar' contents: '"This page: See edrxGuide: #searchBar. Warning: many things here don''t work!!!! " See cm: (See class >>#searchBar:). searchBar := See at: #searchBar. searchBar explore. See class: SearchBar. See class: TextMorphForEditView. See cm: (SearchBar >> #buildWith:). See cm: (SearchBar >> #searchTerm:). See cm: (TextMorph >> #acceptContents). See cm: (TextMorphForEditView >> #keyStroke:). See cm: (TextMorphForEditView>>#acceptContents). See cm: (PluggableTextMorphPlus >> #accept). sb := See at: #searchBar. sb textMorph flash. sb textMorph editView. sb textMorph acceptContents. sb model searchTerm. sb model searchTerm: ''searchTerm''. sb model accept. sb editor accept. sb editor acceptContents. !!' readStream nextChunkText) key: #searchBar; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/4/2023 21:35'! useMenuItems "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #useMenuItems" <generated> ^(HelpTopic title: 'Hacking menu items' contents: '"This page: See edrxGuide: #useMenuItems. Debug a menu item with the halo, then do: See at: #mitem put: self. Some examples use this menu item: World -> new morph -> from alphabetical list -> L-N -> LineMorph Save it with: See at: #itemLineMorph put: self You will probably need to fix a bug in: See cm: (TheWorldMenu >> #newMorphOfClass:event:). Replace the ''evt hand'' there by: (evt ifNotNil: [evt hand] ifNil: [nil currentHand]) " See class: MenuItemMorph. See cm: (MenuItemMorph >> #invokeWithEvent:). mitem := See at: #mitem. { mitem target . mitem selector . mitem arguments . mitem selector numArgs . mitem arguments size }. "Use this to set cr: See edrxGuide: #saveKeystrokeEvents. " See store. cr := See at: #cr. self halt. mitem invokeWithEvent: cr. twm := See at: #twm. self halt. twm doMenuItem: {twm . #newMorph} with: cr. self halt. twm newMorphOfClass: LineMorph event: cr. itemLineMorph := See at: #itemLineMorph. itemLineMorph debugAction. !!' readStream nextChunkText) key: #useMenuItems; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/1/2023 02:40'! whatIsThis "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #whatIsThis" <generated> ^(HelpTopic title: 'What is this' contents: '"This is the ''Edrx Guide to Squeak''. It is based on the ''Terse Guide to Squeak''. You can access the Terse Guide to Squeak with: Help -> Terse Guide to Squeak, or with:" HelpBrowser openOn: TerseGuideHelp. "The Terse Guide to Squeak - I will call it ''TerseGuideHelp'' from here onwards - is implemented as a subclass of the class CustomHelp, and each help topic is implemented as a class method in the class TerseGuideHelp. Try:" See class: TerseGuideHelp class. See class: EdrxGuideHelp class. See cm: (TerseGuideHelp class >> #introduction). See cm: (EdrxGuideHelp class >> #whatIsThis). See terseGuide. See terseGuide: #introduction. See edrxGuide. See edrxGuide: #whatIsThis. "The left pane of a help browser shows a list of help topics. If you right click on a help topic you will see a menu with three items: ''browse'', ''inspect'', and ''explore''. If you choose ''browse'' this will show the source code - as a method - of that help topic. Its comment will be something like this, This method was automatically generated. Edit it using: EdrxGuideHelp edit: #whatIsThis. that explains the best method for both viewing and editing a help topic. The standard HelpBrowser doesn''t support local bindings. The EdrxGuideHelp uses a modified HelpBrowser, called HelpBrowserB, that supports local bindings. See:" See cm: (See class >> #edrxGuide). !!' readStream nextChunkText) key: #whatIsThis; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'pages' stamp: 'Edrx 3/11/2023 02:09'! windowSpecs "This method was automatically generated. Edit it using:" "EdrxGuideHelp edit: #windowSpecs" <generated> ^(HelpTopic title: 'Using window specs' contents: '"This page: See edrxGuide: #windowSpecs. To do: write this!!!! " See cm: (TestWindowSpec >> #buildWith:). See cm: (Browser >> #buildDefaultBrowserWith:). See cm: (Model >> #buildWindowWith:specs:). See at: #buildBrowser put: true. See see. !!' readStream nextChunkText) key: #windowSpecs; shouldStyle: true; yourself! ! !EdrxGuideHelp class methodsFor: 'accessing' stamp: 'Edrx 2/25/2023 22:32'! bookName ^'Edrx Guide'! ! !EdrxGuideHelp class methodsFor: 'accessing' stamp: 'Edrx 3/2/2023 21:27'! edit: aSelector "Adapted from: See cm: (CustomHelp class >> #edit:) See also: self halt. TerseGuideHelp edit: #useMenuItems " (HelpBrowserB openOn: self asHelpTopic) model showTopicNamed: aSelector. ! ! !EdrxGuideHelp class methodsFor: 'accessing' stamp: 'Edrx 3/16/2023 19:35'! pages "Test: See edrxGuide. " ^ #( whatIsThis helpBrowserB addAlarm saveKeystrokeEvents useMenuItems searchBar drawOnAForm )! ! !EdrxGuideHelp class methodsFor: 'testing' stamp: 'tpr 6/19/2018 19:04'! usesCodeStyling "I want the help browser to use code based styling on my content" ^true! ! HelpBrowser subclass: #HelpBrowserB instanceVariableNames: 'bindings' classVariableNames: 'LookupPools' poolDictionaries: '' category: 'Category-Edrx'! !HelpBrowserB commentStamp: 'Edrx 2/28/2023 15:08' prior: 0! A variant of HelpBrowser that has "bindings" like a workspace. Based on ideas by Karl Ramberg.! !HelpBrowserB methodsFor: 'bindings' stamp: 'Edrx 2/28/2023 15:09'! bindingOf: aString bindings ifNil: [ self resetBindings]. (bindings includesKey: aString) ifFalse: [ (self lookupInPools: aString) ifNotNil: [:val | "Caveat: since we're not inserting the pool's Association into the dictionary, assigning a new value to the variable will only affect the one Workspace (i.e. you can't assign to a variable in a SharedPool)." bindings at: aString put: val] ifNil: [aString first isUppercase ifTrue: [^nil] ifFalse: [bindings at: aString put: nil]] ]. ^ bindings associationAt: aString. ! ! !HelpBrowserB methodsFor: 'bindings' stamp: 'Edrx 2/28/2023 15:09'! hasBindingOf: aString ^bindings includesKey: aString ! ! !HelpBrowserB methodsFor: 'bindings' stamp: 'Edrx 2/28/2023 15:17'! initialize "Initializes the receiver class" LookupPools ifNil: [LookupPools := IdentitySet new]. TheWorldMenu registerOpenCommand: {'Help Browser B'. {self. #open}}.! ! !HelpBrowserB methodsFor: 'bindings' stamp: 'Edrx 2/28/2023 15:11'! lookupInPools: aString "Iterate through all of the lookup pools to find a match for the specified name." LookupPools ifNil: [^nil]. LookupPools do: [:pool | (pool bindingOf: aString) ifNotNil: [:assoc | ^assoc value]]. ^nil ! ! !HelpBrowserB methodsFor: 'bindings' stamp: 'Edrx 2/28/2023 15:12'! resetBindings bindings := Dictionary new.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HelpBrowserB class instanceVariableNames: ''! !HelpBrowserB class methodsFor: 'use HelpBrowserB' stamp: 'Edrx 3/1/2023 00:00'! defaultHelpBrowser ^ HelpBrowserB. ! ! Object subclass: #See instanceVariableNames: '' classVariableNames: 'Store' poolDictionaries: '' category: 'Category-Edrx'! !See commentStamp: 'Edrx 3/8/2023 19:56' prior: 0! Elisp hyperlinks reimplemented as Squeak Hyperlinks. Try this: See see.! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! See class instanceVariableNames: ''! !See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'! fileList "Same as: Tools -> File List. Test: See fileList. " ^ StandardToolSet openFileList.! ! !See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'! helpBrowser "Same as Apps -> Help Browser. Test: See helpBrowser. " ^ HelpBrowser open.! ! !See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'! messageNames "Same as World -> open -> message names. Test: See messageNames. " ^ ECToolSet openMessageNames.! ! !See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'! methodFinder "Same as World -> open -> method finder. Test: See methodFinder. " ^ ECToolSet openSelectorBrowser.! ! !See class methodsFor: 'other links' stamp: 'Edrx 3/3/2023 22:18'! browseProtocol: obj "Refs: See cm: (Browser >> #classListMenu:). See cm: (ObjectExplorer >> #browseFullProtocol). " InstanceBrowser new openOnObject: obj showingSelector: nil. ! ! !See class methodsFor: 'other links' stamp: 'Edrx 1/29/2023 00:09'! class: className "Same as: Tools -> Browser -> (select class: className). Test: See class: See. " ^ className browse.! ! !See class methodsFor: 'other links' stamp: 'Edrx 1/29/2023 00:09'! class: class classMethod: method "Same as: Tools -> Browser -> (select class: className) -> (show class methods instead of instance methods) -> (select method: className). Test: See class: See classMethod: #class:. " ^ self class: (class class) method: method. ! ! !See class methodsFor: 'other links' stamp: 'Edrx 1/29/2023 00:10'! class: className method: method "Same as: Tools -> Browser -> (select class: className) -> (select method: className). Test: See class: foo " ^ SystemBrowser default fullOnClass: className selector: method.! ! !See class methodsFor: 'other links' stamp: 'Edrx 2/21/2023 18:48'! cm: compiledMethod | class method | "The 'cm:' here is an abbreviation for both 'class:method:' and 'compiledMethod:'. Tests: See class: Browser class method: #fullOnClass:selector:. See cm: (Browser class >> #fullOnClass:selector:). " class := compiledMethod methodClass. method := compiledMethod searchForSelector. See class: class method: method.! ! !See class methodsFor: 'other links' stamp: 'Edrx 3/10/2023 23:51'! searchBar: aString "See: See edrxGuide: #searchBar. This controls the search bar and makes it search for a string. This only works if this global variable points to the search bar: See at: #searchBar. To make this work, open a debugger on the search bar and run this there: See at: #searchBar put: self. the result should be a PluggableTextMorphPlus. Test: See searchBar: 'baseline'. Warning: BROKEN!! " | sb | sb := See at: #searchBar. "self halt." "sb textMorph editor accept." sb model searchTerm: aString. sb textMorph acceptContents. ! ! !See class methodsFor: 'other links' stamp: 'Edrx 3/4/2023 21:30'! see "Try: See edrxGuide. See edrxGuide: #whatIsThis. " See cm: (See class >> #see).! ! !See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 12:05'! item1ctsa: menu "Return the contents, the target, the selector, and the arguments of the item 1 of a MenuMorph object. To use this, create a menu with just one item with halo/duplicate, then on that new menu do halo/debug -> explore morph, and in its lower window run this: See item1ctsa: self. " | item | item := See item1of: menu. ^ { item contents . item target . item selector . item arguments }.! ! !See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 00:07'! item1of: menu "Return the item 1 of a MenuMorph object. This method is very hard to explain!!!!!! See the comments here: See class: See classMethod: #item1tsa: " ^ menu submorphs at: 1.! ! !See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 00:09'! item1tsa: menu "Return the target, the selector, and the arguments of the item 1 of a MenuMorph object. To use this, create a menu with just one item with halo/duplicate, then on that new menu do halo/debug -> explore morph, and in its lower window run this: See item1tsa: self. " | item | item := See item1of: menu. ^ { item target . item selector . item arguments }.! ! !See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 12:07'! show: menu Transcript show: (See item1ctsa: menu); cr.! ! !See class methodsFor: 'emacs' stamp: 'Edrx 1/29/2023 00:08'! emacsClientEval: string | cmd | "Run `emacsclient --eval string'. Run `M-x find-emacsclient-links' in Emacs to make sure that the emacsserver is running." cmd := 'emacsclient --eval ''' , string , ''''. ^ OSProcess waitForCommand: cmd.! ! !See class methodsFor: 'emacs' stamp: 'Edrx 1/29/2023 00:11'! findSqueakByEx: page "Open the book Squeak by Example on a certain page using emacsclient. Run `M-x find-emacsclient-links' in Emacs to make sure that the emacsserver is running. Test: See findSqueakByEx: (16 + 30). This will do roughly the same as this sexp: (find-squeakbyexpage (+ 16 30)) " ^ self emacsClientEval: '(find-squeakbyexpage ' , page , ')'.! ! !See class methodsFor: 'accessing' stamp: 'Edrx 3/10/2023 20:40'! at: key "This implements a global storage area that we can use to transfer values between workspaces. For example, you can open the debugger on the search bar and do this, See at: #searchBar put: self. and then go to a workspace and to this: searchBar := See at: #searchBar. " ^ See store at: key. ! ! !See class methodsFor: 'accessing' stamp: 'Edrx 3/10/2023 20:36'! at: key ifAbsent: aBlock ^ See store at: key ifAbsent: aBlock. ! ! !See class methodsFor: 'accessing' stamp: 'Edrx 3/1/2023 01:21'! at: key put: value ^ See store at: key put: value. ! ! !See class methodsFor: 'accessing' stamp: 'Edrx 3/1/2023 01:21'! store Store ifNil: [ Store := Dictionary new. ]. ^ Store. ! ! !See class methodsFor: 'accessing' stamp: 'Edrx 2/19/2023 13:18'! store: s Store := s. ! ! !See class methodsFor: 'morphic' stamp: 'Edrx 3/3/2023 21:19'! after: ms run: aBlock self run: aBlock after: ms.! ! !See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 15:54'! keyboardFocus ^ self currentHand keyboardFocus. ! ! !See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 15:53'! keyboardFocus: aMorphOrNil self currentHand newKeyboardFocus: aMorphOrNil. ! ! !See class methodsFor: 'morphic' stamp: 'Edrx 3/1/2023 02:32'! run: aBlock after: ms "This uses a variant of the technique explained in: See edrxGuide: #addAlarm. but with an invisible button, that is eventually garbage-collected." | aButton | aButton := SimpleButtonMorph new. aButton openInWorld; hide; target: aBlock; actionSelector: #value; addAlarm: #doButtonAction after: ms. ! ! !See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 16:34'! sendEvent: evt to: morph evt resetHandlerFields. morph handleEvent: evt. ! ! !See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 16:40'! sendEventDebug: evt to: morph evt resetHandlerFields. self halt. morph handleEvent: evt. ! ! !See class methodsFor: 'edrxGuide / terseGuide' stamp: 'Edrx 3/1/2023 01:18'! edrxGuide "Tests: See edrxGuide. See class: EdrxGuideHelp class. " ^ HelpBrowserB openOn: EdrxGuideHelp. ! ! !See class methodsFor: 'edrxGuide / terseGuide' stamp: 'Edrx 2/25/2023 23:53'! edrxGuide: topic "Tests: See edrxGuide: #whatIsThis. See cm: (EdrxGuideHelp class >> #whatIsThis). " ^ EdrxGuideHelp edit: topic. ! ! !See class methodsFor: 'edrxGuide / terseGuide' stamp: 'Edrx 2/25/2023 18:39'! terseGuide "Test: See terseGuide. " ^ HelpBrowser openOn: TerseGuideHelp. ! ! !See class methodsFor: 'edrxGuide / terseGuide' stamp: 'Edrx 2/25/2023 22:48'! terseGuide: topic "Test: See terseGuide: #introduction. " ^ TerseGuideHelp edit: topic. ! ! !See class methodsFor: 'breakpoints' stamp: 'Edrx 3/11/2023 02:53'! haltAt: symbol See at: symbol put: true.! ! !See class methodsFor: 'breakpoints' stamp: 'Edrx 3/10/2023 21:19'! haltOnceOn: symbol "This is similar to: See cm: (Object >> #haltOnce:). See cm: (Object >> #haltIf:). but it only halts when a certain variable is true, and when it halts it sets that variable to false. " (See at: symbol ifAbsent: [false]) ifTrue: [ See at: symbol put: false. self halt ] ! ! !See class methodsFor: 'fileIn/Out' stamp: 'Edrx 3/11/2023 02:39'! fileOut "See: See cm: (Browser >> #fileOutSystemCategory). " (Browser new systemOrganizer) fileOutCategory: #'Category-Edrx'.! ! Morph subclass: #TestBezier instanceVariableNames: 'form handle a points segmentPoints' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !TestBezier commentStamp: 'Edrx 3/16/2023 19:38' prior: 0! Based on code that Karl Ramberg posted in 2023mar16.! !TestBezier methodsFor: 'as yet unclassified' stamp: 'Edrx 3/16/2023 19:20'! drawOn: aCanvas super drawOn: aCanvas. 1 to: (submorphs size - 1) do:[:i| aCanvas line: ((submorphs at: i) center) to: ((submorphs at: (i+1))center) color: Color gray]. points ifNotNil:[ 1 to: (points size-1) do:[:i| aCanvas line: (points at:i) to: (points at:i+1) color: Color gray]]. segmentPoints ifNotNil:[ segmentPoints do:[: j| aCanvas line: j to: j-1 width:3 color: Color red]].! ! !TestBezier methodsFor: 'as yet unclassified' stamp: 'kfr 1/1/2023 12:09'! handlesMouseDown:evt ^true ! ! !TestBezier methodsFor: 'as yet unclassified' stamp: 'Edrx 3/16/2023 19:30'! initialize " By Karl Ramberg (in a post from 2023-mar-16). TestBezier new openInWorld " super initialize. self extent:500@400; color: Color white. self addMorph:(EllipseMorph new extent: 40@40; color: Color random; position: 30@300). self addMorph:(EllipseMorph new extent: 40@40; color: Color random; position: 300@30). self addMorph:(EllipseMorph new extent: 40@40; color: Color random; position: 300@300). self addMorph:(EllipseMorph new extent: 40@40; color: Color random; position: 150@200). self addMorph:(EllipseMorph new extent: 40@40; color: Color random; position: 350@250). a := 0.01. points := nil. segmentPoints := OrderedCollection new. self startStepping.! ! !TestBezier methodsFor: 'as yet unclassified' stamp: 'kfr 1/1/2023 12:08'! mouseDown: evt ^self mouseMove: evt! ! !TestBezier methodsFor: 'as yet unclassified' stamp: 'kfr 1/1/2023 13:08'! mouseMove: evt submorphs do:[:each| (each containsPoint: (evt cursorPoint)) ifTrue:[ each position: evt cursorPoint- (each extent/2)]]. self changed! ! !TestBezier methodsFor: 'as yet unclassified' stamp: 'kfr 1/1/2023 20:45'! step | p1 p2 | a := a + 0.01. a >=1 ifTrue:[a := 0.01. segmentPoints := OrderedCollection new]. points := OrderedCollection new. 1 to: submorphs size -1 do:[:i| p1 := (submorphs at: i) center. p2 := (submorphs at: i+1) center. points add: p1 +(a * (p2-p1))]. 1 to: points size -1 do:[:i| p1 := (points at: i). p2 := (points at: i+1) . segmentPoints add: p1 +(a * (p2-p1))]. self changed ! ! !TestBezier methodsFor: 'as yet unclassified' stamp: 'kfr 3/11/2023 16:51'! stepTime ^1! ! Morph subclass: #TestCanvas instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !TestCanvas commentStamp: 'Edrx 3/9/2023 20:43' prior: 0! Based on code by Karl Ramberg. Try this: TestCanvas new openInWorld.! !TestCanvas methodsFor: 'as yet unclassified' stamp: 'Edrx 3/7/2023 13:19'! drawOn: aCanvas aCanvas fillOval: self bounds color: Color red! ! !TestCanvas methodsFor: 'as yet unclassified' stamp: 'kfr 2/25/2023 10:11'! handlesKeyboard: anEvent ^true. ! ! !TestCanvas methodsFor: 'as yet unclassified' stamp: 'kfr 2/25/2023 10:05'! handlesMouseDown: anEvent ^true. ! ! !TestCanvas methodsFor: 'as yet unclassified' stamp: 'Edrx 3/7/2023 13:18'! initialize "Test: TestMorph new openInWorld. " super initialize. self extent: 100@100! ! !TestCanvas methodsFor: 'as yet unclassified' stamp: 'kfr 2/25/2023 10:13'! keyStroke: aKeyboardEvent self halt.! ! !TestCanvas methodsFor: 'as yet unclassified' stamp: 'kfr 2/25/2023 10:13'! mouseDown: evt self halt.! ! Morph subclass: #TestDrawing instanceVariableNames: 'form magnification brush point' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !TestDrawing commentStamp: 'Edrx 3/16/2023 19:38' prior: 0! Based on code that Karl Ramberg posted in 2023mar16.! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'kfr 11/20/2022 11:17'! drawOn: aCanvas aCanvas paintImage: form at: bounds origin.! ! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'kfr 3/16/2023 20:33'! extent: aPoint super extent: aPoint. form := Form extent: self extent.! ! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'kfr 11/20/2022 11:01'! handlesMouseDown: evt ^ true! ! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'Edrx 3/16/2023 19:31'! initialize " By Karl Ramberg (in a post from 2023-mar-16). TestDrawing new openInWorld " super initialize. self extent:200@200. magnification := 20. brush := (Form extent: magnification@magnification) fillBlack! ! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'kfr 11/20/2022 12:17'! mouseDown: evt self mouseMove: evt! ! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'kfr 11/20/2022 12:32'! mouseMove: evt evt yellowButtonPressed ifTrue:[brush fillWhite] ifFalse:[brush fillBlack]. brush displayOn:form at: (self pointGriddedFromEvent: evt). self changed! ! !TestDrawing methodsFor: 'as yet unclassified' stamp: 'kfr 11/20/2022 11:07'! pointGriddedFromEvent: evt | relativePt | relativePt := evt cursorPoint - self position. ^ (relativePt x truncateTo: magnification)@(relativePt y truncateTo: magnification) ! ! Morph subclass: #TestLayout instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !TestLayout commentStamp: 'Edrx 3/9/2023 20:44' prior: 0! Based on code by Karl Ramberg. Try this: TestLayout new openInWorld.! !TestLayout methodsFor: 'as yet unclassified' stamp: 'Edrx 3/7/2023 14:16'! initialize "Test: self halt. TestLayoutMorph new openInWorld. Based on code by Karl Ramberg. " super initialize. "self extent: 400@200." "self color: Color gray." self layoutPolicy: TableLayout new; hResizing: #shrinkWrap; listDirection: #center; wrapCentering: #center. self addMorphBack: (SimpleButtonMorph new label:'halt'; target: self; actionSelector: #halt). self addMorphBack: (SimpleButtonMorph new label:'inspect'; target: self; actionSelector: #inspect). self addMorphBack: (SimpleButtonMorph new label:'browse'; target: self; actionSelector: #browse). ! ! Model subclass: #TestToolBuilder instanceVariableNames: 'search tree' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !TestToolBuilder commentStamp: 'Edrx 3/9/2023 20:47' prior: 0! A basic demo of ToolBuilder, based on HelpBrowser. Try this: ToolBuilder open: (TestToolBuilder new).! !TestToolBuilder methodsFor: 'as yet unclassified' stamp: 'Edrx 3/9/2023 20:48'! buildSearchWith: builder "Based on: See cm: (HelpBrowser >> #buildSearchWith:). " ^ builder pluggableInputFieldSpec new model: self; frame: (LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@ builder inputFieldHeight)); yourself.! ! !TestToolBuilder methodsFor: 'as yet unclassified' stamp: 'Edrx 3/9/2023 08:26'! buildTreeWith: builder ^ builder pluggableTreeSpec new model: self; nodeClass: HelpTopicListItemWrapper; frame: (LayoutFrame fractions: (0@0 corner: 0.3@1) offsets: (0@ builder inputFieldHeight corner: 0@0)); yourself. ! ! !TestToolBuilder methodsFor: 'as yet unclassified' stamp: 'Edrx 3/9/2023 20:41'! buildWith: builder "Based on: See cm: (HelpBrowser >> #buildWith:). Test: ToolBuilder open: (TestToolBuilder new). " | windowSpec | windowSpec := self buildWindowWith: builder. windowSpec children add: (search := self buildSearchWith: builder); add: (tree := self buildTreeWith: builder). ^ builder build: windowSpec! ! Model subclass: #TestWindowSpec instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Category-Edrx'! !TestWindowSpec commentStamp: 'Edrx 3/11/2023 02:09' prior: 0! Try: See edrxGuide: #windowSpecs.! !TestWindowSpec methodsFor: 'as yet unclassified' stamp: 'Edrx 3/11/2023 03:10'! buildCodePaneWith: builder | listSpec | listSpec := builder pluggableListSpec new. ^ listSpec. ! ! !TestWindowSpec methodsFor: 'as yet unclassified' stamp: 'Edrx 3/11/2023 03:10'! buildMessageCategoryListWith: builder | listSpec | listSpec := builder pluggableListSpec new. ^ listSpec. ! ! !TestWindowSpec methodsFor: 'as yet unclassified' stamp: 'Edrx 3/11/2023 03:10'! buildMessageListWith: builder | listSpec | listSpec := builder pluggableListSpec new. ^ listSpec. ! ! !TestWindowSpec methodsFor: 'as yet unclassified' stamp: 'Edrx 3/11/2023 03:10'! buildSystemCategoryListWith: builder | listSpec | listSpec := builder pluggableListSpec new. ^ listSpec. ! ! !TestWindowSpec methodsFor: 'as yet unclassified' stamp: 'Edrx 3/11/2023 03:13'! buildWith: builder "This is broken!! But see: See edrxGuide: windowSpecs. See cm: (HelpBrowser >> #buildWith:). See cm: (Browser >> #buildDefaultBrowserWith:). Tests: See haltAt: #buildBrowser. See see. self halt. ToolBuilder open: (TestWindowSpec new). " | max windowSpec | max := 0.42. windowSpec := self buildWindowWith: builder specs: { (0@0 corner: 0.25@max) -> [self buildSystemCategoryListWith: builder]. (0.5@0 corner: 0.75@max) -> [self buildMessageCategoryListWith: builder]. (0.75@0 corner: 1@max) -> [self buildMessageListWith: builder]. (0@max corner: 1@1) -> [self buildCodePaneWith: builder]. }. windowSpec defaultFocus: #systemCategoryList. ^builder build: windowSpec ! !