try to fix gradient

src/backends/fig_drawing.f90

@@ -33,18 +33,13 @@ end subroutine set_background
     subroutine add_shape(this, s)
         class(drawing), intent(inout) :: this
         class(shape), intent(in), target :: s
-        integer :: new_size, i
+        integer :: new_size
         type(shapeWrapper), allocatable :: temp(:)
 
         if (this%shape_count >= size(this%shapes)) then
             new_size = max(1, 2 * size(this%shapes))
 
-            if (this%shape_count > 0) then
-                allocate(temp(this%shape_count))
-                temp = this%shapes(1:this%shape_count)
-            endif
-
-            deallocate(this%shapes)
+            call move_alloc(from=this%shapes,to=temp)
             allocate(this%shapes(new_size))
 
             if (this%shape_count > 0) then

src/gradient.f90 → src/backends/fig_gradient.f90

@@ -9,11 +9,12 @@ module fig_gradient
     end type pattern_stop
 
     type stops_a
-        type(pattern_stop), allocatable :: stop_array(:)
+        type(pattern_stop), allocatable:: stop_array(:)
         integer :: stop_count
         contains
         procedure :: init => init_stops_a
         procedure :: add_stop
+        procedure :: clear_stops
     end type stops_a
 
 
@@ -40,26 +41,35 @@ subroutine init_stops_a(this)
         class(stops_a), intent(inout) :: this
         this%stop_count = 0
         allocate(this%stop_array(0))
-    end subroutine init
+    end subroutine init_stops_a
+
 
     subroutine add_stop(this, offset, color)
         class(stops_a), intent(inout) :: this
         real(kind=8), intent(in) :: offset
         type(RGB), intent(in) :: color
-        type(pattern_stop) :: new_stop
+        type(pattern_stop), allocatable :: new_stop_array(:)
 
-        new_stop%offset = offset
-        new_stop%stop_color = color
+        ! Allocate new array for stops if not already allocated
+        if (.not. allocated(this%stop_array)) then
+            allocate(this%stop_array(1))
+        else
+            ! Allocate new array and copy existing stops
+            allocate(new_stop_array(size(this%stop_array) + 1))
+            new_stop_array(:size(this%stop_array)) = this%stop_array
+            deallocate(this%stop_array)
+            allocate(this%stop_array(size(new_stop_array)))
+            this%stop_array = new_stop_array
+        end if
 
         this%stop_count = this%stop_count + 1
-        if (.not.allocated(this%stop_array)) then
-            allocate(this%stop_array(this%stop_count))
-        else
-            allocate(this%stop_array(this%stop_count), source=this%stop_array)
-        endif
-        this%stop_array(this%stop_count) = new_stop
+        this%stop_array(this%stop_count)%offset = offset
+        this%stop_array(this%stop_count)%stop_color = color
     end subroutine add_stop
+    subroutine clear_stops(this)
+        class(stops_a), intent(inout) :: this
 
-
+        this%stop_count = 0
+    end subroutine clear_stops
 end module fig_gradient
 

src/backends/fig_shapes.f90

@@ -2,11 +2,15 @@ module fig_shapes
     use fig_types
     use fig_rgb_color_constants
     use fig_rgb
+    use fig_gradient
 
     type, abstract :: shape
-        type(RGB) :: fill_color = FIG_COLOR_BLACK
+        type(RGB) :: fill_color = FIG_COLOR_BLANK
         type(RGB) :: stroke_color = FIG_COLOR_BLANK
+        type(pattern_wrapper):: fill_color2
+
         real(kind=8) :: stroke_width  =1
+
     end type shape
 
     type, extends(shape) :: circle

src/backends/raster/bitmap_utils.f90

@@ -19,19 +19,49 @@ function normalize_ch(ch) result(res)
         res= real(ch,kind=8)/real(2**rgb_bit_depth-1,kind=8)
     end function normalize_ch
 
+    subroutine grade(cr,grad)
+        type(c_ptr), intent(inout) :: cr
+        type(linear_gradient) :: grad
+        integer :: i
+        type(c_ptr):: gg
+
+        gg= cairo_pattern_create_linear(grad%x1,grad%y1,grad%x2,grad%y2)
+        do i = 1, grad%stops%stop_count
+           call cairo_pattern_add_color_stop_rgba(gg, &
+            grad%stops%stop_array(i)%offset, &
+            normalize_ch(grad%stops%stop_array(i)%stop_color%r), &
+            normalize_ch(grad%stops%stop_array(i)%stop_color%g), &
+            normalize_ch(grad%stops%stop_array(i)%stop_color%b), &
+            normalize_ch(grad%stops%stop_array(i)%stop_color%a))
+        end do
+        call cairo_set_source(cr,gg)
+
+    end subroutine grade
+
+
     subroutine fill(cr,sh)
         type(c_ptr), intent(inout) :: cr
         class(shape), intent(in) :: sh
-        if (sh%fill_color%a .ne. 0) then
-            call set_rgba(cr,sh%fill_color)
-            call cairo_fill_preserve(cr)
-        end if               
+
+        select type (color =>sh%fill_color2%pat)
+            type is (RGB)
+                if (color%a .ne. 0) then
+                    call set_rgba(cr,sh%fill_color)
+                    call cairo_fill_preserve(cr)
+                end if               
+            type is (linear_gradient)
+
+                if (color%x2.ne.0) then
+                    call grade(cr,color)
+                    call cairo_fill_preserve(cr)
+                end if
+        end select
+
     end subroutine fill
 
     subroutine stroke(cr,sh)
         type(c_ptr), intent(inout) :: cr
         class(shape), intent(in) :: sh
-
         if (sh%stroke_color%a .ne. 0) then
             call set_rgba(cr,sh%stroke_color)
             call cairo_set_line_width(cr,sh%stroke_width)

src/fig_rgb.f90

@@ -12,6 +12,10 @@ module fig_rgb
         integer(rgb_level) :: a
     end type RGB
 
+    type:: pattern_wrapper
+        class(pattern) ,allocatable :: pat
+    end type
+
 contains
 
     elemental type(integer(pixel)) function rgb_to_int(color) result(rgb_int)
@@ -33,13 +37,17 @@ elemental type(RGB) function int_to_rgb(rgb_int) result(color)
      end function int_to_rgb
 
      function rgb_to_string(color) result(color_string)
-         type(RGB), intent(in) :: color
+         class(pattern), intent(in) :: color
          character(len=50) :: color_string
          real :: alpha
 
-         alpha = color%a / 255.0
-         alpha = min(1.0,alpha)
-         write(color_string, '(A,I0,A,I0,A,I0,A,F5.3,A)') 'rgba(', color%r, ',', color%g, ',', color%b, ',', alpha, ')'
+         select type (color)
+            type is (RGB)
+                alpha = color%a / 255.0
+                alpha = min(1.0,alpha)
+                write(color_string, '(A,I0,A,I0,A,I0,A,F5.3,A)') 'rgba(', color%r, ',', color%g, ',', color%b, ',', alpha, ')'
+
+         end select
      end function rgb_to_string     
 
      elemental type(integer(pixel)) function blend_color(c1, c2) result(blended)

test/gradient.f90

@@ -0,0 +1,85 @@
+program gradient_test
+    use fig_canvas
+    use fig_drawing
+    use fig_rgb
+    use fig_shapes
+    use fig_rgb_color_constants
+    use fig_bitmap
+    use fig_test
+    implicit none
+    integer, parameter :: WIDTH = 800
+    integer, parameter :: HEIGHT = 800
+    integer, parameter :: cols = 7
+    integer, parameter :: rows = 4
+    real(kind=8), parameter :: CELL_WIDTH = (WIDTH/real(cols))
+    real(kind=8), parameter :: CELL_HEIGHT =(HEIGHT/real(rows))
+    integer :: x, y
+    character(len=:), allocatable  :: file_name
+
+    type(drawing) :: checker
+    type(bitmap_canvas) :: bitmap_canva
+    type(rectangle) :: rect
+    type(RGB) :: ALTERNATE_COLOR, BACKGROUND_COLOR, color
+    type(linear_gradient) :: gg
+    file_name = "checker_grad"
+    call checker%init()
+
+    BACKGROUND_COLOR = FIG_COLOR_BLACK
+    ALTERNATE_COLOR = FIG_COLOR_WHITE
+
+    color=FIG_COLOR_RED
+    call gg%stops%init()
+
+    do y = 0, rows - 1
+        do x = 0, cols - 1
+
+                gg%x1=x*CELL_WIDTH
+                gg%y1=y*CELL_HEIGHT
+                gg%x2=x*CELL_WIDTH+CELL_WIDTH
+                gg%y2=y*CELL_HEIGHT+CELL_HEIGHT
+        select case (mod(x  + y*cols, 3) )
+            case (0)
+
+                call gg%stops%add_stop(0.0_c_double,FIG_COLOR_RED)
+                call gg%stops%add_stop(1.0_c_double,FIG_COLOR_AQUA)
+                rect%fill_color2%pat=color
+                 ! rect%fill_color2%pat=gg
+                rect%stroke_color = FIG_COLOR_AQUA
+            case (1)
+                call gg%stops%add_stop(0.0_c_double,FIG_COLOR_BLUE)
+                call gg%stops%add_stop(1.0_c_double,FIG_COLOR_GOLD)
+                 ! rect%fill_color=FIG_COLOR_BLUE
+                rect%fill_color2%pat=gg
+                rect%stroke_color = FIG_COLOR_BEIGE
+            case (2)
+                call gg%stops%add_stop(0.0_c_double,FIG_COLOR_LIME)
+                call gg%stops%add_stop(1.0_c_double,FIG_COLOR_DARKKHAKI)
+                rect%fill_color2%pat=gg
+                  ! rect%fill_color=FIG_COLOR_LIME
+                rect%stroke_color = FIG_COLOR_BLACK
+        !     case (3)
+        !         call gg%stops%add_stop(0.0_c_double,FIG_COLOR_YELLOW)
+        !         call gg%stops%add_stop(1.0_c_double,FIG_COLOR_WHITE)
+                ! rect%fill_color=FIG_COLOR_WHITE
+        !         rect%fill_color=gg
+        end select
+            call gg%stops%clear_stops
+            rect%upper_left%x = (x * 1.0 / cols)
+            rect%upper_left%y = (y * 1.0 / rows)
+            rect%width = CELL_WIDTH
+            rect%height = CELL_HEIGHT
+            ! rect%fill_color = color
+            rect%stroke_width = 3
+
+            call checker%add_shape(rect)
+        end do
+    end do
+    call bitmap_canva%init(HEIGHT,WIDTH)
+    call bitmap_canva%save_to_file(checker,file_name,"png")
+    call bitmap_canva%save_to_file(checker,file_name,"ppm")
+    call bitmap_canva%destroy()
+
+    call test_both(file_name,bitmap_canva)
+
+end program gradient_test
+