100 WINDOW 448,192,32,16
110 PAPER 7
120 BORDER 2,4
130 CLS: CLS #0
140 DEFine PROCedure COM(c$)
150  PRINT "***";c$
160 END DEFine COM
170 REMark PAUSE:
180 DEFine PROCedure PL
190  PRINT #0;"Press a key.";
200  PAUSE
210  CLS #0
220 END DEFine
230 :
240 COM " Create a database of the following composition:"
250 COM "  1x word integer (2 bytes);"
260 COM "  1x long-word integer (4 bytes);"
270 COM "  1x floating point number (6 bytes)."
280 :
290 CREATE #3;FLP2_TEST_DBS; 1,0; 2,0; 3,0
300 :
310 COM " Add the following field in position 2:"
320 COM "  1x 16-bytes fixed length string."
330 :
340 ADD_FIELD #3;2,0,16
350 :
360 REMark " Set the field names into the database extra information section,"
370 REMark "  for use by the names handler."
380 REMark " This information must be terminated by CR,LF."
390 REMark ' The name must be in double quotes (") and separated by commas (,).'
400 :
410 SEXTRA #3;'"int_w%","string$","int_l","float"'&CHR$(13)&CHR$(10)
420 :
430 COM " Add an extra field...."
440 ADD_FIELD #3;-1,2,4
450 COM " And remove it again."
460 REMOVE_FIELD #3;5
470 :
480 PRINT
490 COM " Read extra info back to check it."
500 :
510 PRINT FEXTRA(#3)
520 :
530 REMark " Assign values to the fields within the current/new record."
540 REMark " (Note 1: This does not change the file at this point)."
550 REMark ' (Note 2: "string$" can have up to 16 characters).'
560 :
570 SET #3;"float",14.4
580 SET #3;"string$","1.2.3.Testing"
590 SET #3;"int_l",1234
600 SET #3;"int_w%",500
610 :
620 REMark " A record can now be added to the database."
630 REMark " (Note: This operation clears the current record space)."
640 :
650 APPEND #3
660 :
670 PRINT: PL
680 COM " Point to first record."
690 REMark " (Note: Records are numbered from 0)"
700 :
710 RPOSAB #3;1
720 :
730 PRINT
740 COM " Read back the field contents of the current record, the record"
750 COM "  pointer, and the record count."
760 :
770 DEFine PROCedure read_back
780  PRINT "Record ";RECNUM(#3);", Total ";COUNT(#3)
790  PRINT FETCH(#3;"int_w%") TO 6
800  PRINT FETCH(#3;"string$") TO 24
810  PRINT FETCH(#3;"int_l") TO 32
820  PRINT FETCH(#3;"float")
830 END DEFine read_back
840 read_back
850 :
860 PRINT: PL
870 COM " Print the quantity of fields, then for each field:"
880 COM "  print the field type and length."
890 :
900 DEFine PROCedure field_prt
910  PRINT
920  PRINT "No. of fields ";FLNUM(#3);", Composition:"\"Type:",
930  FOR fl_lp = 1 TO FLNUM(#3)
940   PRINT FLTYP(#3;fl_lp),
950  END FOR fl_lp
960  PRINT \"Length:",
970  FOR fl_lp = 1 TO FLNUM(#3)
980   PRINT FLLEN(#3;fl_lp),
990  END FOR fl_lp
1000  PRINT
1010 END DEFine field_prt
1020 field_prt
1030 :
1040 REMark " Close the database and remove associated memory."
1050 :
1060 CLOSE_DATA #3
1070 :
1080 REMark " Reopen database for read/write, and dump field definitions."
1090 REMark " (Note: fields are only defined upon creation)."
1100 :
1110 OPEN_DATA #3;FLP2_TEST_DBS
1120 PL
1130 field_prt
1140 :
1150 REMark " Add some more records."
1160 :
1170 DEFine PROCedure add(p1%,p2$,p3,p4)
1180  SET #3;"int_w%",p1%
1190  SET #3;"string$",p2$
1200  SET #3;"int_l",p3
1210  SET #3;"float",p4
1220  APPEND #3
1230 END DEFine add
1240 add 2,"no. 2",214,LN(2)
1250 add 3,"Hello!!",197,14.14141
1260 add 5,"QLs are top",1,1/2
1270 :
1280 PRINT: PL
1290 COM " Dump the records to the screen"
1300 :
1310 DEFine PROCedure rec_dump
1320  PRINT
1330  FOR rd_lp = 0 TO COUNT(#3)-1
1340   RPOSAB #3;rd_lp
1350   read_back
1360  END FOR rd_lp
1370 END DEFine rec_dump
1380 rec_dump
1390 :
1400 PRINT: PL
1410 COM " Order the database on int_w% ascending, and dump results."
1420 :
1430 ORDER #3;"int_w%",1
1440 rec_dump
1450 :
1460 PRINT: PL
1470 COM " Order the database on float descending, and dump results."
1480 :
1490 ORDER #3;"float",-1
1500 rec_dump
1510 :
1520 PRINT: PL
1530 COM " Select records with int_l>200, and dump the results."
1540 :
1550 EXCLUDE #3;"int_l","<=",200
1560 rec_dump
1570 :
1580 PRINT: PL
1590 COM " Add another pair of record, and dump collection."
1600 REMark " (Note 1: these are not affected by any previous INCLUDEs)."
1610 REMark " (Note 2: these are affected by previous ORDER)."
1620 :
1630 add -15,"Negative int_w%",13,EXP(1)
1640 add 257,"Positive int_w%",-25,2.727273
1650 rec_dump
1660 :
1670 PRINT: PL
1680 COM ' Further select records with "M"<string$<"O".'
1690 REMark " (Note 1: this is superimposed on previous EX/INCLUDEs)."
1700 COM " (Note 2: this is Configured for case-independence)."
1710 :
1720 SCPTR #3;-1
1730 EXCLUDE #3;"string$","<=","M" ;"OR"; "string$","=>","O"
1740 rec_dump
1750 :
1760 PRINT: PL
1770 COM " Reset Selection, and dump records."
1780 REMark " (Note: This does not affect previous ORDER)"
1790 :
1800 RESET #3
1810 rec_dump
1820 :
1830 PRINT: PL
1840 COM " Current record is the last one, move two records back, and"
1850 COM "  dump current record"
1860 :
1870 RPOSRE #3;-2
1880 read_back
1890 :
1900 PRINT: PL
1910 COM " Delete it, then dump current record."
1920 REMark " (Note: does not previous affect ORDER)."
1930 :
1940 REMOVE #3
1950 read_back
1960 :
1970 PRINT: PL
1980 COM " Now dump all remaining records."
1990 :
2000 rec_dump
2010 :
2020 PRINT: PL
2030 COM " Dump, amend, and dump last record."
2040 REMark " (Note: database is reordered)."
2050 :
2060 RPOSAB #3;32767
2070 read_back
2080 SET #3;"int_w%",-232
2090 SET #3;"string$","AMENDED.."
2100 SET #3;"int_l",65538
2110 SET #3;"float",1.42E10
2120 UPDATE #3
2130 read_back
2140 :
2150 PRINT: PL
2160 COM " Dump contents of database again."
2170 :
2180 rec_dump
2190 COM " Done."
2200 CLOSE_DATA #3
