VM Maker: VMMaker-bf.281.mcz

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

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

Name: VMMaker-bf.281
Author: bf
Time: 30 July 2012, 4:33:03.219 pm
UUID: ad601126-ccb3-4876-9f72-d9789d5647b3
Ancestors: VMMaker-bf.280

Add plugins from Scratch: Camera, Scratch, Unicode, WeDo

=============== Diff against VMMaker-bf.280 ===============

Item was added:
+ InterpreterPlugin subclass: #CameraPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!

Item was added:
+ ----- Method: CameraPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ "self translate"
+
+ super declareCVarsIn: aCCodeGenerator.
+ aCCodeGenerator addHeaderFile: '<string.h>'.!

Item was added:
+ ----- Method: CameraPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+
+ ^true!

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ 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 *'.
+ 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 added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ self cCode: 'CameraClose(cameraNum)'.
+
+ interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ e _ self cCode: 'CameraExtent(cameraNum)'.
+
+ interpreterProxy pop: 2 thenPush: (interpreterProxy integerObjectOf: e).  "pop rcvr & arg, push int result"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ ((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.
+
+ 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 added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ result _ self cCode: 'CameraGetParam(cameraNum, paramNum)'.
+
+ interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result).  "pop rcvr & args, push int result"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ 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 added:
+ InterpreterPlugin subclass: #ScratchPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
+
+ !ScratchPlugin commentStamp: 'jm 11/8/2006 18:33' prior: 0!
+ This plugin combines a number of primitives needed by Scratch including:
+
+   a. primitives that manipulate 24-bit color images (i.e. 32-bit deep Forms but alpha is ignored)
+   b. primitive to open browsers, find the user's documents folder, set the window title and other host OS functions
+
+ This plugin includes new serial port primitives, including support for named serial ports. The underlying plugin code can support up to 32 simultaenously open ports.
+
+ Port options for Set/GetOption primitives:
+   1. baud rate
+   2. data bits
+   3. stop bits
+   4. parity type
+   5. input flow control type
+   6. output flow control type
+
+ Handshake lines (options 20-25 for Set/GetOption primitives):
+   20. DTR (output line)
+   21. RTS (output line)
+   22. CTS (input line)
+   23. DSR (input line)
+   24. CD (input line)
+   25. RI (input line)
+
+ !

Item was added:
+ ----- 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 added:
+ ----- Method: ScratchPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+
+ ^true!

Item was added:
+ ----- 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.
+
+ 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)].
+
+ outPix = 0 ifTrue: [outPix _ 1].  "convert transparent to 1"
+ bitmap at: i put: outPix.
+ ^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>checkedFloatPtrOf: (in category 'private') -----
+ checkedFloatPtrOf: oop
+ "Return an unsigned int pointer to the first indexable word of oop, which must be a words object."
+
+ self inline: true.
+ self returnTypeC: 'double *'.
+
+ interpreterProxy success: (interpreterProxy isWordsOrBytes: oop).
+ interpreterProxy failed ifTrue: [^ 0].
+ ^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'double *'
+ !

Item was added:
+ ----- Method: ScratchPlugin>>checkedUnsignedIntPtrOf: (in category 'private') -----
+ checkedUnsignedIntPtrOf: oop
+ "Return an unsigned int pointer to the first indexable word of oop, which must be a words object."
+
+ self inline: true.
+ self returnTypeC: 'unsigned int *'.
+
+ interpreterProxy success: (interpreterProxy isWords: oop).
+ interpreterProxy failed ifTrue: [^ 0].
+ ^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'unsigned int *'
+ !

Item was added:
+ ----- 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 = 0 ifTrue: [^ 0].
+
+ r = max
+ ifTrue: [result _ ((60 * (g - b)) // span)]
+ ifFalse: [
+ g = max
+ ifTrue: [result _ 120 + ((60 * (b - r)) // span)]
+ ifFalse: [result _ 240 + ((60 * (r - g)) // span)]].
+
+ result < 0 ifTrue: [^ result + 360].
+ ^ result
+ !

Item was added:
+ ----- 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].
+ ^ result
+ !

Item was added:
+ ----- 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 < -1 or: [x >= w]) ifTrue: [^ 0].
+ 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"
+
+ 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.
+ xFrac > 0 ifTrue: [
+ 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.
+ xFrac > 0 ifTrue: [
+ bottomPix _ self interpolate: bottomPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].
+
+ ^ self interpolate: topPix and: bottomPix frac: yFrac
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primClose (in category 'serial port') -----
+ primClose
+ "Close the given serial port."
+
+ | portNum |
+ self export: true.
+ portNum _ interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ self cCode: 'SerialPortClose(portNum)'.
+
+ interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ 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 added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ result _ self cCode: 'SerialPortIsOpen(portNum)'.
+
+ interpreterProxy pop: 2.  "pop arg and rcvr"
+ interpreterProxy pushBool: result ~= 0.  "push result"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+
+ ((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.
+ 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 = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+
+ interpreterProxy "pop args and rcvr, push result"
+ pop: 3
+ thenPush: (interpreterProxy integerObjectOf: portNum).
+
+ ^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primPortCount (in category 'serial port') -----
+ primPortCount
+ "Answer the number of serial ports."
+
+ | result |
+ self export: true.
+
+ 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 added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ 0].
+
+ self cCode: 'SerialPortName(portIndex, nameStr, 1000)'.
+
+ 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 *'.
+ 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 added:
+ ----- 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.
+
+ ((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 cCode: 'SerialPortRead(portNum, bufPtr, bufSize)'.
+
+ interpreterProxy pop: 3.   "pop args and rcvr"
+ interpreterProxy pushInteger: bytesRead. "push result"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ 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 added:
+ ----- 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.
+
+ ((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 cCode: 'SerialPortWrite(portNum, bufPtr, bufSize)'.
+
+ interpreterProxy pop: 3.   "pop args and rcvr"
+ interpreterProxy pushInteger: bytesWritten. "push result"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ interpreterProxy failed ifTrue: [^ nil].
+
+ height _ sz // width.
+ 1 to: height - 2 do: [:y |
+ 1 to: width - 2 do: [:x |
+ 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 = 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]]].
+ n = 0
+ 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 added:
+ ----- 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.
+ interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ interpreterProxy failed ifTrue: [^ nil].
+
+ 0 to: sz - 1 do: [:i |
+ 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.
+
+ "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].
+
+ "find current hue with range 0 to 360"
+ 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.
+
+ "compute new brigthness"
+ 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 added:
+ ----- 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.
+ interpreterProxy success: (interpreterProxy isWords: srcOop).
+ interpreterProxy success: (interpreterProxy isWords: 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 *'.
+
+ 1 to: count do: [:i |
+ max _ 0.
+ 1 to: factor do: [:j |
+ 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 added:
+ ----- 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.
+
+ 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.
+ 0 to: inW - 1 do: [: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 added:
+ ----- 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).
+ interpreterProxy success: (interpreterProxy isWords: srcOop).
+ interpreterProxy success: (interpreterProxy isWords: dstOop).
+
+ 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 *'.
+
+ 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 added:
+ ----- 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.
+ 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 added:
+ ----- 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.
+ 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 *'.
+ 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 added:
+ ----- 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.
+
+ 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.
+ 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 + 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 + 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]].
+
+ interpreterProxy pop: 12.  "pop args, leave rcvr on stack"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+
+ 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.
+ 0 to: dstW - 1 do: [:x |
+ 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.
+
+ "store combined RGB into target bitmap"
+ out at: dstIndex put: (r bitOr: (g bitOr: b)).
+
+ srcIndex _ srcIndex + 2.
+ dstIndex _ dstIndex + 1]].
+
+ interpreterProxy pop: 12.  "pop args, leave rcvr on stack"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ interpreterProxy failed ifTrue: [^ nil].
+
+ 0 to: sz - 1 do: [:i |
+ 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.
+
+ "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].
+
+ "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 < 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 = 90)) "tint all blacks and grays the same"
+ ifTrue: [hue _ 0]
+ ifFalse: [hue _ self hueFromR: r G: g B: b min: min max: max].
+
+ 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 added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ 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 added:
+ ----- 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.
+
+ ((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.
+ 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)'.
+
+ interpreterProxy pop: 2.  "pop arg and rcvr"
+ interpreterProxy pushBool: result ~= 0.  "push result"
+ ^ 0
+
+ !

Item was added:
+ ----- 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.
+
+ ((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.
+ 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 added:
+ ----- 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.
+ interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ interpreterProxy failed ifTrue: [^ nil].
+
+ 0 to: sz - 1 do: [:i |
+ 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.
+
+ "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].
+
+ "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].
+
+ saturation > 0 ifTrue: [  "do nothing if pixel is unsaturated (gray)"
+ 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].
+ self bitmap: out at: i putH: hue s: saturation v: brightness]]].
+
+ interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ ^ 0
+ !

Item was added:
+ ----- 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.
+
+ 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"
+ 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).
+ 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 added:
+ ----- 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.
+
+ ((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.
+
+ self cCode: 'SetUnicodePasteBuffer(utf16, count)'.
+
+ interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ ^ 0
+
+ !

Item was added:
+ ----- 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.
+
+ ((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.
+ 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 added:
+ ----- 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.
+
+ ((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.
+ 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 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 added:
+ ----- 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.
+ 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].
+ 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 added:
+ ----- 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.
+ 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.
+ centerX < centerY
+ ifTrue: [
+ radius _ centerX.
+ scaleX _ centerY asFloat / centerX.
+ scaleY _ 1.0]
+ ifFalse: [
+ 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.
+
+ 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).
+ 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
+ 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 added:
+ InterpreterPlugin subclass: #UnicodePlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
+
+ !UnicodePlugin commentStamp: '<historical>' prior: 0!
+ This plugin measures and renders Unicode (UTF8) strings.
+ !

Item was added:
+ ----- Method: UnicodePlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+
+ ^true!

Item was added:
+ ----- Method: UnicodePlugin>>asCString: (in category 'utility') -----
+ asCString: stringOop
+ "Return a C char * pointer into the given Squeak string object."
+ "Warning: A Squeak string is not necessarily null-terminated."
+ "Warning: the resulting pointer may become invalid after the next garbage collection and should only be using during the current primitive call."
+
+ self inline: false.
+ self returnTypeC: 'char *'.
+
+ ((interpreterProxy isIntegerObject: stringOop) or:
+ [(interpreterProxy isBytes: stringOop) not]) ifTrue: [
+ interpreterProxy success: false.
+ ^ 0].
+
+ ^ self cCoerce: (interpreterProxy firstIndexableField: stringOop) to: 'char *'
+ !

Item was added:
+ ----- Method: UnicodePlugin>>cWordsPtr:minSize: (in category 'utility') -----
+ cWordsPtr: oop minSize: minSize
+ "Return a C pointer to the first indexable field of oop, which must be a words object of at least the given size."
+ "Warning: the resulting pointer may become invalid after the next garbage collection and should only be using during the current primitive call."
+
+ self inline: false.
+ self returnTypeC: 'void *'.
+
+ interpreterProxy success:
+ ((interpreterProxy isIntegerObject: oop) not and:
+ [(interpreterProxy isWords: oop) and:
+ [(interpreterProxy stSizeOf: oop) >= minSize]]).
+ interpreterProxy failed ifTrue: [^ 0].
+ ^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'void *'
+ !

Item was added:
+ ----- 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 < maxChars ifFalse: [
+ interpreterProxy success: false.
+ ^ 0].
+
+ srcPtr _ self cCoerce: (interpreterProxy firstIndexableField: stringOop) to: 'char *'.
+ 1 to: count do: [:i | self cCode: '*stringPtr++ = *srcPtr++'].
+ self cCode: '*stringPtr = 0'.
+ ^ 0
+ !

Item was added:
+ ----- 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.
+
+ ((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).
+
+ count _ self cCode: 'unicodeClipboardGet(utf16, utf16Length)'.
+
+ interpreterProxy pop: 2
+ thenPush: (interpreterProxy integerObjectOf: count).
+
+ ^ 0
+ !

Item was added:
+ ----- 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.
+
+ ((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].
+
+ self cCode: 'unicodeClipboardPut(utf16, utf16Length)'.
+
+ interpreterProxy pop: 2.  "pop args, leave rcvr on stack"
+ ^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveClipboardSize (in category 'primitives') -----
+ primitiveClipboardSize
+
+ | count |
+ self export: true.
+
+ count _ self cCode: 'unicodeClipboardSize()'.
+
+ interpreterProxy pop: 1
+ thenPush: (interpreterProxy integerObjectOf: count).
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ utf8Length _ interpreterProxy stSizeOf: utf8Oop.
+ self cCode: 'unicodeDrawString(utf8, utf8Length, &w, &h, bitmapPtr)'.
+
+ result _ interpreterProxy makePointwithxValue: w yValue: h.
+ interpreterProxy pop: 5 thenPush: result.
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ strLength _ interpreterProxy stSizeOf: strOop.
+ count _ self cCode: 'unicodeGetFontList(str, strLength)'.
+
+ interpreterProxy pop: 2
+ thenPush: (interpreterProxy integerObjectOf: count).
+ ^ 0
+ !

Item was added:
+ ----- 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.
+
+ 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)'.
+
+ interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: count).
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ interpreterProxy failed ifTrue: [^ nil].
+
+ w _ h _ 0.
+ utf8Length _ interpreterProxy stSizeOf: utf8Oop.
+ self cCode: 'unicodeMeasureString(utf8, utf8Length, &w, &h)'.
+
+ result _ interpreterProxy makePointwithxValue: w yValue: h.
+ interpreterProxy pop: 2 thenPush: result.
+ ^ 0
+ !

Item was added:
+ ----- 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).
+ interpreterProxy failed ifTrue: [^ nil].
+
+ self cCode: 'unicodeSetColors(fgRed, fgGreen, fgBlue, bgRed, bgGreen, bgBlue, mapBGToTransparent)'.
+
+ interpreterProxy pop: 7.
+ ^ 0
+ !

Item was added:
+ ----- 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).
+ interpreterProxy failed ifTrue: [^ nil].
+
+ self cCode: 'unicodeSetFont(fontName, fontSize, boldFlag, italicFlag, antiAliasFlag)'.
+
+ interpreterProxy pop: 5.
+ ^ 0
+ !

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

Item was added:
+ InterpreterPlugin subclass: #WeDoPlugin
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Plugins'!
+
+ !WeDoPlugin commentStamp: 'jm 12/2/2008 14:22' prior: 0!
+ Low level interface to the Lego WeDo.
+ !

Item was added:
+ ----- Method: WeDoPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+
+ ^true!

Item was added:
+ ----- Method: WeDoPlugin>>primClosePort (in category 'translated prims') -----
+ primClosePort
+ "Close the WeDo port."
+
+ self export: true.
+ interpreterProxy success: (self cCode: 'WeDoClosePort()').
+ ^ 0
+ !

Item was added:
+ ----- Method: WeDoPlugin>>primOpenPort (in category 'translated prims') -----
+ primOpenPort
+ "Open the WeDo port."
+
+ self export: true.
+ interpreterProxy success: (self cCode: 'WeDoOpenPort()').
+ ^ 0
+ !

Item was added:
+ ----- 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.
+ ((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: [^ 0].
+
+ 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 added:
+ ----- 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.
+ ((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: [^ 0].
+
+ 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
+ !