'From Jasmine-rc1 of 7 October 2004 [latest update: #221] on 12 October 2005 at 10:36:40 am'! Float variableWordSubclass: #Convert instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! Object subclass: #Force instanceVariableNames: 'direction velocity mass ' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! PolygonMorph subclass: #ModStar instanceVariableNames: 'rand awheel steptime rotdir myforce controlpanel ' classVariableNames: 'Rnd ' poolDictionaries: '' category: 'ModStars0901'! AlignmentMorph subclass: #ModStarControlPanel instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! ScriptableButton subclass: #SingleModStar instanceVariableNames: 'stopped ' classVariableNames: 'Rand ' poolDictionaries: '' category: 'ModStars0901'! ScriptableButton subclass: #ToggleSwitch instanceVariableNames: 'togglelabel mycolor stopped ' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! ToggleSwitch subclass: #BumperSwitch instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! ToggleSwitch subclass: #GenerateModStars instanceVariableNames: '' classVariableNames: 'Rand ' poolDictionaries: '' category: 'ModStars0901'! ToggleSwitch subclass: #GravSwitch instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! ToggleSwitch subclass: #StickySwitch instanceVariableNames: 'toyform oldcolor ' classVariableNames: '' poolDictionaries: '' category: 'ModStars0901'! !Convert class methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 09:31'! toRadians: aPoint "Answer the angle the receiver makes with (0@0) in radians. right is 0; down is halfPi." | tan theta x y | x := aPoint x. y := aPoint y. x = 0 ifTrue: [y >= 0 ifTrue: [^ Float halfPi ] ifFalse: [^ Float pi + Float halfPi]] ifFalse: [tan := y asFloat / x asFloat. theta := tan arcTan. x >= 0 ifTrue: [y >= 0 ifTrue: [^ theta ] ifFalse: [^ 2 * Float pi + theta]] ifFalse: [^ Float pi + theta]] ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/15/2005 11:12'! direction ^direction ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 09:17'! impactWith: anotherForce | xv1 yv1 xv2 yv2 xv yv v1 v2 | v1 := self direction. v2 := anotherForce direction. xv1 := v1 cos * velocity * mass. yv1 := v1 sin * velocity * mass. xv2 := v2 cos * anotherForce velocity * anotherForce mass. yv2 := v2 sin * anotherForce velocity * anotherForce mass. xv := xv1 + xv2. yv := yv1 + yv2. ^Force velocity: (xv@yv) r abs direction: (Convert toRadians: xv@yv) ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/18/2005 18:49'! initialize mass := 1. velocity := 0. direction := 0. ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/18/2005 18:47'! mass ^mass ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/15/2005 11:01'! momentum ^velocity * mass ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/15/2005 11:25'! velocity ^velocity ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 10/12/2005 10:34'! velocity: v direction: d velocity _ v. direction _ d. mass _ 1. ! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/18/2005 18:47'! velocity: v direction: d mass: m velocity := v. direction := d. mass := m! ! !Force methodsFor: 'as yet unclassified' stamp: 'jf 8/18/2005 19:04'! with: f1 with: f2 with: f3 with: f4 "self singleCollisionWith: " ^self impactWith: ((f1 impactWith: f2) impactWith: (f3 impactWith: f4)).! ! !Force class methodsFor: 'as yet unclassified' stamp: 'jf 10/12/2005 10:36'! velocity: v direction: d ^self new velocity:v direction: d mass: 1 ! ! !Force class methodsFor: 'as yet unclassified' stamp: 'jf 8/18/2005 18:55'! velocity: v direction: d mass: m ^self new velocity:v direction: d mass: m! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/31/2005 13:44'! bumperRepulse | left right top bottom xm ym s gravfac | gravfac := 5. xm := 1024 raisedTo: gravfac. ym := 768 raisedTo: gravfac. s := 3. left := Force velocity: (1024 - self center x raisedTo: gravfac) abs * s // xm direction: 0 mass: 1. right := Force velocity: (self center x raisedTo: gravfac) abs * s // xm direction: Float pi mass: 1. top := Force velocity: (768 - self center y raisedTo: gravfac) abs * s // ym direction: Float halfPi mass: 1. bottom := Force velocity: (self center y raisedTo: gravfac) abs * s // ym direction: Float pi + Float halfPi mass: 1. myforce := myforce with: left with: right with: top with: bottom. " myforce velocity: myforce velocity + 1 direction: myforce direction." " Transcript show: String crlf , 'myforce left right top bottom' , String crlf. (Array with: myforce with: left with: right with: top with: bottom) do: [:b | Transcript show: 'v:' , ((b velocity * 1000) asInteger // 1000) asString , ' d:' , ((b direction * 1000) asInteger // 1000) asString , ' ']"! ! !ModStar methodsFor: 'initialization' stamp: 'jf 9/1/2005 11:31'! controlpanel ^controlpanel! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/20/2005 16:58'! force ^ myforce ! ! !ModStar methodsFor: 'initialization' stamp: 'jf 9/1/2005 11:35'! gravity | homies gs | gs := Force velocity: 0 direction: 0 mass: 0. ModStar allInstancesDo: [ :st | (st owner ~= nil and: [st ~= self]) ifTrue: [ homies := Force velocity: ( (4*myforce mass)/((st center - self center) r abs + 1)) sqrt sqrt sqrt direction: (Convert toRadians: (st center - self center)) mass: st force mass. "homies := Force velocity: (1/((st center - self center) r abs + 1) raisedTo: 3) * 100 direction: (st center - self center) degrees mass: st force mass. " gs := gs impactWith: homies. "self halt." ] ]. myforce := myforce impactWith: gs. ! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/21/2005 17:35'! initialize "(ModStarMorph new modinit:6 size: 49) openInWorld." | colorgap size | Rnd = nil ifTrue: [Rnd := Random new]. awheel := Color wheel: 256. steptime := 0. size:= (Rnd nextInt: 90) * (Rnd nextInt: 90) / 90 + 30. self modinit: (Rnd nextInt: 15) + 2 size: size. "make sure both colors are not nearly the same" colorgap := Rnd nextInt: 256. self modcolor: (awheel at: colorgap) color2: (awheel at: colorgap + 40 + (Rnd nextInt: 216) \\ 256 + 1). self center: (Rnd nextInt: 768) @ (Rnd nextInt: 1024). rotdir := Rnd nextInt: 15. rotdir > 10 ifTrue: [rotdir := 0] ifFalse: [rotdir := rotdir - 5]. myforce := Force velocity: 0 direction: 0 mass: size/15! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/21/2005 10:39'! modcolor: color1 color2: color2 self computeBounds. self useGradientFill. self fillStyle origin: (self center). self fillStyle direction: 0 @ (self bounds extent y // 2). self fillStyle normal: (self bounds extent x // 2) @ 0. self fillStyle radial: true. self borderColor: Color transparent. self fillStyle colorRamp first value: color1. self fillStyle colorRamp last value: color2. ! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/20/2005 16:37'! modinit: points size: size | pt ext oldR | super initialize. "" pt := size @ size. ext := pt r. oldR := ext. vertices := (0 to: 3599 by: (3600 / points) / 2 ) collect: [:angle | ((Point r: (oldR := oldR = ext ifTrue: [ext * 5 // 12] ifFalse: [ext]) degrees: (angle // 10) + pt degrees) + self center ). ]. self computeBounds.! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/21/2005 10:22'! on: aMorph controlpanel := aMorph! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/22/2005 10:07'! rotate: degrees | ext oldR pt t f | f := vertices first. t := vertices sum / vertices size. "t := self center." pt := t - vertices second. ext := pt r. oldR := ext. vertices := (0 to: 3599 by: 3600 / vertices size) collect: [:angle | (Point r: (oldR := oldR = ext ifTrue: [ext * 5 / 12] ifFalse: [ext]) degrees: angle // 10 + (f - t) degrees + degrees) + t]. self computeBounds. ! ! !ModStar methodsFor: 'initialization' stamp: 'jf 9/1/2005 10:38'! step | startdelay gravon bumpon t dx dy delta | startdelay := 0. steptime := steptime + 1. steptime > startdelay ifTrue: [ self rotate:rotdir. "self drawOn: Toyland." controlpanel = nil ifTrue: [ gravon := false. bumpon := true. ] "(ToggleGrav allInstances select: [ :g | g owner ~= nil ]) first gravOn]" ifFalse:[ gravon := controlpanel submorphs first isOn. bumpon := controlpanel submorphs second isOn]. bumpon ifTrue: [self bumperRepulse]. gravon ifTrue: [self gravity]. t := myforce velocity. dx := myforce direction cos. dy := myforce direction sin. delta := (dx * t) @ (dy * t). self center: (self center) + delta. (self center - Display center) r > (Display center) r ifTrue: [self delete]. ]. steptime > 1000 ifTrue: [ self delete.]. ! ! !ModStar methodsFor: 'initialization' stamp: 'jf 8/19/2005 17:34'! stepTime ^100. ! ! !ModStar class methodsFor: 'class initialization' stamp: 'jf 8/19/2005 17:41'! on: aCanvas self new on: aCanvas. ! ! !ModStarControlPanel methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 11:36'! initialize super initialize. Toyland := FormCanvas on: Display form. self listDirection: #topToBottom; wrapCentering: #left; vResizing: #shrinkWrap; vResizing: #shrinkWrap. self addMorph: (SingleModStar new openInWorld). self addMorph: (GenerateModStars new openInWorld). self addMorph: (StickySwitch new openInWorld). self addMorph: (BumperSwitch new openInWorld). self addMorph: (GravSwitch new openInWorld). self color: Color transparent. self trim! ! !ModStarControlPanel methodsFor: 'as yet unclassified' stamp: 'jf 8/30/2005 11:33'! trim self submorphs do: [ :a | a extent: (self extent x * 2 + 35) @ 12. a useSquareCorners] ! ! !ModStarControlPanel class methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 11:52'! makeOne | one | one := self new. one right: Display extent x - (one extent x * 2); openInWorld.! ! !ModStarControlPanel class methodsFor: 'as yet unclassified' stamp: 'jf 9/3/2005 11:28'! makeTwo | one two | one := self new. one right: Display extent x - (one extent x * 2); submorphsDo: [ :s | s toggleColor: Color green]. two := self new. two right: Display extent x - ((two extent x * 2) * 2.5). ^OrderedCollection new; with: one with: two. ! ! !SingleModStar methodsFor: 'as yet unclassified' stamp: 'jf 8/19/2005 16:55'! initialize super initialize. Rand := Random new. self label: 'Clear ModStars'. self actionSelector: #stopstart. self target: self. stopped := true. ! ! !SingleModStar methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 11:35'! stopstart ModStar allInstancesDo: [:a | self owner == nil ifTrue: [ a delete ] ifFalse: [(a controlpanel ~= nil and: [a controlpanel == self owner]) ifTrue: [a delete]]] " Original behavior - generate a morph, then delete it. stopped ifTrue: [ stopped:=false. self start. | t | t := ModStarMorph new. t bounds: (Rectangle center: (Rand nextInt: 800)@(Rand nextInt: 600) extent: t extent). t openInWorld.] ifFalse: [ stopped:=true. self stop. ModStarMorph allInstancesDo: [:a | a delete]]."! ! !SingleModStar methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 17:42'! toggleColor: aColor! ! !SingleModStar class methodsFor: 'as yet unclassified' stamp: 'jf 3/25/2004 09:32'! initialize ! ! !ToggleSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 17:44'! initialize super initialize. self toggleColor: Color orange. self actionSelector: #stopstart. self target: self. self toggleLabel: ' '. stopped := true. ! ! !ToggleSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 09:42'! isOn ^stopped not! ! !ToggleSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 17:40'! stopstart stopped ifTrue: [ stopped:=false. self color: mycolor muchLighter. self label: togglelabel,' ON '. owner class == ModStarControlPanel ifTrue: [owner trim]. self start.] ifFalse: [ stopped:=true. self color: mycolor. self label: togglelabel,' OFF '. owner class == ModStarControlPanel ifTrue: [owner trim]. self stop. ].! ! !ToggleSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 17:39'! toggleColor: aColor mycolor := aColor. self color: mycolor.! ! !ToggleSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:16'! toggleLabel: aLabel togglelabel := aLabel. self label: togglelabel,' on/off'. ! ! !BumperSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:36'! initialize super initialize. self toggleLabel: 'Bumper'. ! ! !GenerateModStars methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:44'! initialize super initialize. Rand := Random new. self toggleLabel: 'Generator'. ! ! !GenerateModStars methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 11:35'! step | t | t := ModStar new on: self owner. t bounds: (Rectangle center: (Rand nextInt: 1024)@(Rand nextInt: 768) extent: t extent). t openInWorld! ! !GenerateModStars methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:39'! stepTime ^10000.! ! !GenerateModStars class methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:39'! initialize ! ! !GravSwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:36'! initialize super initialize. self toggleLabel: 'Grav'! ! !StickySwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:35'! initialize super initialize. self toggleLabel: 'Stickycanvas'! ! !StickySwitch methodsFor: 'as yet unclassified' stamp: 'jf 9/1/2005 10:23'! stopstart self isOn ifFalse: [ oldcolor := self currentWorld color. toyform := FormCanvas on: Display form. toyform form setAsBackground. super stopstart] ifTrue: [ self currentWorld color: oldcolor. super stopstart] ! ! GenerateModStars initialize! SingleModStar initialize! "Postscript: Open a project and some appropriate buttons for the project" | myproj gen | myproj := Project newMorphicOn: nil. gen _ ModStarControlPanel makeTwo . gen do: [ :g | g openInWorld. myproj world addMorph: g]. myproj world color: Color red. myproj flapsSuppressed: true. myproj renameTo: 'ModStars'; enter.!