1 SUB BASIC_ZILL_BROWSE_SUB OPTION TYPE=EXPLICIT ! ! BASIC_ZILL_BROWSE_SUB.BAS ! ! Stand alone program to allow browsing ! of records for the mega_zillionare example ! application. ! %INCLUDE "MEGA_RECS" %FROM %LIBRARY "MEGA_TEXT_LIB" %INCLUDE "MEGA_INC:FDVDEF.INC" ! FMS definitions %INCLUDE "LIB$ROUTINES" %FROM %LIBRARY !;;;;;;;;;; ! Constants !;;;;;;;;;; DECLARE BYTE CONSTANT draw_chan% = 6% DECLARE BYTE CONSTANT elm_count% = 52% DECLARE STRING CONSTANT drawing_data$ = "MY_MEGA_FILE" !;;;;;;;;;; ! Maps !;;;;;;;;;; MAP (LOCAL_MAP) STRING TRANSLATED_NAME$ = 255% MAP (DRAW_MAP) DRAWING_RECORD DRAW_REC ! ! Record we will use to dimension the scrolling array. ! RECORD SCRN_RECORD STRING F_MARK = 1% STRING DRAW_DT = 10% STRING NUMBERS = 30% STRING MEGA_NO = 2% END RECORD %DEFINE scrn_record_size 43% MAP (LINE_MAP) SCRN_RECORD SCRN_REC MAP (LINE_MAP) STRING SCRN_LINE$ = scrn_record_size DECLARE INTEGER CONSTANT scrn_str_size% = 10% * scrn_record_size MAP (SCRN_MAP) STRING SCRN_STR$ = scrn_str_size% MAP (FMS_MAP) LONG FMSSTATUS%, RMSSTATUS%, TCA%(3%), WORKSPACE%(3%) !;;;;;;;;;; ! Local Variables !;;;;;;;;;; DECLARE BYTE B_DONE%, B_ACTION% DECLARE WORD W_X% DECLARE LONG L_X%, L_ERR%, TERMINATOR%, & L_REC_COUNT%, L_SUB%, L_TOP%, L_BOTTOM% DECLARE STRING WORK_STR$, LOG_TXT$ !;;;;;;;;;; ! Main Logic !;;;;;;;;;; 100 L_ERR% = 0% GOSUB A900_FILL_IN_LOGICALS GOSUB A910_OPEN_FILES IF L_ERR% = 0% THEN L_REC_COUNT% = 0% GOSUB A950_COUNT_RECORDS IF L_REC_COUNT% > 0% THEN GOSUB A920_LOAD_FORM ! ! Get a buffer of the correct size in record format. ! DIM RFA DRAW_RFA( L_REC_COUNT%) GOSUB A960_LOAD_RFA B_ACTION% = 0% ! ! Set the initial display range to the top of the file ! L_TOP% = 1% L_BOTTOM% = 10% WHILE B_ACTION% <> 99% GOSUB A970_USER_ACTION NEXT END IF END IF GOTO PROGRAM_EXIT 900 !;;;;;;;;;; ! Subroutine to fill in logical values ! Ordinarily developers simply "assume" that either ! logicals have been defined or do so in a job stream ! but this will allow the demonstration of service calls. !;;;;;;;;;; A900_FILL_IN_LOGICALS: WORK_STR$ = drawing_data$ TRANSLATED_NAME$ = " " ! destination has to be pre-allocated W_X% = 0% L_X% = LIB$GET_LOGICAL( WORK_STR$, TRANSLATED_NAME$, W_X%,,,,) IF LEN( TRM$( TRANSLATED_NAME$)) < 1 THEN LOG_TXT$ = drawing_data$ + ".IDX" L_X% = LIB$SET_LOGICAL( WORK_STR$, LOG_TXT$,,,) END IF RETURN 910 !;;;;;;;;;; ! Subroutine to open indexed files !;;;;;;;;;; A910_OPEN_FILES: WHEN ERROR IN L_ERR% = 0% OPEN drawing_data$ FOR INPUT AS FILE #draw_chan%, & ORGANIZATION INDEXED FIXED, & ALLOW MODIFY, ACCESS READ, & RECORDTYPE FORTRAN, & RECORDSIZE drawing_record_size, & MAP DRAW_MAP USE L_ERR% = ERR PRINT "Unable to open input file"; drawing_data$ PRINT "Error: ";L_ERR%;" ";ERT$( L_ERR%) END WHEN RETURN 920 !;;;;;;;;;; ! Subroutine to load and display the FMS form !;;;;;;;;;; A920_LOAD_FORM: CALL FDV$SPADA( 0%) CALL FDV$SSIGQ( 0%) ! Set signal mode to bell. CALL FDV$CDISP( "ZILL_BROWSE") ! display our form RETURN 950 !;;;;;;;;;; ! Subroutine to count the records on file. !;;;;;;;;;; A950_COUNT_RECORDS: WHEN ERROR IN L_ERR% = 0% FIND #draw_chan%, KEY # 0% GE " ", REGARDLESS USE L_ERR% = ERR END WHEN WHILE L_ERR% = 0% WHEN ERROR IN L_REC_COUNT% = L_REC_COUNT% + 1% FIND #draw_chan%, REGARDLESS ! find next record via index USE L_ERR% = ERR END WHEN NEXT RETURN 960 !;;;;;;;;;; ! Subroutine to load every record from the flie !;;;;;;;;;; A960_LOAD_RFA: WHEN ERROR IN L_ERR% = 0% GET #draw_chan%, KEY #0% GE " ", REGARDLESS USE L_ERR% = ERR END WHEN L_X% = 1% WHILE L_ERR% = 0% WHEN ERROR IN DRAW_RFA( L_X%) = GETRFA( draw_chan%) L_X% = L_X% + 1% GET #draw_chan%, REGARDLESS USE L_ERR% = ERR END WHEN NEXT RETURN 970 !;;;;;;;;;; ! !;;;;;;;;;; A970_USER_ACTION: GOSUB B1000_LOAD_DISPLAY CALL FDV$PUTAL( SCRN_STR$) CALL FDV$GETAL( WORK_STR$, TERMINATOR%) SELECT TERMINATOR% CASE FDV$K_FK_E6 ! scroll forward L_X% = L_BOTTOM% + 10% IF L_X% <= L_REC_COUNT% THEN L_BOTTOM% = L_X% L_TOP% = L_TOP% + 10% ELSE L_BOTTOM% = L_REC_COUNT% L_TOP% = L_BOTTOM% - 10% CALL FDV$BELL ! let the user know ! it is end of file END IF CASE FDV$K_FK_E5 ! scroll backwards L_X% = L_TOP% - 10% IF L_X% >= 1% THEN L_TOP% = L_X% L_BOTTOM% = L_TOP% + 10% ELSE L_TOP% = 1% L_BOTTOM% = 10% CALL FDV$BELL ! let user know ! top of file END IF CASE FDV$K_FK_F10 B_ACTION% = 99% CASE ELSE ! ignore all other keys END SELECT RETURN 1000 !;;;;;;;;;; ! Subroutine to load the display data !;;;;;;;;;; B1000_LOAD_DISPLAY: WORK_STR$ = "" ! null string to build from SCRN_LINE$ = " " ! space out display buffer WHEN ERROR IN L_ERR% = 0% GET #draw_chan%, RFA DRAW_RFA( L_TOP%) USE L_ERR% = ERR END WHEN L_SUB% = L_TOP% WHILE L_ERR% = 0% AND L_SUB% <= L_BOTTOM% ! Load the data into display line ! SCRN_REC::DRAW_DT = MID$(DRAW_REC::DRAW_DT,5%,2%) + "/" & + RIGHT$(DRAW_REC::DRAW_DT, 7%) + "/" & + LEFT$(DRAW_REC::DRAW_DT, 4%) SCRN_REC::NUMBERS = FORMAT$( DRAW_REC::NO_1, "## ") & + FORMAT$( DRAW_REC::NO_2, "## ") & + FORMAT$( DRAW_REC::NO_3, "## ") & + FORMAT$( DRAW_REC::NO_4, "## ") & + FORMAT$( DRAW_REC::NO_5, "##") SCRN_REC::MEGA_NO = FORMAT$(DRAW_REC::MEGA_NO, "##") WORK_STR$ = WORK_STR$ + SCRN_LINE$ L_SUB% = L_SUB% + 1% WHEN ERROR IN GET #draw_chan%, RFA DRAW_RFA( L_SUB%) USE L_ERR% = ERR END WHEN NEXT SCRN_STR$ = WORK_STR$ RETURN 32767 ! End of module PROGRAM_EXIT: WHEN ERROR IN CLOSE #draw_chan% USE ! ignore error on close END WHEN END SUB