add cairo to the backend

backends/fig_canvas.f90

@@ -0,0 +1,33 @@
+module fig_canvas
+    use fig_config
+    use fig_shapes
+    use fig_types
+    implicit none
+
+    type, abstract :: base_canvas 
+        type(canvas_size) :: size
+    contains
+        procedure(canvas_draw_shape), deferred :: draw_shape
+        procedure :: init
+    end type base_canvas
+
+    abstract interface
+       subroutine canvas_draw_shape(canva,sh)
+       import base_canvas, shape 
+       class(base_canvas), intent(inout) :: canva
+       class(shape), intent(in) :: sh
+       end subroutine canvas_draw_shape
+    end interface
+
+contains
+
+    subroutine init(this, width, height)
+        class(base_canvas), intent(inout) :: this
+        integer, intent(in) :: width, height
+
+        this%size%width = width
+        this%size%height = height
+
+    end subroutine init
+
+end module fig_canvas

backends/fig_drawing.f90

@@ -0,0 +1,62 @@
+module fig_drawing
+    use fig_config
+    use fig_shapes
+    use fig_rgb
+    use fig_rgb_color_constants
+    implicit none
+
+    type :: drawing
+        type(shapeWrapper), allocatable :: shapes(:)
+        type(RGB) :: background = FIG_COLOR_BLANK
+        integer :: shape_count
+    contains
+        procedure :: add_shape
+        procedure :: set_background
+        procedure :: init
+    end type drawing
+
+
+contains
+
+    subroutine init(this)
+        class(drawing), intent(inout) :: this
+        this%shape_count = 0
+        allocate(this%shapes(0))
+    end subroutine init
+
+    subroutine set_background(this, bg_color)
+        class(drawing), intent(inout) :: this
+        type(RGB), intent(in), target :: bg_color
+        this%background=bg_color
+    end subroutine set_background
+
+    subroutine add_shape(this, s)
+        class(drawing), intent(inout) :: this
+        class(shape), intent(in), target :: s
+        integer :: new_size, i
+        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)
+            allocate(this%shapes(new_size))
+
+            if (this%shape_count > 0) then
+                this%shapes(1:this%shape_count) = temp
+                deallocate(temp)
+            endif
+
+        endif
+
+        this%shape_count = this%shape_count + 1
+        allocate(this%shapes(this%shape_count)%sh, source=s)
+    end subroutine add_shape
+
+end module fig_drawing
+

backends/fig_shapes.f90

@@ -0,0 +1,38 @@
+module fig_shapes
+    use fig_types
+    use fig_rgb_color_constants
+    use fig_rgb
+
+    type, abstract :: shape
+        type(RGB) :: fill_color = FIG_COLOR_BLACK
+        type(RGB) :: stroke_color = FIG_COLOR_BLANK
+    end type shape
+
+    type, extends(shape) :: circle
+        type(point) :: center
+        real :: r
+    end type circle
+
+    type, extends(shape) :: ellipse
+        type(point) :: center
+        real :: rx, ry
+    end type ellipse
+
+    type, extends(shape) :: rectangle
+        type(point) :: upper_left
+        real :: width, height
+    end type rectangle
+
+    type, extends(shape) :: triangle
+        type(point) :: p1, p2, p3
+    end type triangle
+
+    type, extends(shape) :: line
+        type(point) :: p1,p2
+        integer :: stroke_width  =1
+    end type line
+
+    type :: shapeWrapper
+      class(shape), allocatable :: sh
+    end type
+end module fig_shapes

backends/fig_types.f90

@@ -0,0 +1,30 @@
+module fig_types
+    use fig_config
+    implicit none
+
+    type :: point
+        real :: x
+        real :: y
+    end type point
+
+    type :: canvas_point
+        integer(pixel) :: x
+        integer(pixel) :: y
+    end type canvas_point
+
+    type :: canvas_size
+        integer(pixel) :: width
+        integer(pixel) :: height
+    end type canvas_size
+
+contains
+
+    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)
+    end function to_canvas
+
+end module fig_types

backends/raster/bitmap_backend.f90

@@ -0,0 +1,163 @@
+module fig_bitmap
+    use fig_canvas
+    use fig_shapes
+    use fig_drawing
+    use fig_bitmap_circle
+    use fig_bitmap_ellipse
+    use fig_bitmap_rect
+    use fig_bitmap_line
+    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
+    contains
+        procedure :: init => init_bitmap
+        procedure :: save_to_file
+        procedure :: load_from_ppm
+        procedure :: save_to_ppm
+        procedure :: apply_shapes
+        procedure :: draw_shape=> bitmap_write_shape
+    end type bitmap_canvas
+contains
+
+    subroutine init_bitmap(this, width, height)
+        class(bitmap_canvas), intent(inout) :: this
+        integer, intent(in) :: width, height
+        this%size%width=width
+        this%size%height=height
+        allocate(this%pixels(0:int(width)-1, 0:int(height)-1))
+    end subroutine init_bitmap
+
+    subroutine save_to_file(this,draw,file_path)
+        class(bitmap_canvas), intent(inout) :: this
+        character(len=*), intent(in) :: file_path
+        type(drawing), intent(in):: draw
+        call this%apply_shapes(draw)
+
+        call this%save_to_ppm(file_path)
+    end subroutine save_to_file
+
+    subroutine load_from_ppm(this,file_path)
+        class(bitmap_canvas), intent(inout) :: this
+        character(len=*), intent(in) :: file_path
+        integer :: unit_num, ierr, offset
+        integer :: i, j, width, height, max_color_value
+        integer :: red, green, blue
+        character(len=2) :: magic_number
+        integer :: bytes(3)
+        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
+            stop
+        endif
+
+        read(unit_num, '(a2)') magic_number
+
+        if (magic_number /= 'P6') then
+            print *, "Error reading magic number or not a P6 PPM file"
+            stop
+        endif
+
+        read(unit_num, *) width, height, max_color_value
+
+        if (max_color_value /= (2**rgb_bit_depth-1)) then
+            print *, "Unsupported max color value: ", max_color_value
+            stop
+        endif
+
+        inquire(unit_num, pos=offset)
+
+        close(unit_num)
+
+        call this%init(width,height)
+
+        open(newunit=unit_num, file=file_path, access="stream", status="old")
+
+        read(unit_num, pos=offset-1) ccode
+
+        do j = 0, height - 1
+            do i = 0, width - 1
+            read(unit_num) ccode
+            red = ichar(ccode)
+            read(unit_num) ccode
+            green = ichar(ccode)
+            read(unit_num) ccode
+            blue = ichar(ccode)
+            this%pixels(i, j) = blue + shiftl(green, 8) + shiftl(red, 16)
+            end do
+        end do
+
+        close(unit_num)
+    end subroutine load_from_ppm
+
+    subroutine save_to_ppm(this,file_path)
+        class(bitmap_canvas), intent(inout) :: this
+        character(len=*), intent(in) :: file_path
+        integer :: unit_num, ierr
+        integer :: i,j
+        integer :: bytes(3)
+
+
+        open(newunit=unit_num, file=trim(file_path)//'.ppm', status='replace', action='write', iostat=ierr)
+        if (ierr /= 0) then
+            print *, "Error opening file ", trim(file_path)//'.ppm'
+            stop
+        endif
+
+        write(unit_num, '(a2)') 'P6'
+        write(unit_num, '(i0," ",i0)')  int(this%size%width), int(this%size%height)
+        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)
+
+                write(unit_num, '(3a1)', advance='no') bytes
+            end do
+        end do
+
+        close(unit_num)
+    end subroutine save_to_ppm
+
+    subroutine bitmap_write_shape(canva,sh)
+        class(bitmap_canvas), intent(inout) :: canva
+        class(shape), intent(in) :: sh
+
+        select type(sh)
+        type is (circle)
+            call write_circle(canva, canva%pixels, sh)
+        type is (ellipse)
+            call write_ellipse(canva ,canva%pixels,sh)
+        type is (rectangle)
+            call write_rectangle(canva ,canva%pixels,sh)
+        type is (line)
+            call write_line(canva ,canva%pixels,sh)
+        type is (triangle)
+            call write_triangle(canva ,canva%pixels,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 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
+
+
+    end subroutine apply_shapes
+
+end module fig_bitmap
+