93 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
		
		
			
		
	
	
			93 lines
		
	
	
		
			2.8 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
| 
								 | 
							
								; Test methods of Buffer class of the PDB
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; aka NamedBuffer i.e. the clipboard saved with a name.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Edit methods that create buffers is tested elsewhere.
							 | 
						||
| 
								 | 
							
								; The names of those methods is hard to understand:
							 | 
						||
| 
								 | 
							
								; because they used "named" to mean "buffer"
							 | 
						||
| 
								 | 
							
								; E.G. pika-edit-named-copy might be better named:
							 | 
						||
| 
								 | 
							
								; pika-edit-copy-to-named-buffer
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Prereq:  no buffer exists yet.
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; setup
							 | 
						||
| 
								 | 
							
								; Load test image that already has drawable
							 | 
						||
| 
								 | 
							
								(define testImage (testing:load-test-image "wilber.png"))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; the layer is the zeroeth element in the vector which is the second element
							 | 
						||
| 
								 | 
							
								; but cadr returns the second element!!
							 | 
						||
| 
								 | 
							
								; TODO make this a library routine: get-first-layer
							 | 
						||
| 
								 | 
							
								; (1 #(<layerID>))
							 | 
						||
| 
								 | 
							
								(define testDrawable (vector-ref (cadr (pika-image-get-layers testImage ))
							 | 
						||
| 
								 | 
							
								                                  0))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Create new named buffer
							 | 
						||
| 
								 | 
							
								; There is no pika-buffer-new method,
							 | 
						||
| 
								 | 
							
								; instead it is a method of the Edit class so-to-speak
							 | 
						||
| 
								 | 
							
								; You can't: #(testDrawable)
							 | 
						||
| 
								 | 
							
								(define testBuffer (car (pika-edit-named-copy
							 | 
						||
| 
								 | 
							
								                              1
							 | 
						||
| 
								 | 
							
								                              (make-vector 1 testDrawable)
							 | 
						||
| 
								 | 
							
								                              "bufferName")))
							 | 
						||
| 
								 | 
							
								; Since no selection, the buffer is same size as image
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Creation was effective: pika knows the buffer
							 | 
						||
| 
								 | 
							
								; get-list takes a regex, here empty ""
							 | 
						||
| 
								 | 
							
								; get-list returns  (("bufferName")) : a list of strings
							 | 
						||
| 
								 | 
							
								; and the first string is "bufferName"
							 | 
						||
| 
								 | 
							
								(assert `(string=? (caar (pika-buffers-get-list ""))
							 | 
						||
| 
								 | 
							
								                    "bufferName"))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; buffer has same size as image when created with no selection
							 | 
						||
| 
								 | 
							
								; test image is 256x256
							 | 
						||
| 
								 | 
							
								(assert `(= (car (pika-buffer-get-width "bufferName"))
							 | 
						||
| 
								 | 
							
								            256))
							 | 
						||
| 
								 | 
							
								(assert `(= (car (pika-buffer-get-height "bufferName"))
							 | 
						||
| 
								 | 
							
								            256))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; new buffer has alpha: the image is RGB but the buffer has bpp 4
							 | 
						||
| 
								 | 
							
								; This is not well documented.
							 | 
						||
| 
								 | 
							
								; FIXME the docs and the method name should say "bpp"
							 | 
						||
| 
								 | 
							
								; or "bytes per pixel" instead of "bytes"
							 | 
						||
| 
								 | 
							
								(assert `(= (car (pika-buffer-get-bytes "bufferName"))
							 | 
						||
| 
								 | 
							
								            4))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; image type is RGBA
							 | 
						||
| 
								 | 
							
								; FIXME: the docs erroneously say "ImageBaseType" => "ImageType"
							 | 
						||
| 
								 | 
							
								(assert `(= (car (pika-buffer-get-image-type "bufferName"))
							 | 
						||
| 
								 | 
							
								            RGBA-IMAGE))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								;                 renaming
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Renaming returns the given name if it doesn't clash with existing name.
							 | 
						||
| 
								 | 
							
								(assert `(string=? (car (pika-buffer-rename "bufferName" "renamedName"))
							 | 
						||
| 
								 | 
							
								                  "renamedName"))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Effect renaming: pika knows the renamed name
							 | 
						||
| 
								 | 
							
								(assert `(string=? (caar (pika-buffers-get-list ""))
							 | 
						||
| 
								 | 
							
								                    "renamedName"))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Renaming does not add another buffer
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; TODO list-length 1
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								;                deleting
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Delete evaluates but is void
							 | 
						||
| 
								 | 
							
								(assert `(pika-buffer-delete "renamedName"))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; Delete was effective: pika no longer knows
							 | 
						||
| 
								 | 
							
								; and returns nil i.e. empty list (())
							 | 
						||
| 
								 | 
							
								(assert `(null? (car (pika-buffers-get-list ""))))
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; TODO test two buffers
							 | 
						||
| 
								 | 
							
								
							 | 
						||
| 
								 | 
							
								; TODO test renaming when name already in use
							 |