Menu ▾ ▴

Easter Date Calculation with GnuCOBOL & GTK4

GnuCOBOL
Klaus Siebke
2025-03-07
2025-05-27

  • Klaus Siebke

    Klaus Siebke - 2025-03-07

    In addition to my GTK4 minimal example (https://sourceforge.net/p/gnucobol/discussion/cobol/thread/170a0e64d4/#33e1), here is a more comprehensive program that contains everything you need to develop an application:

    • Enter some data
    • Verify the input
    • Process the data
    • Present the result

    It also uses some CSS styles to give the application a more appealing form.

    See the screen shots.

    Here's the program code:

             >>SOURCE FREE
*> Documentation for GTK4: https://docs.gtk.org/gtk4/getting_started.html
*> Compile with:
*> cobc --static -x `pkg-config --libs gtk4` easterdate4.cbl
*> 
*> License: MIT License
*> --------------------
*> 
*> Copyright 2025 Klaus Siebke
*> 
*> 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 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.
*> 
 identification division.
 program-id. easterdate4.
 environment division.    
 configuration section.
 SPECIAL-NAMES.
     CALL-CONVENTION 0 IS STANDARDC.   
 repository.
     function all intrinsic.    
 input-output section.
 file-control.
 data division.
 file section.

 working-storage section.                    
*> **************************************************************** 
 01 result               usage binary-long.
 01 result-boolean       usage binary-long sync.
 01 gtk-xmlfile          usage pointer.
 01 gtk-window-main      usage pointer.
 01 gtk-entry-buffer     usage pointer. 
 01 gtk-entry-year       usage pointer.
 01 gtk-entry-year-value usage pointer.
 01 gtk-lbl-message1     usage pointer.
 01 gtk-lbl-message2     usage pointer.
 01 gtk-notebook         usage pointer.
 01 gtk-builder          usage pointer.
 01 gtk-app              usage pointer.   
 01 gdk-display          usage pointer.
 01 gdk-monitor          usage pointer. 
 01 gdk-surface          usage pointer. 
 01 gtk-native           usage pointer.  
 01 gtk-widget           usage pointer.   
 01 gtk-cssprovider      usage pointer. 
 01 icon_theme           usage pointer.  
 01 g-connect-id         usage binary-long unsigned sync.
 01 gtk-callback         program-pointer.     
 01 gtk-button           usage pointer.      
 01 css-priority         usage binary-long.   
 01 window-width         usage binary-long.  
 01 window-height        usage binary-long.   
 01 pid                  pic 9(5) value 00000.
 01 ipid                 usage binary-long.
 01 easter-year-x        pic x(4).
 01 easter-year  redefines easter-year-x pic 9(4).  
 01 easter-year-len      pic 9.

 01  wLanguage           pic x(16) value space.
 01  wUserName           pic x(16) value space.

*>Fields for Easter Date calculation
 01  ACCEPT-YEAR            PIC 9(08).                         
 01  WORKING-FIELDS     COMP.                                  
     05 TGT-YEAR            PIC S9(08).                        
     05 GOLDEN-NUMBER       PIC S9(08).                        
     05 TGT-CENTURY         PIC S9(08).                        
     05 LEAP-YEAR-CRCTN     PIC S9(08).                        
     05 MOON-SYNC-CRCTN     PIC S9(08).                        
     05 FIRST-SUNDAY        PIC S9(08).                        
     05 EPACT               PIC S9(08).                        
     05 FULL-MOON           PIC S9(08).                        
     05 EASTER-SUNDAY       PIC S9(08).                        
 01  DISPLAY-FIELDS.                                           
     05 TGT-YEAR-DSP        PIC Z(08)-.                        
     05 EASTER-MONTH        PIC X(06).                         
      05 EASTER-SUNDAY-DSP   PIC Z(02)-.  
 01  msgdisplay.                            
     05 msg-txt             PIC X(20) VALUE "Easter Date is".
     05 msg-month           PIC X(06).
     05 msg-day             PIC ZZ.   
     05 filler              PIC X(01) VALUE x"00".

 01  ws-message. 
     05 msg-text            PIC X(40).  
     05 filler              PIC X(01) VALUE x"00".


 linkage section.
*> ****************************************************************  
 01 gtk-appl             usage pointer.           
 01 gtk-win              usage pointer.
 01 gtk-dat              usage pointer.             


 01 gdk-rectangle        usage pointer. 
    05 gkd-rect-x        usage binary-long unsigned sync.     
    05 gkd-rect-y        usage binary-long unsigned sync. 
    05 gkd-rect-width    usage binary-long unsigned sync.     
    05 gkd-rect-height   usage binary-long unsigned sync.       



 procedure division.
*> *****************************************************************
*>     Main program
*> *****************************************************************
*>*****************************************************************

*> get the pid
   call "C$GETPID" returning ipid
   move ipid to pid
*>  display "pid:" pid end-display
   ACCEPT wUserName FROM USER NAME end-accept
   ACCEPT wLanguage FROM ENVIRONMENT "LANG" END-ACCEPT

*> init Gtk            
    call "gtk_init_check" using
        by value 0
        by reference null
        returning result
     end-call

     if result not equal 1  *> 1: TRUE
        display 
          "Gtk could not be initialized - Program terminated" 
        end-display
        stop run
     end-if 

*> get reference to app
     call "gtk_application_new" using
        by content z"com.siebke.easterdate"         
        by value 0            
        returning gtk-app
     end-call

     set gtk-callback to entry "activate_my_app"
     call "g_signal_connect_data" using
       by value gtk-app
       by content z"activate"         *> with inline Z string                     
       by value gtk-callback          *> function call back pointer
       by reference NULL
       returning g-connect-id 
    end-call                      

    call "g_application_run" using
        by value gtk-app
        by value 0
        by reference null                           
        returning result
     end-call

*> Something terminated the GTK main loop: wrap up
*>   stop run.          *> does not work here ...  
     EXIT PROGRAM.      *> ... use EXIT PROGRAM instead   


*> *****************************************************************
*>     Callbacks
*> *****************************************************************

*> -----------------------------------------------------
 ENTRY  STANDARDC "activate_my_app" USING 
     by reference gtk-appl by value gtk-dat.     


*> get reference to default display             
     call "gdk_display_get_default" 
        returning gdk-display
     end-call  

     call "gtk_icon_theme_get_for_display" using
        by value gdk-display
        returning icon_theme
     end-call    


     call "gtk_icon_theme_add_search_path" using
        by value icon_theme
*>        by content z"/storage/source/gnucobol/gtk_4/"
        by content z"."        
     end-call               


*> load the default icon for the windows
     call "gtk_window_set_default_icon_name" using
       by content z"Easter_icon"
     end-call

*> ************
*> CSS Handling
*> ************

     call "gtk_css_provider_new" 
        returning  gtk-cssprovider
     end-call     

     call "gtk_css_provider_load_from_path" using
        by value gtk-cssprovider
        by content z"guistyle.css"
         by reference null
     end-call     

     call "gdk_display_get_default" 
        returning  gdk-display
     end-call             

     move 600 to css-priority           

     call "gtk_style_context_add_provider_for_display" using
        by value gdk-display
        by value gtk-cssprovider
        by value css-priority   
     end-call        

*> load the xml ui file with the screen layout
     call "gtk_builder_new_from_file" using
       by content z"frmeaster.ui"
       returning gtk-builder             
     end-call

*> get reference to main windows                
     call "gtk_builder_get_object" using
        by value gtk-builder
        by content z"winEaster"
        returning gtk-window-main
     end-call

*> get reference to input field for easter year             
     call "gtk_builder_get_object" using
        by value gtk-builder
        by content z"entYEARE"
        returning gtk-entry-year 
     end-call

*> get reference to message label on first tab            
     call "gtk_builder_get_object" using
        by value gtk-builder
        by content z"lblMESS1"
        returning gtk-lbl-message1 
     end-call

*> get reference to message label on second tab            
     call "gtk_builder_get_object" using
        by value gtk-builder
        by content z"lblMESS2"
        returning gtk-lbl-message2
     end-call

*> get reference to notebook containing the screens           
     call "gtk_builder_get_object" using
        by value gtk-builder
        by content z"nbkSCRNS"
        returning gtk-notebook
     end-call

*> get reference to back button      
     call "gtk_builder_get_object" using
        by value gtk-builder
        by content z"btnBack"
        returning gtk-button
     end-call     

     call "g_object_unref" using
        by value gtk-builder
     end-call

     call "gtk_window_set_application" using
        by value gtk-window-main
        by reference gtk-appl
     end-call

     call "gtk_window_present" using
        by value gtk-window-main
     end-call

 goback.          

*> -----------------------------------------------------
 ENTRY STANDARDC "on_btnCalc_clicked" USING 
     by value gtk-win by value gtk-dat.


   call "gtk_label_set_text" using
      by value gtk-lbl-message1
      by content z" "
   end-call   

   call "gtk_editable_get_text" using
      by value gtk-entry-year
      returning gtk-entry-year-value
   end-call   

   move content-of(gtk-entry-year-value)          to easter-year-x
   move LENGTH(content-of(gtk-entry-year-value))  to easter-year-len 

   if easter-year-x(1:easter-year-len) IS NUMERIC
      if easter-year less than 1583        
         call "gtk_label_set_text" using
            by value gtk-lbl-message1
            by content z"Error: Year must be 1583 or later"
         end-call   
      else
*>      Calculate Easter Date
        PERFORM CalcEasterDate thru 
                CalcEasterDateEx 
         call "gtk_label_set_text" using
            by value gtk-lbl-message2
            by content ws-message *> msgdisplay
         end-call   

         call "gtk_notebook_set_current_page" using
            by value gtk-notebook
            by value 1  *>1
         end-call         

         call "gtk_widget_has_default" using
            by value gtk-button
         end-call                                 
   else 
      call "gtk_label_set_text" using
         by value gtk-lbl-message1
         by content z"Error: Year is not numeric"
      end-call         
   end-if

 goback.  


*> -----------------------------------------------------
 ENTRY STANDARDC "on_btnQuit_clicked" USING 
     by value gtk-win by value gtk-dat.

   call "gtk_window_destroy" using
      by value gtk-window-main
   end-call

 goback.  

*> -----------------------------------------------------
 ENTRY STANDARDC "on_btnBack_clicked" USING 
     by value gtk-win by value gtk-dat.

   call "gtk_label_set_text" using
      by value gtk-lbl-message1
      by content z" "
   end-call  

   call "gtk_widget_grab_focus" using
      by value gtk-entry-year 
   end-call

   call "gtk_editable_set_text" using
      by value gtk-entry-year
      by content X"00" *> empty the field
   end-call   

   call "gtk_notebook_set_current_page" using
      by value gtk-notebook
      by value 0
   end-call      

 goback.  

*>*****************************************************************
*>  Subroutines
*>*****************************************************************

 CalcEasterDate.
*>-----------------------------------------------------------------
*> This routine calculates the date of easter for years in the
*> Gregorian calendar. It's a port of the Donald Knuth Algorithm
*> published in Volume 1 of "The Art Of Programming".
*> Author: Paul Chandler, March 2013
*> Source: https://gnucobol.sourceforge.io/faq/index.html#a-real-cobol-computus
*>-----------------------------------------------------------------

           MOVE easter-year TO ACCEPT-YEAR            
           MOVE ACCEPT-YEAR TO TGT-YEAR TGT-YEAR-DSP                  
           COMPUTE GOLDEN-NUMBER   = FUNCTION MOD(TGT-YEAR, 19) + 1   
           COMPUTE TGT-CENTURY     = (TGT-YEAR / 100) + 1             
           COMPUTE LEAP-YEAR-CRCTN = (3 * TGT-CENTURY / 4) - 12       
           COMPUTE MOON-SYNC-CRCTN = ((8 * TGT-CENTURY + 5) / 25) - 5 
           COMPUTE FIRST-SUNDAY    =                                  
               (5 * TGT-YEAR / 4)- LEAP-YEAR-CRCTN - 10               
*>        
*> TO MAKE THE EPACT CALCULATION MORE READABLE, 
*> THE COMPUTATION WILL BE DONE IN STAGES.           
*>

*>                                                               
*> STAGE #1: GET THE RAW NUMBER.....                 
*>                                                               
           COMPUTE EPACT =                                            
               (11 * GOLDEN-NUMBER)                                    
              + 20                                                 
              + MOON-SYNC-CRCTN                                    
              - LEAP-YEAR-CRCTN                                    
*>                                                            
*> STAGE #2: GET THE MOD 30 VALUE...                        
*>                                                            
           COMPUTE EPACT = FUNCTION MOD(EPACT, 30)                 

*>                                                            
*> STAGE #3: TO ENSURE THAT EPACT IS A POSITIVE NBR,       
*>           ADD 30 AND MOD 30 AGAIN.                       

           ADD 30 TO EPACT                                         
           COMPUTE EPACT = FUNCTION MOD(EPACT, 30)                 
*>                                                        
*> ADJUST FOR YEARS WHEN ORTHODOX DIFFERS             
*>                                                        
           IF (EPACT = 25 AND GOLDEN-NUMBER > 11)              
           OR (EPACT = 24)                                     
              ADD 1 TO EPACT                                   
           END-IF                                              
*>                                                        
*> NEXT TWO STATEMENTS FIND FIRST FULL MOON AFTER MAR.21
*>                                                        
           SUBTRACT EPACT FROM 44 GIVING FULL-MOON              
           IF  EPACT  > 23                                      
               ADD 30 TO FULL-MOON                              
           END-IF                                               
*>                                                         
*> ADVANCE SUNDAY TO THE FIRST SUNDAY AFTER FULL MOON   
*>                                                         
           COMPUTE EASTER-SUNDAY =                              
               FULL-MOON                                        
             + 7                                                
             - (FUNCTION MOD((FIRST-SUNDAY + FULL-MOON), 7))    
*>                                                         
*> IF EASTER-SUNDAY > 31, EASTER IS IN APRIL - MOVE THE    
*> MONTH TO APRIL AND SUBTRACT 31 FROM THE MONTH.          
*> OTHERWISE EASTER IS IN MARCH, USE THE DAY AS IS.        
*>                                                         
           IF  EASTER-SUNDAY > 31                               
               MOVE 'April' TO msg-month  *>EASTER-MONTH                     
               SUBTRACT 31 FROM EASTER-SUNDAY                   
           ELSE                                                 
               MOVE 'March' TO msg-month  *>EASTER-MONTH                     
           END-IF                                               
           MOVE EASTER-SUNDAY TO msg-day  *>EASTER-SUNDAY-DSP  

             move concatenate(trim(msg-txt) " " msg-month " " 
                  msg-day " " easter-year) 
                  to  msg-text     

           continue.
 CalcEasterDateEx.
   exit.

    Because some binary files (images) are needed, I have added a zip file with the complete directory structure.
    Just unpack it and compile it with

    cobc --static -x pkg-config --libs gtk4 easterdate4.cbl

    I have tested it under Fedora 40 and Debian 12.

     

    Last edit: Klaus Siebke 2025-05-27
    easterdate4.zip

    • Simon Sobisch

      Simon Sobisch - 2025-05-22

      Klaus, that would be a good entry for the examples in the contrib repo (same for the simple example if it isn't in yet). Would you mind adding a license now and upload it there? Maybe you prefer someone else to do the commit?

       

      • Klaus Siebke

        Klaus Siebke - 2025-05-27

        Simon, sorry for the late reply - too much other work on my desk ....
        I have added a license in both, the simple example and the easterdate calculation.
        Not sure, as I am not a lawyer, but I think that the MIT License grants the greatest freedom for everyone.
        I am not familiar with the contrib repo. Could someone else move it to the right place?

         

  • Batista Silva

    Batista Silva - 2025-05-21

    Thanks to share...
    Very useful...!

     

Log in to post a comment.

Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.