c fortran GraphApp test

c special G77 functions are
c %loc(i) gives the adress of (value)i
c %val(i) gives the value  of (adress)i

c      declarations of GraphApp functions
       integer new_window
       integer new_menu_bar,new_menu,new_menu_item

c      locals
       integer window,rect,mode
       integer menu,menufile,menuhelp
       integer menufilequit
       integer menuhelpabout,menuhelphelp
       integer newlistbox
       integer newtextbox
       common /textbox/ newtextbox
       integer newbutton

c      CallBack functions
       external help,about,quit,listboxitem,button

c      declaration of Rect .
       dimension rect(4)
c      left x ,top y , breedte , hoogte
       rect(1)=100
       rect(2)=200
       rect(3)=300
       rect(4)=100
c      define NORMALWINDOW
       mode = Z'000003F0'
       write(6,*)'Get start Call-Back system'
       call graph_start()
       write(6,*)'Is started'

C      set a window
       window=new_window(rect,'List window',mode)
       write(6,*)'Has window',window
c      set the menu
       menu=new_menu_bar(window)
       write(6,*)'Has bar',menu
c      set the menu objects
       menufile=new_menu(menu,'File')
       write(6,*)'Has file',menufile
       menuhelp=new_menu(menu,'Help')
       write(6,*)'Has help',menuhelp
c      set the menu items
       menufilequit=new_menu_item(menufile,'Quit','Q',quit)
       write(6,*)'Has menu quit',menufilequit
       menuhelpabout=new_menu_item(menuhelp,'About','A',about)
       write(6,*)'Has menu about',menuhelpabout
       menuhelphelp =new_menu_item(menuhelp,'Help','H',help)
       write(6,*)'Has menu help',menuhelphelp

c      listbox
c      left x ,top y , breedte , hoogte
       rect(1)=05
       rect(2)=30
       rect(3)=100
       rect(4)=75
       newlistbox=new_list_box(window,rect,'1e regel',listboxitem)
c       newlistbox=new_list_box(window,rect,'',listboxitem)
       write(6,*)'Has list box',newlistbox
       call add_list_item(newlistbox,'Deze regel is veel langer')
       call add_list_item(newlistbox,'regel 3e is langer')

c      textbox
c      left x ,top y , breedte , hoogte
       rect(1)=05
       rect(2)=30+75+5
       rect(3)=200
       rect(4)=25
       newtextbox=new_text_box(window,rect,'edit regel')
       write(6,*)'Has text box',newtextbox

c      button
c      left x ,top y , breedte , hoogte
       rect(1)=215
       rect(2)=30+75+5
       rect(3)=90
       rect(4)=20
       newbuttom=new_button(window,rect,'show text',button)
       write(6,*)'Has buttom',newbuttom

c      show what we has done .
       call show_window(window)
       write(6,*)'Show window'

c      main loop
       call main_loop()

c      end main loop
       write(6,*)'end mainloop'
       call graph_stop()
       write(6,*)'Stopped main program'
       end
c ------------------------------------------------------------------------
c      CallBack quit function
       subroutine quit(i)
       integer i
c      remember Fortran uses call by reference
c      so it is a value and not the adres of struct MenuItem
c      the first value of MenuItem is Menu * parent;
       write(6,*)%loc(i)
       write(6,*)'end mainloop'
       call graph_stop()
       write(6,*)'Stopped'
       stop
       end
c ------------------------------------------------------------------------
c      CallBack help function
c       integer function help(i)
       subroutine help(i)
       integer i
c      remember Fortran uses call by reference
c      so it is a value and not the adres of struct MenuItem
c      the first value of MenuItem is Menu * parent;
       write(6,*)%loc(i)
       call ask_oke('help','List box toepassing')
c       help=0
       end
c ------------------------------------------------------------------------
C      CallBack about function
c       integer function about(i)
       subroutine about(i)
       integer i
       integer menuhelpabout
c      remember Fortran uses call by reference
c      so it is a value and not the adres of struct MenuItem
c      the first value of MenuItem is Menu * parent;
       menuhelpabout = %loc(i)
       write(6,*)menuhelpabout
       call ask_oke('About','Wrap voor GraphApp in Fortran\n'//
     1 'Poging 1 24-03-2006 door Menno Ter Haseborg')
c       about=0
       end 
c ------------------------------------------------------------------------
       subroutine listboxitem(c)
       integer c,Control,item,get_list_box_item
       Control=%loc(c)
       item = get_list_box_item(Control)
       write(6,*)'Control = ',Control,' selected item = ',item
       if (item.lt.0) then
       call ask_oke('List Box','Niets geselecteerd')
       elseif(item.eq.0)then
       call ask_oke('List Box','Item 1')
       elseif(item.eq.1)then
       call ask_oke('List Box','Item 2')
       elseif(item.eq.2)then
       call ask_oke('List Box','Item 3')
       else
       call ask_oke('List Box','Dit mag niet voorkomen')
       endif
       end
c ------------------------------------------------------------------------
       subroutine button(C)
       character *25 text,get_control_text
       integer control,C
       integer newtextbox
       common /textbox/ newtextbox
       control=%loc(C)
       text=get_control_text(newtextbox)
       write(6,*)'text = ',text
       call ask_oke('Text box',text)
       end
c ------------------------------------------------------------------------