Initial commit of an AppGraphics renderer that actually works, though it doesn't scroll or allow url entry.

5 files changed, 560 insertions, 17 deletions

diff --git a/ag_render.f90 b/ag_render.f90
new file mode 100644
index 0000000..4d9be55
--- /dev/null
+++ b/ag_render.f90
@@ -0,0 +1,514 @@
+! Copyright (c) 2020 Jeffrey Armstrong <jeff@rainbow-100.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 ag_render
+use render
+use appgraphics
+implicit none
+
+    integer, parameter::default_width = 600
+    integer, parameter::default_height = 700
+    
+    integer, parameter::default_font_size = 18
+    
+    integer, parameter::max_links_displayed = 64
+
+    logical, volatile::closed_browser
+    logical, volatile::mouse_clicked
+
+    type :: link
+        integer, dimension(4)::location
+        character(1024)::url
+    end type
+
+    type, extends(renderer) :: appgraphics_renderer
+    
+        integer::window_id
+        
+        integer::font_size
+        integer::default_font
+        integer::line_spacing
+        
+        integer::left_border, right_border
+        integer::bullet_margin
+        
+        integer::text_color
+        integer::link_color
+        integer::background_color
+        
+        integer::link_count
+        type(link), dimension(max_links_displayed)::links
+        
+        contains
+        
+        procedure :: initialize => ag_initialize
+        procedure :: new_page => ag_new_page
+        procedure :: prepare_for_layout => ag_prepare_for_layout
+    
+        procedure :: text_width => ag_text_width
+        procedure :: text_height => ag_text_height
+        procedure :: is_text_visible => ag_text_visible
+        
+        procedure :: draw_porportional => ag_text_draw
+
+        procedure :: preformatted_width => ag_preformatted_width
+        procedure :: preformatted_height => ag_preformatted_height
+        procedure :: is_preformatted_visible => ag_text_visible
+        
+        procedure :: draw_preformatted => ag_preformatted_draw
+    
+        procedure :: link_width => ag_link_width
+        procedure :: link_height => ag_link_height
+        procedure :: is_link_visible => ag_text_visible
+        
+        procedure :: draw_link => ag_link_draw
+        
+        procedure :: request_input => ag_request_input
+        
+        procedure :: draw_error => ag_draw_error
+        
+        procedure :: report_status => ag_draw_status
+        
+        procedure :: request_action => ag_action
+    
+        procedure :: request_save_filename => ag_request_save_filename
+        
+        procedure :: report_displayed_page => ag_report_page
+        
+    end type appgraphics_renderer
+    
+contains
+    
+    subroutine window_closing_callback()
+    implicit none
+    
+        closed_browser = .true.
+        call stopidle()
+        
+    end subroutine window_closing_callback
+    
+    subroutine ag_initialize(self)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        
+        closed_browser = .false.
+        mouse_clicked = .false.
+        
+        self%window_id = initwindow(default_width, default_height, "LR-87", &
+                                    DEFAULT_POSITION, DEFAULT_POSITION, &
+                                    .FALSE., .FALSE.)
+                                    
+        call setwindowclosecallback(window_closing_callback)
+        
+        call registermousehandler(MOUSE_LB_UP, mouse_button_clicked)
+                                    
+        self%background_color = WHITE
+        self%text_color = BLACK
+        self%link_color = BLUE
+        
+        self%max_width = getmaxx()
+        self%font_size = default_font_size
+        self%default_font = SERIF_FONT
+        self%line_spacing = 2
+        self%left_border = 5
+        self%right_border = 5
+        self%bullet_margin = 5
+    
+    end subroutine ag_initialize
+    
+    function get_clicked_link(self)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        integer::get_clicked_link
+        
+        integer::i, mx, my
+        
+        get_clicked_link = -1
+        mx = mousex()
+        my = mousey()
+        
+        do i = 1, self%link_count
+            if(my >= self%links(i)%location(2) .and. my <= self%links(i)%location(4) .and. &
+               mx >= self%links(i)%location(1) .and. mx <= self%links(i)%location(3)) then
+                
+                get_clicked_link = i
+                exit
+            end if
+        end do
+        
+    end function get_clicked_link
+    
+    subroutine mouse_button_clicked(x, y)
+    use appgraphics, only: stopidle
+    implicit none
+    
+        integer::x, y
+    
+        mouse_clicked = .true.
+        call stopidle()
+        
+    end subroutine mouse_button_clicked
+    
+    subroutine ag_prepare_for_layout(self)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        
+        call setbkcolor(self%background_color)
+        call resetviewport()
+        call clearviewport()
+        
+        self%link_count = 0
+        
+    end subroutine ag_prepare_for_layout
+    
+    subroutine ag_new_page(self)
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        
+        self%y = 0
+    
+    end subroutine ag_new_page
+    
+    pure function get_font_size(self, heading)
+    implicit none
+        
+        class(appgraphics_renderer), intent(in)::self
+        integer, intent(in)::heading
+        integer::get_font_size
+    
+        get_font_size = self%font_size
+        if(heading == 1) then
+            get_font_size = 2*get_font_size
+        else if(heading > 1) then
+            get_font_size = (3*get_font_size)/2
+        end if
+        
+    end function get_font_size
+    
+    function ag_text_width(self, text, heading, list_item)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
+        integer::ag_text_width
+        integer::font_size
+        
+        font_size = self%font_size
+        if(present(heading)) then
+            font_size = get_font_size(self, heading)
+        end if
+        
+        call settextstyle(self%default_font, HORIZ_DIR, font_size)
+        if(len_trim(text) > 0) then
+            ag_text_width = textwidth(trim(text))
+        else
+            ag_text_width = 0
+        end if
+        
+        ag_text_width = ag_text_width + self%left_border + self%right_border
+        
+        if(present(list_item)) then
+            if(list_item) then
+                ag_text_width = ag_text_width + self%font_size/2 + 2*self%bullet_margin
+            end if
+        end if
+        
+    end function ag_text_width
+        
+    function ag_text_height(self, text, heading, list_item)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
+        integer::ag_text_height
+        integer::font_size
+        
+        font_size = self%font_size
+        if(present(heading)) then
+            font_size = get_font_size(self, heading)
+        end if
+        
+        call settextstyle(self%default_font, HORIZ_DIR, font_size)
+        if(len_trim(text) > 0) then
+            ag_text_height = textheight(trim(text)) + self%line_spacing
+        else
+            ag_text_height = self%line_spacing + self%font_size
+        end if
+        
+    end function ag_text_height
+    
+    function ag_text_visible(self, text)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        logical::ag_text_visible
+        
+        ag_text_visible = (self%y > 0 .and. self%y < getmaxy())
+    
+    end function ag_text_visible
+    
+    subroutine ag_text_draw(self, text, heading, list_item)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
+        integer::font_size
+        integer::x, bx, by
+        
+        font_size = self%font_size
+        if(present(heading)) then
+            font_size = get_font_size(self, heading)
+        end if
+        
+        x = self%left_border
+        if(present(list_item)) then
+            if(list_item) then
+                bx = x + self%bullet_margin
+                by = self%y + self%font_size/4
+                
+                call setfillstyle(SOLID_FILL, self%text_color)
+                call bar(bx, by, bx+self%font_size/2, by+self%font_size/2)
+                
+                x = bx + self%bullet_margin + self%font_size/2
+            end if
+        end if
+        
+        call settextstyle(self%default_font, HORIZ_DIR, font_size)
+        call setcolor(self%text_color)
+        call outtextxy(x, self%y, trim(text))
+        
+    end subroutine ag_text_draw
+    
+    function ag_link_width(self, text)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer::ag_link_width
+
+        ag_link_width = ag_text_width(self, text)
+        
+    end function ag_link_width
+        
+    function ag_link_height(self, text)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer::ag_link_height
+        
+        ag_link_height = ag_text_height(self, text)
+        
+    end function ag_link_height
+
+    subroutine ag_link_draw(self, text, url)
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text, url
+        integer::text_width
+        
+        call settextstyle(self%default_font, HORIZ_DIR, self%font_size)
+        call setcolor(self%link_color)
+        call outtextxy(self%left_border, self%y, trim(text))
+    
+        text_width = ag_link_width(self, trim(text))
+        call line(self%left_border, self%y + 7*self%font_size/8, &
+                  self%left_border + text_width, self%y + 7*self%font_size/8)
+                  
+        ! Store this link
+        self%link_count = self%link_count + 1
+        if(self%link_count < max_links_displayed) then
+            self%links(self%link_count)%location(1) = self%left_border
+            self%links(self%link_count)%location(2) = self%y
+            
+            self%links(self%link_count)%location(3) = self%left_border + text_width
+            self%links(self%link_count)%location(4) = self%y + self%font_size
+            
+            self%links(self%link_count)%url = url
+        end if
+    
+    end subroutine ag_link_draw
+    
+    function ag_preformatted_width(self, text)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer::ag_preformatted_width
+
+        call settextstyle(MONOSPACE_FONT, HORIZ_DIR, self%font_size)
+        if(len_trim(text) > 0) then
+            ag_preformatted_width = textwidth(trim(text))
+        else
+            ag_preformatted_width = 0
+        end if
+        
+        ag_preformatted_width = ag_preformatted_width + self%left_border + self%right_border
+        
+    end function ag_preformatted_width
+        
+    function ag_preformatted_height(self, text)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        integer::ag_preformatted_height
+
+        
+        call settextstyle(MONOSPACE_FONT, HORIZ_DIR, self%font_size)
+        if(len_trim(text) > 0) then
+            ag_preformatted_height = textheight(trim(text)) + self%line_spacing
+        else
+            ag_preformatted_height = self%font_size + self%line_spacing
+        end if
+        
+    end function ag_preformatted_height
+    
+    subroutine ag_preformatted_draw(self, text)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        
+        call settextstyle(MONOSPACE_FONT, HORIZ_DIR, self%font_size)
+        call setcolor(BLACK)
+        call outtextxy(self%left_border, self%y, trim(text))
+        
+    end subroutine ag_preformatted_draw
+    
+    function ag_request_input(self, question, answer)
+    use appgraphics
+    implicit none
+
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::question
+        character(*), intent(out)::answer
+        logical::ag_request_input
+    
+        ag_request_input = dlgrequesttext(answer, "Input Requested", question)
+    
+    end function ag_request_input
+    
+    subroutine ag_draw_error(self, text)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        
+        call dlgmessage(0, text)
+    
+    end subroutine ag_draw_error
+    
+    subroutine ag_draw_status(self, text)
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        
+        ! Pass for now...
+        
+    end subroutine ag_draw_status
+    
+    function ag_action(self, text)
+    use render, only: render_action_none, render_action_layout, &
+                      render_action_goto, render_action_quit
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        character(*), intent(out)::text
+        integer::ag_action
+        integer::link_clicked
+        
+        ! Pass for now...
+        call startidle(10000)
+        
+        ag_action = render_action_none
+        
+        if(closed_browser) then
+        
+            ag_action = render_action_quit
+        
+        else if(mouse_clicked) then
+        
+            link_clicked = get_clicked_link(self)
+            if(link_clicked > 0) then
+                text = self%links(link_clicked)%url
+                ag_action = render_action_goto
+            end if
+        
+            call clearmouseclick(MOUSE_LB_UP)
+        
+        end if
+        
+    end function ag_action
+    
+    function ag_request_save_filename(self, url, mimetype, filename)
+    use appgraphics
+    implicit none
+        
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::url
+        character(*), intent(in)::mimetype
+        character(*), intent(out)::filename
+        logical::ag_request_save_filename
+        
+        ag_request_save_filename = dlgsavefile(filename)
+        
+    end function ag_request_save_filename
+    
+    subroutine ag_report_page(self, text)
+    use appgraphics
+    implicit none
+    
+        class(appgraphics_renderer)::self
+        character(*), intent(in)::text
+        
+        call setwindowtitle("LR-87 :: "//trim(text))
+    
+    end subroutine ag_report_page
+    
+end module ag_render
diff --git a/dumb_render.f90 b/dumb_render.f90
index 3834e5c..9142159 100644
--- a/dumb_render.f90
+++ b/dumb_render.f90
@@ -70,6 +70,8 @@ implicit none
     
         procedure :: request_save_filename => dumb_request_save_filename
     
+        procedure :: report_displayed_page => dumb_displayed_page
+    
     end type dumb_renderer
     
 contains
@@ -129,8 +131,8 @@ contains
         
         class(dumb_renderer)::self
         character(*), intent(in)::text
-        integer, optional::heading
-        logical, optional::list_item
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
         integer::dumb_text_width
         
         dumb_text_width = len_trim(text)
@@ -148,8 +150,8 @@ contains
         
         class(dumb_renderer)::self
         character(*), intent(in)::text
-        integer, optional::heading
-        logical, optional::list_item
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
         integer::dumb_text_height
         
         dumb_text_height = 1
@@ -224,8 +226,8 @@ contains
     
         class(dumb_renderer)::self
         character(*), intent(in)::text
-        integer, optional::heading
-        logical, optional::list_item
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
         integer::limit_x
         character(5)::formatting
         character(self%max_width)::heading_line
@@ -441,5 +443,14 @@ contains
     
     end function dumb_request_save_filename
     
+    subroutine dumb_displayed_page(self, text)
+    implicit none
+    
+        class(dumb_renderer)::self
+        character(*), intent(in)::text
+        
+        ! Nothing to do in this renderer
+        
+    end subroutine dumb_displayed_page
     
 end module dumb_render
\ No newline at end of file
diff --git a/gemini-windows.prj b/gemini-windows.prj
index 05c7a2e..c53c8ea 100644
--- a/gemini-windows.prj
+++ b/gemini-windows.prj
@@ -30,7 +30,7 @@
     "Name":"+gemini-windows (lr87.exe)",
     "Files":[{
         "filename":".\\ag_render.f90",
-        "enabled":"0"
+        "enabled":"1"
       },{
         "filename":".\\dumb_render.f90",
         "enabled":"1"
@@ -69,7 +69,7 @@
   "Name":"gemini-windows (lr87.exe)",
   "Options":{
     "Compiler Options":{
-      "Fortran Flags":"-DWINDOWS",
+      "Fortran Flags":"-DWINDOWS -DWINDOWS_GUI",
       "Link Flags":"-lssl -lcrypto -lws2_32 -lcrypt32",
       "C Flags":""
     },
diff --git a/main.F90 b/main.F90
index 8fff5de..16da056 100644
--- a/main.F90
+++ b/main.F90
@@ -23,8 +23,12 @@
 program gemini
 use request
 
+#ifdef WINDOWS_GUI
+use ag_render, only: appgraphics_renderer
+#else
 use dumb_render
-!use ag_render, only: appgraphics_renderer
+#endif
+
 use render
 
 use gemini_protocol
@@ -41,9 +45,13 @@ implicit none
     character(256)::initial_site
     character(1024)::current_url, input
     type(connection)::conn
-    type(dumb_renderer)::r
-    !type(appgraphics_renderer)::r
     
+#ifdef WINDOWS_GUI    
+    type(appgraphics_renderer)::r
+#else
+    type(dumb_renderer)::r
+#endif
+
     logical::running
     logical::loaded
     logical::populated
@@ -201,27 +209,35 @@ contains
         
             case (STATUS_LOCALFAIL)
                 call r%report_status("Network failure loading "//trim(url))
+                call r%report_displayed_page("...")
         
             case (STATUS_INPUT)
                 call r%report_status("Ok (input)")
+                call r%report_displayed_page(url)
             
             case (STATUS_SUCCESS)
                 call r%report_status("Ok")
+                call r%report_displayed_page(url)
             
             case (STATUS_REDIRECT)
                 call r%report_status("Ok (redirect)")
+                call r%report_displayed_page(url)
 
             case (STATUS_TEMPFAIL)
                 call r%report_status("Server reports temporary failure")
+                call r%report_displayed_page("...")
                 
             case (STATUS_PERMFAIL)
                 call r%report_status("Server reports permanent failure")
+                call r%report_displayed_page("...")
 
             case (STATUS_CERTREQ)
                 call r%report_status("Server requesting certificate (unsupported)")
+                call r%report_displayed_page("...")
                 
             case (STATUS_BADRESPONSE)
                 call r%report_status("Bad response code from server")
+                call r%report_displayed_page("...")
                 
         end select
         
diff --git a/render.f90 b/render.f90
index 96ec610..80de58b 100644
--- a/render.f90
+++ b/render.f90
@@ -69,6 +69,8 @@ implicit none
         procedure(draw_simple_text), deferred::report_status
 
         procedure(request_action), deferred::request_action
+        
+        procedure(draw_simple_text), deferred::report_displayed_page
 
     end type renderer
 
@@ -98,8 +100,8 @@ implicit none
         import::renderer
         class(renderer)::self
         character(*), intent(in)::text
-        integer, optional::heading
-        logical, optional::list_item
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
         integer::calculate_width
         end function calculate_width
     end interface
@@ -109,8 +111,8 @@ implicit none
         import::renderer
         class(renderer)::self
         character(*), intent(in)::text
-        integer, optional::heading
-        logical, optional::list_item
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
         integer::calculate_height
         end function calculate_height
     end interface
@@ -120,8 +122,8 @@ implicit none
         import::renderer
         class(renderer)::self
         character(*), intent(in)::text
-        integer, optional::heading
-        logical, optional::list_item
+        integer, intent(in), optional::heading
+        logical, intent(in), optional::list_item
         end subroutine draw_text
     end interface