'From Squeak2.8alpha of 17 April 2000 [latest update: #1997] on 12 March 2001 at 10:13:50 am'! Morph subclass: #StarSqueakMorph instanceVariableNames: 'dimensions pixelsPerPatch patchVariables patchVariableToDisplay logPatchVariableScale patchVarDisplayForm patchForm patchColorSetter patchColorGetter turtles turtleDemons worldDemons sniffRange scaledEvaporationRate diffusionRate lastTurtleID generation running stepTime turtlesAtPatchCache turtlesAtPatchCacheValid ' classVariableNames: 'RandomSeed ' poolDictionaries: '' category: 'StarSqueak-Kernel'! !StarSqueakMorph commentStamp: 'jm 3/12/2001 09:53' prior: 0! I implement a StarSqueak simulation. StarSqueak is a Squeak version of Mitchel Resnick's Star Logo, a simulation environment designed to explore massively parallel simulations with hundreds or thousands of turtles. See the excellent book "Turtles, Termites, and Traffic Jams: Explorations in Massively Parallel Microworlds" by Mitchel Resnick, MIT Press, 1994. ! StarSqueakMorph subclass: #StarSqueakAntColony instanceVariableNames: 'antCount ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakMorph subclass: #StarSqueakDiffusion instanceVariableNames: 'waterCount dyeCount ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakMorph subclass: #StarSqueakForestFire instanceVariableNames: 'treePercentage ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakMorph class instanceVariableNames: ''! Object subclass: #StarSqueakPatch instanceVariableNames: 'world worldWidth worldHeight x y ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Kernel'! !StarSqueakPatch commentStamp: 'jm 3/12/2001 09:49' prior: 0! I represent a patch in a StarSqueak world. Patch objects are not retained, but are created as needed, such as in patchesDo:. ! InterpreterPlugin subclass: #StarSqueakPlugin instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Kernel'! !StarSqueakPlugin commentStamp: 'jm 3/12/2001 09:47' prior: 0! This plugin defines primitives accelerators to support StarSqueak. The plugin library, usually named "StarSqueakPlugin", should be put in the same folder as the Squeak interpreter. If this plugin is not available the primitives will still work, but they will be run much more slowly, since they will be running as Squeak code. ! StarSqueakMorph subclass: #StarSqueakSlimeMold instanceVariableNames: 'cellCount ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakMorph subclass: #StarSqueakTermites instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakMorph subclass: #StarSqueakTrees instanceVariableNames: 'depth treeTypeSelector ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! Object subclass: #StarSqueakTurtle instanceVariableNames: 'world who x y wrapX wrapY headingRadians color penDown nextTurtle ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Kernel'! !StarSqueakTurtle commentStamp: 'jm 3/12/2001 09:54' prior: 0! I represent a "creature" that can move about on the surface of a StarSqueak world. I have a position and a heading (direction), and respond commands such as "turnRight:" and "forward:" by turning or moving. I also have an imaginary pen that can draw a trail as I move. In StarSqueak, turtles are born with random positions and headings. Here are some expressions to try in a workspace: w _ StarSqueakMorph new openInWorld. "make an empty world" w makeTurtles: 100. "create 100 turtles" w turtlesDo: [:t | t forward: 1]. "tell all turtles to take a step" w turtlesDo: [:t | t goto: 50@50]. "tell all turtles to go to 50@50" w turtlesDo: [:t | t forward: 10]. "tell all turtles to take 10 steps" Structure: world StarSqueakMorph the world that owns this turtle who integer unique id x number x position in world y number y position in world wrapX float private; used for wrapping in x wrapY float private; used for wrapping in y headingRadians float heading in radians color color turtle color and its pen color penDown boolean true if drawing a pen trail nextTurtle StarSqueaktTurtle private; used to make linked list of turtles ! StarSqueakTurtle subclass: #AntColonyTurtle instanceVariableNames: 'isCarryingFood pheromoneDropSize ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakTurtle subclass: #DiffusionTurtle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakTurtle subclass: #SlimeMoldTurtle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakTurtle subclass: #TermiteTurtle instanceVariableNames: 'isCarryingChip ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! StarSqueakTurtle subclass: #TreeTurtle instanceVariableNames: 'depth length ' classVariableNames: '' poolDictionaries: '' category: 'StarSqueak-Worlds'! !StarSqueakMorph methodsFor: 'initialization' stamp: 'jm 2/7/2001 19:08'! initialize super initialize. dimensions _ self starSqueakDimensions. "dimensions of this StarSqueak world in patches" pixelsPerPatch _ 2. super extent: dimensions * pixelsPerPatch. self evaporationRate: 6. self diffusionRate: 1. self clearAll. "be sure this is done once in case setup fails to do it" self setup. ! ! !StarSqueakMorph methodsFor: 'accessing' stamp: 'jm 2/7/2001 13:48'! diffusionRate ^ diffusionRate ! ! !StarSqueakMorph methodsFor: 'accessing' stamp: 'jm 3/3/2001 12:48'! diffusionRate: newRate "Set the diffusion rate to an integer between 0 and 10. The diffusion rate gives the number of patches on one size of the area averaged to compute the next value of the variable for a given patch. Larger numbers cause faster diffusion. Zero means no diffusion." diffusionRate _ (newRate rounded max: 0) min: 10. ! ! !StarSqueakMorph methodsFor: 'accessing' stamp: 'jm 2/7/2001 18:59'! evaporationRate ^ 1024 - scaledEvaporationRate! ! !StarSqueakMorph methodsFor: 'accessing' stamp: 'jm 2/7/2001 18:59'! evaporationRate: newRate "Set the evaporation rate. The useful range is 0 to 25 or so. Larger numbers cause faster evaporation. Zero means no evaporization." scaledEvaporationRate _ ((1024 - newRate truncated) max: 1) min: 1024. ! ! !StarSqueakMorph methodsFor: 'accessing' stamp: 'jm 3/3/2001 12:50'! pixelsPerPatch ^ pixelsPerPatch ! ! !StarSqueakMorph methodsFor: 'accessing' stamp: 'jm 3/3/2001 12:53'! pixelsPerPatch: anInteger "Set the width of one patch in pixels. Larger numbers scale up this StarSqueak world, but numbers larger than 2 or 3 result in a blocky look. The useful range is 1 to 10." pixelsPerPatch _ (anInteger rounded max: 1) min: 10. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 1/28/2001 15:33'! addTurtleDemon: aSelector "Add the given selector to the list of selectors sent to every turtle on every step." turtleDemons _ turtleDemons copyWith: aSelector. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 1/28/2001 15:34'! addWorldDemon: aSelector "Add the given selector to the list of selectors sent to the world on every step." worldDemons _ worldDemons copyWith: aSelector. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 3/7/2001 18:57'! clearAll "Reset this StarSqueak world. All patch variables are cleared, all turtles are removed, and all demons are turned off." patchVariables _ Dictionary new: 10. patchVariableToDisplay _ nil. logPatchVariableScale _ 0. patchForm _ Form extent: (dimensions * pixelsPerPatch) depth: 32. self createPatchFormGetterAndSetter. patchVarDisplayForm _ nil. self clearPatches. turtles _ #(). turtleDemons _ #(). worldDemons _ #(). sniffRange _ 1. lastTurtleID _ -1. generation _ 0. running _ false. stepTime _ 0. "full speed" turtlesAtPatchCache _ nil. turtlesAtPatchCacheValid _ false. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 1/24/2001 12:42'! displayPatchVariable: patchVarName "Make this StarSqueak world display the patch variable of the given name. Only one patch variable can be displayed at any given time." self displayPatchVariable: patchVarName logScale: -2. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 3/3/2001 12:54'! displayPatchVariable: patchVarName logScale: logBase2OfScaleFactor "Make this StarSqueak world display the patch variable of the given name. Only one patch variable can be displayed at any given time. Values are scaled by 2^logBase2OfScaleFactor. For example, a value of 5 scales by 32 and a value of -2 scales by 1/4." (patchVariables includesKey: patchVarName) ifFalse: [ patchVariableToDisplay _ nil. patchVarDisplayForm _ nil. ^ self]. patchVariableToDisplay _ patchVarName. patchVarDisplayForm _ Form extent: (dimensions * pixelsPerPatch) depth: 32. logPatchVariableScale _ logBase2OfScaleFactor. self clearPatches. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 1/19/2001 19:16'! random: range "Answer a random integer between 0 and range." RandomSeed _ ((RandomSeed * 1309) + 13849) bitAnd: 65535. ^ (RandomSeed * (range + 1)) // 65536 ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 1/23/2001 07:24'! setup "Subclasses should override this to setup the initial conditions of this StarSqueak world. The method should start with 'self clearAll'." self clearAll. ! ! !StarSqueakMorph methodsFor: 'setup' stamp: 'jm 3/3/2001 12:54'! starSqueakDimensions "Answer the dimensions of this StarSqueak simulation. Subclasses can override this method to define their own world size." ^ 100@100 ! ! !StarSqueakMorph methodsFor: 'turtles' stamp: 'jm 3/12/2001 09:44'! makeTurtles: count "Create the given number of generic turtles." self makeTurtles: count class: StarSqueakTurtle. ! ! !StarSqueakMorph methodsFor: 'turtles' stamp: 'jm 3/3/2001 18:04'! makeTurtles: count class: turtleClass "Create the given number of turtles of the given turtle class." turtles _ turtles, ((1 to: count) collect: [:i | turtleClass new initializeWorld: self who: (lastTurtleID _ lastTurtleID + 1)]). self changed. ! ! !StarSqueakMorph methodsFor: 'turtles' stamp: 'jm 1/28/2001 10:55'! turtles ^ turtles ! ! !StarSqueakMorph methodsFor: 'turtles' stamp: 'jm 3/3/2001 17:41'! turtlesAtX: x y: y do: aBlock "Evaluate the given block for each turtle at the given location." | t | t _ self firstTurtleAtX: x y: y. [t == nil] whileFalse: [ aBlock value: t. t _ t nextTurtle]. ! ! !StarSqueakMorph methodsFor: 'turtles' stamp: 'jm 3/3/2001 18:08'! turtlesDo: aBlock "Evaluate the given block for every turtle. For example: w turtlesDo: [:t | t forward: 1] will tell every turtle to go forward by one turtle step." turtles do: aBlock. self changed. ! ! !StarSqueakMorph methodsFor: 'patches' stamp: 'jm 3/8/2001 13:47'! clearPatches "Clear patch colors, including turtle trails." patchForm fill: patchForm boundingBox fillColor: Color black. ! ! !StarSqueakMorph methodsFor: 'patches' stamp: 'jm 1/22/2001 16:52'! createPatchVariable: patchVarName "Create a patch variable of the given name. It is initialized to a value of zero for every patch." patchVariables at: patchVarName put: (Bitmap new: (dimensions x * dimensions y) withAll: 0). ! ! !StarSqueakMorph methodsFor: 'patches' stamp: 'jm 2/6/2001 17:54'! decayPatchVariable: patchVarName "Decay the values of the patch variable of the given name. That is, the value of each patch is replaced by a fraction of its former value, resulting in an expontial decay each patch's value over time. This can be used to model evaporation of a pheromone." | patchVar | patchVar _ patchVariables at: patchVarName ifAbsent: [^ self]. self primEvaporate: patchVar rate: scaledEvaporationRate. ! ! !StarSqueakMorph methodsFor: 'patches' stamp: 'jm 2/7/2001 14:13'! diffusePatchVariable: patchVarName "Diffuse the patch variable of the given name." | v newV | diffusionRate = 0 ifTrue: [^ self]. "no diffusion" v _ patchVariables at: patchVarName ifAbsent: [^ self]. newV _ Bitmap new: v size. self primDiffuseFrom: v to: newV width: dimensions x height: dimensions y delta: diffusionRate truncated. patchVariables at: patchVarName put: newV. ! ! !StarSqueakMorph methodsFor: 'patches' stamp: 'jm 3/12/2001 09:44'! patchesDo: aBlock "Evaluate the given block for every patch in this world." | patch | patch _ StarSqueakPatch new world: self. 0 to: dimensions y - 1 do: [:y | patch y: y. 0 to: dimensions x - 1 do: [:x | patch x: x. aBlock value: patch]]. ! ! !StarSqueakMorph methodsFor: 'drawing' stamp: 'jm 3/3/2001 12:55'! areasRemainingToFill: aRectangle "Drawing optimization. Since I completely fill my bounds with opaque pixels, this method tells Morphic that it isn't necessary to draw any morphs covered by me." ^ aRectangle areasOutside: self bounds ! ! !StarSqueakMorph methodsFor: 'drawing' stamp: 'jm 3/7/2001 18:49'! display "Display this world on the Display. Used for debugging." | c | c _ FormCanvas extent: (dimensions * pixelsPerPatch) depth: 32. c _ c copyOffset: bounds origin negated. self drawOn: c. c form display. ! ! !StarSqueakMorph methodsFor: 'drawing' stamp: 'jm 3/8/2001 13:40'! drawOn: aCanvas "Display this StarSqueak world." | tmpForm bitBlt t | "copy the patches form" tmpForm _ patchForm deepCopy. "draw patchVariableToDisplay on top of tmpForm as translucent color" self displayPatchVariableOn: tmpForm color: Color yellow shift: logPatchVariableScale. "draw turtles on top of tmpForm" bitBlt _ (BitBlt toForm: tmpForm) clipRect: tmpForm boundingBox; combinationRule: Form over. 1 to: turtles size do: [:i | t _ turtles at: i. bitBlt destX: (pixelsPerPatch * t x truncated) destY: (pixelsPerPatch * t y truncated) width: pixelsPerPatch height: pixelsPerPatch. bitBlt fillColor: t color; copyBits]. "display tmpForm" aCanvas paintImage: tmpForm at: bounds origin. ! ! !StarSqueakMorph methodsFor: 'geometry' stamp: 'jm 2/7/2001 13:31'! extent: aPoint "Do nothing; my extent is determined by my StarSqueak world dimensions and pixelsPerPatch." ! ! !StarSqueakMorph methodsFor: 'stepping and presenter' stamp: 'jm 3/7/2001 18:40'! oneStep "Perform one step of the StarSqueak world. Execute all turtle and world demons." | currentTurtles | "run demons in random order and increment the generation counter" turtleDemons size > 0 ifTrue: [ "Note: Make a copy of turtles list that won't change if turtles are created/deleted." currentTurtles _ turtles copy. turtleDemons shuffled do: [:sel | 1 to: currentTurtles size do: [:i | (currentTurtles at: i) perform: sel]]]. worldDemons shuffled do: [:sel | self perform: sel]. generation _ generation + 1. turtlesAtPatchCacheValid _ false. ! ! !StarSqueakMorph methodsFor: 'stepping and presenter' stamp: 'jm 1/26/2001 17:21'! step running ifTrue: [ self oneStep. self changed]. ! ! !StarSqueakMorph methodsFor: 'stepping and presenter' stamp: 'jm 1/22/2001 17:52'! stepTime ^ stepTime ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/7/2001 13:42'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine. aCustomMenu add: 'start' action: #startRunning. aCustomMenu add: 'stop' action: #stopRunning. aCustomMenu add: 'step' action: #singleStep. aCustomMenu add: 'start over' action: #startOver. aCustomMenu addLine. aCustomMenu add: 'full speed' action: #fullSpeed. aCustomMenu add: 'slow speed' action: #slowSpeed. aCustomMenu addLine. aCustomMenu add: 'set scale' action: #setScale. aCustomMenu add: 'make parameter slider' action: #makeParameterSlider. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 1/23/2001 07:00'! fullSpeed "Run at maximum speed." stepTime _ 0. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/7/2001 18:48'! makeParameterSlider | menu choice s | menu _ CustomMenu new title: 'Parameter?'. self sliderParameters do: [:rec | menu add: rec first action: rec]. choice _ menu startUp. choice ifNil: [^ self]. s _ self newSliderForParameter: (choice at: 1) target: self min: (choice at: 2) max: (choice at: 3) description: (choice at: 4). self world activeHand attachMorph: s. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/6/2001 20:15'! setScale | reply | reply _ FillInTheBlank request: 'Set the number of pixels per patch (a number between 1 and 10)?' initialAnswer: pixelsPerPatch printString. reply isEmpty ifTrue: [^ self]. pixelsPerPatch _ ((reply asNumber rounded) max: 1) min: 10. self changed. super extent: dimensions * pixelsPerPatch. self clearAll. "be sure this is done once in case setup fails to do it" self setup. self startOver. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/5/2001 17:52'! singleStep "Take one step and redisplay." self oneStep. self changed. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/7/2001 19:07'! sliderParameters "Answer a list of parameters that the user can change via a slider. Each parameter is described by an array of: ." ^ #((evaporationRate 0 40 'The rate at which chemicals evaporate in this world. Larger numbers give faster evaporation.') (diffusionRate 0 5 'The rate of chemical diffusion. Larger numbers give quicker diffusion.')) ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/7/2001 19:21'! slowSpeed "Run at slow speed." stepTime _ 250. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/6/2001 22:04'! startOver "Restart this StarSqueak simulation from its initial conditions." self clearAll. self setup. self changed. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/5/2001 17:54'! startRunning "Start running this StarSqueak simulation." running _ true. ! ! !StarSqueakMorph methodsFor: 'menu' stamp: 'jm 2/5/2001 17:54'! stopRunning "STop running this StarSqueak simulation." running _ false. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 2/5/2001 17:57'! createPatchFormGetterAndSetter "Create BitBlt's for getting and setting patch colors." patchColorGetter _ BitBlt bitPeekerFromForm: patchForm. patchColorSetter _ (BitBlt toForm: patchForm) combinationRule: Form over; clipRect: patchForm boundingBox; width: pixelsPerPatch; height: pixelsPerPatch. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/26/2001 17:41'! deleteTurtle: aTurtle "Delete the given turtle from this world." turtles _ turtles copyWithout: aTurtle. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/22/2001 16:58'! dimensions ^ dimensions ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 3/8/2001 13:42'! displayPatchVariableOn: aForm color: aColor shift: shiftAmount "Display patchVariableToDisplay in the given color. The opacity (alpha) of of each patch is determined by the patch variable value for that patch and shiftAmount. If shiftAmount is zero, the source value is unscaled. Positive shiftAmount values result in right shifting the source value by the given number of bits (That is, multiplying by 2^N. Negative values perform right shifts, dividing by 2^N)." | patchVar bitBlt w rowOffset alpha | patchVariableToDisplay ifNil: [^ self]. patchVar _ patchVariables at: patchVariableToDisplay ifAbsent: [^ self]. "set up the BitBlt" bitBlt _ (BitBlt toForm: aForm) sourceRect: (0@0 extent: pixelsPerPatch); fillColor: aColor; combinationRule: 30. w _ dimensions x. 0 to: dimensions y - 1 do: [:y | rowOffset _ (y * w) + 1. 0 to: w - 1 do: [:x | alpha _ (patchVar at: (rowOffset + x)) bitShift: shiftAmount. alpha > 255 ifTrue: [alpha _ 255]. alpha > 1 ifTrue: [ "if not transparent, fill using the given alpha" bitBlt destOrigin: (x * pixelsPerPatch)@(y * pixelsPerPatch). bitBlt copyBitsTranslucent: alpha]]]. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 3/3/2001 19:45'! firstTurtleAtX: xPos y: yPos | w t x y index | "create turtlesAtPatchCache if necessary" turtlesAtPatchCache ifNil: [ turtlesAtPatchCache _ Array new: (dimensions x * dimensions y) withAll: nil. turtlesAtPatchCacheValid _ false]. w _ dimensions y. turtlesAtPatchCacheValid ifFalse: [ turtlesAtPatchCache atAllPut: nil. "cache not yet computed for this step; make linked list of turtles for each patch" 1 to: turtles size do: [:i | t _ turtles at: i. x _ t x truncated. x < 1 ifTrue: [x _ 1]. y _ t y truncated. y < 1 ifTrue: [y _ 1]. index _ (w * (y - 1)) + x. t nextTurtle: (turtlesAtPatchCache at: index). turtlesAtPatchCache at: index put: t]. turtlesAtPatchCacheValid _ true]. x _ xPos truncated. x < 1 ifTrue: [x _ 1]. y _ yPos truncated. y < 1 ifTrue: [y _ 1]. index _ (w * (y - 1)) + x. ^ turtlesAtPatchCache at: index ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/26/2001 14:00'! getPatchBrightnessAtX: x y: y "Answer the brightness of the patch at the given location, a number from 0 to 100." | c | c _ self getPatchColorAtX: x y: y. ^ (c brightness * 100.0) rounded ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 2/7/2001 07:23'! getPatchColorAtX: x y: y "Answer the color of the patch at the given location." | pixel | pixel _ patchColorGetter pixelAt: (pixelsPerPatch * x truncated)@(pixelsPerPatch * y truncated). ^ Color colorFromPixelValue: pixel depth: patchForm depth ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/27/2001 09:08'! getPatchVariable: patchVarName atX: xPos y: yPos "Answer the value of the given patch variable at the given turtle. Answer zero if the turtle is out of bounds." | x y i | x _ xPos truncated. y _ yPos truncated. ((x < 0) or: [y < 0]) ifTrue: [^ 0]. ((x >= dimensions x) or: [y >= dimensions y]) ifTrue: [^ 0]. i _ ((y * dimensions x) + x) truncated + 1. ^ (patchVariables at: patchVarName ifAbsent: [^ 0]) at: i ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/27/2001 09:10'! incrementPatchVariable: patchVarName atX: xPos y: yPos by: amount "Increment the value of the given patch variable at the given location by the given amount. Do nothing if the location is out of bounds." | x y i var | x _ xPos truncated. y _ yPos truncated. ((x < 0) or: [y < 0]) ifTrue: [^ self]. ((x >= dimensions x) or: [y >= dimensions y]) ifTrue: [^ self]. i _ ((y * dimensions x) + x) truncated + 1. var _ patchVariables at: patchVarName ifAbsent: [^ self]. var at: i put: ((var at: i) + amount). ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 2/8/2001 10:26'! newSliderForParameter: parameter target: target min: min max: max description: description | c slider r s | c _ (AlignmentMorph newColumn) color: Color lightBlue; borderWidth: 2; hResizing: #shrinkWrap; vResizing: #shrinkWrap; useRoundedCorners. slider _ SimpleSliderMorph new color: (Color r: 0.065 g: 0.548 b: 0.645); extent: 150@2; target: target; actionSelector: (parameter, ':') asSymbol; minVal: min; maxVal: max; adjustToValue: (target perform: parameter asSymbol). c addMorphBack: slider. r _ (AlignmentMorph newRow) color: Color lightBlue; hResizing: #spaceFill; vResizing: #spaceFill. s _ StringMorph new contents: parameter, ': '. r addMorphBack: s. s _ UpdatingStringMorph new target: target; getSelector: parameter asSymbol; putSelector: (parameter, ':') asSymbol; floatPrecision: (10.0 raisedTo: (((max - min) / 150.0) log: 10) floor); step. r addMorphBack: s. c addMorphBack: r. c setBalloonText: description. ^ c ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/18/2001 21:58'! patchVariable: patchVarName ifAbsent: aBlock "Answer the patch variable array of the given name. If no such patch variables exists, answer the result of evaluating the given block." ^ patchVariables at: patchVarName ifAbsent: aBlock ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/27/2001 08:43'! replicateTurtle: aTurtle "Create an exact copy of the given turtle and add it to this world." | newTurtle | newTurtle _ aTurtle clone who: (lastTurtleID _ lastTurtleID + 1). turtles _ turtles copyWith: newTurtle. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/24/2001 14:47'! setPatchBrightnessAtX: x y: y to: percent "Set the brightness of the patch at the given location to the given level, where 0 is black and 100 is full brightness." | c brightness | c _ self getPatchColorAtX: x y: y. brightness _ percent / 100.0. brightness < 0.03125 ifTrue: [brightness _ 0.03125]. self setPatchColorAtX: x y: y to: (Color h: c hue s: c saturation v: brightness). ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 2/7/2001 07:20'! setPatchColorAtX: x y: y to: aColor "Paint the patch at the given location with the given color." patchColorSetter fillColor: aColor; destX: (pixelsPerPatch * x truncated); destY: (pixelsPerPatch * y truncated); copyBits. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/27/2001 09:05'! setPatchVariable: patchVarName atX: xPos y: yPos to: newValue "Set the value of the given patch variable below the given turtle to the given value. Do nothing if the turtle is out of bounds." | x y i var | x _ xPos truncated. y _ yPos truncated. ((x < 0) or: [y < 0]) ifTrue: [^ self]. ((x >= dimensions x) or: [y >= dimensions y]) ifTrue: [^ self]. i _ ((y * dimensions x) + x) truncated + 1. var _ patchVariables at: patchVarName ifAbsent: [^ self]. var at: i put: newValue. ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/29/2001 09:39'! sumPatchVariable: patchVarName neighborsAtX: xPos y: yPos "Answer the sum of the given patch variable for the eight neighbors of the patch at the given location. Answer zero if the location is out of bounds." | patchVar x y w h xLeft xRight rowOffset sum | patchVar _ patchVariables at: patchVarName ifAbsent: [^ 0]. x _ xPos truncated. y _ yPos truncated. w _ dimensions x. h _ dimensions y. ((x < 0) or: [y < 0]) ifTrue: [^ 0]. ((x >= w) or: [y >= h]) ifTrue: [^ 0]. xLeft _ (x - 1) \\ w. "column before x, wrapped" xRight _ (x + 1) \\ w. "column after x, wrapped" rowOffset _ y * w. sum _ (patchVar at: rowOffset + xLeft) + (patchVar at: rowOffset + xRight). rowOffset _ ((y - 1) \\ h) * w. "row above y, wrapped" sum _ sum + (patchVar at: rowOffset + xLeft) + (patchVar at: rowOffset + x) + (patchVar at: rowOffset + xRight). rowOffset _ ((y + 1) \\ h) * w. "row below y, wrapped" sum _ sum + (patchVar at: rowOffset + xLeft) + (patchVar at: rowOffset + x) + (patchVar at: rowOffset + xRight). ^ sum ! ! !StarSqueakMorph methodsFor: 'private' stamp: 'jm 1/22/2001 16:53'! uphillOf: patchVarName forTurtle: aTurtle "Answer the heading the points in the direction of increasing value for the given patch variable. If there is no gradient, or if the turtle is outside the world bounds, answer the turtles current heading." | patchVar turtleX turtleY startX endX startY endY maxVal rowOffset thisVal maxValX maxValY | patchVar _ patchVariables at: patchVarName ifAbsent: [^ aTurtle heading]. turtleX _ aTurtle x truncated + 1. turtleY _ aTurtle y truncated + 1. turtleX < 1 ifTrue: [turtleX _ 1]. turtleY < 1 ifTrue: [turtleY _ 1]. turtleX > dimensions x ifTrue: [turtleX _ dimensions x]. turtleY > dimensions y ifTrue: [turtleY _ dimensions y]. startX _ (turtleX - sniffRange) max: 1. endX _ (turtleX + sniffRange) min: dimensions x. startY _ (turtleY - sniffRange) max: 1. endY _ (turtleY + sniffRange) min: dimensions y. maxVal _ patchVar at: (((turtleY - 1) * dimensions x) + turtleX). maxValX _ nil. startY to: endY do: [:y | rowOffset _ (y - 1) * dimensions x. startX to: endX do: [:x | thisVal _ patchVar at: (rowOffset + x). thisVal > maxVal ifTrue: [ maxValX _ x. maxValY _ y. maxVal _ thisVal]]]. nil = maxValX ifTrue: [^ aTurtle heading]. ^ (((maxValX - turtleX) @ (maxValY - turtleY)) degrees + 90.0) \\ 360.0 ! ! !StarSqueakMorph methodsFor: 'private-primitives' stamp: 'jm 3/12/2001 09:45'! primDiffuseFrom: srcBitmap to: dstBitmap width: width height: height delta: delta "Diffuse the integer values of the source patch variable Bitmap into the output Bitmap. Each cell of the output is the average of the NxN area around it in the source, where N = (2 * delta) + 1." | area startY endY startX endX sum rowStart | area _ ((2 * delta) + 1) * ((2 * delta) + 1). 1 to: height do: [:y | startY _ y - delta. startY < 1 ifTrue: [startY _ 1]. endY _ y + delta. endY > height ifTrue: [endY _ height]. 1 to: width do: [:x | startX _ x - delta. startX < 1 ifTrue: [startX _ 1]. endX _ x + delta. endX > width ifTrue: [endX _ width]. sum _ 0. startY to: endY do: [:y2 | rowStart _ (y2 - 1) * width. startX to: endX do: [:x2 | sum _ sum + (srcBitmap at: rowStart + x2)]]. dstBitmap at: (((y - 1) * width) + x) put: (sum // area)]]. ! ! !StarSqueakMorph methodsFor: 'private-primitives' stamp: 'jm 3/12/2001 09:45'! primEvaporate: aBitmap rate: rate "Evaporate the integer values of the source Bitmap at the given rate, an integer between 0 and 1024, where 1024 is a scale factor of 1.0 (i.e., no evaporation). That is, replace each integer element v with (rate * v) / 1024." 1 to: aBitmap size do: [:i | aBitmap at: i put: (((aBitmap at: i) * rate) bitShift: -10)]. ! ! !StarSqueakMorph methodsFor: 'private-primitives' stamp: 'jm 3/12/2001 09:45'! primMapFrom: srcBitmap to: dstBitmap width: w height: h patchSize: patchSize rgbFlags: rgbFlags shift: shiftAmount "Map values in the source bitmap (interpreted as unsigned 32-bit integers) to 2x2 patches of color in the destination bitmap. The color brightness level is determined by the source value and the color hue is determined by the bottom three bits of the rgbFlags value. For example, if rgbFlags is 1, you get shades of blue, if it is 6 you get shades of yellow, and if it is 7, you get shades of gray. The shiftAmount is used to scale the source data values by a power of two. If shiftAmount is zero, the data is unscaled. Positive shiftAmount values result in right shifting the source data by the given number of bits (multiplying by 2^N, negative values perform right shifts (dividing by 2^N). The width parameter gives the width of the Form that owns the destination bitmap." StarSqueakPlugin doPrimitive: 'primitiveMapFromToWidthHeightPatchSizeRgbFlagsShift'. ! ! !StarSqueakMorph methodsFor: 'private-primitives' stamp: 'jm 2/6/2001 17:42'! testDiffusePrim "This test should diffuse the initial value in the center cell so that each cell has 1000." "StarSqueakMorph new testDiffusePrim" | src dst | src _ Bitmap new: 49. src at: 25 put: 49000. dst _ Bitmap new: 49. self primDiffuseFrom: src to: dst width: 7 height: 7 delta: 3. ^ dst asArray ! ! !StarSqueakMorph methodsFor: 'private-primitives' stamp: 'jm 2/6/2001 17:47'! testEvaporatePrim "This test should result in reducing each element of the array to 75% of its initial value." "StarSqueakMorph new testEvaporatePrim" | data | data _ Bitmap new: 10. 1 to: data size do: [:i | data at: i put: (10000 * i)]. self primEvaporate: data rate: (75 * 1024) // 100. ^ data asArray ! ! !StarSqueakAntColony methodsFor: 'parameters' stamp: 'jm 2/7/2001 14:45'! antCount ^ antCount ! ! !StarSqueakAntColony methodsFor: 'parameters' stamp: 'jm 2/7/2001 14:46'! antCount: aNumber antCount _ aNumber. ! ! !StarSqueakAntColony methodsFor: 'parameters' stamp: 'jm 3/11/2001 17:10'! backgroundColor ^ Color brown lighter lighter lighter! ! !StarSqueakAntColony methodsFor: 'parameters' stamp: 'jm 2/7/2001 19:31'! initialize antCount _ 50. super initialize. ! ! !StarSqueakAntColony methodsFor: 'parameters' stamp: 'jm 2/7/2001 18:41'! sliderParameters "Answer a list of parameters that the user can change via a slider. Each parameter is described by an array of: ." ^ super sliderParameters, #( (antCount 10 500 'The number of ants searching for food.')) ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 1/19/2001 10:30'! diffusePheromone self diffusePatchVariable: 'pheromone'. ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 1/19/2001 18:02'! evaporatePheromone self decayPatchVariable: 'pheromone'. ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 2/7/2001 06:49'! setup self clearAll. self setupPatches. self setupTurtles. turtleDemons _ #(searchForFood pickUpFood returnToNest dropFoodInNest). worldDemons _ #(evaporatePheromone diffusePheromone). ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 2/7/2001 08:03'! setupFood: aPatch "Create several food caches." aPatch set: 'food' to: 0. "patch default is no food" ((aPatch distanceTo: 15@15) <= 1 or: [(aPatch distanceTo: 80@20) <= 1 or: [(aPatch distanceTo: 25@80) <= 1 or: [(aPatch distanceTo: 70@70) <= 1]]]) ifTrue: [ aPatch set: 'food' to: 10. aPatch color: Color red]. ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 3/11/2001 17:11'! setupNest: aPatch "Create a nest of radius 5 centered at 50@50." | distanceToNest | distanceToNest _ aPatch distanceTo: 50@50. distanceToNest <= 4 ifTrue: [ aPatch set: 'isNest' to: 1. aPatch color: Color brown lighter] ifFalse: [aPatch set: 'isNest' to: 0]. "create a 'hill' of nest scent centered on the nest" distanceToNest > 0 ifTrue: [ aPatch set: 'nestScent' to: 10000.0 // distanceToNest]. ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 3/8/2001 14:23'! setupPatches "Create patch variables for sensing the nest and food caches. The nestScent variable is diffused so that it forms a 'hill' of scent over the entire world with its peak at the center of the nest. That way, the ants always know which way the nest is." self createPatchVariable: 'food'. "greater than zero if patch has food" self createPatchVariable: 'isNest'. "greater than zero if patch is nest" self createPatchVariable: 'nestScent'. "circular gradient with peak centered on nest" self createPatchVariable: 'pheromone'. "dropped by ants when carrying food" self displayPatchVariable: 'pheromone'. self patchesDo: [:p | p color: self backgroundColor. self setupNest: p. self setupFood: p]. ! ! !StarSqueakAntColony methodsFor: 'other' stamp: 'jm 3/8/2001 14:24'! setupTurtles self makeTurtles: antCount class: AntColonyTurtle. turtles do: [:t | t goto: 50@50. t color: Color black. t isCarryingFood: false. t pheromoneDropSize: 100]. ! ! !StarSqueakDiffusion methodsFor: 'parameters' stamp: 'jm 3/8/2001 14:07'! dyeCount ^ dyeCount ! ! !StarSqueakDiffusion methodsFor: 'parameters' stamp: 'jm 3/8/2001 14:07'! dyeCount: aNumber dyeCount _ aNumber asInteger max: 1. ! ! !StarSqueakDiffusion methodsFor: 'parameters' stamp: 'jm 3/8/2001 14:08'! initialize dyeCount _ 200. waterCount _ 2000. super initialize. ! ! !StarSqueakDiffusion methodsFor: 'parameters' stamp: 'jm 3/8/2001 14:08'! sliderParameters "Answer a list of parameters that the user can change via a slider. Each parameter is described by an array of: ." ^ super sliderParameters, #( (dyeCount 50 1000 'The number of dye particles.') (waterCount 100 4000 'The number of water particles.')) ! ! !StarSqueakDiffusion methodsFor: 'parameters' stamp: 'jm 3/8/2001 14:07'! waterCount ^ waterCount ! ! !StarSqueakDiffusion methodsFor: 'parameters' stamp: 'jm 3/8/2001 14:07'! waterCount: aNumber waterCount _ aNumber asInteger max: 1. ! ! !StarSqueakDiffusion methodsFor: 'other' stamp: 'jm 3/8/2001 14:09'! setup self clearAll. self patchesDo: [:p | p color: (Color gray: 0.9)]. self setupTurtles. turtleDemons _ #(move bounce). ! ! !StarSqueakDiffusion methodsFor: 'other' stamp: 'jm 3/8/2001 14:10'! setupTurtles | radius t | dyeCount ifNil: [dyeCount _ 200]. waterCount ifNil: [waterCount _ 2000]. radius _ 10. self makeTurtles: waterCount class: DiffusionTurtle. turtles do: [:each | each color: (Color gray: 0.7). (each distanceTo: 50@50) < radius ifTrue: [each die]]. self makeTurtles: dyeCount class: DiffusionTurtle. turtles size - (dyeCount - 1) to: turtles size do: [:i | t _ turtles at: i. t goto: 50@50. t forward: (self random: radius). t color: Color green darker darker]. ! ! !StarSqueakForestFire methodsFor: 'parameters' stamp: 'jm 3/10/2001 11:03'! initialize treePercentage _ 70. super initialize. ! ! !StarSqueakForestFire methodsFor: 'parameters' stamp: 'jm 3/10/2001 11:06'! sliderParameters "Answer a list of parameters that the user can change via a slider. Each parameter is described by an array of: ." ^ super sliderParameters, #( (treePercentage 0 100 'The probability of that a given patch has a tree.')) ! ! !StarSqueakForestFire methodsFor: 'parameters' stamp: 'jm 3/10/2001 11:06'! treePercentage ^ treePercentage ! ! !StarSqueakForestFire methodsFor: 'parameters' stamp: 'jm 3/10/2001 11:06'! treePercentage: aNumber treePercentage _ aNumber. ! ! !StarSqueakForestFire methodsFor: 'demons' stamp: 'jm 2/5/2001 18:18'! consumeFuel | level | self patchesDo: [:p | level _ p get: #flameLevel. level > 0 ifTrue: [ level _ (level - 15) max: 0. p set: #flameLevel to: level. p brightness: level]]. ! ! !StarSqueakForestFire methodsFor: 'demons' stamp: 'jm 1/28/2001 16:33'! spreadFire self patchesDo: [:p | (p get: #isUnburnt) > 0 ifTrue: [ ((p neighborN get: #flameLevel) + (p neighborS get: #flameLevel) + (p neighborE get: #flameLevel) + (p neighborW get: #flameLevel)) > 0 ifTrue: [ p set: #isUnburnt to: 0. p set: #flameLevel to: 100. p color: Color red]]]. ! ! !StarSqueakForestFire methodsFor: 'setup' stamp: 'jm 3/10/2001 11:09'! setup self clearAll. self createPatchVariable: #isUnburnt. self createPatchVariable: #flameLevel. self setupTrees. self setupFire. self setupBorder. worldDemons _ #(spreadFire consumeFuel). ! ! !StarSqueakForestFire methodsFor: 'setup' stamp: 'jm 1/28/2001 16:32'! setupBorder self patchesDo: [:p | p isLeftEdge | p isRightEdge | p isTopEdge | p isBottomEdge ifTrue: [ p set: #isUnburnt to: 0. p color: Color blue]]. ! ! !StarSqueakForestFire methodsFor: 'setup' stamp: 'jm 1/28/2001 16:32'! setupFire self patchesDo: [:p | p neighborW isLeftEdge ifTrue: [ p set: #isUnburnt to: 0. p set: #flameLevel to: 100. p color: Color red]]. ! ! !StarSqueakForestFire methodsFor: 'setup' stamp: 'jm 3/10/2001 11:09'! setupTrees "Setup a forest with treePercentage of trees." self patchesDo: [:p | p set: #isUnburnt to: 0. p set: #flameLevel to: 0. (10 * treePercentage) > (self random: 1000) ifTrue: [ p set: #isUnburnt to: 1. p color: Color green]]. ! ! !StarSqueakMorph class methodsFor: 'class initialization' stamp: 'jm 1/30/2001 08:46'! initialize "StarSqueakMorph initialize" RandomSeed _ 17. ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/27/2001 08:59'! asPoint ^ x @ y ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/19/2001 08:28'! world ^ world ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/28/2001 15:03'! world: aStarSqueakMorph "Set the world for this patch. Also record the world's width and height." | dims | world _ aStarSqueakMorph. dims _ world dimensions. worldWidth _ dims x. worldHeight _ dims y. ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/18/2001 21:27'! x ^ x ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/19/2001 18:31'! x: anInteger x _ anInteger. ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/18/2001 21:27'! y ^ y ! ! !StarSqueakPatch methodsFor: 'accessing' stamp: 'jm 1/19/2001 08:26'! y: anInteger y _ anInteger. ! ! !StarSqueakPatch methodsFor: 'patch color' stamp: 'jm 1/24/2001 15:57'! brightness "Answer the brightness of this patch, a number from 0 to 100." ^ world getPatchBrightnessAtX: x y: y ! ! !StarSqueakPatch methodsFor: 'patch color' stamp: 'jm 1/24/2001 15:56'! brightness: percent "Set the brightness of this patch to the given level, where 0 is nearly black and 100 is full brightness." world setPatchBrightnessAtX: x y: y to: percent. ! ! !StarSqueakPatch methodsFor: 'patch color' stamp: 'jm 1/24/2001 15:58'! color "Answer the color of this patch." ^ world getPatchColorAtX: x y: y ! ! !StarSqueakPatch methodsFor: 'patch color' stamp: 'jm 1/24/2001 15:58'! color: aColor "Paint this patch the given color." world setPatchColorAtX: x y: y to: aColor. ! ! !StarSqueakPatch methodsFor: 'patch variables' stamp: 'jm 1/18/2001 21:31'! distanceTo: aPoint "Answer the distance from this patch to the given point." ^ ((x - aPoint x) squared + (y - aPoint y) squared) sqrt ! ! !StarSqueakPatch methodsFor: 'patch variables' stamp: 'jm 1/28/2001 15:53'! get: patchVarName "Answer the value of the given patch variable for this patch." | patchVar | patchVar _ world patchVariable: patchVarName ifAbsent: [^ 0]. ^ patchVar at: (y * world dimensions x) + x + 1 ! ! !StarSqueakPatch methodsFor: 'patch variables' stamp: 'jm 1/28/2001 15:53'! set: patchVarName to: newValue "Set the value of the given patch variable for this patch to the given value." | patchVar | patchVar _ world patchVariable: patchVarName ifAbsent: [^ self]. patchVar at: (y * world dimensions x) + x + 1 put: newValue. ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:06'! neighborE "Answer the neightboring patch directly south of (below) this patch." ^ self clone x: ((x + 1) \\ worldWidth) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:06'! neighborN "Answer the neightboring patch directly north of (above) this patch." ^ self clone y: ((y - 1) \\ worldHeight) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:08'! neighborNE "Answer the neightboring patch directly south of (below) this patch." ^ self clone x: ((x + 1) \\ worldWidth) y: ((y - 1) \\ worldHeight) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:08'! neighborNW "Answer the neightboring patch directly south of (below) this patch." ^ self clone x: ((x - 1) \\ worldWidth) y: ((y - 1) \\ worldHeight) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:06'! neighborS "Answer the neightboring patch directly south of (below) this patch." ^ self clone y: ((y + 1) \\ worldHeight) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:08'! neighborSE "Answer the neightboring patch directly south of (below) this patch." ^ self clone x: ((x + 1) \\ worldWidth) y: ((y + 1) \\ worldHeight) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:09'! neighborSW "Answer the neightboring patch directly south of (below) this patch." ^ self clone x: ((x - 1) \\ worldWidth) y: ((y + 1) \\ worldHeight) ! ! !StarSqueakPatch methodsFor: 'neighborhood' stamp: 'jm 1/28/2001 15:06'! neighborW "Answer the neightboring patch directly south of (below) this patch." ^ self clone x: ((x - 1) \\ worldWidth) ! ! !StarSqueakPatch methodsFor: 'geometry' stamp: 'jm 1/28/2001 15:27'! isBottomEdge ^ y = (worldHeight - 1) ! ! !StarSqueakPatch methodsFor: 'geometry' stamp: 'jm 1/28/2001 15:27'! isLeftEdge ^ x = 0 ! ! !StarSqueakPatch methodsFor: 'geometry' stamp: 'jm 1/28/2001 15:27'! isRightEdge ^ x = (worldWidth - 1) ! ! !StarSqueakPatch methodsFor: 'geometry' stamp: 'jm 1/28/2001 15:27'! isTopEdge ^ y = 0 ! ! !StarSqueakPlugin methodsFor: 'all' stamp: 'jm 1/20/2001 11:01'! checkedUnsignedIntPtrOf: oop "Return an unsigned int pointer to the first indexable word of oop, which must be a words object." self returnTypeC: 'unsigned int *'. interpreterProxy success: (interpreterProxy isWords: oop). interpreterProxy failed ifTrue: [^ 0]. ^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'unsigned int *' ! ! !StarSqueakPlugin methodsFor: 'all' stamp: 'jm 2/6/2001 16:39'! primitiveDiffuseFromToWidthHeightDelta "Diffuse the integer values of the source patch variable Bitmap into the output Bitmap. Each cell of the output is the average of the NxN area around it in the source, where N = (2 * delta) + 1." | srcOop dstOop height width delta src dst area startY endY startX endX sum rowStart | self export: true. self var: 'src' declareC: 'unsigned int *src'. self var: 'dst' declareC: 'unsigned int *dst'. srcOop _ interpreterProxy stackValue: 4. dstOop _ interpreterProxy stackValue: 3. width _ interpreterProxy stackIntegerValue: 2. height _ interpreterProxy stackIntegerValue: 1. delta _ interpreterProxy stackIntegerValue: 0. src _ self checkedUnsignedIntPtrOf: srcOop. dst _ self checkedUnsignedIntPtrOf: dstOop. interpreterProxy success: (interpreterProxy stSizeOf: srcOop) = (interpreterProxy stSizeOf: dstOop). interpreterProxy success: (interpreterProxy stSizeOf: srcOop) = (width * height). interpreterProxy failed ifTrue: [^ nil]. area _ ((2 * delta) + 1) * ((2 * delta) + 1). 0 to: height - 1 do: [:y | startY _ y - delta. startY < 0 ifTrue: [startY _ 0]. endY _ y + delta. endY >= height ifTrue: [endY _ height - 1]. 0 to: width - 1 do: [:x | startX _ x - delta. startX < 0 ifTrue: [startX _ 0]. endX _ x + delta. endX >= width ifTrue: [endX _ width - 1]. sum _ 0. startY to: endY do: [:y2 | rowStart _ y2 * width. startX to: endX do: [:x2 | sum _ sum + (src at: rowStart + x2)]]. dst at: ((y * width) + x) put: (sum // area)]]. interpreterProxy pop: 5. "pop args, leave rcvr on stack" ! ! !StarSqueakPlugin methodsFor: 'all' stamp: 'jm 1/20/2001 14:46'! primitiveEvaporateRate "Evaporate the integer values of the source Bitmap at the given rate. The rate is an integer between 0 and 1024, where 1024 is a scale factor of 1.0 (i.e., no evaporation)." | patchVarOop rate patchVar sz | self export: true. self var: 'patchVar' declareC: 'unsigned int *patchVar'. patchVarOop _ interpreterProxy stackValue: 1. rate _ interpreterProxy stackIntegerValue: 0. patchVar _ self checkedUnsignedIntPtrOf: patchVarOop. sz _ interpreterProxy stSizeOf: patchVarOop. interpreterProxy failed ifTrue: [^ nil]. 0 to: sz - 1 do: [:i | patchVar at: i put: (((patchVar at: i) * rate) >> 10)]. interpreterProxy pop: 2. "pop args, leave rcvr on stack" ! ! !StarSqueakPlugin methodsFor: 'all' stamp: 'jm 2/6/2001 19:08'! primitiveMapFromToWidthHeightPatchSizeRgbFlagsShift | srcOop dstOop w h patchSize rgbFlags shiftAmount src dst rgbMult srcIndex level pixel offset | self export: true. self var: 'src' declareC: 'unsigned int *src'. self var: 'dst' declareC: 'unsigned int *dst'. srcOop _ interpreterProxy stackValue: 6. dstOop _ interpreterProxy stackValue: 5. w _ interpreterProxy stackIntegerValue: 4. h _ interpreterProxy stackIntegerValue: 3. patchSize _ interpreterProxy stackIntegerValue: 2. rgbFlags _ interpreterProxy stackIntegerValue: 1. shiftAmount _ interpreterProxy stackIntegerValue: 0. src _ self checkedUnsignedIntPtrOf: srcOop. dst _ self checkedUnsignedIntPtrOf: dstOop. interpreterProxy success: (interpreterProxy stSizeOf: dstOop) = (w * h). interpreterProxy success: (interpreterProxy stSizeOf: dstOop) = ((interpreterProxy stSizeOf: srcOop) * patchSize * patchSize). interpreterProxy failed ifTrue: [^ nil]. rgbMult _ 0. (rgbFlags bitAnd: 2r100) > 0 ifTrue: [rgbMult _ rgbMult + 16r10000]. (rgbFlags bitAnd: 2r10) > 0 ifTrue: [rgbMult _ rgbMult + 16r100]. (rgbFlags bitAnd: 2r1) > 0 ifTrue: [rgbMult _ rgbMult + 16r1]. srcIndex _ -1. 0 to: (h // patchSize) - 1 do: [:y | 0 to: (w // patchSize) - 1 do: [:x | level _ (src at: (srcIndex _ srcIndex + 1)) bitShift: shiftAmount. level > 255 ifTrue: [level _ 255]. level <= 0 ifTrue: [pixel _ 1] "non-transparent black" ifFalse: [pixel _ level * rgbMult]. "fill a patchSize x patchSize square with the pixel value" offset _ ((y * w) + x) * patchSize. offset to: offset + ((patchSize - 1) * w) by: w do: [:rowStart | rowStart to: rowStart + patchSize - 1 do: [:dstIndex | dst at: dstIndex put: pixel]] ]]. interpreterProxy pop: 7. "pop args, leave rcvr on stack" ! ! !StarSqueakSlimeMold methodsFor: 'parameters' stamp: 'jm 2/7/2001 19:28'! cellCount ^ cellCount ! ! !StarSqueakSlimeMold methodsFor: 'parameters' stamp: 'jm 2/7/2001 19:28'! cellCount: aNumber cellCount _ aNumber asInteger. ! ! !StarSqueakSlimeMold methodsFor: 'parameters' stamp: 'jm 2/7/2001 19:31'! initialize cellCount _ 200. super initialize. ! ! !StarSqueakSlimeMold methodsFor: 'parameters' stamp: 'jm 2/7/2001 19:51'! sliderParameters "Answer a list of parameters that the user can change via a slider. Each parameter is described by an array of: ." ^ super sliderParameters, #( (cellCount 50 2000 'The number of slime mold cells.')) ! ! !StarSqueakSlimeMold methodsFor: 'other' stamp: 'jm 1/19/2001 18:36'! diffusePheromone self diffusePatchVariable: 'pheromone'. ! ! !StarSqueakSlimeMold methodsFor: 'other' stamp: 'jm 1/19/2001 18:36'! evaporatePheromone self decayPatchVariable: 'pheromone'. ! ! !StarSqueakSlimeMold methodsFor: 'other' stamp: 'jm 2/7/2001 19:29'! setup self clearAll. self makeTurtles: cellCount class: SlimeMoldTurtle. self createPatchVariable: 'pheromone'. "emitted by slime mold cells" turtleDemons _ #(dropPheromone followPheromone breakLoose). worldDemons _ #(evaporatePheromone diffusePheromone). self displayPatchVariable: 'pheromone'. ! ! !StarSqueakTermites methodsFor: 'all' stamp: 'jm 1/28/2001 15:35'! setup self clearAll. self setupPatches. self setupTurtles. turtleDemons _ #(walk wiggle lookForChip lookForPile). ! ! !StarSqueakTermites methodsFor: 'all' stamp: 'jm 1/24/2001 08:50'! setupPatches "Create patch variables for sensing the nest and food caches. The nestScent variable is diffused so that it forms a 'hill' of scent over the entire world with its peak at the center of the nest. That way, the ants always know which way the nest is." self createPatchVariable: 'woodChips'. "number of wood chips on patch" self displayPatchVariable: 'woodChips' logScale: 5. self patchesDo: [:p | (self random: 8) = 0 ifTrue: [p set: 'woodChips' to: 1] ifFalse: [p set: 'woodChips' to: 0]]. ! ! !StarSqueakTermites methodsFor: 'all' stamp: 'jm 1/28/2001 15:35'! setupTurtles "Create an initialize my termites." self makeTurtles: 400 class: TermiteTurtle. self turtlesDo: [:t | t isCarryingChip: false]. ! ! !StarSqueakTrees methodsFor: 'initialization' stamp: 'jm 2/5/2001 18:12'! initialize super initialize. depth _ 8. treeTypeSelector _ #tree1. self setup. ! ! !StarSqueakTrees methodsFor: 'setup' stamp: 'jm 3/12/2001 09:59'! setup self clearAll. self makeTurtles: 1 class: TreeTurtle. self turtlesDo: [:t | t goto: 50@90. t penDown. t color: Color red. t heading: 0. t length: 15. t depth: depth]. self addTurtleDemon: treeTypeSelector. ! ! !StarSqueakTrees methodsFor: 'menu' stamp: 'jm 1/29/2001 09:46'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine. aCustomMenu add: 'set tree depth' action: #setTreeDepth. aCustomMenu add: 'set tree type' action: #setTreeType. ! ! !StarSqueakTrees methodsFor: 'menu' stamp: 'jm 3/12/2001 09:59'! setTreeDepth | reply | reply _ FillInTheBlank request: 'Tree depth (a number between 1 and 12)?' initialAnswer: depth printString. reply isEmpty ifTrue: [^ self]. depth _ ((reply asNumber rounded) max: 1) min: 12. self startOver. ! ! !StarSqueakTrees methodsFor: 'menu' stamp: 'jm 3/12/2001 09:59'! setTreeType | menu choice | menu _ CustomMenu new title: 'Choose tree type:'. menu add: 'tree1' action: #tree1. menu add: 'tree2' action: #tree2. choice _ menu startUp. choice ifNotNil: [ treeTypeSelector _ choice. self startOver]. ! ! !StarSqueakTurtle methodsFor: 'initialization' stamp: 'jm 3/3/2001 18:05'! initializeWorld: aStarSqueakWorld who: anInteger | dims | dims _ aStarSqueakWorld dimensions. world _ aStarSqueakWorld. who _ anInteger. x _ world random: dims x. y _ world random: dims y. wrapX _ dims x asFloat. wrapY _ dims y asFloat. headingRadians _ ((self random: 36000) / 100.0) degreesToRadians. color _ Color blue. penDown _ false. nextTurtle _ nil. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 1/27/2001 08:59'! asPoint ^ x truncated @ y truncated ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 2/25/2000 16:03'! color ^ color ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 2/25/2000 16:03'! color: aColor color _ aColor. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 3/3/2001 17:47'! heading "Answer my heading in degrees." | degrees | degrees _ 90.0 - headingRadians radiansToDegrees. ^ degrees >= 0.0 ifTrue: [degrees] ifFalse: [degrees + 360.0]. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 3/3/2001 17:48'! heading: angleInDegrees "Set my heading in degrees. Like a compass, up or north is 0 degrees and right or east is 90 degrees." headingRadians _ ((90.0 - angleInDegrees) \\ 360.0) degreesToRadians. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 3/3/2001 17:49'! nextTurtle "The nextTurtle slot is used to make a linked list of turtles at a given patch." ^ nextTurtle ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 3/3/2001 17:49'! nextTurtle: aStarSqueakTurtle "The nextTurtle slot is used to make a linked list of turtles at a given patch." nextTurtle _ aStarSqueakTurtle. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 1/26/2001 17:36'! who ^ who ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 1/26/2001 17:42'! who: anInteger who _ anInteger. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 2/25/2000 16:02'! x ^ x ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 2/25/2000 16:03'! x: aNumber x _ aNumber. ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 2/25/2000 16:02'! y ^ y ! ! !StarSqueakTurtle methodsFor: 'accessing' stamp: 'jm 2/25/2000 16:03'! y: aNumber y _ aNumber. ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/19/2001 19:08'! get: patchVar "Answer the value of the given patch variable below this turtle." ^ world getPatchVariable: patchVar atX: x y: y ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/27/2001 08:49'! increment: patchVar by: delta "Increment the value of the given patch variable below this turtle by the given amount (positive or negative)." world incrementPatchVariable: patchVar atX: x y: y by: delta. ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/24/2001 13:33'! patchBrightness "Answer the brightness of the patch below this turtle, where 0 is black and 100 is full brightness." world getPatchBrightnessAtX: x y: y. ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/24/2001 13:28'! patchBrightness: percent "Set the brightness of the patch below this turtle to the given value, where 0 is black and 100 is full brightness." world setPatchBrightnessAtX: x y: y to: percent. ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/23/2001 17:17'! patchColor "Answer the color of the patch below this turtle." ^ world getPatchColorAtX: x y: y. ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/24/2001 13:37'! patchColor: aColor "Paint the patch below this turtle with the given color." world setPatchColorAtX: x y: y to: aColor. ! ! !StarSqueakTurtle methodsFor: 'patches' stamp: 'jm 1/19/2001 19:09'! set: patchVar to: newValue "Set the value of the given patch variable below this turtle to the given value." world setPatchVariable: patchVar atX: x y: y to: newValue. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/26/2001 17:39'! die "Delete this turtle at the end of the current cycle. The turtle will finish running all demons for the current cycle before it dies." world deleteTurtle: self. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/23/2001 17:26'! forward: dist "Move the given distance in the direction of my heading." 1 to: dist do: [:i | self forwardOne]. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/28/2001 10:57'! forwardOne "Move one turtle step in the direction of my heading." penDown ifTrue: [world setPatchColorAtX: x y: y to: color]. x _ x + headingRadians cos. y _ y - headingRadians sin. x < 0.0 ifTrue: [x _ x + wrapX]. y < 0.0 ifTrue: [y _ y + wrapY]. x >= wrapX ifTrue: [x _ x - wrapX]. y >= wrapY ifTrue: [y _ y - wrapY]. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 2/27/2000 18:18'! goto: aPoint "Jump to the given location." x _ aPoint x. y _ aPoint y. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/23/2001 17:19'! penDown "Put down this turtle's pen. That is, the turtle will leave a trail the same color as itself when it moves." penDown _ true. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/23/2001 17:19'! penUp "Lift this turtle's pen. The turtle will stop leaving a trail." penDown _ false. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/19/2001 19:20'! random: range "Answer a random integer between 0 and range." ^ world random: range ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/27/2001 08:47'! replicate "Add an exact replica of this turtle to the world. The new turtle does not become active until the next cycle." "Note: We call this operation 'replicate' instead of Mitch Resnick's term 'clone' because Squeak already used the message 'clone' for cloning a generic object." world replicateTurtle: self. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/29/2001 10:11'! stop "Stop running." world stopRunning. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/19/2001 19:14'! turnLeft: degrees "Turn left by the given number of degrees." self heading: (self heading - degrees). ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 2/27/2000 18:19'! turnRight: degrees "Turn right by the given number of degrees." self heading: (self heading + degrees). ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/27/2001 09:20'! turnTowards: aPointTurtleOrPatch "Turn to face the given point, turtle, or patch." | degrees | degrees _ (aPointTurtleOrPatch asPoint - self asPoint) degrees. headingRadians _ (0.0 - degrees) degreesToRadians. ! ! !StarSqueakTurtle methodsFor: 'commands' stamp: 'jm 1/27/2001 08:58'! turnTowardsStrongest: patchVarName "Turn to point toward the nearby patch having the highest value of the given patch variable. This command uses only local information. In particular, it only considers patches within 'sniffRange' of this turtles location. For example, with the default 'sniffRange' of 1, it only considers the immediate neighbors of the patch this turtle is on." self heading: (world uphillOf: patchVarName forTurtle: self). ! ! !StarSqueakTurtle methodsFor: 'sensing' stamp: 'jm 2/5/2001 19:42'! distanceTo: aPoint "Answer the distance from this turtle to the given point." ^ ((x - aPoint x) squared + (y - aPoint y) squared) sqrt ! ! !StarSqueakTurtle methodsFor: 'sensing' stamp: 'jm 3/3/2001 19:46'! turtleCountHere "Answer a collection of turtles at this turtle's current location, including this turtle itself." | n | n _ 0. world turtlesAtX: x y: y do: [:t | n _ n + 1]. ^ n ! ! !AntColonyTurtle methodsFor: 'variables' stamp: 'jm 2/26/2000 10:24'! isCarryingFood ^ isCarryingFood ! ! !AntColonyTurtle methodsFor: 'variables' stamp: 'jm 2/26/2000 10:25'! isCarryingFood: aBoolean isCarryingFood _ aBoolean. ! ! !AntColonyTurtle methodsFor: 'variables' stamp: 'jm 2/26/2000 10:24'! pheromoneDropSize ^ pheromoneDropSize ! ! !AntColonyTurtle methodsFor: 'variables' stamp: 'jm 2/26/2000 10:25'! pheromoneDropSize: aNumber pheromoneDropSize _ aNumber. ! ! !AntColonyTurtle methodsFor: 'demons' stamp: 'jm 3/8/2001 14:26'! dropFoodInNest (isCarryingFood and: [(self get: 'isNest') > 0]) ifTrue: [ self color: Color black. isCarryingFood _ false. "turn around and go forward to try to pick up pheromone trail" self turnRight: 180. self forward: 3]. ! ! !AntColonyTurtle methodsFor: 'demons' stamp: 'jm 3/8/2001 14:22'! pickUpFood | newFood | (isCarryingFood not and: [(self get: 'food') > 0]) ifTrue: [ newFood _ (self get: 'food') - 1. self set: 'food' to: newFood. newFood = 0 ifTrue: [self patchColor: world backgroundColor]. isCarryingFood _ true. pheromoneDropSize _ 800. self color: Color red. "drop a blob of pheromone on the side of the food farthest from nest" self turnTowardsStrongest: 'nestScent'. self turnRight: 180. self forward: 4. self increment: 'pheromone' by: 5000]. ! ! !AntColonyTurtle methodsFor: 'demons' stamp: 'jm 2/7/2001 19:20'! returnToNest isCarryingFood ifTrue: [ "decrease size of pheromone drops to create a gradient back to food" pheromoneDropSize > 0 ifTrue: [ self increment: 'pheromone' by: pheromoneDropSize. pheromoneDropSize _ pheromoneDropSize - 20]. self turnTowardsStrongest: 'nestScent'. self forward: 1]. ! ! !AntColonyTurtle methodsFor: 'demons' stamp: 'jm 2/7/2001 08:12'! searchForFood "If you smell pheromone, go towards the strongest smell. Otherwise, wander aimlessly." isCarryingFood ifFalse: [ ((self get: 'pheromone') > 1) ifTrue: [self turnTowardsStrongest: 'pheromone'] ifFalse: [ self turnRight: (self random: 40). self turnLeft: (self random: 40)]. self forward: 1]. ! ! !DiffusionTurtle methodsFor: 'demons' stamp: 'jm 3/3/2001 13:04'! bounce (self turtleCountHere > 1) ifTrue: [ self turnRight: 180 + (self random: 45). self turnLeft: (self random: 45)]. ! ! !DiffusionTurtle methodsFor: 'demons' stamp: 'jm 2/5/2001 19:32'! move self forward: 1. ! ! !SlimeMoldTurtle methodsFor: 'demons' stamp: 'jm 2/5/2001 17:25'! breakLoose "If I smell pheromone, turn in the direction that it gets stronger. Otherwise, turn a random amount right or left. In either case, move forward one step." ((self random: 100) < 10) ifTrue: [ self turnRight: (self random: 360). self forward: 3]. ! ! !SlimeMoldTurtle methodsFor: 'demons' stamp: 'jm 1/23/2001 12:06'! dropPheromone self increment: 'pheromone' by: 100. ! ! !SlimeMoldTurtle methodsFor: 'demons' stamp: 'jm 2/5/2001 17:31'! followPheromone "If I smell pheromone, turn in the direction that it gets stronger. Otherwise, turn a random amount right or left. In either case, move forward one step." ((self get: 'pheromone') > 60) ifTrue: [self turnTowardsStrongest: 'pheromone'] ifFalse: [ self turnRight: (self random: 45). self turnLeft: (self random: 45)]. self forward: 1. ! ! !SlimeMoldTurtle methodsFor: 'demons' stamp: 'jm 3/10/2001 11:19'! walk self forward: 1. ! ! !TermiteTurtle methodsFor: 'variables' stamp: 'jm 1/24/2001 08:28'! isCarryingChip ^ isCarryingChip ! ! !TermiteTurtle methodsFor: 'variables' stamp: 'jm 1/24/2001 08:28'! isCarryingChip: aBoolean isCarryingChip _ aBoolean. ! ! !TermiteTurtle methodsFor: 'demons' stamp: 'jm 1/24/2001 08:20'! lookForChip "If this terminte is not carrying a chip and there is a chip at the current location, pick up the chip. To minimize the chance of immediately enountering the same chip pile, turn around and take one step in the the opposite direction." (isCarryingChip not and: [(self get: 'woodChips') > 0]) ifTrue: [ self pickUpChip. self turnRight: 180. self forward: 1]. ! ! !TermiteTurtle methodsFor: 'demons' stamp: 'jm 1/24/2001 08:23'! lookForPile "If I am carrying a chip and there is a chip at the current location, drop the chip I'm carrying. To minimize the chance of immediately enountering the same chip pile, turn around and take one step in the the opposite direction." (isCarryingChip and: [(self get: 'woodChips') > 0]) ifTrue: [ self putDownChip. self turnRight: 180. self forward: 1]. ! ! !TermiteTurtle methodsFor: 'demons' stamp: 'jm 1/24/2001 08:21'! pickUpChip "Pick up a wood chip from the current patch." self increment: 'woodChips' by: -1. isCarryingChip _ true. self color: Color red. ! ! !TermiteTurtle methodsFor: 'demons' stamp: 'jm 1/24/2001 08:22'! putDownChip "Drop the wood chip I'm carrying on the current patch." self increment: 'woodChips' by: 1. isCarryingChip _ false. self color: Color blue. ! ! !TermiteTurtle methodsFor: 'demons' stamp: 'jm 1/24/2001 08:11'! walk self forward: 1. ! ! !TermiteTurtle methodsFor: 'demons' stamp: 'jm 1/24/2001 08:12'! wiggle self turnRight: (self random: 50). self turnLeft: (self random: 50). ! ! !TreeTurtle methodsFor: 'variables' stamp: 'jm 1/29/2001 09:42'! depth ^ depth ! ! !TreeTurtle methodsFor: 'variables' stamp: 'jm 1/29/2001 09:42'! depth: aNumber depth _ aNumber. ! ! !TreeTurtle methodsFor: 'variables' stamp: 'jm 1/28/2001 10:39'! length ^ length ! ! !TreeTurtle methodsFor: 'variables' stamp: 'jm 1/28/2001 10:39'! length: aNumber length _ aNumber. ! ! !TreeTurtle methodsFor: 'commands' stamp: 'jm 1/29/2001 10:38'! tree1 "Draw a recursive tree whose trunk length is determined by my depth instance variable. Stop when depth is < 1." depth < 1 ifTrue: [^ self stop]. depth _ depth - 1. self forward: 2 * depth. self turnRight: 20. self replicate. "create child 1" self turnLeft: 40. self replicate. "create child 2" self die. "this turtle dies" ! ! !TreeTurtle methodsFor: 'commands' stamp: 'jm 1/29/2001 10:39'! tree2 "Draw a recursive tree whose trunk length determined by my length instance variable. Stop when depth is < 1. This version uses randomness to create a more natural looking, asymmetric tree. It also changes the turtle's hue a little each generation." depth < 1 ifTrue: [^ self stop]. depth _ depth - 1. self color: (Color h: self color hue + 10 s: 0.7 v: 0.7). self forward: length. length _ (0.5 + ((self random: 450) / 1000.0)) * length. self turnRight: 10 + (self random: 20). self replicate. self turnLeft: 30 + (self random: 20). self replicate. self die. ! ! StarSqueakMorph initialize!