[Vm-dev] VM Maker: VMMaker-bf.282.mcz

Bert Freudenberg uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker-bf.282.mcz

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

Name: VMMaker-bf.282 Author: bf Time: 31 July 2012, 11:21:02.618999999 am UUID: e271ca7e-933f-4ec4-ab16-0218182ac3ef Ancestors: VMMaker-bf.281

VMMaker 4.9.8 - convert underscore assignments in Scratch plugins

=============== Diff against VMMaker-bf.281 ===============

Item was changed: ----- Method: CameraPlugin>>primCameraName (in category 'primitives') ----- primCameraName "Get the name for the camera with the given number. Fail if the camera number is greater than the number of available cameras."

| cameraNum nameStr count resultOop dst | self export: true. self var: 'nameStr' declareC: 'char* nameStr'. self var: 'dst' declareC: 'char* dst'.

+ cameraNum := interpreterProxy stackIntegerValue: 0. - cameraNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

+ nameStr := self cCode: 'CameraName(cameraNum)'. - nameStr _ self cCode: 'CameraName(cameraNum)'. nameStr = nil ifTrue: [ interpreterProxy success: false. ^ 0].

+ count := self cCode: '(int) strlen(nameStr)'. + resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. + dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. - count _ self cCode: '(int) strlen(nameStr)'. - resultOop _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. - dst _ self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. 0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].

interpreterProxy pop: 2 thenPush: resultOop. "pop arg and rcvr, push result" ^ 0 !

Item was changed: ----- Method: CameraPlugin>>primCloseCamera (in category 'primitives') ----- primCloseCamera "Close the camera. Do nothing if it was not open."

| cameraNum | self export: true. + cameraNum := interpreterProxy stackIntegerValue: 0. - cameraNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

self cCode: 'CameraClose(cameraNum)'.

interpreterProxy pop: 1. "pop arg, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: CameraPlugin>>primFrameExtent (in category 'primitives') ----- primFrameExtent "Answer the frame extent of the given camera, or zero if the camera is not open. The extent is 16 bits of width and height packed into a single integer."

| cameraNum e | self export: true. + cameraNum := interpreterProxy stackIntegerValue: 0. - cameraNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

+ e := self cCode: 'CameraExtent(cameraNum)'. - e _ self cCode: 'CameraExtent(cameraNum)'.

interpreterProxy pop: 2 thenPush: (interpreterProxy integerObjectOf: e). "pop rcvr & arg, push int result" ^ 0 !

Item was changed: ----- Method: CameraPlugin>>primGetFrame (in category 'primitives') ----- primGetFrame "Copy a camera frame into the given Bitmap. The Bitmap should be for a Form of depth 32 that is the same width and height as the current camera frame. Fail if the camera is not open or if the bitmap is not the right size. If successful, answer the number of frames received from the camera since the last call. If this is zero, then there has been no change."

| cameraNum bitmapOop bitmap pixCount result | self export: true. self var: 'bitmap' declareC: 'unsigned char *bitmap'.

+ cameraNum := interpreterProxy stackIntegerValue: 1. + bitmapOop := interpreterProxy stackValue: 0. - cameraNum _ interpreterProxy stackIntegerValue: 1. - bitmapOop _ interpreterProxy stackValue: 0. ((interpreterProxy isIntegerObject: bitmapOop) or: [(interpreterProxy isWords: bitmapOop) not]) ifTrue: [ interpreterProxy success: false. ^ 0]. + bitmap := self cCoerce: (interpreterProxy firstIndexableField: bitmapOop) to: 'unsigned char *'. + pixCount := interpreterProxy stSizeOf: bitmapOop. - bitmap _ self cCoerce: (interpreterProxy firstIndexableField: bitmapOop) to: 'unsigned char *'. - pixCount _ interpreterProxy stSizeOf: bitmapOop.

+ result := self cCode: 'CameraGetFrame(cameraNum, bitmap, pixCount)'. - result _ self cCode: 'CameraGetFrame(cameraNum, bitmap, pixCount)'. result < 0 ifTrue: [ interpreterProxy success: false. ^ 0].

interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result). "pop rcvr & args, push int result" ^ 0

!

Item was changed: ----- Method: CameraPlugin>>primGetParam (in category 'primitives') ----- primGetParam "Answer the given integer parameter of the given camera."

| cameraNum paramNum result | self export: true. + cameraNum := interpreterProxy stackIntegerValue: 1. + paramNum := interpreterProxy stackIntegerValue: 0. - cameraNum _ interpreterProxy stackIntegerValue: 1. - paramNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

+ result := self cCode: 'CameraGetParam(cameraNum, paramNum)'. - result _ self cCode: 'CameraGetParam(cameraNum, paramNum)'.

interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result). "pop rcvr & args, push int result" ^ 0 !

Item was changed: ----- Method: CameraPlugin>>primOpenCamera (in category 'primitives') ----- primOpenCamera "Open a camera. Takes one argument, the index of the device to open."

| cameraNum desiredFrameWidth desiredFrameHeight ok | self export: true.

+ cameraNum := interpreterProxy stackIntegerValue: 2. + desiredFrameWidth := interpreterProxy stackIntegerValue: 1. + desiredFrameHeight := interpreterProxy stackIntegerValue: 0. - cameraNum _ interpreterProxy stackIntegerValue: 2. - desiredFrameWidth _ interpreterProxy stackIntegerValue: 1. - desiredFrameHeight _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

+ ok := self cCode: 'CameraOpen(cameraNum, desiredFrameWidth, desiredFrameHeight)'. - ok _ self cCode: 'CameraOpen(cameraNum, desiredFrameWidth, desiredFrameHeight)'. ok = 0 ifTrue: [ interpreterProxy success: false. ^ 0].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>bitmap:at:putH:s:v: (in category 'private') ----- bitmap: bitmap at: i putH: hue s: saturation v: brightness

| hI hF p q t v outPix | self inline: true. self var: 'bitmap' declareC: 'unsigned int *bitmap'.

+ hI := hue // 60. "integer part of hue (0..5)" + hF := hue \ 60. "fractional part ofhue" + p := (1000 - saturation) * brightness. + q := (1000 - ((saturation * hF) // 60)) * brightness. + t := (1000 - ((saturation * (60 - hF)) // 60)) * brightness. - hI _ hue // 60. "integer part of hue (0..5)" - hF _ hue \ 60. "fractional part ofhue" - p _ (1000 - saturation) * brightness. - q _ (1000 - ((saturation * hF) // 60)) * brightness. - t _ (1000 - ((saturation * (60 - hF)) // 60)) * brightness.

+ v := (brightness * 1000) // 3922. + p := p // 3922. + q := q // 3922. + t := t // 3922. - v _ (brightness * 1000) // 3922. - p _ p // 3922. - q _ q // 3922. - t _ t // 3922.

+ 0 = hI ifTrue: [outPix := ((v bitShift: 16) + (t bitShift: 8) + p)]. + 1 = hI ifTrue: [outPix := ((q bitShift: 16) + (v bitShift: 8) + p)]. + 2 = hI ifTrue: [outPix := ((p bitShift: 16) + (v bitShift: 8) + t)]. + 3 = hI ifTrue: [outPix := ((p bitShift: 16) + (q bitShift: 8) + v)]. + 4 = hI ifTrue: [outPix := ((t bitShift: 16) + (p bitShift: 8) + v)]. + 5 = hI ifTrue: [outPix := ((v bitShift: 16) + (p bitShift: 8) + q)]. - 0 = hI ifTrue: [outPix _ ((v bitShift: 16) + (t bitShift: 8) + p)]. - 1 = hI ifTrue: [outPix _ ((q bitShift: 16) + (v bitShift: 8) + p)]. - 2 = hI ifTrue: [outPix _ ((p bitShift: 16) + (v bitShift: 8) + t)]. - 3 = hI ifTrue: [outPix _ ((p bitShift: 16) + (q bitShift: 8) + v)]. - 4 = hI ifTrue: [outPix _ ((t bitShift: 16) + (p bitShift: 8) + v)]. - 5 = hI ifTrue: [outPix _ ((v bitShift: 16) + (p bitShift: 8) + q)].

+ outPix = 0 ifTrue: [outPix := 1]. "convert transparent to 1" - outPix = 0 ifTrue: [outPix _ 1]. "convert transparent to 1" bitmap at: i put: outPix. ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>hueFromR:G:B:min:max: (in category 'private') ----- hueFromR: r G: g B: b min: min max: max "Answer the hue, an angle between 0 and 360."

| span result | self inline: true.

+ span := max - min. - span _ max - min. span = 0 ifTrue: [^ 0].

r = max + ifTrue: [result := ((60 * (g - b)) // span)] - ifTrue: [result _ ((60 * (g - b)) // span)] ifFalse: [ g = max + ifTrue: [result := 120 + ((60 * (b - r)) // span)] + ifFalse: [result := 240 + ((60 * (r - g)) // span)]]. - ifTrue: [result _ 120 + ((60 * (b - r)) // span)] - ifFalse: [result _ 240 + ((60 * (r - g)) // span)]].

result < 0 ifTrue: [^ result + 360]. ^ result !

Item was changed: ----- Method: ScratchPlugin>>interpolate:and:frac: (in category 'private') ----- interpolate: pix1 and: pix2 frac: frac2 "Answer the interpolated pixel value between the given two pixel values. If either pixel is zero (transparent) answer the other pixel. If both pixels are transparent, answer transparent. The fraction is between 0 and 1023, out of a total range of 1024."

| frac1 r g b result | self inline: true.

pix1 = 0 ifTrue: [^ pix2]. "pix1 is transparent" pix2 = 0 ifTrue: [^ pix1]. "pix2 is transparent"

+ frac1 := 1024 - frac2. + r := ((frac1 * ((pix1 bitShift: -16) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -16) bitAnd: 16rFF))) // 1024. + g := ((frac1 * ((pix1 bitShift: -8) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -8) bitAnd: 16rFF))) // 1024. + b := ((frac1 * (pix1 bitAnd: 16rFF)) + (frac2 * (pix2 bitAnd: 16rFF))) // 1024. + result := (r bitShift: 16) + (g bitShift: 8) + b. + result = 0 ifTrue: [result := 1]. - frac1 _ 1024 - frac2. - r _ ((frac1 * ((pix1 bitShift: -16) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -16) bitAnd: 16rFF))) // 1024. - g _ ((frac1 * ((pix1 bitShift: -8) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -8) bitAnd: 16rFF))) // 1024. - b _ ((frac1 * (pix1 bitAnd: 16rFF)) + (frac2 * (pix2 bitAnd: 16rFF))) // 1024. - result _ (r bitShift: 16) + (g bitShift: 8) + b. - result = 0 ifTrue: [result _ 1]. ^ result !

Item was changed: ----- Method: ScratchPlugin>>interpolatedFrom:x:y:width:height: (in category 'private') ----- interpolatedFrom: bitmap x: xFixed y: yFixed width: w height: h "Answer the interpolated pixel value from the given bitmap at the given point. The x and y coordinates are fixed-point integers with 10 bits of fraction (i.e. they were multiplied by 1024, then truncated). If the given point is right on an edge, answer the nearest edge pixel value. If it is entirely outside of the image, answer 0 (transparent)."

| x y xFrac yFrac index topPix bottomPix | self inline: true. self var: 'bitmap' declareC: 'unsigned int *bitmap'.

+ x := xFixed bitShift: -10. - x _ xFixed bitShift: -10. (x < -1 or: [x >= w]) ifTrue: [^ 0]. + y := yFixed bitShift: -10. - y _ yFixed bitShift: -10. (y < -1 or: [y >= h]) ifTrue: [^ 0].

+ xFrac := xFixed bitAnd: 1023. + x = -1 ifTrue: [x := 0. xFrac := 0]. "left edge" + x = (w - 1) ifTrue: [xFrac := 0]. "right edge" - xFrac _ xFixed bitAnd: 1023. - x = -1 ifTrue: [x _ 0. xFrac _ 0]. "left edge" - x = (w - 1) ifTrue: [xFrac _ 0]. "right edge"

+ yFrac := yFixed bitAnd: 1023. + y = -1 ifTrue: [y := 0. yFrac := 0]. "top edge" + y = (h - 1) ifTrue: [yFrac := 0]. "bottom edge" - yFrac _ yFixed bitAnd: 1023. - y = -1 ifTrue: [y _ 0. yFrac _ 0]. "top edge" - y = (h - 1) ifTrue: [yFrac _ 0]. "bottom edge"

+ index := (y * w) + x "for squeak: + 1". + topPix := (bitmap at: index) bitAnd: 16rFFFFFF. - index _ (y * w) + x "for squeak: + 1". - topPix _ (bitmap at: index) bitAnd: 16rFFFFFF. xFrac > 0 ifTrue: [ + topPix := self interpolate: topPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac]. - topPix _ self interpolate: topPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].

yFrac = 0 ifTrue: [^ topPix]. "no y fraction, so just use value from top row"

+ index := ((y + 1) * w) + x "for squeak: + 1". + bottomPix := (bitmap at: index) bitAnd: 16rFFFFFF. - index _ ((y + 1) * w) + x "for squeak: + 1". - bottomPix _ (bitmap at: index) bitAnd: 16rFFFFFF. xFrac > 0 ifTrue: [ + bottomPix := self interpolate: bottomPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac]. - bottomPix _ self interpolate: bottomPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].

^ self interpolate: topPix and: bottomPix frac: yFrac !

Item was changed: ----- Method: ScratchPlugin>>primClose (in category 'serial port') ----- primClose "Close the given serial port."

| portNum | self export: true. + portNum := interpreterProxy stackIntegerValue: 0. - portNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ nil].

self cCode: 'SerialPortClose(portNum)'.

interpreterProxy pop: 1. "pop arg, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primGetOption (in category 'serial port') ----- primGetOption "Return the given option value for the given serial port."

| portNum attrNum result | self export: true. + portNum := interpreterProxy stackIntegerValue: 1. + attrNum := interpreterProxy stackIntegerValue: 0. - portNum _ interpreterProxy stackIntegerValue: 1. - attrNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ nil].

+ result := self cCode: 'SerialPortGetOption(portNum, attrNum)'. - result _ self cCode: 'SerialPortGetOption(portNum, attrNum)'. result = -1 ifTrue: [interpreterProxy success: false. ^ 0].

interpreterProxy pop: 3. "pop args and rcvr, push result" interpreterProxy pushInteger: result. ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primIsPortOpen (in category 'serial port') ----- primIsPortOpen "Answer the true if the given port is open."

| portNum result | self export: true. + portNum := interpreterProxy stackIntegerValue: 0. - portNum _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

+ result := self cCode: 'SerialPortIsOpen(portNum)'. - result _ self cCode: 'SerialPortIsOpen(portNum)'.

interpreterProxy pop: 2. "pop arg and rcvr" interpreterProxy pushBool: result ~= 0. "push result" ^ 0 !

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 | self export: true. self var: 'nameStr' declareC: 'char nameStr[1000]'. self var: 'src' declareC: 'char * src'.

+ nameOop := interpreterProxy stackValue: 1. + baudRate := interpreterProxy stackIntegerValue: 0. - nameOop _ interpreterProxy stackValue: 1. - baudRate _ interpreterProxy stackIntegerValue: 0.

((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 *'. + count := interpreterProxy stSizeOf: nameOop. - 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 cCode: 'SerialPortOpenPortNamed(nameStr, 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>>primPortCount (in category 'serial port') ----- primPortCount "Answer the number of serial ports."

| result | self export: true.

+ result := self cCode: 'SerialPortCount()'. - result _ self cCode: 'SerialPortCount()'. result = -1 ifTrue: [interpreterProxy success: false. ^ 0].

interpreterProxy pop: 1 thenPush: (interpreterProxy integerObjectOf: result). "pop rcvr, push result" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primPortName (in category 'serial port') ----- primPortName "Get the name for the port with the given number. Fail if the port number is greater than the number of available ports. Port numbering starts with 1."

| portIndex nameStr count resultOop dst | self export: true. self var: 'nameStr' declareC: 'char nameStr[1000]'. self var: 'dst' declareC: 'char* dst'.

+ portIndex := interpreterProxy stackIntegerValue: 0. - portIndex _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

self cCode: 'SerialPortName(portIndex, nameStr, 1000)'.

+ count := self cCode: 'strlen(nameStr)'. - count _ self cCode: 'strlen(nameStr)'. count = 0 ifTrue: [ interpreterProxy success: false. ^ 0].

+ resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. + dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. - resultOop _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. - dst _ self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. 0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].

interpreterProxy pop: 2 thenPush: resultOop. "pop arg and rcvr, push result" ^ 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 bufPtr bufSize bytesRead | self export: true. self var: 'bufPtr' declareC: 'char *bufPtr'.

+ portNum := interpreterProxy stackIntegerValue: 1. + bufOop := interpreterProxy stackValue: 0. - portNum _ interpreterProxy stackIntegerValue: 1. - bufOop _ interpreterProxy stackValue: 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. - bufPtr _ self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'. - bufSize _ interpreterProxy stSizeOf: bufOop. interpreterProxy failed ifTrue: [^ nil].

+ bytesRead := self cCode: 'SerialPortRead(portNum, bufPtr, bufSize)'. - bytesRead _ self cCode: 'SerialPortRead(portNum, bufPtr, bufSize)'.

interpreterProxy pop: 3. "pop args and rcvr" interpreterProxy pushInteger: bytesRead. "push result" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primSetOption (in category 'serial port') ----- primSetOption "Return the given option value for the given serial port."

| portNum attrNum attrValue result | self export: true. + portNum := interpreterProxy stackIntegerValue: 2. + attrNum := interpreterProxy stackIntegerValue: 1. + attrValue := interpreterProxy stackIntegerValue: 0. - portNum _ interpreterProxy stackIntegerValue: 2. - attrNum _ interpreterProxy stackIntegerValue: 1. - attrValue _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ nil].

+ result := self cCode: 'SerialPortSetOption(portNum, attrNum, attrValue)'. - result _ self cCode: 'SerialPortSetOption(portNum, attrNum, attrValue)'. result = -1 ifTrue: [interpreterProxy success: false. ^ 0].

interpreterProxy pop: 3. "pop args; leave rcvr on stack" ^ 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 bufPtr bufSize bytesWritten | self export: true. self var: 'bufPtr' declareC: 'char *bufPtr'.

+ portNum := interpreterProxy stackIntegerValue: 1. + bufOop := interpreterProxy stackValue: 0. - portNum _ interpreterProxy stackIntegerValue: 1. - bufOop _ interpreterProxy stackValue: 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. - bufPtr _ self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'. - bufSize _ interpreterProxy stSizeOf: bufOop. interpreterProxy failed ifTrue: [^ nil].

+ bytesWritten := self cCode: 'SerialPortWrite(portNum, bufPtr, bufSize)'. - bytesWritten _ self cCode: 'SerialPortWrite(portNum, bufPtr, bufSize)'.

interpreterProxy pop: 3. "pop args and rcvr" interpreterProxy pushInteger: bytesWritten. "push result" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveBlur (in category 'other filters') ----- primitiveBlur

| inOop outOop width in out sz height n rTotal gTotal bTotal pix outPix | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'.

+ inOop := interpreterProxy stackValue: 2. + outOop := interpreterProxy stackValue: 1. + width := interpreterProxy stackIntegerValue: 0. + in := self checkedUnsignedIntPtrOf: inOop. + out := self checkedUnsignedIntPtrOf: outOop. + sz := interpreterProxy stSizeOf: inOop. - inOop _ interpreterProxy stackValue: 2. - outOop _ interpreterProxy stackValue: 1. - width _ 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].

+ height := sz // width. - height _ sz // width. 1 to: height - 2 do: [:y | 1 to: width - 2 do: [:x | + n := rTotal := gTotal := bTotal := 0. - n _ rTotal _ gTotal _ bTotal _ 0. -1 to: 1 do: [:dY | -1 to: 1 do: [:dX | + pix := (in at: ((y + dY) * width) + (x + dX) "add 1 when testing in Squeak") bitAnd: 16rFFFFFF. - pix _ (in at: ((y + dY) * width) + (x + dX) "add 1 when testing in Squeak") bitAnd: 16rFFFFFF. pix = 0 ifFalse: [ "skip transparent pixels" + rTotal := rTotal + ((pix bitShift: -16) bitAnd: 16rFF). + gTotal := gTotal + ((pix bitShift: -8) bitAnd: 16rFF). + bTotal := bTotal + (pix bitAnd: 16rFF). + n := n + 1]]]. - rTotal _ rTotal + ((pix bitShift: -16) bitAnd: 16rFF). - gTotal _ gTotal + ((pix bitShift: -8) bitAnd: 16rFF). - bTotal _ bTotal + (pix bitAnd: 16rFF). - n _ n + 1]]]. n = 0 + ifTrue: [outPix := 0] + ifFalse: [outPix := ((rTotal // n) bitShift: 16) + ((gTotal // n) bitShift: 8) + (bTotal // n)]. - ifTrue: [outPix _ 0] - ifFalse: [outPix _ ((rTotal // n) bitShift: 16) + ((gTotal // n) bitShift: 8) + (bTotal // n)]. out at: ((y * width) + x "add 1 when testing in Squeak") put: outPix]].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveBrightnessShift (in category 'hsv filters') ----- primitiveBrightnessShift

| inOop outOop shift in sz out pix r g b max min hue saturation brightness | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'.

+ inOop := interpreterProxy stackValue: 2. + outOop := interpreterProxy stackValue: 1. + shift := interpreterProxy stackIntegerValue: 0. + in := self checkedUnsignedIntPtrOf: inOop. + sz := interpreterProxy stSizeOf: inOop. + out := self checkedUnsignedIntPtrOf: outOop. - inOop _ interpreterProxy stackValue: 2. - outOop _ interpreterProxy stackValue: 1. - shift _ interpreterProxy stackIntegerValue: 0. - in _ self checkedUnsignedIntPtrOf: inOop. - sz _ interpreterProxy stSizeOf: inOop. - out _ self checkedUnsignedIntPtrOf: outOop. interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz). interpreterProxy failed ifTrue: [^ nil].

0 to: sz - 1 do: [:i | + pix := (in at: i) bitAnd: 16rFFFFFF. - pix _ (in at: i) bitAnd: 16rFFFFFF. pix = 0 ifFalse: [ "skip pixel values of 0 (transparent)" + r := (pix bitShift: -16) bitAnd: 16rFF. + g := (pix bitShift: -8) bitAnd: 16rFF. + b := pix bitAnd: 16rFF. - r _ (pix bitShift: -16) bitAnd: 16rFF. - g _ (pix bitShift: -8) bitAnd: 16rFF. - b _ pix bitAnd: 16rFF.

"find min and max color components" + max := min := r. + g > max ifTrue: [max := g]. + b > max ifTrue: [max := b]. + g < min ifTrue: [min := g]. + b < min ifTrue: [min := b]. - max _ min _ r. - g > max ifTrue: [max _ g]. - b > max ifTrue: [max _ b]. - g < min ifTrue: [min _ g]. - b < min ifTrue: [min _ b].

"find current hue with range 0 to 360" + hue := self hueFromR: r G: g B: b min: min max: max. - hue _ self hueFromR: r G: g B: b min: min max: max.

"find current saturation and brightness with range 0 to 1000" + max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max]. + brightness := (max * 1000) // 255. - max = 0 ifTrue: [saturation _ 0] ifFalse: [saturation _ ((max - min) * 1000) // max]. - brightness _ (max * 1000) // 255.

"compute new brigthness" + brightness := brightness + (shift * 10). + brightness > 1000 ifTrue: [brightness := 1000]. + brightness < 0 ifTrue: [brightness := 0]. - brightness _ brightness + (shift * 10). - brightness > 1000 ifTrue: [brightness _ 1000]. - brightness < 0 ifTrue: [brightness _ 0].

self bitmap: out at: i putH: hue s: saturation v: brightness]].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveCondenseSound (in category 'sound') ----- primitiveCondenseSound

| srcOop dstOop factor sz src dst count max v | self export: true. self var: 'src' declareC: 'short *src'. self var: 'dst' declareC: 'short *dst'.

+ srcOop := interpreterProxy stackValue: 2. + dstOop := interpreterProxy stackValue: 1. + factor := interpreterProxy stackIntegerValue: 0. - srcOop _ interpreterProxy stackValue: 2. - dstOop _ interpreterProxy stackValue: 1. - factor _ interpreterProxy stackIntegerValue: 0. interpreterProxy success: (interpreterProxy isWords: srcOop). interpreterProxy success: (interpreterProxy isWords: dstOop).

+ count := (2 * (interpreterProxy stSizeOf: srcOop)) // factor. + sz := 2 * (interpreterProxy stSizeOf: dstOop). - count _ (2 * (interpreterProxy stSizeOf: srcOop)) // factor. - sz _ 2 * (interpreterProxy stSizeOf: dstOop). interpreterProxy success: (sz >= count). interpreterProxy failed ifTrue: [^ nil].

+ src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'. + dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'. - src _ self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'. - dst _ self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'.

1 to: count do: [:i | + max := 0. - max _ 0. 1 to: factor do: [:j | + v := self cCode: '*src++'. + v < 0 ifTrue: [v := 0 - v]. + v > max ifTrue: [max := v]]. - v _ self cCode: '*src++'. - v < 0 ifTrue: [v _ 0 - v]. - v > max ifTrue: [max _ v]]. self cCode: '*dst++ = max'].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveDoubleSize (in category 'scaling') ----- primitiveDoubleSize

| in out inOop outOop inW inH outW outH dstX dstY baseIndex pix i | self export: true. self var: 'in' declareC: 'int *in'. self var: 'out' declareC: 'int *out'.

+ inOop := interpreterProxy stackValue: 7. + inW := interpreterProxy stackIntegerValue: 6. + inH := interpreterProxy stackIntegerValue: 5. + outOop := interpreterProxy stackValue: 4. + outW := interpreterProxy stackIntegerValue: 3. + outH := interpreterProxy stackIntegerValue: 2. + dstX := interpreterProxy stackIntegerValue: 1. + dstY := interpreterProxy stackIntegerValue: 0. - inOop _ interpreterProxy stackValue: 7. - inW _ interpreterProxy stackIntegerValue: 6. - inH _ interpreterProxy stackIntegerValue: 5. - outOop _ interpreterProxy stackValue: 4. - outW _ interpreterProxy stackIntegerValue: 3. - outH _ interpreterProxy stackIntegerValue: 2. - dstX _ interpreterProxy stackIntegerValue: 1. - dstY _ interpreterProxy stackIntegerValue: 0.

+ in := self checkedUnsignedIntPtrOf: inOop. + out := self checkedUnsignedIntPtrOf: outOop. - in _ self checkedUnsignedIntPtrOf: inOop. - out _ self checkedUnsignedIntPtrOf: outOop. interpreterProxy success: (dstX + (2 * inW)) < outW. interpreterProxy success: (dstY + (2 * inH)) < outH. interpreterProxy failed ifTrue: [^ nil].

0 to: inH - 1 do: [:y | + baseIndex := ((dstY + (2 * y)) * outW) + dstX. - baseIndex _ ((dstY + (2 * y)) * outW) + dstX. 0 to: inW - 1 do: [:x | + pix := in at: x + (y * inW). + i := baseIndex + (2 * x). - pix _ in at: x + (y * inW). - i _ baseIndex + (2 * x). out at: i put: pix. out at: i + 1 put: pix. out at: i + outW put: pix. out at: i + outW + 1 put: pix]].

interpreterProxy pop: 8. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveExtractChannel (in category 'sound') ----- primitiveExtractChannel

| srcOop dstOop rightFlag sz src dst | self export: true. self var: 'src' declareC: 'short *src'. self var: 'dst' declareC: 'short *dst'.

+ srcOop := interpreterProxy stackValue: 2. + dstOop := interpreterProxy stackValue: 1. + rightFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). - srcOop _ interpreterProxy stackValue: 2. - dstOop _ interpreterProxy stackValue: 1. - rightFlag _ interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). interpreterProxy success: (interpreterProxy isWords: srcOop). interpreterProxy success: (interpreterProxy isWords: dstOop).

+ sz := interpreterProxy stSizeOf: srcOop. - sz _ interpreterProxy stSizeOf: srcOop. interpreterProxy success: ((interpreterProxy stSizeOf: dstOop) >= (sz // 2)). interpreterProxy failed ifTrue: [^ nil].

+ src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'. + dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'. - src _ self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'. - dst _ self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'.

rightFlag ifTrue: [self cCode: 'src++']. 1 to: sz do: [:i | self cCode: '*dst++ = *src; src += 2'].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 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 | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'. self var: 'scaleX' declareC: 'double scaleX'. self var: 'scaleY' declareC: 'double scaleY'. self var: 'whirlRadians' declareC: 'double whirlRadians'. self var: 'radiusSquared' declareC: 'double radiusSquared'. self var: 'dx' declareC: 'double dx'. self var: 'dy' declareC: 'double dy'. self var: 'd' declareC: 'double d'. self var: 'factor' declareC: 'double factor'. self var: 'ang' declareC: 'double ang'. self var: 'sina' declareC: 'double sina'. self var: 'cosa' declareC: 'double cosa'. self var: 'r' declareC: 'double r'. self 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. - 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.

+ height := sz // width. + centerX := width // 2. + centerY := height // 2. + scaledPower := power / 100.0. - 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. - 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] - 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 - 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>>primitiveGetFolderPath (in category 'os functions') ----- primitiveGetFolderPath "Get the path for the special folder with given ID. Fail if the folder ID is out of range."

| nameStr dst folderID count resultOop | self export: true. self var: 'nameStr' declareC: 'char nameStr[2000]'. self var: 'dst' declareC: 'char* dst'.

+ folderID := interpreterProxy stackIntegerValue: 0. - folderID _ interpreterProxy stackIntegerValue: 0. interpreterProxy failed ifTrue: [^ 0].

self cCode: 'GetFolderPathForID(folderID, nameStr, 2000)'.

+ count := self cCode: 'strlen(nameStr)'. + resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. + dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. - count _ self cCode: 'strlen(nameStr)'. - resultOop _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. - dst _ self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. 0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].

interpreterProxy pop: 2 thenPush: resultOop. "pop arg and rcvr, push result" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveHalfSizeAverage (in category 'scaling') ----- primitiveHalfSizeAverage

| in inW inH out outW outH srcX srcY dstX dstY dstW dstH srcIndex dstIndex pixel r g b | self export: true. self var: 'in' declareC: 'int *in'. self var: 'out' declareC: 'int *out'.

+ in := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11). + inW := interpreterProxy stackIntegerValue: 10. + inH := interpreterProxy stackIntegerValue: 9. + out := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8). + outW := interpreterProxy stackIntegerValue: 7. + outH := interpreterProxy stackIntegerValue: 6. + srcX := interpreterProxy stackIntegerValue: 5. + srcY := interpreterProxy stackIntegerValue: 4. + dstX := interpreterProxy stackIntegerValue: 3. + dstY := interpreterProxy stackIntegerValue: 2. + dstW := interpreterProxy stackIntegerValue: 1. + dstH := interpreterProxy stackIntegerValue: 0. - in _ self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11). - inW _ interpreterProxy stackIntegerValue: 10. - inH _ interpreterProxy stackIntegerValue: 9. - out _ self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8). - outW _ interpreterProxy stackIntegerValue: 7. - outH _ interpreterProxy stackIntegerValue: 6. - srcX _ interpreterProxy stackIntegerValue: 5. - srcY _ interpreterProxy stackIntegerValue: 4. - dstX _ interpreterProxy stackIntegerValue: 3. - dstY _ interpreterProxy stackIntegerValue: 2. - dstW _ interpreterProxy stackIntegerValue: 1. - dstH _ interpreterProxy stackIntegerValue: 0.

interpreterProxy success: (srcX >= 0) & (srcY >= 0). interpreterProxy success: (srcX + (2 * dstW)) <= inW. interpreterProxy success: (srcY + (2 * dstH)) <= inH. interpreterProxy success: (dstX >= 0) & (dstY >= 0). interpreterProxy success: (dstX + dstW) <= outW. interpreterProxy success: (dstY + dstH) <= outH. interpreterProxy failed ifTrue: [^ nil].

0 to: dstH - 1 do: [:y | + srcIndex := (inW * (srcY + (2 * y))) + srcX. + dstIndex := (outW * (dstY + y)) + dstX. - srcIndex _ (inW * (srcY + (2 * y))) + srcX. - dstIndex _ (outW * (dstY + y)) + dstX. 0 to: dstW - 1 do: [:x | + pixel := in at: srcIndex. + r := pixel bitAnd: 16rFF0000. + g := pixel bitAnd: 16rFF00. + b := pixel bitAnd: 16rFF. - pixel _ in at: srcIndex. - r _ pixel bitAnd: 16rFF0000. - g _ pixel bitAnd: 16rFF00. - b _ pixel bitAnd: 16rFF.

+ pixel := in at: srcIndex + 1. + r := r + (pixel bitAnd: 16rFF0000). + g := g + (pixel bitAnd: 16rFF00). + b := b + (pixel bitAnd: 16rFF). - pixel _ in at: srcIndex + 1. - r _ r + (pixel bitAnd: 16rFF0000). - g _ g + (pixel bitAnd: 16rFF00). - b _ b + (pixel bitAnd: 16rFF).

+ pixel := in at: srcIndex + inW. + r := r + (pixel bitAnd: 16rFF0000). + g := g + (pixel bitAnd: 16rFF00). + b := b + (pixel bitAnd: 16rFF). - pixel _ in at: srcIndex + inW. - r _ r + (pixel bitAnd: 16rFF0000). - g _ g + (pixel bitAnd: 16rFF00). - b _ b + (pixel bitAnd: 16rFF).

+ pixel := in at: srcIndex + inW + 1. + r := r + (pixel bitAnd: 16rFF0000). + g := g + (pixel bitAnd: 16rFF00). + b := b + (pixel bitAnd: 16rFF). - pixel _ in at: srcIndex + inW + 1. - r _ r + (pixel bitAnd: 16rFF0000). - g _ g + (pixel bitAnd: 16rFF00). - b _ b + (pixel bitAnd: 16rFF).

"store combined RGB into target bitmap" out at: dstIndex put: (((r bitShift: -2) bitAnd: 16rFF0000) bitOr: (((g bitShift: -2) bitAnd: 16rFF00) bitOr: (b bitShift: -2))).

+ srcIndex := srcIndex + 2. + dstIndex := dstIndex + 1]]. - srcIndex _ srcIndex + 2. - dstIndex _ dstIndex + 1]].

interpreterProxy pop: 12. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveHalfSizeDiagonal (in category 'scaling') ----- primitiveHalfSizeDiagonal

| in inW inH out outW outH srcX srcY dstX dstY dstW dstH srcIndex dstIndex p1 p2 r g b | self export: true. self var: 'in' declareC: 'int *in'. self var: 'out' declareC: 'int *out'.

+ in := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11). + inW := interpreterProxy stackIntegerValue: 10. + inH := interpreterProxy stackIntegerValue: 9. + out := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8). + outW := interpreterProxy stackIntegerValue: 7. + outH := interpreterProxy stackIntegerValue: 6. + srcX := interpreterProxy stackIntegerValue: 5. + srcY := interpreterProxy stackIntegerValue: 4. + dstX := interpreterProxy stackIntegerValue: 3. + dstY := interpreterProxy stackIntegerValue: 2. + dstW := interpreterProxy stackIntegerValue: 1. + dstH := interpreterProxy stackIntegerValue: 0. - in _ self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11). - inW _ interpreterProxy stackIntegerValue: 10. - inH _ interpreterProxy stackIntegerValue: 9. - out _ self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8). - outW _ interpreterProxy stackIntegerValue: 7. - outH _ interpreterProxy stackIntegerValue: 6. - srcX _ interpreterProxy stackIntegerValue: 5. - srcY _ interpreterProxy stackIntegerValue: 4. - dstX _ interpreterProxy stackIntegerValue: 3. - dstY _ interpreterProxy stackIntegerValue: 2. - dstW _ interpreterProxy stackIntegerValue: 1. - dstH _ interpreterProxy stackIntegerValue: 0.

interpreterProxy success: (srcX >= 0) & (srcY >= 0). interpreterProxy success: (srcX + (2 * dstW)) <= inW. interpreterProxy success: (srcY + (2 * dstH)) <= inH. interpreterProxy success: (dstX >= 0) & (dstY >= 0). interpreterProxy success: (dstX + dstW) <= outW. interpreterProxy success: (dstY + dstH) <= outH. interpreterProxy failed ifTrue: [^ nil].

0 to: dstH - 1 do: [:y | + srcIndex := (inW * (srcY + (2 * y))) + srcX. + dstIndex := (outW * (dstY + y)) + dstX. - srcIndex _ (inW * (srcY + (2 * y))) + srcX. - dstIndex _ (outW * (dstY + y)) + dstX. 0 to: dstW - 1 do: [:x | + p1 := in at: srcIndex. + p2 := in at: srcIndex + inW + 1. - p1 _ in at: srcIndex. - p2 _ in at: srcIndex + inW + 1.

+ r := (((p1 bitAnd: 16rFF0000) + (p2 bitAnd: 16rFF0000)) bitShift: -1) bitAnd: 16rFF0000. + g := (((p1 bitAnd: 16rFF00) + (p2 bitAnd: 16rFF00)) bitShift: -1) bitAnd: 16rFF00. + b := ((p1 bitAnd: 16rFF) + (p2 bitAnd: 16rFF)) bitShift: -1. - r _ (((p1 bitAnd: 16rFF0000) + (p2 bitAnd: 16rFF0000)) bitShift: -1) bitAnd: 16rFF0000. - g _ (((p1 bitAnd: 16rFF00) + (p2 bitAnd: 16rFF00)) bitShift: -1) bitAnd: 16rFF00. - b _ ((p1 bitAnd: 16rFF) + (p2 bitAnd: 16rFF)) bitShift: -1.

"store combined RGB into target bitmap" out at: dstIndex put: (r bitOr: (g bitOr: b)).

+ srcIndex := srcIndex + 2. + dstIndex := dstIndex + 1]]. - srcIndex _ srcIndex + 2. - dstIndex _ dstIndex + 1]].

interpreterProxy pop: 12. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveHueShift (in category 'hsv filters') ----- primitiveHueShift

| inOop outOop shift in sz out pix r g b max min brightness saturation hue | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'.

+ inOop := interpreterProxy stackValue: 2. + outOop := interpreterProxy stackValue: 1. + shift := interpreterProxy stackIntegerValue: 0. + in := self checkedUnsignedIntPtrOf: inOop. + sz := interpreterProxy stSizeOf: inOop. + out := self checkedUnsignedIntPtrOf: outOop. - inOop _ interpreterProxy stackValue: 2. - outOop _ interpreterProxy stackValue: 1. - shift _ interpreterProxy stackIntegerValue: 0. - in _ self checkedUnsignedIntPtrOf: inOop. - sz _ interpreterProxy stSizeOf: inOop. - out _ self checkedUnsignedIntPtrOf: outOop. interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz). interpreterProxy failed ifTrue: [^ nil].

0 to: sz - 1 do: [:i | + pix := (in at: i) bitAnd: 16rFFFFFF. - pix _ (in at: i) bitAnd: 16rFFFFFF. pix = 0 ifFalse: [ "skip pixel values of 0 (transparent)" + r := (pix bitShift: -16) bitAnd: 16rFF. + g := (pix bitShift: -8) bitAnd: 16rFF. + b := pix bitAnd: 16rFF. - r _ (pix bitShift: -16) bitAnd: 16rFF. - g _ (pix bitShift: -8) bitAnd: 16rFF. - b _ pix bitAnd: 16rFF.

"find min and max color components" + max := min := r. + g > max ifTrue: [max := g]. + b > max ifTrue: [max := b]. + g < min ifTrue: [min := g]. + b < min ifTrue: [min := b]. - max _ min _ r. - g > max ifTrue: [max _ g]. - b > max ifTrue: [max _ b]. - g < min ifTrue: [min _ g]. - b < min ifTrue: [min _ b].

"find current brightness (v) and saturation with range 0 to 1000" + brightness := (max * 1000) // 255. + max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max]. - brightness _ (max * 1000) // 255. - max = 0 ifTrue: [saturation _ 0] ifFalse: [saturation _ ((max - min) * 1000) // max].

brightness < 110 ifTrue: [ "force black to a very dark, saturated gray" + brightness := 110. saturation := 1000]. + saturation < 90 ifTrue: [saturation := 90]. "force a small color change on grays" - brightness _ 110. saturation _ 1000]. - saturation < 90 ifTrue: [saturation _ 90]. "force a small color change on grays" ((brightness = 110) | (saturation = 90)) "tint all blacks and grays the same" + ifTrue: [hue := 0] + ifFalse: [hue := self hueFromR: r G: g B: b min: min max: max]. - ifTrue: [hue _ 0] - ifFalse: [hue _ self hueFromR: r G: g B: b min: min max: max].

+ hue := (hue + shift + 360000000) \ 360. "compute new hue" - hue _ (hue + shift + 360000000) \ 360. "compute new hue" self bitmap: out at: i putH: hue s: saturation v: brightness]].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveInterpolate (in category 'bilinear interpolation') ----- primitiveInterpolate

| inOop xFixed yFixed width in sz result | self export: true. self var: 'in' declareC: 'unsigned int *in'.

+ inOop := interpreterProxy stackValue: 3. + width := interpreterProxy stackIntegerValue: 2. + xFixed := interpreterProxy stackIntegerValue: 1. + yFixed := interpreterProxy stackIntegerValue: 0. + in := self checkedUnsignedIntPtrOf: inOop. + sz := interpreterProxy stSizeOf: inOop. - inOop _ interpreterProxy stackValue: 3. - width _ interpreterProxy stackIntegerValue: 2. - xFixed _ interpreterProxy stackIntegerValue: 1. - yFixed _ interpreterProxy stackIntegerValue: 0. - in _ self checkedUnsignedIntPtrOf: inOop. - sz _ interpreterProxy stSizeOf: inOop. interpreterProxy failed ifTrue: [^ nil].

+ result := self interpolatedFrom: in x: xFixed y: yFixed width: width height: sz // width. - result _ self interpolatedFrom: in x: xFixed y: yFixed width: width height: sz // width.

interpreterProxy pop: 5. "pop args and rcvr" interpreterProxy pushInteger: result. ^ 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 | self export: true. self var: 'fullPath' declareC: 'char fullPath[1000]'. self var: 'src' declareC: 'char * src'.

+ pathOop := interpreterProxy stackValue: 0. - pathOop _ interpreterProxy stackValue: 0.

((interpreterProxy isIntegerObject: pathOop) or: [(interpreterProxy isBytes: pathOop) not]) ifTrue: [ interpreterProxy success: false].

interpreterProxy failed ifTrue: [^ 0].

+ src := self cCoerce: (interpreterProxy firstIndexableField: pathOop) to: 'char *'. + count := interpreterProxy stSizeOf: pathOop. - 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 cCode: 'IsFileOrFolderHidden(fullPath)'. - result _ self cCode: 'IsFileOrFolderHidden(fullPath)'.

interpreterProxy pop: 2. "pop arg and rcvr" interpreterProxy pushBool: result ~= 0. "push result" ^ 0

!

Item was changed: ----- Method: ScratchPlugin>>primitiveOpenURL (in category 'os functions') ----- primitiveOpenURL "Open a web browser on the given URL."

| urlStr src urlOop count | self export: true. self var: 'urlStr' declareC: 'char urlStr[2000]'. self var: 'src' declareC: 'char * src'.

+ urlOop := interpreterProxy stackValue: 0. - urlOop _ interpreterProxy stackValue: 0.

((interpreterProxy isIntegerObject: urlOop) or: [(interpreterProxy isBytes: urlOop) not]) ifTrue: [ interpreterProxy success: false].

interpreterProxy failed ifTrue: [^ 0].

+ src := self cCoerce: (interpreterProxy firstIndexableField: urlOop) to: 'char *'. + count := interpreterProxy stSizeOf: urlOop. - 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 cCode: 'OpenURL(urlStr)'.

interpreterProxy pop: 1. "pop arg, leave rcvr on stack" ^ 0

!

Item was changed: ----- Method: ScratchPlugin>>primitiveSaturationShift (in category 'hsv filters') ----- primitiveSaturationShift

| inOop outOop shift in sz out pix r g b max min brightness saturation hue | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'.

+ inOop := interpreterProxy stackValue: 2. + outOop := interpreterProxy stackValue: 1. + shift := interpreterProxy stackIntegerValue: 0. + in := self checkedUnsignedIntPtrOf: inOop. + sz := interpreterProxy stSizeOf: inOop. + out := self checkedUnsignedIntPtrOf: outOop. - inOop _ interpreterProxy stackValue: 2. - outOop _ interpreterProxy stackValue: 1. - shift _ interpreterProxy stackIntegerValue: 0. - in _ self checkedUnsignedIntPtrOf: inOop. - sz _ interpreterProxy stSizeOf: inOop. - out _ self checkedUnsignedIntPtrOf: outOop. interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz). interpreterProxy failed ifTrue: [^ nil].

0 to: sz - 1 do: [:i | + pix := (in at: i) bitAnd: 16rFFFFFF. - pix _ (in at: i) bitAnd: 16rFFFFFF. pix < 2 ifFalse: [ "skip pixel values of 0 (transparent) and 1 (black)" + r := (pix bitShift: -16) bitAnd: 16rFF. + g := (pix bitShift: -8) bitAnd: 16rFF. + b := pix bitAnd: 16rFF. - r _ (pix bitShift: -16) bitAnd: 16rFF. - g _ (pix bitShift: -8) bitAnd: 16rFF. - b _ pix bitAnd: 16rFF.

"find min and max color components" + max := min := r. + g > max ifTrue: [max := g]. + b > max ifTrue: [max := b]. + g < min ifTrue: [min := g]. + b < min ifTrue: [min := b]. - max _ min _ r. - g > max ifTrue: [max _ g]. - b > max ifTrue: [max _ b]. - g < min ifTrue: [min _ g]. - b < min ifTrue: [min _ b].

"find current brightness (v) and saturation with range 0 to 1000" + brightness := (max * 1000) // 255. + max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max]. - brightness _ (max * 1000) // 255. - max = 0 ifTrue: [saturation _ 0] ifFalse: [saturation _ ((max - min) * 1000) // max].

saturation > 0 ifTrue: [ "do nothing if pixel is unsaturated (gray)" + hue := self hueFromR: r G: g B: b min: min max: max. - hue _ self hueFromR: r G: g B: b min: min max: max.

"compute new saturation" + saturation := saturation + (shift * 10). + saturation > 1000 ifTrue: [saturation := 1000]. + saturation < 0 ifTrue: [saturation := 0]. - saturation _ saturation + (shift * 10). - saturation > 1000 ifTrue: [saturation _ 1000]. - saturation < 0 ifTrue: [saturation _ 0]. self bitmap: out at: i putH: hue s: saturation v: brightness]]].

interpreterProxy pop: 3. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: ScratchPlugin>>primitiveScale (in category 'scaling') ----- primitiveScale "Scale using bilinear interpolation."

| inOop inW inH outOop outW outH in out inX inY xIncr yIncr outPix w1 w2 w3 w4 t p1 p2 p3 p4 tWeight | self export: true. self var: 'in' declareC: 'int *in'. self 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. - 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. - 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" - 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. - 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). - 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]. - 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" + 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" - 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. - 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). + outPix = 0 ifTrue: [outPix := 1]]. - 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). - outPix = 0 ifTrue: [outPix _ 1]].

out at: (outY * outW) + outX put: outPix. + inX := inX + xIncr]. + inY := inY + yIncr]. - 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 | self export: true. self var: 'utf16' declareC: 'short int *utf16'.

+ strOop := interpreterProxy stackValue: 0. - strOop _ interpreterProxy stackValue: 0.

((interpreterProxy isIntegerObject: strOop) or: [(interpreterProxy isBytes: strOop) not]) ifTrue: [ interpreterProxy success: false].

interpreterProxy failed ifTrue: [^ 0].

+ utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'short int *'. + count := interpreterProxy stSizeOf: strOop. - utf16 _ self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'short int *'. - count _ interpreterProxy stSizeOf: strOop.

self cCode: 'SetUnicodePasteBuffer(utf16, count)'.

interpreterProxy pop: 1. "pop arg, leave rcvr on stack" ^ 0

!

Item was changed: ----- Method: ScratchPlugin>>primitiveSetWindowTitle (in category 'os functions') ----- primitiveSetWindowTitle "Set the title of the Scratch window."

| titleStr src titleOop count | self export: true. self var: 'titleStr' declareC: 'char titleStr[1000]'. self var: 'src' declareC: 'char * src'.

+ titleOop := interpreterProxy stackValue: 0. - titleOop _ interpreterProxy stackValue: 0.

((interpreterProxy isIntegerObject: titleOop) or: [(interpreterProxy isBytes: titleOop) not]) ifTrue: [ interpreterProxy success: false].

interpreterProxy failed ifTrue: [^ 0].

+ src := self cCoerce: (interpreterProxy firstIndexableField: titleOop) to: 'char *'. + count := interpreterProxy stSizeOf: titleOop. - 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 cCode: 'SetScratchWindowTitle(titleStr)'.

interpreterProxy pop: 1. "pop arg, leave rcvr on stack" ^ 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 | self export: true. self var: 'shortPath' declareC: 'char shortPath[1000]'. self var: 'longPath' declareC: 'char longPath[1000]'. self var: 'ptr' declareC: 'char * ptr'.

+ shortPathOop := interpreterProxy stackValue: 0. - shortPathOop _ interpreterProxy stackValue: 0.

((interpreterProxy isIntegerObject: shortPathOop) or: [(interpreterProxy isBytes: shortPathOop) not]) ifTrue: [ interpreterProxy success: false. ^ 0].

+ ptr := self cCoerce: (interpreterProxy firstIndexableField: shortPathOop) to: 'char *'. + count := interpreterProxy stSizeOf: shortPathOop. - 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 _ self cCode: 'WinShortToLongPath(shortPath, longPath, 1000)'. result = -1 ifTrue: [interpreterProxy success: false. ^ 0].

+ count := self cCode: 'strlen(longPath)'. + resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. + ptr := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'. - count _ self cCode: 'strlen(longPath)'. - resultOop _ interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count. - 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 !

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 | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'. self var: 'aArray' declareC: 'double *aArray'. self var: 'bArray' declareC: 'double *bArray'. self var: 'ripply' declareC: 'int ripply'. self var: 'temp' declareC: 'double temp'. self var: 'pix' declareC: 'unsigned int pix'. self var: 'dist' declareC: 'double dist'. self var: 'dx2' declareC: 'double dx2'. self 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. - 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. - height _ allPix // width.

+ t1 := self cCode: 'rand()'. + blops := t1 \ ripply -1. - 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. - 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 _ ((g*g) + (h*h)) asFloat. ((dist < 25) and: [dist > 0]) ifTrue: [ + dx := (x + g) asInteger. + dy := (y + h) asInteger. - 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. - 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." - "temp _ bArray. - bArray _ aArray. - aArray _ temp." 0 to: width*height do: [:q | + temp := bArray at: 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]. + newLoc := ((j+dy2)*width + (i+dx2)) asInteger. - 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]. - newLoc _ ((j+dy2)*width + (i+dx2)) asInteger. ((newLoc < (width*height)) and: [newLoc >=0]) ifTrue: [ + pix := in at: newLoc] - pix _ in at: newLoc] ifFalse: [ + pix := in at: (i +(j*width)) ]. - pix _ in at: (i +(j*width)) ]. ] ifFalse: [ + pix := in at: (i +(j*width)) ]. - 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: ScratchPlugin>>primitiveWhirl (in category 'other filters') ----- primitiveWhirl

| inOop outOop width degrees in out sz height centerX centerY radius scaleX scaleY whirlRadians radiusSquared dx dy d factor ang sina cosa pix | self export: true. self var: 'in' declareC: 'unsigned int *in'. self var: 'out' declareC: 'unsigned int *out'. self var: 'scaleX' declareC: 'double scaleX'. self var: 'scaleY' declareC: 'double scaleY'. self var: 'whirlRadians' declareC: 'double whirlRadians'. self var: 'radiusSquared' declareC: 'double radiusSquared'. self var: 'dx' declareC: 'double dx'. self var: 'dy' declareC: 'double dy'. self var: 'd' declareC: 'double d'. self var: 'factor' declareC: 'double factor'. self var: 'ang' declareC: 'double ang'. self var: 'sina' declareC: 'double sina'. self var: 'cosa' declareC: 'double cosa'.

+ inOop := interpreterProxy stackValue: 3. + outOop := interpreterProxy stackValue: 2. + width := interpreterProxy stackIntegerValue: 1. + degrees := interpreterProxy stackIntegerValue: 0. + in := self checkedUnsignedIntPtrOf: inOop. + out := self checkedUnsignedIntPtrOf: outOop. + sz := interpreterProxy stSizeOf: inOop. - inOop _ interpreterProxy stackValue: 3. - outOop _ interpreterProxy stackValue: 2. - width _ interpreterProxy stackIntegerValue: 1. - degrees _ 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. centerX < centerY ifTrue: [ + radius := centerX. + scaleX := centerY asFloat / centerX. + scaleY := 1.0] - radius _ centerX. - scaleX _ centerY asFloat / centerX. - scaleY _ 1.0] ifFalse: [ + radius := centerY. + scaleX := 1.0. - radius _ centerY. - scaleX _ 1.0. centerY < centerX + ifTrue: [scaleY := centerX asFloat / centerY] + ifFalse: [scaleY := 1.0]]. + whirlRadians := (-3.141592653589793 * degrees) / 180.0. + radiusSquared := (radius * radius) asFloat. - ifTrue: [scaleY _ centerX asFloat / centerY] - ifFalse: [scaleY _ 1.0]]. - whirlRadians _ (-3.141592653589793 * degrees) / 180.0. - radiusSquared _ (radius * radius) asFloat.

0 to: width - 1 do: [:x | 0 to: height - 1 do: [:y | + dx := scaleX * (x - centerX) asFloat. + dy := scaleY * (y - centerY) asFloat. + d := (dx * dx) + (dy * dy). - dx _ scaleX * (x - centerX) asFloat. - dy _ scaleY * (y - centerY) asFloat. - d _ (dx * dx) + (dy * dy). d < radiusSquared ifTrue: [ "inside the whirl circle" + factor := 1.0 - (d sqrt / radius). + ang := whirlRadians * (factor * factor). + sina := ang sin. + cosa := ang cos. + pix := self interpolatedFrom: in - factor _ 1.0 - (d sqrt / radius). - ang _ whirlRadians * (factor * factor). - sina _ ang sin. - cosa _ ang cos. - pix _ self interpolatedFrom: in x: (1024.0 * ((((cosa * dx) - (sina * dy)) / scaleX) + centerX)) asInteger y: (1024.0 * ((((sina * dx) + (cosa * dy)) / scaleY) + centerY)) asInteger width: width height: height. out at: ((width * y) + x "for Squeak: + 1") put: pix]]].

interpreterProxy pop: 4. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>copyString:into:max: (in category 'utility') ----- copyString: stringOop into: stringPtr max: maxChars "Copy the Squeak string into a temporary buffer and add a terminating null byte. Fail if there is not sufficent space in the buffer."

| srcPtr count | self inline: false. self var: 'stringPtr' declareC: 'char *stringPtr'. self var: 'srcPtr' declareC: 'char *srcPtr'.

((interpreterProxy isIntegerObject: stringOop) or: [(interpreterProxy isBytes: stringOop) not]) ifTrue: [ interpreterProxy success: false. ^ 0].

+ count := interpreterProxy stSizeOf: stringOop. - count _ interpreterProxy stSizeOf: stringOop. count < maxChars ifFalse: [ interpreterProxy success: false. ^ 0].

+ srcPtr := self cCoerce: (interpreterProxy firstIndexableField: stringOop) to: 'char *'. - srcPtr _ self cCoerce: (interpreterProxy firstIndexableField: stringOop) to: 'char *'. 1 to: count do: [:i | self cCode: '*stringPtr++ = *srcPtr++']. self cCode: '*stringPtr = 0'. ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveClipboardGet (in category 'primitives') ----- primitiveClipboardGet "Read the clipboard into the given UTF16 string.."

| utf16Oop utf16 utf16Length count | self export: true. self var: 'utf16' declareC: 'unsigned short *utf16'.

+ utf16Oop := interpreterProxy stackValue: 0. - utf16Oop _ interpreterProxy stackValue: 0.

((interpreterProxy isIntegerObject: utf16Oop) or: [(interpreterProxy isWords: utf16Oop) not]) ifTrue: [ interpreterProxy success: false].

interpreterProxy failed ifTrue: [^ 0].

+ utf16 := self cCoerce: (interpreterProxy firstIndexableField: utf16Oop) to: 'unsigned short *'. + utf16Length := 2 * (interpreterProxy stSizeOf: utf16Oop). - utf16 _ self cCoerce: (interpreterProxy firstIndexableField: utf16Oop) to: 'unsigned short *'. - utf16Length _ 2 * (interpreterProxy stSizeOf: utf16Oop).

+ count := self cCode: 'unicodeClipboardGet(utf16, utf16Length)'. - count _ self cCode: 'unicodeClipboardGet(utf16, utf16Length)'.

interpreterProxy pop: 2 thenPush: (interpreterProxy integerObjectOf: count).

^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveClipboardPut (in category 'primitives') ----- primitiveClipboardPut "Set the clipboard to a UTF16 string.."

| strOop count utf16 utf16Length | self export: true. self var: 'utf16' declareC: 'unsigned short *utf16'.

+ strOop := interpreterProxy stackValue: 1. + count := interpreterProxy stackIntegerValue: 0. - strOop _ interpreterProxy stackValue: 1. - count _ interpreterProxy stackIntegerValue: 0.

((interpreterProxy isIntegerObject: strOop) or: [(interpreterProxy isWords: strOop) not]) ifTrue: [ interpreterProxy success: false].

interpreterProxy failed ifTrue: [^ 0].

+ utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'unsigned short *'. + utf16Length := 2 * (interpreterProxy stSizeOf: strOop). + ((count >= 0) & (count < utf16Length)) ifTrue: [utf16Length := count]. - utf16 _ self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'unsigned short *'. - utf16Length _ 2 * (interpreterProxy stSizeOf: strOop). - ((count >= 0) & (count < utf16Length)) ifTrue: [utf16Length _ count].

self cCode: 'unicodeClipboardPut(utf16, utf16Length)'.

interpreterProxy pop: 2. "pop args, leave rcvr on stack" ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveClipboardSize (in category 'primitives') ----- primitiveClipboardSize

| count | self export: true.

+ count := self cCode: 'unicodeClipboardSize()'. - count _ self cCode: 'unicodeClipboardSize()'.

interpreterProxy pop: 1 thenPush: (interpreterProxy integerObjectOf: count). ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveDrawString (in category 'primitives') ----- primitiveDrawString

| utf8Oop utf8 w h bitmapOop bitmapPtr utf8Length result | self export: true. self var: 'utf8' declareC: 'char *utf8'. self var: 'bitmapPtr' declareC: 'void *bitmapPtr'.

+ utf8Oop := interpreterProxy stackValue: 3. + utf8 := self asCString: utf8Oop. + w := interpreterProxy stackIntegerValue: 2. + h := interpreterProxy stackIntegerValue: 1. + bitmapOop := interpreterProxy stackValue: 0. + bitmapPtr := self cWordsPtr: bitmapOop minSize: w * h. - utf8Oop _ interpreterProxy stackValue: 3. - utf8 _ self asCString: utf8Oop. - w _ interpreterProxy stackIntegerValue: 2. - h _ interpreterProxy stackIntegerValue: 1. - bitmapOop _ interpreterProxy stackValue: 0. - bitmapPtr _ self cWordsPtr: bitmapOop minSize: w * h. interpreterProxy failed ifTrue: [^ nil].

+ utf8Length := interpreterProxy stSizeOf: utf8Oop. - utf8Length _ interpreterProxy stSizeOf: utf8Oop. self cCode: 'unicodeDrawString(utf8, utf8Length, &w, &h, bitmapPtr)'.

+ result := interpreterProxy makePointwithxValue: w yValue: h. - result _ interpreterProxy makePointwithxValue: w yValue: h. interpreterProxy pop: 5 thenPush: result. ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveGetFontList (in category 'primitives') ----- primitiveGetFontList

| strOop str strLength count | self export: true. self var: 'str' declareC: 'char *str'.

+ strOop := interpreterProxy stackValue: 0. + str := self asCString: strOop. - strOop _ interpreterProxy stackValue: 0. - str _ self asCString: strOop. interpreterProxy failed ifTrue: [^ nil].

+ strLength := interpreterProxy stSizeOf: strOop. + count := self cCode: 'unicodeGetFontList(str, strLength)'. - strLength _ interpreterProxy stSizeOf: strOop. - count _ self cCode: 'unicodeGetFontList(str, strLength)'.

interpreterProxy pop: 2 thenPush: (interpreterProxy integerObjectOf: count). ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveGetXRanges (in category 'primitives') ----- primitiveGetXRanges

| utf8Oop utf8 resultOop resultPtr utf8Length count resultLength | self export: true. self var: 'utf8' declareC: 'char *utf8'. self var: 'resultPtr' declareC: 'int *resultPtr'.

+ utf8Oop := interpreterProxy stackValue: 1. + utf8 := self asCString: utf8Oop. - utf8Oop _ interpreterProxy stackValue: 1. - utf8 _ self asCString: utf8Oop.

+ resultOop := interpreterProxy stackValue: 0. + resultPtr := self cWordsPtr: resultOop minSize: 0. - resultOop _ interpreterProxy stackValue: 0. - resultPtr _ self cWordsPtr: resultOop minSize: 0. interpreterProxy failed ifTrue: [^ nil].

+ utf8Length := interpreterProxy stSizeOf: utf8Oop. + resultLength := interpreterProxy stSizeOf: resultOop. + count := self cCode: 'unicodeGetXRanges(utf8, utf8Length, resultPtr, resultLength)'. - utf8Length _ interpreterProxy stSizeOf: utf8Oop. - resultLength _ interpreterProxy stSizeOf: resultOop. - count _ self cCode: 'unicodeGetXRanges(utf8, utf8Length, resultPtr, resultLength)'.

interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: count). ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveMeasureString (in category 'primitives') ----- primitiveMeasureString

| utf8Oop utf8 utf8Length w h result | self export: true. self var: 'utf8' declareC: 'char *utf8'.

+ utf8Oop := interpreterProxy stackValue: 0. + utf8 := self asCString: utf8Oop. - utf8Oop _ interpreterProxy stackValue: 0. - utf8 _ self asCString: utf8Oop. interpreterProxy failed ifTrue: [^ nil].

+ w := h := 0. + utf8Length := interpreterProxy stSizeOf: utf8Oop. - w _ h _ 0. - utf8Length _ interpreterProxy stSizeOf: utf8Oop. self cCode: 'unicodeMeasureString(utf8, utf8Length, &w, &h)'.

+ result := interpreterProxy makePointwithxValue: w yValue: h. - result _ interpreterProxy makePointwithxValue: w yValue: h. interpreterProxy pop: 2 thenPush: result. ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveSetColors (in category 'primitives') ----- primitiveSetColors

| fgRed fgGreen fgBlue bgRed bgGreen bgBlue mapBGToTransparent | self export: true.

+ fgRed := interpreterProxy stackIntegerValue: 6. + fgGreen := interpreterProxy stackIntegerValue: 5. + fgBlue := interpreterProxy stackIntegerValue: 4. + bgRed := interpreterProxy stackIntegerValue: 3. + bgGreen := interpreterProxy stackIntegerValue: 2. + bgBlue := interpreterProxy stackIntegerValue: 1. + mapBGToTransparent := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). - fgRed _ interpreterProxy stackIntegerValue: 6. - fgGreen _ interpreterProxy stackIntegerValue: 5. - fgBlue _ interpreterProxy stackIntegerValue: 4. - bgRed _ interpreterProxy stackIntegerValue: 3. - bgGreen _ interpreterProxy stackIntegerValue: 2. - bgBlue _ interpreterProxy stackIntegerValue: 1. - mapBGToTransparent _ interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifTrue: [^ nil].

self cCode: 'unicodeSetColors(fgRed, fgGreen, fgBlue, bgRed, bgGreen, bgBlue, mapBGToTransparent)'.

interpreterProxy pop: 7. ^ 0 !

Item was changed: ----- Method: UnicodePlugin>>primitiveSetFont (in category 'primitives') ----- primitiveSetFont

| fontName fontSize boldFlag italicFlag antiAliasFlag | self export: true. self var: 'fontName' declareC: 'char fontName[200]'.

self copyString: (interpreterProxy stackValue: 4) into: fontName max: 200. + fontSize := interpreterProxy stackIntegerValue: 3. + boldFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 2). + italicFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 1). + antiAliasFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). - fontSize _ interpreterProxy stackIntegerValue: 3. - boldFlag _ interpreterProxy booleanValueOf: (interpreterProxy stackValue: 2). - italicFlag _ interpreterProxy booleanValueOf: (interpreterProxy stackValue: 1). - antiAliasFlag _ interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0). interpreterProxy failed ifTrue: [^ nil].

self cCode: 'unicodeSetFont(fontName, fontSize, boldFlag, italicFlag, antiAliasFlag)'.

interpreterProxy pop: 5. ^ 0 !

Item was changed: ----- Method: WeDoPlugin>>primRead (in category 'translated prims') ----- primRead "Read data from the WeDo port into the given buffer (a ByteArray or String). Answer the number of bytes read."

| bufOop bufPtr bufSize byteCount | self export: true. self var: 'bufPtr' declareC: 'char *bufPtr'.

+ bufOop := interpreterProxy stackValue: 0. - bufOop _ interpreterProxy stackValue: 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. - bufPtr _ self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'. - bufSize _ interpreterProxy stSizeOf: bufOop. interpreterProxy failed ifTrue: [^ 0].

+ byteCount := self cCode: 'WeDoRead(bufPtr, bufSize)'. - byteCount _ self cCode: 'WeDoRead(bufPtr, bufSize)'. byteCount < 0 ifTrue: [ interpreterProxy success: false. ^ 0].

interpreterProxy pop: 2. "pop args and rcvr" interpreterProxy pushInteger: byteCount. "push result" ^ 0 !

Item was changed: ----- Method: WeDoPlugin>>primWrite (in category 'translated prims') ----- primWrite "Write data to the WeDo port from the given buffer (a ByteArray or String). Answer the number of bytes written."

| bufOop bufPtr bufSize byteCount | self export: true. self var: 'bufPtr' declareC: 'char *bufPtr'.

+ bufOop := interpreterProxy stackValue: 0. - bufOop _ interpreterProxy stackValue: 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. - bufPtr _ self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'. - bufSize _ interpreterProxy stSizeOf: bufOop. interpreterProxy failed ifTrue: [^ 0].

+ byteCount := self cCode: 'WeDoWrite(bufPtr, bufSize)'. - byteCount _ self cCode: 'WeDoWrite(bufPtr, bufSize)'. byteCount < 0 ifTrue: [ interpreterProxy success: false. ^ 0].

interpreterProxy pop: 2. "pop args and rcvr" interpreterProxy pushInteger: byteCount. "push result" ^ 0 !