[Vm-dev] VM Maker: VMMaker-dtl.356.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Dec 17 02:22:01 UTC 2014


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.356.mcz

==================== Summary ====================

Name: VMMaker-dtl.356
Author: dtl
Time: 16 December 2014, 9:20:35.462 pm
UUID: b4a4af04-ab24-45ac-9c5e-7fb83c764a85
Ancestors: VMMaker-dtl.355

VMMaker 4.13.9 - Update ScratchPlugin from VMMaker.oscog-tpr.989 plus previous updates by Eliot:

Name: VMMaker.oscog-tpr.989
Author: tpr
Time: 16 December 2014, 2:59:27.229 pm
Update the ScratchPlugin bilinear scaling prim to include the correct alpha channel value for non-transparent output pixels.

=============== Diff against VMMaker-dtl.355 ===============

Item was removed:
- ----- Method: ScratchPlugin class>>declareCVarsIn: (in category 'translation') -----
- declareCVarsIn: aCCodeGenerator
- 	"self translate"
- 
- 	super declareCVarsIn: aCCodeGenerator.
- 	aCCodeGenerator
- 		addHeaderFile: '<math.h>';
- 		addHeaderFile: '<stdlib.h>';
- 		addHeaderFile: '<string.h>'.
- !

Item was changed:
  ----- Method: ScratchPlugin>>primOpenPortNamed (in category 'serial port') -----
  primOpenPortNamed
  	"Open the port with the given name and baud rate."
  
  	| nameStr src nameOop baudRate count portNum |
  	<export: true>
  	<var: 'nameStr' declareC: 'char nameStr[1000]'>
+ 	<var: 'src' type: #'char *'>
- 	<var: 'src' declareC: 'char * src'>
  
  	nameOop := interpreterProxy stackValue: 1.
  	baudRate := interpreterProxy stackIntegerValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: nameOop).
- 	((interpreterProxy isIntegerObject: nameOop) or:
- 	 [(interpreterProxy isBytes: nameOop) not]) ifTrue: [
- 		interpreterProxy success: false.
- 		^ 0].
  
  	interpreterProxy failed ifTrue: [^ 0].
  
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: nameOop) to: #'char *'.
- 	src := self cCoerce: (interpreterProxy firstIndexableField: nameOop) to: 'char *'.
  	count := interpreterProxy stSizeOf: nameOop.
  	0 to: count - 1 do: [:i | nameStr at: i put: (src at: i)].
  	nameStr at: count put: 0.
  
+ 	portNum := self SerialPortOpen: nameStr PortNamed: baudRate.
- 	portNum := self cCode: 'SerialPortOpenPortNamed(nameStr, baudRate)'.
  	portNum = -1 ifTrue: [interpreterProxy success: false. ^ 0].
  
  	interpreterProxy	"pop args and rcvr, push result"
  		pop: 3
  		thenPush: (interpreterProxy integerObjectOf: portNum).
  
  	^ 0
  !

Item was changed:
  ----- Method: ScratchPlugin>>primRead (in category 'serial port') -----
  primRead
  	"Read data from the given serial port into the given buffer (a ByteArray or String). Answer the number of bytes read."
  
+ 	| portNum bufOop bytesRead |
- 	| portNum bufOop bufPtr bufSize bytesRead |
  	<export: true>
- 	<var: 'bufPtr' declareC: 'char *bufPtr'>
  
  	portNum := interpreterProxy stackIntegerValue: 1.
  	bufOop := interpreterProxy stackValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: bufOop).
+ 	interpreterProxy failed ifTrue: [^ 0].
- 	((interpreterProxy isIntegerObject: bufOop) or:
- 	 [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
- 		interpreterProxy success: false.
- 		^ 0].
- 	bufPtr := self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'.
- 	bufSize := interpreterProxy stSizeOf: bufOop.
- 	interpreterProxy failed ifTrue: [^ nil].
  
+ 	bytesRead := self Serial: portNum
+ 						Port: (self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *')
+ 						Read: (interpreterProxy stSizeOf: bufOop).
- 	bytesRead := self cCode: 'SerialPortRead(portNum, bufPtr, bufSize)'.
  
  	interpreterProxy pop: 3.  					"pop args and rcvr"
  	interpreterProxy pushInteger: bytesRead.	"push result"
+ 	^ 0!
- 	^ 0
- !

Item was changed:
  ----- Method: ScratchPlugin>>primWrite (in category 'serial port') -----
  primWrite
  	"Write data to the given serial port from the given buffer (a ByteArray or String). Answer the number of bytes written."
  
+ 	| portNum bufOop bytesWritten |
- 	| portNum bufOop bufPtr bufSize bytesWritten |
  	<export: true>
- 	<var: 'bufPtr' declareC: 'char *bufPtr'>
  
  	portNum := interpreterProxy stackIntegerValue: 1.
  	bufOop := interpreterProxy stackValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: bufOop).
+ 	interpreterProxy failed ifTrue: [^ 0].
- 	((interpreterProxy isIntegerObject: bufOop) or:
- 	 [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
- 		interpreterProxy success: false.
- 		^ 0].
- 	bufPtr := self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'.
- 	bufSize := interpreterProxy stSizeOf: bufOop.
- 	interpreterProxy failed ifTrue: [^ nil].
  
+ 	bytesWritten := self Serial: portNum
+ 						Port: (self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *')
+ 						Write: (interpreterProxy stSizeOf: bufOop).
- 	bytesWritten := self cCode: 'SerialPortWrite(portNum, bufPtr, bufSize)'.
  
+ 	interpreterProxy pop: 3.  						"pop args and rcvr"
- 	interpreterProxy pop: 3.  					"pop args and rcvr"
  	interpreterProxy pushInteger: bytesWritten.	"push result"
+ 	^ 0!
- 	^ 0
- !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveFisheye (in category 'other filters') -----
  primitiveFisheye
  
  	| inOop outOop width in out sz height centerX centerY dx dy ang pix power r srcX srcY scaledPower |
  	<export: true>
+ 	<var: 'in' type: #'unsigned int *'>
+ 	<var: 'out' type: #'unsigned int *'>
+ 	<var: 'dx' type: #double>
+ 	<var: 'dy' type: #double>
+ 	<var: 'ang' type: #double>
+ 	<var: 'r' type: #double>
+ 	<var: 'scaledPower' type: #double>
- 	<var: 'in' declareC: 'unsigned int *in'>
- 	<var: 'out' declareC: 'unsigned int *out'>
- 	<var: 'scaleX' declareC: 'double scaleX'>
- 	<var: 'scaleY' declareC: 'double scaleY'>
- 	<var: 'whirlRadians' declareC: 'double whirlRadians'>
- 	<var: 'radiusSquared' declareC: 'double radiusSquared'>
- 	<var: 'dx' declareC: 'double dx'>
- 	<var: 'dy' declareC: 'double dy'>
- 	<var: 'd' declareC: 'double d'>
- 	<var: 'factor' declareC: 'double factor'>
- 	<var: 'ang' declareC: 'double ang'>
- 	<var: 'sina' declareC: 'double sina'>
- 	<var: 'cosa' declareC: 'double cosa'>
- 	<var: 'r' declareC: 'double r'>
- 	<var: 'scaledPower' declareC: 'double scaledPower'>
  
  	inOop := interpreterProxy stackValue: 3.
  	outOop := interpreterProxy stackValue: 2.
  	width := interpreterProxy stackIntegerValue: 1.
  	power := interpreterProxy stackIntegerValue: 0.
  	in := self checkedUnsignedIntPtrOf: inOop.
  	out := self checkedUnsignedIntPtrOf: outOop.
  	sz := interpreterProxy stSizeOf: inOop.
  	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
  	interpreterProxy failed ifTrue: [^ nil].
  
  	"calculate height, center, scales, radius, whirlRadians, and radiusSquared"
  	height := sz // width.
  	centerX := width // 2.
  	centerY := height // 2.
  
  	height := sz // width.
  	centerX := width // 2.
  	centerY := height // 2.
  	scaledPower := power / 100.0.
  
  	0 to: width - 1 do: [:x |
  		0 to: height - 1 do: [:y |
  			dx := (x - centerX) / centerX asFloat.
  			dy := (y - centerY) / centerY asFloat.
  			r := ((dx * dx) + (dy * dy)) sqrt raisedTo: scaledPower.
  			r <= 1.0
  				ifTrue: [
  					ang := self cCode: 'atan2(dy,dx)'.
  					srcX := (1024 * (centerX + ((r * ang cos) * centerX))) asInteger.
  					srcY := (1024 * (centerY + ((r * ang sin) * centerY))) asInteger]
  				ifFalse: [
  					srcX := 1024 * x.
  					srcY := 1024 * y].
  			pix := self interpolatedFrom: in
  					x: srcX
  					y: srcY
  					width: width
  					height: height.
  			out at: ((y * width) + x "+ 1 for Squeak") put: pix]].
  
  	interpreterProxy pop: 4.  "pop args, leave rcvr on stack"
  	^ 0
  !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveIsHidden (in category 'os functions') -----
  primitiveIsHidden
  	"Answer true if the file or folder with the given path should be hidden from the user. On Windows, this is the value of the 'hidden' file property."
  
  	| pathOop src count fullPath result |
  	<export: true>
  	<var: 'fullPath' declareC: 'char fullPath[1000]'>
+ 	<var: 'src' type: #'char *'>
- 	<var: 'src' declareC: 'char * src'>
  
  	pathOop := interpreterProxy stackValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: pathOop).
- 	((interpreterProxy isIntegerObject: pathOop) or:
- 	 [(interpreterProxy isBytes: pathOop) not]) ifTrue: [
- 		interpreterProxy success: false].
  
  	interpreterProxy failed ifTrue: [^ 0].
  
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: pathOop) to: #'char *'.
- 	src := self cCoerce: (interpreterProxy firstIndexableField: pathOop) to: 'char *'.
  	count := interpreterProxy stSizeOf: pathOop.
  	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
  	0 to: count - 1 do: [:i | fullPath at: i put: (src at: i)].
  	fullPath at: count put: 0.
  
+ 	result := self IsFileOrFolderHidden: fullPath.
- 	result := self cCode: 'IsFileOrFolderHidden(fullPath)'.
  
  	interpreterProxy pop: 2.  "pop arg and rcvr"
  	interpreterProxy pushBool: result ~= 0.  "push result"
+ 	^ 0!
- 	^ 0
- 
- !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveOpenURL (in category 'os functions') -----
  primitiveOpenURL
  	"Open a web browser on the given URL."
  
  	| urlStr src urlOop count |
  	<export: true>
  	<var: 'urlStr' declareC: 'char urlStr[2000]'>
+ 	<var: 'src' type: #'char *'>
- 	<var: 'src' declareC: 'char * src'>
  
  	urlOop := interpreterProxy stackValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: urlOop).
- 	((interpreterProxy isIntegerObject: urlOop) or:
- 	 [(interpreterProxy isBytes: urlOop) not]) ifTrue: [
- 		interpreterProxy success: false].
  
  	interpreterProxy failed ifTrue: [^ 0].
  
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: urlOop) to: #'char *'.
- 	src := self cCoerce: (interpreterProxy firstIndexableField: urlOop) to: 'char *'.
  	count := interpreterProxy stSizeOf: urlOop.
  	count >= 2000 ifTrue: [interpreterProxy success: false. ^ 0].
  	0 to: count - 1 do: [:i | urlStr at: i put: (src at: i)].
  	urlStr at: count put: 0.
  
+ 	self OpenURL: urlStr.
- 	self cCode: 'OpenURL(urlStr)'.
  
  	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0!
- 	^ 0
- 
- !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveScale (in category 'scaling') -----
  primitiveScale
  	"Scale using bilinear interpolation."
+ 	"This version isn't really able to do much with full ARGB based images; the A channel will be ignored and only fully transparent pixels will be treated as transparent. The output pixel will be either fully transparent or fully opaque."
  
  	| inOop inW inH outOop outW outH in out inX inY xIncr yIncr outPix w1 w2 w3 w4 t p1 p2 p3 p4 tWeight |
  	<export: true>
  	<var: 'in' declareC: 'int *in'>
  	<var: 'out' declareC: 'int *out'>
  
  	inOop := interpreterProxy stackValue: 5.
  	inW := interpreterProxy stackIntegerValue: 4.
  	inH := interpreterProxy stackIntegerValue: 3.
  	outOop := interpreterProxy stackValue: 2.
  	outW := interpreterProxy stackIntegerValue: 1.
  	outH := interpreterProxy stackIntegerValue: 0.
  
  	interpreterProxy success: (interpreterProxy stSizeOf: inOop) = (inW * inH).
  	interpreterProxy success: (interpreterProxy stSizeOf: outOop) = (outW * outH).
  	in := self checkedUnsignedIntPtrOf: inOop.
  	out := self checkedUnsignedIntPtrOf: outOop.
  	interpreterProxy failed ifTrue: [^ nil].
  
  	inX := inY := 0.					"source x and y, scaled by 1024"
  	xIncr := (inW * 1024) // outW.	"source x increment, scaled by 1024"
  	yIncr := (inH * 1024) // outH.		"source y increment, scaled by 1024"
  
  	0 to: (outH - 1) do: [:outY |
  		inX := 0.
  		0 to: (outW - 1) do: [:outX |
  			"compute weights, scaled by 2^20"
  			w1 := (1024 - (inX bitAnd: 1023))	* (1024 - (inY bitAnd: 1023)).
  			w2 := (inX bitAnd: 1023)			* (1024 - (inY bitAnd: 1023)).
  			w3 := (1024 - (inX bitAnd: 1023))	* (inY bitAnd: 1023).
  			w4 := (inX bitAnd: 1023)			* (inY bitAnd: 1023).
  
  			"get source pixels"
  			t := ((inY >> 10) * inW) + (inX >> 10).
  			p1 := in at: t.
  			((inX >> 10) < (inW - 1)) ifTrue: [p2 := in at: t + 1] ifFalse: [p2 := p1].
  			(inY >> 10) < (inH - 1) ifTrue: [t := t + inW].  "next row"
  			p3 := in at: t.
  			((inX >> 10) < (inW - 1)) ifTrue: [p4 := in at: t + 1] ifFalse: [p4 := p3].
  
  			"deal with transparent pixels"
+ 			"Note as above - only transparent not translucent"
  			tWeight := 0.
  			p1 = 0 ifTrue: [p1 := p2. tWeight := tWeight + w1].
  			p2 = 0 ifTrue: [p2 := p1. tWeight := tWeight + w2].
  			p3 = 0 ifTrue: [p3 := p4. tWeight := tWeight + w3].
  			p4 = 0 ifTrue: [p4 := p3. tWeight := tWeight + w4].
  			p1 = 0 ifTrue: [p1 := p3. p2 := p4].  "both top pixels were transparent; use bottom row"
  			p3 = 0 ifTrue: [p3 := p1. p4 := p2].  "both bottom pixels were transparent; use top row"
  
  			outPix := 0.
  			tWeight < 500000 ifTrue: [  "compute an (opaque) output pixel if less than 50% transparent"
  				t := (w1 * ((p1 >> 16) bitAnd: 255)) + (w2 * ((p2 >> 16) bitAnd: 255)) + (w3 * ((p3 >> 16) bitAnd: 255)) + (w4 * ((p4 >> 16) bitAnd: 255)).
  				outPix := ((t >> 20) bitAnd: 255) << 16.
  				t := (w1 * ((p1 >> 8) bitAnd: 255)) + (w2 * ((p2 >> 8) bitAnd: 255)) + (w3 * ((p3 >> 8) bitAnd: 255)) + (w4 * ((p4 >> 8) bitAnd: 255)).
  				outPix := outPix bitOr: (((t >> 20) bitAnd: 255) << 8).
  				t := (w1 * (p1 bitAnd: 255)) + (w2 * (p2 bitAnd: 255)) + (w3 * (p3 bitAnd: 255)) + (w4 * (p4 bitAnd: 255)).
  				outPix := outPix bitOr: ((t >> 20) bitAnd: 255).
+ 				"If the result is black, remember to make it Squeak-standard-fake-black"
+ 				outPix = 0 ifTrue: [outPix := 1].
+ 				"add the A channel to make it really opaque"
+ 				outPix := outPix bitOr: 16rFF000000].
- 				outPix = 0 ifTrue: [outPix := 1]].
  
  			out at: (outY * outW) + outX put: outPix.
  			inX := inX + xIncr].
  		inY := inY + yIncr].
  
  	interpreterProxy pop: 6.  "pop args, leave rcvr on stack"
  	^ 0
  !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveSetUnicodePasteBuffer (in category 'os functions') -----
  primitiveSetUnicodePasteBuffer
  	"Set the Mac OS X Unicode paste buffer."
  
  	| utf16 strOop count |
  	<export: true>
+ 	<var: 'utf16' declareC: 'short *utf16'>
- 	<var: 'utf16' declareC: 'short int *utf16'>
  
  	strOop := interpreterProxy stackValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: strOop).
- 	((interpreterProxy isIntegerObject: strOop) or:
- 	 [(interpreterProxy isBytes: strOop) not]) ifTrue: [
- 		interpreterProxy success: false].
  
  	interpreterProxy failed ifTrue: [^ 0].
  
+ 	utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: #'short *'.
- 	utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'short int *'.
  	count := interpreterProxy stSizeOf: strOop.
  
+ 	self SetUnicodePaste: utf16 Buffer: count.
- 	self cCode: 'SetUnicodePasteBuffer(utf16, count)'.
  
  	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0!
- 	^ 0
- 
- !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveSetWindowTitle (in category 'os functions') -----
  primitiveSetWindowTitle
  	"Set the title of the Scratch window."
  
  	| titleStr src titleOop count |
  	<export: true>
  	<var: 'titleStr' declareC: 'char titleStr[1000]'>
+ 	<var: 'src' type: #'char *'>
- 	<var: 'src' declareC: 'char * src'>
  
  	titleOop := interpreterProxy stackValue: 0.
  
+ 	interpreterProxy success: (interpreterProxy isBytes: titleOop).
- 	((interpreterProxy isIntegerObject: titleOop) or:
- 	 [(interpreterProxy isBytes: titleOop) not]) ifTrue: [
- 		interpreterProxy success: false].
  
  	interpreterProxy failed ifTrue: [^ 0].
  
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: titleOop) to: #'char *'.
- 	src := self cCoerce: (interpreterProxy firstIndexableField: titleOop) to: 'char *'.
  	count := interpreterProxy stSizeOf: titleOop.
  	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
  	0 to: count - 1 do: [:i | titleStr at: i put: (src at: i)].
  	titleStr at: count put: 0.
  
+ 	self SetScratchWindowTitle: titleStr.
- 	self cCode: 'SetScratchWindowTitle(titleStr)'.
  
  	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0!
- 	^ 0
- 
- !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveShortToLongPath (in category 'os functions') -----
  primitiveShortToLongPath
  	"On Windows, convert a short file/path name into a long one. Fail on other platforms."
  
  	| shortPath longPath ptr shortPathOop result count resultOop |
  	<export: true>
  	<var: 'shortPath' declareC: 'char shortPath[1000]'>
  	<var: 'longPath' declareC: 'char longPath[1000]'>
+ 	<var: 'ptr' type: #'char *'>
- 	<var: 'ptr' declareC: 'char * ptr'>
  
  	shortPathOop := interpreterProxy stackValue: 0.
  
+ 	(interpreterProxy isBytes: shortPathOop) ifFalse:
+ 		[interpreterProxy success: false. ^ 0].
- 	((interpreterProxy isIntegerObject: shortPathOop) or:
- 	 [(interpreterProxy isBytes: shortPathOop) not]) ifTrue: [
- 		interpreterProxy success: false. ^ 0].
  
+ 	ptr := self cCoerce: (interpreterProxy firstIndexableField: shortPathOop) to: #'char *'.
- 	ptr := self cCoerce: (interpreterProxy firstIndexableField: shortPathOop) to: 'char *'.
  	count := interpreterProxy stSizeOf: shortPathOop.
  	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
  	0 to: count - 1 do: [:i | shortPath at: i put: (ptr at: i)].
  	shortPath at: count put: 0.
  
  	result := self cCode: 'WinShortToLongPath(shortPath, longPath, 1000)'.
  	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
  
+ 	count := self strlen: longPath.
- 	count := self cCode: 'strlen(longPath)'.
  	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	ptr := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: #'char *'.
- 	ptr := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
  	0 to: count - 1 do: [:i | ptr at: i put: (longPath at: i)].
  
  	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0!
- 	^ 0
- !

Item was changed:
  ----- Method: ScratchPlugin>>primitiveWaterRipples1 (in category 'other filters') -----
  primitiveWaterRipples1
   
  	| in out aArray bArray ripply temp pix dx dy dist inOop outOop width allPix aArOop bArOop height t1 blops x y power val val2 dx2 dy2 newLoc |
  	<export: true>
  	<var: 'in' declareC: 'unsigned int *in'>
  	<var: 'out' declareC: 'unsigned int *out'>
  	<var: 'aArray' declareC: 'double *aArray'>
  	<var: 'bArray' declareC: 'double *bArray'>
  	<var: 'ripply' declareC: 'int ripply'>
  	<var: 'temp' declareC: 'double temp'>
  	<var: 'pix' declareC: 'unsigned int pix'>
  	<var: 'dist' declareC: 'double dist'>
  	<var: 'dx2' declareC: 'double dx2'>
  	<var: 'dy2' declareC: 'double dy2'>
  
  	inOop := interpreterProxy stackValue: 5.
  	outOop := interpreterProxy stackValue: 4.
  	width := interpreterProxy stackIntegerValue: 3.
  	in := self checkedUnsignedIntPtrOf: inOop.
  	out := self checkedUnsignedIntPtrOf: outOop.
  	allPix := interpreterProxy stSizeOf: inOop.
  	ripply := interpreterProxy stackIntegerValue: 2.
  	aArOop := interpreterProxy stackValue: 1.
  	bArOop := interpreterProxy stackValue: 0.
  	aArray := self checkedFloatPtrOf: aArOop.
  	bArray := self checkedFloatPtrOf: bArOop.
  	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = allPix).
  	interpreterProxy failed ifTrue: [^ nil].
  
  	height := allPix // width.
  
  	t1 := self cCode: 'rand()'.
  	blops := t1 \\ ripply -1.
  	0 to: blops /2-1 do: [:t |
  		t1 := self cCode: 'rand()'.
  		x := t1 \\ width.
  		t1 := self cCode: 'rand()'.
  		y := t1 \\ height.
  		t1 := self cCode: 'rand()'.
  		power := t1 \\ 8.
  		-4 to: 4 do: [:g |
  			-4 to: 4 do: [:h |
  				dist := ((g*g) + (h*h)) asFloat.
  				((dist < 25) and: [dist > 0]) ifTrue: [
  						dx := (x + g) asInteger.
  						dy := (y + h) asInteger.
  						((dx >0) and: [(dy>0) and: [(dy < height) and: [dx < width]]]) ifTrue: [
  							aArray at: ((dy)*width + dx) put: (power *(1.0 asFloat -(dist/(25.0 asFloat))) asFloat).
  						].
  					].
  				].
  			].
  		].
  	
  		1 to: width -2 do: [:f |
  			1 to: height -2 do: [:d |
  			val := (d)*width + f.
  			aArray at: val put: (((
  				(bArray at: (val+1)) + (bArray at: (val-1)) + (bArray at: (val + width)) + (bArray at: (val - width)) +
  				((bArray at: (val -1 -width))/2) + ((bArray at: (val-1+width))/2) + ((bArray at: (val+1-width))/2) + ((bArray at: (val+1+width))/2)) /4) - (aArray at: (val))).
  			aArray at: (val) put: ((aArray at: (val))*(0.9 asFloat)).
  			].
  		].
  	
  		"temp := bArray.
  		bArray := aArray.
  		aArray := temp."
  		0 to: width*height do: [:q |
  			temp := bArray at: q.
  			bArray at: q put: (aArray at: q).
  			aArray at: q put: temp.
  		].
  
  		0 to: height-1 do: [:j |
  			0 to: width-1 do: [:i |
  				((i > 1) and: [(i<(width-1)) and: [(j>1) and: [(j<(height-1))]]]) ifTrue: [
  					val2 := (j)*width + i.
  					dx2 := ((((aArray at: (val2)) - (aArray at: (val2-1))) + ((aArray at: (val2+1)) - (aArray at: (val2)))) *64) asFloat.
  					dy2 := ((((aArray at: (val2)) - (aArray at: (val2-width))) + ((aArray at: (val2+width)) - (aArray at: (val2)))) /64) asFloat.
+ 					(dx2 < -2) ifTrue: [dx2 := -2].
+ 					(dx2 >  2) ifTrue: [dx2 :=  2].
+ 					(dy2 < -2) ifTrue: [dy2 := -2].
+ 					(dy2 >  2) ifTrue: [dy2 :=  2].
- 					(dx2<2) ifTrue: [dx2 := -2].
- 					(dx2>2) ifTrue: [dx2 := 2].
- 					(dy2<2) ifTrue: [dy2 := -2].
- 					(dy2>2) ifTrue: [dy2 := 2].
  					newLoc := ((j+dy2)*width + (i+dx2)) asInteger.
  					((newLoc < (width*height)) and: [newLoc >=0]) ifTrue: [
  						pix := in at: newLoc]
  					ifFalse: [
  						pix := in at: (i +(j*width)) ].
  				]
  				ifFalse: [
  					pix := in at: (i +(j*width)) ].
  			out at: (i + (j*width)) put: pix.
  		]].
  
  	interpreterProxy pop: 6.  "pop args, leave rcvr on stack"
  	^ 0
  !

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.13.9'!
- 	^'4.13.8'!



More information about the Vm-dev mailing list