[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
|