JohnCampbell
Joined: 16 Feb 2006 Posts: 2615 Location: Sydney
|
Posted: Wed Feb 12, 2025 1:25 am Post subject: using contained function as ^callback |
|
|
I was testing using a contained function as a ^ call-back.
It could have the advantage of all variables in the winio@ call are in scope, and the local callback is not in scope for other winio@ blocks.
However, FTN95 9.04 does not allow this approach.
Do you see any benefit in making call-back functions as contained in this way ?
Code: |
!++++ Select
integer function KB_Select_Accnt_ls ()
use menu_data
use quicken_records, only : account_list
include <WINDOWS.INS>
integer :: na
integer :: iw
! integer, external :: kb_select_accnt_ok
call validate_accnt_code_rec
call generate_account_list_ls ( local_ls_list, na )
! generate list of accounts ( uses all accounts )
ls_sel = accnt_no
iw = WINIO@ ( '%ca[Select User Account]&' )
iw = WINIO@ ( '%2nl %20.4ls&', local_ls_list, na, ls_sel )
iw = WINIO@ ( '%ff%2nl&' )
iw = WINIO@ ( '%ta %`^bt[Select]&', kb_select_accnt_ok )
iw = WINIO@ ( '%ta %bt[Skip]' )
if ( iw == 1 ) then
write (*,*) 'Select Account : ',account_list(ls_sel), ls_sel
end if
write (*,11) 'Select_Accnt ', ls_sel, accnt_no, iw
11 format (a,7(2x,i0) )
KB_Select_Accnt_ls = 2
contains
integer function kb_select_accnt_ok ()
use menu_data
accnt_no = ls_sel
kb_select_accnt_ok = 0
end function kb_select_accnt_ok
end function KB_Select_Accnt_ls
[FTN95/x64 Ver. 9.04.0.0 Copyright (c) Silverfrost Ltd 1993-2024]
[Current options] 64;CHECK;ERROR_NUMBERS;IMPLICIT_NONE;INTL;LOGL;
PROCESSING MODULE [<MENU_DATA> FTN95/x64 v9.04.0.0]
NO ERRORS [<GET_LV_HEADER_PIXELS> FTN95 v9.04.0.0]
NO ERRORS [<MENU_DATA> FTN95 v9.04.0.0]
...
0285) iw = WINIO@ ( '%ta %`^bt[Select]&', kb_select_accnt_ok )
*** Error 964: You cannot use the local-routine name, KB_SELECT_ACCNT_OK, as
an actual argument
*** Error 997: An internal FUNCTION, such as KB_SELECT_ACCNT_OK, cannot be
used as an actual argument
2 ERRORS [<KB_SELECT_ACCNT_OK> FTN95 v9.04.0.0]
NO ERRORS [<KB_SELECT_ACCNT_LS> FTN95 v9.04.0.0]
...
*** Compilation failed
|
|
|