Squeak-dev February 2015

squeak-dev@lists.squeakfoundation.org

45 participants
152 discussions

The Trunk: Morphic-ul.763.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.763.mcz ==================== Summary ==================== Name: Morphic-ul.763 Author: ul Time: 26 February 2015, 10:17:41.62 pm UUID: ca68fd92-ab68-403b-91ae-3adef769f32d Ancestors: Morphic-mt.762, Morphic-ul.754 Merged Morphic-ul.754: Simplified and improved WorldState >> #interCyclePause: - don't create a new Delay (along with a new Semaphore) every 20 (or 50) milliseconds - use #millisecondsSince: to avoid the effects of the clock rollover - separated the code of time calculation and actual waiting =============== Diff against Morphic-mt.762 =============== Item was changed: Object subclass: #WorldState + instanceVariableNames: 'hands activeHand viewBox canvas damageRecorder stepList lastStepTime lastStepMessage lastCycleTime commandHistory alarms lastAlarmTime remoteServer multiCanvas interCycleDelay' - instanceVariableNames: 'hands activeHand viewBox canvas damageRecorder stepList lastStepTime lastStepMessage lastCycleTime commandHistory alarms lastAlarmTime remoteServer multiCanvas' classVariableNames: 'CanSurrenderToOS DeferredUIMessages DisableDeferredUpdates LastCycleTime MinCycleLapse' poolDictionaries: '' category: 'Morphic-Worlds'! !WorldState commentStamp: 'ls 7/10/2003 19:30' prior: 0! The state of a Morphic world. (This needs some serious commenting!!!!) The MinCycleLapse variable holds the minimum amount of time that a morphic cycle is allowed to take. If a cycle takes less than this, then interCyclePause: will wait until the full time has been used up.! Item was changed: ----- Method: WorldState>>interCyclePause: (in category 'update cycle') ----- interCyclePause: milliSecs "delay enough that the previous cycle plus the amount of delay will equal milliSecs. If the cycle is already expensive, then no delay occurs. However, if the system is idly waiting for interaction from the user, the method will delay for a proportionally long time and cause the overall CPU usage of Squeak to be low. If the preference #serverMode is enabled, always do a complete delay of 50ms, independant of my argument. This prevents the freezing problem described in Mantis #6581" + | millisecondsToWait | + millisecondsToWait := Preferences serverMode + ifTrue: [ 50 ] - | currentTime wait | - Preferences serverMode ifFalse: [ + (lastCycleTime notNil and: [CanSurrenderToOS ~~ false]) + ifTrue: [ milliSecs - (Time millisecondsSince: lastCycleTime) ] + ifFalse: [ 0 ] ]. + millisecondsToWait > 0 ifTrue: [ + interCycleDelay + ifNil: [ interCycleDelay := Delay forMilliseconds: millisecondsToWait ] + ifNotNil: [ interCycleDelay delayDuration: millisecondsToWait ]. + interCycleDelay wait ]. - (lastCycleTime notNil and: [CanSurrenderToOS ~~ false]) ifTrue: [ - currentTime := Time millisecondClockValue. - wait := lastCycleTime + milliSecs - currentTime. - (wait > 0 and: [ wait <= milliSecs ] ) ifTrue: [ - (Delay forMilliseconds: wait) wait ] ] ] - ifTrue: [ (Delay forMilliseconds: 50) wait ]. - lastCycleTime := Time millisecondClockValue. CanSurrenderToOS := true.!

1 0

The Trunk: Kernel-ul.908.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.908.mcz ==================== Summary ==================== Name: Kernel-ul.908 Author: ul Time: 26 February 2015, 10:09:05.384 pm UUID: 89028aae-a08b-4320-9c55-53b1036a5192 Ancestors: Kernel-ul.907 Removed the unused variables from Random. =============== Diff against Kernel-ul.907 =============== Item was changed: Object subclass: #Random + instanceVariableNames: 'states index' + classVariableNames: 'MTa MTbShifted MTcShifted MTl MTlowerMask MTm MTn MTs MTt MTu MTupperMask MTw MTwFloatMultiplier MTwordMask' - instanceVariableNames: 'states index seed' - classVariableNames: 'A M MTa MTbShifted MTcShifted MTl MTlowerMask MTm MTn MTs MTt MTu MTupperMask MTw MTwFloatMultiplier MTwordMask Q R' poolDictionaries: '' category: 'Kernel-Numbers'! !Random commentStamp: 'ul 2/20/2015 09:44' prior: 0! I implement the 32-bit version of the Mersenne Twister PRNG, using 30-bit arithmetic, based on http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/ARTICLES/mt.pdf . The parameters of the generator are stored in class variables prefixed with MT. Instance Variables states: <Array> index: <Integer> index - the index of the state, which should be used to generate the next random integer value states - an Array holding the internal state of the generator --- If you just want a quick random integer, use: 10 atRandom Every integer interval can give a random number: (6 to: 12) atRandom SequenceableCollections can give randomly selected elements: 'pick one of these letters randomly' atRandom SequenceableCollections also respond to shuffled, as in: ($A to: $Z) shuffled The correct way to use class Random is to store one in an instance or class variable: myGenerator := Random new. Then use it every time you need another number between 0.0 and 1.0 (excluding) myGenerator next You can also generate a positive integer myGenerator nextInt: 10!

1 0

The Trunk: Kernel-ul.907.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.907.mcz ==================== Summary ==================== Name: Kernel-ul.907 Author: ul Time: 26 February 2015, 9:26:09.288 pm UUID: a94084a6-3f89-4708-8e60-b7978f1b3501 Ancestors: Kernel-ul.906 Removed the old random number generator implementation from Random. =============== Diff against Kernel-ul.906 =============== Item was changed: ----- Method: LargePositiveInteger>>atRandom: (in category 'truncation and round off') ----- + atRandom: aRandom + "Answer a random integer from 1 to self picked from aRandom." - atRandom: aGenerator - "Answer a random integer from 1 to self picked from aGenerator." + ^aRandom nextLargeInt: self! - | chunkByteLength chunkBitLength chunkCount chunkMax bigRandomInteger | - chunkByteLength := 3. - chunkBitLength := chunkByteLength * 8. - chunkCount := - self highBitOfMagnitude + chunkBitLength - 1 // chunkBitLength "self would fit in that many chunks..." - + 2. "and two more chunks (48 bits) so as to have a pretty fair distribution" - chunkMax := 1<<chunkBitLength-1. - - "fill a big random integer by chunks of 3 bytes (24 bits)" - bigRandomInteger := self class new: chunkCount*chunkByteLength neg: false. - 0 to: chunkCount*chunkByteLength - 1 by: chunkByteLength do: [:byteOffset | - | chunk | - chunk := (aGenerator nextInt: chunkMax) - 1. - 1 to: chunkByteLength do: [:byteIndex | - bigRandomInteger digitAt: byteOffset + byteIndex put: (chunk digitAt: byteIndex)]]. - - ^self * bigRandomInteger >> (chunkCount * chunkBitLength) + 1! Item was changed: Object subclass: #Random + instanceVariableNames: 'states index seed' - instanceVariableNames: 'seed states index' classVariableNames: 'A M MTa MTbShifted MTcShifted MTl MTlowerMask MTm MTn MTs MTt MTu MTupperMask MTw MTwFloatMultiplier MTwordMask Q R' poolDictionaries: '' category: 'Kernel-Numbers'! + !Random commentStamp: 'ul 2/20/2015 09:44' prior: 0! + I implement the 32-bit version of the Mersenne Twister PRNG, using 30-bit arithmetic, based on http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/ARTICLES/mt.pdf . The parameters of the generator are stored in class variables prefixed with MT. - !Random commentStamp: 'nice 3/24/2010 07:38' prior: 0! - This Random Number Generator graciously contributed by David N. Smith. It is an adaptation of the Park-Miller RNG which uses Floats to avoid the need for LargeInteger arithmetic. + Instance Variables + states: <Array> + index: <Integer> + + index + - the index of the state, which should be used to generate the next random integer value + + states + - an Array holding the internal state of the generator + + --- + If you just want a quick random integer, use: 10 atRandom Every integer interval can give a random number: (6 to: 12) atRandom SequenceableCollections can give randomly selected elements: 'pick one of these letters randomly' atRandom SequenceableCollections also respond to shuffled, as in: ($A to: $Z) shuffled The correct way to use class Random is to store one in an instance or class variable: myGenerator := Random new. Then use it every time you need another number between 0.0 and 1.0 (excluding) myGenerator next You can also generate a positive integer myGenerator nextInt: 10! Item was changed: ----- Method: Random class>>initialize (in category 'class initialization') ----- initialize "30-bit MT521 parameters. generated with a modified version of dcmt with ID=1. http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/DC/dc.html" "Base parameters" "MTp := 521. Not used directly." MTw := 30. MTm := 9. MTa := 16r3235DEE2. "MTb := 16r39BB2B00. Not used directly." "MTc := 16r3EFD0000. Not used directly." MTl := -18. MTu := -12. MTs := 7. MTt := 15. "Calculated parameters" MTn := 18. "MTr := 19. Not used directly." MTupperMask := 16r3FF80000. MTlowerMask := 16r7FFFF. MTwordMask := 16r3FFFFFFF. MTbShifted := 7566934. MTcShifted := 32250. + MTwFloatMultiplier := 8388608! - MTwFloatMultiplier := 8388608. - self allInstancesDo: [ :each | each instVarNamed: #seed put: nil; seed: nil ]! Item was changed: ----- Method: Random>>initialize (in category 'initialization') ----- initialize + self seed: nil! - self seed: seed! Item was removed: - ----- Method: Random>>initializeStates (in category 'private') ----- - initializeStates - "Initialize the states array with the seed." - - states := Array new: MTn. - 1 to: MTn do: [ :i | - states at: i put: (MTwordMask bitAnd: seed). - seed := 16rFFFFFFFF bitAnd: (16r6C078965 * (seed bitXor: seed // 16r40000000 "bitShift: -30") + i) ]! Item was added: + ----- Method: Random>>initializeStatesWith: (in category 'private') ----- + initializeStatesWith: anInteger + "Initialize the states array with the seed." + + | seed | + states := Array new: MTn. + seed := anInteger. + 1 to: MTn do: [ :i | + states at: i put: (MTwordMask bitAnd: seed). + seed := 16rFFFFFFFF bitAnd: (16r6C078965 * (seed bitXor: seed // 16r40000000 "bitShift: -30") + i) ]! Item was changed: ----- Method: Random>>next (in category 'accessing') ----- next "Answer a random 53-bit Float from the [0, 1) interval. The implementation assumes that the MTw parameter is between 27 and 53." - seed isFloat ifTrue: [ - "Answer a random Float in the interval [0 to 1)." - ^ (seed := self nextValue) - 1.0 / M ]. ^self nextValue asFloat * MTwFloatMultiplier + (self nextValue bitAnd: MTwFloatMultiplier - 1) / 9.007199254740992e15 "(1 << 53) asFloat"! Item was changed: ----- Method: Random>>nextInt: (in category 'accessing') ----- nextInt: anInteger "Answer a random integer value from the interval [1, anInteger]" | bucketSize retriesLeft | anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ]. - seed isFloat ifTrue: [ - " Answer a random integer in the interval [1, anInteger]. anInteger should be less than 16r80000000. " - "avoid Float arithmetic in #next to work with LargeInts" - ^ ((seed := self nextValue) asInteger * anInteger // M asInteger) + 1 ]. (anInteger isLarge or: [ anInteger > MTwordMask "In case SmallIntegers have more than MTw-bits, but the generator hasn't been updated accordingly." ]) ifTrue: [ ^self nextLargeInt: anInteger ]. - "Split the MTw-bit(currently 30-bit) integer range up to the equal sized buckets. Generate an MTw-bit random number, and see which bucket it's in. If it doesn't fit in any bucket, then try again." bucketSize := MTwordMask // anInteger. "The optimal bucket size would be MTwordMask + 1 // anInteger, but calculating it would involve LargeInteger arithmetic. The MTwordMask // anInteger expression is suboptimal only when anInteger is a power of two. These cases are rare, and the effect is negligible for small values. We could handle these cases separately, but testing if anInteger is a power of two costs more in general." retriesLeft := 10. "Based on measurements with various seeds, 10 retries is about optimal for the worst case, when anInteger = MTwordMask // 2 + 1." [ (retriesLeft := retriesLeft - 1) >= 0 ] whileTrue: [ | bucket | bucket := self nextValue // bucketSize. bucket < anInteger ifTrue: [ ^bucket + 1 ] ]. "Fall back to the floating point method, which is slower, but when we get here, then we've already spent enough resources on trying to generate the number. Using this fallback also ensures that the method doesn't run for indefinitely long." ^(self next * anInteger) truncated + 1! Item was changed: ----- Method: Random>>nextValue (in category 'private') ----- nextValue "Answer an MTw-bit random integer between 0 and wordMask, and increment the index." | y | - seed isFloat ifTrue: [ - "This method generates random instances of Integer in the interval 1 to 16r7FFFFFFF. This method does NOT update the seed; repeated sends answer the same value. - The algorithm is described in detail in 'Random Number Generators: - Good Ones Are Hard to Find' by Stephen K. Park and Keith W. Miller - (Comm. Asso. Comp. Mach., 31(10):1192--1201, 1988)." - | lo hi aLoRHi | - hi := seed quo: Q. - lo := seed - (Q * hi). " = seed rem: q" - aLoRHi := (A * lo) - (R * hi). - aLoRHi > 0.0 ifTrue: [ ^aLoRHi ]. - ^aLoRHi + M ]. y := states at: index. (index := index + 1) > MTn ifTrue: [ self generateStates ]. y := y bitXor: (y bitShift: MTu). y := ((y bitAnd: MTbShifted) bitShift: MTs) bitXor: y. y := ((y bitAnd: MTcShifted) bitShift: MTt) bitXor: y. y := (y bitShift: MTl) bitXor: y. ^y! Item was removed: - ----- Method: Random>>seed (in category 'private') ----- - seed - ^ seed! Item was changed: ----- Method: Random>>seed: (in category 'initialization') ----- seed: anIntegerOrNil " Use the given integer as seed, or generate one if it's nil. " | newSeed | newSeed := anIntegerOrNil ifNil: [ | now | now := Time primUTCMicrosecondClock. now = 0 ifTrue: [ now := Time millisecondClockValue ]. (now bitShift: 28) bitXor: self hash hashMultiply ]. + (newSeed between: 0 and: 16rFFFFFFFF) ifFalse: [ + newSeed := self hashSeed: newSeed ]. - seed isFloat ifTrue: [ - (newSeed between: 0 and: 16r7FFFFFFF) - ifTrue: [ seed := newSeed asFloat ] - ifFalse: [ seed := ((self hashSeed: newSeed) bitXor: 16r7FFFFFFF) asFloat ]. - ^self ]. - (newSeed between: 0 and: 16rFFFFFFFF) - ifTrue: [ seed := newSeed ] - ifFalse: [ seed := self hashSeed: newSeed ]. self + initializeStatesWith: newSeed; - initializeStates; generateStates!

1 0

The Trunk: Kernel-ul.906.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.906.mcz ==================== Summary ==================== Name: Kernel-ul.906 Author: ul Time: 26 February 2015, 9:22:02.722 pm UUID: 9fd0ffbc-c774-442a-baa5-5b0e13950856 Ancestors: Kernel-topa.905 Added an implementation of a 30-bit Mersenne Twister (p=521) to Random. All existing Random instances are migrated to the new implementation. =============== Diff against Kernel-topa.905 =============== Item was changed: Object subclass: #Random + instanceVariableNames: 'seed states index' + classVariableNames: 'A M MTa MTbShifted MTcShifted MTl MTlowerMask MTm MTn MTs MTt MTu MTupperMask MTw MTwFloatMultiplier MTwordMask Q R' - instanceVariableNames: 'seed' - classVariableNames: 'A M Q R' poolDictionaries: '' category: 'Kernel-Numbers'! !Random commentStamp: 'nice 3/24/2010 07:38' prior: 0! This Random Number Generator graciously contributed by David N. Smith. It is an adaptation of the Park-Miller RNG which uses Floats to avoid the need for LargeInteger arithmetic. If you just want a quick random integer, use: 10 atRandom Every integer interval can give a random number: (6 to: 12) atRandom SequenceableCollections can give randomly selected elements: 'pick one of these letters randomly' atRandom SequenceableCollections also respond to shuffled, as in: ($A to: $Z) shuffled The correct way to use class Random is to store one in an instance or class variable: myGenerator := Random new. Then use it every time you need another number between 0.0 and 1.0 (excluding) myGenerator next You can also generate a positive integer myGenerator nextInt: 10! Item was changed: ----- Method: Random class>>bucketTest: (in category 'testing') ----- bucketTest: randy "Execute this: Random bucketTest: Random new" " A quick-and-dirty bucket test. Prints nbuckets values on the Transcript. Each should be 'near' the value of ntries. Any run with any value 'far' from ntries indicates something is very wrong. Each run generates different values. For a slightly better test, try values of nbuckets of 200-1000 or more; go get coffee. This is a poor test; see Knuth. Some 'OK' runs: 1000 1023 998 969 997 1018 1030 1019 1054 985 1003 1011 987 982 980 982 974 968 1044 976 1029 1011 1025 1016 997 1019 991 954 968 999 991 978 1035 995 988 1038 1009 988 993 976 " | nbuckets buckets ntrys | nbuckets := 200. buckets := Array new: nbuckets. buckets atAllPut: 0. + ntrys := 10000. - ntrys := 1000. ntrys*nbuckets timesRepeat: [ | slot | + slot := randy nextInt: nbuckets. - slot := (randy next * nbuckets) floor + 1. buckets at: slot put: (buckets at: slot) + 1 ]. Transcript cr. 1 to: nbuckets do: [ :nb | Transcript print: (buckets at: nb); space ]. Transcript flush! Item was changed: ----- Method: Random class>>initialize (in category 'class initialization') ----- initialize + "30-bit MT521 parameters. generated with a modified version of dcmt with ID=1. http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/DC/dc.html" + + "Base parameters" + "MTp := 521. Not used directly." + MTw := 30. + MTm := 9. + MTa := 16r3235DEE2. + "MTb := 16r39BB2B00. Not used directly." + "MTc := 16r3EFD0000. Not used directly." + MTl := -18. + MTu := -12. + MTs := 7. + MTt := 15. + "Calculated parameters" + MTn := 18. + "MTr := 19. Not used directly." + MTupperMask := 16r3FF80000. + MTlowerMask := 16r7FFFF. + MTwordMask := 16r3FFFFFFF. + MTbShifted := 7566934. + MTcShifted := 32250. + MTwFloatMultiplier := 8388608. + self allInstancesDo: [ :each | each instVarNamed: #seed put: nil; seed: nil ]! - "Initialize the magic constants. All instances share these values. Use floats to avoid LargeInteger computations (it still gives about 3-4x speedup)." - - A := 16807.0. " magic constant = 16807 " - M := 2147483647.0. " magic constant = 2147483647 " - Q := 127773.0. "(m quo: a) asFloat." - R := 2836.0 "(m \\ a) asFloat."! Item was changed: ----- Method: Random class>>seed: (in category 'instance creation') ----- + seed: anInteger + - seed: anInteger ^self basicNew seed: anInteger! Item was added: + ----- Method: Random>>generateStates (in category 'private') ----- + generateStates + "Generate untempered numbers into the states variable. Split up the operation into three parts to avoid the use of #atWrap: for accessing the states array. Optimized for SmallInteger operations." + + | i limit y offset | + "Part 1" + i := 0. + offset := MTm. + limit := MTn - offset. + [ (i := i + 1) <= limit ] whileTrue: [ + y := (MTupperMask bitAnd: (states at: i)) bitOr: (MTlowerMask bitAnd: (states at: i + 1)). + states + at: i + put: ((y bitAnd: 1) * MTa bitXor: ((states at: i + offset) bitXor: (y bitShift: -1))) ]. + "Part 2" + limit := MTn - 1. + offset := MTm - MTn. + i := i - 1. + [ (i := i + 1) <= limit ] whileTrue: [ + y := (MTupperMask bitAnd: (states at: i)) bitOr: (MTlowerMask bitAnd: (states at: i + 1)). + states + at: i + put: ((y bitAnd: 1) * MTa bitXor: ((states at: i + offset) bitXor: (y bitShift: -1))) ]. + "Part 3" + y := (MTupperMask bitAnd: (states at: MTn)) bitOr: (MTlowerMask bitAnd: (states at: 1)). + states + at: MTn + put: ((y bitAnd: 1) * MTa bitXor: ((states at: MTm) bitXor: (y bitShift: -1))). + index := 1 + ! Item was changed: + ----- Method: Random>>hashSeed: (in category 'private') ----- - ----- Method: Random>>hashSeed: (in category 'initialization') ----- hashSeed: anInteger + "Use the 32-bit version of the FNV-1a algorithm to hash the seed, and return a 32-bit unsigned integer." - " Use the 32-bit version of the FNV-1a algorithm to hash the seed. Keep only 31 bits during the calculation. " | fnvPrime hash | fnvPrime := 16777619 " 32-bit FVN prime ". hash := anInteger negative + ifTrue: [ 3490449840 " mix in the sign as (2166136261 bitXor: 2r1010101) * 16777619 bitAnd: 16rFFFFFFFF "] - ifTrue: [ 1342966192 " mix in the sign as (2166136261 bitXor: 2r1010101) * 16777619 bitAnd: 16r7FFFFFFF "] ifFalse: [ 2166136261 " 32-bit FVN offset basis "]. 1 to: anInteger digitLength do: [ :index | + hash := 16rFFFFFFFF bitAnd: (hash bitXor: (anInteger digitAt: index)) * fnvPrime ]. + ^hash! - hash := (hash bitXor: (anInteger digitAt: index)) * fnvPrime bitAnd: 16r7FFFFFFF ]. - seed := hash asFloat! Item was changed: ----- Method: Random>>initialize (in category 'initialization') ----- initialize - " Set a reasonable Park-Miller starting seed " + self seed: seed! - | hash newSeed | - hash := self hash hashMultiply. - newSeed := Time primUTCMicrosecondClock. - newSeed isZero ifTrue: [ " microsecond clock not available " - newSeed := Time millisecondClockValue ]. - seed := ((newSeed bitAnd: 16r7FFFFFFF) bitXor: hash) asFloat! Item was added: + ----- Method: Random>>initializeStates (in category 'private') ----- + initializeStates + "Initialize the states array with the seed." + + states := Array new: MTn. + 1 to: MTn do: [ :i | + states at: i put: (MTwordMask bitAnd: seed). + seed := 16rFFFFFFFF bitAnd: (16r6C078965 * (seed bitXor: seed // 16r40000000 "bitShift: -30") + i) ]! Item was changed: ----- Method: Random>>next (in category 'accessing') ----- next + "Answer a random 53-bit Float from the [0, 1) interval. The implementation assumes that the MTw parameter is between 27 and 53." + + seed isFloat ifTrue: [ + "Answer a random Float in the interval [0 to 1)." + ^ (seed := self nextValue) - 1.0 / M ]. + ^self nextValue asFloat * MTwFloatMultiplier + (self nextValue bitAnd: MTwFloatMultiplier - 1) / 9.007199254740992e15 "(1 << 53) asFloat"! - "Answer a random Float in the interval [0 to 1)." - - ^ (seed := self nextValue) - 1.0 / M! Item was changed: ----- Method: Random>>nextInt: (in category 'accessing') ----- nextInt: anInteger + "Answer a random integer value from the interval [1, anInteger]" - " Answer a random integer in the interval [1, anInteger]. anInteger should be less than 16r80000000. " + | bucketSize retriesLeft | anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ]. + seed isFloat ifTrue: [ + " Answer a random integer in the interval [1, anInteger]. anInteger should be less than 16r80000000. " + "avoid Float arithmetic in #next to work with LargeInts" + ^ ((seed := self nextValue) asInteger * anInteger // M asInteger) + 1 ]. + (anInteger isLarge + or: [ anInteger > MTwordMask "In case SmallIntegers have more than MTw-bits, but the generator hasn't been updated accordingly." ]) + ifTrue: [ ^self nextLargeInt: anInteger ]. + + "Split the MTw-bit(currently 30-bit) integer range up to the equal sized buckets. Generate an MTw-bit random number, and see which bucket it's in. If it doesn't fit in any bucket, then try again." + bucketSize := MTwordMask // anInteger. "The optimal bucket size would be MTwordMask + 1 // anInteger, but calculating it would involve LargeInteger arithmetic. The MTwordMask // anInteger expression is suboptimal only when anInteger is a power of two. These cases are rare, and the effect is negligible for small values. We could handle these cases separately, but testing if anInteger is a power of two costs more in general." + retriesLeft := 10. "Based on measurements with various seeds, 10 retries is about optimal for the worst case, when anInteger = MTwordMask // 2 + 1." + [ (retriesLeft := retriesLeft - 1) >= 0 ] whileTrue: [ + | bucket | + bucket := self nextValue // bucketSize. + bucket < anInteger ifTrue: [ ^bucket + 1 ] ]. + "Fall back to the floating point method, which is slower, but when we get here, then we've already spent enough resources on trying to generate the number. Using this fallback also ensures that the method doesn't run for indefinitely long." + ^(self next * anInteger) truncated + 1! - "avoid Float arithmetic in #next to work with LargeInts" - ^ ((seed := self nextValue) asInteger * anInteger // M asInteger) + 1! Item was added: + ----- Method: Random>>nextLargeInt: (in category 'accessing') ----- + nextLargeInt: anInteger + "Answer a random integer value from the interval [1, anInteger]. This method works for arbitrarily large integers." + + | byteCount bigRandom remainder remainingBits i result firstDigit | + byteCount := anInteger digitLength + 4. "Extend the space with at least 32 bits for a fairer distribution." + bigRandom := LargePositiveInteger new: byteCount. + remainder := remainingBits := 0. + i := 1. + [ i <= byteCount ] whileTrue: [ + remainingBits >= 8 + ifTrue: [ + bigRandom digitAt: i put: (remainder bitAnd: 16rFF). + remainder := remainder bitShift: -8. + remainingBits := remainingBits - 8. + i := i + 1 ] + ifFalse: [ + remainingBits = 0 + ifTrue: [ remainder := self nextValue ] + ifFalse: [ + | newRandom | + newRandom := self nextValue. + bigRandom digitAt: i put: (remainder bitShift: 8 - remainingBits) + + (newRandom bitAnd: (1 bitShift: 8 - remainingBits) - 1). + i := i + 1. + remainder := newRandom bitShift: 0 - remainingBits ]. + remainingBits := MTw - remainingBits ] ]. + result := anInteger * bigRandom bitShift: -8 * byteCount. + "Avoid using LargeInteger arithmetic for +1 in most cases." + result isLarge ifFalse: [ ^result + 1 ]. + (firstDigit := result digitAt: 1) = 255 ifTrue: [ ^result + 1 ]. + result digitAt: 1 put: firstDigit + 1. + ^result + ! Item was changed: ----- Method: Random>>nextValue (in category 'private') ----- nextValue + "Answer an MTw-bit random integer between 0 and wordMask, and increment the index." - "This method generates random instances of Integer in the interval 1 to 16r7FFFFFFF. This method does NOT update the seed; repeated sends answer the same value. - The algorithm is described in detail in 'Random Number Generators: - Good Ones Are Hard to Find' by Stephen K. Park and Keith W. Miller - (Comm. Asso. Comp. Mach., 31(10):1192--1201, 1988)." + | y | + seed isFloat ifTrue: [ + "This method generates random instances of Integer in the interval 1 to 16r7FFFFFFF. This method does NOT update the seed; repeated sends answer the same value. + The algorithm is described in detail in 'Random Number Generators: + Good Ones Are Hard to Find' by Stephen K. Park and Keith W. Miller + (Comm. Asso. Comp. Mach., 31(10):1192--1201, 1988)." + | lo hi aLoRHi | + hi := seed quo: Q. + lo := seed - (Q * hi). " = seed rem: q" + aLoRHi := (A * lo) - (R * hi). + aLoRHi > 0.0 ifTrue: [ ^aLoRHi ]. + ^aLoRHi + M ]. + y := states at: index. + (index := index + 1) > MTn ifTrue: [ self generateStates ]. + y := y bitXor: (y bitShift: MTu). + y := ((y bitAnd: MTbShifted) bitShift: MTs) bitXor: y. + y := ((y bitAnd: MTcShifted) bitShift: MTt) bitXor: y. + y := (y bitShift: MTl) bitXor: y. + ^y! - | lo hi aLoRHi | - hi := seed quo: Q. - lo := seed - (Q * hi). " = seed rem: q" - aLoRHi := (A * lo) - (R * hi). - aLoRHi > 0.0 ifTrue: [ ^aLoRHi ]. - ^aLoRHi + M! Item was changed: ----- Method: Random>>seed: (in category 'initialization') ----- + seed: anIntegerOrNil + " Use the given integer as seed, or generate one if it's nil. " - seed: anInteger - " Use this 31-bit nonnegative integer as seed. Generate a valid seed using a hash function if it's out of range. " + | newSeed | + newSeed := anIntegerOrNil ifNil: [ + | now | + now := Time primUTCMicrosecondClock. + now = 0 ifTrue: [ now := Time millisecondClockValue ]. + (now bitShift: 28) bitXor: self hash hashMultiply ]. + seed isFloat ifTrue: [ + (newSeed between: 0 and: 16r7FFFFFFF) + ifTrue: [ seed := newSeed asFloat ] + ifFalse: [ seed := ((self hashSeed: newSeed) bitXor: 16r7FFFFFFF) asFloat ]. + ^self ]. + (newSeed between: 0 and: 16rFFFFFFFF) + ifTrue: [ seed := newSeed ] + ifFalse: [ seed := self hashSeed: newSeed ]. + self + initializeStates; + generateStates! - (anInteger between: 0 and: 16r7FFFFFFF) - ifTrue: [ seed := anInteger asFloat ] - ifFalse: [ self hashSeed: anInteger ]!

1 0

Please add Robot support tools
by Kirk Fraser 26 Feb '15

26 Feb '15

Here are improvements to make Squeak more useful for Robot control. 1) Add machine vision tools. I'm told eToys has video camera access but more access to each frame is needed for autonomous robot control including "contour" to reduce the image to arcs and lines to start visual object identification and measurement of object speed and direction as the robot is moving, to either intercept or avoid an object. The same arcs and lines may in some applications be processed into readable text, read your lips, or other interesting things. 2) Method to stop Garbage Collection. I see Squeak 4.5 has a menu item to perform garbage collection so performing collections can be put under program control but there should also be a message to stop any garbage collection until requested or resumed. Why? Imagine you are in a self-driving car powered by Squeak. You enter a curve, turn, or need to stop while going 60 MPH then encounter a 100 millisecond delay for garbage collection. That scenario could put you 8 feet off course into a canyon, oncoming traffic, or a child chasing a ball. So the only way is to use two Squeaks operating in separate cores and use socket communication to guarantee one Squeak is paying close attention to the road while the other collects its garbage, trading off as needed. Perhaps a measure of the garbage pile and growth rate would also help decide which image gets to proceed. 3) The Raspberry Pi has many pins to connect electronics to. Supporting those could potentially provide control for many projects for children and adults. Thank you. Kirk W. Fraser w <http://freetom.info/TrueChurch>ww.JesusGospelChurch.com <http://www.JesusGospelChurch.com> - Replace the fraud churches with the true church. http://freetom.info - Example of False Justice common in America

8 16

The Trunk: Morphic-mt.762.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.762.mcz ==================== Summary ==================== Name: Morphic-mt.762 Author: mt Time: 26 February 2015, 6:40:30.831 pm UUID: bf4412d4-1e58-344a-ab7b-05e401f170d4 Ancestors: Morphic-mt.761 Flag added to document that we don't handle rounded corners for roll-over borders. (eToys only?) =============== Diff against Morphic-mt.761 =============== Item was changed: ----- Method: Morph>>drawRolloverBorderOn: (in category 'drawing') ----- drawRolloverBorderOn: aCanvas | colorToUse offsetToUse myShadow newForm f | colorToUse := self valueOfProperty: #rolloverColor ifAbsent: [Color blue alpha: 0.5]. offsetToUse := self valueOfProperty: #rolloverWidth ifAbsent: [10 @ 10]. self hasRolloverBorder: false. myShadow := self shadowForm. self hasRolloverBorder: true. myShadow offset: 0 @ 0. f := ColorForm extent: myShadow extent depth: 1. myShadow displayOn: f. f colors: {Color transparent. colorToUse}. newForm := Form extent: offsetToUse * 2 + myShadow extent depth: 32. (WarpBlt toForm: newForm) sourceForm: f; cellSize: 1; combinationRule: 3; copyQuad: f boundingBox innerCorners toRect: newForm boundingBox. + + self flag: #roundedCorners. "mt: Check for #wantsRoundedCorners and call appropriate things in canvas." aCanvas translateBy: offsetToUse negated during: [:shadowCanvas | shadowCanvas shadowColor: colorToUse. shadowCanvas paintImage: newForm at: self position]!

1 0

The Trunk: Morphic-mt.761.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.761.mcz ==================== Summary ==================== Name: Morphic-mt.761 Author: mt Time: 26 February 2015, 6:32:43.542 pm UUID: 5cad7567-3a07-a94e-8544-72737cc6bbf0 Ancestors: Morphic-mt.760 Make pluggable buttons use the appropriate code for handling rounded corners (e.g. like system windows do). Corner rounding is now also configurable for buttons. Same preference: 'Preferred corner radius'. =============== Diff against Morphic-mt.760 =============== Item was changed: ----- Method: PluggableButtonMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas | cc gradient borderColor fill | cc := self color. cc isTransparent ifTrue:[cc := Color gray: 0.9]. self enabled ifFalse:[cc := Color lightGray]. cc brightness > 0.9 ifTrue:[cc := cc adjustBrightness: 0.9 - cc brightness]. showSelectionFeedback ifTrue:[ borderColor := cc muchDarker. gradient := GradientFillStyle ramp: { 0.0 -> cc muchDarker. 0.1-> (cc adjustBrightness: -0.2). 0.5 -> cc. 0.9-> (cc adjustBrightness: -0.1). 1 -> cc muchDarker}. cc := cc muchDarker. ] ifFalse:[ borderColor := Color lightGray. gradient := GradientFillStyle ramp: { 0.0 -> Color white. 0.1-> (cc adjustBrightness: 0.05). 0.6 -> (cc darker)}. ]. gradient origin: bounds topLeft. gradient direction: 0@self height. PluggableButtonMorph gradientButton ifFalse: [fill := SolidFillStyle color: cc] ifTrue: [fill := gradient]. + ^ self wantsRoundedCorners - ^ self roundedButtonCorners ifTrue: [aCanvas frameAndFillRoundRect: bounds + radius: self class preferredCornerRadius - radius: 8 fillStyle: fill borderWidth: 1 borderColor: borderColor] ifFalse: [aCanvas frameAndFillRectangle: self innerBounds fillColor: fill asColor borderWidth: 1 borderColor: borderColor darker; fillRectangle: (self innerBounds insetBy: 1) fillStyle: fill]! Item was removed: - ----- Method: PluggableButtonMorph>>roundedButtonCorners (in category 'drawing') ----- - roundedButtonCorners - "If the button is intended to invoke a menu for selection, provide a visual - distinction by inverting the rounded corners attribute." - ^self class roundedButtonCorners - xor: style == #menuButton! Item was added: + ----- Method: PluggableButtonMorph>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + "If the button is intended to invoke a menu for selection, provide a visual + distinction by inverting the rounded corners attribute." + + ^ (self class roundedButtonCorners or: [super wantsRoundedCorners]) + xor: style == #menuButton!

1 0

The Trunk: Graphics-mt.307.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Marcel Taeumel uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-mt.307.mcz ==================== Summary ==================== Name: Graphics-mt.307 Author: mt Time: 26 February 2015, 6:22:20.558 pm UUID: 15e4bf40-5f71-5f45-a0a4-86179930d6d5 Ancestors: Graphics-kfr.305 No CornerRounder anymore. Depended morphs have to round corners themselves. See Morphic-mt.760. =============== Diff against Graphics-kfr.305 =============== Item was removed: - Object subclass: #CornerRounder - instanceVariableNames: 'cornerMasks cornerOverlays underBits' - classVariableNames: 'CR0 CR1 CR2' - poolDictionaries: '' - category: 'Graphics-Display Objects'! - - !CornerRounder commentStamp: '<historical>' prior: 0! - This class is a quick hack to support rounded corners in morphic. - - Rather than produce rounded rectangles, it tweaks the display of corners. - Rather than work for any radius, it only supports a radius of 6. - Rather than work for any border width, it only supports widths 0, 1 and 2. - The corners, while apparently transparent, still behave opaquely to mouse clicks. - - Worse than this, the approach relies on the ability to extract underlying bits from the canvas prior to display. This ran afoul of top-down display, it seems, in SystemWindow spawnReframeHandle: (qv). It will also make a postscript printer very unhappy. - - But, hey, it's cute.! Item was removed: - ----- Method: CornerRounder class>>initialize (in category 'all') ----- - initialize "CornerRounder initialize" - - CR0 := CR1 := self new - masterMask: - (Form extent: 6@6 - fromArray: #(2r1e26 2r111e26 2r1111e26 2r11111e26 2r11111e26 2r111111e26) - offset: 0@0) - masterOverlay: - (Form extent: 6@6 - fromArray: #(2r1e26 2r110e26 2r1000e26 2r10000e26 2r10000e26 2r100000e26) - offset: 0@0). - CR2 := self new - masterMask: - (Form extent: 6@6 - fromArray: #(2r1e26 2r111e26 2r1111e26 2r11111e26 2r11111e26 2r111111e26) - offset: 0@0) - masterOverlay: - (Form extent: 6@6 - fromArray: #(2r1e26 2r111e26 2r1111e26 2r11100e26 2r11000e26 2r111000e26) - offset: 0@0). - - ! Item was removed: - ----- Method: CornerRounder class>>rectWithinCornersOf: (in category 'all') ----- - rectWithinCornersOf: aRectangle - "Return a single sub-rectangle that lies entirely inside corners - that are made by me. - Used to identify large regions of window that do not need to be redrawn." - - ^ aRectangle insetBy: 0@6! Item was removed: - ----- Method: CornerRounder class>>roundCornersOf:on:in:displayBlock:borderWidth:corners: (in category 'all') ----- - roundCornersOf: aMorph on: aCanvas in: bounds displayBlock: displayBlock borderWidth: w corners: aList - - | rounder | - rounder := CR0. - w = 1 ifTrue: [rounder := CR1]. - w = 2 ifTrue: [rounder := CR2]. - rounder := rounder copy. - rounder saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: aList. - displayBlock value. - rounder tweakCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: aList! Item was removed: - ----- Method: CornerRounder>>masterMask:masterOverlay: (in category 'all') ----- - masterMask: maskForm masterOverlay: overlayForm - - cornerMasks := #(none left pi right) collect: - [:dir | (maskForm rotateBy: dir centerAt: 0@0) offset: 0@0]. - cornerOverlays := #(none left pi right) collect: - [:dir | (overlayForm rotateBy: dir centerAt: 0@0) offset: 0@0]. - ! Item was removed: - ----- Method: CornerRounder>>saveBitsUnderCornersOf:on:in:corners: (in category 'all') ----- - saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: cornerList - - | corners | - underBits := Array new: 4. - corners := bounds corners. - cornerList do:[:i| - | offset corner mask form rect | - mask := cornerMasks at: i. - corner := corners at: i. - i = 1 ifTrue: [offset := 0@0]. - i = 2 ifTrue: [offset := 0@mask height negated]. - i = 3 ifTrue: [offset := mask extent negated]. - i = 4 ifTrue: [offset := mask width negated@0]. - rect := corner + offset extent: mask extent. - (aCanvas isVisible: rect) ifTrue:[ - form := aCanvas contentsOfArea: rect. - form copyBits: form boundingBox from: mask at: 0@0 clippingBox: form boundingBox rule: Form and fillColor: nil map: (Bitmap with: 16rFFFFFFFF with: 0). - underBits at: i put: form]]. - ! Item was removed: - ----- Method: CornerRounder>>tweakCornersOf:on:in:borderWidth:corners: (in category 'all') ----- - tweakCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: cornerList - "This variant has a cornerList argument, to allow some corners to be rounded and others not" - | fourColors mask shadowColor corners | - shadowColor := aCanvas shadowColor. - aCanvas shadowColor: nil. "for tweaking it's essential" - w > 0 ifTrue:[ - fourColors := shadowColor - ifNil:[aMorph borderStyle colorsAtCorners] - ifNotNil:[Array new: 4 withAll: Color transparent]]. - mask := Form extent: cornerMasks first extent depth: aCanvas depth. - corners := bounds corners. - cornerList do:[:i| - | offset corner saveBits outBits | - corner := corners at: i. - saveBits := underBits at: i. - saveBits ifNotNil:[ - i = 1 ifTrue: [offset := 0@0]. - i = 2 ifTrue: [offset := 0@saveBits height negated]. - i = 3 ifTrue: [offset := saveBits extent negated]. - i = 4 ifTrue: [offset := saveBits width negated@0]. - - "Mask out corner area (painting saveBits won't clear if transparent)." - mask copyBits: mask boundingBox from: (cornerMasks at: i) at: 0@0 clippingBox: mask boundingBox rule: Form over fillColor: nil map: (Bitmap with: 0 with: 16rFFFFFFFF). - outBits := aCanvas contentsOfArea: (corner + offset extent: mask extent). - mask displayOn: outBits at: 0@0 rule: Form and. - "Paint back corner bits." - saveBits displayOn: outBits at: 0@0 rule: Form paint. - "Paint back corner bits." - aCanvas drawImage: outBits at: corner + offset. - - w > 0 ifTrue:[ - - aCanvas stencil: (cornerOverlays at: i) at: corner + offset - color: (fourColors at: i)]]]. - aCanvas shadowColor: shadowColor. "restore shadow color" - !

1 0

The Trunk: Nebraska-mt.40.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Marcel Taeumel uploaded a new version of Nebraska to project The Trunk: http://source.squeak.org/trunk/Nebraska-mt.40.mcz ==================== Summary ==================== Name: Nebraska-mt.40 Author: mt Time: 26 February 2015, 6:21:34.677 pm UUID: 87029112-f31e-4d46-a380-9c0442f2bec7 Ancestors: Nebraska-bf.39 No CornerRounder anymore. Depended morphs have to round corners themselves. See Morphic-mt.760. =============== Diff against Nebraska-bf.39 =============== Item was removed: - ----- Method: RemoteCanvas>>roundCornersOf:in:during: (in category 'drawing-general') ----- - roundCornersOf: aMorph in: bounds during: aBlock - - self flag: #roundedRudeness. - - aMorph wantsRoundedCorners ifFalse:[^aBlock value]. - (self seesNothingOutside: (CornerRounder rectWithinCornersOf: bounds)) - ifTrue: ["Don't bother with corner logic if the region is inside them" - ^ aBlock value]. - CornerRounder roundCornersOf: aMorph on: self in: bounds - displayBlock: aBlock - borderWidth: aMorph borderWidthForRounding - corners: aMorph roundedCorners!

1 0

The Trunk: Morphic-mt.760.mcz
by commits＠source.squeak.org 26 Feb '15

26 Feb '15

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.760.mcz ==================== Summary ==================== Name: Morphic-mt.760 Author: mt Time: 26 February 2015, 6:19:14.906 pm UUID: fb8f4f20-e595-d444-a291-58885547c05f Ancestors: Morphic-topa.759 Corner rounding refactored. Does not rely on (spooky) CornerRounder implementation anymore. Many hacks for that CornerRounder could be removed from Morphic. A preference can be used to choose the preferred corner radius for rounded morphs. (Preferences > Morphic > Preferred Corner Radius) Subclasses may override the drawing of corners as needed. See draw* methods. =============== Diff against Morphic-topa.759 =============== Item was removed: - ----- Method: Canvas>>roundCornersOf:during: (in category 'drawing-general') ----- - roundCornersOf: aMorph during: aBlock - ^self roundCornersOf: aMorph in: aMorph bounds during: aBlock! Item was removed: - ----- Method: Canvas>>roundCornersOf:in:during: (in category 'drawing-general') ----- - roundCornersOf: aMorph in: bounds during: aBlock - ^aBlock value! Item was removed: - ----- Method: FormCanvas>>roundCornersOf:in:during: (in category 'drawing-general') ----- - roundCornersOf: aMorph in: bounds during: aBlock - aMorph wantsRoundedCorners ifFalse:[^aBlock value]. - (self seesNothingOutside: (CornerRounder rectWithinCornersOf: bounds)) - ifTrue: ["Don't bother with corner logic if the region is inside them" - ^ aBlock value]. - CornerRounder roundCornersOf: aMorph on: self in: bounds - displayBlock: aBlock - borderWidth: aMorph borderWidthForRounding - corners: aMorph roundedCorners! Item was changed: ----- Method: HandMorph>>fullDrawOn: (in category 'drawing') ----- fullDrawOn: aCanvas "A HandMorph has unusual drawing requirements: 1. the hand itself (i.e., the cursor) appears in front of its submorphs 2. morphs being held by the hand cast a shadow on the world/morphs below The illusion is that the hand plucks up morphs and carries them above the world." "Note: This version caches an image of the morphs being held by the hand for better performance. This cache is invalidated if one of those morphs changes." + | disableCaching subBnds | - | disableCaching subBnds roundCorners rounded | self visible ifFalse: [^self]. (aCanvas isVisible: self fullBounds) ifFalse: [^self]. (self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas]. disableCaching := false. disableCaching ifTrue: [self nonCachingFullDrawOn: aCanvas. ^self]. submorphs isEmpty ifTrue: [cacheCanvas := nil. ^self drawOn: aCanvas]. "just draw the hand itself" subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]). self updateCacheCanvas: aCanvas. (cacheCanvas isNil or: [cachedCanvasHasHoles and: [cacheCanvas depth = 1]]) ifTrue: ["could not use caching due to translucency; do full draw" self nonCachingFullDrawOn: aCanvas. ^self]. - "--> begin rounded corners hack <---" - roundCorners := cachedCanvasHasHoles == false - and: [submorphs size = 1 and: [submorphs first wantsRoundedCorners]]. - roundCorners - ifTrue: - [rounded := submorphs first. - aCanvas asShadowDrawingCanvas translateBy: self shadowOffset - during: - [:shadowCanvas | - shadowCanvas roundCornersOf: rounded - during: - [(subBnds areasOutside: (rounded boundsWithinCorners - translateBy: self shadowOffset negated)) - do: [:r | shadowCanvas fillRectangle: r color: Color black]]]. - aCanvas roundCornersOf: rounded - during: - [aCanvas - drawImage: cacheCanvas form - at: subBnds origin - sourceRect: cacheCanvas form boundingBox]. - ^self drawOn: aCanvas "draw the hand itself in front of morphs"]. - "--> end rounded corners hack <---" - "draw the shadow" aCanvas asShadowDrawingCanvas translateBy: self shadowOffset during: [:shadowCanvas | cachedCanvasHasHoles ifTrue: ["Have to draw the real shadow of the form" shadowCanvas paintImage: cacheCanvas form at: subBnds origin] ifFalse: ["Much faster if only have to shade the edge of a solid rectangle" (subBnds areasOutside: (subBnds translateBy: self shadowOffset negated)) do: [:r | shadowCanvas fillRectangle: r color: Color black]]]. "draw morphs in front of the shadow using the cached Form" cachedCanvasHasHoles ifTrue: [aCanvas paintImage: cacheCanvas form at: subBnds origin] ifFalse: [aCanvas drawImage: cacheCanvas form at: subBnds origin sourceRect: cacheCanvas form boundingBox]. self drawOn: aCanvas "draw the hand itself in front of morphs"! Item was changed: Object subclass: #Morph instanceVariableNames: 'bounds owner submorphs fullBounds color extension' + classVariableNames: 'PreferredCornerRadius' - classVariableNames: '' poolDictionaries: '' category: 'Morphic-Kernel'! !Morph commentStamp: 'efc 2/26/2003 20:01' prior: 0! A Morph (from the Greek "shape" or "form") is an interactive graphical object. General information on the Morphic system can be found at http://minnow.cc.gatech.edu/squeak/30. Morphs exist in a tree, rooted at a World (generally a PasteUpMorph). The morphs owned by a morph are its submorphs. Morphs are drawn recursively; if a Morph has no owner it never gets drawn. To hide a Morph and its submorphs, set its #visible property to false using the #visible: method. The World (screen) coordinate system is used for most coordinates, but can be changed if there is a TransformMorph somewhere in the owner chain. My instance variables have accessor methods (e.g., #bounds, #bounds:). Most users should use the accessor methods instead of using the instance variables directly. Structure: instance var Type Description bounds Rectangle A Rectangle indicating my position and a size that will enclose me. owner Morph My parent Morph, or nil for the top-level Morph, which is a or nil world, typically a PasteUpMorph. submorphs Array My child Morphs. fullBounds Rectangle A Rectangle minimally enclosing me and my submorphs. color Color My primary color. Subclasses can use this in different ways. extension MorphExtension Allows extra properties to be stored without adding a or nil storage burden to all morphs. By default, Morphs do not position their submorphs. Morphs may position their submorphs directly or use a LayoutPolicy to automatically control their submorph positioning. Although Morph has some support for BorderStyle, most users should use BorderedMorph if they want borders.! Item was added: + ----- Method: Morph class>>preferredCornerRadius (in category 'preferences') ----- + preferredCornerRadius + + <preference: 'Preferred Corner Radius' + category: 'Morphic' + description: 'If a morph wants rounded corners, use this radius. May be overwritten in subclasses.' + type: #Number> + ^ PreferredCornerRadius ifNil: [6]! Item was added: + ----- Method: Morph class>>preferredCornerRadius: (in category 'preferences') ----- + preferredCornerRadius: anInteger + + PreferredCornerRadius := anInteger.! Item was changed: ----- Method: Morph>>boundsWithinCorners (in category 'drawing') ----- boundsWithinCorners + "Return a single sub-rectangle that lies entirely inside corners + that are made by me. + Used to identify large regions of window that do not need to be redrawn." + ^ self wantsRoundedCorners + ifTrue: [self bounds insetBy: 0@self class preferredCornerRadius] + ifFalse: [self bounds] + ! - ^ CornerRounder rectWithinCornersOf: self bounds! Item was changed: ----- Method: Morph>>drawDropHighlightOn: (in category 'drawing') ----- drawDropHighlightOn: aCanvas + self highlightedForDrop ifTrue: [ + self wantsRoundedCorners + ifTrue: [aCanvas frameRoundRect: self fullBounds radius: self class preferredCornerRadius width: 1 color: self dropHighlightColor] + ifFalse: [aCanvas frameRectangle: self fullBounds color: self dropHighlightColor]].! - aCanvas frameRectangle: self fullBounds color: self dropHighlightColor].! Item was changed: ----- Method: Morph>>drawDropShadowOn: (in category 'drawing') ----- drawDropShadowOn: aCanvas aCanvas translateBy: self shadowOffset during: [ :shadowCanvas | + (shadowCanvas isVisible: self bounds) ifTrue: [ + self wantsRoundedCorners + ifTrue: [shadowCanvas fillRoundRect: self bounds radius: self class preferredCornerRadius fillStyle: self shadowColor] + ifFalse: [shadowCanvas fillRectangle: self bounds fillStyle: self shadowColor]]]. - shadowCanvas shadowColor: self shadowColor. - shadowCanvas roundCornersOf: self during: [ - (shadowCanvas isVisible: self bounds) ifTrue: - [shadowCanvas fillRectangle: self bounds fillStyle: self fillStyle]] - ]. ! Item was changed: ----- Method: Morph>>drawMouseDownHighlightOn: (in category 'drawing') ----- drawMouseDownHighlightOn: aCanvas + self highlightedForMouseDown ifTrue: [ + self wantsRoundedCorners + ifTrue: [aCanvas frameRoundRect: self fullBounds radius: self class preferredCornerRadius width: 1 color: self color darker darker] + ifFalse: [aCanvas frameRectangle: self fullBounds color: self color darker darker]].! - aCanvas frameRectangle: self fullBounds color: self color darker darker].! Item was changed: ----- Method: Morph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas + self wantsRoundedCorners + ifTrue: [aCanvas frameAndFillRoundRect: self bounds radius: self class preferredCornerRadius fillStyle: self fillStyle borderWidth: self borderStyle width borderColor: self borderStyle color] + ifFalse: [aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle]. + - aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle. ! Item was changed: ----- Method: Morph>>fullDrawOn: (in category 'drawing') ----- fullDrawOn: aCanvas "Draw the full Morphic structure on the given Canvas" self visible ifFalse: [^ self]. (aCanvas isVisible: self fullBounds) ifFalse:[^self]. (self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas]. "Note: At some point we should generalize this into some sort of multi-canvas so that we can cross-optimize some drawing operations." + "Pass 1: Draw eventual drop-shadow" self hasDropShadow ifTrue: [self drawDropShadowOn: aCanvas]. (self hasRolloverBorder and: [(aCanvas seesNothingOutside: self bounds) not]) ifTrue: [self drawRolloverBorderOn: aCanvas]. "Pass 2: Draw receiver itself" + (aCanvas isVisible: self bounds) ifTrue:[aCanvas drawMorph: self]. + self drawSubmorphsOn: aCanvas. + self drawDropHighlightOn: aCanvas. + self drawMouseDownHighlightOn: aCanvas.! - aCanvas roundCornersOf: self during:[ - (aCanvas isVisible: self bounds) ifTrue:[aCanvas drawMorph: self]. - self drawSubmorphsOn: aCanvas. - self drawDropHighlightOn: aCanvas. - self drawMouseDownHighlightOn: aCanvas].! Item was removed: - ----- Method: PluggableCanvas>>roundCornersOf:in:during: (in category 'drawing-general') ----- - roundCornersOf: aMorph in: bounds during: aBlock - aMorph wantsRoundedCorners ifFalse:[^aBlock value]. - (self seesNothingOutside: (CornerRounder rectWithinCornersOf: bounds)) - ifTrue: ["Don't bother with corner logic if the region is inside them" - ^ aBlock value]. - CornerRounder roundCornersOf: aMorph on: self in: bounds - displayBlock: aBlock - borderWidth: aMorph borderWidthForRounding - corners: aMorph roundedCorners! Item was changed: ----- Method: WorldState>>displayWorld:submorphs: (in category 'update cycle') ----- displayWorld: aWorld submorphs: submorphs "Update this world's display." + | deferredUpdateMode handsToDraw allDamage handDamageRects worldDamageRects | - | deferredUpdateMode handsToDraw allDamage | submorphs do: [:m | m fullBounds]. "force re-layout if needed" self checkIfUpdateNeeded ifFalse: [^ self]. "display is already up-to-date" deferredUpdateMode := self doDeferredUpdatingFor: aWorld. deferredUpdateMode ifFalse: [self assuredCanvas]. - canvas roundCornersOf: aWorld during:[ | handDamageRects worldDamageRects | - worldDamageRects := self drawWorld: aWorld submorphs: submorphs invalidAreasOn: canvas. "repair world's damage on canvas" - "self handsDo:[:h| h noticeDamageRects: worldDamageRects]." - handsToDraw := self selectHandsToDrawForDamage: worldDamageRects. - handDamageRects := handsToDraw collect: [:h | h savePatchFrom: canvas]. - allDamage := worldDamageRects, handDamageRects. + worldDamageRects := self drawWorld: aWorld submorphs: submorphs invalidAreasOn: canvas. "repair world's damage on canvas" + "self handsDo:[:h| h noticeDamageRects: worldDamageRects]." + handsToDraw := self selectHandsToDrawForDamage: worldDamageRects. + handDamageRects := handsToDraw collect: [:h | h savePatchFrom: canvas]. + allDamage := worldDamageRects, handDamageRects. + + handsToDraw reverseDo: [:h | canvas fullDrawMorph: h]. "draw hands onto world canvas" + - handsToDraw reverseDo: [:h | canvas fullDrawMorph: h]. "draw hands onto world canvas" - ]. "*make this true to flash damaged areas for testing*" Preferences debugShowDamage ifTrue: [aWorld flashRects: allDamage color: Color black]. canvas finish: allDamage. "quickly copy altered rects of canvas to Display:" deferredUpdateMode ifTrue: [self forceDamageToScreen: allDamage] ifFalse: [canvas showAt: aWorld viewBox origin invalidRects: allDamage]. handsToDraw do: [:h | h restoreSavedPatchOn: canvas]. "restore world canvas under hands" Display deferUpdates: false; forceDisplayUpdate. !

1 0

← Newer
1
2
3
4
5
6
7
8
...
16
Older →

Jump to page: