Add gradient

fpm.toml

@@ -16,3 +16,5 @@ implicit-typing = false
 implicit-external = false
 source-form = "free"
 
+[dependencies]
+cairo-fortran = {git = "https://github.com/vmagnin/cairo-fortran" }

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/backends/fig_gradient.f90

@@ -0,0 +1,75 @@
+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
+        procedure :: clear_stops
+    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_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), allocatable :: new_stop_array(:)
+
+        ! 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
+        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,25 +2,30 @@ 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
         type(point) :: center
-        real :: r
+        real (kind=8):: r
     end type circle
 
     type, extends(shape) :: ellipse
         type(point) :: center
-        real :: rx, ry
+        real (kind=8):: rx, ry
     end type ellipse
 
     type, extends(shape) :: rectangle
         type(point) :: upper_left
-        real :: width, height
+        real (kind=8):: width, height
     end type rectangle
 
     type, extends(shape) :: triangle
@@ -29,7 +34,6 @@ module fig_shapes
 
     type, extends(shape) :: line
         type(point) :: p1,p2
-        integer :: stroke_width  =1
     end type line
 
     type :: shapeWrapper

src/backends/fig_types.f90

@@ -8,8 +8,8 @@ module fig_types
     end type point
 
     type :: canvas_point
-        integer(pixel) :: x
-        integer(pixel) :: y
+        real(kind=8) :: x
+        real(kind=8) :: y
     end type canvas_point
 
     type :: canvas_size
@@ -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_backend.f90

@@ -1,22 +1,28 @@
 module fig_bitmap
+    use cairo
+    use cairo_enums
+    use cairo_types
+    use cairo_extra
     use fig_canvas
     use fig_shapes
     use fig_drawing
+    use fig_config
+    use fig_bitmap_utils
     use fig_bitmap_circle
     use fig_bitmap_ellipse
-    use fig_bitmap_rect
     use fig_bitmap_line
+    use fig_bitmap_rect
     use fig_bitmap_triangle
-    use fig_config
-    use fig_bitmap_utils
     use fig_rgb
     implicit none
     private
     public :: bitmap_canvas 
     type,extends(base_canvas) :: bitmap_canvas
-        integer(pixel), dimension(:,:), allocatable:: pixels
+        type(c_ptr) :: surface
+        type(c_ptr) :: cairo
     contains
         procedure :: init => init_bitmap
+        procedure :: destroy
         procedure :: save_to_file
         procedure :: load_from_ppm
         procedure :: save_to_ppm
@@ -30,16 +36,35 @@ subroutine init_bitmap(this, width, height)
         integer, intent(in) :: width, height
         this%size%width=width
         this%size%height=height
-        allocate(this%pixels(0:int(width)-1, 0:int(height)-1))
+
+        this%surface = cairo_image_surface_create(CAIRO_FORMAT_ARGB32,width, height)
+        this%cairo = cairo_create(this%surface)
     end subroutine init_bitmap
 
-    subroutine save_to_file(this,draw,file_path)
+    subroutine destroy(this)
+        class(bitmap_canvas), intent(inout) :: this
+
+        call cairo_destroy(this%cairo)
+        call cairo_surface_destroy(this%surface)
+    end subroutine destroy
+
+    subroutine save_to_file(this,draw,file_path,ext)
         class(bitmap_canvas), intent(inout) :: this
-        character(len=*), intent(in) :: file_path
         type(drawing), intent(in):: draw
+        integer :: r
+        character(len=*), intent(in) :: file_path
+        character(len=*), intent(in) :: ext
+
         call this%apply_shapes(draw)
 
-        call this%save_to_ppm(file_path)
+        select case (trim(ext))
+        case ('ppm')
+            call this%save_to_ppm(trim(file_path)//".ppm")
+        case ('png')
+            r = cairo_surface_write_to_png(this%surface, trim(file_path) // ".png" // c_null_char)
+        case default
+            error stop 'Unsupported file extension: ' // ext
+        end select
     end subroutine save_to_file
 
     subroutine load_from_ppm(this,file_path)
@@ -53,6 +78,7 @@ subroutine load_from_ppm(this,file_path)
         character(len=1) :: temp
         character(len=1) :: byte
         character :: ccode
+
         open(newunit=unit_num, file=file_path, status='old', access="stream", form="formatted", iostat=ierr)
         if (ierr /= 0) then
             print *, "Error opening file ", file_path
@@ -91,7 +117,7 @@ subroutine load_from_ppm(this,file_path)
             green = ichar(ccode)
             read(unit_num) ccode
             blue = ichar(ccode)
-            this%pixels(i, j) = blue + shiftl(green, 8) + shiftl(red, 16)
+            call set_pixel(this%surface, i, j, blue + shiftl(green, 8) + shiftl(red, 16))
             end do
         end do
 
@@ -104,6 +130,7 @@ subroutine save_to_ppm(this,file_path)
         integer :: unit_num, ierr
         integer :: i,j
         integer :: bytes(3)
+        integer(pixel) :: pixel_t
 
 
         open(newunit=unit_num, file=trim(file_path)//'.ppm', status='replace', action='write', iostat=ierr)
@@ -117,9 +144,10 @@ subroutine save_to_ppm(this,file_path)
         write(unit_num, '(i0)') 2**rgb_bit_depth-1
         do j = 0, int(this%size%height)-1
             do i = 0, int(this%size%width)-1
-                bytes(3) = ibits(this%pixels(i, j), 0, rgb_bit_depth)
-                bytes(2) = ibits(this%pixels(i, j), rgb_bit_depth, rgb_bit_depth)
-                bytes(1) = ibits(this%pixels(i, j), 2*rgb_bit_depth, rgb_bit_depth)
+                pixel_t = get_pixel(this%surface,i,j)
+                bytes(3) = ibits(pixel_t, 0, rgb_bit_depth)
+                bytes(2) = ibits(pixel_t, rgb_bit_depth, rgb_bit_depth)
+                bytes(1) = ibits(pixel_t, 2*rgb_bit_depth, rgb_bit_depth)
 
                 write(unit_num, '(3a1)', advance='no') bytes
             end do
@@ -131,27 +159,31 @@ end subroutine save_to_ppm
     subroutine bitmap_write_shape(canva,sh)
         class(bitmap_canvas), intent(inout) :: canva
         class(shape), intent(in) :: sh
+        type(canvas_point) :: p,p2,p3
 
         select type(sh)
         type is (circle)
-            call write_circle(canva, canva%pixels, sh)
+            call write_circle(canva, canva%cairo, sh)
         type is (ellipse)
-            call write_ellipse(canva ,canva%pixels,sh)
+            call write_ellipse(canva, canva%cairo, sh)
         type is (rectangle)
-            call write_rectangle(canva ,canva%pixels,sh)
+            call write_rectangle(canva, canva%cairo, sh)
         type is (line)
-            call write_line(canva ,canva%pixels,sh)
+            call write_line(canva, canva%cairo, sh)
         type is (triangle)
-            call write_triangle(canva ,canva%pixels,sh)
+            call write_triangle(canva, canva%cairo, sh)
         end select
+
     end subroutine bitmap_write_shape
 
     subroutine apply_shapes(canva,draw)
         class(bitmap_canvas), intent(inout) :: canva
         type(drawing), intent(in):: draw
         integer :: i
+        call set_rgba(canva%cairo,draw%background)
+        call cairo_paint(canva%cairo)
+        ! call write_rectangle(canva ,canva%cairo,bg)
 
-        call fill_rect(canva,canva%pixels,0,0,canva%size%width,canva%size%height,rgb_to_int(draw%background))
         do i = 1, draw%shape_count
             call bitmap_write_shape(canva,draw%shapes(i)%sh)
         end do