Initial code commit

1 files changed, 664 insertions, 0 deletions

diff --git a/pptxml.f90 b/pptxml.f90
new file mode 100644
index 0000000..c785bb8
--- /dev/null
+++ b/pptxml.f90
@@ -0,0 +1,664 @@
+! Copyright (c) 2022 Approximatrix, LLC <support@approximatrix.com>
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy
+! of this software and associated documentation files (the "Software"), to deal
+! in the Software without restriction, including without limitation the rights
+! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+! copies of the Software, and to permit persons to whom the Software is
+! furnished to do so, subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in
+! all copies or substantial portions of the Software.
+!
+! The Software shall be used for Good, not Evil.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+! SOFTWARE.
+
+module fpoint_pptxml
+use FoX_dom
+implicit none
+
+    private
+    public::slide
+
+    integer, parameter::list_single_bullet_max_length = 512
+
+    integer, parameter::SLIDENUM_UNKNOWN        = 0
+    integer, parameter::SLIDENUM_DOESNOTEXIST   = -1
+    integer, parameter::SLIDENUM_ERRORPARSING   = -2
+
+    character(*), parameter::presentation_schema = "http://schemas.openxmlformats.org/presentationml/2006/main"
+    character(*), parameter::drawing_schema = "http://schemas.openxmlformats.org/drawingml/2006/main"
+
+    type::slide
+
+        integer::number
+        
+        character(len=:), pointer::title
+
+        type(Node), pointer::slide_dom
+        class(element), pointer::content
+
+        contains 
+            
+        procedure :: load => slide_load_filename
+        procedure :: to_text => slide_to_text
+        procedure :: text_length => slide_text_length
+        
+    end type slide
+    
+    type, abstract::element
+        class(element), pointer :: next
+        contains
+        procedure(from_node), deferred :: from_node
+        procedure(to_text), deferred :: to_text
+        procedure :: length => element_text_length
+    end type element
+    
+    abstract interface
+        function to_text(self)
+        import::element
+        class(element), intent(in)::self
+        character(len=:), pointer::to_text
+        end function to_text
+    end interface
+    
+    abstract interface
+        subroutine from_node(self, n)
+        use FoX_dom
+        import::element
+        class(element), intent(inout)::self
+        type(Node), pointer::n
+        end subroutine from_node
+    end interface
+    
+    type, extends(element)::text_element
+        character(len=:), pointer::text
+        contains
+        procedure::to_text => text_element_to_text
+        procedure::from_node => text_element_from_node
+    end type text_element
+    
+    type, extends(text_element)::heading_element
+        contains
+        procedure::to_text => heading_element_to_text
+    end type heading_element
+    
+    type, extends(element)::list_element
+        character(len=list_single_bullet_max_length), dimension(:), pointer::text
+        contains
+        procedure::to_text => list_element_to_text
+        procedure::from_node => list_element_from_node
+    end type list_element
+    
+contains
+
+    function get_child_text(n) result(t)
+    use FoX_dom
+    implicit none
+    
+        type(Node), pointer::n, tn
+        character(len=:), pointer::t, resize_t
+        type(NodeList), pointer::text_nodes
+        
+        text_nodes => getElementsByTagNameNS(n, drawing_schema, "t")
+        if(getLength(text_nodes) >= 1) then
+            tn => item(text_nodes, 0)
+            allocate(character(len=1024) :: resize_t)
+            call extractDataContent(tn, resize_t)
+            allocate(character(len=len_trim(resize_t)) :: t)
+            t = resize_t
+            deallocate(resize_t)
+        end if
+        
+    end function get_child_text
+    
+    function find_slide_title(dom) result(t)
+    use FoX_dom
+    implicit none
+    
+        type(Node), pointer::dom
+        character(len=:), pointer::t
+    
+        type(NodeList), pointer::nonvis_props
+        type(Node), pointer::one_props, sp, nonvis_sp
+        character(len=6)::temp
+        integer::i
+    
+        t => null()
+        nonvis_props => getElementsByTagNameNS(dom, presentation_schema, "cNvPr")
+        
+        do i=1, getLength(nonvis_props)
+            one_props => item(nonvis_props, i-1)
+            if(hasAttribute(one_props, "name")) then
+                temp = getAttribute(one_props, "name")
+                if(temp(1:6) == "Title ") then
+                    exit
+                end if
+            end if
+            one_props => null()
+        end do
+        
+        if(associated(one_props)) then
+            nonvis_sp => getParentNode(one_props)
+            sp => getParentNode(nonvis_sp)
+            if(associated(sp)) then
+                t => concatenated_text_in_rows(getElementsByTagNameNS(sp, drawing_schema, "r"))
+            end if
+        end if
+        
+    end function find_slide_title
+
+    function parse_one_sp_node(n) result(e)
+    use FoX_dom
+    implicit none
+    
+        type(Node), pointer::n
+        class(element), pointer::e
+        
+        type(heading_element), pointer::he
+        type(text_element), pointer::te
+        type(list_element), pointer::le
+        
+        type(NodeList), pointer::nonvis_sp, bullet_defns
+        type(Node), pointer::prop_node
+        
+        integer::i
+        
+        e => null()
+        
+        nonvis_sp => getElementsByTagNameNS(n, presentation_schema, "cNvPr")
+        do i=1, getLength(nonvis_sp) 
+            prop_node => item(nonvis_sp, i-1)
+            
+            ! Try based on property name
+            if(hasAttribute(prop_node, "name")) then
+                
+                ! if "Title" or "Subtitle" is present
+                if(index(getAttribute(prop_node, "name"), "itle") > 0) then
+                    allocate(he)
+                    call he%from_node(n)
+                    e => he
+                    exit
+                end if
+            
+            end if
+            
+        end do
+        
+        ! Next, check for bullets
+        if(.not. associated(e)) then
+            bullet_defns => getElementsByTagNameNS(n, drawing_schema, "cNvPr")
+            if(associated(bullet_defns)) then
+                if(getLength(bullet_defns) > 0) then
+                    allocate(le)
+                    call le%from_node(n)
+                    e => le
+                end if
+            end if
+        end if
+        
+        if(.not. associated(e)) then
+            bullet_defns => getElementsByTagNameNS(n, drawing_schema, "lstStyle")
+            if(associated(bullet_defns)) then
+                if(getLength(bullet_defns) > 0) then
+                    allocate(le)
+                    call le%from_node(n)
+                    e => le
+                end if
+            end if
+        end if
+        
+        ! Finally, try treating as a text node
+        if(.not. associated(e)) then
+            allocate(te)
+            call te%from_node(n)
+            e=>te
+        end if
+        
+        if(associated(e)) then
+            if(e%length() == 0) then
+                deallocate(e)
+                e => null()
+            else
+                e%next => null()
+            end if
+        end if
+
+    end function parse_one_sp_node
+    
+    recursive function walk_sp_tree(parent) result(elements)
+    use FoX_dom
+    implicit none
+    
+        type(Node), pointer::parent
+        class(element), pointer::elements
+        
+        type(Node), pointer::one_child
+        type(NodeList), pointer::child_nodes
+        class(element), pointer::child_elements, walker
+        integer::i
+        type(DomException)::fex
+        character(32)::tname
+        
+        elements => null()
+        
+        child_nodes => getChildNodes(parent)
+        do i = 1, getLength(child_nodes)
+            one_child => item(child_nodes, i-1)
+            
+            child_elements => null()
+            
+            tname = getTagName(one_child, fex)
+            
+            if(.not. inException(fex)) then
+                ! Single sp
+                if(trim(tname) == "p:sp") then
+                    child_elements => parse_one_sp_node(one_child)
+                
+                ! A group of sp's
+                elseif(trim(tname) == "p:grpSp") then
+                    child_elements => walk_sp_tree(one_child)
+                    
+                end if
+                
+                if(associated(child_elements)) then
+                
+                    ! Append
+                    if(associated(elements)) then
+
+                        walker => elements
+                        do while(associated(walker%next))
+                            walker => walker%next
+                        end do
+                        walker%next => child_elements
+                    
+                    ! First one!
+                    else
+                        elements => child_elements
+                    end if
+                    
+                end if
+            end if
+            
+        end do
+    
+    end function walk_sp_tree
+    
+    subroutine parse_slide_sp(self)
+    use FoX_dom
+    implicit none
+    
+        class(slide), intent(inout)::self
+        
+        type(NodeList), pointer::nl
+        type(Node), pointer::sptree
+        
+        nl => getElementsByTagNameNS(self%slide_dom, &
+                                     presentation_schema, "spTree")
+        
+        self%content => null()
+        if(associated(nl)) then
+            if(getLength(nl) >= 1) then
+                sptree => item(nl, 0)
+                self%content => walk_sp_tree(sptree)
+            end if
+        end if
+    
+    end subroutine parse_slide_sp
+
+    subroutine slide_load_filename(self, filename)
+    use FoX_dom
+    implicit none
+    
+        class(slide), intent(out)::self
+        character(len=*), intent(in)::filename
+        character(len=:), pointer::filename_no_backslashes
+        
+        ! For parsing the title out
+        type(NodeList), pointer::sp_elements
+        type(Node), pointer::title_parent
+        
+        integer::ext, startnum, ios
+        logical::existence
+        
+        integer::i
+        
+        class(element), pointer::walker, tmp
+        
+        self%number = SLIDENUM_UNKNOWN
+
+        inquire(file=filename, exist=existence)
+        if(.not. existence) then
+            self%number = SLIDENUM_DOESNOTEXIST
+            return
+        end if
+        
+        ext = index(filename, ".xml", back=.true.)
+        if(ext >= 1) then
+            startnum = index(filename(1:ext), "slide", back=.true.)
+            if(startnum >= 1) then
+                startnum = startnum + 5
+                read(filename(startnum:ext-1), *, iostat=ios) self%number
+            end if
+        end if
+        
+        ! Now actually load the xml
+        if(index(filename, "\") > 0) then
+            allocate(character(len=len_trim(filename))::filename_no_backslashes)
+            filename_no_backslashes = filename
+            i = index(filename_no_backslashes, '\')
+            do while(i > 0)
+                filename_no_backslashes(i:i) = '/'
+                i = index(filename_no_backslashes, '\')
+            end do
+            ! This was all very stupid...
+            self%slide_dom => parseFile(filename_no_backslashes)
+            deallocate(filename_no_backslashes)
+        else
+            self%slide_dom => parseFile(filename)
+        end if
+        if(.not. associated(self%slide_dom)) then
+            self%number = SLIDENUM_ERRORPARSING
+            return
+        end if
+
+        self%title => find_slide_title(self%slide_dom)
+        if(.not. associated(self%title) .and. self%number > 0) then
+            allocate(character(len=16)::self%title)
+            write(self%title, '(I8)') self%number
+            self%title = "Slide "//trim(adjustl(self%title))
+        end if
+        
+        call parse_slide_sp(self)
+        
+        ! This gets rid of double-accounting for the title
+        if(associated(self%content) .and. associated(self%title)) then
+            tmp => null()
+            walker => self%content
+            do while(associated(walker))
+                if(self%content%to_text() == "## "//self%title) then
+                    if(.not.associated(tmp)) then
+                        self%content => walker%next
+                    else
+                        tmp%next => walker%next
+                    end if
+                    deallocate(walker)
+                    exit
+                end if
+                tmp => walker
+                walker => walker%next
+            end do
+        end if
+        
+    end subroutine slide_load_filename
+
+    function element_text_length(self)
+    implicit none
+    
+        class(element), intent(in)::self
+        integer::element_text_length
+        character(len=:), pointer::text_temp
+        
+        text_temp => self%to_text()
+        if(associated(text_temp)) then
+            element_text_length = len_trim(text_temp)
+            deallocate(text_temp)
+        else
+            element_text_length = 0
+        end if
+        
+    end function element_text_length
+    
+    function heading_element_to_text(self) result(t)
+    implicit none
+    
+        class(heading_element), intent(in)::self
+        character(len=:), pointer::t
+
+        t => null()
+        if(associated(self%text)) then
+            allocate(character(len=len_trim(self%text)+3) :: t)
+            t = "## "//self%text
+        end if
+        
+    end function heading_element_to_text
+    
+    function text_element_to_text(self) result(t)
+    implicit none
+    
+        class(text_element), intent(in)::self
+        character(len=:), pointer::t
+
+        t => null()
+        if(associated(self%text)) then
+            allocate(character(len=len_trim(self%text)) :: t)
+            t = self%text
+        end if
+    end function text_element_to_text
+    
+    function concatenated_text_in_row(r) result(t)
+    use FoX_dom
+    implicit none
+    
+        type(Node), pointer::r
+        character(len=:), pointer::t
+        type(NodeList), pointer::text_nodes
+        type(Node), pointer::tn, bairn
+        integer::i, text_length, j
+        
+        text_length = 0
+        text_nodes => getElementsByTagNameNS(r, drawing_schema, "t")
+        do i = 1, getLength(text_nodes)
+            tn => item(text_nodes, i-1)
+            do j = 1, getLength(getChildNodes(tn))
+                bairn => item(getChildNodes(tn), i-1)
+                text_length = text_length + len(getNodeValue(bairn))
+            end do
+        end do
+        
+        allocate(character(len=text_length)::t)
+        text_length = 1
+        do i = 1, getLength(text_nodes)
+            tn => item(text_nodes, i-1)
+            do j = 1, getLength(getChildNodes(tn))
+                bairn => item(getChildNodes(tn), i-1)
+                
+                t(text_length:len(t)) = getNodeValue(bairn)
+                text_length = text_length + len(getNodeValue(bairn))
+            end do
+            
+        end do
+    
+    end function concatenated_text_in_row
+    
+    function concatenated_text_in_rows(rows) result(t)
+    implicit none
+    
+        type(NodeList), pointer::rows
+        character(len=:), pointer::t
+        
+        character(len=:), pointer::one_row_text
+        integer::i, text_length
+        
+        t => null()
+        if(getLength(rows) == 0) then
+            return
+        end if
+        
+        text_length = 0
+        do i = 1, getLength(rows)
+            one_row_text => concatenated_text_in_row(item(rows, i-1))
+            if(associated(one_row_text)) then
+                text_length = text_length + len(one_row_text)
+                deallocate(one_row_text)
+            end if
+        end do
+        
+        allocate(character(len=text_length) :: t)
+        text_length = 1
+        do i = 1, getLength(rows)
+            one_row_text => concatenated_text_in_row(item(rows, i-1))
+            if(associated(one_row_text)) then
+                t(text_length:len(t)) = one_row_text
+                text_length = text_length + len(one_row_text)
+                deallocate(one_row_text)
+            end if
+        end do
+        
+    end function concatenated_text_in_rows
+    
+    subroutine text_element_from_node(self, n)
+    use FoX_dom
+    implicit none
+    
+        class(text_element), intent(inout)::self
+        type(Node), pointer::n
+        type(NodeList), pointer::rows
+        
+        rows => getElementsByTagNameNS(n, drawing_schema, "r")
+        self%text => concatenated_text_in_rows(rows)
+        
+    end subroutine text_element_from_node
+    
+    function slide_to_text(self) result(t)
+    implicit none
+    
+        class(slide), intent(in)::self
+        character(len=:), pointer::t
+        
+        character(len=:), pointer::one_element
+        class(element), pointer::walker
+        integer::text_length
+        
+        text_length = 0
+        walker => self%content
+        do while(associated(walker))
+            text_length = text_length + walker%length() + 2*len(new_line(' '))
+            walker => walker%next
+        end do
+        
+        if(associated(self%title)) then
+            text_length = text_length + 2 + len_trim(self%title) + 2*len(new_line(' ')) + 2
+        end if
+        
+        allocate(character(len=text_length) :: t)
+        t = " "
+        text_length = 1
+        
+        if(associated(self%title)) then
+            t = "# "//trim(self%title)//repeat(new_line(' '),2)
+            text_length = text_length + 2 + len_trim(self%title) + 2*len(new_line(' '))
+        end if
+        
+        walker => self%content
+        do while(associated(walker))
+            one_element => walker%to_text()
+            if(associated(one_element)) then
+                t(text_length:len(t)) = one_element//repeat(new_line(' '),2)
+                text_length = text_length + len_trim(one_element) + 2*len(new_line(' '))
+                deallocate(one_element)
+            end if
+            walker => walker%next
+        end do
+    
+    end function slide_to_text
+        
+    function slide_text_length(self)
+    implicit none
+    
+        class(slide), intent(in)::self
+        integer::slide_text_length
+        
+        character(len=:), pointer::tmp
+        
+        tmp => self%to_text()
+        if(associated(tmp)) then
+            slide_text_length = len_trim(tmp)
+        else
+            slide_text_length =  0
+        end if
+        
+    end function slide_text_length
+        
+    subroutine list_element_from_node(self, n)
+    use FoX_dom
+    implicit none
+    
+        class(list_element), intent(inout)::self
+        type(Node), pointer::n
+        
+        character(len=:), pointer::one_text
+        integer::i, j
+        type(NodeList), pointer::p_nodes, row_nodes
+        type(Node), pointer:: one_p
+        
+        character(len=list_single_bullet_max_length), dimension(:), pointer::tmp
+        
+        p_nodes => getElementsByTagNameNS(n, drawing_schema, "p")
+        allocate(tmp(getLength(p_nodes)))
+        tmp = " "
+        
+        j = 0
+        do i = 1, getLength(p_nodes)
+            one_p => item(p_nodes, i-1)
+            row_nodes => getElementsByTagNameNS(one_p, drawing_schema, "r")
+            one_text => concatenated_text_in_rows(row_nodes)
+            if(associated(one_text)) then
+                if(len_trim(one_text) > 0) then
+                    j = j + 1
+                    tmp(j) = one_text
+                end if
+                deallocate(one_text)
+            end if
+        end do
+        
+        ! j now holds the number of bullets with actual text
+        allocate(self%text(j))
+        self%text = tmp(1:j)
+        deallocate(tmp)
+        
+    end subroutine list_element_from_node
+    
+    function list_element_to_text(self) result(t)
+    implicit none
+    
+        class(list_element), intent(in)::self
+        character(len=:), pointer::t
+    
+        integer::i, text_length
+    
+        t => null()
+        if(.not. associated(self%text)) then
+            return
+        end if
+    
+        text_length = 0
+        do i = 1, size(self%text)
+            text_length = text_length + &
+                          len_trim(self%text(i)) + &
+                          len(new_line(' ')) + 2
+        end do
+        
+        allocate(character(len=text_length) :: t)
+        t = " "
+        
+        text_length = 1
+        do i = 1, size(self%text)
+            if(i < size(self%text)) then
+                t(text_length:len(t)) = "* "//trim(self%text(i))//new_line(' ')
+                text_length = text_length + len(new_line(' ')) + len_trim(self%text(i))+2
+            else
+                t(text_length:len(t)) = "* "//trim(self%text(i))
+            end if
+        end do
+    
+    end function list_element_to_text
+
+end module fpoint_pptxml
\ No newline at end of file