gradient

src/backends/fig_types.f90

@@ -23,8 +23,8 @@ elemental type(canvas_point) function to_canvas(p, sz) result(pxl)
         type(point), intent(in) :: p
         type(canvas_size), intent(in) :: sz
 
-        pxl%x = nint(p%x * sz%width, kind=pixel)
-        pxl%y = nint(p%y * sz%height, kind=pixel)
+        pxl%x = p%x * sz%width
+        pxl%y = p%y * sz%height
     end function to_canvas
 
 end module fig_types

src/backends/raster/bitmap_utils.f90

@@ -19,22 +19,22 @@ function normalize_ch(ch) result(res)
         res= real(ch,kind=8)/real(2**rgb_bit_depth-1,kind=8)
     end function normalize_ch
 
-    subroutine fill(cr,color)
+    subroutine fill(cr,sh)
         type(c_ptr), intent(inout) :: cr
-        type(RGB) :: color
-        if (color%a .ne. 0) then
-            call set_rgba(cr,color)
+        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
+        end if               
     end subroutine fill
 
-    subroutine stroke(cr,color,width)
+    subroutine stroke(cr,sh)
         type(c_ptr), intent(inout) :: cr
-        type(RGB) :: color
-        real(kind=8) :: width
-        if (color%a .ne. 0) then
-            call set_rgba(cr,color)
-            call cairo_set_line_width(cr,width)
+        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)
             call cairo_stroke(cr)
         else 
             call cairo_new_path(cr)

src/backends/raster/shapes/bitmap_circle.f90

@@ -31,8 +31,8 @@ subroutine write_circle(canva, cr, circ)
         call cairo_curve_to(cr, c%x - cpx, bottom, left, c%y + cpy, left, c%y);
         call cairo_curve_to(cr, left, c%y - cpy, c%x - cpx, top, c%x, top);
         call cairo_close_path(cr);
-        call fill(cr,circ%fill_color)
-        call stroke(cr,circ%stroke_color,circ%stroke_width)
+        call fill(cr,circ)
+        call stroke(cr,circ)
 
     end subroutine write_circle
 

src/backends/raster/shapes/bitmap_ellipse.f90

@@ -31,8 +31,8 @@ subroutine write_ellipse(canva, cr, ellip)
         call cairo_curve_to(cr, c%x - cpx, bottom, left, c%y + cpy, left, c%y);
         call cairo_curve_to(cr, left, c%y - cpy, c%x - cpx, top, c%x, top);
         call cairo_close_path(cr);
-        call fill(cr,ellip%fill_color)
-        call stroke(cr,ellip%stroke_color,ellip%stroke_width)
+        call fill(cr,ellip)
+        call stroke(cr,ellip)
 
     end subroutine write_ellipse
 

src/backends/raster/shapes/bitmap_line.f90

@@ -18,7 +18,7 @@ subroutine write_line(canva, cr, l)
         call cairo_move_to(cr,p1%x,p1%y)
         call cairo_line_to(cr,p2%x,p2%y)
         call cairo_close_path(cr)
-        call stroke(cr,l%stroke_color,l%stroke_width)
+        call stroke(cr,l)
 
 
     end subroutine write_line

src/backends/raster/shapes/bitmap_rect.f90

@@ -16,8 +16,8 @@ subroutine write_rectangle(canva, cr, rect)
 
 
         call cairo_rectangle(cr, p%x, p%y, rect%width, rect%height)
-        call fill(cr,rect%fill_color)
-        call stroke(cr,rect%stroke_color, rect%stroke_width)
+        call fill(cr,rect)
+        call stroke(cr,rect)
 
 
     end subroutine write_rectangle

src/backends/raster/shapes/bitmap_triangle.f90

@@ -21,8 +21,8 @@ subroutine write_triangle(canva, cr, tri)
         call cairo_line_to(cr,p3%x,p3%y)
         call cairo_line_to(cr,p1%x,p1%y)
         call cairo_close_path(cr)
-        call fill(cr,tri%fill_color)
-        call stroke(cr,tri%stroke_color,tri%stroke_width)
+        call fill(cr,tri)
+        call stroke(cr,tri)
 
     end subroutine write_triangle
 

src/fig_rgb.f90

@@ -2,8 +2,10 @@ module fig_rgb
     use fig_config
     implicit none
 
-    type :: RGB
-        sequence
+    type, abstract :: pattern
+    end type
+
+    type,extends(pattern) :: RGB
         integer(rgb_level) :: r
         integer(rgb_level) :: g
         integer(rgb_level) :: b

src/gradient.f90

@@ -0,0 +1,65 @@
+module fig_gradient
+    use fig_rgb
+    use fig_rgb_color_constants
+    implicit none
+
+    type pattern_stop
+        real(kind=8) :: offset=0
+        type(RGB) :: stop_color = FIG_COLOR_BLANK
+    end type pattern_stop
+
+    type stops_a
+        type(pattern_stop), allocatable :: stop_array(:)
+        integer :: stop_count
+        contains
+        procedure :: init => init_stops_a
+        procedure :: add_stop
+    end type stops_a
+
+
+    type,extends(pattern) :: linear_gradient
+        real(kind=8) :: x1=0
+        real(kind=8) :: y1=0
+        real(kind=8) :: x2=0
+        real(kind=8) :: y2=0
+        type(stops_a) :: stops
+
+    end type linear_gradient
+
+    type,extends(pattern) :: radial_gradient
+        real(kind=8) :: fx=0
+        real(kind=8) :: fy=0
+        real(kind=8) :: fr=0
+        real(kind=8) :: cx=0
+        real(kind=8) :: cy=0
+        real(kind=8) :: cr=0
+
+    end type radial_gradient
+    contains
+    subroutine init_stops_a(this)
+        class(stops_a), intent(inout) :: this
+        this%stop_count = 0
+        allocate(this%stop_array(0))
+    end subroutine init
+
+    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
+
+        new_stop%offset = offset
+        new_stop%stop_color = color
+
+        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
+    end subroutine add_stop
+
+
+end module fig_gradient
+