116 lines
		
	
	
		
			2.7 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			116 lines
		
	
	
		
			2.7 KiB
		
	
	
	
		
			Factor
		
	
	
| 
 | |
| USING: kernel alien.c-types combinators sequences splitting grouping
 | |
|        opengl.gl ui.gadgets ui.render
 | |
|        math math.vectors accessors math.geometry.rect ;
 | |
| 
 | |
| IN: ui.gadgets.frame-buffer
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| TUPLE: frame-buffer < gadget action pdim last-dim graft ungraft pixels ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| : init-frame-buffer-pixels ( frame-buffer -- frame-buffer )
 | |
|   dup
 | |
|     rect-dim product "uint[4]" <c-array>
 | |
|   >>pixels ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| : new-frame-buffer ( class -- gadget )
 | |
|   new-gadget
 | |
|     [ ]         >>action
 | |
|     { 100 100 } >>pdim
 | |
|     [ ]         >>graft
 | |
|     [ ]         >>ungraft ;
 | |
| 
 | |
| : <frame-buffer> ( -- frame-buffer ) frame-buffer new-frame-buffer ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| : draw-pixels ( fb -- fb )
 | |
|   dup >r
 | |
|   dup >r
 | |
|   rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glDrawPixels
 | |
|   r> ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| : read-pixels ( fb -- fb )
 | |
|   dup >r
 | |
|   dup >r
 | |
|       >r
 | |
|   0 0 r> rect-dim first2 GL_RGBA GL_UNSIGNED_INT r> pixels>> glReadPixels
 | |
|   r> ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| M: frame-buffer pref-dim* pdim>> ;
 | |
| M: frame-buffer graft*    graft>>   call ;
 | |
| M: frame-buffer ungraft*  ungraft>> call ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| : copy-row ( old new -- )
 | |
|   2dup min-length swap >r head-slice 0 r> copy ;
 | |
| 
 | |
| ! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
 | |
| !   [ group ] 2bi@
 | |
| !   [ copy-row ] 2each ;
 | |
| 
 | |
| ! : copy-pixels ( old-pixels old-width new-pixels new-width -- )
 | |
| !   [ 16 * group ] 2bi@
 | |
| !   [ copy-row ] 2each ;
 | |
| 
 | |
| : copy-pixels ( old-pixels old-width new-pixels new-width -- )
 | |
|   [ 16 * <sliced-groups> ] 2bi@
 | |
|   [ copy-row ] 2each ;
 | |
| 
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| M: frame-buffer layout* ( fb -- )
 | |
|    {
 | |
|      {
 | |
|        [ dup last-dim>> f = ]
 | |
|        [
 | |
|          init-frame-buffer-pixels
 | |
|          dup
 | |
|            rect-dim >>last-dim
 | |
|          drop
 | |
|        ]
 | |
|      }
 | |
|      {
 | |
|        [ dup [ rect-dim ] [ last-dim>> ] bi = not ]
 | |
|        [
 | |
|          dup [ pixels>> ] [ last-dim>> first ] bi
 | |
| 
 | |
|          rot init-frame-buffer-pixels
 | |
|          dup rect-dim >>last-dim
 | |
| 
 | |
|          [ pixels>> ] [ rect-dim first ] bi
 | |
| 
 | |
|          copy-pixels
 | |
|        ]
 | |
|      }
 | |
|      { [ t ] [ drop ] }
 | |
|    }
 | |
|    cond ;
 | |
|    
 | |
| ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 | |
| 
 | |
| M: frame-buffer draw-gadget* ( fb -- )
 | |
| 
 | |
|    dup rect-dim { 0 1 } v* first2 glRasterPos2i
 | |
| 
 | |
|    draw-pixels
 | |
| 
 | |
|    dup action>> call
 | |
| 
 | |
|    glFlush
 | |
| 
 | |
|    read-pixels
 | |
| 
 | |
|    drop ;
 | |
| 
 |