[squeak-dev] Spur Squeak Trunk Image Available

Stéphane Rollandin lecteur at zogotounga.net
Fri Jun 13 11:50:36 UTC 2014


> And if anything does go wrong please let me know, preferrably
> providing a reproducible case.

Here you go:

File in the attached Sprite.st then evaluate

SpriteGame new install

... I get a (non-crashing) "Unable to VirtualFree committed memory" signal


Stef
-------------- next part --------------
Object subclass: #Clock
	instanceVariableNames: 'start frequency'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:49'!
do: aBlock

	^ aBlock value: self now
! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 11:53'!
do: aBlock at: aNumber

	[
		(aNumber - self seconds) seconds asDelay wait.
		aBlock value
	] 
	forkAt: Processor timingPriority! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:47'!
frequency

	^ frequency ifNil: [^ 1]! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:48'!
frequency: aNumber

	frequency _ aNumber! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 11:27'!
milliseconds

	^ Time millisecondsSince: start! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:48'!
now

	^ self seconds * self frequency! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 11:27'!
seconds

	^ self milliseconds / 1000.0! !

!Clock methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 11:26'!
start

	start _ Time millisecondClockValue! !


Morph subclass: #Sprite
	instanceVariableNames: 'clock action form'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!
!Sprite commentStamp: 'spfa 3/2/2012 13:23' prior: 0!
(Sprite orbitingAround: Display center at: 100 speed: 90) openInWorld

((Sprite orbitingAround: World currentHand position at: 100 speed: 140) color: Color orange) openInWorld

Sprite pulsating openInWorld


(1 to: 100) do: [:n |
	((Sprite orbitingAround: Display center at: (2 * n) + 30 speed: (100 atRandom + 10)) color: (Color gray: n / 100.0)) openInWorld]


(1 to: 100) do: [:n |
	(Sprite pulsating color: (Color gray: n / 100.0) ; position: (1000 atRandom @ 600 atRandom)) openInWorld]

Project current fullScreenOn
!
]style[(9 15 9 6 1 3 1 3 1 6 1 2 2 11 423 8 7 1 12 2)cblack;,c000000123,cblack;,c000000123,cblack;,c000000123,cblack;,c123000000,cblack;,c000000123,cblack;,c123000000,cblack;,c000000123,cred;,cblack;,c000000124,cblack;,c000000124,cred;!


!Sprite methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 21:54'!
action

	^ action! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:06'!
action: aBlock

	action _ aBlock

	
! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:05'!
brownianAround: aPoint

	self position: aPoint.

	self action: [:sprite :t |
			| s |
		s := "self speed asFloat." 20.0.
		sprite position: sprite position + ((3 atRandom -2) @ (3 atRandom - 2))]! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 21:53'!
canBeHit

	^ true! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 11:59'!
clock

	^ clock ifNil: [clock _ Clock new]
	
! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 11:58'!
clock: aClock

	clock _ aClock
	
! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 19:09'!
drawOn: aCanvas

	form ifNil: [^ super drawOn: aCanvas].
	
	aCanvas clipBy: self bounds during: [:canvas |
		canvas translucentImage: form at: self innerBounds origin].! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 19:05'!
form: aForm

	form _ aForm
	
! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:38'!
getHitBy: aRocket

	aRocket delete.
	self hitSound play.
	self color: ({Color green . Color orange . Color blue . Color yellow} copyWithout: self color) atRandom! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:49'!
hitSound

	^ SampledSound soundNamed: 'motor'! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:01'!
initialize

	super initialize.
	self clock start! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:16'!
orbitingAround: aPoint at: aNumber speed: bNumber

	self action: [:sprite :t |
		sprite position: aPoint + (Point r: aNumber degrees: t \\ 360 * bNumber)]! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:11'!
step

	action ifNil: [^ self].

	self clock do: [:t | action value: self value: t]
	
	
! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 18:57'!
stepTime

	^ 20
	! !

!Sprite methodsFor: 'as yet unclassified' stamp: 'spfa 3/1/2012 11:15'!
wantsSteps

	^ true! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Sprite class
	instanceVariableNames: ''!

!Sprite class methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 21:11'!
brownianAround: aPoint

	^ self new action: [:sprite :t |
			| s |
		s := self speed asFloat.
		sprite position: aPoint + ((s atRandom - (s/2)) @ (s atRandom - (s/2)))]! !

!Sprite class methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:11'!
orbitingAround: aPoint at: aNumber speed: bNumber

	^ self new action: [:sprite :t |
		sprite position: aPoint + (Point r: aNumber degrees: t \\ 360 * bNumber)]! !

!Sprite class methodsFor: 'as yet unclassified' stamp: 'spfa 3/2/2012 12:52'!
pulsating

	| m |
	
	m _ self new.
	m clock frequency: 1000 atRandom / 100.0 .

	^ m action: [:sprite :t |
		sprite extent: ((t ) sin abs * 120 + 10) @ ((t * 0.5) cos abs * 50) + 10]! !


Sprite subclass: #Fragment
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!Fragment methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 21:02'!
canBeHit

	^ false! !

!Fragment methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:08'!
drawOn: aCanvas 

	aCanvas fillOval: bounds fillStyle: self fillStyle borderWidth: self borderWidth borderColor: self borderColor.
! !

!Fragment methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:29'!
explosion

	| counter |

	self color: Color yellow.
	self borderColor: Color orange.

	self extent: 10 at 10.
	counter := 15.
		
	self action: [:sprite :t |
		counter := counter - 1.
		counter < 0 ifTrue: [self delete].
		sprite extent: sprite extent + (4 at 4).
		self color: (self color alpha: counter * 0.07).
		self borderColor: (self borderColor alpha: counter * 0.06).
		sprite center: sprite center + ((6 atRandom - 4) @ (6 atRandom - 4))]! !

!Fragment methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:28'!
impact

	| counter |

	self color: Color orange.
	self borderColor: Color red.

	self extent: 5 at 5.
	counter := 15.
		
	self action: [:sprite :t |
		counter := counter - 1.
		counter < 0 ifTrue: [self delete].
		sprite extent: sprite extent + (1 at 1).
		self color: (self color alpha: counter * 0.06).
		self borderColor: (self borderColor alpha: counter * 0.04).
		sprite center: sprite center + ((3 atRandom - 2) @ (3 atRandom - 2))]! !

!Fragment methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:28'!
initialize

	super initialize.
	self borderWidth: 2.
	self cornerStyle: #rounded.
! !


Sprite subclass: #Rocket
	instanceVariableNames: 'speed'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!Rocket methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 21:53'!
canBeHit

	^ false! !

!Rocket methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:17'!
from: aPoint to: bPoint targetColor: aColor

	| dist |

	dist := bPoint dist: aPoint.
	
	self getFormFrom: aPoint to: bPoint.
	
	self action:  [:sprite :t |
		| dt contact targets |
		dt := t * self speed / dist.
		sprite position: aPoint + ((bPoint - aPoint) * dt).
		contact := sprite color: self laserColor sees: aColor.
		targets := (sprite owner morphsAt: sprite position behind: sprite unlocked: true) select: [:m | m isKindOf: Sprite].
		dt > self rangeFactor ifTrue: [sprite delete]. 
		contact ifTrue: [targets ifNotEmpty: [targets first getHitBy: sprite]]].

	self position: aPoint! !

!Rocket methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:17'!
getFormFrom: aPoint to: bPoint

	| canvas p1 p2 extp exta dist |
	
	dist := bPoint dist: aPoint.
	extp := ((bPoint - aPoint) * 20.0 / dist) rounded.
	exta := extp abs.
	canvas := FormCanvas extent: (exta + (2 at 2)).
	
	extp x *  extp y > 0 
		ifTrue: [p1 := 1 at 1 . p2 := exta]
		ifFalse: [p1 := 1@ exta y . p2 := exta x @ 1].
	
	canvas line: p1 to: p2 width: 2 color: self laserColor.
	
	form := canvas form.
	
	self extent: form extent.
! !

!Rocket methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 21:49'!
getHitBy: aRocket! !

!Rocket methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:01'!
power 

	^ 10! !

!Rocket methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 20:49'!
rangeFactor

	^ 3! !

!Rocket methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 20:45'!
speed

	^ 3000.0 / self stepTime! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Rocket class
	instanceVariableNames: ''!

!Rocket class methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:27'!
firingFrom: aPoint to: bPoint targetColor: aColor

	^ self new from: aPoint to: bPoint targetColor: aColor! !

!Rocket class methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:50'!
firingSound

	^ SampledSound soundNamed: 'meow'! !


Rocket subclass: #OrangeLaser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!OrangeLaser methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:21'!
getFormFrom: aPoint to: bPoint

	| canvas p1 p2 extp exta dist |
	
	dist := bPoint dist: aPoint.
	extp := ((bPoint - aPoint) * 30.0 / dist) rounded.
	exta := extp abs.
	canvas := FormCanvas extent: (exta + (2 at 2)).
	
	extp x *  extp y > 0 
		ifTrue: [p1 := 1 at 1 . p2 := exta]
		ifFalse: [p1 := 1@ exta y . p2 := exta x @ 1].
	
	canvas line: p1 to: p2 width: 2 color: self laserColor.
	canvas line: p1 to: p2 width: 1 color: Color yellow.	
	form := canvas form.
	
	self extent: form extent.
! !

!OrangeLaser methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:29'!
laserColor

	^ Color orange! !

!OrangeLaser methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:22'!
rangeFactor

	^ 2! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

OrangeLaser class
	instanceVariableNames: ''!

!OrangeLaser class methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:48'!
firingSound

	^ SampledSound soundNamed: 'coyote'! !


Rocket subclass: #RedLaser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!RedLaser methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 23:19'!
getFormFrom: aPoint to: bPoint

	| canvas p1 p2 extp exta dist |
	
	dist := bPoint dist: aPoint.
	extp := ((bPoint - aPoint) * 20.0 / dist) rounded.
	exta := extp abs.
	canvas := FormCanvas extent: (exta + (2 at 2)).
	
	extp x *  extp y > 0 
		ifTrue: [p1 := 1 at 1 . p2 := exta]
		ifFalse: [p1 := 1@ exta y . p2 := exta x @ 1].
	
	canvas line: p1 to: p2 width: 3 color: self laserColor.
	canvas line: p1 to: p2 width: 1 color: Color yellow.	
	form := canvas form.
	
	self extent: form extent.
! !

!RedLaser methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:28'!
laserColor

	^ Color red! !

!RedLaser methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 20:45'!
speed

	^ 4000.0 / self stepTime! !


Sprite subclass: #Spaceship
	instanceVariableNames: 'damage strength'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!Spaceship methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 21:58'!
addFragment

	^ (Fragment new position: self position) openInWorld
		! !

!Spaceship methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:38'!
explose

	self delete.
	self class explosionSound play.
	self fragments timesRepeat: [self addFragment explosion center: self center]
! !

!Spaceship methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:29'!
fragments

	^ 3
! !

!Spaceship methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:21'!
getHitBy: aRocket

	super getHitBy: aRocket.
	self addFragment impact center: aRocket center! !

!Spaceship methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:38'!
initialize

	super initialize.
	self borderWidth: 2.
	self borderColor: Color blue.
	damage := 0.
	strength := 100! !

!Spaceship methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:40'!
strength: anInteger

	strength := anInteger! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Spaceship class
	instanceVariableNames: ''!

!Spaceship class methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:37'!
explosionSound

	^ SampledSound soundNamed: 'splash'! !


Object subclass: #SpriteGame
	instanceVariableNames: 'warrior'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:13'!
down

	warrior position: warrior position + (0 at self speed)
! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:05'!
fire

		 | m |
		m := warrior getTarget.
		m ifNotNil: [warrior shoot: m]! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:01'!
install

	World submorphs do:[:m| m visible: false].
	World displayWorldSafely.
	
	World eventHandler: EventHandler new.
	World eventHandler on: #keyStroke send: #keyStroke: to: self.
	World eventHandler on: #mouseDown send: #yourself to: self.
	World eventHandler on: #mouseUp send: #yourself to: self.
				
	ActiveHand releaseKeyboardFocus.
	Preferences enable: #mouseOverForKeyboardFocus.
	
	self setUp
! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:08'!
keyStroke: anEvent 

	anEvent wasHandled: true.
	
	anEvent keyValue == 27 ifTrue: [^ self uninstall].

	anEvent keyCharacter caseOf: {
		[$q] -> [^ self fire].
			[$z] -> [^ self up].
				[$s] -> [^ self down].
					[$a] -> [^ self left].
						[$e] -> [^ self right].
		} otherwise: [].

	! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:11'!
left

	warrior position: warrior position + (self speed negated @0)
! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:11'!
right

	warrior position: warrior position + (self speed at 0)
! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:16'!
setUp

	1 to: 2 do: [:i|

(Warrior enemy orbitingAround: Display center at: (50 * 7 atRandom) + 30 speed: (100 atRandom + 10))  openInWorld

	].

	warrior := ((Warrior ally action: [:sprite :t | ]) position: 500 at 500) openInWorld
! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:10'!
speed

	^ 5! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:01'!
uninstall

	World submorphs do:[:m| m visible ifTrue: [m delete]].
	World submorphs do:[:m| m visible: true].
		
	World eventHandler: nil.
	
	Preferences disable: #mouseOverForKeyboardFocus.
! !

!SpriteGame methodsFor: 'as yet unclassified' stamp: 'spfa 6/11/2014 00:13'!
up 

	warrior position: warrior position + (0 at self speed negated)
! !


Spaceship subclass: #Warrior
	instanceVariableNames: 'rocketType fireRate'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!Warrior methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:45'!
fireRate: aNumber

	fireRate := aNumber! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:27'!
getHitBy: aRocket

	super getHitBy: aRocket.
	damage := damage + aRocket power.	
	damage > strength ifTrue: [self explose]! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 22:57'!
getTarget

	| targets |
	
	targets := World submorphs select: [:sm | 
		sm ~~ self and: [sm isKindOf: Sprite] and: [sm borderColor ~~ self borderColor] and: [sm canBeHit]].

	targets ifEmpty: [^ nil].
	^ targets atRandom
! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 22:27'!
guns

	^ {self topLeft . self topRight . self bottomLeft . self bottomRight}
! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:37'!
initialize

	super initialize.
	rocketType := RedLaser.
	fireRate := 10! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:20'!
rocketType: aClass

	rocketType := aClass! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'muOuser 6/12/2014 22:36'!
shoot: aMorph

	self guns do: [:gun |
		
		

	(rocketType firingFrom: gun to: aMorph center targetColor: aMorph borderColor) openInWorld].

rocketType firingSound play! !

!Warrior methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 19:47'!
step

	super step.
	
	(10000 / self stepTime) rounded atRandom < fireRate ifTrue: [ | m |
		m := self getTarget.
		m ifNotNil: [self shoot: m]]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Warrior class
	instanceVariableNames: ''!

!Warrior class methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 21:04'!
ally

	^ self new borderColor: Color black; strength: 200; fireRate: 20; extent: 40 at 40! !

!Warrior class methodsFor: 'as yet unclassified' stamp: 'spfa 6/12/2014 21:04'!
enemy

	^ Warrior2Guns new rocketType: OrangeLaser; fireRate: 10; extent: 60 at 20! !


Warrior subclass: #Warrior2Guns
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!

!Warrior2Guns methodsFor: 'as yet unclassified' stamp: 'spfa 6/10/2014 23:55'!
guns

	^ {self topLeft . self topRight}
! !


Warrior subclass: #Warrior4Guns
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Sprite'!


More information about the Squeak-dev mailing list