10! OUTPUT 2 USING "#,K";"<lf>REN<cr>INDENT<cr><lf>RE-STORE ""FILE""<cr>"
20 !
30 ! EDIT File_file
40 ! EDIT File_save_open
50 ! EDIT File_load_open
60 ! EDIT File_save_s
70 ! EDIT File_load_s
80 ! EDIT File_save_r
90 ! EDIT File_load_r
100!
110!
120 ! Subprograms in the FILE file handle the Save-ing to disc and Load-ing
130 ! from disc of measurement setups.
140 !
150 ! Saving works like this: At the top level, the Main_save
160 ! subprogram is called. It calls File_save_open to open @file, and then
170 ! passes @File to Disp_save, Srce_save, etc. and they
180 ! output their state to the @File using File_save_s and File_save_r.
190 ! Loading works in a similar way except Disp_load, Srce_load, etc. are
200 ! called to read their state from the file.
210 END
220 ! PAGE ->
230 !************************************************************************
240 File_file:SUB File_file
250 SUBEND
260 !************************************************************************
270 File_save_open:SUB File_save_open(@File,Ok)
280 !This subprogram prompts for
290 !a file name to to save the state into and opens the file. OK is
300 !set to 1 if successful.
310 DIM File_name$[160]
320 Ok=0
330 LINPUT "Enter name of file for save",File_name$
340 IF TRIM$(File_name$)="" THEN SUBEXIT
350 ON ERROR GOTO Create_failed
360 CREATE BDAT File_name$,50
370 OFF ERROR
380 IF 0 THEN
390 Create_failed:OFF ERROR
400 IF ERRN=54 THEN !duplicate file name
410 IF NOT FNUser_yes("File already exists. OK to overwrite? (Y or N)",1) THEN
420 CALL User_error("Save aborted.")
430 SUBEXIT
440 END IF
450 ELSE
460 CALL User_error("Save failed: "&ERRM$)
470 SUBEXIT
480 END IF
490 END IF
500 ASSIGN @File TO File_name$
510 Ok=1
520 SUBEND
530 !************************************************************************
540 File_load_open:SUB File_load_open(@File,Ok)
550 !This subprogram prompts
560 !for a file name to load the state from and opens the file.
570 !
580 DIM File_name$[160]
590 Ok=0
600 LINPUT "Enter name of file to recall",File_name$
610 IF TRIM$(File_name$)="" THEN SUBEXIT
620 ON ERROR GOTO Assign_failed
630 ASSIGN @File TO File_name$
640 OFF ERROR
650 Ok=1
660 SUBEXIT
670 Assign_failed:OFF ERROR
680 CALL User_error("Get failed: "&ERRM$)
690 SUBEND
700 ! PAGE ->
710 !************************************************************************
720 File_save_s:SUB File_save_s(@File,S$(*))
730 !This subprogram outputs a string array and its dimensions to file @File.
740 OUTPUT @File;RANK(S$) !note this will be an INTEGER
750 FOR R=1 TO RANK(S$)
760 OUTPUT @File;BASE(S$,R),BASE(S$,R)+SIZE(S$,R)-1
770 NEXT R
780 OUTPUT @File;S$(*)
790 SUBEND
800 !************************************************************************
810 File_load_s:SUB File_load_s(@File,S$(*))
820 !This subprogram enters a string array from file @File and REDIMs it.
830 INTEGER Rank,B(1:6),U(1:6) !array bases and upperbounds
840 ENTER @File;Rank
850 FOR R=1 TO Rank
860 ENTER @File;B(R),U(R)
870 NEXT R
880 SELECT Rank
890 CASE 1
900 REDIM S$(B(1):U(1))
910 CASE 2
920 REDIM S$(B(1):U(1),B(2):U(2))
930 CASE 3
940 REDIM S$(B(1):U(1),B(2):U(2),B(3):U(3))
950 CASE 4
960 REDIM S$(B(1):U(1),B(2):U(2),B(3):U(3),B(4):U(4))
970 CASE 5
980 REDIM S$(B(1):U(1),B(2):U(2),B(3):U(3),B(4):U(4),B(5):U(5))
990 CASE 6
1000 REDIM S$(B(1):U(1),B(2):U(2),B(3):U(3),B(4):U(4),B(5):U(5),B(6):U(6))
1010 END SELECT
1020 ENTER @File;S$(*)
1030 SUBEND
1040 ! PAGE ->
1050 !************************************************************************
1060 File_save_r:SUB File_save_r(@File,A(*))
1070 !This subprogram outputs a real array and its dimensions in file @File.
1080 OUTPUT @File;RANK(A)
1090 FOR R=1 TO RANK(A)
1100 OUTPUT @File;BASE(A,R),BASE(A,R)+SIZE(A,R)-1
1110 NEXT R
1120 OUTPUT @File;A(*)
1130 SUBEND
1140 !************************************************************************
1150 File_load_r:SUB File_load_r(@File,A(*))
1160 !This subprogram enters a real array from @File and REDIMs it.
1170 INTEGER Rank,B(1:6),U(1:6) !array bases and upperbounds
1180 ENTER @File;Rank
1190 FOR R=1 TO Rank
1200 ENTER @File;B(R),U(R)
1210 NEXT R
1220 SELECT Rank
1230 CASE 1
1240 REDIM A(B(1):U(1))
1250 CASE 2
1260 REDIM A(B(1):U(1),B(2):U(2))
1270 CASE 3
1280 REDIM A(B(1):U(1),B(2):U(2),B(3):U(3))
1290 CASE 4
1300 REDIM A(B(1):U(1),B(2):U(2),B(3):U(3),B(4):U(4))
1310 CASE 5
1320 REDIM A(B(1):U(1),B(2):U(2),B(3):U(3),B(4):U(4),B(5):U(5))
1330 CASE 6
1340 REDIM A(B(1):U(1),B(2):U(2),B(3):U(3),B(4):U(4),B(5):U(5),B(6):U(6))
1350 END SELECT
1360 ENTER @File;A(*)
1370 SUBEND
1380 ! PAGE ->
1390 !************************************************************************