Squeak-dev September 2021

squeak-dev@lists.squeakfoundation.org

23 participants
204 discussions

The Trunk: Regex-Help-pre.1.mcz
by commits＠source.squeak.org 12 Oct '22

12 Oct '22

Patrick Rein uploaded a new version of Regex-Help to project The Trunk: http://source.squeak.org/trunk/Regex-Help-pre.1.mcz ==================== Summary ==================== Name: Regex-Help-pre.1 Author: pre Time: 6 July 2018, 5:14:56.533269 pm UUID: 476b203d-1709-a54e-9a96-f0dfc3a93dfd Ancestors: Converts the regex documentation from class methods to a full help topic. ==================== Snapshot ==================== SystemOrganization addCategory: #'Regex-Help'! CustomHelp subclass: #RegexHelp instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Regex-Help'! ----- Method: RegexHelp class>>bookName (in category 'as yet unclassified') ----- bookName ^ 'Regex'! ----- Method: RegexHelp class>>changelog (in category 'as yet unclassified') ----- changelog "This method was automatically generated. Edit it using:" "RegexHelp edit: #changelog" ^(HelpTopic title: 'Changelog' contents: 'VERSION 1.3.1 (September 2008) 1. Updated documentation of character classes, making clear the problems of locale - an area for future improvement VERSION 1.3 (September 2008) 1. \w now matches underscore as well as alphanumerics, in line with most other regex libraries (and our documentation!!!!). 2. \W rejects underscore as well as alphanumerics 3. added tests for this at end of testSuite 4. updated documentation and added note to old incorrect comments in version 1.1 below VERSION 1.2.3 (November 2007) 1. Regexs with ^ or $ applied to copy empty strings caused infinite loops, e.g. ('''' copyWithRegex: ''^.*$'' matchesReplacedWith: ''foo''). Applied a similar correction to that from version 1.1c, to #copyStream:to:(replacingMatchesWith:|translatingMatchesUsing:). 2. Extended RxParser testing to run each test for #copy:translatingMatchesUsing: as well as #search:. 3. Corrected #testSuite test that a dot does not match a null, which was passing by luck with Smalltalk code in a literal array. 4. Added test to end of test suite for fix 1 above. VERSION 1.2.2 (November 2006) There was no way to specify a backslash in a character set. Now [\\] is accepted. VERSION 1.2.1 (August 2006) 1. Support for returning all ranges (startIndex to: stopIndex) matching a regex - #allRangesOfRegexMatches:, #matchingRangesIn: 2. Added hint to usage documentation on how to get more information about matches when enumerating 3. Syntax description of dot corrected: matches anything but NUL since 1.1a VERSION 1.2 (May 2006) Fixed case-insensitive search for character sets. VERSION 1.1c (December 2004) Fixed the issue with #matchesOnStream:do: which caused infinite loops for matches that matched empty strings. VERSION 1.1b (November 2001) Changes valueNowOrOnUnwindDo: to ensure:, plus incorporates some earlier fixes. VERSION 1.1a (May 2001) 1. Support for keeping track of multiple subexpressions. 2. Dot (.) matches anything but NUL character, as it should per POSIX spec. 3. Some bug fixes. VERSION 1.1 (October 1999) Regular expression syntax corrections and enhancements: 1. Backslash escapes similar to those in Perl are allowed in patterns: \w any word constituent character (equivalent to [a-zA-Z0-9_]) *** underscore only since 1.3 *** \W any character but a word constituent (equivalent to [^a-xA-Z0-9_] *** underscore only since 1.3 *** \d a digit (same as [0-9]) \D anything but a digit \s a whitespace character \S anything but a whitespace character \b an empty string at a word boundary \B an empty string not at a word boundary \< an empty string at the beginning of a word \> an empty string at the end of a word For example, ''\w+'' is now a valid expression matching any word. 2. The following backslash escapes are also allowed in character sets (between square brackets): \w, \W, \d, \D, \s, and \S. 3. The following grep(1)-compatible named character classes are recognized in character sets as well: [:alnum:] [:alpha:] [:cntrl:] [:digit:] [:graph:] [:lower:] [:print:] [:punct:] [:space:] [:upper:] [:xdigit:] For example, the following patterns are equivalent: ''[[:alnum:]_]+'' ''\w+'' ''[\w]+'' ''[a-zA-Z0-9_]+'' *** underscore only since 1.3 *** 4. Some non-printable characters can be represented in regular expressions using a common backslash notation: \t tab (Character tab) \n newline (Character lf) \r carriage return (Character cr) \f form feed (Character newPage) \e escape (Character esc) 5. A dot is corectly interpreted as ''any character but a newline'' instead of ''anything but whitespace''. 6. Case-insensitive matching. The easiest access to it are new messages CharacterArray understands: #asRegexIgnoringCase, #matchesRegexIgnoringCase:, #prefixMatchesRegexIgnoringCase:. 7. The matcher (an instance of RxMatcher, the result of String>>asRegex) now provides a collection-like interface to matches in a particular string or on a particular stream, as well as substitution protocol. The interface includes the following messages: matchesIn: aString matchesIn: aString collect: aBlock matchesIn: aString do: aBlock matchesOnStream: aStream matchesOnStream: aStream collect: aBlock matchesOnStream: aStream do: aBlock copy: aString translatingMatchesUsing: aBlock copy: aString replacingMatchesWith: replacementString copyStream: aStream to: writeStream translatingMatchesUsing: aBlock copyStream: aStream to: writeStream replacingMatchesWith: aString Examples: ''\w+'' asRegex matchesIn: ''now is the time'' returns an OrderedCollection containing four strings: ''now'', ''is'', ''the'', and ''time''. ''\<t\w+'' asRegexIgnoringCase copy: ''now is the Time'' translatingMatchesUsing: [:match | match asUppercase] returns ''now is THE TIME'' (the regular expression matches words beginning with either an uppercase or a lowercase T). ACKNOWLEDGEMENTS Since the first release of the matcher, thanks to the input from several fellow Smalltalkers, I became convinced a native Smalltalk regular expression matcher was worth the effort to keep it alive. For the contributions, suggestions, and bug reports that made this release possible, I want to thank: Felix Hack Peter Hatch Alan Knight Eliot Miranda Thomas Muhr Robb Shecter David N. Smith Francis Wolinski and anyone whom I haven''t yet met or heard from, but who agrees this has not been a complete waste of time.!!' readStream nextChunkText) key: #changelog! ----- Method: RegexHelp class>>examples (in category 'as yet unclassified') ----- examples "This method was automatically generated. Edit it using:" "RegexHelp edit: #examples" ^(HelpTopic title: 'Examples' contents: 'As the introductions said, a great use for regular expressions is userinput validation. Following are a few examples of regular expressionsthat might be handy in checking input entered by the user in an inputfield. Try them out by entering something between the quotes andprint-iting. (Also, try to imagine Smalltalk code that each validationwould require if coded by hand). Most example expressions could havebeen written in alternative ways. Checking if aString may represent a nonnegative integer number: '''' matchesRegex: '':isDigit:+''or '''' matchesRegex: ''[0-9]+''or '''' matchesRegex: ''\d+'' Checking if aString may represent an integer number with an optionalsign in front: '''' matchesRegex: ''(\+|-)?\d+'' Checking if aString is a fixed-point number, with at least one digitis required after a dot: '''' matchesRegex: ''(\+|-)?\d+(\.\d+)?'' The same, but allow notation like `123.'': '''' matchesRegex: ''(\+|-)?\d+(\.\d*)?'' Recognizer for a string that might be a name: one word with firstcapital letter, no blanks, no digits. More traditional: '''' matchesRegex: ''[A-Z][A-Za-z]*'' more Smalltalkish: '''' matchesRegex: '':isUppercase::isAlphabetic:*'' A date in format MMM DD, YYYY with any number of spaces in between, inXX century: '''' matchesRegex: ''(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(\d\d?)[ ]*,[ ]*19(\d\d)'' Note parentheses around some components of the expression above. As`Usage'' section shows, they will allow us to obtain the actual stringsthat have matched them (i.e. month name, day number, and year number). For dessert, coming back to numbers: here is a recognizer for ageneral number format: anything like 999, or 999.999, or -999.999e+21. '''' matchesRegex: ''(\+|-)?\d+(\.\d*)?((e|E)(\+|-)?\d+)?''!!!!!!' readStream nextChunkText) key: #examples! ----- Method: RegexHelp class>>implementationNotes (in category 'as yet unclassified') ----- implementationNotes "This method was automatically generated. Edit it using:" "RegexHelp edit: #implementationNotes" ^(HelpTopic title: 'Implementation Notes' contents: 'WHAT TO LOOK AT FIRST String>>matchesRegex: -- in 90% cases this method is all you need to access the package. RxParser -- accepts a string or a stream of characters with a regular expression, and produces a syntax tree corresponding to the expression. The tree is made of instances of Rxs<whatever> classes. RxMatcher -- accepts a syntax tree of a regular expression built by the parser and compiles it into a matcher: a structure made of instances of Rxm<whatever> classes. The RxMatcher instance can test whether a string or a positionable stream of characters matches the original regular expression, or search a string or a stream for substrings matching the expression. After a match is found, the matcher can report a specific string that matched the whole expression, or any parenthesized subexpression of it. All other classes support the above functionality and are used by RxParser, RxMatcher, or both. CAVEATS The matcher is similar in spirit, but NOT in the design--let alone the code--to the original Henry Spencer''s regular expression implementation in C. The focus is on simplicity, not on efficiency. I didn''t optimize or profile anything. I may in future--or I may not: I do this in my spare time and I don''t promise anything. The matcher passes H. Spencer''s test suite (see ''test suite'' protocol), with quite a few extra tests added, so chances are good there are not too many bugs. But watch out anyway. EXTENSIONS, FUTURE, ETC. With the existing separation between the parser, the syntax tree, and the matcher, it is easy to extend the system with other matchers based on other algorithms. In fact, I have a DFA-based matcher right now, but I don''t feel it is good enough to include it here. I might add automata-based matchers later, but again I don''t promise anything. HOW TO REACH ME As of today (December 20, 2000), you can contact me at <vassili(a)parcplace.com>. If this doesn''t work, look around comp.lang.smalltalk or comp.lang.lisp. !!' readStream nextChunkText) key: #implementationNotes! ----- Method: RegexHelp class>>introduction (in category 'as yet unclassified') ----- introduction "This method was automatically generated. Edit it using:" "RegexHelp edit: #introduction" ^(HelpTopic title: 'Introduction' contents: 'A regular expression is a template specifying a class of strings. A regular expression matcher is an tool that determines whether a string belongs to a class specified by a regular expression. This is a common task of a user input validation code, and the use of regular expressions can GREATLY simplify and speed up development of such code. As an example, here is how to verify that a string is a valid hexadecimal number in Smalltalk notation, using this matcher package: aString matchesRegex: ''16r[[:xdigit:]]+'' (Coding the same "the hard way'''' is an exercise to a curious reader). This matcher is offered to the Smalltalk community in hope it will be useful. It is free in terms of money, and to a large extent -- in terms of rights of use. Refer to the "Boring Stuff" section for legalese. The "Syntax" section explains the recognized syntax of regular expressions. The "Usage" section explains matcher capabilities that go beyond what String>>matchesRegex: method offers. The "Implementation Notes" sections says a few words about what is under the hood. The "Changelog" section describes the functionality introduced in 1.1 release. Happy hacking, --Vassili Bykov <vassili(a)objectpeople.com> <vassili(a)magma.ca> !! ]style[(479 40 712),daString matchesRegex: ''16r[[:xdigit:]]+'';;,!!' readStream nextChunkText) key: #introduction! ----- Method: RegexHelp class>>license (in category 'as yet unclassified') ----- license "This method was automatically generated. Edit it using:" "RegexHelp edit: #license" ^(HelpTopic title: 'License' contents: 'The Regular Expression Matcher (``The Software'''') is Copyright (C) 1996, 1999 Vassili Bykov. It is provided to the Smalltalk community in hope it will be useful. 1. This license applies to the package as a whole, as well as to any component of it. By performing any of the activities described below, you accept the terms of this agreement. 2. The software is provided free of charge, and "as is'''', in hope that it will be useful, with ABSOLUTELY NO WARRANTY. The entire risk and all responsibility for the use of the software is with you. Under no circumstances the author may be held responsible for loss of data, loss of profit, or any other damage resulting directly or indirectly from the use of the software, even if the damage is caused by defects in the software. 3. You may use this software in any applications you build. 4. You may distribute this software provided that the software documentation and copyright notices are included and intact. 5. You may create and distribute modified versions of the software, such as ports to other Smalltalk dialects or derived work, provided that: a. any modified version is expressly marked as such and is not misrepresented as the original software; b. credit is given to the original software in the source code and documentation of the derived work; c. the copyright notice at the top of this document accompanies copyright notices of any modified version.!!' readStream nextChunkText) key: #license! ----- Method: RegexHelp class>>pages (in category 'as yet unclassified') ----- pages ^ #(introduction syntax examples usage implementationNotes license changelog)! ----- Method: RegexHelp class>>syntax (in category 'as yet unclassified') ----- syntax "This method was automatically generated. Edit it using:" "RegexHelp edit: #syntax" ^(HelpTopic title: 'Syntax' contents: 'The simplest regular expression is a single character. It matchesexactly that character. A sequence of characters matches a string withexactly the same sequence of characters: ''a'' matchesRegex: ''a'' -- true ''foobar'' matchesRegex: ''foobar'' -- true ''blorple'' matchesRegex: ''foobar'' -- false The above paragraph introduced a primitive regular expression (acharacter), and an operator (sequencing). Operators are applied toregular expressions to produce more complex regular expressions.Sequencing (placing expressions one after another) as an operator is,in a certain sense, ''invisible''--yet it is arguably the most common. A more ''visible'' operator is Kleene closure, more often simplyreferred to as ''a star''. A regular expression followed by an asteriskmatches any number (including 0) of matches of the originalexpression. For example: ''ab'' matchesRegex: ''a*b'' -- true ''aaaaab'' matchesRegex: ''a*b'' -- true ''b'' matchesRegex: ''a*b'' -- true ''aac'' matchesRegex: ''a*b'' -- false: b does not match A star''s precedence is higher than that of sequencing. A star appliesto the shortest possible subexpression that precedes it. For example,''ab*'' means ''a followed by zero or more occurrences of b'', not ''zeroor more occurrences of ab'': ''abbb'' matchesRegex: ''ab*'' -- true ''abab'' matchesRegex: ''ab*'' -- false To actually make a regex matching ''zero or more occurrences of ab'',''ab'' is enclosed in parentheses: ''abab'' matchesRegex: ''(ab)*'' -- true ''abcab'' matchesRegex: ''(ab)*'' -- false: c spoils the fun Two other operators similar to ''*'' are ''+'' and ''?''. ''+'' (positiveclosure, or simply ''plus'') matches one or more occurrences of theoriginal expression. ''?'' (''optional'') matches zero or one, but nevermore, occurrences. ''ac'' matchesRegex: ''ab*c'' -- true ''ac'' matchesRegex: ''ab+c'' -- false: need at least one b ''abbc'' matchesRegex: ''ab+c'' -- true ''abbc'' matchesRegex: ''ab?c'' -- false: too many b''s As we have seen, characters ''*'', ''+'', ''?'', ''('', and '')'' have specialmeaning in regular expressions. If one of them is to be usedliterally, it should be quoted: preceded with a backslash. (Thus,backslash is also special character, and needs to be quoted for aliteral match--as well as any other special character describedfurther). ''ab*'' matchesRegex: ''ab*'' -- false: star in the right string is special ''ab*'' matchesRegex: ''ab\*'' -- true ''a\c'' matchesRegex: ''a\\c'' -- true The last operator is ''|'' meaning ''or''. It is placed between tworegular expressions, and the resulting expression matches if one ofthe expressions matches. It has the lowest possible precedence (lowerthan sequencing). For example, ''ab*|ba*'' means ''a followed by anynumber of b''s, or b followed by any number of a''s'': ''abb'' matchesRegex: ''ab*|ba*'' -- true ''baa'' matchesRegex: ''ab*|ba*'' -- true ''baab'' matchesRegex: ''ab*|ba*'' -- false A bit more complex example is the following expression, matching thename of any of the Lisp-style ''car'', ''cdr'', ''caar'', ''cadr'',... functions: c(a|d)+r It is possible to write an expression matching an empty string, forexample: ''a|''. However, it is an error to apply ''*'', ''+'', or ''?'' tosuch expression: ''(a|)*'' is an invalid expression. So far, we have used only characters as the ''smallest'' components ofregular expressions. There are other, more ''interesting'', components. A character set is a string of characters enclosed in squarebrackets. It matches any single character if it appears between thebrackets. For example, ''[01]'' matches either ''0'' or ''1'': ''0'' matchesRegex: ''[01]'' -- true ''3'' matchesRegex: ''[01]'' -- false ''11'' matchesRegex: ''[01]'' -- false: a set matches only one character Using plus operator, we can build the following binary numberrecognizer: ''10010100'' matchesRegex: ''[01]+'' -- true ''10001210'' matchesRegex: ''[01]+'' -- false If the first character after the opening bracket is ''^'', the set isinverted: it matches any single character *not* appearing between thebrackets: ''0'' matchesRegex: ''[^01]'' -- false ''3'' matchesRegex: ''[^01]'' -- true For convenience, a set may include ranges: pairs of charactersseparated with ''-''. This is equivalent to listing all charactersbetween them: ''[0-9]'' is the same as ''[0123456789]''. Special characters within a set are ''^'', ''-'', and '']'' that closes theset. Below are the examples of how to literally use them in a set: [01^] -- put the caret anywhere except the beginning [01-] -- put the dash as the last character []01] -- put the closing bracket as the first character [^]01] (thus, empty and universal sets cannot be specified) Regular expressions can also include the following backquote escapesto refer to popular classes of characters: \w any word constituent character (same as [a-zA-Z0-9_]) \W any character but a word constituent \d a digit (same as [0-9]) \D anything but a digit \s a whitespace character (same as [:space:] below) \S anything but a whitespace character These escapes are also allowed in character classes: ''[\w+-]'' means''any character that is either a word constituent, or a plus, or aminus''. Character classes can also include the following grep(1)-compatibleelements to refer to: [:alnum:] any alphanumeric character (same as [a-zA-Z0-9]) [:alpha:] any alphabetic character (same as [a-zA-Z]) [:cntrl:] any control character. (any character with code < 32) [:digit:] any decimal digit (same as [0-9]) [:graph:] any graphical character. (any character with code >= 32). [:lower:] any lowercase character (including non-ASCII lowercase characters) [:print:] any printable character. In this version, this is the same as [:graph:] [:punct:] any punctuation character: . , !!!!!!!! ? ; : '' - ( ) '' and double quotes [:space:] any whitespace character (space, tab, CR, LF, null, form feed, Ctrl-Z, 16r2000-16r200B, 16r3000) [:upper:] any uppercase character (including non-ASCII uppercase characters) [:xdigit:] any hexadecimal character (same as [a-fA-F0-9]). Note that many of these are only as consistent or inconsistent on issuesof locale as the underlying Smalltalk implementation. Values shown hereare for VisualWorks 7.6. Note that these elements are components of the character classes,i.e. they have to be enclosed in an extra set of square brackets toform a valid regular expression. For example, a non-empty string ofdigits would be represented as ''[[:digit:]]+''. The above primitive expressions and operators are common to manyimplementations of regular expressions. The next primitive expressionis unique to this Smalltalk implementation. A sequence of characters between colons is treated as a unary selectorwhich is supposed to be understood by Characters. A character matchessuch an expression if it answers true to a message with thatselector. This allows a more readable and efficient way of specifyingcharacter classes. For example, ''[0-9]'' is equivalent to '':isDigit:'',but the latter is more efficient. Analogously to character sets,character classes can be negated: '':^isDigit:'' matches a Characterthat answers false to #isDigit, and is therefore equivalent to''[^0-9]''. As an example, so far we have seen the following equivalent ways towrite a regular expression that matches a non-empty string of digits: ''[0-9]+'' ''\d+'' ''[\d]+'' ''[[:digit:]]+'' '':isDigit:+'' The last group of special primitive expressions includes: . matching any character except a NULL; ^ matching an empty string at the beginning of a line; $ matching an empty string at the end of a line. \b an empty string at a word boundary \B an empty string not at a word boundary \< an empty string at the beginning of a word \> an empty string at the end of a word ''axyzb'' matchesRegex: ''a.+b'' -- true ''ax zb'' matchesRegex: ''a.+b'' -- true (space is matched by ''.'') ''axzb'' matchesRegex: ''a.+b'' -- true (carriage return is matched by ''.'') Again, the dot ., caret ^ and dollar $ characters are special and should be quotedto be matched literally.!! ]style[(179 21 7851),f5,!!' readStream nextChunkText) key: #syntax! ----- Method: RegexHelp class>>usage (in category 'as yet unclassified') ----- usage "This method was automatically generated. Edit it using:" "RegexHelp edit: #usage" ^(HelpTopic title: 'Usage' contents: 'The preceding section covered the syntax of regular expressions. It used the simplest possible interface to the matcher: sending #matchesRegex: message to the sample string, with regular expression string as the argument. This section explains hairier ways of using the matcher. PREFIX MATCHING AND CASE-INSENSITIVE MATCHING A CharacterArray (an EsString in VA) also understands these messages: #prefixMatchesRegex: regexString #matchesRegexIgnoringCase: regexString #prefixMatchesRegexIgnoringCase: regexString #prefixMatchesRegex: is just like #matchesRegex, except that the whole receiver is not expected to match the regular expression passed as the argument; matching just a prefix of it is enough. For example: ''abcde'' matchesRegex: ''(a|b)+'' -- false ''abcde'' prefixMatchesRegex: ''(a|b)+'' -- true The last two messages are case-insensitive versions of matching. ENUMERATION INTERFACE An application can be interested in all matches of a certain regular expression within a String. The matches are accessible using a protocol modelled after the familiar Collection-like enumeration protocol: #regex: regexString matchesDo: aBlock Evaluates a one-argument <aBlock> for every match of the regular expression within the receiver string. #regex: regexString matchesCollect: aBlock Evaluates a one-argument <aBlock> for every match of the regular expression within the receiver string. Collects results of evaluations and anwers them as a SequenceableCollection. #allRegexMatches: regexString Returns a collection of all matches (substrings of the receiver string) of the regular expression. It is an equivalent of <aString regex: regexString matchesCollect: [:each | each]>. #allRangesOfRegexMatches: regexString Returns a collection of all character ranges (startIndex to: stopIndex) that match the regular expression. REPLACEMENT AND TRANSLATION It is possible to replace all matches of a regular expression with a certain string using the message: #copyWithRegex: regexString matchesReplacedWith: aString For example: ''ab cd ab'' copyWithRegex: ''(a|b)+'' matchesReplacedWith: ''foo'' A more general substitution is match translation: #copyWithRegex: regexString matchesTranslatedUsing: aBlock This message evaluates a block passing it each match of the regular expression in the receiver string and answers a copy of the receiver with the block results spliced into it in place of the respective matches. For example: ''ab cd ab'' copyWithRegex: ''(a|b)+'' matchesTranslatedUsing: [:each | each asUppercase] All messages of enumeration and replacement protocols perform a case-sensitive match. Case-insensitive versions are not provided as part of a CharacterArray protocol. Instead, they are accessible using the lower-level matching interface. LOWER-LEVEL INTERFACE Internally, #matchesRegex: works as follows: 1. A fresh instance of RxParser is created, and the regular expression string is passed to it, yielding the expression''s syntax tree. 2. The syntax tree is passed as an initialization parameter to an instance of RxMatcher. The instance sets up some data structure that will work as a recognizer for the regular expression described by the tree. 3. The original string is passed to the matcher, and the matcher checks for a match. THE MATCHER If you repeatedly match a number of strings against the same regular expression using one of the messages defined in CharacterArray, the regular expression string is parsed and a matcher is created anew for every match. You can avoid this overhead by building a matcher for the regular expression, and then reusing the matcher over and over again. You can, for example, create a matcher at a class or instance initialization stage, and store it in a variable for future use. You can create a matcher using one of the following methods: - Sending #forString:ignoreCase: message to RxMatcher class, with the regular expression string and a Boolean indicating whether case is ignored as arguments. - Sending #forString: message. It is equivalent to <... forString: regexString ignoreCase: false>. A more convenient way is using one of the two matcher-created messages understood by CharacterArray. - <regexString asRegex> is equivalent to <RxMatcher forString: regexString>. - <regexString asRegexIgnoringCase> is equivalent to <RxMatcher forString: regexString ignoreCase: true>. Here are four examples of creating a matcher: hexRecognizer := RxMatcher forString: ''16r[0-9A-Fa-f]+'' hexRecognizer := RxMatcher forString: ''16r[0-9A-Fa-f]+'' ignoreCase: false hexRecognizer := ''16r[0-9A-Fa-f]+'' asRegex hexRecognizer := ''16r[0-9A-F]+'' asRegexIgnoringCase MATCHING The matcher understands these messages (all of them return true to indicate successful match or search, and false otherwise): matches: aString True if the whole target string (aString) matches. matchesPrefix: aString True if some prefix of the string (not necessarily the whole string) matches. search: aString Search the string for the first occurrence of a matching substring. (Note that the first two methods only try matching from the very beginning of the string). Using the above example with a matcher for `a+'', this method would answer success given a string `baaa'', while the previous two would fail. matchesStream: aStream matchesStreamPrefix: aStream searchStream: aStream Respective analogs of the first three methods, taking input from a stream instead of a string. The stream must be positionable and peekable. All these methods answer a boolean indicating success. The matcher also stores the outcome of the last match attempt and can report it: lastResult Answers a Boolean -- the outcome of the most recent match attempt. If no matches were attempted, the answer is unspecified. SUBEXPRESSION MATCHES After a successful match attempt, you can query the specifics of which part of the original string has matched which part of the whole expression. A subexpression is a parenthesized part of a regular expression, or the whole expression. When a regular expression is compiled, its subexpressions are assigned indices starting from 1, depth-first, left-to-right. For example, `((ab)+(c|d))?ef'' includes the following subexpressions with these indices: 1: ((ab)+(c|d))?ef 2: (ab)+(c|d) 3: ab 4: c|d After a successful match, the matcher can report what part of the original string matched what subexpression. It understandards these messages: subexpressionCount Answers the total number of subexpressions: the highest value that can be used as a subexpression index with this matcher. This value is available immediately after initialization and never changes. subexpression: anIndex An index must be a valid subexpression index, and this message must be sent only after a successful match attempt. The method answers a substring of the original string the corresponding subexpression has matched to. subBeginning: anIndex subEnd: anIndex Answer positions within the original string or stream where the match of a subexpression with the given index has started and ended, respectively. This facility provides a convenient way of extracting parts of input strings of complex format. For example, the following piece of code uses the ''MMM DD, YYYY'' date format recognizer example from the `Syntax'' section to convert a date to a three-element array with year, month, and day strings (you can select and evaluate it right here): | matcher | matcher := RxMatcher forString: ''(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[ ]+(:isDigit::isDigit:?)[ ]*,[ ]*(19|20)(:isDigit::isDigit:)''. (matcher matches: ''Aug 6, 1996'') ifTrue: [Array with: (matcher subexpression: 5) with: (matcher subexpression: 2) with: (matcher subexpression: 3)] ifFalse: [''no match''] (should answer ` #(''96'' ''Aug'' ''6'')''). ENUMERATION AND REPLACEMENT The enumeration and replacement protocols exposed in CharacterArray are actually implemented by the matcher. The following messages are understood: #matchesIn: aString #matchesIn: aString do: aBlock #matchesIn: aString collect: aBlock #copy: aString replacingMatchesWith: replacementString #copy: aString translatingMatchesUsing: aBlock #matchingRangesIn: aString #matchesOnStream: aStream #matchesOnStream: aStream do: aBlock #matchesOnStream: aStream collect: aBlock #copy: sourceStream to: targetStream replacingMatchesWith: replacementString #copy: sourceStream to: targetStream translatingMatchesWith: aBlock Note that in those methods that take a block, the block may refer to the rxMatcher itself, e.g. to collect information about the position the match occurred at, or the subexpressions of the match. An example can be seen in #matchingRangesIn: ERROR HANDLING Exception signaling objects (Signals in VisualWorks, Exceptions in VisualAge) are accessible through RxParser class protocol. To handle possible errors, use the protocol described below to obtain the exception objects and use the protocol of the native Smalltalk implementation to handle them. If a syntax error is detected while parsing expression, RxParser>>syntaxErrorSignal is raised/signaled. If an error is detected while building a matcher, RxParser>>compilationErrorSignal is raised/signaled. If an error is detected while matching (for example, if a bad selector was specified using `:<selector>:'' syntax, or because of the matcher''s internal error), RxParser>>matchErrorSignal is raised RxParser>>regexErrorSignal is the parent of all three. Since any of the three signals can be raised within a call to #matchesRegex:, it is handy if you want to catch them all. For example: VisualWorks: RxParser regexErrorSignal handle: [:ex | ex returnWith: nil] do: [''abc'' matchesRegex: ''))garbage[''] VisualAge: [''abc'' matchesRegex: ''))garbage[''] when: RxParser regexErrorSignal do: [:signal | signal exitWith: nil]!!' readStream nextChunkText) key: #usage!

2 1

The Trunk: System-tonyg.1224.mcz
by commits＠source.squeak.org 14 Sep '22

14 Sep '22

Tony Garnock-Jones uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tonyg.1224.mcz ==================== Summary ==================== Name: System-tonyg.1224 Author: tonyg Time: 29 March 2021, 10:15:02.279821 am UUID: 9d897d72-46fc-4205-a27b-89c7a50ac104 Ancestors: System-mt.1223 Teach SystemOrganizer about multiple environments. =============== Diff against System-mt.1223 =============== Item was changed: Categorizer subclass: #SystemOrganizer + instanceVariableNames: 'environment' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support'! !SystemOrganizer commentStamp: '<historical>' prior: 0! My instances provide an organization for the classes in the system, just as a ClassOrganizer organizes the messages within a class. The only difference is the methods for fileIn/Out.! Item was changed: ----- Method: SystemOrganizer>>classesIn: (in category 'query') ----- classesIn: categoryName | classes | classes := OrderedCollection new. self categories withIndexCollect: [:cat :idx | (categoryName match: cat) ifTrue: [classes addAll: (self listAtCategoryNumber: idx)] ifFalse: [nil]]. + ^ classes collect: [:clsName | self environment classNamed: clsName]! - ^ classes collect: [:clsName | Smalltalk classNamed: clsName]! Item was changed: ----- Method: SystemOrganizer>>classify:under: (in category 'accessing') ----- classify: element under: newCategory | oldCategory class | self flag: #environments. "do we want notifications for classes in other environments?" oldCategory := self categoryOfElement: element. super classify: element under: newCategory. + class := self environment at: element ifAbsent: [^ self]. - class := Smalltalk at: element ifAbsent: [^ self]. self == SystemOrganization ifTrue: [ SystemChangeNotifier uniqueInstance class: class recategorizedFrom: oldCategory to: newCategory]! Item was changed: ----- Method: SystemOrganizer>>commentInventory: (in category 'query') ----- commentInventory: categoryName "SystemOrganization commentInventory: 'Morphic*'" | classes commentedClasses | classes := OrderedCollection new. self categories withIndexCollect: [:cat :idx | (categoryName match: cat) ifTrue: [classes addAll: (self listAtCategoryNumber: idx)] ifFalse: [nil]]. + commentedClasses := classes select: [:catCls | (self environment at: catCls) hasComment]. - commentedClasses := classes select: [:catCls | (Smalltalk at: catCls) hasComment]. ^ 'There are ' , classes size asString , ' classes in ' , categoryName , ' of which ' , commentedClasses size asString , ' have comments and ', (classes size - commentedClasses size) asString , ' do not yet have comments.' ! Item was added: + ----- Method: SystemOrganizer>>environment (in category 'accessing') ----- + environment + ^ environment ifNil: [Smalltalk globals]! Item was added: + ----- Method: SystemOrganizer>>environment: (in category 'accessing') ----- + environment: anEnvironment + environment := anEnvironment! Item was changed: ----- Method: SystemOrganizer>>fileOutCategory:on:initializing: (in category 'fileIn/Out') ----- fileOutCategory: category on: aFileStream initializing: aBool "Store on the file associated with aFileStream, all the traits and classes associated with the category and any requested shared pools in the right order." | first poolSet tempClass classes traits | traits := self orderedTraitsIn: category. classes := self superclassOrder: category. poolSet := Set new. classes do: [:class | class sharedPools do: [:eachPool | poolSet add: eachPool]]. poolSet size > 0 ifTrue: [ tempClass := Class new. tempClass shouldFileOutPools ifTrue: [ poolSet := poolSet select: [:aPool | + tempClass shouldFileOutPool: (self environment keyAtIdentityValue: aPool)]. - tempClass shouldFileOutPool: (Smalltalk globals keyAtIdentityValue: aPool)]. poolSet do: [:aPool | tempClass fileOutPool: aPool onFileStream: aFileStream]]]. first := true. traits, classes do: [:each | first ifTrue: [first := false] ifFalse: [aFileStream cr; nextPut: Character newPage; cr]. each fileOutOn: aFileStream moveSource: false toFile: 0 initializing: false]. aBool ifTrue: [classes do: [:cls | cls fileOutInitializerOn: aFileStream]].! Item was changed: ----- Method: SystemOrganizer>>orderedTraitsIn: (in category 'fileIn/Out') ----- orderedTraitsIn: category "Answer an OrderedCollection containing references to the traits in the category whose name is the argument, category (a string). The traits are ordered so they can be filed in." | behaviors traits | behaviors := (self listAtCategoryNamed: category asSymbol) + collect: [:title | self environment at: title]. - collect: [:title | Smalltalk at: title]. traits := behaviors reject: [:each | each isBehavior]. ^traits asArray sort: [:t1 :t2 | (t2 traitComposition allTraits includes: t1) or: [(t1 traitComposition allTraits includes: t2) not]]! Item was changed: ----- Method: SystemOrganizer>>removeMissingClasses (in category 'remove') ----- removeMissingClasses "Remove any class names that are no longer in the Smalltalk dictionary. Used for cleaning up after garbage collecting user-generated classes." "SystemOrganization removeMissingClasses" elementArray copy do: [:el | + (self environment includesKey: el) ifFalse: [self removeElement: el]]. - (Smalltalk includesKey: el) ifFalse: [self removeElement: el]]. ! Item was changed: ----- Method: SystemOrganizer>>superclassOrder: (in category 'fileIn/Out') ----- superclassOrder: category "Answer an OrderedCollection containing references to the classes in the category whose name is the argument, category (a string). The classes are ordered with superclasses first so they can be filed in." | behaviors classes | behaviors := (self listAtCategoryNamed: category asSymbol) + collect: [:title | self environment at: title]. - collect: [:title | Smalltalk at: title]. classes := behaviors select: [:each | each isBehavior]. ^ChangeSet superclassOrder: classes!

5 7

ResumableTestFailure
by Thiede, Christoph 13 Sep '22

13 Sep '22

Hi all! :-) I was just working a bit with Squeak by Example (the book) and found out that resumable assertions as described in the book (see chapter SUnit, Advanced, Continuing after a failure) do not any longer work in a trunk image. If you write a test case with some resumable assertions, turn on logging, and run the test, only the first failure will be logged, not the rest, too. (Methods to reproduce: isLogging ^ true "You will need to open a Transcript" testResumable #(1 2 3 4 5) do: [:i | self assert: i even description: ['{1} is not even' format: {i}] resumable: true] ) A second issue I experienced frequently when I felt the desire to work with resumable assertions was that they are basically only available for two selectors: #assert:description:resumable: and #deny:description:identical:. I often would like to insert a resumable into any test without being that verbose, and nearly redoubling the number of assertion selectors by adding a resumable argument to each of them did not feel right, either. Please find the attached changeset, which fixes both issues. * In TestResult >> #runCase:, resumable assertions are identified and - finally - resumed, after marking the test as failed. Unfortunately, other test runners (yes, I'm thinking of smalltalkCI) will need to reimplement this feature unless they reuse the TestResult implementation. * In TestCase, I refactored some methods that raise assertion failures and added the most basic #signalFailure:resumable: as the single source of signalization. Instead of setting the resumable bit manually for each assertion, you now can also make the whole test execution resumable by: * overriding #isResumable, * setting a resumable flag using #resumable:, * setting a resumable flag temporarily using #beResumable:during:, or * adding a <resumable> or <resumable: true> pragma to the test method. * In addition, I tested the added and fixed behavior in ResumableTestFailureTestCase. Looking forward to your review! :-) Best, Christoph

2 2

The Inbox: Kernel-ct.1294.mcz
by commits＠source.squeak.org 09 Sep '22

09 Sep '22

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-ct.1294.mcz ==================== Summary ==================== Name: Kernel-ct.1294 Author: ct Time: 9 January 2020, 3:42:36.672555 pm UUID: 7409dcc3-160e-9d44-9712-f266e0f25973 Ancestors: Kernel-nice.1292 Proposal: Add #haltOnceIf: to Object, which combines the strengths of #haltOnce and #haltIf:. Especially useful in performance-critical situations: It HaltOnce is disabled, the condition will not be evaluated at all. =============== Diff against Kernel-nice.1292 =============== Item was changed: ----- Method: Object>>haltIf: (in category 'debugging') ----- + haltIf: aCondition + "This is the typical message to use for inserting breakpoints during debugging. Param can be a block or expression, halt if true. - haltIf: condition - "This is the typical message to use for inserting breakpoints during - debugging. Param can be a block or expression, halt if true. If the Block has one arg, the receiver is bound to that. + If the condition is a selector, we look up in the callchain. Halt if any method's selector equals selector." - If the condition is a selector, we look up in the callchain. Halt if - any method's selector equals selector." - | cntxt | + ^ (self meetsHaltCondition: aCondition) + ifTrue: [self halt]! - condition isSymbol ifTrue:[ - "only halt if a method with selector symbol is in callchain" - cntxt := thisContext. - [cntxt sender isNil] whileFalse: [ - cntxt := cntxt sender. - (cntxt selector = condition) ifTrue: [Halt signal]. - ]. - ^self. - ]. - (condition isBlock - ifTrue: [condition cull: self] - ifFalse: [condition] - ) ifTrue: [ - Halt signal - ].! Item was added: + ----- Method: Object>>haltOnceIf: (in category 'debugging') ----- + haltOnceIf: aCondition + "Check aCondition and halt, unless we have already done it once. See #meetsHaltCondition:." + + self haltOnceEnabled ifFalse: [^ self]. + ^ (self meetsHaltCondition: aCondition) + ifTrue: [ + self clearHaltOnce; halt].! Item was added: + ----- Method: Object>>meetsHaltCondition: (in category 'debugging') ----- + meetsHaltCondition: aCondition + "If the Block has one arg, the receiver is bound to that. + If the condition is a selector, we look up in the callchain. Halt if any method's selector equals selector." + + aCondition isSymbol ifTrue: [ | ctxt | + "only halt if a method with selector symbol is in callchain" + ctxt := thisContext. + [(ctxt := ctxt sender) isNil] whileFalse: [ + (ctxt selector = aCondition) ifTrue: [^ true] ]. + ^ false ]. + ^ aCondition isBlock + ifTrue: [aCondition cull: self] + ifFalse: [aCondition value]!

2 1

[Sounds] How to turn off reverb
by Thiede, Christoph 20 Jul '22

20 Jul '22

Hi all, I never have dealt with the Sound system in Squeak before so here is a newbie question from my side: How can I turn off the reverb which you hear every time you play an FM sound? Take this example: AbstractSound dial: '#'. Either my speakers are broken or there is a reverb that is hidden somewhere in the implementation of FMSound. :-) I can also reproduce this when creating an FMSound manually without defining any envelopes. I also took a look at the ingenious Speech-TTS package from Squeak 3 and could hear a reverb there, too. Is this a bug? Is this a - maybe unfortunate - default setting? How can I turn off this? Thanks in advance! :-) Best, Christoph

8 13

The Inbox: ST80-mt.265.mcz
by commits＠source.squeak.org 08 Jul '22

08 Jul '22

A new version of ST80 was added to project The Inbox: http://source.squeak.org/inbox/ST80-mt.265.mcz ==================== Summary ==================== Name: ST80-mt.265 Author: mt Time: 9 March 2021, 1:33:39.525921 pm UUID: 1b02e796-d790-b34d-9f4f-dd406f43e130 Ancestors: ST80-mt.264 Free the names Path, Arc, Circle, Line, Spline to be used in a prospective Math package. =============== Diff against ST80-mt.264 =============== Item was removed: - Path subclass: #Arc - instanceVariableNames: 'quadrant radius center' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Arc commentStamp: '<historical>' prior: 0! - Arcs are an unusual implementation of splines due to Ted Kaehler. Imagine two lines that meet at a corner. Now imagine two moving points; one moves from the corner to the end on one line, the other moves from the end of the other line in to the corner. Now imagine a series of lines drawn between those moving points at each step along the way (they form a sort of spider web pattern). By connecting segments of the intersecting lines, a smooth curve is achieved that is tangent to both of the original lines. Voila.! Item was removed: - ----- Method: Arc class>>example (in category 'examples') ----- - example - "Click the button somewhere on the screen. The designated point will - be the center of an Arc with radius 50 in the 4th quadrant." - - | anArc aForm | - aForm := Form extent: 1 @ 30. "make a long thin Form for display" - aForm fillBlack. "turn it black" - anArc := Arc new. - anArc form: aForm. "set the form for display" - anArc radius: 50.0. - anArc center: Sensor waitButton. - anArc quadrant: 4. - anArc displayOn: Display. - Sensor waitButton - - "Arc example"! Item was removed: - ----- Method: Arc>>center (in category 'accessing') ----- - center - "Answer the point at the center of the receiver." - - ^center! Item was removed: - ----- Method: Arc>>center: (in category 'accessing') ----- - center: aPoint - "Set aPoint to be the receiver's center." - - center := aPoint! Item was removed: - ----- Method: Arc>>center:radius: (in category 'accessing') ----- - center: aPoint radius: anInteger - "The receiver is defined by a point at the center and a radius. The - quadrant is not reset." - - center := aPoint. - radius := anInteger! Item was removed: - ----- Method: Arc>>center:radius:quadrant: (in category 'accessing') ----- - center: aPoint radius: anInteger quadrant: section - "Set the receiver's quadrant to be the argument, section. The size of the - receiver is defined by the center and its radius." - - center := aPoint. - radius := anInteger. - quadrant := section! Item was removed: - ----- Method: Arc>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - | aRectangle aPoint | - aRectangle := center - radius + form offset extent: form extent + (radius * 2) asPoint. - aPoint := center + form extent. - quadrant = 1 ifTrue: [^ aRectangle encompass: center x @ aPoint y]. - quadrant = 2 ifTrue: [^ aRectangle encompass: aPoint x @ aPoint y]. - quadrant = 3 ifTrue: [^ aRectangle encompass: aPoint x @ center y]. - quadrant = 4 ifTrue: [^ aRectangle encompass: center x @ center y]! Item was removed: - ----- Method: Arc>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - - | nSegments line angle sin cos xn yn | - nSegments := 12.0. - line := Line new. - line form: self form. - angle := (90.0 / nSegments) degreesToRadians. - sin := angle sin. - cos := angle cos. - quadrant = 1 - ifTrue: - [xn := radius asFloat. - yn := 0.0]. - quadrant = 2 - ifTrue: - [xn := 0.0. - yn := 0.0 - radius asFloat]. - quadrant = 3 - ifTrue: - [xn := 0.0 - radius asFloat. - yn := 0.0]. - quadrant = 4 - ifTrue: - [xn := 0.0. - yn := radius asFloat]. - nSegments asInteger - timesRepeat: - [ | xn1 yn1 | - xn1 := xn * cos + (yn * sin). - yn1 := yn * cos - (xn * sin). - line beginPoint: center + (xn asInteger @ yn asInteger). - line endPoint: center + (xn1 asInteger @ yn1 asInteger). - line - displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm. - xn := xn1. - yn := yn1]! Item was removed: - ----- Method: Arc>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - | newArc tempCenter | - newArc := Arc new. - tempCenter := aTransformation applyTo: self center. - newArc center: tempCenter x asInteger @ tempCenter y asInteger. - newArc quadrant: self quadrant. - newArc radius: (self radius * aTransformation scale x) asInteger. - newArc form: self form. - newArc - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: Arc>>quadrant (in category 'accessing') ----- - quadrant - "Answer the part of the circle represented by the receiver." - ^quadrant! Item was removed: - ----- Method: Arc>>quadrant: (in category 'accessing') ----- - quadrant: section - "Set the part of the circle represented by the receiver to be the argument, - section." - - quadrant := section! Item was removed: - ----- Method: Arc>>radius (in category 'accessing') ----- - radius - "Answer the receiver's radius." - - ^radius! Item was removed: - ----- Method: Arc>>radius: (in category 'accessing') ----- - radius: anInteger - "Set the receiver's radius to be the argument, anInteger." - - radius := anInteger! Item was removed: - Arc subclass: #Circle - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Circle commentStamp: '<historical>' prior: 0! - I represent a full circle. I am made from four Arcs.! Item was removed: - ----- Method: Circle class>>exampleOne (in category 'examples') ----- - exampleOne - "Click any button somewhere on the screen. The point will be the center - of the circcle of radius 150." - - | aCircle aForm | - aForm := Form extent: 1@30. - aForm fillBlack. - aCircle := Circle new. - aCircle form: aForm. - aCircle radius: 150. - aCircle center: Sensor waitButton. - aCircle displayOn: Display - - "Circle exampleOne"! Item was removed: - ----- Method: Circle class>>exampleTwo (in category 'examples') ----- - exampleTwo - "Designate a rectangular area that should be used as the brush for - displaying the circle. Click any button at a point on the screen which - will be the center location for the circle. The curve will be displayed - with a long black form." - - | aCircle aForm | - aForm := Form fromUser. - aCircle := Circle new. - aCircle form: aForm. - aCircle radius: 150. - aCircle center: Sensor waitButton. - aCircle displayOn: Display at: 0 @ 0 rule: Form reverse - - "Circle exampleTwo"! Item was removed: - ----- Method: Circle>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - - ^center - radius + form offset extent: form extent + (radius * 2) asPoint! Item was removed: - ----- Method: Circle>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - - 1 to: 4 do: - [:i | - super quadrant: i. - super displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: Circle>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - 1 to: 4 do: - [:i | - super quadrant: i. - super displayOn: aDisplayMedium - transformation: aTransformation - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - Path subclass: #CurveFitter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !CurveFitter commentStamp: '<historical>' prior: 0! - I represent a conic section determined by three points p1, p2 and p3. I interpolate p1 and p3 and am tangent to line p1, p2 at p1 and line p3, p2 at p3.! Item was removed: - ----- Method: CurveFitter class>>example (in category 'examples') ----- - example - "Designate three locations on the screen by clicking any button. The - curve determined by the points will be displayed with a long black form." - - | aCurveFitter aForm | - aForm := Form extent: 1@30. "make a long thin Form for display " - aForm fillBlack. "turn it black" - aCurveFitter := CurveFitter new. - aCurveFitter form: aForm. "set the form for display" - "collect three Points and show them on the dispaly" - aCurveFitter firstPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aCurveFitter firstPoint. - aCurveFitter secondPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aCurveFitter secondPoint. - aCurveFitter thirdPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aCurveFitter thirdPoint. - - aCurveFitter displayOn: Display "display the CurveFitter" - - "CurveFitter example"! Item was removed: - ----- Method: CurveFitter class>>new (in category 'instance creation') ----- - new - - | newSelf | - newSelf := super new: 3. - newSelf add: 0@0. - newSelf add: 0@0. - newSelf add: 0@0. - ^newSelf! Item was removed: - ----- Method: CurveFitter>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - - | pa pb k s p1 p2 p3 line | - line := Line new. - line form: self form. - collectionOfPoints size < 3 ifTrue: [self error: 'Curve must have three points']. - p1 := self firstPoint. - p2 := self secondPoint. - p3 := self thirdPoint. - s := Path new. - s add: p1. - pa := p2 - p1. - pb := p3 - p2. - k := 5 max: pa x abs + pa y abs + pb x abs + pb y abs // 20. - "k is a guess as to how many line segments to use to approximate - the curve." - 1 to: k do: - [:i | - s add: pa * i // k + p1 * (k - i) + (pb * (i - 1) // k + p2 * (i - 1)) // (k - 1)]. - s add: p3. - 1 to: s size - 1 do: - [:i | - line beginPoint: (s at: i). - line endPoint: (s at: i + 1). - line displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: CurveFitter>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - | transformedPath newCurveFitter | - transformedPath := aTransformation applyTo: self. - newCurveFitter := CurveFitter new. - newCurveFitter firstPoint: transformedPath firstPoint. - newCurveFitter secondPoint: transformedPath secondPoint. - newCurveFitter thirdPoint: transformedPath thirdPoint. - newCurveFitter form: self form. - newCurveFitter - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was added: + DisplayPath subclass: #DisplayArc + instanceVariableNames: 'quadrant radius center' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplayArc commentStamp: '<historical>' prior: 0! + Arcs are an unusual implementation of splines due to Ted Kaehler. Imagine two lines that meet at a corner. Now imagine two moving points; one moves from the corner to the end on one line, the other moves from the end of the other line in to the corner. Now imagine a series of lines drawn between those moving points at each step along the way (they form a sort of spider web pattern). By connecting segments of the intersecting lines, a smooth curve is achieved that is tangent to both of the original lines. Voila.! Item was added: + ----- Method: DisplayArc class>>example (in category 'examples') ----- + example + "Click the button somewhere on the screen. The designated point will + be the center of an DisplayArc with radius 50 in the 4th quadrant." + + | anDisplayArc aForm | + aForm := Form extent: 1 @ 30. "make a long thin Form for display" + aForm fillBlack. "turn it black" + anDisplayArc := DisplayArc new. + anDisplayArc form: aForm. "set the form for display" + anDisplayArc radius: 50.0. + anDisplayArc center: Sensor waitButton. + anDisplayArc quadrant: 4. + anDisplayArc displayOn: Display. + Sensor waitButton + + "DisplayArc example"! Item was added: + ----- Method: DisplayArc>>center (in category 'accessing') ----- + center + "Answer the point at the center of the receiver." + + ^center! Item was added: + ----- Method: DisplayArc>>center: (in category 'accessing') ----- + center: aPoint + "Set aPoint to be the receiver's center." + + center := aPoint! Item was added: + ----- Method: DisplayArc>>center:radius: (in category 'accessing') ----- + center: aPoint radius: anInteger + "The receiver is defined by a point at the center and a radius. The + quadrant is not reset." + + center := aPoint. + radius := anInteger! Item was added: + ----- Method: DisplayArc>>center:radius:quadrant: (in category 'accessing') ----- + center: aPoint radius: anInteger quadrant: section + "Set the receiver's quadrant to be the argument, section. The size of the + receiver is defined by the center and its radius." + + center := aPoint. + radius := anInteger. + quadrant := section! Item was added: + ----- Method: DisplayArc>>computeBoundingBox (in category 'display box access') ----- + computeBoundingBox + | aRectangle aPoint | + aRectangle := center - radius + form offset extent: form extent + (radius * 2) asPoint. + aPoint := center + form extent. + quadrant = 1 ifTrue: [^ aRectangle encompass: center x @ aPoint y]. + quadrant = 2 ifTrue: [^ aRectangle encompass: aPoint x @ aPoint y]. + quadrant = 3 ifTrue: [^ aRectangle encompass: aPoint x @ center y]. + quadrant = 4 ifTrue: [^ aRectangle encompass: center x @ center y]! Item was added: + ----- Method: DisplayArc>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm + + | nSegments line angle sin cos xn yn | + nSegments := 12.0. + line := DisplayLine new. + line form: self form. + angle := (90.0 / nSegments) degreesToRadians. + sin := angle sin. + cos := angle cos. + quadrant = 1 + ifTrue: + [xn := radius asFloat. + yn := 0.0]. + quadrant = 2 + ifTrue: + [xn := 0.0. + yn := 0.0 - radius asFloat]. + quadrant = 3 + ifTrue: + [xn := 0.0 - radius asFloat. + yn := 0.0]. + quadrant = 4 + ifTrue: + [xn := 0.0. + yn := radius asFloat]. + nSegments asInteger + timesRepeat: + [ | xn1 yn1 | + xn1 := xn * cos + (yn * sin). + yn1 := yn * cos - (xn * sin). + line beginPoint: center + (xn asInteger @ yn asInteger). + line endPoint: center + (xn1 asInteger @ yn1 asInteger). + line + displayOn: aDisplayMedium + at: aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm. + xn := xn1. + yn := yn1]! Item was added: + ----- Method: DisplayArc>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm + + | newDisplayArc tempCenter | + newDisplayArc := DisplayArc new. + tempCenter := aTransformation applyTo: self center. + newDisplayArc center: tempCenter x asInteger @ tempCenter y asInteger. + newDisplayArc quadrant: self quadrant. + newDisplayArc radius: (self radius * aTransformation scale x) asInteger. + newDisplayArc form: self form. + newDisplayArc + displayOn: aDisplayMedium + at: 0 @ 0 + clippingBox: clipRect + rule: anInteger + fillColor: aForm! Item was added: + ----- Method: DisplayArc>>quadrant (in category 'accessing') ----- + quadrant + "Answer the part of the circle represented by the receiver." + ^quadrant! Item was added: + ----- Method: DisplayArc>>quadrant: (in category 'accessing') ----- + quadrant: section + "Set the part of the circle represented by the receiver to be the argument, + section." + + quadrant := section! Item was added: + ----- Method: DisplayArc>>radius (in category 'accessing') ----- + radius + "Answer the receiver's radius." + + ^radius! Item was added: + ----- Method: DisplayArc>>radius: (in category 'accessing') ----- + radius: anInteger + "Set the receiver's radius to be the argument, anInteger." + + radius := anInteger! Item was added: + DisplayArc subclass: #DisplayCircle + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplayCircle commentStamp: '<historical>' prior: 0! + I represent a full circle. I am made from four Arcs.! Item was added: + ----- Method: DisplayCircle class>>exampleOne (in category 'examples') ----- + exampleOne + "Click any button somewhere on the screen. The point will be the center + of the circcle of radius 150." + + | aDisplayCircle aForm | + aForm := Form extent: 1@30. + aForm fillBlack. + aDisplayCircle := DisplayCircle new. + aDisplayCircle form: aForm. + aDisplayCircle radius: 150. + aDisplayCircle center: Sensor waitButton. + aDisplayCircle displayOn: Display + + "DisplayCircle exampleOne"! Item was added: + ----- Method: DisplayCircle class>>exampleTwo (in category 'examples') ----- + exampleTwo + "Designate a rectangular area that should be used as the brush for + displaying the circle. Click any button at a point on the screen which + will be the center location for the circle. The curve will be displayed + with a long black form." + + | aDisplayCircle aForm | + aForm := Form fromUser. + aDisplayCircle := DisplayCircle new. + aDisplayCircle form: aForm. + aDisplayCircle radius: 150. + aDisplayCircle center: Sensor waitButton. + aDisplayCircle displayOn: Display at: 0 @ 0 rule: Form reverse + + "DisplayCircle exampleTwo"! Item was added: + ----- Method: DisplayCircle>>computeBoundingBox (in category 'display box access') ----- + computeBoundingBox + + ^center - radius + form offset extent: form extent + (radius * 2) asPoint! Item was added: + ----- Method: DisplayCircle>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm + + 1 to: 4 do: + [:i | + super quadrant: i. + super displayOn: aDisplayMedium + at: aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm]! Item was added: + ----- Method: DisplayCircle>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm + + 1 to: 4 do: + [:i | + super quadrant: i. + super displayOn: aDisplayMedium + transformation: aTransformation + clippingBox: clipRect + rule: anInteger + fillColor: aForm]! Item was added: + DisplayPath subclass: #DisplayCurveFitter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplayCurveFitter commentStamp: '<historical>' prior: 0! + I represent a conic section determined by three points p1, p2 and p3. I interpolate p1 and p3 and am tangent to line p1, p2 at p1 and line p3, p2 at p3.! Item was added: + ----- Method: DisplayCurveFitter class>>example (in category 'examples') ----- + example + "Designate three locations on the screen by clicking any button. The + curve determined by the points will be displayed with a long black form." + + | aDisplayCurveFitter aForm | + aForm := Form extent: 1@30. "make a long thin Form for display " + aForm fillBlack. "turn it black" + aDisplayCurveFitter := DisplayCurveFitter new. + aDisplayCurveFitter form: aForm. "set the form for display" + "collect three Points and show them on the dispaly" + aDisplayCurveFitter firstPoint: Sensor waitButton. Sensor waitNoButton. + aForm displayOn: Display at: aDisplayCurveFitter firstPoint. + aDisplayCurveFitter secondPoint: Sensor waitButton. Sensor waitNoButton. + aForm displayOn: Display at: aDisplayCurveFitter secondPoint. + aDisplayCurveFitter thirdPoint: Sensor waitButton. Sensor waitNoButton. + aForm displayOn: Display at: aDisplayCurveFitter thirdPoint. + + aDisplayCurveFitter displayOn: Display "display the DisplayCurveFitter" + + "DisplayCurveFitter example"! Item was added: + ----- Method: DisplayCurveFitter class>>new (in category 'instance creation') ----- + new + + | newSelf | + newSelf := super new: 3. + newSelf add: 0@0. + newSelf add: 0@0. + newSelf add: 0@0. + ^newSelf! Item was added: + ----- Method: DisplayCurveFitter>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm + + | pa pb k s p1 p2 p3 line | + line := DisplayLine new. + line form: self form. + collectionOfPoints size < 3 ifTrue: [self error: 'Curve must have three points']. + p1 := self firstPoint. + p2 := self secondPoint. + p3 := self thirdPoint. + s := DisplayPath new. + s add: p1. + pa := p2 - p1. + pb := p3 - p2. + k := 5 max: pa x abs + pa y abs + pb x abs + pb y abs // 20. + "k is a guess as to how many line segments to use to approximate + the curve." + 1 to: k do: + [:i | + s add: pa * i // k + p1 * (k - i) + (pb * (i - 1) // k + p2 * (i - 1)) // (k - 1)]. + s add: p3. + 1 to: s size - 1 do: + [:i | + line beginPoint: (s at: i). + line endPoint: (s at: i + 1). + line displayOn: aDisplayMedium + at: aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm]! Item was added: + ----- Method: DisplayCurveFitter>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm + + | transformedPath newDisplayCurveFitter | + transformedPath := aTransformation applyTo: self. + newDisplayCurveFitter := DisplayCurveFitter new. + newDisplayCurveFitter firstPoint: transformedPath firstPoint. + newDisplayCurveFitter secondPoint: transformedPath secondPoint. + newDisplayCurveFitter thirdPoint: transformedPath thirdPoint. + newDisplayCurveFitter form: self form. + newDisplayCurveFitter + displayOn: aDisplayMedium + at: 0 @ 0 + clippingBox: clipRect + rule: anInteger + fillColor: aForm! Item was added: + DisplayPath subclass: #DisplayLine + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplayLine commentStamp: '<historical>' prior: 0! + I represent the line segment specified by two points.! Item was added: + ----- Method: DisplayLine class>>example (in category 'examples') ----- + example + "Designate two places on the screen by clicking any mouse button. A + straight path with a square black form will be displayed connecting the + two selected points." + + | aDisplayLine aForm | + aForm := Form extent: 20@20. "make a form one quarter of inch square" + aForm fillBlack. "turn it black" + aDisplayLine := DisplayLine new. + aDisplayLine form: aForm. "use the black form for display" + aDisplayLine beginPoint: Sensor waitButton. Sensor waitNoButton. + aForm displayOn: Display at: aDisplayLine beginPoint. + aDisplayLine endPoint: Sensor waitButton. + aDisplayLine displayOn: Display. "display the line" + + "DisplayLine example"! Item was added: + ----- Method: DisplayLine class>>from:to:withForm: (in category 'instance creation') ----- + from: beginPoint to: endPoint withForm: aForm + "Answer an instance of me with end points begingPoint and endPoint; + the source form for displaying the line is aForm." + + | newSelf | + newSelf := super new: 2. + newSelf add: beginPoint. + newSelf add: endPoint. + newSelf form: aForm. + ^newSelf! Item was added: + ----- Method: DisplayLine class>>new (in category 'instance creation') ----- + new + + | newSelf | + newSelf := super new: 2. + newSelf add: 0@0. + newSelf add: 0@0. + ^newSelf! Item was added: + ----- Method: DisplayLine>>beginPoint (in category 'accessing') ----- + beginPoint + "Answer the first end point of the receiver." + + ^self first! Item was added: + ----- Method: DisplayLine>>beginPoint: (in category 'accessing') ----- + beginPoint: aPoint + "Set the first end point of the receiver to be the argument, aPoint. + Answer aPoint." + + self at: 1 put: aPoint. + ^aPoint! Item was added: + ----- Method: DisplayLine>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm + "The form associated with this Path will be displayed, according + to one of the sixteen functions of two logical variables (rule), at + each point on the Line. Also the source form will be first anded + with aForm as a mask. Does not effect the state of the Path." + + collectionOfPoints size < 2 ifTrue: [self error: 'a line must have two points']. + aDisplayMedium + drawLine: self form + from: self beginPoint + aPoint + to: self endPoint + aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm! Item was added: + ----- Method: DisplayLine>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm + + | newPath newDisplayLine | + newPath := aTransformation applyTo: self. + newDisplayLine := DisplayLine new. + newDisplayLine beginPoint: newPath firstPoint. + newDisplayLine endPoint: newPath secondPoint. + newDisplayLine form: self form. + newDisplayLine + displayOn: aDisplayMedium + at: 0 @ 0 + clippingBox: clipRect + rule: anInteger + fillColor: aForm! Item was added: + ----- Method: DisplayLine>>displayOnPort:at: (in category 'displaying') ----- + displayOnPort: aPort at: aPoint + aPort sourceForm: self form; combinationRule: Form under; fillColor: nil. + aPort drawFrom: collectionOfPoints first + aPoint + to: collectionOfPoints last + aPoint! Item was added: + ----- Method: DisplayLine>>endPoint (in category 'accessing') ----- + endPoint + "Answer the last end point of the receiver." + + ^self last! Item was added: + ----- Method: DisplayLine>>endPoint: (in category 'accessing') ----- + endPoint: aPoint + "Set the first end point of the receiver to be the argument, aPoint. + Answer aPoint." + + self at: 2 put: aPoint. + ^aPoint! Item was added: + DisplayPath subclass: #DisplayLinearFit + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplayLinearFit commentStamp: '<historical>' prior: 0! + I represent a piece-wise linear approximation to a set of points in the plane.! Item was added: + ----- Method: DisplayLinearFit class>>example (in category 'examples') ----- + example + "Select points on a Path using the red button. Terminate by selecting + any other button. Creates a Path from the points and displays it as a + piece-wise linear approximation." + + | aDisplayLinearFit aForm flag | + aDisplayLinearFit := DisplayLinearFit new. + aForm := Form extent: 1 @ 40. + aForm fillBlack. + aDisplayLinearFit form: aForm. + flag := true. + [flag] whileTrue: + [Sensor waitButton. + Sensor redButtonPressed + ifTrue: [aDisplayLinearFit add: Sensor waitButton. Sensor waitNoButton. + aForm displayOn: Display at: aDisplayLinearFit last] + ifFalse: [flag:=false]]. + aDisplayLinearFit displayOn: Display + + "DisplayLinearFit example"! Item was added: + ----- Method: DisplayLinearFit>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger + fillColor: aForm + + | line | + line := DisplayLine new. + line form: self form. + 1 to: self size - 1 do: + [:i | + line beginPoint: (self at: i). + line endPoint: (self at: i + 1). + line displayOn: aDisplayMedium + at: aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm]! Item was added: + ----- Method: DisplayLinearFit>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: aTransformation clippingBox: + clipRect rule: anInteger fillColor: aForm + + | transformedPath | + "get the scaled and translated Path." + transformedPath := aTransformation applyTo: self. + transformedPath + displayOn: aDisplayMedium + at: 0 @ 0 + clippingBox: clipRect + rule: anInteger + fillColor: aForm! Item was added: + DisplayObject subclass: #DisplayPath + instanceVariableNames: 'form collectionOfPoints' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplayPath commentStamp: '<historical>' prior: 0! + I am the abstract superclass of the Graphic spatial primitives. I represent an ordered sequence of Points. Spatial primitives are used to generate "trajectories" such as lines and circles.! Item was added: + ----- Method: DisplayPath class>>example (in category 'examples') ----- + example + "Creates a DisplayPath from mousePoints and displays it several ways on the display screen. Messes up the display. For learning about class DisplayPath, just select the code below and execute it to create a path and see it redisplayed in another place on the screen. Each path displays using a different form. A path is indicated by pressing the red mouse button in a sequence; press any other mouse button to terminate. " + + | aDisplayPath aForm pl fl flag | + aForm := Form extent: 2 @ 40. "creates a form one inch long" + aForm fillBlack. "turns it black" + aDisplayPath := DisplayPath new. + aDisplayPath form: aForm. "use the long black form for displaying" + flag := true. + [flag] + whileTrue: + [Sensor waitButton. + Sensor redButtonPressed + ifTrue: + [aDisplayPath add: Sensor waitButton. + Sensor waitNoButton. + aForm displayOn: Display at: aDisplayPath last] + ifFalse: [flag := false]]. + Display fillWhite. + aDisplayPath displayOn: Display. "the original path" + pl := aDisplayPath translateBy: 0 @ 100. + fl := Form extent: 40 @ 40. + fl fillGray. + pl form: fl. + pl displayOn: Display. "the translated path" + Sensor waitNoButton + + "DisplayPath example"! Item was added: + ----- Method: DisplayPath class>>new (in category 'instance creation') ----- + new + + ^self basicNew initializeCollectionOfPoints! Item was added: + ----- Method: DisplayPath class>>new: (in category 'instance creation') ----- + new: anInteger + + ^self basicNew initializeCollectionOfPoints: anInteger! Item was added: + ----- Method: DisplayPath>>add: (in category 'adding') ----- + add: aPoint + "Include aPoint as one of the receiver's elements." + + ^collectionOfPoints add: aPoint! Item was added: + ----- Method: DisplayPath>>at: (in category 'accessing') ----- + at: index + "Answer the point on the receiver's path at position index." + + ^collectionOfPoints at: index! Item was added: + ----- Method: DisplayPath>>at:put: (in category 'accessing') ----- + at: index put: aPoint + "Store the argument, aPoint, as the point on the receiver's path at position + index." + + ^collectionOfPoints at: index put: aPoint! Item was added: + ----- Method: DisplayPath>>collect: (in category 'enumerating') ----- + collect: aBlock + "Evaluate aBlock with each of the receiver's elements as the argument. + Collect the resulting values into a path that is like the receiver. Answer + the new path." + + | newCollection | + newCollection := collectionOfPoints collect: aBlock. + newCollection form: self form. + ^newCollection! Item was added: + ----- Method: DisplayPath>>computeBoundingBox (in category 'display box access') ----- + computeBoundingBox + "Refer to the comment in DisplayObject|computeBoundingBox." + + | box | + box := Rectangle origin: (self at: 1) extent: 0 @ 0. + collectionOfPoints do: + [:aPoint | box swallow: (Rectangle origin: aPoint extent: 0 @ 0)]. + ^box! Item was added: + ----- Method: DisplayPath>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm + "Display this Path--offset by aPoint, clipped by clipRect and the form + associated with this Path will be displayedr according to one of the sixteen + functions of two logical variables (rule). Also the source form will be first + anded with aForm as a mask. Does not effect the state of the Path" + + collectionOfPoints do: + [:element | + self form + displayOn: aDisplayMedium + at: element + aDisplayPoint + clippingBox: clipRectangle + rule: ruleInteger + fillColor: aForm]! Item was added: + ----- Method: DisplayPath>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger fillColor: aForm + "Displays this path, translated and scaled by aTransformation. Get the + scaled and translated DisplayPath." + + | newDisplayPath transformedDisplayPath | + transformedDisplayPath := displayTransformation applyTo: self. + newDisplayPath := DisplayPath new. + transformedDisplayPath do: [:point | newDisplayPath add: point]. + newDisplayPath form: self form. + newDisplayPath + displayOn: aDisplayMedium + at: 0 @ 0 + clippingBox: clipRectangle + rule: ruleInteger + fillColor: aForm! Item was added: + ----- Method: DisplayPath>>first (in category 'accessing') ----- + first + "Answer the first point on the receiver's path; included to correspond to + OrderedCollection protocol." + + ^collectionOfPoints first! Item was added: + ----- Method: DisplayPath>>firstPoint (in category 'accessing') ----- + firstPoint + "Answer the first point on the receiver's path." + + ^collectionOfPoints first! Item was added: + ----- Method: DisplayPath>>firstPoint: (in category 'accessing') ----- + firstPoint: aPoint + "Replace the first element of the receiver with the new value aPoint. + Answer the argument aPoint." + + collectionOfPoints at: 1 put: aPoint. + ^aPoint! Item was added: + ----- Method: DisplayPath>>form (in category 'accessing') ----- + form + "Answer the receiver's form, or, if form is nil, then answer a 1 x 1 black + form (a black dot)." + + | aForm | + form == nil + ifTrue: + [aForm := Form extent: 1 @ 1. + aForm fillBlack. + ^aForm] + ifFalse: + [^form]! Item was added: + ----- Method: DisplayPath>>form: (in category 'accessing') ----- + form: aForm + "Make the argument, aForm, be the receiver's form." + + form := aForm! Item was added: + ----- Method: DisplayPath>>initializeCollectionOfPoints (in category 'private') ----- + initializeCollectionOfPoints + + collectionOfPoints := OrderedCollection new! Item was added: + ----- Method: DisplayPath>>initializeCollectionOfPoints: (in category 'private') ----- + initializeCollectionOfPoints: anInteger + + collectionOfPoints := OrderedCollection new: anInteger! Item was added: + ----- Method: DisplayPath>>isEmpty (in category 'testing') ----- + isEmpty + + ^collectionOfPoints isEmpty! Item was added: + ----- Method: DisplayPath>>last (in category 'accessing') ----- + last + "Answer the last point on the receiver's path; included to correspond to + OrderedCollection protocol." + + ^collectionOfPoints last! Item was added: + ----- Method: DisplayPath>>offset (in category 'accessing') ----- + offset + "There are basically two kinds of display objects in the system: those + that, when asked to transform themselves, create a new object; and those + that side effect themselves by maintaining a record of the transformation + request (typically an offset). Path, like Rectangle and Point, is a display + object of the first kind." + + self shouldNotImplement! Item was added: + ----- Method: DisplayPath>>removeAllSuchThat: (in category 'removing') ----- + removeAllSuchThat: aBlock + "Evaluate aBlock for each element of the receiver. + Remove each element for which aBlock evaluates to true." + + collectionOfPoints removeAllSuchThat: aBlock. + ! Item was added: + ----- Method: DisplayPath>>scaleBy: (in category 'transforming') ----- + scaleBy: aPoint + "Answers a new Path scaled by aPoint. Does not affect the current data in + this Path." + + | newPath | + newPath := self species new: self size. + newPath form: self form. + collectionOfPoints do: [:element | newPath add: (element scaleBy: aPoint)]. + ^newPath! Item was added: + ----- Method: DisplayPath>>secondPoint (in category 'accessing') ----- + secondPoint + "Answer the second element of the receiver." + + ^collectionOfPoints at: 2! Item was added: + ----- Method: DisplayPath>>secondPoint: (in category 'accessing') ----- + secondPoint: aPoint + "Replace the second element of the receiver with the new value aPoint. + Answer the argument aPoint." + + collectionOfPoints at: 2 put: aPoint. + ^aPoint! Item was added: + ----- Method: DisplayPath>>select: (in category 'enumerating') ----- + select: aBlock + "Evaluate aBlock with each of the receiver's elements as the argument. + Collect into a new path like the receiver only those elements for which + aBlock evaluates to true. Answer the new path." + + | newCollection | + newCollection := collectionOfPoints select: aBlock. + newCollection form: self form. + ^newCollection! Item was added: + ----- Method: DisplayPath>>size (in category 'accessing') ----- + size + "Answer the length of the receiver." + + ^collectionOfPoints size! Item was added: + ----- Method: DisplayPath>>thirdPoint (in category 'accessing') ----- + thirdPoint + "Answer the third element of the receiver." + + ^collectionOfPoints at: 3! Item was added: + ----- Method: DisplayPath>>thirdPoint: (in category 'accessing') ----- + thirdPoint: aPoint + "Replace the third element of the receiver with the new value aPoint. + Answer the argument aPoint." + + collectionOfPoints at: 3 put: aPoint. + ^aPoint! Item was added: + ----- Method: DisplayPath>>translateBy: (in category 'transforming') ----- + translateBy: aPoint + "Answers a new Path whose elements are translated by aPoint. Does not + affect the elements of this Path." + + | newPath | + newPath := self species new: self size. + newPath form: self form. + collectionOfPoints do: [:element | newPath add: (element translateBy: aPoint)]. + ^newPath! Item was added: + DisplayPath subclass: #DisplaySpline + instanceVariableNames: 'coefficients' + classVariableNames: '' + poolDictionaries: '' + category: 'ST80-Paths'! + + !DisplaySpline commentStamp: '<historical>' prior: 0! + I represent a collection of Points through which a cubic spline curve is fitted.! Item was added: + ----- Method: DisplaySpline class>>example (in category 'examples') ----- + example + "Designate points on the Path by clicking the red button. Terminate by + pressing any other button. A curve will be displayed, through the + selected points, using a long black form." + + | splineCurve aForm flag| + aForm := Form extent: 2@2. + aForm fillBlack. + splineCurve := DisplaySpline new. + splineCurve form: aForm. + flag := true. + [flag] whileTrue: + [Sensor waitButton. + Sensor redButtonPressed + ifTrue: + [splineCurve add: Sensor waitButton. + Sensor waitNoButton. + aForm displayOn: Display at: splineCurve last] + ifFalse: [flag:=false]]. + splineCurve computeCurve. + splineCurve isEmpty + ifFalse: [splineCurve displayOn: Display. + Sensor waitNoButton]. + + "DisplaySpline example"! Item was added: + ----- Method: DisplaySpline>>coefficients (in category 'accessing') ----- + coefficients + "Answer an eight-element Array of Arrays each of which is the length + of the receiver. The first four arrays are the values, first, second and + third derivatives, respectively, for the parametric spline in x. The last + four elements are for y." + + ^coefficients! Item was added: + ----- Method: DisplaySpline>>computeCurve (in category 'displaying') ----- + computeCurve + "Compute an array for the coefficients." + + | length extras | + length := self size. + extras := 0. + coefficients := Array new: 8. + 1 to: 8 do: [:i | coefficients at: i put: (Array new: length + extras)]. + 1 to: 5 by: 4 do: + [:k | + 1 to: length do: + [:i | (coefficients at: k) + at: i put: (k = 1 + ifTrue: [(self at: i) x asFloat] + ifFalse: [(self at: i) y asFloat])]. + 1 to: extras do: [:i | (coefficients at: k) + at: length + i put: ((coefficients at: k) + at: i + 1)]. + self derivs: (coefficients at: k) + first: (coefficients at: k + 1) + second: (coefficients at: k + 2) + third: (coefficients at: k + 3)]. + extras > 0 + ifTrue: [1 to: 8 do: + [:i | + coefficients at: i put: ((coefficients at: i) + copyFrom: 2 to: length + 1)]]! Item was added: + ----- Method: DisplaySpline>>derivs:first:second:third: (in category 'private') ----- + derivs: a first: point1 second: point2 third: point3 + "Compute the first, second and third derivitives (in coefficients) from + the Points in this Path (coefficients at: 1 and coefficients at: 5)." + + | l v anArray | + l := a size. + l < 2 ifTrue: [^self]. + l > 2 + ifTrue: + [v := Array new: l. + v at: 1 put: 4.0. + anArray := Array new: l. + anArray at: 1 put: (6.0 * ((a at: 1) - ((a at: 2) * 2.0) + (a at: 3))). + 2 to: l - 2 do: + [:i | + v at: i put: (4.0 - (1.0 / (v at: (i - 1)))). + anArray + at: i + put: (6.0 * ((a at: i) - ((a at: (i + 1)) * 2.0) + (a at: (i + 2))) + - ((anArray at: (i - 1)) / (v at: (i - 1))))]. + point2 at: (l - 1) put: ((anArray at: (l - 2)) / (v at: (l - 2))). + l - 2 to: 2 by: 0-1 do: + [:i | + point2 + at: i + put: ((anArray at: (i - 1)) - (point2 at: (i + 1)) / (v at: (i - 1)))]]. + point2 at: 1 put: (point2 at: l put: 0.0). + 1 to: l - 1 do: + [:i | point1 + at: i + put: ((a at: (i + 1)) - (a at: i) - + ((point2 at: i) * 2.0 + (point2 at: (i + 1)) / 6.0)). + point3 at: i put: ((point2 at: (i + 1)) - (point2 at: i))]! Item was added: + ----- Method: DisplaySpline>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm + "Display the receiver, a spline curve, approximated by straight line + segments." + + | n line t x y x1 x2 x3 y1 y2 y3 | + collectionOfPoints size < 1 ifTrue: [self error: 'a spline must have at least one point']. + line := DisplayLine new. + line form: self form. + line beginPoint: + (x := (coefficients at: 1) at: 1) rounded @ (y := (coefficients at: 5) at: 1) rounded. + 1 to: (coefficients at: 1) size - 1 do: + [:i | + "taylor series coefficients" + x1 := (coefficients at: 2) at: i. + y1 := (coefficients at: 6) at: i. + x2 := ((coefficients at: 3) at: i) / 2.0. + y2 := ((coefficients at: 7) at: i) / 2.0. + x3 := ((coefficients at: 4) at: i) / 6.0. + y3 := ((coefficients at: 8) at: i) / 6.0. + "guess n" + n := 5 max: (x2 abs + y2 abs * 2.0 + ((coefficients at: 3) + at: i + 1) abs + ((coefficients at: 7) + at: i + 1) abs / 100.0) rounded. + 1 to: n - 1 do: + [:j | + t := j asFloat / n. + line endPoint: + (x3 * t + x2 * t + x1 * t + x) rounded + @ (y3 * t + y2 * t + y1 * t + y) rounded. + line + displayOn: aDisplayMedium + at: aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm. + line beginPoint: line endPoint]. + line beginPoint: + (x := (coefficients at: 1) at: i + 1) rounded + @ (y := (coefficients at: 5) at: i + 1) rounded. + line + displayOn: aDisplayMedium + at: aPoint + clippingBox: clipRect + rule: anInteger + fillColor: aForm]! Item was added: + ----- Method: DisplaySpline>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- + displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm + "Get the scaled and translated path of newKnots." + + | newKnots newDisplaySpline | + newKnots := aTransformation applyTo: self. + newDisplaySpline := DisplaySpline new. + newKnots do: [:knot | newDisplaySpline add: knot]. + newDisplaySpline form: self form. + newDisplaySpline + displayOn: aDisplayMedium + at: 0 @ 0 + clippingBox: clipRect + rule: anInteger + fillColor: aForm! Item was changed: ----- Method: FormEditor>>curve (in category 'editing tools') ----- curve "Conic-section specified by three points designated by: first point--press red button second point--release red button third point--click red button. The resultant curve on the display is displayed according to the current form and mode." | firstPoint secondPoint thirdPoint curve drawForm | "sensor noButtonPressed ifTrue: [^self]." firstPoint := self cursorPoint. secondPoint := self rubberBandFrom: firstPoint until: [sensor noButtonPressed]. thirdPoint := self rubberBandFrom: secondPoint until: [sensor redButtonPressed]. Display depth > 1 ifTrue: [self deleteRubberBandFrom: secondPoint to: thirdPoint. self deleteRubberBandFrom: firstPoint to: secondPoint]. + curve := DisplayCurveFitter new. - curve := CurveFitter new. curve firstPoint: firstPoint. curve secondPoint: secondPoint. curve thirdPoint: thirdPoint. drawForm := form asFormOfDepth: Display depth. Display depth > 1 ifTrue: [drawForm mapColor: Color white to: Color transparent; mapColor: Color black to: color]. curve form: drawForm. curve displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] ifFalse: [mode]) fillColor: (Display depth = 1 ifTrue: [color] ifFalse: [nil]). sensor waitNoButton. hasUnsavedChanges contents: true.! Item was changed: ----- Method: FormEditor>>deleteRubberBandFrom:to: (in category 'private') ----- deleteRubberBandFrom: startPoint to: endPoint + (DisplayLine from: startPoint to: endPoint withForm: form) - (Line from: startPoint to: endPoint withForm: form) displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: Form reverse fillColor: (Display depth = 1 ifTrue: [Color black] ifFalse: [Color gray]).! Item was changed: ----- Method: FormEditor>>line (in category 'editing tools') ----- line + "DisplayLine is specified by two points from the mouse: first point--press red - "Line is specified by two points from the mouse: first point--press red button; second point--release red button. The resultant line is displayed according to the current form and mode." | firstPoint endPoint drawForm | drawForm := form asFormOfDepth: Display depth. Display depth > 1 ifTrue: [drawForm mapColor: Color white to: Color transparent; mapColor: Color black to: color]. firstPoint := self cursorPoint. endPoint := self rubberBandFrom: firstPoint until: [sensor noButtonPressed]. endPoint isNil ifTrue: [^self]. Display depth > 1 ifTrue: [self deleteRubberBandFrom: firstPoint to: endPoint.]. + (DisplayLine from: firstPoint to: endPoint withForm: drawForm) - (Line from: firstPoint to: endPoint withForm: drawForm) displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: (Display depth > 1 ifTrue: [mode ~= Form erase ifTrue: [Form paint] ifFalse: [mode]] ifFalse: [mode]) fillColor: (Display depth = 1 ifTrue: [color] ifFalse: [nil]). hasUnsavedChanges contents: true.! Item was changed: ----- Method: FormEditor>>rubberBandFrom:until: (in category 'private') ----- rubberBandFrom: startPoint until: aBlock | endPoint previousEndPoint | previousEndPoint := startPoint. [aBlock value] whileFalse: [(endPoint := self cursorPoint) = previousEndPoint ifFalse: + [(DisplayLine from: startPoint to: previousEndPoint withForm: form) - [(Line from: startPoint to: previousEndPoint withForm: form) displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: Form reverse fillColor: Color gray. + (DisplayLine from: startPoint to: endPoint withForm: form) - (Line from: startPoint to: endPoint withForm: form) displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: Form reverse fillColor: Color gray. previousEndPoint := endPoint]]. + (DisplayLine from: startPoint to: previousEndPoint withForm: form) - (Line from: startPoint to: previousEndPoint withForm: form) displayOn: Display at: 0 @ 0 clippingBox: view insetDisplayBox rule: Form reverse fillColor: (Display depth = 1 ifTrue: [Color gray] ifFalse: [Color black]). ^endPoint! Item was changed: ----- Method: GraphicSymbolInstance class>>example (in category 'examples') ----- example "Simply evaluate the method and two GraphicSymbolInstances, each displaying a transformation of the same graphic symbol, will be presented on the screen. Clears the screen to white." | gate instance1 instance2 trans1 trans2 line arc f| Display fillWhite. "clear the Screen." f := Form extent: 2 @ 2. f fillBlack. gate:= GraphicSymbol new. "make a logic gate out of lines and arcs." + line:=DisplayLine new. line beginPoint: -20 @ -20. line endPoint: 0 @ -20. line form: f. - line:=Line new. line beginPoint: -20 @ -20. line endPoint: 0 @ -20. line form: f. gate add: line. + line:=DisplayLine new. line beginPoint: -20 @ 20. line endPoint: 0 @ 20. line form: f. - line:=Line new. line beginPoint: -20 @ 20. line endPoint: 0 @ 20. line form: f. gate add: line. + line:=DisplayLine new. line beginPoint: 0 @ -40. line endPoint: 0 @ 40. line form: f. - line:=Line new. line beginPoint: 0 @ -40. line endPoint: 0 @ 40. line form: f. gate add: line. + arc := DisplayArc new. arc center: 0 @ 0 radius: 40 quadrant: 1. - arc := Arc new. arc center: 0 @ 0 radius: 40 quadrant: 1. arc form: f. gate add: arc. + arc := DisplayArc new. arc center: 0 @ 0 radius: 40 quadrant: 4. - arc := Arc new. arc center: 0 @ 0 radius: 40 quadrant: 4. arc form: f. gate add: arc. "one instance at 1/2 scale." trans1:=WindowingTransformation identity. trans1:= trans1 scaleBy: 0.5 @ 0.5. trans1:= trans1 translateBy: 100 @ 100. "the other instance at 2 times scale" trans2:=WindowingTransformation identity. trans2:= trans2 scaleBy: 2.0 @ 2.0. trans2:= trans2 translateBy: 200 @ 200. instance1 := GraphicSymbolInstance new. instance1 transformation: trans1. instance1 graphicSymbol: gate. instance2 := GraphicSymbolInstance new. instance2 transformation: trans2. instance2 graphicSymbol: gate. "display both instances of the logic gate" instance1 displayOn: Display transformation: WindowingTransformation identity clippingBox: Display boundingBox rule: Form under fillColor: nil. instance2 displayOn: Display transformation: WindowingTransformation identity clippingBox: Display boundingBox rule: Form under fillColor: nil "GraphicSymbolInstance example"! Item was removed: - Path subclass: #Line - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Line commentStamp: '<historical>' prior: 0! - I represent the line segment specified by two points.! Item was removed: - ----- Method: Line class>>example (in category 'examples') ----- - example - "Designate two places on the screen by clicking any mouse button. A - straight path with a square black form will be displayed connecting the - two selected points." - - | aLine aForm | - aForm := Form extent: 20@20. "make a form one quarter of inch square" - aForm fillBlack. "turn it black" - aLine := Line new. - aLine form: aForm. "use the black form for display" - aLine beginPoint: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aLine beginPoint. - aLine endPoint: Sensor waitButton. - aLine displayOn: Display. "display the line" - - "Line example"! Item was removed: - ----- Method: Line class>>from:to:withForm: (in category 'instance creation') ----- - from: beginPoint to: endPoint withForm: aForm - "Answer an instance of me with end points begingPoint and endPoint; - the source form for displaying the line is aForm." - - | newSelf | - newSelf := super new: 2. - newSelf add: beginPoint. - newSelf add: endPoint. - newSelf form: aForm. - ^newSelf! Item was removed: - ----- Method: Line class>>new (in category 'instance creation') ----- - new - - | newSelf | - newSelf := super new: 2. - newSelf add: 0@0. - newSelf add: 0@0. - ^newSelf! Item was removed: - ----- Method: Line>>beginPoint (in category 'accessing') ----- - beginPoint - "Answer the first end point of the receiver." - - ^self first! Item was removed: - ----- Method: Line>>beginPoint: (in category 'accessing') ----- - beginPoint: aPoint - "Set the first end point of the receiver to be the argument, aPoint. - Answer aPoint." - - self at: 1 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Line>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - "The form associated with this Path will be displayed, according - to one of the sixteen functions of two logical variables (rule), at - each point on the Line. Also the source form will be first anded - with aForm as a mask. Does not effect the state of the Path." - - collectionOfPoints size < 2 ifTrue: [self error: 'a line must have two points']. - aDisplayMedium - drawLine: self form - from: self beginPoint + aPoint - to: self endPoint + aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: Line>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - - | newPath newLine | - newPath := aTransformation applyTo: self. - newLine := Line new. - newLine beginPoint: newPath firstPoint. - newLine endPoint: newPath secondPoint. - newLine form: self form. - newLine - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - ----- Method: Line>>displayOnPort:at: (in category 'displaying') ----- - displayOnPort: aPort at: aPoint - aPort sourceForm: self form; combinationRule: Form under; fillColor: nil. - aPort drawFrom: collectionOfPoints first + aPoint - to: collectionOfPoints last + aPoint! Item was removed: - ----- Method: Line>>endPoint (in category 'accessing') ----- - endPoint - "Answer the last end point of the receiver." - - ^self last! Item was removed: - ----- Method: Line>>endPoint: (in category 'accessing') ----- - endPoint: aPoint - "Set the first end point of the receiver to be the argument, aPoint. - Answer aPoint." - - self at: 2 put: aPoint. - ^aPoint! Item was removed: - Path subclass: #LinearFit - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !LinearFit commentStamp: '<historical>' prior: 0! - I represent a piece-wise linear approximation to a set of points in the plane.! Item was removed: - ----- Method: LinearFit class>>example (in category 'examples') ----- - example - "Select points on a Path using the red button. Terminate by selecting - any other button. Creates a Path from the points and displays it as a - piece-wise linear approximation." - - | aLinearFit aForm flag | - aLinearFit := LinearFit new. - aForm := Form extent: 1 @ 40. - aForm fillBlack. - aLinearFit form: aForm. - flag := true. - [flag] whileTrue: - [Sensor waitButton. - Sensor redButtonPressed - ifTrue: [aLinearFit add: Sensor waitButton. Sensor waitNoButton. - aForm displayOn: Display at: aLinearFit last] - ifFalse: [flag:=false]]. - aLinearFit displayOn: Display - - "LinearFit example"! Item was removed: - ----- Method: LinearFit>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger - fillColor: aForm - - | line | - line := Line new. - line form: self form. - 1 to: self size - 1 do: - [:i | - line beginPoint: (self at: i). - line endPoint: (self at: i + 1). - line displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: LinearFit>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: - clipRect rule: anInteger fillColor: aForm - - | transformedPath | - "get the scaled and translated Path." - transformedPath := aTransformation applyTo: self. - transformedPath - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm! Item was removed: - DisplayObject subclass: #Path - instanceVariableNames: 'form collectionOfPoints' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Path commentStamp: '<historical>' prior: 0! - I am the abstract superclass of the Graphic spatial primitives. I represent an ordered sequence of Points. Spatial primitives are used to generate "trajectories" such as lines and circles.! Item was removed: - ----- Method: Path class>>example (in category 'examples') ----- - example - "Creates a Path from mousePoints and displays it several ways on the display screen. Messes up the display. For learning about class Path, just select the code below and execute it to create a path and see it redisplayed in another place on the screen. Each path displays using a different form. A path is indicated by pressing the red mouse button in a sequence; press any other mouse button to terminate. " - - | aPath aForm pl fl flag | - aForm := Form extent: 2 @ 40. "creates a form one inch long" - aForm fillBlack. "turns it black" - aPath := Path new. - aPath form: aForm. "use the long black form for displaying" - flag := true. - [flag] - whileTrue: - [Sensor waitButton. - Sensor redButtonPressed - ifTrue: - [aPath add: Sensor waitButton. - Sensor waitNoButton. - aForm displayOn: Display at: aPath last] - ifFalse: [flag := false]]. - Display fillWhite. - aPath displayOn: Display. "the original path" - pl := aPath translateBy: 0 @ 100. - fl := Form extent: 40 @ 40. - fl fillGray. - pl form: fl. - pl displayOn: Display. "the translated path" - Sensor waitNoButton - - "Path example"! Item was removed: - ----- Method: Path class>>new (in category 'instance creation') ----- - new - - ^self basicNew initializeCollectionOfPoints! Item was removed: - ----- Method: Path class>>new: (in category 'instance creation') ----- - new: anInteger - - ^self basicNew initializeCollectionOfPoints: anInteger! Item was removed: - ----- Method: Path>>add: (in category 'adding') ----- - add: aPoint - "Include aPoint as one of the receiver's elements." - - ^collectionOfPoints add: aPoint! Item was removed: - ----- Method: Path>>at: (in category 'accessing') ----- - at: index - "Answer the point on the receiver's path at position index." - - ^collectionOfPoints at: index! Item was removed: - ----- Method: Path>>at:put: (in category 'accessing') ----- - at: index put: aPoint - "Store the argument, aPoint, as the point on the receiver's path at position - index." - - ^collectionOfPoints at: index put: aPoint! Item was removed: - ----- Method: Path>>collect: (in category 'enumerating') ----- - collect: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect the resulting values into a path that is like the receiver. Answer - the new path." - - | newCollection | - newCollection := collectionOfPoints collect: aBlock. - newCollection form: self form. - ^newCollection! Item was removed: - ----- Method: Path>>computeBoundingBox (in category 'display box access') ----- - computeBoundingBox - "Refer to the comment in DisplayObject|computeBoundingBox." - - | box | - box := Rectangle origin: (self at: 1) extent: 0 @ 0. - collectionOfPoints do: - [:aPoint | box swallow: (Rectangle origin: aPoint extent: 0 @ 0)]. - ^box! Item was removed: - ----- Method: Path>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger fillColor: aForm - "Display this Path--offset by aPoint, clipped by clipRect and the form - associated with this Path will be displayedr according to one of the sixteen - functions of two logical variables (rule). Also the source form will be first - anded with aForm as a mask. Does not effect the state of the Path" - - collectionOfPoints do: - [:element | - self form - displayOn: aDisplayMedium - at: element + aDisplayPoint - clippingBox: clipRectangle - rule: ruleInteger - fillColor: aForm]! Item was removed: - ----- Method: Path>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: displayTransformation clippingBox: clipRectangle rule: ruleInteger fillColor: aForm - "Displays this path, translated and scaled by aTransformation. Get the - scaled and translated Path." - - | newPath transformedPath | - transformedPath := displayTransformation applyTo: self. - newPath := Path new. - transformedPath do: [:point | newPath add: point]. - newPath form: self form. - newPath - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRectangle - rule: ruleInteger - fillColor: aForm! Item was removed: - ----- Method: Path>>first (in category 'accessing') ----- - first - "Answer the first point on the receiver's path; included to correspond to - OrderedCollection protocol." - - ^collectionOfPoints first! Item was removed: - ----- Method: Path>>firstPoint (in category 'accessing') ----- - firstPoint - "Answer the first point on the receiver's path." - - ^collectionOfPoints first! Item was removed: - ----- Method: Path>>firstPoint: (in category 'accessing') ----- - firstPoint: aPoint - "Replace the first element of the receiver with the new value aPoint. - Answer the argument aPoint." - - collectionOfPoints at: 1 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Path>>form (in category 'accessing') ----- - form - "Answer the receiver's form, or, if form is nil, then answer a 1 x 1 black - form (a black dot)." - - | aForm | - form == nil - ifTrue: - [aForm := Form extent: 1 @ 1. - aForm fillBlack. - ^aForm] - ifFalse: - [^form]! Item was removed: - ----- Method: Path>>form: (in category 'accessing') ----- - form: aForm - "Make the argument, aForm, be the receiver's form." - - form := aForm! Item was removed: - ----- Method: Path>>initializeCollectionOfPoints (in category 'private') ----- - initializeCollectionOfPoints - - collectionOfPoints := OrderedCollection new! Item was removed: - ----- Method: Path>>initializeCollectionOfPoints: (in category 'private') ----- - initializeCollectionOfPoints: anInteger - - collectionOfPoints := OrderedCollection new: anInteger! Item was removed: - ----- Method: Path>>isEmpty (in category 'testing') ----- - isEmpty - - ^collectionOfPoints isEmpty! Item was removed: - ----- Method: Path>>last (in category 'accessing') ----- - last - "Answer the last point on the receiver's path; included to correspond to - OrderedCollection protocol." - - ^collectionOfPoints last! Item was removed: - ----- Method: Path>>offset (in category 'accessing') ----- - offset - "There are basically two kinds of display objects in the system: those - that, when asked to transform themselves, create a new object; and those - that side effect themselves by maintaining a record of the transformation - request (typically an offset). Path, like Rectangle and Point, is a display - object of the first kind." - - self shouldNotImplement! Item was removed: - ----- Method: Path>>removeAllSuchThat: (in category 'removing') ----- - removeAllSuchThat: aBlock - "Evaluate aBlock for each element of the receiver. - Remove each element for which aBlock evaluates to true." - - collectionOfPoints removeAllSuchThat: aBlock. - ! Item was removed: - ----- Method: Path>>scaleBy: (in category 'transforming') ----- - scaleBy: aPoint - "Answers a new Path scaled by aPoint. Does not affect the current data in - this Path." - - | newPath | - newPath := self species new: self size. - newPath form: self form. - collectionOfPoints do: [:element | newPath add: (element scaleBy: aPoint)]. - ^newPath! Item was removed: - ----- Method: Path>>secondPoint (in category 'accessing') ----- - secondPoint - "Answer the second element of the receiver." - - ^collectionOfPoints at: 2! Item was removed: - ----- Method: Path>>secondPoint: (in category 'accessing') ----- - secondPoint: aPoint - "Replace the second element of the receiver with the new value aPoint. - Answer the argument aPoint." - - collectionOfPoints at: 2 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Path>>select: (in category 'enumerating') ----- - select: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect into a new path like the receiver only those elements for which - aBlock evaluates to true. Answer the new path." - - | newCollection | - newCollection := collectionOfPoints select: aBlock. - newCollection form: self form. - ^newCollection! Item was removed: - ----- Method: Path>>size (in category 'accessing') ----- - size - "Answer the length of the receiver." - - ^collectionOfPoints size! Item was removed: - ----- Method: Path>>thirdPoint (in category 'accessing') ----- - thirdPoint - "Answer the third element of the receiver." - - ^collectionOfPoints at: 3! Item was removed: - ----- Method: Path>>thirdPoint: (in category 'accessing') ----- - thirdPoint: aPoint - "Replace the third element of the receiver with the new value aPoint. - Answer the argument aPoint." - - collectionOfPoints at: 3 put: aPoint. - ^aPoint! Item was removed: - ----- Method: Path>>translateBy: (in category 'transforming') ----- - translateBy: aPoint - "Answers a new Path whose elements are translated by aPoint. Does not - affect the elements of this Path." - - | newPath | - newPath := self species new: self size. - newPath form: self form. - collectionOfPoints do: [:element | newPath add: (element translateBy: aPoint)]. - ^newPath! Item was removed: - Path subclass: #Spline - instanceVariableNames: 'coefficients' - classVariableNames: '' - poolDictionaries: '' - category: 'ST80-Paths'! - - !Spline commentStamp: '<historical>' prior: 0! - I represent a collection of Points through which a cubic spline curve is fitted.! Item was removed: - ----- Method: Spline class>>example (in category 'examples') ----- - example - "Designate points on the Path by clicking the red button. Terminate by - pressing any other button. A curve will be displayed, through the - selected points, using a long black form." - - | splineCurve aForm flag| - aForm := Form extent: 2@2. - aForm fillBlack. - splineCurve := Spline new. - splineCurve form: aForm. - flag := true. - [flag] whileTrue: - [Sensor waitButton. - Sensor redButtonPressed - ifTrue: - [splineCurve add: Sensor waitButton. - Sensor waitNoButton. - aForm displayOn: Display at: splineCurve last] - ifFalse: [flag:=false]]. - splineCurve computeCurve. - splineCurve isEmpty - ifFalse: [splineCurve displayOn: Display. - Sensor waitNoButton]. - - "Spline example"! Item was removed: - ----- Method: Spline>>coefficients (in category 'accessing') ----- - coefficients - "Answer an eight-element Array of Arrays each of which is the length - of the receiver. The first four arrays are the values, first, second and - third derivatives, respectively, for the parametric spline in x. The last - four elements are for y." - - ^coefficients! Item was removed: - ----- Method: Spline>>computeCurve (in category 'displaying') ----- - computeCurve - "Compute an array for the coefficients." - - | length extras | - length := self size. - extras := 0. - coefficients := Array new: 8. - 1 to: 8 do: [:i | coefficients at: i put: (Array new: length + extras)]. - 1 to: 5 by: 4 do: - [:k | - 1 to: length do: - [:i | (coefficients at: k) - at: i put: (k = 1 - ifTrue: [(self at: i) x asFloat] - ifFalse: [(self at: i) y asFloat])]. - 1 to: extras do: [:i | (coefficients at: k) - at: length + i put: ((coefficients at: k) - at: i + 1)]. - self derivs: (coefficients at: k) - first: (coefficients at: k + 1) - second: (coefficients at: k + 2) - third: (coefficients at: k + 3)]. - extras > 0 - ifTrue: [1 to: 8 do: - [:i | - coefficients at: i put: ((coefficients at: i) - copyFrom: 2 to: length + 1)]]! Item was removed: - ----- Method: Spline>>derivs:first:second:third: (in category 'private') ----- - derivs: a first: point1 second: point2 third: point3 - "Compute the first, second and third derivitives (in coefficients) from - the Points in this Path (coefficients at: 1 and coefficients at: 5)." - - | l v anArray | - l := a size. - l < 2 ifTrue: [^self]. - l > 2 - ifTrue: - [v := Array new: l. - v at: 1 put: 4.0. - anArray := Array new: l. - anArray at: 1 put: (6.0 * ((a at: 1) - ((a at: 2) * 2.0) + (a at: 3))). - 2 to: l - 2 do: - [:i | - v at: i put: (4.0 - (1.0 / (v at: (i - 1)))). - anArray - at: i - put: (6.0 * ((a at: i) - ((a at: (i + 1)) * 2.0) + (a at: (i + 2))) - - ((anArray at: (i - 1)) / (v at: (i - 1))))]. - point2 at: (l - 1) put: ((anArray at: (l - 2)) / (v at: (l - 2))). - l - 2 to: 2 by: 0-1 do: - [:i | - point2 - at: i - put: ((anArray at: (i - 1)) - (point2 at: (i + 1)) / (v at: (i - 1)))]]. - point2 at: 1 put: (point2 at: l put: 0.0). - 1 to: l - 1 do: - [:i | point1 - at: i - put: ((a at: (i + 1)) - (a at: i) - - ((point2 at: i) * 2.0 + (point2 at: (i + 1)) / 6.0)). - point3 at: i put: ((point2 at: (i + 1)) - (point2 at: i))]! Item was removed: - ----- Method: Spline>>displayOn:at:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium at: aPoint clippingBox: clipRect rule: anInteger fillColor: aForm - "Display the receiver, a spline curve, approximated by straight line - segments." - - | n line t x y x1 x2 x3 y1 y2 y3 | - collectionOfPoints size < 1 ifTrue: [self error: 'a spline must have at least one point']. - line := Line new. - line form: self form. - line beginPoint: - (x := (coefficients at: 1) at: 1) rounded @ (y := (coefficients at: 5) at: 1) rounded. - 1 to: (coefficients at: 1) size - 1 do: - [:i | - "taylor series coefficients" - x1 := (coefficients at: 2) at: i. - y1 := (coefficients at: 6) at: i. - x2 := ((coefficients at: 3) at: i) / 2.0. - y2 := ((coefficients at: 7) at: i) / 2.0. - x3 := ((coefficients at: 4) at: i) / 6.0. - y3 := ((coefficients at: 8) at: i) / 6.0. - "guess n" - n := 5 max: (x2 abs + y2 abs * 2.0 + ((coefficients at: 3) - at: i + 1) abs + ((coefficients at: 7) - at: i + 1) abs / 100.0) rounded. - 1 to: n - 1 do: - [:j | - t := j asFloat / n. - line endPoint: - (x3 * t + x2 * t + x1 * t + x) rounded - @ (y3 * t + y2 * t + y1 * t + y) rounded. - line - displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm. - line beginPoint: line endPoint]. - line beginPoint: - (x := (coefficients at: 1) at: i + 1) rounded - @ (y := (coefficients at: 5) at: i + 1) rounded. - line - displayOn: aDisplayMedium - at: aPoint - clippingBox: clipRect - rule: anInteger - fillColor: aForm]! Item was removed: - ----- Method: Spline>>displayOn:transformation:clippingBox:rule:fillColor: (in category 'displaying') ----- - displayOn: aDisplayMedium transformation: aTransformation clippingBox: clipRect rule: anInteger fillColor: aForm - "Get the scaled and translated path of newKnots." - - | newKnots newSpline | - newKnots := aTransformation applyTo: self. - newSpline := Spline new. - newKnots do: [:knot | newSpline add: knot]. - newSpline form: self form. - newSpline - displayOn: aDisplayMedium - at: 0 @ 0 - clippingBox: clipRect - rule: anInteger - fillColor: aForm!

4 5

SequenceableCollection #= method in current trunk differs from Squeak 5.2
by Nikolay Suslov 07 Jul '22

07 Jul '22

Hello all, Figuring out, could we go back to the previous version of SequenceableCollection #= method (as in Squeak 5.2), to check if the receiver is equivalent to the otherCollection by using "self species == otherCollection species", instead of "self class = otherCollection class"? The current version of #= method breaks code in different places. For example the RFB/VNC server gives wrong results starting from an authentication process, where RFBMessage is the ByteArray subclass and implements #species. Best regards, Nikolai

9 18

The Inbox: ToolBuilder-Morphic-cbc.270.mcz
by commits＠source.squeak.org 07 Jul '22

07 Jul '22

A new version of ToolBuilder-Morphic was added to project The Inbox: http://source.squeak.org/inbox/ToolBuilder-Morphic-cbc.270.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-cbc.270 Author: cbc Time: 8 January 2021, 11:27:47.8204 am UUID: abbbeb8a-9a8b-ef4a-b6a9-051b55cc2d5b Ancestors: ToolBuilder-Morphic-mt.269 Set the initial extent of the ListChooser to not require resizing the dialog for reasonable sized lists (i.e., expand it so you can see all of the list). At the small end, still object MT's suggested size; at the large end, will not take up more the 3/4ths of the world size. =============== Diff against ToolBuilder-Morphic-mt.269 =============== Item was changed: ----- Method: ListChooser>>initialExtent (in category 'building') ----- initialExtent + | listFont width height | - - | listFont | listFont := Preferences standardListFont. + width := (items collect: [:item| listFont widthOfString: item]) max + 20 "Acutal size of items plus dialog buffer left/right" + max: (20 * (listFont widthOf: $m)). "but we want a not-too-small box as well" + height := ((items size max: 15) * listFont height) + 40. "for various other stuff in dialog above/below list" + "But, don't use the whole world." + width := width min: (self currentWorld extent x * 0.75) asInteger. + height := height min: (self currentWorld extent y * 0.75) asInteger. + ^ width@height! - ^ (20 * (listFont widthOf: $m))@(15 * listFont height)!

3 7

Squeak VM & image package/bundle building?
by tim Rowledge 07 Jul '22

07 Jul '22

We obviously have some system in place that produces the downloadable packages containing the vm & image etc. I haven't so far successfully googled anything that usefully helps me understand *how*. What is the current build setup for these things? Do we have to run platform specific jobs or is it practical to have a single system? I'm interested in how one might build a Mac bundle, for example, that might have a custom name, icons, image file, other resources. I recall some quite long threads about the joy of signing Mac application bundles too. And can Mac & Windows applications run without open windows these days? Again, I recall interesting issues with this years ago but nothing from more recent times. Imagine I want to run a Seaside server; no open windows, write errors to a suitable log, stuff like that. tim -- tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim Useful Latin Phrases:- Furnulum pani nolo = I don't want a toaster.

2 1

The Trunk: Tools-tpr.1008.mcz
by commits＠source.squeak.org 22 Jun '22

22 Jun '22

tim Rowledge uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-tpr.1008.mcz ==================== Summary ==================== Name: Tools-tpr.1008 Author: tpr Time: 25 October 2020, 5:52:09.007789 pm UUID: 2ebe15ce-0c25-4b8d-b993-f1c51203dee5 Ancestors: Tools-tpr.1003, Tools-mt.1007 Rework the window label handing of MessageSet/Trace to be a bit more accurate, and to work within the normal style of labels. Instead of assuming the size of the list passed to the MessageSet/Trace is correct, derive it from the post-processing list. We process the list to remove duplicates, which e.g. the #allUnimplementedCalls method produces. This required adding an instvar to M-Set, removing one from M-Trace, setting the new one properly, dumping some dodgy code that used to half-assedly derive the old one, use the proper #changed: #windowTitle to, y'know, change the title, and some faffing with the messageList. As a result we are better placed to make further improvements if/when we develop a way to correctly hightlight multi-part keywords (or indeed, multiple messages) within a single method, which would greatly improve many browsers. This benefits from being accompanied by the single-method change in the System-tpr.1181 package =============== Diff against Tools-mt.1007 =============== Item was changed: CodeHolder subclass: #MessageSet + instanceVariableNames: 'growable messageList messageListFormatted autoSelectString messageListIndex editSelection windowLabel' - instanceVariableNames: 'growable messageList messageListFormatted autoSelectString messageListIndex editSelection' classVariableNames: 'UseUnifiedMessageLabels' poolDictionaries: '' category: 'Tools-Browser'! !MessageSet commentStamp: '<historical>' prior: 0! I represent a query path of the retrieval result of making a query about methods in the system. The result is a set of methods, denoted by a message selector and the class in which the method was found. As a StringHolder, the string I represent is the source code of the currently selected method. I am typically viewed in a Message Set Browser consisting of a MessageListView and a BrowserCodeView.! Item was changed: ----- Method: MessageSet class>>openMessageList:name:autoSelect: (in category 'instance creation') ----- openMessageList: messageList name: labelString autoSelect: autoSelectString "Open a system view for a MessageSet on messageList. + The labelString is passed to the model to use as a base label, depending on the selection state" - 1/24/96 sw: the there-are-no msg now supplied by my sender" | messageSet | messageSet := self messageList: messageList. + messageSet + autoSelectString: autoSelectString; + setInitialLabel: labelString. + ^ToolBuilder open: messageSet! - messageSet autoSelectString: autoSelectString. - ^ToolBuilder open: messageSet label: labelString! Item was changed: ----- Method: MessageSet>>adjustWindowTitleAfterFiltering (in category 'private') ----- adjustWindowTitleAfterFiltering + "Set the title of the receiver's window, if any, to reflect the just-completed filtering. Avoid re-doing it if fitering is re-done" - "Set the title of the receiver's window, if any, to reflect the just-completed filtering" + (windowLabel endsWith: 'Filtered') + ifFalse: [windowLabel := windowLabel , ' Filtered'. + self changed: #windowTitle]! - | aWindow existingLabel newLabel | - - (aWindow := self containingWindow) ifNil: [^ self]. - (existingLabel := aWindow label) isEmptyOrNil ifTrue: [^ self]. - (((existingLabel size < 3) or: [existingLabel last ~~ $]]) or: [(existingLabel at: (existingLabel size - 1)) isDigit not]) ifTrue: [^ self]. - existingLabel size to: 1 by: -1 do: - [:anIndex | ((existingLabel at: anIndex) == $[) ifTrue: - [newLabel := (existingLabel copyFrom: 1 to: anIndex), - 'Filtered: ', - messageList size printString, - ']'. - ^ aWindow setLabel: newLabel]] - - - ! Item was changed: ----- Method: MessageSet>>initializeMessageList: (in category 'private') ----- initializeMessageList: anArray "Initialize my messageList from the given list of MethodReference or string objects. NB: special handling for uniclasses. Do /not/ replace the elements of anArray if they are already MethodReferences, so as to allow users to construct richer systems, such as differencers between existing and edited versions of code." + messageList := Set new. - messageList := OrderedCollection new. anArray do: [:each | each isMethodReference + ifTrue: [messageList add: each] - ifTrue: [messageList addLast: each] ifFalse: [ MessageSet parse: each toClassAndSelector: + [ : class : sel | class ifNotNil: [ messageList add: (MethodReference class: class selector: sel) ] ] ] ]. + messageList := messageList asOrderedCollection sort. - [ : class : sel | class ifNotNil: [ messageList addLast: (MethodReference class: class selector: sel) ] ] ] ]. "Unify labels if wanted." self class useUnifiedMessageLabels ifTrue: [ messageList withIndexDo: [ : each : index | | cls | cls := each actualClass. each stringVersion: (self indentionPrefixOfSize: (self indentionsIn: each stringVersion)) , (cls ifNil: [each asString] ifNotNil: [cls isUniClass ifTrue: [cls typicalInstanceName, ' ', each selector] ifFalse: [ cls name , ' ' , each selector , ' {' , ((cls organization categoryOfElement: each selector) ifNil: ['']) , '}' , ' {', cls category, '}' ] ]) ] ]. messageListIndex := messageList isEmpty ifTrue: [0] ifFalse: [1]. contents := String empty! Item was changed: ----- Method: MessageSet>>messageListIndex: (in category 'message list') ----- messageListIndex: anInteger + "Set the index of the selected item to be anInteger. + Update the message list morph, the text edit morph and the assorted buttons" - "Set the index of the selected item to be anInteger." messageListIndex := anInteger. contents := messageListIndex ~= 0 ifTrue: [self selectedMessage] ifFalse: ['']. self changed: #messageListIndex. "update my selection" self editSelection: #editMessage. self contentsChanged. (messageListIndex ~= 0 and: [ autoSelectString notNil and: [ self contents notEmpty ] ]) ifTrue: [ self changed: #autoSelect ]. self decorateButtons ! Item was added: + ----- Method: MessageSet>>setInitialLabel: (in category 'accessing') ----- + setInitialLabel: aString + "set the base label for the window, as returned by #windowTitle" + + windowLabel := aString! Item was added: + ----- Method: MessageSet>>windowTitle (in category 'user interface') ----- + windowTitle + "just return the basic label for now" + + ^windowLabel! Item was changed: MessageSet subclass: #MessageTrace + instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex' - instanceVariableNames: 'autoSelectStrings messageSelections anchorIndex defaultSelectString' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !MessageTrace commentStamp: 'cmm 3/2/2010 20:26' prior: 0! A MessageTrace is a MessageSet allowing efficient sender/implementor message following. With implementors indented below, and senders outdended above, message flow is succinctly expressed, hierarchically. My autoSelectStrings and messageSelections are Arrays of Booleans, parallel to my messageList. Each boolean indicates whether that message is selected. Each autoSelectStrings indicates which string should be highlighted in the code for each method in my messageList.! Item was changed: ----- Method: MessageTrace>>browseAllImplementorsOf: (in category 'actions') ----- browseAllImplementorsOf: selectorSymbol | selectorToBrowse | selectorToBrowse := self selection ifNil: [ selectorSymbol ] + ifNotNil: [ self getImplementorNamed: selectorSymbol asSymbol "since we can get passed literals"]. - ifNotNil: [ self getImplementorNamed: selectorSymbol ]. (self hasUnacceptedEdits or: [ Preferences traceMessages not ]) ifTrue: [ super browseAllImplementorsOf: selectorToBrowse ] ifFalse: [ self addChildMethodsNamed: selectorToBrowse ] ! Item was changed: ----- Method: MessageTrace>>initializeMessageList: (in category 'private initializing') ----- initializeMessageList: anArray - messageSelections := (Array new: anArray size withAll: false) asOrderedCollection. super initializeMessageList: anArray. + messageSelections := (Array new: messageList size withAll: false) asOrderedCollection. self messageAt: messageListIndex beSelected: true. "autoSelectStrings is initialized right after this method, in autoSelectString:" ! Item was changed: ----- Method: MessageTrace>>messageListIndex: (in category 'actions') ----- messageListIndex: anInteger + "Set the index of the selected item to be anInteger. + Find the relevant auto select string to use, do my superclass' work and update the window title" + autoSelectStrings ifNotEmpty: [ autoSelectString := anInteger = 0 + ifTrue: [ "clear the autoSelectString" + String empty ] + ifFalse: [autoSelectStrings at: anInteger] + ]. + + anInteger > 0 ifTrue: [ self + messageAt: anInteger + beSelected: true + ]. + super messageListIndex: anInteger. + self changed: #windowTitle - ifTrue: - [ defaultSelectString ifNotNil: [:default| self containingWindow setLabel: default]. - "clear the autoSelectString" - '' ] - ifFalse: - [ messageListIndex := anInteger. - "setting the window label, below, can't wait for this.." - self containingWindow setLabel: (self windowLabelAt: anInteger). - "work out the string to ask the text view to pre-select. We should do better than this; after all the debugger does" - (autoSelectStrings at: anInteger)] ]. - anInteger > 0 ifTrue: - [ self - messageAt: anInteger - beSelected: true ]. - super messageListIndex: anInteger ! Item was changed: ----- Method: MessageTrace>>windowLabelAt: (in category 'private accessing') ----- windowLabelAt: anInteger + "return a suitable window label when there is an actual list item selected; work out what it should be based upon the array of autoSelectStrings or the current selection" + ^(autoSelectStrings at: anInteger) + ifNil: [ 'Implementors of ', - | str | - defaultSelectString ifNil: - [defaultSelectString := self containingWindow label]. - ^(str := autoSelectStrings at: anInteger) - ifNil: - [ 'Implementors of ', (self class parse: self selection + toClassAndSelector: [ :class :selector | selector ]) + ] + ifNotNil: [:str| 'Senders of ', str ] - toClassAndSelector: [ :class :selector | selector ]) ] - ifNotNil: - [ 'Senders of ', str ] ! Item was added: + ----- Method: MessageTrace>>windowTitle (in category 'building') ----- + windowTitle + "set the window label to suit the selection state; + if no selection, use saved widow label and add the number of items in the messageList + if something is selected, use the relevant string provided by windowLabelAt: which considers the index" + + ^messageListIndex = 0 + ifTrue:[String streamContents: [:str| str nextPutAll: windowLabel; + space; + nextPut: $[; + nextPutAll: messageList size asString; + nextPut: $] + ] + ] + ifFalse: [self windowLabelAt: messageListIndex]!

3 5

Jump to page: