harbour-core/contrib/hbcairo/tests/fancytxt.prg

#require "hbcairo"

PROCEDURE Main()

   LOCAL hSurface

   hSurface := cairo_pdf_surface_create( "fancytxt.pdf", 566.9, 793.7 )  // 200x280 mm in pt
   draw( hSurface )
   cairo_surface_destroy( hSurface )

   hSurface := cairo_image_surface_create( "fancytxt.pdf", 567, 794 )
   draw( hSurface )
   cairo_surface_write_to_png( hSurface, "fancytxt.png" )
   cairo_surface_destroy( hSurface )

   RETURN


PROCEDURE draw( hSurface )

   LOCAL hCairo, hPath

   hCairo := cairo_create( hSurface )
   cairo_set_tolerance( hCairo, 0.01 )

   // Draw base line
   cairo_move_to( hCairo, 50, 650 )
   cairo_rel_line_to( hCairo, 250, 50 )
   cairo_rel_curve_to( hCairo, 100, 20, 200, -50, 200, -150 )
   cairo_rel_curve_to( hCairo, 0, -400, -300, -100, -400, -300 )
   hPath := cairo_copy_path_flat( hCairo )

   cairo_set_line_width( hCairo, 1 )
   cairo_set_source_rgb( hCairo, 0.6, 0.0, 0.0 )
   cairo_stroke( hCairo )

   // Draw text
   cairo_new_path( hCairo )
   cairo_select_font_face( hCairo, "sans-serif", CAIRO_FONT_SLANT_NORMAL, CAIRO_FONT_WEIGHT_NORMAL )
   cairo_set_font_size( hCairo, 72 )
   cairo_move_to( hCairo, 0, -5 )
   cairo_text_path( hCairo, "Welcome to the world of Harbour..." )

   // Transform
   map_path_onto( hCairo, hPath )
   cairo_path_destroy( hPath )

   // Paint
   cairo_set_line_cap( hCairo, CAIRO_LINE_CAP_ROUND )
   cairo_set_source_rgb( hCairo, 0.2, 0.1, 0.8 )
   cairo_fill_preserve( hCairo )

   cairo_set_line_width( hCairo, 1 )
   cairo_set_source_rgb( hCairo, 0.2, 0.2, 0.2 )
   cairo_stroke( hCairo )

   cairo_show_page( hCairo )
   cairo_destroy( hCairo )

   RETURN


PROCEDURE map_path_onto( hCairo, hPath )

   LOCAL hCurrentPath, aLengths, hIterator, nI, aPoints

   hCurrentPath := cairo_copy_path( hCairo )
   aLengths := path_lengths( hPath )
   hIterator := cairo_path_iterator_create( hCurrentPath )
   DO WHILE cairo_path_iterator_next( hIterator ) != NIL
      IF Len( aPoints := cairo_path_iterator_get_points( hIterator ) ) > 0
         FOR nI := 1 TO Len( aPoints )
            transform_point( @aPoints[ nI, 1 ], @aPoints[ nI, 2 ], hPath, aLengths )
         NEXT
         cairo_path_iterator_set_points( hIterator, aPoints )
      ENDIF
   ENDDO
   cairo_path_iterator_destroy( hIterator )
   cairo_append_path( hCairo, hCurrentPath )

   RETURN


STATIC PROCEDURE transform_point( nX, nY, hPath, aLengths )

   LOCAL hIterator, nI, nNX, nNY, nDX, nDY, nRatio, nType, aLast, aPoints, nK1, nK2

   nNX := nX
   nNY := nY
   hIterator := cairo_path_iterator_create( hPath )
   nI := 1
   DO WHILE ( nType := cairo_path_iterator_next( hIterator ) ) != NIL
      aPoints := cairo_path_iterator_get_points( hIterator )
      IF nNX <= aLengths[ nI ] .AND. nType != CAIRO_PATH_MOVE_TO
         EXIT
      ENDIF
      nNX -= aLengths[ nI ]
      nI++
      IF nType == CAIRO_PATH_MOVE_TO .OR. nType == CAIRO_PATH_LINE_TO
         aLast := aPoints[ 1 ]
      ELSEIF nType == CAIRO_PATH_CURVE_TO
         aLast := aPoints[ 3 ]
      ENDIF
   ENDDO

   IF nType == CAIRO_PATH_MOVE_TO
   ELSEIF nType == CAIRO_PATH_LINE_TO
      nRatio := nNX / aLengths[ nI ]
      nX := aLast[ 1 ] * ( 1 - nRatio ) + aPoints[ 1, 1 ] * nRatio
      nY := aLast[ 2 ] * ( 1 - nRatio ) + aPoints[ 1, 2 ] * nRatio

      nDX := -( aLast[ 1 ] - aPoints[ 1, 1 ] )
      nDY := -( aLast[ 2 ] - aPoints[ 1, 2 ] )

      nRatio := nNY / aLengths[ nI ]
      nX += -nDY * nRatio
      nY += nDX * nRatio
   ELSEIF nType == CAIRO_PATH_CURVE_TO
      nX := aLast[ 1 ] * ( 1 - nRatio ) ^ 3 + 3 * aPoints[ 1, 1 ] * ( 1 - nRatio ) ^ 2 * nRatio + 3 * aPoints[ 2, 1 ] * ( 1 - nRatio ) * nRatio ^ 2 + aPoints[ 3, 1 ] * nRatio ^ 3
      nY := aLast[ 2 ] * ( 1 - nRatio ) ^ 3 + 3 * aPoints[ 1, 2 ] * ( 1 - nRatio ) ^ 2 * nRatio + 3 * aPoints[ 2, 2 ] * ( 1 - nRatio ) * nRatio ^ 2 + aPoints[ 3, 2 ] * nRatio ^ 3

      nK1 := 1 - 4 * nRatio + 3 * nRatio ^ 2
      nK2 := 2 * nRatio - 3 * nRatio ^ 2

      nDX := -3 * aLast[ 1 ] * ( 1 - nRatio ) ^ 2 + 3 * aPoints[ 1, 1 ] * nK1 + 3 * aPoints[ 2, 1 ] * nK2 + 3 * aPoints[ 3, 1 ] * nRatio ^ 2
      nDY := -3 * aLast[ 2 ] * ( 1 - nRatio ) ^ 2 + 3 * aPoints[ 1, 2 ] * nK1 + 3 * aPoints[ 2, 2 ] * nK2 + 3 * aPoints[ 3, 2 ] * nRatio ^ 2

      nRatio := nNY / Sqrt( nDX * nDX + nDY * nDY )
      nX += -nDY * nRatio
      nY += nDX * nRatio
   ENDIF
   cairo_path_iterator_destroy( hIterator )

   RETURN


STATIC FUNC path_lengths( hPath )

   LOCAL hIterator, nType, aLast, aRet, aPoints, nLen

   aRet := {}
   hIterator := cairo_path_iterator_create( hPath )
   DO WHILE ( nType := cairo_path_iterator_next( hIterator ) ) != NIL
      aPoints := cairo_path_iterator_get_points( hIterator )
      nLen := 0
      IF nType == CAIRO_PATH_MOVE_TO
         aLast := aPoints[ 1 ]
      ELSEIF nType == CAIRO_PATH_LINE_TO
         nLen := distance( aLast[ 1 ], aLast[ 2 ], aPoints[ 1, 1 ], aPoints[ 1, 2 ] )
         aLast := aPoints[ 1 ]
      ELSEIF nType == CAIRO_PATH_CURVE_TO
         nLen := curve_length( aLast[ 1 ], aLast[ 2 ], aPoints[ 1, 1 ], aPoints[ 1, 2 ], ;
            aPoints[ 2, 1 ], aPoints[ 2, 2 ], aPoints[ 3, 1 ], aPoints[ 3, 2 ] )
         aLast := aPoints[ 3 ]
      ENDIF
      AAdd( aRet, nLen )
   ENDDO
   cairo_path_iterator_destroy( hIterator )

   RETURN aRet


STATIC FUNC distance( nX1, nY1, nX2, nY2 )
   RETURN Sqrt( ( nX1 - nX2 ) ^ 2 + ( nY1 - nY2 ) ^ 2 )


STATIC FUNC curve_length( nX1, nY1, nX2, nY2, nX3, nY3, nX4, nY4 )

   LOCAL nLength := 0, hSurface, hCairo, hPath, hIterator, nType, aLast, aPoints

   hSurface := cairo_image_surface_create( CAIRO_FORMAT_A8, 0, 0 )
   hCairo := cairo_create( hSurface )
   cairo_move_to( hCairo, nX1, nY1 )
   cairo_curve_to( hCairo, nX2, nY2, nX3, nY3, nX4, nY4 )
   hPath := cairo_copy_path_flat( hCairo )
   hIterator := cairo_path_iterator_create( hPath )
   DO WHILE ( nType := cairo_path_iterator_next( hIterator, @aPoints ) ) != NIL
      IF nType == CAIRO_PATH_MOVE_TO
         aLast := aPoints
      ELSEIF nType == CAIRO_PATH_LINE_TO
         nLength += distance( aLast[ 1 ], aLast[ 2 ], aPoints[ 1 ], aPoints[ 2 ] )
         aLast := aPoints
      ENDIF
   ENDDO
   cairo_path_iterator_destroy( hIterator )
   cairo_path_destroy( hPath )
   cairo_destroy( hCairo )
   cairo_surface_destroy( hSurface )

   RETURN nLength