2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Cairo "Hello World" demo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!  Copyright (c) 2007 Sampo Vuori
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!    License: http://factorcode.org/license.txt
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! This example is an adaptation of the following cairo sample code:
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								!  http://cairographics.org/samples/text/
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-15 20:36:40 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: cairo.ffi math math.constants byte-arrays kernel ui ui.render
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:05:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								           ui.gadgets opengl.gl accessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: cairo-demo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: make-image-array ( -- array )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  384 256 4 * * <byte-array> ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: convert-array-to-surface ( array -- cairo_surface_t )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  CAIRO_FORMAT_ARGB32 384 256 over 4 *
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  cairo_image_surface_create_for_data ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: cairo-demo-gadget < gadget image-array cairo-t ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cairo-demo-gadget draw-gadget* ( gadget -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-17 10:03:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    0 0 glRasterPos2i
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    1.0 -1.0 glPixelZoom
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    >r 384 256 GL_RGBA GL_UNSIGNED_BYTE r>
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:05:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    image-array>> glDrawPixels ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: create-surface ( gadget -- cairo_surface_t )
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:05:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    make-image-array [ swap (>>image-array) ] keep
							 | 
						
					
						
							
								
									
										
										
										
											2008-03-15 20:36:40 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    convert-array-to-surface ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: init-cairo ( gadget -- cairo_t )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   create-surface cairo_create ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cairo-demo-gadget pref-dim* drop { 384 256 0 } ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: draw-hello-world ( gadget -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:05:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  cairo-t>>
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD cairo_select_font_face
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 90.0 cairo_set_font_size
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 10.0 135.0 cairo_move_to
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup "Hello" cairo_show_text
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 70.0 165.0 cairo_move_to
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup "World" cairo_text_path
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 0.5 0.5 1 cairo_set_source_rgb
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup cairo_fill_preserve
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 0 0 0 cairo_set_source_rgb
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 2.56 cairo_set_line_width
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup cairo_stroke
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 1 0.2 0.2 0.6 cairo_set_source_rgba
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 10.0 135.0 5.12 0 pi 2 * cairo_arc
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup cairo_close_path
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup 70.0 165.0 5.12 0 pi 2 * cairo_arc
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  cairo_fill ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cairo-demo-gadget graft* ( gadget -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:05:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  dup dup init-cairo swap (>>cairo-t) draw-hello-world ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: cairo-demo-gadget ungraft* ( gadget -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:05:31 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								   cairo-t>> cairo_destroy ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <cairo-demo-gadget> ( -- gadget )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  cairo-demo-gadget new-gadget ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: run ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  [
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-10 20:07:04 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        <cairo-demo-gadget> "Hello World from Factor!" open-window
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-25 15:06:28 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  ] with-ui ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								MAIN: run
							 |