[prev in list] [next in list] [prev in thread] [next in thread]
List: squeak-vm-dev
Subject: [Vm-dev] VM Maker: VMMaker-bf.281.mcz
From: commits () source ! squeak ! org
Date: 2012-07-30 23:33:38
[Download RAW message or body]
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
+ !
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic