The Trunk: MorphicExtras-eem.293.mcz

Eliot Miranda uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-eem.293.mcz

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

Name: MorphicExtras-eem.293
Author: eem
Time: 16 April 2021, 7:14:15.621938 pm
UUID: 27489c5b-4cc5-4581-905d-881e877c32d6
Ancestors: MorphicExtras-mt.292

Add frame buffering to the CameraInterface (i.e. if possible the CameraPlugin copies data directly into a pinned bitmap instead of into an internal buffer which is then copied into the bitmap in getFrameForCamera:into:.  Update the camera:framesDo:while: utility to use buffering and/or interrupt notification if possible.

=============== Diff against MorphicExtras-mt.292 ===============

Item was added:
+ ----- Method: CameraInterface class>>bufferedInterruptDrivenVideoTest: (in category 'test') -----
+ bufferedInterruptDrivenVideoTest: camNum
+        "A quick test of video input. Displays video on the screen until the mouse is pressed.
+         Answer nil if the interrupt-driven interface is unavailable."
+        "self bufferedInterruptDrivenVideoTest: 1"
+        "self bufferedInterruptDrivenVideoTest: 2"
+        "[self bufferedInterruptDrivenVideoTest: 2] fork.
+          self bufferedInterruptDrivenVideoTest: 1"
+
+        | semaphore height frameExtent frameBuffer |
+        height := 16.
+        1 to: camNum - 1 do:
+                [:camIndex| "N.B. the extent of an unopened camera is 0@0"
+                height := height + (self frameExtent: camIndex) y + 16].
+        (self cameraIsOpen: camNum) ifFalse:
+                [(self openCamera: camNum width: 352 height: 288) ifNil:
+                        [self inform: 'no camera'.
+                         ^nil]].
+        frameExtent := self frameExtent: camNum.
+        frameBuffer := Form extent: frameExtent depth: 32.
+        frameBuffer bits pin.
+        self camera: camNum setFrameBuffer: frameBuffer bits.
+                
+        semaphore := Semaphore new.
+        [self camera: camNum setSemaphore: (Smalltalk registerExternalObject: semaphore)]
+                on: Error
+                do: [:err|
+                        Smalltalk unregisterExternalObject: semaphore.
+                        self inform: 'interrupt-driven camera interface unavailable: ', err messageText.
+                        ^nil].
+        [| n startTime frameCount msecs fps |
+         [semaphore wait.
+          startTime ifNil:
+                [frameCount := 0.
+                 frameExtent := self frameExtent: camNum.
+                "N.B. the actual frame size may not be determined until delivery of the first frame.
+                 So resize the form if necessary."
+                 frameExtent ~= frameBuffer extent ifTrue:
+                        [frameBuffer := Form extent: frameExtent depth: 32 bits: frameBuffer bits].
+                 startTime := Time millisecondClockValue].
+          Sensor anyButtonPressed] whileFalse:
+                [n := self getFrameForCamera: camNum into: frameBuffer bits.
+                n > 0 ifTrue:
+                        [frameCount := frameCount + 1.
+                         frameBuffer displayAt: 16 @ height]].
+         msecs := Time millisecondClockValue - startTime.
+         fps := (frameCount * 1000) // msecs.
+         ^(self cameraName: camNum), ': ', frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec']
+                ensure:
+                        [self closeCamera: camNum.
+                         Smalltalk unregisterExternalObject: semaphore.
+                         Sensor waitNoButton]!

Item was changed:
  ----- Method: CameraInterface class>>camera:framesDo:while: (in category 'utilities') -----
  camera: cameraNum framesDo: aBlock while: whileBlock
+        "Evaluate aBlock every time a frame becomes available.  Answer a tuple of frames per second
+         and the number of 16ms delays per second if polling is used, plus indications of which schemes
+         were used. Be destructive; use only one bitmap, overwriting its contents with each successive frame.
+         Use the buffered interface if possible. It is the sender's responsibility to open and close the camera."
+        | form bitmap schemes delay start duration frameCount delayCount semaphore  |
-        "Evaluate aBlock every time a frame becomes available.  Answer a tuple of frames per second and number of 16ms delays per second.
-         Be destructive; use only one bitmap, overwriting its contents with each successive frame.
-         It is the sender's responsibility to open and close the camera."
-        | form bitmap delay start duration frameCount delayCount |
         form := Form
                                 extent: (self frameExtent: cameraNum)
                                 depth: 32.
         bitmap := form bits.
+        bitmap pin.
+        schemes := Array new writeStream.
+        [self camera: cameraNum setFrameBuffer: bitmap.
+         schemes nextPut: 'buffered']
+                on: Error
+                do: [:err|
+                        bitmap unpin.
+                        schemes nextPut: 'copied'].
+        semaphore := Semaphore new.
+        [self camera: cameraNum setSemaphore: (Smalltalk registerExternalObject: semaphore).
+         schemes nextPut: 'interrupt driven']
+                on: Error
+                do: [:err|
+                        Smalltalk unregisterExternalObject: semaphore.
+                        semaphore := nil.
+                        schemes nextPut: 'polling'].
         delay := Delay forMilliseconds: (1000 / 60) asInteger. "60 fps is fast"
+
         start := Time utcMicrosecondClock.
         frameCount := delayCount := 0.
+        [semaphore ifNotNil:
+                [semaphore wait].
+        [(self getFrameForCamera: cameraNum into: bitmap) <= 0] whileTrue:
-        [[(self camera: cameraNum getParam: 1) <= 0] whileTrue:
                 [delay wait. delayCount := delayCount + 1].
-         self getFrameForCamera: cameraNum into: bitmap.
          frameCount := frameCount + 1.
          aBlock value: form.
          whileBlock value] whileTrue.
         ^{ frameCount * 1.0e6 / (duration := Time utcMicrosecondClock - start).
+                delayCount * 1.0e6 / duration },
+         schemes contents
-                delayCount * 1.0e6 / duration }
 
         "| cameraNum |
          self openCamera: (cameraNum := 1) width: 640 height: 480.
          self waitForCameraStart: cameraNum.
          [self camera: cameraNum framesDo: [:bitmap| bitmap display] while: [Sensor noButtonPressed]] ensure:
                 [self closeCamera: cameraNum]"!

Item was added:
+ ----- Method: CameraInterface class>>camera:setFrameBuffer: (in category 'camera ops') -----
+ camera: cameraNum setFrameBuffer: frameBuffer
+        "Set a pinned non-pointer object as the frame buffer for the camera.
+         Fail if cameraNum does not reference an open camera, or if the buffer is not large enough."
+        <primitive: 'primSetCameraBuffers' module: 'CameraPlugin' error: ec>
+        ^self primitiveFailed!

Item was added:
+ ----- Method: CameraInterface class>>camera:setFrameBufferA:B: (in category 'camera ops') -----
+ camera: cameraNum setFrameBufferA: frameBufferA B: frameBufferBOrNil
+        "Set a pair of pinned non-pointer objects as the frame buffers for the camera.
+         If both are non-nil the plugin will fill them alternating between first frameBufferA and second frameBufferBOrNil.
+         Fail if frameBufferBOrNil is not nil and a different size from frameBufferA.
+         Fail if cameraNum does not reference an open camera, or if the buffers are not large enough."
+        <primitive: 'primSetCameraBuffers' module: 'CameraPlugin' error: ec>
+        ^self primitiveFailed!

Item was changed:
  ----- Method: CameraInterface class>>interruptDrivenVideoTest: (in category 'test') -----
  interruptDrivenVideoTest: camNum
         "A quick test of video input. Displays video on the screen until the mouse is pressed.
          Answer nil if the interrupt-driven interface is unavailable."
         "self interruptDrivenVideoTest: 1"
         "self interruptDrivenVideoTest: 2"
         "[self interruptDrivenVideoTest: 2] fork.
           self interruptDrivenVideoTest: 1"
 
         | semaphore height frameExtent |
         height := 16.
         1 to: camNum - 1 do:
+                [:camIndex| "N.B. the extent of an unopened camera is 0@0"
-                [:camIndex| "N.B. the of an unopened camera is 0@0"
                 height := height + (self frameExtent: camIndex) y + 16].
         (self cameraIsOpen: camNum) ifFalse:
                 [(self openCamera: camNum width: 352 height: 288) ifNil:
                         [self inform: 'no camera'.
                          ^nil]].
         semaphore := Semaphore new.
         [self camera: camNum setSemaphore: (Smalltalk registerExternalObject: semaphore)]
                 on: Error
                 do: [:err|
                         Smalltalk unregisterExternalObject: semaphore.
                         self inform: 'interrupt-driven camera interface unavailable: ', err messageText.
                         ^nil].
         [| f n startTime frameCount msecs fps |
          [semaphore wait.
          "N.B. the frame extent may not be known until the delivery of the first frame.
           So we have to delay initialization."
           startTime ifNil:
                 [(frameExtent := self frameExtent: camNum) x = 0 ifTrue: [self inform: 'no camera'. ^nil].
                  f := Form extent: (self frameExtent: camNum) depth: 32.
                  frameCount := 0.
                  startTime := Time millisecondClockValue].
           Sensor anyButtonPressed] whileFalse:
                 [n := self getFrameForCamera: camNum into: f bits.
                 n > 0 ifTrue:
                         [frameCount := frameCount + 1.
                          f displayAt: 16 @ height]].
          msecs := Time millisecondClockValue - startTime.
          fps := (frameCount * 1000) // msecs.
          ^(self cameraName: camNum), ': ', frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec']
                 ensure:
                         [self closeCamera: camNum.
                          Smalltalk unregisterExternalObject: semaphore.
                          Sensor waitNoButton]!

Item was changed:
  ----- Method: CameraInterface class>>videoTest: (in category 'test') -----
  videoTest: camNum
         "A quick test of video input. Displays video on the screen until the mouse is pressed."
         "self videoTest: 1"
         "self videoTest: 2"
 
         | frameExtent f n startTime frameCount msecs fps |
+        (self cameraIsOpen: camNum) ifFalse:
+                [(self openCamera: camNum width: 320 height: 240) ifNil:
+                        [self inform: 'no camera'.
+                         ^nil]].
-        (self openCamera: camNum width: 320 height: 240) ifNil: [^ self inform: 'no camera'].
         self waitForCameraStart: camNum.
         (frameExtent := self frameExtent: camNum) x = 0 ifTrue: [^ self inform: 'no camera'].
         f := Form extent: (self frameExtent: camNum) depth: 32.
         frameCount := 0.
         startTime := nil.
         [Sensor anyButtonPressed] whileFalse:
                 [n := self getFrameForCamera: camNum into: f bits.
                 n > 0 ifTrue:
                         [startTime ifNil: [startTime := Time millisecondClockValue].
                         frameCount := frameCount + 1.
                         f display]].
         Sensor waitNoButton.
         msecs := Time millisecondClockValue - startTime.
         self closeCamera: camNum.
         fps := frameCount * 1000 // msecs.
+        ^(self cameraName: camNum), ': ', frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec'!
-        ^frameExtent printString, ' ', frameCount printString, ' frames at ', fps printString, ' frames/sec'!