Home of the original IBM PC emulator for browsers.
[PCjs Machine "ibm5170"]
Waiting for machine "ibm5170" to load....
A collection of database management programs. The mailing labels
program allows sorting by four fields and keying printing of labels by
any field. PMB15.BAS provides a way of keeping track of events which
occur periodically such as bills, preventive maintenence items, dental
appointments, etc. INDXCARD.BAS is intended to make it very easy to
create and maintain 3" by 5" card files. By itself, it forms an
electronic typewriter with full editing facilities for the 3 by 5 card
format. It can be used with the program PC- FILE III.
Features:
~ Forms an electronic typewriter with full editing facilities.
~ Uses PC-FILE to sort index cards prior to printing.
~ Sorts a mailing list by four fields.
~ Prints one across or two across labels.
~ Keeps track of bills, preventive maintenence items, dental
appointments.
~ Writes your appointments or activities for the whole year.
~ Schedules your activities from 6 a.m. till 10 p.m.
~ Creates a computerized Rolodex.
System Requirements: Two disk drives, a Color/Graphics
Adapter Card (color not used), Epson MX-80 (or compatible) printer.
How to Start: Consult the .DOC files for documentation and
directions. To run the BASIC programs follow the GETTING STARTED
instructions for your configuration.
File Descriptions:
ADDRESS1 FIL Subroutine for the above program
ADDRESS BAS Random address file and mailing label printing program
FRM BAS BASIC program to generate blank 3" by 5"index cards
FILECAB BAS BASIC program to create and maintain databases
BOOKINV BAS Menu for book tracking in the library
BARRGOLD FRM Format of gold prices quotes
INDXCARD BAS BASIC program to generate index cards
INDXCARD BAT A DOS batch file to prepare a data disk
INDXCARD CMP A BASIC program to compress data
INDXCARD DTA Card data entered by INDXCARD.BAS
INDXCARD DOC Documentation for INDXCARD.BAS
PC^3LOG FRM Format for meeting reminder and log for PC meetings
MAIL1 DOC Documentation for MAIL1.BAS
MAIL1 BAS Mailing list program
INDXCARD RPT Used by PC-FILE to clone sorted data
INDXCARD KEY Key definitions used by INDXCARD.BAS
INDXCARD INX Index file used by PC-FILE
INDXCARD HDR Field definitions used by PC-FILE
INDXCARD FRM Card format created by INDXCARD.BAS
PMB15 DOC Documentation for PMB15.BAS
PMB15 BAS A preventive maintenance, bills and message program
WSJSTOCK FRM Format for stock prices
WEATHER FRM Format for weather report
VWREPAIR FRM Format for VW Rabbit service log
TEST FRM Format for test pattern
SCHEDU DOC Documentation for SCHEDU.BAS
SCHEDU BAS A BASIC program to generate and maintain calendars
ROLODEX DOC Documentation for Rolodex.bas
ROLODEX BAS A computerized Rolodex
??? BAK Backup or information files
ITEMDATA DAT Data file for PMB
GRAPHICS Graphics subdirectory
100 REM **********************************************************************
110 REM *** RANDOM ADDRESS FILE AND MAIL LABEL PRINTING PROGRAM ***
120 REM *** SAVED on disk as "ADDRESS.BAS" ***
130 REM *** DATE:11-4-82, Version 1.06 (C) COPYRIGHT Smothers & Co. - 1982 ***
140 REM *** Licensed Material - Program Property of SMOTHERS & COMPANY ***
150 REM **********************************************************************
160 COLOR 7,0: CLS: KEY OFF: COLOR 0,7
170 PRINT " THIS PROGRAM PRINTS LABELS FROM ADDRESS FILES SET UP BY ADDRESS.BAS PROGRAM ": PRINT
180 PRINT " THIS PROGRAM PROVIDES FOR CREATION AND EDITING OF RANDOM ADDRESS FILES ": PRINT
190 PRINT: COLOR 7,0
200 REM **********************************************************************
210 REM ******* THIS IS THE DISK SELECTION SECTION ************************
220 REM **********************************************************************
230 GOSUB 2940
240 CLOSE
250 INPUT "WHICH DISK DO YOU WISH TO WORK FROM A or B ";DK$
260 IF DK$="a" GOTO 330
270 IF DK$="A" GOTO 330
280 IF DK$="b" GOTO 330
290 IF DK$="B" GOTO 330
300 IF DK$<>"A" GOTO 250
310 IF DK$<>"B" GOTO 250
320 CLS: GOTO 200
330 REM **********************************************************************
340 REM ****** THIS SECTION DISPLAYS THE ADDRESS FILE NUMBERS ON DISK ******
350 REM **********************************************************************
360 ADD$=":ADDRESS?.FIL"
370 PRINT : PRINT "DISK `" DK$ "' ADDRESS FILE NUMBERS ARE: "
380 COLOR 0,7
390 FILES DK$+ADD$: PRINT
400 COLOR 7,0
410 REM **********************************************************************
420 REM ****** THIS IS THE ADDRESS FILE NUMBER SELECTION SECTION **********
430 REM **********************************************************************
440 INPUT "WHICH ADDRESS FILE NUMBER DO YOU WISH TO WORK FROM ";AD$
450 IF AD$="1"GOTO 580
460 IF AD$="2"GOTO 580
470 IF AD$="3"GOTO 580
480 IF AD$="4"GOTO 580
490 IF AD$="5"GOTO 580
500 IF AD$="6"GOTO 580
510 IF AD$="7"GOTO 580
520 IF AD$="8"GOTO 580
530 IF AD$="9"GOTO 580
540 AD$="00": GOTO 440
550 REM **********************************************************************
560 REM ****** THIS SECTION SETS UP THE ADDRESS FILES ON DISK *************
570 REM **********************************************************************
580 ADDR$=":ADDRESS"
590 EXT$=".FIL"
600 ADDFILE$=DK$+ADDR$+AD$+EXT$
610 OPEN ADDFILE$ AS 1 LEN=108
620 TEFO$=":TELEPHO"
630 TELEFILE$=DK$+TEFO$+AD$+EXT$
640 OPEN TELEFILE$ AS 2 LEN=18
650 FIELD #1, 18 AS X$, 30 AS Y$, 30 AS Z$, 30 AS V$
660 FIELD #2, 18 AS T$
670 LET D=0
680 LET C=0
690 LET S=0
700 GOTO 2690
710 REM **********************************************************************
720 REM ***** THIS SECTION CONTROLS THE PRINT TO SCREEN ADDRESS FUNCTION ****
730 REM **********************************************************************
740 GOSUB 2940
750 COLOR 7,0:CLS
760 COLOR 0,7: LOCATE 21,1,0: PRINT STRING$(80," ");
770 LOCATE 22,1,0: PRINT " YOU CAN NOW: F2 -- EXIT TO MASTER MENU ";
780 LOCATE 23,1,0: PRINT " F9 -- DISPLAY SELECTED ADDRESS (1 to 99) ";
790 LOCATE 24,1,0: PRINT " F10 -- DISPLAY CODE#/NAME/TELEPHONE LISTING (20 per page) ";
791 COLOR 7,0: KEY(2) ON: KEY(9) ON: KEY(10) ON
792 ON KEY(2) GOSUB 2660: ON KEY(9) GOSUB 800: ON KEY(10) GOSUB 1110
793 GOTO 791
800 REM **********************************************************************
810 CLS: COLOR 0,7: LOCATE 21,1,0: PRINT " DISPLAY ADDRESS FILE NUMBER "
815 LOCATE 22,1,0: PRINT STRING$(79," ")
820 COLOR 0,7: LOCATE 23,1,0: PRINT " ENTER RETURN FOR SUB MENU "
825 LOCATE 24,1,0: INPUT;" or INPUT 2-DIGIT ADDRESS CODE# "; CODE%: COLOR 7,0
830 IF CODE%=0 GOTO 750
850 IF CODE%=<0 GOTO 800
860 IF CODE%>99 GOTO 800
870 REM **********************************************************************
880 GET #1, CODE%: GET #2, CODE%: CLS
890 COLOR 0,15: LOCATE 3,4,0: PRINT " CODE#"; CODE%: COLOR 7,0
900 PRINT: IF X$=STRING$(18,32) GOTO 910 ELSE PRINT X$
910 IF Y$=STRING$(30,32) GOTO 920 ELSE PRINT Y$
920 IF Z$=STRING$(30,32) GOTO 930 ELSE PRINT Z$
930 IF V$=STRING$(30,32) GOTO 935 ELSE PRINT V$
935 IF T$=STRING$(18,32) GOTO 940 ELSE PRINT T$
940 GOTO 820
950 REM **********************************************************************
965 CLS: KEY(10) OFF
970 FOR I=C TO C+19
980 C=C+1: CODE%=C
990 GET #1, CODE%
1000 PRINT "CODE #";C,X$,Y$
1010 IF C=>99 THEN I=0: C=0: GOTO 1050
1020 NEXT I
1030 PRINT
1040 REM **********************************************************************
1050 LOCATE 23,1,0: COLOR 0,7: PRINT " YOU CAN NOW: F2 -- EXIT TO SUB MENU ";
1060 LOCATE 24,1,0: PRINT " F10 -- CONTINUE CODE#/NAVE LISTING ";
1065 COLOR 7,0
1080 KEY(2) ON: KEY(10) ON: KEY(9) OFF: ON KEY(2) GOSUB 1140: ON KEY(10) GOSUB 965
1090 GOTO 1080
1100 REM **********************************************************************
1110 CLS: LOCATE 23,1,0: COLOR 0,7: PRINT " YOU CAN NOW: F2 -- EXIT TO SUB MENU ";
1120 LOCATE 24,1,0: PRINT " F10 -- CONTINUE CODE#/NAVE LISTING ";
1130 COLOR 7,0: LOCATE 1,1,0: C=0: I=0: CODE%=0: GOTO 970
1135 RETURN
1140 C=0: I=0: CODE%=0: KEY(2) OFF: KEY(10) OFF: GOTO 750
1210 REM **********************************************************************
1220 REM ****** THIS IS THE ALL OR SOME LABLE PRINTING SECTION *************
1230 REM **********************************************************************
1240 GOSUB 2940
1241 CLS:PRINT : INPUT "DO YOU WANT TO PRINT THE TELEPHONE NUMBERS TOO -- Y/N "; TX$
1242 IF TX$="Y" THEN GOTO 1247
1243 IF TX$="y" THEN GOTO 1247
1244 IF TX$="N" THEN GOTO 1248
1245 IF TX$="n" THEN GOTO 1248
1246 GOTO 1241
1247 TPX=1: GOTO 1250
1248 TPX=0: GOTO 1250
1250 CLS: PRINT: INPUT "PRINT ALL LABELS? Y/N ", G$
1260 IF G$="Y" THEN PRINT: GOTO 1480
1270 IF G$="y" THEN PRINT: GOTO 1480
1280 IF G$="N" THEN GOTO 1340
1290 IF G$="n" THEN GOTO 1340
1300 GOTO 1250
1310 REM *********************************************************************
1320 REM ****** THIS PART IS THE PRINT RANGE OF LABELS SECTION ******
1330 REM *********************************************************************
1340 PRINT: PRINT "PRINT LABELS ___ THRU ___."
1350 COLOR 0,7
1360 PRINT: INPUT "START # IS ___"; SN%
1370 IF SN% =<0 GOTO 1360
1380 IF SN% >99 GOTO 1360
1390 INPUT "STOP # IS ___"; EN%
1400 IF EN% <0 GOTO 1390
1410 IF EN% >99 GOTO 1390
1420 IF EN% < SN% THEN PRINT: PRINT "STOP BEFORE START FAULT. TRY AGAIN!": PRINT ELSE GOTO 1440
1430 GOTO 1390
1440 COLOR 7,0: PRINT :GOTO 1500
1450 REM *********************************************************************
1460 REM *************** THIS IS THE PRINTER SECTION ***************
1470 REM *********************************************************************
1480 SN%=1
1490 EN%=99
1500 PRINT: INPUT "HOW MANY COPIES OF THE LABELS ARE TO BE PRINTED "; C
1510 PRINT: INPUT "ALIGN LABELS TO TOP OF FORM --- PRESS RETURN TO START";G$
1520 PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT
1530 IF CODE% > 99 THEN GOTO 1340
1540 FOR I=1 TO C
1550 FOR D=SN% TO EN%
1560 LET E=0
1570 CODE%=D
1580 GET #1, CODE% : GET #2, CODE%
1590 IF X$<= STRING$(18,32) GOTO 1600 ELSE LPRINT X$: E=E+1
1600 IF Y$<= STRING$(30,32) GOTO 1610 ELSE LPRINT Y$: E=E+1
1610 IF Z$<= STRING$(30,32) GOTO 1620 ELSE LPRINT Z$: E=E+1
1620 IF V$<= STRING$(30,32) GOTO 1621 ELSE LPRINT V$: E=E+1
1621 IF TPX=1 GOTO 1625 ELSE GOTO 1660
1625 IF T$<= STRING$(18,32) GOTO 1660 ELSE LPRINT T$: E=E+1: GOTO 1660
1630 REM *********************************************************************
1640 REM ******************* END OF A PRINT ***********************
1650 REM *********************************************************************
1655 E=E+1
1660 IF E=0 GOTO 1680
1670 IF E=6 GOTO 1680 ELSE LPRINT CHR$(10);
1679 GOTO 1655
1680 NEXT D
1690 LOCATE 19,1,0: PRINT STRING$(100," ");
1700 LOCATE 19,1,0
1710 PRINT "["; I; "LABELS PRINTED ] * [" ; C-I; "LABELS TO BE PRINTED ] * ["; C; "LABELS REQUESTED ] ";
1720 NEXT I
1730 REM *********************************************************************
1740 REM ****** PROGRAM TERMINATION POINT ******
1750 REM *********************************************************************
1760 COLOR 0,7
1770 LOCATE 22,30,0
1780 PRINT "*** JOB FINISHED ***";
1790 COLOR 7,0
1800 PRINT: PRINT: PRINT: INPUT " PRESS `RETURN' KEY TO RETURN TO MASTER MENU ";R%: IF R%=0 THEN CLS: GOTO 2690
1810 REM **********************************************************************
1820 REM *** C= NUMBER OF LABELS TO BE PRINTED
1830 REM *** T$= AREA CODE, TELEPHONE, EXT #
1840 REM *** X$= PERSON'S NAME
1850 REM *** Y$= COMPANY NAME
1860 REM *** Z$= STREET ADDRESS
1870 REM *** V$= CITY, STATE, ZIPCODE
1880 REM **********************************************************************
1890 REM **** ADDRESS INFORMATION STORED in disk file as ADDRESS#.FIL ****
1900 REM ** TELEPHONE INFORMATION STORED in disk file as TELEPHP#.FIL ****
1910 REM **********************************************************************
1920 REM
1930 REM **********************************************************************
1940 REM ****** THIS IS THE ADDRESS FILE EDIT SECTION *******
1950 REM **********************************************************************
1960 GOSUB 2940
1970 CLS: KEY OFF
1980 FIELD #1, 18 AS X$, 30 AS Y$, 30 AS Z$, 30 AS V$
1990 FIELD #2, 18 AS T$
2000 REM **********************************************************************
2010 LOCATE 22,1,0: COLOR 0,7: PRINT " PRESS `RETURN' KEY TO RETURN TO MASTER MENU ": COLOR 7,0
2020 REM **********************************************************************
2030 LOCATE 1,1,0: PRINT "ADDING TO ADDRESS FILE"
2040 INPUT "2-DIGIT CODE"; CODE%
2050 IF CODE%=0 THEN: CLS: GOTO 2690
2060 IF CODE%<0 THEN: CLS: GOTO 2010
2070 IF CODE%>99 THEN: CLS: GOTO 2010
2080 GET #1, CODE%: GET #2, CODE%
2090 REM **********************************************************************
2100 LOCATE 5,23,0: PRINT X$
2110 LOCATE 8,23,0: PRINT T$
2120 LOCATE 11,23,0: PRINT Y$
2130 LOCATE 14,23,0: PRINT Z$
2140 LOCATE 17,23,0: PRINT V$
2150 REM **********************************************************************
2160 LOCATE 2,23,0: INPUT "ENTER `OK' IF TRUE or NEW CODE# TO CHANGE"; CODE$
2170 IF LEN(CODE$) > 2 GOTO 2190
2180 IF LEN(CODE$)<1 GOTO 2190 ELSE GOTO 2200
2190 CODE$="": LOCATE 2,23,0: PRINT STRING$(55,32): GOTO 1970
2200 IF CODE$="OK" THEN GOTO 2220
2210 IF CODE$="ok" THEN GOTO 2220 ELSE GOTO 2230
2220 CODE%=CODE%: GOTO 2250
2230 CODE%=VAL(CODE$)
2240 REM **********************************************************************
2250 LOCATE 4,41,0: PRINT "]": LOCATE 4,1,0: LINE INPUT "PERSON'S NAME ? [";PN$
2260 IF LEN(PN$) > 18 GOTO 2270 ELSE GOTO 2280
2270 PN$="": LOCATE 4,23,0: PRINT STRING$(55,32): GOTO 2250
2280 IF PN$="OK" THEN GOTO 2300
2290 IF PN$="ok" GOTO 2300 ELSE GOTO 2310
2300 LSET X$=X$: GOTO 2330
2310 LSET X$=PN$
2320 REM **********************************************************************
2330 LOCATE 7,41,0: PRINT "]": LOCATE 7,1,0: LINE INPUT "AREACODE-TELEPHONE ? [";ACTN$
2340 IF LEN(ACTN$) > 18 GOTO 2350 ELSE GOTO 2360
2350 ACTN$="": LOCATE 7,23,0: PRINT STRING$(55,32): GOTO 2330
2360 IF ACTN$="OK" THEN GOTO 2380
2370 IF ACTN$="ok" THEN GOTO 2380 ELSE GOTO 2390
2380 RSET T$=T$: GOTO 2410
2390 RSET T$=ACTN$
2400 REM **********************************************************************
2410 LOCATE 10,53,0: PRINT "]": LOCATE 10,1,0: LINE INPUT "COMPANY NAME ? [";CN$
2420 IF LEN(CN$) > 30 GOTO 2430 ELSE GOTO 2440
2430 CN$="": LOCATE 10,23,0: PRINT STRING$(55,32): GOTO 2410
2440 IF CN$="OK" THEN GOTO 2460
2450 IF CN$="ok" THEN GOTO 2460 ELSE GOTO 2470
2460 LSET Y$=Y$: GOTO 2480
2470 LSET Y$=CN$
2480 LOCATE 13,53,0: PRINT "]": LOCATE 13,1,0: LINE INPUT "STREET ADDRESS ? [";SA$
2490 REM **********************************************************************
2500 IF LEN(SA$) > 30 GOTO 2510 ELSE GOTO 2520
2510 CN$="": LOCATE 13,23,0: PRINT STRING$(55,32): GOTO 2480
2520 IF SA$="OK" THEN GOTO 2540
2530 IF SA$="ok" GOTO 2540 ELSE GOTO 2550
2540 LSET Z$=Z$: GOTO 2570
2550 LSET Z$=SA$
2560 REM **********************************************************************
2570 LOCATE 16,53,0: PRINT "]": LOCATE 16,1,0: LINE INPUT "CITY,STATE,ZIPCODE ? [";CSZ$
2580 IF LEN(CSZ$) > 30 GOTO 2590 ELSE GOTO 2600
2590 CSZ$="": LOCATE 16,23,0: PRINT STRING$(55,32): GOTO 2570
2600 IF CSZ$="OK" THEN GOTO 2620
2610 IF CSZ$="ok" GOTO 2620 ELSE GOTO 2630
2620 LSET V$=V$: GOTO 2640
2630 LSET V$=CSZ$
2640 PUT 1#,CODE%: PUT #2, CODE%
2650 CLS: GOTO 2010
2660 REM **********************************************************************
2670 REM ****** THIS IS THE MASTER MENU SECTION *********
2680 REM **********************************************************************
2690 CLS: PRINT: COLOR 0,7
2700 LOCATE 19,1,0: PRINT " YOU CAN NOW: F1 -- PRINT LABELS "
2710 PRINT " F2 -- EXIT FROM PROGRAM "
2720 PRINT " F5 -- EDIT CURRENT ADDRESS FILE "
2730 PRINT " F6 -- EDIT ANOTHER ADDRESS FILE "
2740 PRINT " F7 -- DISPLAY ADDRESS FILES ";
2750 COLOR 7,0
2760 KEY(1) ON
2770 KEY(2) ON
2780 KEY(5) ON
2790 KEY(6) ON
2800 KEY(7) ON
2810 KEY(3) OFF
2820 KEY(4) OFF
2830 KEY(8) OFF
2840 KEY(9) OFF
2850 KEY(10) OFF
2860 ON KEY(1) GOSUB 1210
2870 ON KEY(2) GOSUB 2911
2880 ON KEY(5) GOSUB 1930
2890 ON KEY(6) GOSUB 320
2900 ON KEY(7) GOSUB 710
2910 GOTO 2860
2911 FOR E=1 TO 3
2912 BEEP: SOUND 2200,4: SOUND 400,6
2913 NEXT E
2914 LOCATE 1,20,0: INPUT " ARE YOU SURE Y/N "; EXIT$
2915 IF EXIT$="N" THEN GOTO 2680
2916 IF EXIT$="n" THEN GOTO 2680
2917 IF EXIT$="Y" THEN GOTO 2920
2918 IF EXIT$="y" THEN GOTO 2920
2919 GOTO 2915
2920 COLOR 7,0: CLS: KEY ON: SYSTEM
2930 REM **********************************************************************
2940 REM ***** THIS SUB CLOSES ALL KEYS BEFORE EXIT TO SUBS ******
2950 REM **********************************************************************
2960 KEY(1) OFF
2970 KEY(2) OFF
2980 KEY(3) OFF
2990 KEY(4) OFF
3000 KEY(5) OFF
3010 KEY(6) OFF
3020 KEY(7) OFF
3030 KEY(8) OFF
3040 KEY(9) OFF
3050 RETURN
3060 REM **********************************************************************
0 'BOOKINV.BAS From Rich S. 12/25/82
40 REM PROGRAMMER: Alfred Fant
41 REM FROM MICROCOMPUTING 12-82 PAGE 48
43 CLOSE:SCREEN 0,0,0,0:COLOR 7,0,0:WIDTH 80:CLS:LI$=STRING$(79,"-"):SP$=STRING$(79," "):FG=7:BG=0:HI=15:UL=1:BL=18:DEFINT A-Z:KEY OFF
60 GOSUB 3000
69 GOTO 100
80 GOSUB 99:REM single character input, lower case converted to uppercase
81 IN$=INKEY$:IF IN$="" THEN 81 ELSE SOUND 1000,1
82 IF ASC(IN$)=27 THEN RUN
83 IF ASC(IN$)>96 THEN IN$=CHR$(ASC(IN$)-32):REM Lower case to upper case.
84 RETURN
85 GOSUB 99:A$="":REM Input with L/C conversion until C/R.
86 IN$=INKEY$:IF IN$="" THEN 86 ELSE SOUND 1000,1
87 IF IN$=CHR$(13) THEN IN$=A$:RETURN ELSE IF ASC(IN$)=27 THEN RUN
88 IF ASC(IN$)>96 THEN IN$=CHR$(ASC(IN$)-32)
89 PRINT IN$;:A$=A$+IN$:GOTO 86
90 FOR I=1 TO 1000:NEXT:RETURN ' timer
96 GOSUB 99:LOCATE 25,35,0:COLOR 18,0:PRINT"< ENTER >";:COLOR 7,0
97 IN$=INKEY$:IF IN$="" THEN 97 ELSE CLS:SOUND 1000,1:RETURN
99 IN$=INKEY$:IF IN$<>"" THEN 99 ELSE LOCATE ,,1:RETURN
100 REM PROGRAM BOOKS
190 RESET:OPEN "B:SHELVES.DAT" AS 1 LEN=62
200 FIELD 1,2 AS F$,20 AS A$,20 AS T$,20 AS S$
210 CLS
215 IF S>1 THEN COLOR 0,7:PRINT TOTAL"BOOKS IN LIBRARY. CAPACITY IS"S-1;:COLOR 7,0:PRINT:PRINT
220 PRINT"MENU. 1 : NEW BOOK
230 PRINT" 2 : SEARCHES
240 PRINT" 3 : DELETE BOOK
250 PRINT" 4 : NEW LIBRARY
260 PRINT" 5 : STOP
270 PRINT
280 LOCATE 9,1,1:PRINT "CHOICE? ";:GOSUB 80:CHOICE=VAL(IN$)
290 WHILE CHOICE<1 OR CHOICE>5
300 GOTO 280
310 WEND:PRINT CHOICE
320 PRINT:ON CHOICE GOSUB 350,510,1760,2030,2190
330 GOTO 190
350 REM CHOICE=1 NEW BOOK SUBROUTINE
360 I=0:LOOP=1
370 GET 1,1
380 S=CVI(F$)
390 WHILE LOOP=1
400 I=I+1
410 GET 1,I
420 IF A$=SPACE$(20) OR S=I THEN LOOP=0
430 WEND
440 IF S=I THEN COLOR 0,7:PRINT " LIBRARY IS FULL WITH"I-1"BOOKS ":COLOR 7,0:RESET:GOSUB 96:RETURN
445 PRINT"ADD A BOOK TO THE LIBRARY! ARE YOU SURE?":GOSUB 80:IF IN$="N" THEN 190
450 INPUT "AUTHOR ";AU$:LSET A$=AU$
460 INPUT "TITLE ";TI$:LSET T$=TI$
470 INPUT "SUBJECT";SU$:LSET S$=SU$
480 PUT 1,I
490 RESET:RETURN
510 REM CHOICE=2 SEARCHES SUBROUTINE
520 CLS
530 INPUT " AUTHOR";AU$
540 INPUT " TITLE ";TI$
550 INPUT " SUBJECT";SU$
560 PRINT
570 PRINT "HARD COPY?":GOSUB 80:P$=IN$:IF P$="Y" THEN P=1 ELSE P=0
580 PRINT
590 IF P=1 THEN LPRINT "author" TAB(26) "title" TAB (51) "subject"
600 IF P=0 THEN CLS:COLOR 1,0:PRINT "author";:COLOR 7,0:PRINT TAB(26);:COLOR 1,0:PRINT"title";:COLOR 7,0:PRINT TAB(51);:COLOR 1,0:PRINT "subject":COLOR 7,0
610 IF AU$="" AND TI$="" AND SU$="" THEN MENU=1
620 IF AU$<>"" AND TI$="" AND SU$="" THEN MENU=2
630 IF AU$<>"" AND TI$<>"" AND SU$="" THEN MENU=3
640 IF AU$="" AND TI$<>"" AND SU$<>"" THEN MENU=4
650 IF AU$="" AND TI$="" AND SU$<>"" THEN MENU=5
660 IF AU$="" AND TI$<>"" AND SU$="" THEN MENU=6
670 Z$=SPACE$(20):LSET Z$=AU$
680 Y$=SPACE$(20):LSET Y$=TI$
690 X$=SPACE$(20):LSET X$=SU$
700 ON MENU GOSUB 760,920,1080,1240,1410,1570
720 GOSUB 96
730 CLOSE:GOTO 190
760 REM MENU=1 SUBROUTINE
770 I=0:TOTAL=I
780 GET 1,1
790 B$=SPACE$(20)
800 S=CVI(F$)
810 WHILE S <> I
820 I=I+1
830 GET 1,I
840 IF A$<>B$ THEN B=1:TOTAL=TOTAL+1 ELSE B=0
850 IF P=1 AND B=1 THEN LPRINT A$;" ";T$;" ";S$
860 IF P=0 AND B=1 THEN PRINT A$;" ";T$;" ";S$
870 WEND
880 CLOSE
890 RETURN
920 REM MENU=2 SUBROUTINE
930 I=0:TOTLA=I
940 GET 1,1
950 B$=SPACE$(20)
960 S=CVI(F$)
970 WHILE S<>I
980 I=I+1
990 GET 1,I
1000 IF A$<>B$ THEN B=1:TOTAL=TOTAL+1 ELSE B=0
1010 IF P=1 AND B=1 AND A$=Z$ THEN LPRINT A$;" ";T$;" ";S$
1020 IF P=0 AND B=1 AND A$=Z$ THEN PRINT A$;" ";T$;" ";S$
1030 WEND
1040 CLOSE
1050 RETURN
1080 REM MENU=3 SUBROUTINE
1090 I=0:TOTAL=I
1100 GET 1,1
1110 B$=SPACE$(20)
1120 S=CVI(F$)
1130 WHILE S<>I
1140 I=I+1
1150 GET 1,I
1160 IF A$<>S$ THEN B=1:TOTAL=TOTAL+1 ELSE B=0
1170 IF P=1 AND B=1 AND A$=Z$ AND T$=Y$ THEN LPRINT A$;" ";T$;" ";S$
1180 IF P=0 AND B=1 AND A$=Z$ AND T$=Y$ THEN PRINT A$;" ";T$;" ";S$
1190 WEND
1200 CLOSE
1210 RETURN
1240 REM MENU=4 SUBROUTINE
1250 I=0:TOTAL=I
1260 GET 1,1
1270 B$=SPACE$(20)
1280 S=CVI(F$)
1290 WHILE S<>I
1300 I=I+1
1310 GET 1,I
1320 IF A$<>B$ THEN B=1:TOTAL=TOTAL+1 ELSE B=0
1330 IF P=1 AND B=1 AND T$=Y$ AND S$=X$ THEN LPRINT A$;" ";T$;" ";S$
1340 IF P=0 AND B=1 AND T$=Y$ AND S$=X$ THEN PRINT A$;" ";T$;" ";S$
1350 WEND
1360 CLOSE
1370 RETURN
1410 REM MENU=5 SUBROUTINE
1420 I=0:TOTAL=I
1430 GET 1,1
1440 B$=SPACE$(20)
1450 S=CVI(F$)
1460 WHILE S<>I
1470 I=I+1
1480 GET 1,I
1490 IF A$<>B$ THEN B=1:TOTAL=TOTAL+1 ELSE B=0
1500 IF P=1 AND B=1 AND S$=X$ THEN LPRINT A$;" ";T$;" ";S$
1510 IF P=0 AND B=1 AND S$=X$ THEN PRINT A$;" ";T$;" ";S$
1520 WEND
1530 CLOSE
1540 RETURN
1570 REM MENU=6 SUBROUTINE
1580 I=0:TOTAL=I
1590 GET 1,1
1600 B$=SPACE$(20)
1610 S=CVI(F$)
1620 WHILE S<>I
1630 I=I+1
1640 GET 1,I
1650 IF A$<>B$ THEN B=1:TOTAL=TOTAL+1 ELSE B=0
1660 IF P=1 AND B=1 AND T$=Y$ THEN LPRINT A$;" ";T$;" ";S$
1670 IF P=0 AND B=1 AND T$=Y$ THEN PRINT A$;" ";T$;" ";S$
1680 WEND
1690 CLOSE
1700 RETURN
1760 REM CHOICE=3 : DELETE BOOK SUBROUTINE
1770 PRINT"DELETE A BOOK! ARE YOU SURE?":GOSUB 80:B$=IN$
1780 WHILE B$="Y"
1790 COLOR 0,7:PRINT"REQUIRED";:COLOR 7,0:INPUT " AUTHOR ";AU$
1800 COLOR 0,7:PRINT"REQUIRED";:COLOR 7,0:INPUT " TITLE ";TI$
1810 I=0:II=0:SP$=SPACE$(20)
1820 Y$=SP$:LSET Y$=TI$
1830 Z$=SP$:LSET Z$=AU$
1840 I=0:II=0
1850 GET 1,1
1860 S=CVI(F$)
1870 WHILE S<>I
1880 I=I+1
1890 GET 1,I
1900 IF A$=Z$ AND T$=Y$ THEN PRINT "DELETE: ";A$;" ";T$;" ";S$
1910 IF A$=Z$ AND T$=Y$ THEN II=I:I=S
1920 IF II<>0 THEN LSET A$=SP$:LSET T$=SP$:LSET S$=SP$
1930 WEND
1940 PUT 1,II
1950 B$="N"
1960 WEND
1970 RESET
1980 PRINT:GOSUB 96
1990 RETURN
2030 REM CHOICE=4 : NEW LIBRARY SUBROUTINE
2040 PRINT"CLEAR THE LIBRARY! ARE YOU SURE?":GOSUB 80:B$=IN$
2050 WHILE B$="Y"
2060 INPUT "NEW LIBRARY SIZE IN BOOKS ";SIZE:SIZE=SIZE+1
2065 SP$=SPACE$(20)
2070 LSET F$=MKI$(SIZE):LSET A$=SP$:LSET T$=SP$:LSET S$=SP$
2080 PUT 1,1
2100 FOR I=2 TO SIZE
2105 LSET F$=MKI$(I):LSET A$=SP$:LSET T$=SP$:LSET S$=SP$
2110 PUT 1,I
2120 NEXT I
2130 B$="N"
2140 WEND
2150 CLOSE
2160 RETURN
2190 REM CHOICE=5 SUBROUTINE : STOP SUBROUTINE
2200 CLOSE
2210 CLS:PRINT"ended ";:END
3000 CLS
3010 PRINT"This BOOKS program will keep track of a library of up to 2,000 books
3020 PRINT"by author, title, or subject.
3030 PRINT:PRINT"The drive used is B:, but that can be changed in line 190.
3999 GOSUB 96:RETURN
9999 COLOR 7,0:KEY ON:LOCATE ,,1,8,11:END
1010 P$="FILECAB.BAS":V$="82/04/16/1240"
1020 SCREEN 0,0,0:CLEAR
1030 KEY OFF:DEFINT A-Z:CLS
1040 OPEN "SCRN:" FOR OUTPUT AS #2
1050 DIM R$(65),AC(21),K(65),H$(21),RN$(21),Z$(21)
1060 COMMA$="NO" 'SEE INPUT ROUTINE
1070 H$(0)="REC #":DB$="":F$="BASENAME":ON ERROR GOTO 2320
1080 GOSUB 3840
1090 GOTO 2230
1100 F$=".HED":ON ERROR GOTO 1490:GOSUB 3840
1110 FOR I=1 TO NR:H$(I)=R$(I):NEXT I
1120 NH=NR:NR=0:MEM#=FRE(0)
1130 PRINT "AVAILABLE BYTES OF MEMORY ="FRE(0)
1140 AVGFLEN=20:B=INT(MEM#/(AVGFLEN*NH))-10
1150 PRINT "ASSUMING"AVGFLEN"CHARS/FIELD AND"NH"FIELDS"
1160 PRINT "MEMORY HAS ROOM FOR"B"RECORDS"
1170 DIM N$(B,NH),R(B)
1180 F$=".IND":ON ERROR GOTO 4530:GOSUB 3840
1190 GOTO 4510
1200 REM *** SORT ***
1210 FOR I=1 TO NR:R(I)=0:NEXT I
1220 FOR I=1 TO NR:FOR J=1 TO NR
1230 ON L GOTO 1240,1260
1240 IF N$(I,S)>=N$(J,S) THEN R(I)=R(I)+1
1250 GOTO 1270
1260 IF VAL(N$(I,S))>=VAL(N$(J,S)) THEN R(I)=R(I)+1
1270 NEXT J:NEXT I
1280 PRINT "SORT PHASE 1 FINISHED"
1290 FOR I=NR TO 1 STEP -1:FOR J=NR TO 1 STEP -1
1300 IF I<>J THEN IF R(I)=R(J) THEN R(J)=R(J)-1
1310 NEXT J:NEXT I
1320 PRINT "SORT PHASE 2 FINISHED"
1330 J=1
1340 IF R(J)=J THEN J=J+1:GOTO 1340
1350 IF J>=NR THEN 1400
1360 FOR I=1 TO NH
1370 Z$(I)=N$(R(J),I):N$(R(J),I)=N$(J,I):N$(J,I)=Z$(I):NEXT I
1380 Z=R(R(J)):R(R(J))=R(J):R(J)=Z
1390 GOTO 1340
1400 PRINT CHR$(7):PRINT "-Y- TO SAVE THE "DB$" FILE"
1410 PRINT "SORTED BY "H$(S);:INPUT L$
1420 IF L$="Y" THEN F$=".IND":GOSUB 3960
1430 GOTO 4510
1440 MF=1:GOSUB 3590
1450 INPUT "# OF SORT KEY FIELD";S$:S=VAL(S$)
1460 IF S<1 OR S>NH THEN 1450
1470 PRINT:INPUT "1 => SORT ALPHA; 2 => SORT NUMER ";L$:L=VAL(L$)
1480 PRINT:PRINT "SORT BEGINS":GOTO 1210
1490 RESUME 1500 'ERROR TARGET
1500 ON ERROR GOTO 0
1510 REM *** CREATE FIELDNAMEFILE ***
1520 NR=1
1530 CLS:PRINT "-RETURN- TO GO TO MAIN MENU":PRINT
1540 PRINT "FIELD NAME FOR FIELD"NR;:INPUT R$(NR)
1550 IF R$(NR)="" OR NR>20 THEN 1580
1560 NR=NR+1
1570 GOTO 1540
1580 NR=NR-1
1590 GOSUB 3960:GOTO 1110
1600 REM ***ENTER RECORDS***
1610 CLS
1620 PRINT "THERE ARE "NR" RECORDS IN THE "DB$" FILE"
1630 NR=NR+1
1640 PRINT "YOU ARE ENTERING RECORD"NR:PRINT
1650 FOR I=1 TO NH:PRINT H$(I)":";:GOSUB 4420:N$(NR,I)=I$:NEXT I:PRINT
1660 INPUT "-Y- TO ENTER ANOTHER RECORD";L$
1670 IF L$="Y" THEN 1620:F$=".IND"
1680 GOSUB 3960
1690 GOTO 4510
1700 REM ***SEARCH/CHANGE***
1710 L=0
1720 CLS:PRINT "SEARCH ANY OF THE FOLLOWING FIELDS:":PRINT
1730 GOSUB 3590
1740 PRINT:PRINT "OR":PRINT:PRINT I" MAKE CHANGES":PRINT
1750 INPUT "TYPE A NUMBER";S$:S=VAL(S$)
1760 IF S<0 OR S>NH+1 THEN 1750
1770 IF S=NH+1 THEN 1940
1780 CLS:PRINT "ENTER THE"H$(S):PRINT "TO BE FOUND":INPUT Q$
1790 CLS:FOR J=1 TO NR:N$(J,0)=STR$(J)
1800 IF LEFT$(N$(J,S),LEN(Q$))=Q$ THEN GOSUB 2050
1810 IF L+NH>20 THEN GOSUB 1890:NEXT J
1820 PRINT "SEARCH FINISHED":PRINT
1830 PRINT "1 => DO MORE SEARCHES"
1840 PRINT "2 => MAKE CHANGES"
1850 PRINT "3 => RETURN TO MAIN MENU"
1860 INPUT S$:S=VAL(S$)
1870 IF S<1 OR S>3 THEN 1860
1880 ON S GOTO 1720,1940,4510
1890 IF PF <> 0 THEN 1930
1900 PRINT "-RETURN- TO CONTINUE; -ESC- TO GO TO MAIN MENU";
1910 L$=INKEY$:IF L$="" THEN 1910
1920 IF ASC(L$)=27 THEN 4510:IF ASC(L$)<>13 THEN 1910
1930 L=0:CLS:RETURN
1940 REM ***CHANGE DATA***
1950 INPUT "REC # TO BE CHANGED";J$:J=VAL(J$)
1960 CLS:GOSUB 2050
1970 PRINT "FIELD NUMBER TO BE CHANGED ("I"FOR NO CHANGE)"
1980 INPUT S$:S=VAL(S$)
1990 IF S<1 THEN 1980 ELSE IF S>NH THEN 2020
2000 PRINT:PRINT "FROM"H$(S)": "N$(J,S):PRINT:PRINT "TO"H$(S)": ";
2010 INPUT N$(J,S):CLS:GOSUB 2050
2020 PRINT:INPUT "-Y- TO CHANGE ANOTHER RECORD";L$
2030 IF L$="Y" THEN 1940
2040 F$=".IND":GOSUB 3960:GOTO 4510
2050 REM ***PRINT A RECORD***
2060 ON PF GOSUB 4850,4880,4920
2070 PRINT #2," "H$(0)": ";J
2080 FOR I=1 TO NH:PRINT #2,I" "H$(I)": "N$(J,I):NEXT I:PRINT #2,
2090 L=L+NH+2
2100 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
2110 RETURN
2120 REM ***DELETE RECORDS***
2130 CLS
2140 PRINT "REC # TO BE DELETED ("NR+1"TO ABORT DELETION)";
2150 INPUT DR$:DR=VAL(DR$)
2160 IF DR<1 THEN 2140 ELSE IF DR>NR THEN NR=NR+1:GOTO 2200
2170 FOR J=DR TO NR-1:FOR I=1 TO NH
2180 N$(J,I)=N$(J+1,I):NEXT I:NEXT J
2190 PRINT:PRINT "RECORD NUMBER "DR" DELETED!":PRINT
2200 INPUT "-Y- TO DELETE MORE";L$
2210 IF L$="Y" THEN 2140
2220 NR=NR-1:F$=".IND":GOSUB 3960:GOTO 4510
2230 REM *** BASENAMEFILE ROUTINES ***
2240 CLS:PRINT "SELECT FROM:":PRINT
2250 FOR J=1 TO NR:PRINT J" "R$(J):NEXT J:PRINT
2260 PRINT J" CREATE A NEW DATA BASE"
2270 IF J>1 THEN PRINT J+1" DELETE A DATA BASE":PRINT
2280 INPUT "TYPE A NUMBER";S$:S=VAL(S$)
2290 IF S=(J+1) THEN 2370
2300 IF S<1 OR S>J THEN PRINT CHR$(7);:GOSUB 4990:GOTO 2280
2310 DB$=R$(S):IF S<>J THEN 1100:PRINT:GOTO 2340
2320 RESUME 2330 'ERROR TARGET
2330 ON ERROR GOTO 0
2340 IF J=0 THEN J=1:INPUT "NAME FOR NEW DATA BASE FILE :";R$(J)
2350 NR=J:GOSUB 3960
2360 DB$=R$(J-1):GOTO 1100
2370 REM *** DELETE A DATA BASE ***
2380 PRINT:INPUT "DELETE WHICH DATABASE: ";S$:S=VAL(S$)
2390 IF S<1 OR S>J-1 THEN PRINT CHR$(7);:GOSUB 4990:GOTO 2380
2400 CLS:LOCATE 9,1
2410 PRINT "READY TO DELETE "CHR$(34);R$(S);CHR$(34);".":PRINT
2420 PRINT "ONCE DELETED, THIS DATA CANNOT BE RECOVERED."
2430 PRINT "ARE YOU SURE YOU WANT TO DELETE IT (Y/N) ";:INPUT S$
2440 IF S$<>"Y" THEN 2230
2450 CLS:LOCATE 12,11:COLOR 0,7:PRINT " DELETING DATABASE ":COLOR 7,0
2460 ON ERROR GOTO 2500
2470 DB$=R$(S):DB$=R$(S):F$=".RPN":GOSUB 3840:KILL DB$+F$
2480 FOR I=1 TO NR:KILL DB$+R$(I)+".RPT":NEXT I
2490 GOTO 2520
2500 RESUME 2510 'TARGET OF ERROR
2510 ON ERROR GOTO 0
2520 ON ERROR GOTO 4960
2530 KILL DB$+".RPN":KILL DB$+".IND":KILL DB$+".HED"
2540 ON ERROR GOTO 0
2550 DB$=""
2560 F$="BASENAME":GOSUB 3840
2570 IF NR=1 THEN KILL "BASENAME":GOTO 1010
2580 FOR I=S TO NR-1:R$(I)=R$(I+1):NEXT I
2590 NR=NR-1:GOSUB 3960
2600 GOTO 2230
2610 REM ***REPORT***
2620 T9=0
2630 CLS:E=0
2640 FOR I=0 TO 3*NH+2:K(I)=0:NEXT I
2650 FOR I=0 TO NH:AC(I)=0:NEXT I:HC=0:GT=0
2660 ON E GOTO 2860
2670 GOTO 3650
2680 PRINT:INPUT "HOW MANY FIELD NAMES";RH$
2690 RH= VAL(RH$):IF RH<1 OR RH>NH+1 THEN 2680
2700 IF E=0 THEN RN$(NN)="PRESENT"
2710 FOR I=1 TO RH*3 STEP 3
2720 PRINT "ENTER # OF FIELD NAME TO GO IN"
2730 PRINT "POSITION #"(I+2)/3" ";:INPUT "";K$:K(I)=VAL(K$)
2740 IF K(I)<0 OR K(I)>NH THEN 2720
2750 PRINT "ENTER STARTING COLUMN FOR"H$(K(I))" ";:INPUT K$:K(I+1)=VAL(K$)
2760 IF K(I+1)<0 OR K(I+1)>255 THEN 2750
2770 PRINT "CALCULATE COLUMN TOTAL ON"H$(K(I))" (Y/N)";:INPUT L$
2780 IF L$="Y" THEN K(I+2)=1:K(0)=1
2790 NEXT I
2800 IF K(0)<>1 THEN 2860
2810 INPUT "ENTER STARTING COLUMN FOR TOTAL: ";A$
2820 IF LEN(A$)=0 THEN K(0)=0:T9=1:GOTO 2860
2830 K(I+1)=VAL(A$)
2840 IF K(I+1)<0 OR K(I+1)>131 THEN PRINT CHR$(7):RWLC=CSRLIN-2
2850 IF K(I+1)<0 OR K(I+1)>131 THEN LOCATE RWLC,1:GOTO 2810
2860 PRINT
2870 INPUT "SELECT RECORDS BY WHICH FIELD # ";S$:S=VAL(S$)
2880 IF LEN(S$)=0 THEN Q$="@":GOTO 2950
2890 PRINT:INPUT "'AND' 2ND HEADER (Y/N)";L$
2900 IF L$<>"Y" THEN X$="@":GOTO 2920
2910 PRINT:INPUT "ENTER # OF 'AND' HEADER ";X$:X=VAL(X$)
2920 PRINT:PRINT "@ WILL SELECT ALL RECORDS."
2930 PRINT:PRINT "SELECT RECORDS FOR"H$(S)"= ";:INPUT Q$:PRINT
2940 IF L$="Y" THEN PRINT "AND "H$(X)"= ";:INPUT X$
2950 FOR I=1 TO RH+1:REM IF K(3*I-1)>35 THEN PF = 2
2960 NEXT I
2970 ON PF GOSUB 4850,4880,4920:GOSUB 3310
2980 FOR J=1 TO NR
2990 N$(J,0)=STR$(J)
3000 IF Q$="@" THEN 3040
3010 IF LEFT$(N$(J,S),LEN(Q$))<>Q$ THEN 3050
3020 IF X$="@" THEN 3040
3030 IF LEFT$(N$(J,X),LEN(X$))<>X$ THEN 3050
3040 GOSUB 3160
3050 IF PF<1 THEN IF L>18 THEN GOSUB 1890:GOSUB 3310
3060 IF L=0 THEN GOSUB 3310
3070 NEXT J
3080 ON T9 GOSUB 3240
3090 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
3100 ON E GOTO 3130
3110 PRINT:PRINT "-Y- TO SAVE THE FORMAT FOR THIS REPORT":INPUT L$
3120 IF L$="Y" THEN E=1:GOSUB 3410
3130 PRINT:PRINT "-Y- FOR MORE REPORTS WITH THE "RN$(NN)" FORMAT":INPUT L$
3140 IF L$="Y" THEN GOSUB 3590:E=1:GOTO 2650
3150 GOTO 4510
3160 FOR I=1 TO RH
3170 PRINT #2,TAB(K(3*I-1)) N$(J,K(3*I-2));:ON K(3*I) GOSUB 3210:NEXT I
3180 IF K(0)=1 THEN IF HC<>0 THEN PRINT #2,TAB(K(3*I-1)) HC;:GT=GT+HC:HC=0
3190 L=L+1
3200 PRINT #2,:RETURN
3210 N=3*I-2
3220 V=VAL(N$(J,K(N))):AC(I)=AC(I)+V:HC=HC+V
3230 RETURN
3240 FOR I=1 TO 39+((PF>1)*39):PRINT #2,"-";:NEXT I:PRINT #2,
3250 FOR I=1 TO RH
3260 IF AC(I)=0 THEN 3280
3270 PRINT #2,TAB(K(3*I-1)) AC(I);
3280 NEXT I
3290 IF GT<>0 THEN PRINT #2,TAB(K(3*I-1)) GT;
3300 PRINT #2,:RETURN
3310 CLS
3320 IF PF=>1 THEN PRINT #2,CHR$(27)+CHR$(12) 'TOP OF FORM
3330 PRINT #2,RN$(NN)"REPORT FOR"H$(S)":"Q$;
3340 IF X$="@" THEN 3360
3350 PRINT #2," AND"H$(X)":"X$:GOTO 3370
3360 PRINT #2," "
3370 FOR I=1 TO RH:PRINT #2,TAB(K(3*I-1)) H$(K(3*I-2));:NEXT I
3380 IF K(0)=1 THEN PRINT #2,TAB(K(3*I-1)) "TOTAL";
3390 PRINT #2,:PRINT #2,
3400 L=4:RETURN
3410 REM *** SET-UP TO SAVE RPTFMTFILE ***
3420 NS=NR
3430 PRINT:INPUT "TYPE THE REPORT FORMAT NAME ";RN$(NN)
3440 F$=RN$(NN)+".RPT"
3450 PRINT F$ "*****TEST***"
3460 NR=3*RH+2
3470 FOR I=1 TO NR:R$(I)=STR$(K(I)):NEXT I
3480 R$(I-2)=STR$(K(0))
3490 GOSUB 3960:GOSUB 4090
3500 RETURN
3510 REM *** SET-UP TO READ RPTFMTFILE ***
3520 F$=RN$(NN)+".RPT"
3530 PRINT F$ "******TEST*****"
3540 GOSUB 3840
3550 RH=(NR-2)/3:FOR I=1 TO NR:K(I)=VAL(R$(I)):NEXT I
3560 K(0)=VAL(R$(I-2))
3570 NR=NS
3580 GOSUB 3590:PRINT:GOTO 2870
3590 REM *** SUB MENU ***
3600 PRINT "SELECT FROM:":PRINT
3610 IF MF=0 THEN PRINT "0 "H$(0)
3620 FOR I=1 TO NH:PRINT I" "H$(I):NEXT I:PRINT
3630 MF=0
3640 RETURN
3650 REM *** READ REPORTNAMEFILE & SELECT REPORT ***
3660 NN=0:FOR I=0 TO 21:RN$(I)="":NEXT I:NS=NR
3670 F$=".RPN"
3680 ON ERROR GOTO 3780
3690 GOSUB 3840
3700 FOR I=1 TO NR:RN$(I)=R$(I):NEXT I
3710 CLS:PRINT "SELECT FROM:":PRINT
3720 FOR I=1 TO NR:PRINT I" "R$(I):NEXT I:PRINT
3730 PRINT I" CREATE A NEW REPORT FORMAT":PRINT
3740 INPUT "WHICH ";S$:S=VAL(S$):IF S<1 OR S>I THEN 3740
3750 NN=S
3760 IF S<>I THEN RN$(S)=R$(S):E=1:NR=NS:GOTO 3510
3770 GOTO 3830
3780 RESUME 3790 'TARGET OF ERROR
3790 ON ERROR GOTO 0
3800 CLS:PRINT "NO REPORT FORMATS ON DISK":PRINT
3810 NN=1
3820 INPUT "CREATE ONE (Y/N) ?";L$:IF L$<>"Y" THEN 4510
3830 GOSUB 3590:NR=NS:GOTO 2680
3840 REM *** READ FILES ***
3850 IF F$<>".IND" THEN FF=1
3860 OPEN DB$+F$ FOR INPUT AS #1
3870 ON ERROR GOTO 0
3880 INPUT #1,NR
3890 FOR J=1 TO NR
3900 ON FF GOTO 3930
3910 FOR I=1 TO NH:INPUT #1,I$:N$(J,I)=I$:NEXT I
3920 GOTO 3940
3930 INPUT #1,R$(J)
3940 NEXT J
3950 CLOSE #1:FF=0:RETURN
3960 REM *** SAVE FILES ***
3970 IF F$<>".IND" THEN FF=1
3980 OPEN DB$+F$ FOR OUTPUT AS #1
3990 PRINT #1,NR
4000 FOR J=1 TO NR
4010 ON FF GOTO 4040
4020 FOR I=1 TO NH:PRINT #1,N$(J,I):NEXT I
4030 GOTO 4050
4040 PRINT #1,R$(J)
4050 NEXT J
4060 CLOSE #1
4070 FF=0
4080 RETURN
4090 REM *** SAVE REPORTNAMEFILE ***
4100 NR=NN
4110 F$=".RPN"
4120 FOR I=1 TO NR:R$(I)=RN$(I):NEXT I
4130 GOSUB 3960
4140 NR=NS:RETURN
4150 REM *** LIST ***
4160 L=0
4170 CLS
4180 REM IF PF=>1 THEN LPRINT CHR$(12)
4190 FOR J=1 TO NR
4200 ON PF GOSUB 4850,4880,4920
4210 PRINT #2," "H$(0)": ";J:L=L+1
4220 FOR I=1 TO NH
4230 PRINT #2,I" "H$(I)": "N$(J,I)
4240 L=L+1
4250 NEXT I
4260 PRINT #2,:L=L+1
4270 IF L+NH>20 THEN 4320
4280 NEXT J
4290 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
4300 INPUT "-RETURN- FOR MENU";L$
4310 GOTO 4510
4320 CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2
4330 PRINT "-RETURN- TO CONTINUE; -ESC- FOR MENU";
4340 L$=INKEY$:IF L$="" THEN 4340
4350 IF ASC(L$)=27 THEN 4510
4360 IF ASC(L$)=13 THEN 4380
4370 GOTO 4340
4380 CLS:L=0
4390 ON PF GOSUB 4850,4880,4920
4400 GOTO 4280
4410 STOP
4420 REM *** INPUT ROUTINES ***
4430 I$ = ""
4440 IF COMMA$="NO" THEN INPUT I$:RETURN
4450 A$=INKEY$:IF A$="" THEN 4450
4460 IF A$=CHR$(3) THEN STOP
4470 PRINT A$;
4480 IF A$=CHR$(13) THEN RETURN
4490 I$=I$+A$
4500 GOTO 4450
4510 REM *** MAIN MENU ***
4520 GOTO 4550
4530 RESUME 4540 ' TARGET OF ERROR
4540 ON ERROR GOTO 0
4550 CLS
4560 PRINT "******* DATA BASE MANAGEMENT I *******"
4570 PRINT:PRINT " IBM PERSONAL COMPUTER"
4580 PRINT
4590 PRINT "CURRENT DATA BASE: "DB$" NOW HAS"NR"RECORDS:PRINT
4600 PRINT "ASSUMING"AVGFLEN"CHARS/FIELD, ROOM FOR"B - NR"MORE":PRINT
4610 IF PF >=1 THEN PRINT "PRINTER ";:COLOR 23:PRINT "ON":COLOR 7:GOTO 4630
4620 PRINT "PRINTER OFF"
4630 PRINT
4640 PRINT "1 SELECT DATA BASE"
4650 PRINT "2 SEARCH AND/OR CHANGE DATA"
4660 PRINT "3 ENTER RECORDS"
4670 PRINT "4 DELETE RECORDS"
4680 PRINT "5 REPORT"
4690 PRINT "6 SORT
4700 PRINT "7 TURN ON PRINTER"
4710 PRINT "8 TURN OFF PRINTER"
4720 PRINT "9 LIST ALL RECORDS"
4730 PRINT "10 QUIT"
4740 PRINT
4750 INPUT "TYPE A NUMBER";S$:S=VAL(S$)
4760 IF S<1 OR S>10 THEN 4510
4770 ON S GOTO 1030,1700,1600,2120,2610,1440,4780,4830,4150,4840
4780 CLS:PRINT "PRINTER OPTIONS:"
4790 PRINT "1 => 40 COLUMNS; 2 => 80 COLUMNS; 3 => 132 COLUMNS"
4800 PRINT:INPUT "WHICH ";PF$:PF=VAL(PF$)
4810 IF PF<1 OR PF>3 THEN 4800
4820 GOTO 4510
4830 PF=0:CLOSE #2:OPEN "SCRN:" FOR OUTPUT AS #2:GOTO 4510
4840 END
4850 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2
4860 PRINT #2,CHR$(18)
4870 PRINT "K":RETURN
4880 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2
4890 PRINT #2,CHR$(18)
4900 PRINT "K80N"
4910 RETURN
4920 CLOSE #2:OPEN "LPT1:" FOR OUTPUT AS #2
4930 PRINT #2,CHR$(15)
4940 PRINT "K132N"
4950 RETURN
4960 REM CLEAR ERROR IF .RPN FILE DOSENT EXIST
4970 RESUME NEXT
4980 REM SUBROUTINE TO ERASE A LINE
4990 RWLC=CSRLIN-1:LOCATE RWLC,1:PRINT STRING$(39," ");:LOCATE RWLC,1
5000 RETURN
------------------------------------------------------------------------
Disk No 317 Database Programs v2 DS
------------------------------------------------------------------------
A collection of data base management programs. Mailing labels, schedules,
calendars, 3" x 5" index cards are generated by the various programs.
ADDRESS BAS Random address file and mailing label printing program
ADDRESS1 FIL Subroutine for the above program
BARRGOLD FRM Format of gold prices quotes
BOOKINV BAS Menu for book tracking in the library
FILECAB BAS Basic program to create and maintain data bases
FRM BAS Basic program to generate blank 3" x 5" index cards
INDXCARD BAS Basic program to generate index cards
INDXCARD BAT A dos batch file to prepare a data disk
INDXCARD CMP A basic program to compress data
INDXCARD DOC Documentation for indxcard.bas
INDXCARD DTA Card data entered by indxcard.bas
INDXCARD FRM Card format created by indxcard.bas
INDXCARD HDR Field definitions used by pc-file
INDXCARD INX Index file used by pc-file
INDXCARD KEY Key definitions used by indxcard.bas
INDXCARD RPT Used by pc-file to clone sorted data
MAIL1 BAS Mailing list program
MAIL1 DOC Documentation for mail1.bas
PC^3LOG FRM Format for meeting reminder and log for pc meetings
PMB15 BAS A preventive maintenance, bills and message program
PMB15 DOC Documentation for pmb15.bas
PMB15 BAK Part of pmb15 program
ROLODEX BAS A computerized rolodex
ROLODEX DOC Documentation for rolodex.bas
SCHEDU BAS A basic program to generate and maintain calendars
SCHEDU DOC Documentation for schedu.bas
TEST FRM Format for test pattern
VWREPAIR FRM Format for vw rabbit service log
WEATHER FRM Format for weather report
WSJSTOCK FRM Format for stock prices
GRAPHICS This subdirectory contains contains a graph drawing program.
PC-SIG
1030D E Duane Avenue
Sunnyvale Ca. 94086
(408) 730-9291
(c) Copyright 1987 PC-SIG
10 KEY OFF:CLS
20 ' PC^3 Software Library Program ADDRFLCD
30 ' Michael Csontos 7-30-82
40 PRINT " This program generates form filecards (3x5 index cards) for the collection and"
50 PRINT " filing of club membership or other name and address information. They look"
60 PRINT " something like the following.":PRINT
70 PRINT
80 PRINT " Name:______________________________________________
90 PRINT " as you want it on address labels
100 PRINT " Street Address______________________________________
110 PRINT " for mailing purposes
120 PRINT " City___________________________State________ZIP_____
130 PRINT
140 PRINT " Company_______________________Mail Code_____________
150 PRINT " may help in distributing meeting notices
160 PRINT " Phone:Home___________________Work___________________
170 PRINT
180 PRINT " Club Office_________________________________________
190 PRINT " office or duties assumed during the current year
200 PRINT
210 PRINT " The program is set up for an Epson MX-80 with Graphtrack. Other printers may
220 PRINT " require modification of the printer commands. The output is intended for
230 PRINT "continuous sprocket feed form index cards (one across) such as are available
240 PRINT "from Misco Inc., Box 399, Holmdel, NJ 07733, 800/631-2227 (Cat. # 8871)
250 PRINT
260 INPUT "How many cards do you want in this run"; NUMBER
270 IF NUMBER<1 OR INT(NUMBER)<>NUMBER THEN PRINT "Please enter an integer number from 1 to the number of blank cards you have":GOTO 260
280 INPUT "Is the printer ready to print the cards";Q$
290 IF Q$="y" OR Q$="Y" THEN GOTO 320
300 IF Q$="n" OR Q$="N" THEN GOTO 280
310 PRINT "Please enter Y, y, N, or n":GOTO 280
320 PRINTED=NUMBER
330 LPRINT CHR$(27)CHR$(64);' reset printer
340 LPRINT CHR$(27)CHR$(67)CHR$(0)CHR$(3);' 3 inch form
350 LPRINT CHR$(15)CHR$(27)CHR$(65)CHR$(10);' 10/72 inch lines
360 IF NUMBER>0 THEN GOSUB 390 ELSE GOTO 550
370 NUMBER=NUMBER-1
380 GOTO 360
390 LPRINT CHR$(27)CHR$(69) "Name:" CHR$(27)CHR$(45)CHR$(1) STRING$(40,"_") CHR$(27)CHR$(45)CHR$(0)'
400 LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(83)CHR$(0) " AS YOU WANT IT ON ADDRESS LABLES" CHR$(27)CHR$(72)
410 LPRINT
420 LPRINT CHR$(27)CHR$(69) "Street Address:" CHR$(27)CHR$(45)CHR$(1) STRING$(30,"_") CHR$(27)CHR$(45)CHR$(0)
430 LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(83)CHR$(0) " FOR MAILING PURPOSES" CHR$(27)CHR$(72)
440 LPRINT
450 LPRINT CHR$(27)CHR$(69) "City:" CHR$(27)CHR$(45)CHR$(1) STRING$(17,"_") CHR$(27)CHR$(45)CHR$(0) "State:" CHR$(27)CHR$(45)CHR$(1) STRING$(5,"_") CHR$(27)CHR$(45)CHR$(0) "ZIP:" CHR$(27)CHR$(45)CHR$(1) STRING$(8,"_") CHR$(27)CHR$(45)CHR$(0)
460 LPRINT :LPRINT
470 LPRINT CHR$(27)CHR$(69) "Company:" CHR$(27)CHR$(45)CHR$(1) STRING$(13,"_") CHR$(27)CHR$(45)CHR$(0) "Mail Code:" CHR$(27)CHR$(45)CHR$(1) STRING$(14,"_") CHR$(27)CHR$(45)CHR$(0)
480 LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(83)CHR$(0) " MAY HELP IN DISTRIBUTING MEETING NOTICES" CHR$(27)CHR$(72)
490 LPRINT
500 LPRINT CHR$(27)CHR$(69) "Phone:Home:" CHR$(27)CHR$(45)CHR$(1) STRING$(14,"_") CHR$(27)CHR$(45)CHR$(0) "Work:" CHR$(27)CHR$(45)CHR$(1) STRING$(15,"_") CHR$(27)CHR$(45)CHR$(0)
510 LPRINT :LPRINT
520 LPRINT "Club Office:" CHR$(27)CHR$(45)CHR$(1) STRING$(33,"_") CHR$(27)CHR$(45)CHR$(0)'
530 LPRINT CHR$(27)CHR$(70)CHR$(27)CHR$(83)CHR$(0) " OFFICE OR DUTIES ASSUMED BY YOU DURING THE CURRENT YEAR" CHR$(27)CHR$(72)
540 LPRINT CHR$(140);:RETURN
550 PRINT PRINTED " cards completed.":PRINT:PRINT:KEY ON
560 END
570 ' SAVE"addrflcd
PLOTTER.DOC Documentation for Plotter 4/19/86
This package of programs contain a demonstration program
written in Turbo Pascal along with a set of procedures for
plotting high resolution (640x400 pixel) graphs. The plotter
routines are intended for engineering and scientific applications
where X-Y coordinate line plots are needed and where standard
color graphic adaptor screen dumps are inadequate. The routines
are simple to use and provide a high resolution hard copy from
printers compatible with the Epson MX-80/FX-80 dot graphics. It
has been tested on IBM PCs and ATs and a Radio Shack model 3000.
I have not tried it on any other systems. The software is
composed of three files:
o DEMOPLOT.PAS - A pascal demonstration program which uses
the Pascal graphics procedures contained in HiResPlt.pas.
o HiResPlt.PAS - A file of Pascal routines which are
necessary to draw axis and perform plotting. The procedures
work in conjunction with another program, HIPLOT2, written
in assembly code which actually performs the plotting.
HiResPlt.pas is used as an "include" file in programs like
DEMOPLOT which require graphics.
o HIPLOT2.EXE - This assembly code plotter attaches itself
to the system as a run-and-remain-resident program
accessible via a single interrupt. Access through interrupt
was chosen to simplify interfacing to higher level
languages. As a result, only the interface routines need to
be customized to a particular compiler.
o PLOTTER.DOC - This description of the plotter software.
BACKGROUND:
HIPLOT2 was originally written to provide a higher
resolution curve than was available with the 640x200 pixel
resolution of an IBM Color Graphics Adapter (CGA). HIPLOT2
"draws" the plot into a large buffer to a resolution of 640x400
pixels. At the same time, it can optionally draw a lower
resolution curve of 640x200 pixels on the CGA. When a hardcopy
is requested, the higher resolution curve is sent from the buffer
to the printer in the Epson bit graphics format. This is to be
contrasted with a screen dump which has the same resolution as
the display.
Because the printed resolution is different from the
displayed resolution, the characters stored in the buffer and
printed on the hardcopy are selected from a different character
matrix made compatible with the higher resolution. The CGA,
however, receives the lower resolution IBM ROM character set.
HIPLOT2 maps the character matrix to the CGA differently than is
done in other graphics packages like BASICA. Mapping is done on
1
a pixel boundary where the characters can be placed anywhere on
the CGA display. In BASICA, placement is restricted to column-
row boundarys. Bit mapping provides flexibility when labeling
axis tics.
Future plans include modifying HIPLOT2 to use the higher
resolution of the IBM Enhanced Graphics Adapter (EGA) if used,
however until then, the software uses the highest resolution
available on the CGA. It will work on the EGA but only the
reduced 640x200 resolution compatible with the CGA. You may need
to type "mode co80" before running the graphics software. If you
notice loss of sync when using a card other than the color
graphics card, you may need to reboot to avoid damage to your
monitor.
DEMOPLOT.PAS is a small demonstration program. The user
should try the demonstration program first to see how it works.
This is done by first running HIPLOT2 to load the machine code
plotter into memory and then running Turbo Pascal with
DEMOPLOT.PAS as the work file. Again, you may need to run "mode
co80" before running Turbo if you use an EGA.
The demonstration program first asks if a color graphics
card is available. If a no is given, plotting to the screen is
suppressed. The program then draws a diagonal line and a box.
It then allows the user to position a crosshair using the cursor
keys. Absolute coordinates are displayed at the top of the
screen. When the user presses <enter>, the program will ask if a
hard copy is desired. A "y" followed by an <enter> will cause
the program to attempt to send the plot to the printer. Any
other character or simply an <enter> will cause the program to go
to the next demonstration.
The next demonstration is a more realistic plot of the
absolute value of a sine wave followed by a simple dotted line.
Again, the user is given the opportunity to read out the
coordinates of the curve with a crosshair and then to get a hard
copy of the curve. To simply view the operation of the plotter,
simply keep hitting <enter> and the demonstration will progress
from beginning to end.
2
If you have the same hardware configuration as I, you should
have no problem running the program. I do not have the resources
to try the software on any more than a few systems so I cannot
say what will or will not work. The two systems which I have
been able to use the software on are:
Configuration: 1 2
Type: IBM PC, 256k main board IBM AT
Graphics board: IBM CGA IBM EGA
Disc Drives: 2ea. Teac DSDD Floppies 20 Mbyte hard disc
Total RAM: 640k 512k
IBM DOS version: 2.0 3.10
It also seems to run on a Radio Shack model 3000.
The only difference between the operation on the above
systems involves the timing used to fast move the crosshair.
Look in the source code and set the value of a constant MinCount
in procedure Crosshair. Correctly setting it is not mandatory
but it removes the jerkyness that might otherwise exist of the
value is not set for your system.
There are several reasons why the software may not work on
your system. First, of course, is that you may have a very
different display board than I do. The software will try to plot
points using interrupt 10h. If your graphics adapter modifies
this interrupt routine, the results will be unpredictable.
Secondly, HIPLOT2 will try to attach a pointer to itself at
interrupt 64h. If you already have something attached to that
interrupt, the software will give you an error message and abort.
Some hard disk software configurations, for instance, may attach
their software to the same pointer, so be careful.
Finally, there have been reports of damage to monitors if
they are driven by the wrong sync. Since this software does not
address the hardware directly, there should be no problem.
HiResPlt uses the Turbo graphics procedures and HIPLOT2 plots
points via interrupt 10H, therefore there should be no problem.
If you use a different display adaptor, you should verify that a
sync error will not occur.
Because of the wide variety of configurations, the following
disclaimer is necessary:
DISCLAIMER:
This software is provided free for public domain on an "as
is" basis for others to use on a non-profit basis. The Author
will in no way be held responsible to you or to any third party
for any damages such as lost profits or savings or other
incidental or consequential damages resulting from the use of
this software or its misuse whether or not the Author has been
advised of the possibility of such damages.
3
DESCRIPTION OF PROCEDURES IN HiResPlt
The plotter procedures and functions described next are all
part of the plotter package. The demonstration program does not
have any procedures or functions unique to it alone.
Hcmd(CMD,I1,I2:integer)
This and Htext perform the actual interrupts to HIPLOT2.
Hcmd has three arguments. CMD is a command integer which tells
HIPLOT2 what you want it to do. I1 and I2, also integers, are
the parameters which may be required. When coordinates are to be
specified, I1 represents X and I2 represents Y.
Command Function
0 Set origin (cursor) of next curve to point I1,I2
1 Plot line from last point (origin) to I1,I2
2 Not used from Hcmd. See Htext
3 Clear plotter buffer and, if selected, the CRT screen
4 Make hardcopy on Epson MX-80 or equivalent printer
5 Home cursor to x=0, y=0.
6 Set mode bits to least significant byte of I1
7 Set line pattern to pattern in I1
8 Set pixel "color". I1=0 for white (Erase), I1=1 for
black (default). Used to erase curve.
9 Do not use
10 Do not use
11 Set x window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
12 Set y window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
13 Do not use
Htext(CMD:Integer, S:String, I:Integer)-
This is similar to Hcmd except it is intended for text
command 2 where S is the string to be placed on the graph at the
cursor location and I is the maximum length. The string printed
will be the lesser of the length of the string or I.
Hdraw(IX1,IY1,IX2,IY2)-
This draws a line from IX1, IY1 to IX2, IY2 in the non-axis
mode. It is similar to Plot except it uses absolute co-ordinates
and does not draw from the last point.
Pattern(I:Integer)-
4
This sets the line pattern to reflect the bit pattern of the
integer, I. If used, it must be placed after Axis or SetPlot.
Note that Pattern($FFFF) will make a solid line and
Pattern($CCCC) will produce a dotted line with medium length
dots.
ScreenOn and ScreenOff-
These procedures enable or disable plotting to the CRT.
Normally, ScreenOn would be used unless the system does not have
an IBM color graphic adapter such as the CGA or the EGA, or
something equivalent.
ToUpper(S:String)- This simply converts string S to upper case.
Beep- This just makes a short beep near middle C.
Alarm- This produces a more noticeable tone
SetOption(B:Byte)-
HIPLOT2 has a set of 8 flags which select options. These
are only useful to other procedures. If interested, refer to the
comments in the routine.
Option(I:Integer, B:Boolean)-
The same comments as for SetOption. This just allows the
individual setting of the bits.
BW80-
This resets the CRT back to text mode after a plot.
Cls-
This clears the screen. It has no effect on the plotter
buffer. Clearing the buffer is done with Hcmd using command 3.
Box(IX1,IY1,IX2,IY2)-
This will draw a box with the main diagonal from IX1, IY1 to
IX2, IY2.
5
FindReal(IX,IY:Integer, Xval,Yval:Real)-
This converts the integer absolute screen values to the real
values computed by Axis. It is not used in non-axis plotting.
SetCross(IX,IY:Integer)-
A utility routine for placing a crosshair on the plot. User
does not need to use this directly. It is called by Crosshair.
DaTime(I:Integer)-
This places the date and the time at the left and right
sides of the plot. It is invoked in Axis so you do not need it
unless you plan to use SetPlot instead. I=0 places them at the
bottom, I=1 places them at the top.
SetTypeComputer(I1,I2: Integer)-
This sets the timing in the crosshair updating routine to
match the type of computer used. This routine allows low rate
keypresses to move the crosshair in small steps and fast
keypresses to move the crosshair in large steps. It is not
required to invoke this routine, but it makes the operation of
the crosshair appear smoother.
Crosshair(Ix,Iy:Integer)-
This draws a crosshair on either an axis or a non-axis plot
and allows the user to read out the values into the integers Ix,
Iy. In the axis mode, Ix, Iy should be converted to real graph
values by using FindReal.
Hcopy(Str1,Str2:string)-
If Str1 is the string "PAUSE", the routine will ask if a
hardcopy is desired. Without it, a hardcopy is automatically
made. If Str2 is the string "EJECT", then a page will be ejected
after plotting.
Vcheck-
This is a function which checks to see if the HIPLOT2
software is loaded. If it is not, Vcheck will be set to 0 else
Vcheck will be set equal the current HIPLOT2 version number if
HIPLOT2 is loaded.
FmtNum(Val:real)-
6
This is used by Axis to place a formatted number on the plot
at the current cursor position.
Xinit- This is used by Axis to initialize the plotter.
SetPlot-
This initializes the plotter for subsequent plotting for
cases where line drawings alone are desired (non-axis plotting).
The global scale factors are set to create a screen where x=0,
y=0 represents the upper left part of the screen as in Turbo's
Plot. The lower right co-ordinates are x=639, y=399. Note that
the vertical resolution is twice that of Turbo. This routine
takes the place of Axis. Either use SetPlot or Axis to
initialize the plotter.
Axis(X1,X2,X3,Y1,Y2,Y3:Real)-
This initializes the CRT and plotter buffer, draws the axis
and sets the required scale factors for later plotting. For a
linear X-axis, X1 is the start value, X2 is the stop value, and
X3 is the incremental value to be added at each tic. For a
Logarithmic X-axis, X1 is the starting decade, x2 is the number
of decades and x3=0. The same is true for the Y axis. When the
axis is drawn, if the values to be printed require an exponential
format, they are scaled with the multiplication factor placed
close by in a box near the axis. Not included in the parameter
list but used as a global variable is Alpha[n], where n ranges
from 1 to 9. These are the strings to be printed. Alpha[1] is
the x-axis label, Alpha[2] is the Y-axis label and the remainder
constitute the heading.
ReOrg-
This resets the origin flag so that the next point to be
plotted will become the starting point for the next curve. This
allows multiple curves to be plotted. This is used only in the
axis plotting mode.
Interpolate(Var I1,I2: Integer; I3,I4: Integer)-
When a program asks the plotter to plot out of the active
window, the plotter will stop plotting at the boundarys. HIPLOT2
simply stops placing pixels but acts as if the plot is
7
continuing. Because only integers are passed to HIPLOT2, it is
possible for overflow to place the point at the other side of the
active window. Interpolate helps calculate the point
corresponding to the edge of the window to allow limiting the
line drawn to the boundary to avoid the problem. The routine is
intended for internal use only.
Hplot(X,Y:real)-
The values of X,Y are plotted after being scaled. The
scaling is based on the values selected by the user in the call
to Axis. There is no separate windowing or whatever as in more
sophisticated plotter packages. This is used only in the axis
mode. For non-axis mode, use Hdraw.
Insert(X,Y:Real, I:Integer)-
This places the single digit integer, I, at a location on
the plot specified by X and Y. X and Y are real quantities. I
ranges from 1 through 9.
FINAL COMMENTS:
That's it. The plotter package is meant to be easy to use
at the expense of some flexibility. This is the first version to
be released although I have used various versions in my own work
for several years in Turbo-Pascal, FORTRAN and BASIC. I would
like to revisit this software in detail in a few months and I
would appreciate any comments and suggested modifications. I
have not released the source for HIPLOT2 yet since I plan to make
some significant changes. One of these may be a search algorithm
to place the routine at an available interrupt in case the one
currently used has already been taken. Another will be to allow
drawing a high resolution curve on the enhanced graphics adapter.
Please send comments and suggestions to me. Please describe
your machine. I would like to know if there are clones that
have problems with this software.
Roger Coleman
2011 Bradway St NE
Palm Bay, Fl
32905
(305) 724-6873
8
A Final Note:
Cursor speed constant:
The demonstration program was modified to allow direct
entry of MinCount99 which sets the minimum count between any two
keypresses of the same cursor control arrow. This discriminates
between two finger taps and holding the key down. The latter
means to move the cursor in bigger steps. Unfortunately, this
test makes the software processor speed sensitive.
In retrospect, I should have calculated time using the
system clock rather than relying on processor speed because of
the wide variety of machines in the world. Alas, its too late
now. That will be left for the next version when I add mouse
software.
DEMOPLOT was modified at the last moment to allow you to
select the value for the speed constant. If my suggestions do
not work best for your machine, try doubling the constant by a
factor of 2 to move the cursor quickly when the key is held down.
Reduce the constant by a factor by 2 to allow the cursor to move
in small steps on individual key presses. You can fine tune the
value if you want. The number is typed as a constant.
NEW HIPLOT2:
The current HIPLOT2 version is 10-08-86 8:40PM and it replaces
the version 2-23-86 12:08PM. The only difference is to modify
hardcopy routine for faster output. It now uses INT 17h rather
than the much slower INT 21h.
OLD WARNING MESSAGE:
The documentation has a stiff warning to make the user pay
attention when he first tries it on his system. After using
the software on a number of clones, it appears that the worst
thing that should happen is that HIPLOT2 will not load. It looks
to see if the interrupt is occupied before installing itself.
If the vector is 0000:0000 then it assumes it to be available.
If not, it says that 64h is occupied and returns you to the
system. The Pascal procedures have a function Vcheck which
looks for the 16 bit sequence A55Ah and a valid version number.
To keep the plotting routines as fast as possible, the check is
done only once. If something changes the vector during a plot
than there could be a problem. Just make sure to include
Vcheck in your software and avoid changing int 64h during a plot.
COMPATIBILITIES:
I have found the software to work on:
o IBM PC
o IBM XT
o IBM AT
o PC Limited 8 Mhz AT
o Wells American 8 Mhz
o Wells American 10 Mhz
o Lanier C-2400 AT
o Radio Shack 3000
I have not kept a list of printers that it works on but I know
it has worked on a good number. The only printer that did not work
well with it was a Star Radix-15 which does not work with 123
graphs either for the same reason. The bit mapped graphics are
8 pixels high and a line feed should skip 8 pixels worth. The
Star skips more and leaves a gap. Just my luck that the printer
happens to belong to my fiance'.
INCOMPATIBILITIES:
o Some network software use the same interrupt vector and Hiplot2
will not allow loading. If you network, try not installing the
network software prior to plotting to your printer.
o As I said, the Star Radix-15 skips lines.
R. Coleman 1/18/87
PLOTTER.DOC Documentation for Plotter 4/19/86
This package of programs contain a demonstration program
written in Turbo Pascal along with a set of procedures for
plotting high resolution (640x400 pixel) graphs. The plotter
routines are intended for engineering and scientific applications
where X-Y coordinate line plots are needed and where standard
color graphic adaptor screen dumps are inadequate. The routines
are simple to use and provide a high resolution hard copy from
printers compatible with the Epson MX-80/FX-80 dot graphics. It
has been tested on IBM PCs and ATs and a Radio Shack model 3000.
I have not tried it on any other systems. The software is
composed of three files:
o DEMOPLOT.PAS - A pascal demonstration program which uses
the Pascal graphics procedures contained in HiResPlt.pas.
o HiResPlt.PAS - A file of Pascal routines which are
necessary to draw axis and perform plotting. The procedures
work in conjunction with another program, HIPLOT2, written
in assembly code which actually performs the plotting.
HiResPlt.pas is used as an "include" file in programs like
DEMOPLOT which require graphics.
o HIPLOT2.EXE - This assembly code plotter attaches itself
to the system as a run-and-remain-resident program
accessible via a single interrupt. Access through interrupt
was chosen to simplify interfacing to higher level
languages. As a result, only the interface routines need to
be customized to a particular compiler.
o PLOTTER.DOC - This description of the plotter software.
BACKGROUND:
HIPLOT2 was originally written to provide a higher
resolution curve than was available with the 640x200 pixel
resolution of an IBM Color Graphics Adapter (CGA). HIPLOT2
"draws" the plot into a large buffer to a resolution of 640x400
pixels. At the same time, it can optionally draw a lower
resolution curve of 640x200 pixels on the CGA. When a hardcopy
is requested, the higher resolution curve is sent from the buffer
to the printer in the Epson bit graphics format. This is to be
contrasted with a screen dump which has the same resolution as
the display.
Because the printed resolution is different from the
displayed resolution, the characters stored in the buffer and
printed on the hardcopy are selected from a different character
matrix made compatible with the higher resolution. The CGA,
however, receives the lower resolution IBM ROM character set.
HIPLOT2 maps the character matrix to the CGA differently than is
done in other graphics packages like BASICA. Mapping is done on
1
a pixel boundary where the characters can be placed anywhere on
the CGA display. In BASICA, placement is restricted to column-
row boundarys. Bit mapping provides flexibility when labeling
axis tics.
Future plans include modifying HIPLOT2 to use the higher
resolution of the IBM Enhanced Graphics Adapter (EGA) if used,
however until then, the software uses the highest resolution
available on the CGA. It will work on the EGA but only the
reduced 640x200 resolution compatible with the CGA. You may need
to type "mode co80" before running the graphics software. If you
notice loss of sync when using a card other than the color
graphics card, you may need to reboot to avoid damage to your
monitor.
DEMOPLOT.PAS is a small demonstration program. The user
should try the demonstration program first to see how it works.
This is done by first running HIPLOT2 to load the machine code
plotter into memory and then running Turbo Pascal with
DEMOPLOT.PAS as the work file. Again, you may need to run "mode
co80" before running Turbo if you use an EGA.
The demonstration program first asks if a color graphics
card is available. If a no is given, plotting to the screen is
suppressed. The program then draws a diagonal line and a box.
It then allows the user to position a crosshair using the cursor
keys. Absolute coordinates are displayed at the top of the
screen. When the user presses <enter>, the program will ask if a
hard copy is desired. A "y" followed by an <enter> will cause
the program to attempt to send the plot to the printer. Any
other character or simply an <enter> will cause the program to go
to the next demonstration.
The next demonstration is a more realistic plot of the
absolute value of a sine wave followed by a simple dotted line.
Again, the user is given the opportunity to read out the
coordinates of the curve with a crosshair and then to get a hard
copy of the curve. To simply view the operation of the plotter,
simply keep hitting <enter> and the demonstration will progress
from beginning to end.
2
If you have the same hardware configuration as I, you should
have no problem running the program. I do not have the resources
to try the software on any more than a few systems so I cannot
say what will or will not work. The two systems which I have
been able to use the software on are:
Configuration: 1 2
Type: IBM PC, 256k main board IBM AT
Graphics board: IBM CGA IBM EGA
Disc Drives: 2ea. Teac DSDD Floppies 20 Mbyte hard disc
Total RAM: 640k 512k
IBM DOS version: 2.0 3.10
It also seems to run on a Radio Shack model 3000.
The only difference between the operation on the above
systems involves the timing used to fast move the crosshair.
Look in the source code and set the value of a constant MinCount
in procedure Crosshair. Correctly setting it is not mandatory
but it removes the jerkyness that might otherwise exist of the
value is not set for your system.
There are several reasons why the software may not work on
your system. First, of course, is that you may have a very
different display board than I do. The software will try to plot
points using interrupt 10h. If your graphics adapter modifies
this interrupt routine, the results will be unpredictable.
Secondly, HIPLOT2 will try to attach a pointer to itself at
interrupt 64h. If you already have something attached to that
interrupt, the software will give you an error message and abort.
Some hard disk software configurations, for instance, may attach
their software to the same pointer, so be careful.
Finally, there have been reports of damage to monitors if
they are driven by the wrong sync. Since this software does not
address the hardware directly, there should be no problem.
HiResPlt uses the Turbo graphics procedures and HIPLOT2 plots
points via interrupt 10H, therefore there should be no problem.
If you use a different display adaptor, you should verify that a
sync error will not occur.
Because of the wide variety of configurations, the following
disclaimer is necessary:
DISCLAIMER:
This software is provided free for public domain on an "as
is" basis for others to use on a non-profit basis. The Author
will in no way be held responsible to you or to any third party
for any damages such as lost profits or savings or other
incidental or consequential damages resulting from the use of
this software or its misuse whether or not the Author has been
advised of the possibility of such damages.
3
DESCRIPTION OF PROCEDURES IN HiResPlt
The plotter procedures and functions described next are all
part of the plotter package. The demonstration program does not
have any procedures or functions unique to it alone.
Hcmd(CMD,I1,I2:integer)
This and Htext perform the actual interrupts to HIPLOT2.
Hcmd has three arguments. CMD is a command integer which tells
HIPLOT2 what you want it to do. I1 and I2, also integers, are
the parameters which may be required. When coordinates are to be
specified, I1 represents X and I2 represents Y.
Command Function
0 Set origin (cursor) of next curve to point I1,I2
1 Plot line from last point (origin) to I1,I2
2 Not used from Hcmd. See Htext
3 Clear plotter buffer and, if selected, the CRT screen
4 Make hardcopy on Epson MX-80 or equivalent printer
5 Home cursor to x=0, y=0.
6 Set mode bits to least significant byte of I1
7 Set line pattern to pattern in I1
8 Set pixel "color". I1=0 for white (Erase), I1=1 for
black (default). Used to erase curve.
9 Do not use
10 Do not use
11 Set x window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
12 Set y window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
13 Do not use
Htext(CMD:Integer, S:String, I:Integer)-
This is similar to Hcmd except it is intended for text
command 2 where S is the string to be placed on the graph at the
cursor location and I is the maximum length. The string printed
will be the lesser of the length of the string or I.
Hdraw(IX1,IY1,IX2,IY2)-
This draws a line from IX1, IY1 to IX2, IY2 in the non-axis
mode. It is similar to Plot except it uses absolute co-ordinates
and does not draw from the last point.
Pattern(I:Integer)-
4
This sets the line pattern to reflect the bit pattern of the
integer, I. If used, it must be placed after Axis or SetPlot.
Note that Pattern($FFFF) will make a solid line and
Pattern($CCCC) will produce a dotted line with medium length
dots.
ScreenOn and ScreenOff-
These procedures enable or disable plotting to the CRT.
Normally, ScreenOn would be used unless the system does not have
an IBM color graphic adapter such as the CGA or the EGA, or
something equivalent.
ToUpper(S:String)- This simply converts string S to upper case.
Beep- This just makes a short beep near middle C.
Alarm- This produces a more noticeable tone
SetOption(B:Byte)-
HIPLOT2 has a set of 8 flags which select options. These
are only useful to other procedures. If interested, refer to the
comments in the routine.
Option(I:Integer, B:Boolean)-
The same comments as for SetOption. This just allows the
individual setting of the bits.
BW80-
This resets the CRT back to text mode after a plot.
Cls-
This clears the screen. It has no effect on the plotter
buffer. Clearing the buffer is done with Hcmd using command 3.
Box(IX1,IY1,IX2,IY2)-
This will draw a box with the main diagonal from IX1, IY1 to
IX2, IY2.
5
FindReal(IX,IY:Integer, Xval,Yval:Real)-
This converts the integer absolute screen values to the real
values computed by Axis. It is not used in non-axis plotting.
SetCross(IX,IY:Integer)-
A utility routine for placing a crosshair on the plot. User
does not need to use this directly. It is called by Crosshair.
DaTime(I:Integer)-
This places the date and the time at the left and right
sides of the plot. It is invoked in Axis so you do not need it
unless you plan to use SetPlot instead. I=0 places them at the
bottom, I=1 places them at the top.
SetTypeComputer(I1,I2: Integer)-
This sets the timing in the crosshair updating routine to
match the type of computer used. This routine allows low rate
keypresses to move the crosshair in small steps and fast
keypresses to move the crosshair in large steps. It is not
required to invoke this routine, but it makes the operation of
the crosshair appear smoother.
Crosshair(Ix,Iy:Integer)-
This draws a crosshair on either an axis or a non-axis plot
and allows the user to read out the values into the integers Ix,
Iy. In the axis mode, Ix, Iy should be converted to real graph
values by using FindReal.
Hcopy(Str1,Str2:string)-
If Str1 is the string "PAUSE", the routine will ask if a
hardcopy is desired. Without it, a hardcopy is automatically
made. If Str2 is the string "EJECT", then a page will be ejected
after plotting.
Vcheck-
This is a function which checks to see if the HIPLOT2
software is loaded. If it is not, Vcheck will be set to 0 else
Vcheck will be set equal the current HIPLOT2 version number if
HIPLOT2 is loaded.
FmtNum(Val:real)-
6
This is used by Axis to place a formatted number on the plot
at the current cursor position.
Xinit- This is used by Axis to initialize the plotter.
SetPlot-
This initializes the plotter for subsequent plotting for
cases where line drawings alone are desired (non-axis plotting).
The global scale factors are set to create a screen where x=0,
y=0 represents the upper left part of the screen as in Turbo's
Plot. The lower right co-ordinates are x=639, y=399. Note that
the vertical resolution is twice that of Turbo. This routine
takes the place of Axis. Either use SetPlot or Axis to
initialize the plotter.
Axis(X1,X2,X3,Y1,Y2,Y3:Real)-
This initializes the CRT and plotter buffer, draws the axis
and sets the required scale factors for later plotting. For a
linear X-axis, X1 is the start value, X2 is the stop value, and
X3 is the incremental value to be added at each tic. For a
Logarithmic X-axis, X1 is the starting decade, x2 is the number
of decades and x3=0. The same is true for the Y axis. When the
axis is drawn, if the values to be printed require an exponential
format, they are scaled with the multiplication factor placed
close by in a box near the axis. Not included in the parameter
list but used as a global variable is Alpha[n], where n ranges
from 1 to 9. These are the strings to be printed. Alpha[1] is
the x-axis label, Alpha[2] is the Y-axis label and the remainder
constitute the heading.
ReOrg-
This resets the origin flag so that the next point to be
plotted will become the starting point for the next curve. This
allows multiple curves to be plotted. This is used only in the
axis plotting mode.
Interpolate(Var I1,I2: Integer; I3,I4: Integer)-
When a program asks the plotter to plot out of the active
window, the plotter will stop plotting at the boundarys. HIPLOT2
simply stops placing pixels but acts as if the plot is
7
continuing. Because only integers are passed to HIPLOT2, it is
possible for overflow to place the point at the other side of the
active window. Interpolate helps calculate the point
corresponding to the edge of the window to allow limiting the
line drawn to the boundary to avoid the problem. The routine is
intended for internal use only.
Hplot(X,Y:real)-
The values of X,Y are plotted after being scaled. The
scaling is based on the values selected by the user in the call
to Axis. There is no separate windowing or whatever as in more
sophisticated plotter packages. This is used only in the axis
mode. For non-axis mode, use Hdraw.
Insert(X,Y:Real, I:Integer)-
This places the single digit integer, I, at a location on
the plot specified by X and Y. X and Y are real quantities. I
ranges from 1 through 9.
FINAL COMMENTS:
That's it. The plotter package is meant to be easy to use
at the expense of some flexibility. This is the first version to
be released although I have used various versions in my own work
for several years in Turbo-Pascal, FORTRAN and BASIC. I would
like to revisit this software in detail in a few months and I
would appreciate any comments and suggested modifications. I
have not released the source for HIPLOT2 yet since I plan to make
some significant changes. One of these may be a search algorithm
to place the routine at an available interrupt in case the one
currently used has already been taken. Another will be to allow
drawing a high resolution curve on the enhanced graphics adapter.
Please send comments and suggestions to me. Please describe
your machine. I would like to know if there are clones that
have problems with this software.
Roger Coleman
2011 Bradway St NE
Palm Bay, Fl
32905
(305) 724-6873
8
A Final Note:
Cursor speed constant:
The demonstration program was modified to allow direct
entry of MinCount99 which sets the minimum count between any two
keypresses of the same cursor control arrow. This discriminates
between two finger taps and holding the key down. The latter
means to move the cursor in bigger steps. Unfortunately, this
test makes the software processor speed sensitive.
In retrospect, I should have calculated time using the
system clock rather than relying on processor speed because of
the wide variety of machines in the world. Alas, its too late
now. That will be left for the next version when I add mouse
software.
DEMOPLOT was modified at the last moment to allow you to
select the value for the speed constant. If my suggestions do
not work best for your machine, try doubling the constant by a
factor of 2 to move the cursor quickly when the key is held down.
Reduce the constant by a factor by 2 to allow the cursor to move
in small steps on individual key presses. You can fine tune the
value if you want. The number is typed as a constant.
NEW HIPLOT2:
The current HIPLOT2 version is 10-08-86 8:40PM and it replaces
the version 2-23-86 12:08PM. The only difference is to modify
hardcopy routine for faster output. It now uses INT 17h rather
than the much slower INT 21h.
OLD WARNING MESSAGE:
The documentation has a stiff warning to make the user pay
attention when he first tries it on his system. After using
the software on a number of clones, it appears that the worst
thing that should happen is that HIPLOT2 will not load. It looks
to see if the interrupt is occupied before installing itself.
If the vector is 0000:0000 then it assumes it to be available.
If not, it says that 64h is occupied and returns you to the
system. The Pascal procedures have a function Vcheck which
looks for the 16 bit sequence A55Ah and a valid version number.
To keep the plotting routines as fast as possible, the check is
done only once. If something changes the vector during a plot
than there could be a problem. Just make sure to include
Vcheck in your software and avoid changing int 64h during a plot.
COMPATIBILITIES:
I have found the software to work on:
o IBM PC
o IBM XT
o IBM AT
o PC Limited 8 Mhz AT
o Wells American 8 Mhz
o Wells American 10 Mhz
o Lanier C-2400 AT
o Radio Shack 3000
I have not kept a list of printers that it works on but I know
it has worked on a good number. The only printer that did not work
well with it was a Star Radix-15 which does not work with 123
graphs either for the same reason. The bit mapped graphics are
8 pixels high and a line feed should skip 8 pixels worth. The
Star skips more and leaves a gap. Just my luck that the printer
happens to belong to my fiance'.
INCOMPATIBILITIES:
o Some network software use the same interrupt vector and Hiplot2
will not allow loading. If you network, try not installing the
network software prior to plotting to your printer.
o As I said, the Star Radix-15 skips lines.
R. Coleman 1/18/87
PLOTTER.DOC Documentation for Plotter 4/19/86
This package of programs contain a demonstration program
written in Turbo Pascal along with a set of procedures for
plotting high resolution (640x400 pixel) graphs. The plotter
routines are intended for engineering and scientific applications
where X-Y coordinate line plots are needed and where standard
color graphic adaptor screen dumps are inadequate. The routines
are simple to use and provide a high resolution hard copy from
printers compatible with the Epson MX-80/FX-80 dot graphics. It
has been tested on IBM PCs and ATs and a Radio Shack model 3000.
I have not tried it on any other systems. The software is
composed of three files:
o DEMOPLOT.PAS - A pascal demonstration program which uses
the Pascal graphics procedures contained in HiResPlt.pas.
o HiResPlt.PAS - A file of Pascal routines which are
necessary to draw axis and perform plotting. The procedures
work in conjunction with another program, HIPLOT2, written
in assembly code which actually performs the plotting.
HiResPlt.pas is used as an "include" file in programs like
DEMOPLOT which require graphics.
o HIPLOT2.EXE - This assembly code plotter attaches itself
to the system as a run-and-remain-resident program
accessible via a single interrupt. Access through interrupt
was chosen to simplify interfacing to higher level
languages. As a result, only the interface routines need to
be customized to a particular compiler.
o PLOTTER.DOC - This description of the plotter software.
BACKGROUND:
HIPLOT2 was originally written to provide a higher
resolution curve than was available with the 640x200 pixel
resolution of an IBM Color Graphics Adapter (CGA). HIPLOT2
"draws" the plot into a large buffer to a resolution of 640x400
pixels. At the same time, it can optionally draw a lower
resolution curve of 640x200 pixels on the CGA. When a hardcopy
is requested, the higher resolution curve is sent from the buffer
to the printer in the Epson bit graphics format. This is to be
contrasted with a screen dump which has the same resolution as
the display.
Because the printed resolution is different from the
displayed resolution, the characters stored in the buffer and
printed on the hardcopy are selected from a different character
matrix made compatible with the higher resolution. The CGA,
however, receives the lower resolution IBM ROM character set.
HIPLOT2 maps the character matrix to the CGA differently than is
done in other graphics packages like BASICA. Mapping is done on
1
a pixel boundary where the characters can be placed anywhere on
the CGA display. In BASICA, placement is restricted to column-
row boundarys. Bit mapping provides flexibility when labeling
axis tics.
Future plans include modifying HIPLOT2 to use the higher
resolution of the IBM Enhanced Graphics Adapter (EGA) if used,
however until then, the software uses the highest resolution
available on the CGA. It will work on the EGA but only the
reduced 640x200 resolution compatible with the CGA. You may need
to type "mode co80" before running the graphics software. If you
notice loss of sync when using a card other than the color
graphics card, you may need to reboot to avoid damage to your
monitor.
DEMOPLOT.PAS is a small demonstration program. The user
should try the demonstration program first to see how it works.
This is done by first running HIPLOT2 to load the machine code
plotter into memory and then running Turbo Pascal with
DEMOPLOT.PAS as the work file. Again, you may need to run "mode
co80" before running Turbo if you use an EGA.
The demonstration program first asks if a color graphics
card is available. If a no is given, plotting to the screen is
suppressed. The program then draws a diagonal line and a box.
It then allows the user to position a crosshair using the cursor
keys. Absolute coordinates are displayed at the top of the
screen. When the user presses <enter>, the program will ask if a
hard copy is desired. A "y" followed by an <enter> will cause
the program to attempt to send the plot to the printer. Any
other character or simply an <enter> will cause the program to go
to the next demonstration.
The next demonstration is a more realistic plot of the
absolute value of a sine wave followed by a simple dotted line.
Again, the user is given the opportunity to read out the
coordinates of the curve with a crosshair and then to get a hard
copy of the curve. To simply view the operation of the plotter,
simply keep hitting <enter> and the demonstration will progress
from beginning to end.
2
If you have the same hardware configuration as I, you should
have no problem running the program. I do not have the resources
to try the software on any more than a few systems so I cannot
say what will or will not work. The two systems which I have
been able to use the software on are:
Configuration: 1 2
Type: IBM PC, 256k main board IBM AT
Graphics board: IBM CGA IBM EGA
Disc Drives: 2ea. Teac DSDD Floppies 20 Mbyte hard disc
Total RAM: 640k 512k
IBM DOS version: 2.0 3.10
It also seems to run on a Radio Shack model 3000.
The only difference between the operation on the above
systems involves the timing used to fast move the crosshair.
Look in the source code and set the value of a constant MinCount
in procedure Crosshair. Correctly setting it is not mandatory
but it removes the jerkyness that might otherwise exist of the
value is not set for your system.
There are several reasons why the software may not work on
your system. First, of course, is that you may have a very
different display board than I do. The software will try to plot
points using interrupt 10h. If your graphics adapter modifies
this interrupt routine, the results will be unpredictable.
Secondly, HIPLOT2 will try to attach a pointer to itself at
interrupt 64h. If you already have something attached to that
interrupt, the software will give you an error message and abort.
Some hard disk software configurations, for instance, may attach
their software to the same pointer, so be careful.
Finally, there have been reports of damage to monitors if
they are driven by the wrong sync. Since this software does not
address the hardware directly, there should be no problem.
HiResPlt uses the Turbo graphics procedures and HIPLOT2 plots
points via interrupt 10H, therefore there should be no problem.
If you use a different display adaptor, you should verify that a
sync error will not occur.
Because of the wide variety of configurations, the following
disclaimer is necessary:
DISCLAIMER:
This software is provided free for public domain on an "as
is" basis for others to use on a non-profit basis. The Author
will in no way be held responsible to you or to any third party
for any damages such as lost profits or savings or other
incidental or consequential damages resulting from the use of
this software or its misuse whether or not the Author has been
advised of the possibility of such damages.
3
DESCRIPTION OF PROCEDURES IN HiResPlt
The plotter procedures and functions described next are all
part of the plotter package. The demonstration program does not
have any procedures or functions unique to it alone.
Hcmd(CMD,I1,I2:integer)
This and Htext perform the actual interrupts to HIPLOT2.
Hcmd has three arguments. CMD is a command integer which tells
HIPLOT2 what you want it to do. I1 and I2, also integers, are
the parameters which may be required. When coordinates are to be
specified, I1 represents X and I2 represents Y.
Command Function
0 Set origin (cursor) of next curve to point I1,I2
1 Plot line from last point (origin) to I1,I2
2 Not used from Hcmd. See Htext
3 Clear plotter buffer and, if selected, the CRT screen
4 Make hardcopy on Epson MX-80 or equivalent printer
5 Home cursor to x=0, y=0.
6 Set mode bits to least significant byte of I1
7 Set line pattern to pattern in I1
8 Set pixel "color". I1=0 for white (Erase), I1=1 for
black (default). Used to erase curve.
9 Do not use
10 Do not use
11 Set x window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
12 Set y window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
13 Do not use
Htext(CMD:Integer, S:String, I:Integer)-
This is similar to Hcmd except it is intended for text
command 2 where S is the string to be placed on the graph at the
cursor location and I is the maximum length. The string printed
will be the lesser of the length of the string or I.
Hdraw(IX1,IY1,IX2,IY2)-
This draws a line from IX1, IY1 to IX2, IY2 in the non-axis
mode. It is similar to Plot except it uses absolute co-ordinates
and does not draw from the last point.
Pattern(I:Integer)-
4
This sets the line pattern to reflect the bit pattern of the
integer, I. If used, it must be placed after Axis or SetPlot.
Note that Pattern($FFFF) will make a solid line and
Pattern($CCCC) will produce a dotted line with medium length
dots.
ScreenOn and ScreenOff-
These procedures enable or disable plotting to the CRT.
Normally, ScreenOn would be used unless the system does not have
an IBM color graphic adapter such as the CGA or the EGA, or
something equivalent.
ToUpper(S:String)- This simply converts string S to upper case.
Beep- This just makes a short beep near middle C.
Alarm- This produces a more noticeable tone
SetOption(B:Byte)-
HIPLOT2 has a set of 8 flags which select options. These
are only useful to other procedures. If interested, refer to the
comments in the routine.
Option(I:Integer, B:Boolean)-
The same comments as for SetOption. This just allows the
individual setting of the bits.
BW80-
This resets the CRT back to text mode after a plot.
Cls-
This clears the screen. It has no effect on the plotter
buffer. Clearing the buffer is done with Hcmd using command 3.
Box(IX1,IY1,IX2,IY2)-
This will draw a box with the main diagonal from IX1, IY1 to
IX2, IY2.
5
FindReal(IX,IY:Integer, Xval,Yval:Real)-
This converts the integer absolute screen values to the real
values computed by Axis. It is not used in non-axis plotting.
SetCross(IX,IY:Integer)-
A utility routine for placing a crosshair on the plot. User
does not need to use this directly. It is called by Crosshair.
DaTime(I:Integer)-
This places the date and the time at the left and right
sides of the plot. It is invoked in Axis so you do not need it
unless you plan to use SetPlot instead. I=0 places them at the
bottom, I=1 places them at the top.
SetTypeComputer(I1,I2: Integer)-
This sets the timing in the crosshair updating routine to
match the type of computer used. This routine allows low rate
keypresses to move the crosshair in small steps and fast
keypresses to move the crosshair in large steps. It is not
required to invoke this routine, but it makes the operation of
the crosshair appear smoother.
Crosshair(Ix,Iy:Integer)-
This draws a crosshair on either an axis or a non-axis plot
and allows the user to read out the values into the integers Ix,
Iy. In the axis mode, Ix, Iy should be converted to real graph
values by using FindReal.
Hcopy(Str1,Str2:string)-
If Str1 is the string "PAUSE", the routine will ask if a
hardcopy is desired. Without it, a hardcopy is automatically
made. If Str2 is the string "EJECT", then a page will be ejected
after plotting.
Vcheck-
This is a function which checks to see if the HIPLOT2
software is loaded. If it is not, Vcheck will be set to 0 else
Vcheck will be set equal the current HIPLOT2 version number if
HIPLOT2 is loaded.
FmtNum(Val:real)-
6
This is used by Axis to place a formatted number on the plot
at the current cursor position.
Xinit- This is used by Axis to initialize the plotter.
SetPlot-
This initializes the plotter for subsequent plotting for
cases where line drawings alone are desired (non-axis plotting).
The global scale factors are set to create a screen where x=0,
y=0 represents the upper left part of the screen as in Turbo's
Plot. The lower right co-ordinates are x=639, y=399. Note that
the vertical resolution is twice that of Turbo. This routine
takes the place of Axis. Either use SetPlot or Axis to
initialize the plotter.
Axis(X1,X2,X3,Y1,Y2,Y3:Real)-
This initializes the CRT and plotter buffer, draws the axis
and sets the required scale factors for later plotting. For a
linear X-axis, X1 is the start value, X2 is the stop value, and
X3 is the incremental value to be added at each tic. For a
Logarithmic X-axis, X1 is the starting decade, x2 is the number
of decades and x3=0. The same is true for the Y axis. When the
axis is drawn, if the values to be printed require an exponential
format, they are scaled with the multiplication factor placed
close by in a box near the axis. Not included in the parameter
list but used as a global variable is Alpha[n], where n ranges
from 1 to 9. These are the strings to be printed. Alpha[1] is
the x-axis label, Alpha[2] is the Y-axis label and the remainder
constitute the heading.
ReOrg-
This resets the origin flag so that the next point to be
plotted will become the starting point for the next curve. This
allows multiple curves to be plotted. This is used only in the
axis plotting mode.
Interpolate(Var I1,I2: Integer; I3,I4: Integer)-
When a program asks the plotter to plot out of the active
window, the plotter will stop plotting at the boundarys. HIPLOT2
simply stops placing pixels but acts as if the plot is
7
continuing. Because only integers are passed to HIPLOT2, it is
possible for overflow to place the point at the other side of the
active window. Interpolate helps calculate the point
corresponding to the edge of the window to allow limiting the
line drawn to the boundary to avoid the problem. The routine is
intended for internal use only.
Hplot(X,Y:real)-
The values of X,Y are plotted after being scaled. The
scaling is based on the values selected by the user in the call
to Axis. There is no separate windowing or whatever as in more
sophisticated plotter packages. This is used only in the axis
mode. For non-axis mode, use Hdraw.
Insert(X,Y:Real, I:Integer)-
This places the single digit integer, I, at a location on
the plot specified by X and Y. X and Y are real quantities. I
ranges from 1 through 9.
FINAL COMMENTS:
That's it. The plotter package is meant to be easy to use
at the expense of some flexibility. This is the first version to
be released although I have used various versions in my own work
for several years in Turbo-Pascal, FORTRAN and BASIC. I would
like to revisit this software in detail in a few months and I
would appreciate any comments and suggested modifications. I
have not released the source for HIPLOT2 yet since I plan to make
some significant changes. One of these may be a search algorithm
to place the routine at an available interrupt in case the one
currently used has already been taken. Another will be to allow
drawing a high resolution curve on the enhanced graphics adapter.
Please send comments and suggestions to me. Please describe
your machine. I would like to know if there are clones that
have problems with this software.
Roger Coleman
2011 Bradway St NE
Palm Bay, Fl
32905
(305) 724-6873
8
A Final Note:
Cursor speed constant:
The demonstration program was modified to allow direct
entry of MinCount99 which sets the minimum count between any two
keypresses of the same cursor control arrow. This discriminates
between two finger taps and holding the key down. The latter
means to move the cursor in bigger steps. Unfortunately, this
test makes the software processor speed sensitive.
In retrospect, I should have calculated time using the
system clock rather than relying on processor speed because of
the wide variety of machines in the world. Alas, its too late
now. That will be left for the next version when I add mouse
software.
DEMOPLOT was modified at the last moment to allow you to
select the value for the speed constant. If my suggestions do
not work best for your machine, try doubling the constant by a
factor of 2 to move the cursor quickly when the key is held down.
Reduce the constant by a factor by 2 to allow the cursor to move
in small steps on individual key presses. You can fine tune the
value if you want. The number is typed as a constant.
NEW HIPLOT2:
The current HIPLOT2 version is 10-08-86 8:40PM and it replaces
the version 2-23-86 12:08PM. The only difference is to modify
hardcopy routine for faster output. It now uses INT 17h rather
than the much slower INT 21h.
OLD WARNING MESSAGE:
The documentation has a stiff warning to make the user pay
attention when he first tries it on his system. After using
the software on a number of clones, it appears that the worst
thing that should happen is that HIPLOT2 will not load. It looks
to see if the interrupt is occupied before installing itself.
If the vector is 0000:0000 then it assumes it to be available.
If not, it says that 64h is occupied and returns you to the
system. The Pascal procedures have a function Vcheck which
looks for the 16 bit sequence A55Ah and a valid version number.
To keep the plotting routines as fast as possible, the check is
done only once. If something changes the vector during a plot
than there could be a problem. Just make sure to include
Vcheck in your software and avoid changing int 64h during a plot.
COMPATIBILITIES:
I have found the software to work on:
o IBM PC
o IBM XT
o IBM AT
o PC Limited 8 Mhz AT
o Wells American 8 Mhz
o Wells American 10 Mhz
o Lanier C-2400 AT
o Radio Shack 3000
I have not kept a list of printers that it works on but I know
it has worked on a good number. The only printer that did not work
well with it was a Star Radix-15 which does not work with 123
graphs either for the same reason. The bit mapped graphics are
8 pixels high and a line feed should skip 8 pixels worth. The
Star skips more and leaves a gap. Just my luck that the printer
happens to belong to my fiance'.
INCOMPATIBILITIES:
o Some network software use the same interrupt vector and Hiplot2
will not allow loading. If you network, try not installing the
network software prior to plotting to your printer.
o As I said, the Star Radix-15 skips lines.
R. Coleman 1/18/87
1 ' (PC)^3 Software Submission MAKSTKFL authored on January 4, 1983 by
2 '
3 ' Michael Csontos, 3228 Livonia Center Road, Lima, New York 14485
4 '
5 ' Copyright 1983 Michael Csontos
6 '
7 ' This program is made freely available non-exclusively to the Picture
8 ' City Personal Computer Programmers' Club for distribution to its members
9 ' and through software exchange to other users groups as long as credit is
10 ' given to the author and (PC)^3.
11 '
12 '
13 ' NOTE: The files MAKSTKFL.DOC, UPDSTKFL.DAT, and data files with the
14 ' extensions FRM, KEY, DTA, HDR, RPT, BAT and INX are associated with this
15 ' program.
16 '
10000 CLS:PRINT "INDXCARD - (C) 1983 Michael Csontos":PRINT
10100 PRINT "This program uses the IBM Color/Graphics Adapter,":PRINT
10200 PRINT "a 80 column display (not colored), and a disk drive.":PRINT
10300 PRINT "Printer commands issued by the program are for an EPSON MX-80.":PRINT
10400 PRINT "The size of the records created by this program requires":PRINT
10500 PRINT "that you enter BASICA with the disk buffer set to 1024 bytes.":PRINT
10600 PRINT "Use the command: BASICA INDXCARD /S:1024 to start if you get an":PRINT
10700 PRINT "error message."
10800 PRINT:PRINT:PRINT "Press any key to start."
10900 X$=INKEY$:IF X$="" THEN 10900
11000 DEF SEG=&HB800:DEFINT A-Z:DIM CK$(58),FLDUSED(18),FLD$(19,2),F$(18):SCREEN 0,0,0:COLOR 7,0,0:WIDTH 80:WIDTH"LPT1:",255:KEY OFF:M=0:CLS
11100 ON ERROR GOTO 11200:OPEN "indxcard.key" FOR INPUT AS #3:FOR N=1 TO 58:LINE INPUT #3,CK$(N):NEXT N:CLOSE #3:GOTO 11400
11200 CLOSE #3:RESUME 11300
11300 ON ERROR GOTO 0
11400 ON ERROR GOTO 12700:OPEN "indxcard.dta" FOR INPUT AS #2:CLOSE #2:ON ERROR GOTO 0
11500 PRINT "There is already a file called INDXCARD.DTA on the disk in the default drive. You have four choices:":PRINT
11600 PRINT " 1.) quit and copy or rename the file,":PRINT
11700 PRINT " 2.) print the data on index cards,":PRINT
11800 PRINT " 3.) add new data to that file,":PRINT
11900 PRINT " 4.) continue and erase the present file.
12000 PRINT:PRINT "Please press 1,2,3,or 4"
12100 X$=INKEY$:IF X$="" THEN 12100 ELSE AAA=ASC(X$)-48:IF AAA<1 OR AAA>4 THEN 12100 ELSE IF AAA=1 THEN 16400
12200 CLS:OPEN "indxcard.dta" AS #2 LEN=865
12300 FIELD #2,48 AS F$(1),48 AS F$(2),48 AS F$(3),48 AS F$(4),48 AS F$(5),48 AS F$(6),48 AS F$(7),48 AS F$(8),48 AS F$(9),48 AS F$(10),48 AS F$(11),48 AS F$(12),48 AS F$(13),48 AS F$(14),48 AS F$(15),48 AS F$(16),48 AS F$(17),48 AS F$(18),1 AS EF$
12400 LSET EF$=CHR$(10):IF AAA=2 THEN 15800 ELSE IF AAA<>3 THEN 12900
12500 Z!=LOF(2):CARD=Z!/865:IF CARD=0 THEN CARD=1
12600 GET #2,CARD:IF LEFT$(F$(1),1)="\" THEN 12900 ELSE CARD=CARD+1:GOTO 12900
12700 RESUME 12800
12800 ON ERROR GOTO 0:CARD=1:GOTO 12200
12900 ON ERROR GOTO 13200:OPEN "indxcard.frm" FOR INPUT AS #1:ON ERROR GOTO 0
13000 FOR N=1 TO 18:LINE INPUT #1,FLD$(N,0):NEXT N:CLOSE #1
13100 PRINT " The following card format is on the disk in your default drive. You may use it or edit it now using <Alt>+<F7>. Any changes will replace the file on the disk.":GOTO 14200
13200 CLOSE #1:RESUME 13300
13300 ON ERROR GOTO 0
13400 FOR N=1 TO 9:FLD$(N,0)=STRING$(10,CHR$(193))+"Field "+STR$(N)+STRING$(30,CHR$(193)):NEXT
13500 FOR N=10 TO 18:FLD$(N,0)=STRING$(10,CHR$(193))+"Field"+STR$(N)+STRING$(30,CHR$(193)):NEXT
13600 PRINT " Fill in the fields with anything that will help you fill in the card later. Leave fields as shown to leave them blank on the cards."
13700 LOCATE 23,33:PRINT "FIELD DEFINITION";:LOCATE 3,1:GOSUB 16500'CRDBLANK
13800 LOCATE 25,1:PRINT SPC(20)"PRESS <Alt>+<F8> WHEN FINISHED, <Alt>+<F1> TO QUIT";
13900 LOCATE 4,22,1:GOSUB 17100'CRDWRITE
14000 GOSUB 21400'scancard
14100 LOCATE 1,1:PRINT " The following is the format for your card. If you want to change it before continuing press <Alt><F7>. This will allow you to resume editing the format."
14200 LOCATE 3,1:GOSUB 16500'crdblank
14300 LOCATE 23,1:PRINT " If you continue, this format will be saved on disk in the file INDXCARD.FRM for possible future reference. ";
14400 GOSUB 16600:IF REPEAT=1 THEN CLS:GOTO 13600'nextpage
14500 GOSUB 22100'save card format
14600 LOCATE 1,1:PRINT " You may now start filling out the cards. To do this, simply type over any lines on the screen, using the screen editing keys. ";
14700 LOCATE 23,1:PRINT STRING$(159," ");
14800 LOCATE 25,1:PRINT "PRESS <Alt>+<F8> FOR NEXT CARD, <Alt>+<F1> TO QUIT, <Alt>+<F9> TO END THE FILE.";
14900 FINISH2=0:R=4:C=22:M=1
15000 IF FLD$(R-3,0)=STRING$(48," ") THEN R=R+1:GOTO 15000 ELSE RRR=R
15100 LOCATE 23,22:PRINT "CARD: "CARD" FILE SIZE: "LOF(2)" BYTES";:LOCATE RRR,22:GOSUB 17100'cardwrite
15200 IF FINISH2=1 THEN IF NTEND THEN CARD=LSTCRD:GOTO 15400 ELSE 15400 ELSE GOSUB 21400:GOSUB 22600'scancard,savecard
15300 IF NTEND=1 THEN CARD=LSTCRD:NTEND=0:GOTO 15100:ELSE CARD=CARD+1:GOTO 15100'next card
15400 LSET F$(1)="\":RSET F$(18)="\":RSET EF$="\":ON ERROR GOTO 24200:PUT #2,CARD:ON ERROR GOTO 0
15500 CLS:PRINT "You now have a file called INDXCARD.DTA which may be sorted, edited, or printed with the program PC-FILE and a file INDXCARD.KEY containing any <Alt>+<char.> definitions you may have entered.":PRINT
15600 OPEN "indxcard.key" FOR OUTPUT AS #3:FOR N=1 TO 58:PRINT #3,CK$(N):NEXT N:CLOSE #3
15700 PRINT "You may now print the cards in the file in the same order that they were enteredor stop and sort the file for printing later.":PRINT
15800 PRINT "If you are now ready to start printing cards, set up the printer so that the first card is positioned so that the print head is at its upper left hand corner.":PRINT
15900 PRINT " You may print continuously if you have form feed cards, but if you want the printer to stop after each card in an attempt to single-feed cards, then press <Alt><F7> to continue from this page.":PRINT
16000 PRINT " The printing will start immediately when you leave this page."
16100 GOSUB 16600:IF REPEAT=1 THEN SINGLE=1'nextpage
16200 GOSUB 22700'prntcard
16300 GOSUB 25500'prtsetup
16400 CLS:KEY ON:END
16500 LOCATE 3,16:PRINT CHR$(218)STRING$(48,CHR$(196))CHR$(191):FOR N=1 TO 18:LOCATE N+3,16:PRINT CHR$(179)FLD$(N,M)CHR$(179):NEXT N:LOCATE N+3,16:PRINT CHR$(192)STRING$(48,CHR$(196))CHR$(217);:RETURN'-----------CARDBLANK-----------------
16600 REPEAT=0:LOCATE 25,1:PRINT "PRESS ANY KEY TO CONTINUE EXCEPT <Esc> TO QUIT OR PRESS <Alt><F7>. ";'------------------NEXTPAGE------------------
16700 X$=INKEY$:IF LEN(X$)>1 THEN 17000 ELSE IF X$="" THEN GOTO 16700 ELSE IF X$=CHR$(27) THEN GOTO 16800 ELSE FOR N=0 TO 15:DUMP$=INKEY$:NEXT:RETURN
16800 LOCATE 25,1:PRINT "Are you sure you want to quit?"STRING$(49," ");:GOSUB 23600:ON A GOTO 16600,16900,16800'YESORNO
16900 KEY ON:COLOR 7,0,0:CLS:END
17000 IF ASC(RIGHT$(X$,1))=110 THEN REPEAT=1:RETURN ELSE 16700
17100 FINISH1=0:FOR N=1 TO 18:FLDUSED(N)=0:NEXT N:LOCATE ,,1'------cardwrite---
17200 X$=INKEY$:IF X$="" THEN 17200 ELSE I=0:B=0
17300 R=CSRLIN:C=POS(0):IF E=1 THEN LOCATE 24,1,0:PRINT STRING$(79," ");:E=0:LOCATE R,C,1
17400 IF LEN(X$)>1 THEN GOSUB 18500:IF FINISH1=1 OR FINISH2=1 THEN RETURN ELSE 17200'EXTNDCOD
17500 X=ASC(X$)'------------------------single byte keys---------------------
17600 IF X=13 AND R<21 AND M=0 THEN LOCATE R+1,22:GOTO 17200'carriage ret
17700 IF X=13 AND R<22 AND M>0 THEN R=R+1:IF FLD$(R-3,0)=STRING$(48," ") AND R<22 THEN 17700 ELSE IF R=22 THEN 17200 ELSE LOCATE R,22:GOTO 17200'
17800 IF X=8 AND C>17 THEN C=C-1:LOCATE ,C:GOSUB 30500:GOTO 17200'backspace
17900 IF X=9 THEN 29000'tab right
18000 IF X=27 THEN LOCATE R,17:PRINT FLD$(R-3,0);:FLDUSED(R-3)=0:LOCATE R,22:GOTO 17200'esc
18100 IF X<32 THEN 21100'non-character
18200 IF X<127 AND C<65 AND FLDUSED(R-3)=0 THEN LOCATE R,17:PRINT STRING$(48," ");:LOCATE R,C:FLDUSED(R-3)=1'clear field if first character
18300 IF X<127 AND C<65 THEN PRINT X$;:IF C=64 THEN LOCATE R,C:GOTO 17200 ELSE 17200'enter character
18400 GOTO 21100'not valid character
18500 X=ASC(RIGHT$(X$,1))'----------------two byte keys----------------------
18600 IF X=15 THEN 29200'shift tab
18700 IF X=71 THEN IF M=0 THEN LOCATE 4,22:RETURN ELSE IF FLD$(B+1,0)=STRING$(48," ") AND B<18 THEN B=B+1:GOTO 18700 ELSE LOCATE B+4,22:B=0:RETURN'home
18800 IF X=72 AND R>4 AND M=0 THEN PRINT CHR$(30);:RETURN'cursor up
18900 IF X=72 AND R>3 AND M>0 THEN R=R-1:IF FLD$(R-3,0)=STRING$(48," ") AND R>3 THEN 18900 ELSE IF R=3 THEN RETURN ELSE LOCATE R,C:RETURN'cursor up
19000 IF X=75 AND C>17 THEN PRINT CHR$(29);:RETURN'cursor left
19100 IF X=77 AND C<64 THEN PRINT CHR$(28);:RETURN'cursor right
19200 IF X=79 THEN 31400'end
19300 IF X=80 AND R<21 AND M=0 THEN PRINT CHR$(31);:RETURN'cursor down
19400 IF X=80 AND R<22 AND M>0 THEN R=R+1:IF FLD$(R-3,0)=STRING$(48," ") AND R<22 THEN 19400 ELSE IF R=22 THEN RETURN ELSE LOCATE R,C:RETURN'cursor down
19500 IF X=82 THEN 29400'insert
19600 IF X=83 THEN 30500'delete
19700 IF X=104 THEN LOCATE 25,1:PRINT "Are you sure you want to quit?" STRING$(49," ");:GOSUB 23600:ON A GOTO 21200,21300,21200'alt f1 - quit
19800 IF X=105 THEN LPRINT CHR$(27)CHR$(64);:GOSUB 25900:GOTO 25500'alt f2 - list f keys
19900 IF X=106 THEN 28300'alt f3 - list alt keys
20000 IF X=107 THEN 26600'alt f4 - program a alt-character key
20100 IF (X=108 OR X=132) AND CARD>1 THEN MV=-1:GOSUB 28700:LOCATE R,C:RETURN'alt f5 or <Ctrl>+<PgUp> - previous card
20200 IF (X=109 OR X=118) AND NTEND AND CARD<LSTCRD THEN MV=1:GOSUB 28700:LOCATE R,C:RETURN'alt f6 or <Ctrl>+<PgDn> - next card
20300 IF X=111 THEN FINISH1=1:RETURN'alt f8 - finished with card
20400 IF X=112 THEN FINISH2=1:RETURN'alt f9 - through entering cards
20500 IF X=113 THEN FLDUSED(R-3)=1:RETURN'alt f10 - edit displayed line
20600 IF X=115 THEN 29800'ctrl cursor left
20700 IF X=116 THEN 30700'ctrl cursor right
20800 IF X=117 THEN 31600'ctrl end
20900 IF X=119 THEN 31800'ctrl home
21000 Y=X:CHAR=0:GOSUB 27400:IF CHAR=0 THEN 21100 ELSE IF I=1 THEN 40000 ELSE IF FLDUSED(R-3)=0 THEN LOCATE R,17:PRINT STRING$(48," ");:LOCATE R,C:PRINT LEFT$(CK$(CHAR),65-C);:FLDUSED(R-3)=1:RETURN ELSE PRINT LEFT$(CK$(CHAR),65-C);:RETURN'print phrase
21100 LOCATE 24,1:E=1:PRINT "Not a valid character or command at this position. ASCII code:";:IF LEN(X$)>1 THEN PRINT ASC(LEFT$(X$,1)) ASC(RIGHT$(X$,1));:LOCATE R,C:RETURN ELSE PRINT ASC(X$);:LOCATE R,C:GOTO 17200
21200 LOCATE 25,1:PRINT SPC(20)"PRESS <Alt>+<F8> WHEN FINISHED, <Alt>+<F1> TO QUIT";:LOCATE R,C:RETURN
21300 CLS:CLOSE:KEY ON:END
21400 FOR N=1 TO 18'------------------------scancard------------------------
21500 LOCATE N+3,15,0:PRINT CHR$(26);:LOCATE N+2,15:PRINT " ";
21600 IF M>0 AND FLD$(N,0)=STRING$(48," ") THEN FLD$(N,M)=STRING$(48," "):GOTO 21900
21700 IF M=0 AND PEEK(352+160*N)=193 THEN FLD$(N,M)=STRING$(48," "):GOTO 21900
21800 FLD$(N,M)=" ":FOR P=1 TO 48:FLD$(N,M)=FLD$(N,M)+CHR$(PEEK(350+160*N+2*P)):NEXT P:FLD$(N,M)=RIGHT$(FLD$(N,M),48)
21900 NEXT N
22000 LOCATE 21,15:PRINT " ":RETURN
22100 ON ERROR GOTO 24200'---------------save card format--------------------
22200 OPEN "indxcard.frm" FOR OUTPUT AS #1
22300 FOR N=1 TO 18:PRINT #1,FLD$(N,0):NEXT N
22400 CLOSE #1:ON ERROR GOTO 0
22500 FOR N=1 TO 18:LOCATE N+3,1:PRINT MID$(FLD$(N,0),6,14);:LOCATE N+3,66:PRINT MID$(FLD$(N,0),20,14):NEXT N:RETURN
22600 FOR N=1 TO 18:LSET F$(N)=FLD$(N,M):NEXT N:ON ERROR GOTO 24200:PUT #2,CARD:ON ERROR GOTO 0:RETURN'----save card---
22700 ON ERROR GOTO 23700'--------------------PRNTCARD-----------------------
22800 LPRINT CHR$(27)CHR$(64)CHR$(27)CHR$(69);'printer commands
22900 GET #2,1:FOR N=1 TO 18:LPRINT F$(N):NEXT N:IF SINGLE=1 THEN 23200
23000 GET #2:IF LEFT$(F$(1),1)="\" THEN 23400
23100 FOR N=1 TO 18:LPRINT F$(N):NEXT N
23200 IF SINGLE=1 THEN LOCATE 24,1:PRINT "Press <Alt><F7> to go to continuous printing.";:GOSUB 16600:IF REPEAT=1 THEN SINGLE=0:LOCATE 24,1:PRINT STRING$(79," ");
23300 GOTO 23000
23400 ON ERROR GOTO 0:RETURN
23500 '---------------------yes or no answer--------------------------------
23600 X$=INKEY$:IF X$="" THEN GOTO 23600 ELSE IF X$="N" OR X$="n" THEN A=1:RETURN:ELSE IF X$="Y" OR X$="y" THEN A=2:RETURN:ELSE A=3:LOCATE 25,40:PRINT "Please answer Y,y,N,or n";:FOR N=0 TO 5000:NEXT :FOR N=0 TO 15:DUMP$=INKEY$:NEXT:RETURN
23700 IF ERR = 27 THEN PRINT "Printer off or out of paper. Program will continue when problem is corrected.":RESUME'------------prterror-----------------------
23800 IF ERR = 68 THEN PRINT "Printer unavailable or disabled. Program will continue when problem is corrected.":RESUME
23900 IF ERR = 25 THEN PRINT "Printer fault. Program will continue when problem is corrected.":RESUME
24000 IF ERR = 24 THEN PRINTIME=PRINTIME+1 ELSE PRINT "PRTERROR problem.":ON ERROR GOTO 0:STOP
24100 IF PRINTIME < 2 THEN RESUME ELSE PRINT "Printer off line. Program will continue when problem is corrected.":PRINTIME=0:RESUME
24200 R=CSRLIN:C=POS(0):LOCATE 23,1'---------------diskerror-------------------
24300 IF ERR=24 THEN PRINT "No disk in drive? Device timeout.":GOTO 25400
24400 IF ERR=53 THEN PRINT "There is no file for this program on this disk.";:NOFILE=1:LOCATE R,C:RESUME
24500 IF ERR=57 THEN PRINT "I/O error. Try another disk.":GOTO 25400
24600 IF ERR=61 THEN LOCATE 24,1:PRINT "Disk full. Last card not entered. Previous card made end-of-file. ":FOR N=1 TO 4000:NEXT N:GET #2,LOC(2)-2:RESUME 15400
24700 IF ERR=64 THEN PRINT "Bad file name. Software problem.":STOP
24800 IF ERR=67 THEN PRINT "Too many files in directory. Try another disk to temoroarily save your data.":GOTO 25400
24900 IF ERR=68 THEN PRINT "Disk drive unavailable.":GOTO 25400
25000 IF ERR=70 THEN PRINT "You have write protected this disk!":GOTO 25400
25100 IF ERR=71 THEN PRINT "No disk in drive or door not closed.":GOTO 25400
25200 IF ERR=72 THEN PRINT "Disk Media Error. Try another disk.":GOTO 25400
25300 PRINT "DISKERROR problem.";:ON ERROR GOTO 0:STOP
25400 PRINT "Program will continue when problem is corrected.";:LOCATE R,C:RESUME
25500 LPRINT CHR$(27) "@";'-------------------printsetup---------------------
25600 LPRINT CHR$(27);"C";CHR$(0);CHR$(11); 'ESC,FORM LENGTH,11 INCHES
25700 LPRINT CHR$(15);CHR$(27);CHR$(65);CHR$(9);'COMPRESSED,ESC,LINE FEED,9/72"
25800 RETURN
25900 LPRINT CHR$(27)CHR$(69);
26000 LPRINT:LPRINT "<Alt>+<F1> = Quit (during screen editing and most other functions).":LPRINT:LPRINT "<Alt>+<F2> = Print this list of function key settings.
26100 LPRINT:LPRINT "<Alt>+<F3> = Print a list of the <Alt>+<character> key settings.":LPRINT:LPRINT "<Alt>+<F4> = Program an <Alt>+<character> key."
26200 LPRINT:LPRINT "<Alt>+<F5> = Page back to previous card.":LPRINT:LPRINT "<Alt>+<F6> = Page foreward to next card (if not at end of file)."
26300 LPRINT:LPRINT "<Alt>+<F7> = Unassigned.":LPRINT:LPRINT "<Alt>+<F8> = Finished with card."
26400 LPRINT:LPRINT "<Alt>+<F9> = Finished entering cards.":LPRINT:LPRINT "<Alt>+<F10> = Edit the previous entry as shown (instead of clearing it).
26500 RETURN
26600 LOCATE 25,1:PRINT "Enter <Alt>+<the key you want to use>: ";'----program alt-character key----------------
26700 GOSUB 27300:IF CHAR=0 THEN 27100 ELSE KYSTR=CHAR'identify key
26800 CK$(KYSTR)="":LOCATE 25,1:PRINT "Enter a string: ";:COLOR 0,7:PRINT STRING$(48," ");:LOCATE 25,17
26900 Y$=INKEY$:IF Y$="" OR LEN(Y$)>1 THEN 26900 ELSE IF ASC(Y$)=13 THEN 27200 ELSE IF ASC(Y$)=8 AND POS(0)>17 THEN 27000 ELSE CHAR=0:GOSUB 27400:IF CHAR=0 THEN 26900 ELSE CK$(KYSTR)=CK$(KYSTR)+Y$:PRINT Y$;:IF LEN(CK$(KYSTR))>48 THEN 27200 ELSE 26900
27000 KYS=LEN(CK$(KYSTR))-1:CK$(KYSTR)=LEFT$(CK$(KYSTR),KYS):LOCATE 25,17:PRINT CK$(KYSTR) " ";:LOCATE ,POS(0)-1:GOTO 26900
27100 LOCATE 25,1:PRINT "This key cannot be programmed ";:FOR N=1 TO 4000:NEXT N
27200 COLOR 7,0:LOCATE 25,1:PRINT "PRESS <Alt>+<F8> FOR NEXT CARD, <Alt>+<F1> TO QUIT, <Alt>+<F9> TO END THE FILE.";:LOCATE R,C:RETURN
27300 Y$=INKEY$:IF Y$="" OR LEN(Y$)<2 THEN 27300 ELSE IF ASC(Y$)=13 THEN RETURN ELSE Y=ASC(RIGHT$(Y$,1)):CHAR=0
27400 IF Y>15 AND Y<26 THEN CHAR=Y-15
27500 IF Y>29 AND Y<39 THEN CHAR=Y-19
27600 IF Y>43 AND Y<51 THEN CHAR=Y-24
27700 IF Y>83 AND Y<104 THEN CHAR=Y-57
27800 IF Y>119 AND Y<132 THEN CHAR=Y-73
27900 RETURN
28000 DATA "A",11,"4",50,"B",24,"5",51,"C",22,"6",52,"D",13,"7",53,"E",3,"8",54,"F",14,"9",55,"G",15,"0",56,"H",16,"-",57,"I",8,"=",58,"J",17,"<SHIFT>+<F1>",27
28100 DATA "K",18,"<SHIFT>+<F2>",28,"L",19,"<SHIFT>+<F3>",29,"M",26,"<SHIFT>+<F4>",30,"N",25,"<SHIFT>+<F5>",31,"O",9,"<SHIFT>+<F6>",32,"P",10,"<SHIFT>+<F7>",33,"Q",1,"<SHIFT>+<F8>",34,"R",4,"<SHIFT>+<F9>",35,"S",12,"<SHIFT>+<F10>",36
28200 DATA "T",5,"<Ctrl>+<F1>",37,"U",7,"<Ctrl>+<F2>",38,"V",23,"<Ctrl>+<F3>",39,"W",2,"<Ctrl>+<F4>",40,"X",21,"<Ctrl>+<F5>",41,"Y",6,"<Ctrl>+<F6>",42,"Z",20,"<Ctrl>+<F7>",43,"1",47,"<Ctrl>+<F8>",44,"2",48,"<Ctrl>+<F9>",45,"3",49,"<Ctrl>+<F10>",46
28300 GOSUB 25500'printer to compressed print----------print alt keys---------
28400 LPRINT CHR$(14) " INDXCARD -- ALTERNATE KEY ASSIGNMENTS " DATE$:LPRINT
28500 PFLD1$=SPACE$(48):PFLD2$=SPACE$(48)
28600 FOR N=1 TO 29:READ C1$,C1,C2$,C2:LSET PFLD1$=CK$(C1):LSET PFLD2$=CK$(C2):LPRINT C1$" = "PFLD1$ SPC(10) C2$" = "PFLD2$:LPRINT:NEXT N:GOSUB 25900:LPRINT CHR$(12);:RESTORE:GOTO 25500
28700 IF NTEND=0 THEN LSTCRD=CARD:NTEND=1
28800 CARD=CARD+MV:X$=INKEY$:IF LEN(X$)>1 THEN X=ASC(RIGHT$(X$,1)):IF X=108 OR X=109 THEN LOCATE 23,22:PRINT "CARD: "CARD" ";:IF CARD=1 THEN 28900 ELSE RETURN 20100
28900 GET #2, CARD:FOR N=1 TO 18:FLD$(N,M)=F$(N):NEXT N:LOCATE 23,22:PRINT "CARD: "CARD" FILE SIZE: "LOF(2)" BYTES ";:GOTO 16500
29000 IF C<22 THEN C=22 ELSE IF C<28 THEN C=28 ELSE IF C<34 THEN C=34 ELSE IF C<40 THEN C=40 ELSE IF C<46 THEN C=46 ELSE IF C<52 THEN C=52 ELSE IF C<58 THEN C=58
29100 LOCATE R,C:GOTO 17200
29200 IF C>58 THEN C=58 ELSE IF C>52 THEN C=52 ELSE IF C>46 THEN C=46 ELSE IF C>40 THEN C=40 ELSE IF C>34 THEN C=34 ELSE IF C>28 THEN C=28 ELSE IF C>22 THEN C=22
29300 LOCATE R,C:RETURN
29400 IF C>63 THEN LOCATE ,,,7,7:RETURN'----------insert--------------
29500 FLDUSED(R-3)=1:LOCATE ,,,4,7:U=160*(R-1)+2*(C-1):UMAX=160*(R-1)+126
29600 X$=INKEY$:IF X$="" THEN 29600 ELSE IF LEN(X$)>1 THEN IF ASC(RIGHT$(X$,1))=82 THEN LOCATE ,,,7,7:RETURN ELSE LOCATE ,,,7,7:I=1:GOTO 18500 ELSE X=ASC(X$):IF X=8 THEN C=C-1:LOCATE ,C:GOSUB 30500:GOTO 29400 ELSE IF X<32 THEN LOCATE ,,,7,7:RETURN 17400
29700 FOR N=UMAX TO U STEP -2:POKE N,PEEK(N-2):NEXT N:POKE U,X:C=C+1:LOCATE R,C:GOTO 29400
29800 RR=R:CC=C:FLDUSED(R-3)=1'----------ctrl cursor right------------------
29900 U=160*(RR-1)+2*(CC-1):UMIN=160*(RR-1)+32
30000 FOR N=U-2 TO UMIN STEP -2:IF PEEK(N)<>32 THEN 30200 ELSE CC=CC-1:NEXT N
30100 RR=RR-1:CC=64:IF RR<4 THEN RETURN ELSE 29900
30200 U=N:FOR N=U TO UMIN STEP -2:IF PEEK(N)=32 THEN 30400 ELSE CC=CC-1:NEXT N
30300 RETURN
30400 LOCATE RR,CC:RETURN
30500 FLDUSED(R-3)=1:U=160*(R-1)+2*(C-1):UMAX=160*(R-1)+126'---delete--------
30600 FOR N=U TO UMAX-2 STEP 2:POKE N,PEEK(N+2):NEXT N:POKE UMAX,32:RETURN
30700 RR=R:CC=C:FLDUSED(R-3)=1'----------ctrl cursor right------------------
30800 U=160*(RR-1)+2*(CC-1):UMAX=160*(RR-1)+126
30900 FOR N=U TO UMAX STEP 2:IF PEEK(N)=32 THEN 31100 ELSE CC=CC+1:NEXT N
31000 RR=RR+1:CC=17:IF RR>21 THEN RETURN ELSE 30800
31100 U=N:FOR N=U TO UMAX STEP 2:IF PEEK(N)<>32 THEN 31300 ELSE CC=CC+1:NEXT N
31200 GOTO 31000
31300 LOCATE RR,CC:RETURN
31400 FLDUSED(R-3)=1:U=160*(R-1)+32:UMAX=160*(R-1)+126'------end--------
31500 C=64:FOR N=UMAX TO U STEP-2:IF PEEK(N)=32 THEN C=C-1:NEXT N ELSE IF C=64 THEN LOCATE ,C:RETURN ELSE LOCATE ,C+1:RETURN
31600 FLDUSED(R-3)=1:U=160*(R-1)+2*(C-1):UMAX=160*(R-1)+126'---ctrl end--------
31700 FOR N=U TO UMAX STEP 2:POKE N,32:NEXT N:RETURN
31800 U=512:UMAX=606'---------------------------------ctrl home----------
31900 FOR N=U TO UMAX STEP 2:POKE N,32:NEXT N
32000 U=U+160:UMAX=UMAX+160:IF UMAX<3328 THEN 31900 ELSE R=4
32100 IF FLD$(R-3,0)=STRING$(48," ") THEN R=R+1:IF R>21 THEN LOCATE 4,17:RETURN ELSE 32100
32200 LOCATE R,22:RETURN
40000 FOR O=LEN(CK$(CHAR)) TO 1 STEP -1'-----------insert phrase-------------
40100 FOR N=UMAX TO U STEP -2:POKE N,PEEK(N-2):NEXT N:POKE U,ASC(MID$(CK$(CHAR),O,1)):C=C+1:IF C>63 THEN LOCATE R,C:I=0:RETURN
40200 NEXT O:LOCATE R,C:I=0:GOTO 29400
65000 ' SAVE"b:indxcard.bas"
65100 ' KEY 7,"kill"+chr$(34)+"indxcard":KEY 8,".dta"+chr$(34)
DOCUMENTATION FOR INDXCARD.BAS
(C) Copyright 1983 by Michael Csontos
3228 Livonia Center Road
Lima, New York 14485
INTRODUCTION
In spite of the advantages of computers for data bases, there are
still uses for the common 3" x 5" index cards. Small numbers of them are more
portable and accessable than a computer file, and for large files (>10,000
records) the hardware is still too expensive for home use.
This program is intended to make it very easy to create and maintain
3x5 card files. By itself, it forms an electronic typewriter with full editing
facilities for the 3"x5" card format. It can be used with the program PC-FILE
as a data entry format for small databases. PC-FILE can also be used to sort
the cards prior to printing, eliminating the tedious task of alphabetizing.
The requirements for this program are:
1.) PC-DOS 1.1 with BASICA,
2.) two disk drives,
3.) 64k memory,
4.) Color/Graphics Adapter Card (color not used),
5.) Epson MX-80 (or comparable) printer.
Optional but highly desirable items are:
1.) 3" by 5" continuous form index cards, such as are
available as catalog number DD8871 for $9.95/M ($8.75/M in 5M lots) (M=1000)
from:
Misco Inc.
404 Timber Lane
Marlboto, N. J. 07746.
2.) PC-FILE, a database program by Jim Button, P. O. Box
5786, Bellville WA 98006, available through many software exchanges or from:
Headlands Press, Inc.
Post Office Box 862
Tilburton, California 94920.
This program was tested with version 8.1 of PC-FILE.
3.) A RAM disk with a printer buffer. Both INDXCARD and
PC-FILE produce long continuous run cycles for the disk drives. An electronic
disk drive will speed the sorting and printing operations considerably.
There are a number of files associated with INDXCARD. INDXCARD.BAS is
usable by itself but it creates or uses the other files for some operations.
They are:
1.) INDXCARD.BAS - The BASIC program to create index cards,
2.) INDXCARD.DOC - This documentation file in ASCII form,
3.) INDXCARD.FRM - A card format created by INDXCARD.BAS,
4.) INDXCARD.KEY - Key definitions created by INDXCARD.BAS,
5.) INDXCARD.DTA - Card data entered through INDXCARD.BAS,
6.) INDXCARD.HDR - Field definitions used by PC-FILE,
7.) INDXCARD.RPT - Used by PC-FILE to clone sorted data,
8.) INDXCARD.CMP - A BASIC program to compress the data,
9.) INDXCARD.BAT - A DOS batch file to prepare a data disk,
10.) INDXCARD.INX - May be present if PC-FILE was used.
OPERATION
IMPORTANT: This program creates disk records 865 bytes long. Therefore
the BASIC random file buffer must be set to allow the reading of this size
record. Load BASICA from DOS with the command:
BASICA /S:1024
or load the program from DOS using the command:
BASICA B:INDXCARD.BAS/S:1024
or similar syntax. See page 2-4 of the IBM BASIC manual.
INDXCARD.BAS ALONE
If INDXCARD.BAS is run with no other INDXCARD file on the default
drive disk, the following will occur. You will be presented with a screen image
of an index card with eighteen lines, labeled as Field 1 to Field 18, each
having room for 48 characters. You can use the cursor control keys to position
the cursor on any line on the card and enter a short description of the data
that you will place on this line when you fill out the cards.
You may use the entire 48 characters for these labels. When you press
the <Esc> key when filling out the cards, the entire line will be displayed,
erasing whatever was on the line on the screen.
The information in these labels is also used on the screen during data
entry as follows: starting at the fifth character (the default cursor position)
the next 14 characters are displayed on the left of the screen, and the next 14
characters after that are displayed on the right. You may want to keep this in
mind in choosing field labels.
Enter lables only on the lines you want to use. If you accidentally
erase the field label on a line you want to skip, press <Esc> to restore the
field number label.
When you are satisfied with the card layout, press <Alt>+<F8>. This
will record the card layout in a file called INDXCARD.FRM on the default disk,
place the (possibly truncated) labels alongside the card form, and move the
program to the data entry mode. At this time the full set of function keys is
available (see FUNCTION KEYS below).
You may now enter data, using the same editing keys and functions as
are available when editing a BASIC program listing. The editing is confined to
the boundaries of the card. Editing functions behave as if only the labeled
fields exist, i. e. <enter> moves to the next field, not the next line. The
major differences are that the cursor does not wrap around to the next field,
and <Esc> restores the field label as well as erasing the line.
The initial entry of any character in a field (including <space>)
erases the field displayed. Pressing <Alt>+<F10> or an editing function (such
as <Ins>) will prevent this allowing the displayed field to be edited or
reused. Pressing <enter> will skip the field, but it will be erased if you
return to it and enter a character without pressing <Alt>+<F10>.
When the displayed card looks the way you want your index card to
look, press <Alt>+<F8>. The card will be scanned and the data placed in a file
called INDXCARD.DTA in the disk in the default drive. The card number and file
size displayed below the bottom of the card will be incremented and the cursor
will be placed in column five on the first defined field of the card. The
contents of the diaplayed card are not erased. If you were to press <Alt>+<F8>
twice, a second identical card would be entered into the file. The next card
may now be generated by changing only the fields or characters that are
different. (Remember to press <Alt>+<F10> before entering a character change.)
This is the major advantage of using this program. For example if you
were indexing a record collection and had a set of the nine Beethoven
symphonies, you would only enter the composer, conductor, orchestra, and record
identification information once, then generate nine cards by editing the line
containing the name of the symphony.
During data entry, you may define any character key as a phrase of up
to 48 characters to be recalled by pressing <Alt>+<the-character-key> as in
editing a BASIC program. To do this, press <Alt>+<F4>. On line 25 of the screen
you will be asked to identify the key to be defined by pressing
<Alt>+<the-key>. You will then be presented with a field on line 25 to fill in
with any phrase. After you press enter the cursor is returned to the card and
any time thereafter the entire phrase (truncated at the edge of the card if it
is too long) will be entered when you press <Alt>+<the-defined-key>. These key
definitions will be saved on the default disk as INDXCARD.KEY when you exit the
program.
The key definition feature can save considerable typing. For example,
for a address card file, <Alt>+<R> could be <Rochester, New York>, <Alt>+<S>
could be <Scottsville, New York 14546>, etc. Thus entire lines can be entered
with a double keystroke. The <shift>+<F-key> and <Ctrl>+<F-key> functions may
also be defined in this way. You may also use the straight <F-key> functions by
defining them with the BASIC [KEY n, "ccc"] function before running INDXCARD.
This gives you a total of 68 user defined keys for this program.
When you are finished entering data, press <Alt>+<F9>. This will place
a end-of-file field in INDXCARD.DTA and record INDXCARD.KEY. You may then
immediately print the cards you have just entered by setting up the printer and
pressing any key. If this is the first run for a print setup, it is advisable
to press <Alt>+<F7> which will print single cards. Thereafter pressing
<Alt>+<F7> will start continuous printing.
To stop without printing press <Esc> after pressing <Alt>+<F9>. You
may then sort the file using PC-FILE or resume data entry at a later time.
NOTE: It is important to end the program through <Alt>+<F9>. If no
end-of-file field is present, PC-File will not be able to sort the file and the
printer will do strange things (and use up a lot of paper) when it runs off the
end of the file!
RESUMING INDXCARD.BAS
If the file INDXCARD.DTA is present on the default drive when
INDXCARD.BAS is run, you will be presented with a menu giving the following
options:
1.) Quit and copy or rename the file,
2.) Print the data on index cards,
3.) Add new data to the file,
4.) Continue and erase the present file.
Option 1 is to prevent you from damaging data you wish to save.
Actually no harm would be done by proceeding through options 2 or 3 and then
ending the program in a normal way without changing data, however option 1
would save time.
Option 2 skips directly to the card printing routine. It is intended
mainly for printing cards after they have been sorted with PC-FILE. It is also
useful if a print run has been aborted because of printer or paper problems.
Option 3 will allow you to resume entering data where you left off
from a previous session. The end-of-file marker will be replaced with the next
card entered and the card numbers will continue from the last card in the
existing file. If the data file has no end-of-file marker (because the program
was ended inproperly, as with <Ctrl>+<Break>) then the new cards will be
entered directly after the last card in the file. This is a way to recover from
such a situation. Simply going through the data entry mode, then pressing
<Alt>+<F9> will properly terminate the file.
Option 4 will write over the existing INDXCARD.DTA file. It is the
option that would normally be used, since this program in not intended to build
a permanent data base, but remember that all data in the file is permanently
lost.
In either option 3 or option 4, the files INDXCARD.FRM and
INDXCARD.KEY will be read and the definitions in them will be used. The field
definitions will be displayed and you will be given an opportunity to change
them. This is an opportunity to adjust the field names so that they are
properly displayed alongside the card, or to refresh your memory of the card
layout.
The file format used by this program allows a flexibility not
available in many data-base programes. All fields are stored on the disk even
if they are not used. Therefore, fields may be activated and used even after a
large amount of data has been entered into the file. You may enter a label in a
blank field at this time and enter data into that field for all subsequent
cards. You may also add that field to existing cards by using the <Ctrl>+<PgUp>
or <Alt>+<F5> functions (see FUNCTION KEYS below). You may also delete a field
by making it blank at this stage. It will be skipped in subsequent data entry
and it will not be printed even where it exists on cards already entered. The
data is still in the file, however, and may be recovered by reactivating the
field.
The card re-layout feature is handy if, for example, you realise that
you need a company name field in a address card file, or that you shouldn't
have a religion field in your employee file. The cost of this feature is that
the files are very large. A single-sided disk will hold only about 150 cards.
This is sufficient for any single typing session, however, for data-base use
the data should be converted to another form. PC-FILE, version 8.1 provides for
cloning files; writing selected fields to a new, sortable DTA file.
INDXCARD.CMP converts the DTA files to sequential files with blanks removed.
This compresses the data considerably but it is left to you to write a program
to use the data.
Once you have reviewed or changed the card format, pressing any key
will allow you to proceed to data entry. The INDXCARD.FRM and INDXCARD.KEY
files will be updated with any changes made while running the program.
SORTING INDXCARD.DTA
After you have left the program by pressing <Alt>+<F9> and <Esc>, you
have a data file INDXCARD.DTA which is in a format that can be handled by
PC-FILE. PC-FILE also requires a field definition file with a .HDR extension.
INDXCARD.HDR should be provided with INDXCARD.BAS. If not, you can create it by
loading PC-FILE and entering 18 field names, with each field 48 characters
long. It might be worthwhile to make your own .HDR file this way anyway, since
the fields in INDXCARD.HDR are just named FIELD 1, FIELD 2, ... etc. You can
also copy or rename your INDXCARD.DTA and INDXCARD.HDR files for protection
from accidental erasure by option 4 of INDXCARD.BAS, however the DTA file must
be renamed INDXCARD.DTA to be printed by INBXCARD.BAS after sorting.
See the documentation provided with PC-FILE for instructions on
sorting the data. In selecting the sort fields, you must identify the fields
you have used. Notes made when formatting the card could be useful since you
can't list the cards with PC-FILE until an index in created. If the first line
on the card is the one you want sorted (as it usually would be) just note which
one it is and specify it to PC-FILE.
After the cards are sorted, use the PC-FILE "<F6> LISt or clone" mode
to make a new file from the sorted index. The format for this should also be
included with INDXCARD.BAS as INDXCARD.RPT, but may be created with PC-FILE by
just listing the 18 fields in order when asked for the output format. Follow
the PC-FILE instructions for version 8.1 or later for cloning the file. The new
file must be named or later renamed INDXCARD.DTA and will consist of all the
original data in the sorted order. It is not necessary to sort this file as
requested by PC-FILE unless you are going to do further work on it with
PC-FILE.
PRINTING SORTED CARDS
To print the file sorted by PC-FILE, load INDXCARD.BAS, place the disk
containing the sorted INDXCARD.DTA in the default drive, and run INDXCARD.BAS
using option 2 above. The cards will be printed in the sorted order ready to
use or to be collated with an existing card catalog.
The print commands in the program are for an EPSON MX-80 printer. They
assume six lines per inch with emphasized type. Every line is available so you
must lay out the card to allow for top and bottom margins, i.e., the first and
last fields should not be used. The printer should be aligned so that the first
line (first field) is right at the top of the card.
The cursor is positioned at column 5 of the card form for data entry
to allow for a left margin on the printed cards. The first five columns may be
used on any field by moving the cursor left before entering data, or by using
<Del> to remove the leading blanks from a field which has run into the end of
the line. It might be a good idea to run the program once with one or two cards
as test patterns (characters in all corners) so that you can decide on the best
positioning for your printer.
The printer is completely reset by the program so the cards may be
aligned by turning the printer off even just before printing. The printer is
left in the compressed print mode after the program ends.
You may use the features of PC-FILE to print other types of reports
from the data (after resorting it). Address labels and lists may be made,
however the 48 character fields make reports difficult to print.
DATA COMPRESSION WITH INDXCARD.CMP
The program INDXCARD.CMP which should be supplied with INDXCARD.BAS is
a simple BASIC program which reads the data in INDXCARD.DTA (preferably after
sorting) and converts it to a sequential file. In this new file (which you are
asked to name) all leading and trailing blanks are removed from each active
field. Blank fields are reduced to single <space> characters to preserve the
field locations. A paragraph symbol (^T or ASCII 20) followed by the card
number (the record number from the sorted file) is inserted between each card.
This information should be sufficient to reconstruct the data except for any
indentations (tabs).
INDXCARD.CMP is not intended to be particulatly user-friendly since
you need to know how to write a BASIC file handling program to use the data
after it is compressed. If you understand the commands necessary, it should be
easy to convert the data in these files for use by other databases, to combine
or collate files, and to print specialized reports. At least these files can be
edited and searched by EDLIN from PC-DOS.
An attempt was made to write a program that would remove the
end-of-file marker from DTA files to allow them to be combined using the PC-DOS
1.1 [COPY] concatenation feature. The attempt was unsuccessful, however a
custom BASIC program that combines and colates DTA files using selected parts
of selected fields could be easily written to compress any particular card
layout.
FUNCTION KEYS
Extensive use is made of the function keys by this program. The key
combinations <Alt>+<F1> through <Alt>+<F10> are used to control the program.
The rest of the keys that can be used with <Alt>, <shift>, or <Ctrl>
combinations may be programed with character strings by the user. This
considerably reduces the number of keystrokes needed to enter data.
<Alt>+<F1> - QUIT
This key combination is recognised during most parts of the program to
allow you to return directly to BASIC without going through the printer
instruction screen display. If you are in the data entry mode it will NOT place
the end-of-field marker on the file. You can continue data entry where you left
off by rerunning the program, but you cannot use PC-FILE on the data and you
should not try to print cards from the file.
<Alt>+<F2> - LIST FUNCTION KEYS
This will cause the printer to print a short list of the <Alt>+<Fn>
key assignments to be placed next to the keyboard for reference while using the
program.
<Alt>+<F3> - LIST <Alt>+<character> KEY ASSIGNMENTS
This will produce on the printer a full page listing of all of the
user and programed key assignments. All of the character keys (A-Z, 1-0, - and
=) may be assigned using <Alt>+<F4>. If assignments have been made or if
assignments were read from the disk file INDXCARD.KEY, then they will be
listed, along with any <shift>+<Fn> and <Ctrl>+<Fn> assignments. The programed
<Alt>+<Fn> key assignments will be listed on the bottom of the page as with
<Alt>+<F2> above.
<Alt>+<F4> - PROGRAM A USER KEY ASSIGNMENT
When this key combination is pressed during data entry, line 25 of the
screen is used first to identify the key combination to be assigned, then to
enter the string to be assigned to that key combination.
When asked to enter <Alt>+<the-key-you-want-to-use> press the key
combination that you want to program. In spite of the instruction, you may also
press <Ctrl>+<Fn> and <shift>+<Fn> to program them the same way.
<Ctrl>+<character> and obviously <shift>+<character> don't work.
A 48 character string may be entered, only backspace may be used or
editing. When the string is entered press <enter>. You will be returned to the
previous cursor position and may immediately use the character string you have
just entered by pressing the key combination.
Character strings entered in card lines behave just as the
<Alt>+<character> keys do in BASIC, where <Alt>+<P> produces PRINT on the
screen. Strings may be inserted with the <Ins> key. The major difference is
that the end of the line will always be the edge of the card. There is no line
wrap since for this application it would usually go into a field with a
different data definition.
You lose a previous key definition as soon as you enter the key
definition mode. If you press <Alt>+<F4> by mistake, just reenter the shortest
key definition (or an undefined key) on your list.
All current key definitions are automatically saved when you exit the
program through <Alt>+<F9>. They will be lost (and any previous INDXCARD.KEY
file preserved) if you exit through <Alt>+<F1> or other means. Key definitions
are automatically restored when you run the program if INDXCARD.KEY is present
on the default drive.
<Alt>+<F5> and <Alt>+<F6> PAGE THROUGH CARDS
During data entry you may move backward and foreward through the card
file with these keys. <Alt>+<F5> moves toward lower numbered cards; <Alt>+<F6>
moves toward the end of the file. Similar functins are also provided by
<Ctrl>+<PgUp> (toward the beginning of the file) and <Ctrl>+<PgDn> (toward
higher card numbers).
Each keystroke moves one card number in the appropriate direction.
Since during normal data entry, the next card's display contains the previous
card's contents on the screen until changed, the first press of <Alt>+<F5> or
<Ctrl>+<PgUp> will appear to change only the card number. However if this
action is followed by <Alt>+<F6> or <Ctrl>+<PgDn>, you will be presented with a
blank card, which is the actual content of the last card in the file before an
entry is made.
You may edit any card displayed after a paging operation and then
enter the changes in that card by pressing <Alt>+<F8>. That card will now have
the updated information and you will be returned to the last (unentered) card
in the file with the screen showing the content of the changed card.
If you just press <Alt>+<F8> at a card reached by paging, the data on
that card will be reentered unchanged and you will also transfer that data to
the last card position. This can be useful if, for example, you remember that
five cards back you entered an almost identical address to the one you must now
enter. Simply press <Alt>+<F5> five times, check to see that you have reached
the right card, then press <Alt>+<F8>. You need now make only the necessary
changes and enter the new card.
The IBM keyboard's typamatic feature works for the function keys. With
<Alt>+<F5> and <Alt>+<F6> the program will skip rapidly through the number of
pages held in the keyboard buffer. This does not work for the <Ctrl>+<PgUp> and
<Ctrl>+<PgDn> keys. Thus you can skip through the file by rapidly pressing the
<Alt>+<F5> or <Alt>+<F6> combinations or display it page by page using the Pg
keys. No not hold down the keys when you hear the buffer-full alarm tone.
Somewhere (DOS, BASIC, or INDXCARD) there is something that doesn't like to
process an [INKEY$] command while scanning the screen memory while sounding the
buffer alarm!
<Alt>+<F7> - UNASSIGNED
This key is used to provide alternate continuation modes for several
parts of the program but to avoid confusion is unassigned during data entry.
<Alt>+<F8> - RECORD DATA; FINISHED WITH CARD
The card is scanned and the data is recorded in the disk file. All
fields that are defined in the card format set-up at the start of the program
are scanned, other fields are skipped. If you have changed the card format and
paged back to a card entered before the change, some lines on the screen may
not be scanned and the data will be erased from the disk file. This is useful
to clear old data, or a problem if you wish to preserve it. This program is not
meant to be a data base.
Data on the screen will not be saved unless <Alt>+<F8> is pressed.
Therefore be sure to use it before ending the program with <Alt>+<F1> or
<Alt>+<F9>.
The scanning process is somewhat slow, however the keyboard buffer is
not cleared so in continuous data entry you can enter the first line of the
next card while the last card is being scanned. Since the user-defined keys
count as single keys in the buffer, you can enter a considerable amount during
the scan.
<Alt>+<F9> - END DATA ENTRY; FINISHED WITH CARDS
The end of file record for PC-FILE and printing is placed on the disk
and the program is made ready to end or print cards. The end of file record is
just the last entered card data with backslashes (\) at the beginning and end
of the record.
After pressing <Alt>+<F9> you are given the choice of ending the
progrqm with <Esc>, printing the first card with <Alt>+<F7> or printing cards
continuously after pressing any key. This selection was based on making it the
easiest to use the program as an electronic typewriter for printing a few cards
at time.
<Alt>+<F10> - USE CURRENT LINE AS DISPLAYED
For rapid continuous entry of new data, the line from the previous
card is erased as soon as new data is started. If you use a key such as <Ins>,
<Del> or <End> the program assumes that you want to edit the line and doesn't
erase it. However to distinguish between new data and a change when a character
is the first entry on a line, you must press <Alt>+<F10> first.
OPERATING PROCEDURES
INDXCARD.BAS is simple enough to operate if all you want to do is to
print a few index cards at a time without sorting. However doing large batches
with single sided disks is more complicated because of the large size of the
files. If all of the PC-FILE and INDXCARD files are on one disk there is no
room for data. Therefore two procedures are provided; one for two disk drives
and another for two drives plus a RAM drive electronic disk. Both assume that
all of the required program files are on one operating disk (called Program
Disk). The Program disk contains all of the files associated with INDXCARD.BAS
and all of the files associated with PC-FILE.
PROCEDURE WITH TWO DRIVES
1.) Start the PC in DOS with default drive A:.
2.) Place the Program Disk in drive A: and a formatted but blank data
disk in drive B:
3.) Type INDXCARD <enter>. This will run the file INDXCARD.BAT which
copies the files INDXCARD.FRM, .KEY, .HDR AND .RPT to the
data disk.
4.) Place your DOS disk in drive A, make drive B: the default drive
(type B:<enter>) and load BASICA with the /S:1024 option
(type A:BASICA/S:1024).
5.) Place the Program Disk in drive A: and run INDXCARD.BAS (type
LOAD"A:INDXCARD",R<enter>).
6.) Run through the program. entering data and ending with <Alt>+<F9>
then <Esc>.
7.) Place your DOS disk in drive A: and type SYSTEM<enter> to return
to DOS. Type A:<enter> to make drive A: the default drive.
8.) Place the Program Disk in drive A: and type PC-FILE<enter>. This
will load PC-FILE. FolIow PC-FILE instructions to tell it
that the data is in drive B: and to sort the data.
9.) Place another formatted data disk in drive A:. Tell PC-FILE to
clone the data to A:INDXCARD.DTA and run the list routine.
10.) Place your DOS disk in drive A: and exit PC-FILE
11.) Replace the second data disk into drive a: and type COPY B:*.FRM
A:<ENTER>. You now have a sorted data file and its format
on the second data disk in drive A: and your intact
original data and its PC-FILE index on the first data disk
in drive B:.
12.) Place the second data disk in drive B:, and your DOS disk in
drive A:. Make drive B: the default drive (type B:<enter>)
and load BASICA (type A:BASICA /S:1048<enter>).
13.) Place the Program Disk in drive a and type RUN"A:INDXCARD".
Select option 2 on the menu and follow the instructions to
print the sorted cards.
The above procedure is quite formidable. It is actually a worst-case
procedure. For someone used to working with disk files most of the steps come
automatically. Considerable disk switching can be saved by making the Program
Disk into a DOS disk. However it also illustrates that two single-sided drives
are barely adaquate for serious data-base work.
PROCEDURE FOR TWO DRIVES PLUS AN ELECTRONIC (RAM) DRIVE
This assumes that the RAM drive is set up to be the same size as a
disk drive and the Program Disk is also a DOS disk (is a system disk with
BASICA on it as well as all PC-FILE and INDXCARD files.
1.) Start the PC with the Program Disk in drive A: and make B: the
default drive (type B:<enter>).
2.) Place a formatted data disk in drive B: and type A: INDXCARD to
transfer the control files.
3.) Run INDXCARD by typing A:BASICA A:INDXCARD/S:1024<ENTER>, then
RUN<enter>.
4.) Enter data and end the program with <Alt>+<F9> then <Esc>. Type
SYSTEM to return to DOS.
5.) Type A:PC-FILE<enter> and sort the file in drive B:.
6.) Use the list option of PC-FILE to clone the sorted data to the
RAM drive. Exit PC-FILE.
7:) Copy INDXCARD.FRM to the RAM drive. Make the RAM drive the
default drive.
8:) Reload BASICA and INDXCARD as before and run option 2 to print
the cards.
If you want to process the sorted data further it can be copied to
another data disk or copied over the original data file. Most of the above
steps could be placed into an AUTOEXEC.BAT file for futher automation of the
process.
MISCELLANEOUS OBSERVATIONS
The <Ins> mode in data entry allows any character code above 031 to be
inserted. If your printer will print foreign characters or you want to use
printer graphics on your cards, press <Ins> then hold down <Alt> while keying
in the ASCII code on the numeric keypad. The character will appear when you
release <Alt>. These codes can be found in Appendix G of the IBM Basic manual
(for the screen and IBM printers) or Appendix F of the EPSON manual (for EPSON
printers).
A single-sided double-density 8-segment format disk will hold about
160 cards plus the required control files transfered by INDXCARD.BAT. and the
PC-FILE generated .INX file. If you fail to watch the card numbers shown under
the card form on the screen and run out of disk space, you may not be able to
recover even by erasing all but the .DTA and .HDR files. Therefore it might be
useful to include a dummy file of about 7K bytes on the data disk which can be
erased to make room for the .INX file if necessary. Alternativly, if you are
using a RAM disk, you can define it to be 10k bytes larger than your mechanical
drives and use it to sort the file.
In no event will the author be liable to you for any damages,
including any lost profits, lost savings or other incidental or consequential
damages arising out of the use or of the inability to use these programs, even
if the author has been advised of the possibility of such damages, or for any
claim by any other party.
---***---
The program INDXCARD.BAS and its associated
files are made freely available for non-exclusive
distribution to the members of the Picture City
Personal Computer Programming Club and through
softrare exchanges with other users' groups as long
as the author and (PC)^3 are fully credited.
This disk copy was originally provided by "The Public Library",
the software library of the Houston Area League of PC Users.
Programs are available from the Public Library at $2 per disk
on user-provided disks. To get a listing of the disks in the
Public Library, send a self-addressed, stamped envelope to
Nelson Ford, P.O.Box 61565, Houston, TX 77208.
5 '
10 ' ******************************************
20 ' *** MAILING LIST PROGRAM v.1.0 ***
30 ' ******************************************
40 '
50 ' by Joe Long for IBM PC
60 ' Rt. 1 Box 100 up to 1,000 records
70 ' Madison, AL 35758
75 '
80 ' *** Copyright 1983 by Joe Long ***
85 ' ** Permission to copy for private use and FREE distribution granted **
90 '
100 DEFINT A-Z : DIM SORT$(1000), SORT(1000), FILL$(50), FRERECNUM$(50)
110 ON ERROR GOTO 9900
120 FG=7 : BG=0 : BD=0 : HI = 15 ' Color variables
130 COLOR FG,BG,BD : KEY OFF : CLS
140 ON KEY(1) GOSUB 2000: ON KEY(2) GOSUB 3000: ON KEY(3) GOSUB 4000: ON KEY(4) GOSUB 5000: ON KEY(5) GOSUB 4200: ON KEY(6) GOSUB 4400: ON KEY(7) GOSUB 4600: ON KEY(8) GOSUB 4800: ON KEY(9) GOSUB 500: ON KEY(10) GOSUB 400
150 KEY(1) ON: KEY(2) ON: KEY(3) ON: KEY(4) ON: KEY(5) ON: KEY(6) ON: KEY(7) ON: KEY(8) ON: KEY(9) ON: KEY(10) ON
160 OPEN "R",1,"b:MAILLIST.TXT"
170 FIELD 1, 20 AS SCRDATA$(1), 1 AS SCRDATA$(2), 16 AS SCRDATA$(3), 34 AS SCRDATA$(4), 18 AS SCRDATA$(5), 2 AS SCRDATA$(6), 5 AS SCRDATA$(7), 16 AS SCRDATA$(8), 8 AS SCRDATA$(9), 8 AS SCRDATA$(10)
175 FIELD 1, 20 AS FILL$, 1 AS SORTFLAG$, 107 AS FILLER$
176 FOR I = 1 TO 50
177 FIELD 1, 19 + 2*I AS FILL$(I), 2 AS FRERECNUM$(I)
178 NEXT I
180 OPEN "R",2,"b:NAMEINDX.TXT",18
190 FIELD 2, 16 AS NAMEINDEX$, 2 AS NAMERECORD$
200 OPEN "R",3,"b:ZIPINDEX.TXT",7
210 FIELD 3, 5 AS ZIPINDEX$, 2 AS ZIPRECORD$
220 OPEN "R",4,"b:CITYINDX.TXT",20
230 FIELD 4, 18 AS CITYINDEX$, 2 AS CITYRECORD$
240 OPEN "R",5,"b:STATEIDX.TXT",4
250 FIELD 5, 2 AS STATEINDEX$, 2 AS STATERECORD$
260 GET 1,1
270 IF FILL$ = " " THEN 300
280 LSET FILL$ = "" : LSET SORTFLAG$ = "" : LSET FILLER$ = ""
290 PUT 1,1
300 IF ASC(SORTFLAG$) = 2 THEN 350
310 PRINT : PRINT "The file has been modified since last sorted."
320 PRINT : PRINT "Do you want to sort the index files? ";
330 GOSUB 9100
340 IF YES = 1 THEN GOSUB 3000
350 GOTO 1000
390 '
400 ' *** Ending Routine ***
410 '
420 LOCATE 22,10 : COLOR FG,BG : PRINT "Do you really want to end the program? ";
430 GOSUB 9100
440 IF YES = 0 THEN MENU = 0 : LOCATE 22,10 : PRINT STRING$(70," ") : RETURN
450 CLS : PRINT : PRINT TAB(36) "End of program." : PRINT
460 END
500 ' *** Restart routine ***
510 '
520 CLOSE : RUN
980 '
990 ' ******************************
1000 ' *** MAIN MENU ROUTINES ***
1010 ' ******************************
1015 '
1020 CLS : PRINT : PRINT TAB(30) "MAILLIST Main Menu"
1030 PRINT : PRINT TAB(10) "Key" : PRINT TAB(54) "Function"
1040 PRINT TAB(10)"---" : PRINT TAB(50) "----------------"
1050 PRINT : PRINT TAB(10)"F1"; : PRINT TAB(50) "Add name to list"
1070 PRINT : PRINT TAB(10)"F2"; : PRINT TAB(50) "Sort list"
1080 PRINT : PRINT TAB(10)"F3"; : PRINT TAB(50) "Search/edit record"
1090 PRINT : PRINT TAB(10)"F4"; : PRINT TAB(50) "Print labels"
1100 PRINT : PRINT TAB(10)"F10"; : PRINT TAB(50) "Exit program"
1110 MENU=1
1120 IF MENU=1 THEN GOTO 1120 ELSE GOTO 1000
1480 '
1490 ' **************************************************************
1500 ' *** Maintain list of free (deleted) records for re-use ***
1510 ' **************************************************************
1590 '
1600 ' *** Find free record ***
1610 '
1620 GET 1,1
1630 FOR I = 50 TO 1 STEP -1
1640 IF FRERECNUM$(I) <> " " THEN 1690
1650 NEXT I
1660 RECORD = LOF(1)/128 + 1 : TRIAL = RECORD
1670 RETURN
1690 RECORD = CVI(FRERECNUM$(I))
1700 TRIAL = LOF(1)/128 : GET 2, TRIAL ' Find free index record
1710 WHILE NAMEINDEX$ = "________________"
1720 TRIAL = TRIAL - 1
1730 GET 2, TRIAL
1740 WEND
1750 LSET FRERECNUM$(I) = "" : PUT 1,1 ' delete stored record #
1760 RETURN
1790 '
1800 ' *** Store deleted record number ***
1810 '
1820 GET 1,1
1830 FOR I = 1 TO 50
1840 IF FRERECNUM$(I) = " " THEN 1870
1850 NEXT I
1860 RETURN ' discard if 50 free records stored
1870 LSET FRERECNUM$(I) = MKI$(RECORD)
1880 PUT 1,1
1890 RETURN
1980 '
1990 ' *****************************
2000 ' *** Add names to list ***
2010 ' *****************************
2020 '
2030 MENU=0
2040 GOSUB 1500 ' get next record #
2050 GOSUB 8100 ' Print blank form on screen
2060 RESTORE : READ DUMMY, DUMMY, DUMMY ' set data for cursor advance
2070 ROW=4 : COL=13 ' set initial cursor location
2080 GOSUB 8500
2090 RESTORE : GOSUB 8800
2110 GOSUB 6100 ' Save to disc
2120 RETURN
2980 '
2990 ' ************************
3000 ' *** Sort Indexes ***
3010 ' ************************
3015 '
3020 MENU = 0
3030 LASTRECORD = LOF(1)/128
3040 CLS : PRINT "Reading last name index file."
3090 '
3100 ' *** Sort Name Index ***
3110 '
3120 FOR I = 1 TO LASTRECORD
3130 GET 2,I : SORT$(I) = NAMEINDEX$ : SORT(I) = CVI(NAMERECORD$)
3140 NEXT I
3150 PRINT "Last name index read ... now sorting last name index."
3160 GOSUB 9400
3170 PRINT "Sorting complete ... now writing sorted last name index."
3180 FOR I = 1 TO LASTRECORD
3190 LSET NAMEINDEX$ = SORT$(I) : LSET NAMERECORD$ = MKI$(SORT(I))
3200 PUT 2,I
3210 NEXT I
3220 PRINT "Last name index file written ... now reading zip code index file."
3290 '
3300 ' *** Sort zip code index ***
3310 '
3320 FOR I = 1 TO LASTRECORD
3330 GET 3,I : SORT$(I) = ZIPINDEX$ : SORT(I) = CVI(ZIPRECORD$)
3340 NEXT I
3350 PRINT "Zip code index file read ... now sorting zip code index."
3360 GOSUB 9400
3370 PRINT "Sorting complete ... now writing sorted zip code index file."
3380 FOR I = 1 TO LASTRECORD
3390 LSET ZIPINDEX$ = SORT$(I) : LSET ZIPRECORD$ = MKI$(SORT(I))
3400 PUT 3,I
3410 NEXT I
3420 PRINT "Zip code index file written ... reading City index file."
3490 '
3500 ' *** Sort City Index ***
3510 '
3520 FOR I = 1 TO LASTRECORD
3530 GET 4,I : SORT$(I) = CITYINDEX$ : SORT(I) = CVI(CITYRECORD$)
3540 NEXT I
3550 PRINT "City index file read ... now sorting City index."
3560 GOSUB 9400
3570 PRINT "Sorting complete ... now writing sorted City index file."
3580 FOR I = 1 TO LASTRECORD
3590 LSET CITYINDEX$ = SORT$(I) : LSET CITYRECORD$ = MKI$(SORT(I))
3600 PUT 4,I
3610 NEXT I
3620 PRINT "City index file written ... reading State index file."
3690 '
3700 ' *** Sort State index ***
3710 '
3720 FOR I = 1 TO LASTRECORD
3730 GET 5,I : SORT$(I) = STATEINDEX$ : SORT(I) = CVI(STATERECORD$)
3740 NEXT I
3750 PRINT "State index file read ... now sorting State index file."
3760 GOSUB 9400
3770 PRINT "Sorting complete ... now writing sorted State index file."
3780 FOR I = 1 TO LASTRECORD
3790 LSET STATEINDEX$ = SORT$(I) : LSET STATERECORD$ = MKI$(SORT(I))
3800 PUT 5,I
3810 NEXT I
3820 BEEP : PRINT "State index file written ... all sorting completed."
3830 LSET FILL1$ = "" : LSET SORTFLAG$ = CHR$(2) : LSET FILL2$ = ""
3840 PUT 1,1
3850 FOR I = 1 TO 1000 : NEXT I
3860 RETURN
3980 '
3990 ' ***********************************
4000 ' *** Search and Edit Records ***
4010 ' ***********************************
4020 '
4030 LASTRECORD = LOF(1)/128
4090 '
4100 ' *** Search Menu ***
4110 '
4120 CLS : MENU = 1 : PRINT : PRINT TAB(10) "Key";: PRINT TAB(50) "Type of Search"
4130 PRINT TAB(10) "___";: PRINT TAB(50) "______________"
4140 PRINT : PRINT TAB(11) "F5";: PRINT TAB(50) "Last Name"
4150 PRINT : PRINT TAB(11) "F6";: PRINT TAB(50) "Zip Code"
4160 PRINT : PRINT TAB(11) "F7";: PRINT TAB(50) "City"
4170 PRINT : PRINT TAB(11) "F8";: PRINT TAB(50) "State"
4180 PRINT : PRINT TAB(11) "F9";: PRINT TAB(50) "Return to Main Menu"
4190 IF MENU = 1 THEN GOTO 4190 ELSE MENU = 1 : GOTO 4120
4195 '
4200 ' *** Search by last name ***
4210 '
4220 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
4240 PRINT : INPUT "Last name for search"; LASTNAME$
4250 NAMELENGTH = LEN(LASTNAME$)
4260 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
4270 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4280 GET 2, TRIAL : RECORD = CVI(NAMERECORD$)
4290 IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4340
4300 IF NAMEINDEX$ < LASTNAME$ THEN LOWLIMIT = TRIAL
4310 IF NAMEINDEX$ > LASTNAME$ THEN HIGHLIMIT = TRIAL
4320 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4330 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4280
4340 MATCH = TRIAL
4350 TRIAL = TRIAL - 1 : GET 2, TRIAL : RECORD = CVI(NAMERECORD$) : IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4350
4360 TRIAL = MATCH
4370 TRIAL = TRIAL + 1 : GET 2, TRIAL : RECORD = CVI(NAMERECORD$) : IF LEFT$(NAMEINDEX$,NAMELENGTH) = LASTNAME$ THEN GOSUB 9700 : GOTO 4370
4380 BEEP : PRINT "No more entries by that name." : FOR I = 1 TO 500 : NEXT I : RETURN
4390 '
4400 ' *** Search by zip code ***
4410 '
4420 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
4440 PRINT : INPUT "Zip code for search"; ZIPCODE$
4460 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
4470 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4480 GET 3, TRIAL : RECORD = CVI(ZIPRECORD$)
4490 IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4540
4500 IF ZIPINDEX$ < ZIPCODE$ THEN LOWLIMIT = TRIAL
4510 IF ZIPINDEX$ > ZIPCODE$ THEN HIGHLIMIT = TRIAL
4520 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4530 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4480
4540 MATCH = TRIAL
4550 TRIAL = TRIAL - 1 : GET 3, TRIAL : RECORD = CVI(ZIPRECORD$) : IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4550
4560 TRIAL = MATCH
4570 TRIAL = TRIAL + 1 : GET 3, TRIAL : RECORD = CVI(ZIPRECORD$) : IF ZIPINDEX$ = ZIPCODE$ THEN GOSUB 9700 : GOTO 4570
4580 BEEP : PRINT "No more entries with that number." : FOR I = 1 TO 500 : NEXT I : RETURN
4590 '
4600 ' *** Search by City ***
4610 '
4620 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
4640 PRINT : INPUT "City for search"; CITY$
4650 CITYLENGTH = LEN(CITY$)
4660 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
4670 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4680 GET 4, TRIAL : RECORD = CVI(CITYRECORD$)
4690 IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4740
4700 IF CITYINDEX$ < CITY$ THEN LOWLIMIT = TRIAL
4710 IF CITYINDEX$ > CITY$ THEN HIGHLIMIT = TRIAL
4720 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4730 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4680
4740 MATCH = TRIAL
4750 TRIAL = TRIAL - 1 : GET 4, TRIAL : RECORD = CVI(CITYRECORD$) : IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4750
4760 TRIAL = MATCH
4770 TRIAL = TRIAL + 1 : GET 4, TRIAL : RECORD = CVI(CITYRECORD$) : IF LEFT$(CITYINDEX$,CITYLENGTH) = CITY$ THEN GOSUB 9700 : GOTO 4770
4780 BEEP : PRINT "No more entries with that city." : FOR I = 1 TO 500 : NEXT I : RETURN
4790 '
4800 ' *** Search by State ***
4810 '
4820 CLS : MENU = 0 : LASTRECORD = LOF(1)/128
4840 PRINT : INPUT "State for search"; STATE$
4860 LOWLIMIT = 0 : HIGHLIMIT = LASTRECORD
4870 TRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4880 GET 5, TRIAL : RECORD = CVI(STATERECORD$)
4890 IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4940
4900 IF STATEINDEX$ < STATE$ THEN LOWLIMIT = TRIAL
4910 IF STATEINDEX$ > STATE$ THEN HIGHLIMIT = TRIAL
4920 NEWTRIAL = INT((LOWLIMIT + HIGHLIMIT)/2+0.5)
4930 IF TRIAL = NEWTRIAL THEN BEEP : PRINT "None found." : FOR I = 1 TO 500 : NEXT I : RETURN ELSE TRIAL = NEWTRIAL : GOTO 4880
4940 MATCH = TRIAL
4950 TRIAL = TRIAL - 1 : GET 5, TRIAL : RECORD = CVI(STATERECORD$) : IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4950
4960 TRIAL = MATCH
4970 TRIAL = TRIAL + 1 : GET 5, TRIAL : RECORD = CVI(STATERECORD$) : IF STATEINDEX$ = STATE$ THEN GOSUB 9700 : GOTO 4970
4980 BEEP : PRINT "No more entries with that state." : FOR I = 1 TO 500 : NEXT I : RETURN
4985 '
4990 ' ************************
5000 ' *** Print Labels ***
5010 ' ************************
5020 '
5030 MENU = 0 : CLS
5040 PRINT : INPUT "One or two across"; LABELNUMBER
5050 IF LABELNUMBER < 1 OR LABELNUMBER > 2 THEN PRINT : PRINT "This program only prints one or two 3 1/2"; CHR$(34); "labels per row, choose (1) or (2) please." : GOTO 5040
5060 GOSUB 9200 ' Select key field
5070 PRINT : PRINTKEY$ = "" : INPUT "Key to print (or <enter> to print all)"; PRINTKEY$ : IF PRINTKEY$ = "" THEN PRINTKEY$ = "*"
5075 PRINT : PRINT "Print phone numbers? "; : GOSUB 9100
5078 IF YES = 1 THEN PHONEFLAG = 1 ELSE PHONEFLAG = 0
5080 IF LABELNUMBER = 2 THEN GOTO 5400
5090 '
5100 ' *** Print one across labels ***
5110 '
5120 LASTRECORD = LOF(1)/128
5130 RECORD = 0
5140 IF RECORD = LASTRECORD THEN RETURN ELSE RECORD = RECORD + 1 : GOSUB 6300 ' get next record
5150 IF KEYFIELD < 9 THEN GOTO 5240
5160 FOR I = 1 TO 8
5170 FOR J = 1 TO LEN(PRINTKEY$)
5180 IF MID$(SCREENDATA$(KEYFIELD),I,1) = MID$(PRINTKEY$,J,1) THEN GOTO 5300
5190 NEXT J
5200 NEXT I
5220 GOTO 5140
5240 IF PRINTKEY$ = "*" THEN 5300
5250 FIELDDATA$(KEYFIELD) = LEFT$(SCREENDATA$(KEYFIELD),LEN(PRINTKEY$))
5260 IF FIELDDATA$(KEYFIELD) <> PRINTKEY$ THEN GOTO 5140
5300 LPRINT : LPRINT SCREENDATA$(1);" ";
5310 IF SCREENDATA$(2) <> "" THEN LPRINT SCREENDATA$(2);". ";
5320 LPRINT SCREENDATA$(3)
5330 LPRINT SCREENDATA$(4)
5340 LPRINT SCREENDATA$(5); ", "; SCREENDATA$(6); : LPRINT TAB(25); SCREENDATA$(7)
5350 IF PHONEFLAG = 1 THEN LPRINT SCREENDATA$(8) ELSE LPRINT
5360 LPRINT
5370 GOTO 5140
5390 '
5400 ' *** Print two across labels ***
5410 '
5420 LASTRECORD = LOF(1)/128 : RECORD = 0 : LEFTLABEL = 1
5430 IF RECORD >= LASTRECORD THEN 5800
5440 RECORD = RECORD + 1 : GOSUB 6300 ' get next record
5450 IF KEYFIELD < 9 THEN GOTO 5540
5460 FOR I = 1 TO 8
5470 FOR J = 1 TO LEN(PRINTKEY$)
5480 IF MID$(SCREENDATA$(KEYFIELD),I,1) = MID$(PRINTKEY$,J,1) THEN GOTO 5600
5490 NEXT J
5500 NEXT I
5520 GOTO 5430
5540 IF PRINTKEY$ = "*" THEN 5600
5550 FIELDDATA$(KEYFIELD) = LEFT$(SCREENDATA$(KEYFIELD),LEN(PRINTKEY$))
5560 IF FIELDDATA$(KEYFIELD) <> PRINTKEY$ THEN GOTO 5440
5600 IF LEFTLABEL = 0 THEN 5700
5610 FOR I = 1 TO 8
5620 LABELDATA$(I) = SCREENDATA$(I)
5630 NEXT I
5640 LEFTLABEL = 0
5650 GOTO 5430
5700 LPRINT : LPRINT LABELDATA$(1); " "; : IF LABELDATA$(2) <> "" THEN LPRINT LABELDATA$(2); ". ";
5710 LPRINT LABELDATA$(3);
5720 LPRINT TAB(37) SCREENDATA$(1); " "; : IF SCREENDATA$(2) <> "" THEN LPRINT SCREENDATA$(2); ". ";
5730 LPRINT SCREENDATA$(3)
5740 LPRINT LABELDATA$(4); : LPRINT TAB(37) SCREENDATA$(4)
5750 LPRINT LABELDATA$(5); ", "; LABELDATA$(6); : LPRINT TAB(25) LABELDATA$(7);
5760 LPRINT TAB(37) SCREENDATA$(5); ", "; SCREENDATA$(6); : LPRINT TAB(62) SCREENDATA$(7)
5770 IF PHONEFLAG = 1 THEN LPRINT LABELDATA$(8); : LPRINT TAB(37) SCREENDATA$(8) ELSE LPRINT
5780 LPRINT : LEFTLABEL = 1 : GOTO 5430
5790 '
5800 ' *** Print odd remaining label ***
5810 '
5820 IF LEFTLABEL = 1 THEN RETURN
5830 LPRINT : LPRINT LABELDATA$(1); " "; : IF LABELDATA$(2) <> "" THEN LPRINT LABELDATA$(2); ". ";
5840 LPRINT LABELDATA$(3)
5850 LPRINT LABELDATA$(4)
5860 LPRINT LABELDATA$(5); ", "; LABELDATA$(6); : LPRINT TAB(25) LABELDATA$(7)
5870 IF PHONEFLAG = 1 THEN LPRINT LABELDATA$(8) : LPRINT ELSE LPRINT : LPRINT
5890 RETURN
5980 '
5990 ' *****************************
6000 ' *** MAIN I/O ROUTINES ***
6010 ' *****************************
6090 '
6100 ' *** Write Record to File ***
6110 '
6140 FOR I=1 TO 10
6150 LSET SCRDATA$(I) = SCREENDATA$(I)
6160 NEXT I
6170 PUT 1, RECORD
6180 LSET NAMEINDEX$ = SCREENDATA$(3) : LSET NAMERECORD$ = MKI$(RECORD)
6190 PUT 2, TRIAL
6200 LSET ZIPINDEX$ = SCREENDATA$(7) : LSET ZIPRECORD$ = MKI$(RECORD)
6210 PUT 3, TRIAL
6220 LSET CITYINDEX$ = SCREENDATA$(5) : LSET CITYRECORD$ = MKI$(RECORD)
6230 PUT 4, TRIAL
6240 LSET STATEINDEX$ = SCREENDATA$(6) : LSET STATERECORD$ = MKI$(RECORD)
6250 PUT 5, TRIAL
6260 GET 1,1
6270 LSET FILL$ = "" : LSET SORTFLAG$ = ""
6280 PUT 1,1 : RETURN
6290 '
6300 ' *** Read Record from File ***
6310 '
6330 GET 1, RECORD
6340 FOR I = 1 TO 10
6350 SCREENDATA$(I) = SCRDATA$(I)
6360 FOR J = LEN(SCREENDATA$(I)) TO 1 STEP -1
6370 IF MID$(SCREENDATA$(I),J,1) <> "_" THEN 6400
6380 NEXT J
6390 SCREENDATA$(I) = "" ' change blank string to null string
6400 SCREENDATA$(I) = LEFT$(SCREENDATA$(I),J)
6410 NEXT I
6420 RETURN
7980 '
7990 ' ***********************************
8000 ' *** Display I/O Subroutines ***
8010 ' ***********************************
8090 '
8100 ' *** Print Form on Screen ***
8110 '
8120 CLS : PRINT : PRINT TAB(20) "Record Number"; RECORD
8130 PRINT : PRINT "First Name: ";STRING$(20,"_"); " M.I.: __ Last Name: ";STRING$(16,"_")
8140 PRINT : PRINT "Address: "; STRING$(34,"_")
8150 PRINT : PRINT "City: "; STRING$(18,"_"); " State: __ Zip: "; STRING$(5,"_")
8160 PRINT : PRINT "Phone: ";STRING$(16,"_")
8170 PRINT : PRINT "Activity Key: "; STRING$(8,"_")
8180 PRINT : PRINT "Membership Key: ";STRING$(8,"_")
8190 PRINT : PRINT : PRINT TAB(22) "(Press <Esc> to delete record)"
8200 PRINT : PRINT TAB(12) "(Forward tab to next item, <Enter> to exit form)"
8210 RETURN
8390 '
8400 ' *** Print Data on Screen ***
8410 '
8420 COLOR HI, BG
8430 FOR I = 1 TO 10
8440 READ ROWDATA, COLDATA, LENDATA
8450 LOCATE ROWDATA,COLDATA : PRINT SCREENDATA$(I);
8460 NEXT I
8470 RETURN
8490 '
8500 ' *** Process Keyboard Inputs to Screen ***
8510 '
8520 COLORVAL = SCREEN(ROW,COL,1) : COLORFORE = (COLORVAL MOD 16) : CHARACTER = SCREEN(ROW,COL)
8530 LOCATE ROW,COL : COLOR BG,COLORFORE : PRINT CHR$(CHARACTER);
8540 FOR I = 1 TO 30
8550 DATUM$ = INKEY$ : IF DATUM$ <> "" THEN GOTO 8620
8560 NEXT I
8570 LOCATE ROW,COL : COLOR COLORFORE,BG : PRINT CHR$(SCREEN(ROW,COL));
8580 FOR I = 1 TO 30
8590 DATUM$ = INKEY$ : IF DATUM$ <> "" THEN GOTO 8620
8600 NEXT I
8610 GOTO 8530
8620 LOCATE ROW,COL : COLOR COLORFORE,BG : PRINT CHR$(SCREEN(ROW,COL));
8625 IF ASC(DATUM$) = 27 THEN 9600 ' delete entry
8630 IF LEN(DATUM$) = 1 THEN GOTO 8700
8640 CURMOVE = ASC(RIGHT$(DATUM$,1))
8650 IF CURMOVE = 77 THEN COL = COL + 1 : IF COL > 80 THEN COL = 1 : ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23 : COL = 80
8660 IF CURMOVE = 75 THEN COL = COL - 1 : IF COL < 1 THEN COL = 80 : ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1 : COL = 1
8670 IF CURMOVE = 80 THEN ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23
8680 IF CURMOVE = 72 THEN ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1
8685 IF CURMOVE = 83 THEN LOCATE ROW,COL : IF COLORFORE = 15 THEN COLOR FG,BG : PRINT "_";
8690 GOTO 8520
8700 VALDATUM = ASC(DATUM$)
8710 IF VALDATUM = 9 THEN COLOR COLORFORE,BG : LOCATE ROW,COL : PRINT CHR$(CHARACTER) : READ ROW,COL,LENDATA : IF ROW = 1 THEN RETURN ELSE GOTO 8500
8720 IF VALDATUM = 13 THEN RETURN
8730 IF VALDATUM < 31 OR VALDATUM > 127 THEN GOTO 8760
8740 LOCATE ROW,COL : COLOR HI,BG : PRINT DATUM$;
8750 COL = COL + 1 : IF COL > 80 THEN COL = 1 : ROW = ROW + 1 : IF ROW = 24 THEN ROW = 23 : COL = 80
8760 IF VALDATUM = 8 THEN LOCATE ROW,COL : COLOR FG,BG : PRINT "_"; : COL = COL - 1 : IF COL < 1 THEN COL = 80 : ROW = ROW - 1 : IF ROW = 0 THEN ROW = 1 : COL = 1
8770 GOTO 8520
8790 '
8800 ' *** Read data from screen ***
8810 '
8820 FOR I = 1 TO 10
8830 SCREENDATA$(I) = "" : READ ROWDATA, COLDATA, LENDATA
8840 FOR J = 0 TO LENDATA -1
8850 SCREENDATA$(I) = SCREENDATA$(I) + CHR$(SCREEN(ROWDATA,COLDATA+J))
8860 NEXT J
8870 NEXT I
8880 RETURN
8890 '
8900 ' *** Data statements for form data locations ***
8910 '
8920 DATA 4,13,20,4,44,1,4,62,16,6,10,34,8,7,18,8,37,2,8,49,5
8930 DATA 10,8,16,12,15,8,14,17,8,1,1,1
8980 '
8990 ' *************************************
9000 ' *** Miscellaneous Subroutines ***
9010 ' *************************************
9090 '
9100 ' *** Process Yes/No Inputs ***
9110 '
9115 ENTRY$ = INKEY$
9120 ENTRY$ = INKEY$ : IF ENTRY$ = "" THEN 9120
9130 IF ENTRY$ = "Y" OR ENTRY$ = "y" THEN YES = 1 ELSE YES = 0
9140 IF YES = 1 THEN PRINT "Yes" ELSE PRINT "No"
9150 RETURN
9190 '
9200 ' *** Select keyfield for printing labels ***
9210 '
9220 CLS : PRINT : PRINT " You may print labels selectively, based on the ten data fields stored in"
9230 PRINT "each record. Select your key field, then specify the key. For example, if"
9240 PRINT "you select a keyfield of `City' and a key of `Detroit', then only people"
9250 PRINT "living in Detroit will have their labels printed."
9260 PRINT " The last two fields, activity and membership, are intended so that you can"
9270 PRINT "mail to only people with a specific interest or members of a specific club."
9280 PRINT "A good system is to assign a single letter of the alphabet as the key for each"
9290 PRINT "interest or organization on your list, allowing up to eight keys per name."
9300 PRINT : PRINT TAB(20) "Key fields are: ";CHR$(13);" 1. First name";CHR$(13);" 2. Middle Initial";CHR$(13);" 3. Last Name"
9310 PRINT " 4. Address";CHR$(13);" 5. City";CHR$(13);" 6. State";CHR$(13);" 7. Zip code"
9320 PRINT " 8. Phone #";CHR$(13);" 9. Activity Key";CHR$(13);" 10. Membership key"
9330 PRINT : INPUT "Input number of keyfield"; KEYFIELD
9340 KEYFIELD = INT(KEYFIELD) : IF KEYFIELD < 1 OR KEYFIELD > 10 THEN PRINT "Only use keyfield between 1 and 10, please." : GOTO 9310
9350 RETURN
9390 '
9400 ' *** Sort Subroutine ***
9410 '
9420 FOR I = 2 TO LASTRECORD
9430 IF SORT$(I) > SORT$(I-1) THEN 9560 ' skip if already in order
9450 FOR J = I-1 TO 0 STEP -1 ' find place to insert
9460 IF SORT$(I) > SORT$(J) THEN 9500
9470 NEXT J
9480 GOTO 9560
9500 TEMP$ = SORT$(I) : TEMP = SORT(I) ' hold item to insert
9510 FOR K = I TO J+2 STEP -1 ' bump others up
9520 SORT$(K) = SORT$(K-1) : SORT(K) = SORT(K-1)
9530 NEXT K
9540 SORT$(J+1) = TEMP$ : SORT(J+1) = TEMP ' Insert index item
9560 NEXT I
9570 RETURN
9590 '
9600 ' *** Delete index & record of deleted item ***
9610 '
9620 COLOR FG, BG : GOSUB 8100 ' write blank form
9630 LOCATE 15,1 : PRINT SPACE$(80) : LOCATE 17,1 : PRINT SPACE$(80) : PRINT TAB(20) "DELETE RECORD . . . Are you sure (y/n)? ";
9640 GOSUB 9100
9650 IF YES = 0 THEN RETURN 9810
9660 RESTORE : GOSUB 8800 : GOSUB 6100 ' Write blanks to disc
9670 GOSUB 1800 ' Add record # to free record list
9680 RETURN 9810
9690 '
9700 ' *** Edit record ***
9710 '
9730 CLS : MENU = 0
9740 GOSUB 6300
9750 GOSUB 8100
9760 RESTORE : GOSUB 8400
9770 RESTORE : READ DUMMY, DUMMY, DUMMY : ROW = 4 : COL = 13
9780 GOSUB 8500
9790 LOCATE 22,20 : COLOR FG,BG : PRINT "Store updated data on disc (yes/no)? "; : GOSUB 9100
9800 IF YES = 1 THEN RESTORE : GOSUB 8800 : GOSUB 6100
9810 LOCATE 22,10 : COLOR FG,BG : PRINT "(Strike any key to find next record or return to menu)"
9820 DUMMY$ = INKEY$ : IF DUMMY$ = "" THEN GOTO 9820
9830 MENU = 0 : RETURN
9890 '
9900 ' *** Error Traps ***
9910 '
9920 IF ERR = 57 THEN 9960
9925 IF ERR = 61 THEN 9965
9930 IF ERR = 68 THEN 9970
9935 IF ERR = 70 THEN 9975
9940 IF ERR = 71 THEN 9980
9945 IF ERR = 72 THEN 9985
9950 ON ERROR GOTO 0
9960 PRINT : PRINT "Disc I/O error. No I/O took place. Try another disc." : GOTO 9990
9965 PRINT : PRINT "Disc full. Your last entry was not saved." : GOTO 9990
9970 PRINT : PRINT "Device unavailable. Check installation." : GOTO 9990
9975 PRINT : PRINT "The disc is write protected. Your entry was not saved."
9980 PRINT : PRINT "The disc was not ready. No I/O took place." : GOTO 9990
9985 PRINT : PRINT "Media error. Check for bad disc. No I/O took place." : GOTO 9990
9990 PRINT : PRINT "Press any key to restart program. "
9995 Z$ = INKEY$ : IF Z$ = "" THEN 9995 ELSE CLOSE : RUN
9999 END
23:59:55 01-02-1983
JOE LONG
MAILING LIST PROGRAM v1.0 by Joe Long
This is a straightforward mailing list program written as an exercise.
It is fairly powerful, allowing sorting by four fields and keying printing of
labels by any field. It will print one across or two across labels. It was
repeatedly modified and expanded in scope as it grew, so it is not as elegantly
structured as it should be. It has had little testing, so probably has bugs --
please report any bugs to me at the address listed in the program heading.
The program has five files open at once, and uses the function keys, so
BASICA must be called with five file buffers specified. Call as
"BASICA/F:5/S:512".
The program is nearly self-explanatory. Use the "tab" key or cursor
control keys to move about the form. "Tab" only moves forward. "Esc" deletes
the current record from the file. You are always given a chance to change your
ind before the disc is modified, except when inputting a new record.
Sorting is done by maintaining a separate index file for the four sort
fields. Only these files are sorted, the main file is never shuffled.
Searches are done by a binary search, so the index files must be sorted before
a search if even one record has been changed. An insertion sort is used, which
is fast when the list is almost in order (as will be the case when only a few
records have been changed since the last sort). If you enter a large number of
new records, the sort can get very slow. I have a compiled version available,
which I have not uploaded because of its large size (42K). You can get it by
sending me a blank, formatted disc in a self-addressed return mailer WITH
POSTAGE.
The program does a LOT of disc I/O. It will run much faster if you have a
"ramdisc" (a virtual disc drive in high RAM). Just change the drive
specification on lines 160, 180, 200, 220, and 240 to the ramdrive.
Feel free to modify or expand this program as you wish. It is fairly
well self-documented, so modification should not be difficult.
If you have a color monitor, change the values of FG, BG, BD, and HI to
whatever colors suit you. They are now set for B/W monitors.
My only reason for the 1,000 record limit is the feeling that by that time
the program will have gotten intolerably slow anyway, at least until the
compiled version is done. If you have the disc space, and a compiler, you may
wnat to increase this. Notice that I maintain dynamic file allocation;
eleted records are re-used to keep the file from growing unnecessarily. Up to
50 deleted record numbers are saved at one time.
If you have any questions, write me or leave a message on the Capitol BBS.
eted record numbers are saved at on
PLOTTER.DOC Documentation for Plotter 4/19/86
This package of programs contain a demonstration program
written in Turbo Pascal along with a set of procedures for
plotting high resolution (640x400 pixel) graphs. The plotter
routines are intended for engineering and scientific applications
where X-Y coordinate line plots are needed and where standard
color graphic adaptor screen dumps are inadequate. The routines
are simple to use and provide a high resolution hard copy from
printers compatible with the Epson MX-80/FX-80 dot graphics. It
has been tested on IBM PCs and ATs and a Radio Shack model 3000.
I have not tried it on any other systems. The software is
composed of three files:
o DEMOPLOT.PAS - A pascal demonstration program which uses
the Pascal graphics procedures contained in HiResPlt.pas.
o HiResPlt.PAS - A file of Pascal routines which are
necessary to draw axis and perform plotting. The procedures
work in conjunction with another program, HIPLOT2, written
in assembly code which actually performs the plotting.
HiResPlt.pas is used as an "include" file in programs like
DEMOPLOT which require graphics.
o HIPLOT2.EXE - This assembly code plotter attaches itself
to the system as a run-and-remain-resident program
accessible via a single interrupt. Access through interrupt
was chosen to simplify interfacing to higher level
languages. As a result, only the interface routines need to
be customized to a particular compiler.
o PLOTTER.DOC - This description of the plotter software.
BACKGROUND:
HIPLOT2 was originally written to provide a higher
resolution curve than was available with the 640x200 pixel
resolution of an IBM Color Graphics Adapter (CGA). HIPLOT2
"draws" the plot into a large buffer to a resolution of 640x400
pixels. At the same time, it can optionally draw a lower
resolution curve of 640x200 pixels on the CGA. When a hardcopy
is requested, the higher resolution curve is sent from the buffer
to the printer in the Epson bit graphics format. This is to be
contrasted with a screen dump which has the same resolution as
the display.
Because the printed resolution is different from the
displayed resolution, the characters stored in the buffer and
printed on the hardcopy are selected from a different character
matrix made compatible with the higher resolution. The CGA,
however, receives the lower resolution IBM ROM character set.
HIPLOT2 maps the character matrix to the CGA differently than is
done in other graphics packages like BASICA. Mapping is done on
1
a pixel boundary where the characters can be placed anywhere on
the CGA display. In BASICA, placement is restricted to column-
row boundarys. Bit mapping provides flexibility when labeling
axis tics.
Future plans include modifying HIPLOT2 to use the higher
resolution of the IBM Enhanced Graphics Adapter (EGA) if used,
however until then, the software uses the highest resolution
available on the CGA. It will work on the EGA but only the
reduced 640x200 resolution compatible with the CGA. You may need
to type "mode co80" before running the graphics software. If you
notice loss of sync when using a card other than the color
graphics card, you may need to reboot to avoid damage to your
monitor.
DEMOPLOT.PAS is a small demonstration program. The user
should try the demonstration program first to see how it works.
This is done by first running HIPLOT2 to load the machine code
plotter into memory and then running Turbo Pascal with
DEMOPLOT.PAS as the work file. Again, you may need to run "mode
co80" before running Turbo if you use an EGA.
The demonstration program first asks if a color graphics
card is available. If a no is given, plotting to the screen is
suppressed. The program then draws a diagonal line and a box.
It then allows the user to position a crosshair using the cursor
keys. Absolute coordinates are displayed at the top of the
screen. When the user presses <enter>, the program will ask if a
hard copy is desired. A "y" followed by an <enter> will cause
the program to attempt to send the plot to the printer. Any
other character or simply an <enter> will cause the program to go
to the next demonstration.
The next demonstration is a more realistic plot of the
absolute value of a sine wave followed by a simple dotted line.
Again, the user is given the opportunity to read out the
coordinates of the curve with a crosshair and then to get a hard
copy of the curve. To simply view the operation of the plotter,
simply keep hitting <enter> and the demonstration will progress
from beginning to end.
2
If you have the same hardware configuration as I, you should
have no problem running the program. I do not have the resources
to try the software on any more than a few systems so I cannot
say what will or will not work. The two systems which I have
been able to use the software on are:
Configuration: 1 2
Type: IBM PC, 256k main board IBM AT
Graphics board: IBM CGA IBM EGA
Disc Drives: 2ea. Teac DSDD Floppies 20 Mbyte hard disc
Total RAM: 640k 512k
IBM DOS version: 2.0 3.10
It also seems to run on a Radio Shack model 3000.
The only difference between the operation on the above
systems involves the timing used to fast move the crosshair.
Look in the source code and set the value of a constant MinCount
in procedure Crosshair. Correctly setting it is not mandatory
but it removes the jerkyness that might otherwise exist of the
value is not set for your system.
There are several reasons why the software may not work on
your system. First, of course, is that you may have a very
different display board than I do. The software will try to plot
points using interrupt 10h. If your graphics adapter modifies
this interrupt routine, the results will be unpredictable.
Secondly, HIPLOT2 will try to attach a pointer to itself at
interrupt 64h. If you already have something attached to that
interrupt, the software will give you an error message and abort.
Some hard disk software configurations, for instance, may attach
their software to the same pointer, so be careful.
Finally, there have been reports of damage to monitors if
they are driven by the wrong sync. Since this software does not
address the hardware directly, there should be no problem.
HiResPlt uses the Turbo graphics procedures and HIPLOT2 plots
points via interrupt 10H, therefore there should be no problem.
If you use a different display adaptor, you should verify that a
sync error will not occur.
Because of the wide variety of configurations, the following
disclaimer is necessary:
DISCLAIMER:
This software is provided free for public domain on an "as
is" basis for others to use on a non-profit basis. The Author
will in no way be held responsible to you or to any third party
for any damages such as lost profits or savings or other
incidental or consequential damages resulting from the use of
this software or its misuse whether or not the Author has been
advised of the possibility of such damages.
3
DESCRIPTION OF PROCEDURES IN HiResPlt
The plotter procedures and functions described next are all
part of the plotter package. The demonstration program does not
have any procedures or functions unique to it alone.
Hcmd(CMD,I1,I2:integer)
This and Htext perform the actual interrupts to HIPLOT2.
Hcmd has three arguments. CMD is a command integer which tells
HIPLOT2 what you want it to do. I1 and I2, also integers, are
the parameters which may be required. When coordinates are to be
specified, I1 represents X and I2 represents Y.
Command Function
0 Set origin (cursor) of next curve to point I1,I2
1 Plot line from last point (origin) to I1,I2
2 Not used from Hcmd. See Htext
3 Clear plotter buffer and, if selected, the CRT screen
4 Make hardcopy on Epson MX-80 or equivalent printer
5 Home cursor to x=0, y=0.
6 Set mode bits to least significant byte of I1
7 Set line pattern to pattern in I1
8 Set pixel "color". I1=0 for white (Erase), I1=1 for
black (default). Used to erase curve.
9 Do not use
10 Do not use
11 Set x window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
12 Set y window to I1 and I2 (I2 > I1) Prevents
plotting outside of window.
13 Do not use
Htext(CMD:Integer, S:String, I:Integer)-
This is similar to Hcmd except it is intended for text
command 2 where S is the string to be placed on the graph at the
cursor location and I is the maximum length. The string printed
will be the lesser of the length of the string or I.
Hdraw(IX1,IY1,IX2,IY2)-
This draws a line from IX1, IY1 to IX2, IY2 in the non-axis
mode. It is similar to Plot except it uses absolute co-ordinates
and does not draw from the last point.
Pattern(I:Integer)-
4
This sets the line pattern to reflect the bit pattern of the
integer, I. If used, it must be placed after Axis or SetPlot.
Note that Pattern($FFFF) will make a solid line and
Pattern($CCCC) will produce a dotted line with medium length
dots.
ScreenOn and ScreenOff-
These procedures enable or disable plotting to the CRT.
Normally, ScreenOn would be used unless the system does not have
an IBM color graphic adapter such as the CGA or the EGA, or
something equivalent.
ToUpper(S:String)- This simply converts string S to upper case.
Beep- This just makes a short beep near middle C.
Alarm- This produces a more noticeable tone
SetOption(B:Byte)-
HIPLOT2 has a set of 8 flags which select options. These
are only useful to other procedures. If interested, refer to the
comments in the routine.
Option(I:Integer, B:Boolean)-
The same comments as for SetOption. This just allows the
individual setting of the bits.
BW80-
This resets the CRT back to text mode after a plot.
Cls-
This clears the screen. It has no effect on the plotter
buffer. Clearing the buffer is done with Hcmd using command 3.
Box(IX1,IY1,IX2,IY2)-
This will draw a box with the main diagonal from IX1, IY1 to
IX2, IY2.
5
FindReal(IX,IY:Integer, Xval,Yval:Real)-
This converts the integer absolute screen values to the real
values computed by Axis. It is not used in non-axis plotting.
SetCross(IX,IY:Integer)-
A utility routine for placing a crosshair on the plot. User
does not need to use this directly. It is called by Crosshair.
DaTime(I:Integer)-
This places the date and the time at the left and right
sides of the plot. It is invoked in Axis so you do not need it
unless you plan to use SetPlot instead. I=0 places them at the
bottom, I=1 places them at the top.
SetTypeComputer(I1,I2: Integer)-
This sets the timing in the crosshair updating routine to
match the type of computer used. This routine allows low rate
keypresses to move the crosshair in small steps and fast
keypresses to move the crosshair in large steps. It is not
required to invoke this routine, but it makes the operation of
the crosshair appear smoother.
Crosshair(Ix,Iy:Integer)-
This draws a crosshair on either an axis or a non-axis plot
and allows the user to read out the values into the integers Ix,
Iy. In the axis mode, Ix, Iy should be converted to real graph
values by using FindReal.
Hcopy(Str1,Str2:string)-
If Str1 is the string "PAUSE", the routine will ask if a
hardcopy is desired. Without it, a hardcopy is automatically
made. If Str2 is the string "EJECT", then a page will be ejected
after plotting.
Vcheck-
This is a function which checks to see if the HIPLOT2
software is loaded. If it is not, Vcheck will be set to 0 else
Vcheck will be set equal the current HIPLOT2 version number if
HIPLOT2 is loaded.
FmtNum(Val:real)-
6
This is used by Axis to place a formatted number on the plot
at the current cursor position.
Xinit- This is used by Axis to initialize the plotter.
SetPlot-
This initializes the plotter for subsequent plotting for
cases where line drawings alone are desired (non-axis plotting).
The global scale factors are set to create a screen where x=0,
y=0 represents the upper left part of the screen as in Turbo's
Plot. The lower right co-ordinates are x=639, y=399. Note that
the vertical resolution is twice that of Turbo. This routine
takes the place of Axis. Either use SetPlot or Axis to
initialize the plotter.
Axis(X1,X2,X3,Y1,Y2,Y3:Real)-
This initializes the CRT and plotter buffer, draws the axis
and sets the required scale factors for later plotting. For a
linear X-axis, X1 is the start value, X2 is the stop value, and
X3 is the incremental value to be added at each tic. For a
Logarithmic X-axis, X1 is the starting decade, x2 is the number
of decades and x3=0. The same is true for the Y axis. When the
axis is drawn, if the values to be printed require an exponential
format, they are scaled with the multiplication factor placed
close by in a box near the axis. Not included in the parameter
list but used as a global variable is Alpha[n], where n ranges
from 1 to 9. These are the strings to be printed. Alpha[1] is
the x-axis label, Alpha[2] is the Y-axis label and the remainder
constitute the heading.
ReOrg-
This resets the origin flag so that the next point to be
plotted will become the starting point for the next curve. This
allows multiple curves to be plotted. This is used only in the
axis plotting mode.
Interpolate(Var I1,I2: Integer; I3,I4: Integer)-
When a program asks the plotter to plot out of the active
window, the plotter will stop plotting at the boundarys. HIPLOT2
simply stops placing pixels but acts as if the plot is
7
continuing. Because only integers are passed to HIPLOT2, it is
possible for overflow to place the point at the other side of the
active window. Interpolate helps calculate the point
corresponding to the edge of the window to allow limiting the
line drawn to the boundary to avoid the problem. The routine is
intended for internal use only.
Hplot(X,Y:real)-
The values of X,Y are plotted after being scaled. The
scaling is based on the values selected by the user in the call
to Axis. There is no separate windowing or whatever as in more
sophisticated plotter packages. This is used only in the axis
mode. For non-axis mode, use Hdraw.
Insert(X,Y:Real, I:Integer)-
This places the single digit integer, I, at a location on
the plot specified by X and Y. X and Y are real quantities. I
ranges from 1 through 9.
FINAL COMMENTS:
That's it. The plotter package is meant to be easy to use
at the expense of some flexibility. This is the first version to
be released although I have used various versions in my own work
for several years in Turbo-Pascal, FORTRAN and BASIC. I would
like to revisit this software in detail in a few months and I
would appreciate any comments and suggested modifications. I
have not released the source for HIPLOT2 yet since I plan to make
some significant changes. One of these may be a search algorithm
to place the routine at an available interrupt in case the one
currently used has already been taken. Another will be to allow
drawing a high resolution curve on the enhanced graphics adapter.
Please send comments and suggestions to me. Please describe
your machine. I would like to know if there are clones that
have problems with this software.
Roger Coleman
2011 Bradway St NE
Palm Bay, Fl
32905
(305) 724-6873
8
100 '****************************
110 '* *
120 '* PMB *
130 '* Preventive Maintenance *
140 '* And Bill Program *
150 '* *
160 '****************************
170 '
180 A$=" PMB - Preventive Maintanence, Bill Program (IBM-Ver 1.0) - 10/8/83 "
190 '
200 ' Copyright (C) 1983 J. R. Coleman
210 ' License is granted to all users to copy, use and distribute this
220 ' program provided that no fee is charged or any other consideration
230 ' received without written permission.
240 ' J. R. Coleman, (305) 724-6873 2011 Bradway st NE, Palm Bay, Fl 32905
250 '
260 ' This program is written for IBM PC and will work with DOS 2.0
270 ' and the color graphics card. The program may be compiled if desired.
280 ' Instructions are found close to end of program.
290 '
300 DEFINT I-N
310 DIM ITYPE(100),ITRIG(100),MSG$(100),IP1(100),IMONT(12,2)
320 DIM CARNAME$(4),IMILE(4)
330 MAXITEM=100 'Maximum number of items, set to agree with dim
340 'Array maximum based on maximum number of items possible in file
350 '
360 'Initialize constants
370 MAXLIN=12 'Maximum number of lines listed on console before pause
380 FORMFEED$=CHR$(12)
390 F1$="### #### ###### ###### &"
400 STR1$="Num Type TrigNo Para-1 ........Comment........"
410 STR2$="=== ==== ====== ====== ======================="
420 QUO$=CHR$(34) 'Quote
430 ABRT$="/" 'Abort character
440 ABSTR$=CHR$(7)+"==> ABORTED..." 'Abort string
450 BELL$=CHR$(7) 'Bell tone
460 ESC$="??????" : INVON$=ESC$+"5" : INVOFF$=ESC$+"2" 'Escape, inverse on/off
470 UL$=CHR$(201) : UR$=CHR$(187): LL$=CHR$(200): LR$=CHR$(188): HH$=CHR$(205): VV$=CHR$(186) 'double bar graphics symbols
480 '
490 KEY OFF : WIDTH 80 : SCREEN 0,0,0: CLS:
500 COLOR 0,7:PRINT SPACE$(LEN(A$)): PRINT A$: PRINT SPACE$(LEN(A$)): COLOR 7,0
510 'Create arrays for conversion to/from month, day, year to IDATE
520 DATA 31,28,31,30,31,30,31,31,30,31,30,31
530 DATA 31,29,31,30,31,30,31,31,30,31,30,31
540 FOR I=1 TO 12 : READ IMONT(I,1) : NEXT I 'Load non-leap years
550 FOR I=1 TO 12 : READ IMONT(I,2) : NEXT I 'Load leap years
560 '
570 'Print signon message
580 'Get today's date from real time clock or user
590 GOSUB 10100
600 'Load file data into various arrays
610 GOSUB 1000
620 '
630 'Choose option
640 WHILE CMD$<> "STOP" 'Not used for stopping, use ^C
650 PRINT
660 PRINT UL$+STRING$(61,HH$)+UR$ 'Draw box
670 PRINT VV$;" Commands: ";VV$
680 PRINT VV$;" U-update N-next due C-car pm S-save data ";VV$
690 PRINT VV$;" I-insert K-kill L-list all/due D-change date ";VV$
700 PRINT VV$;" H-help E-EXIT ";VV$
710 PRINT VV$;" If required, enter parameter seperated by space ";VV$
720 PRINT LL$+STRING$(61,HH$)+LR$
730 PRINT
740 A$=" Enter command: " : GOSUB 9880 : CMD$=ANS$
750 IF INSTR("UNCSIKLDH",CMD$)=0 OR LEN(CMD$)=0 THEN GOSUB 10730 : COLOR 0,7: PRINT"==> Bad command...": COLOR 7,0
760 IF CMD$="U" THEN GOSUB 2000 'Update item with current data
770 IF CMD$="N" THEN GOSUB 3000 'Print next due items on printer
780 IF CMD$="C" THEN GOSUB 4000 'Enter car PM mode
790 IF CMD$="S" THEN GOSUB 5000 'Save current data in file
800 IF CMD$="I" THEN GOSUB 6000 'Insert new item
810 IF CMD$="K" THEN GOSUB 7000 'kill item from list
820 IF CMD$="L" THEN GOSUB 8000 'List all or some items
830 IF CMD$="D" THEN GOSUB 9000 'Enter new date
840 IF CMD$="H" THEN GOSUB 9200 'Print instructional data
850 IF CMD$="E" THEN CLS: STOP
860 WEND
870 '
880 STOP
890 '
900 '=================================================================
910 '
920 '**** Main subroutines ****
930 '
940 '.................................................................
1000 'Load PM and Bill data into arrays
1010 '
1020 PRINT : PRINT"Loading file data..." : PRINT
1030 OPEN "I",1,"ITEMDATA.DAT"
1040 I=0 'File length counter
1050 IF EOF(1) THEN 1180
1060 INPUT#1,A$ 'Read comment line
1070 GOSUB 10730 'New page and print date at top right of screen
1080 PRINT : PRINT MID$(A$,8)
1090 INPUT #1,IDUM,CARNAME$(1),CARNAME$(2),CARNAME$(3),CARNAME$(4),NCARS
1100 PRINT
1110 PRINT"Item";TAB(8);"..............Text.............."
1120 PRINT"====";TAB(8);"================================"
1130 WHILE EOF(1)=0
1140 I=I+1
1150 INPUT#1,IDUM,ITYPE(I),ITRIG(I),MSG$(I),IP1(I),IDUM,IDUM
1160 IF ITYPE(I) < 100 AND ITRIG(I) <= IDATE+7 THEN PRINT I;TAB(8);MSG$(I)
1170 WEND
1180 NITEMS=I
1190 CLOSE 1
1200 RETURN
1210 '
1220 '.................................................................
2000 '"U" - Update item with current date
2010 '
2020 IF LEN(ANSP$) = 0 THEN INPUT "Enter item number (CR to abort): ", ITEM ELSE ITEM=VAL(ANSP$) 'Get parameter
2030 IF ITEM <= 0 THEN AA$=ABSTR$ : GOSUB 10800 : GOSUB 10880: RETURN 'Abort
2040 IF ITEM > NITEMS THEN PRINT BELL$;"==> Item does not exist..." : RETURN
2050 GOSUB 10730 'New page and print date at top right of screen
2060 IF ITYPE(ITEM)=1 THEN PRINT BELL$; "==> Item cannot be updated, use delete" :RETURN
2070 PRINT : PRINT "Update:" : PRINT : COLOR 0,7 : PRINT SPACE$(24);MSG$(ITEM); " " : COLOR 7,0 : PRINT
2080 AA$=" Enter 'Y' or `y` for yes:": GOSUB 10800 : LOCATE IROW,ICOL : INPUT A$ : LOCATE JJ,II : IF A$ <> "Y" AND A$<>"y" THEN AA$=ABSTR$: GOSUB 10880 : GOSUB 10800 : PRINT : RETURN 'Abort
2090 IF ITYPE(ITEM)=2 THEN ITRIG(ITEM)=ITRIG(ITEM)+IP1(ITEM)
2100 IF ITYPE(ITEM)=3 THEN ITRIG(ITEM)=IDATE+IP1(ITEM)
2110 IF ITYPE(ITEM)=4 THEN IDAT=ITRIG(ITEM) : GOSUB 10290 : ITRIG(ITEM)=IDA : ITEM=ITEM : GOSUB 10430 'Update by finding day, next valid month
2120 'Note: for type 4, the call to 10360 sets imo, ida, and iyr
2130 IF ITYPE(ITEM)>1 AND ITYPE(ITEM) < 100 THEN IDAT=ITRIG(ITEM) : GOSUB 10290 : MID$(MSG$(ITEM),1,8)=MID$(STR$(IMO),2)+ "/"+MID$(STR$(IDA),2)+"/"+ MID$(STR$(IYR),2)+" "
2140 IF ITYPE(ITEM) > 100 AND ITYPE(ITEM) < 105 THEN ITRIG(ITEM)=IMILE(ITYPE(ITEM)-100)+IP1(ITEM)
2150 PRINT STR1$ : PRINT STR2$ : PRINT USING F1$;ITEM;ITYPE(ITEM); ITRIG(ITEM); IP1(ITEM);MSG$(ITEM) : PRINT
2160 RETURN
2170 '
2180 '.................................................................
3000 '"N" - Print next due on printer
3010 '
3020 GOSUB 10730 'New page and print date at top right of screen
3030 IF LEN(ANSP$)>0 THEN ITEMP=VAL(ANSP$) ELSE ITEMP=0 'Evaluate parameter
3040 IF ITEMP <> 0 THEN IDUE=IDATE+ITEMP ELSE IDUE=IDATE+14
3050 LPRINT : LPRINT "PREVENTIVE MAINTANENCE/BILL PROGRAM" : LPRINT
3060 IDAT=IDATE+7 : GOSUB 10290 : LPRINT "Resolve on ";IMO;"/";IDA;"/";IYR
3070 IDAT=IDUE : GOSUB 10290 'Find day, month, year of due date
3080 LPRINT "Items due in";IDUE-IDATE;"days or before ";IMO;"/";IDA;"/";IYR : LPRINT
3090 LPRINT "Item";TAB(8);"Message, Bill or PM due"
3100 LPRINT "====";TAB(8);"======================="
3110 'For each non-car item, check and print items due
3120 FOR I=1 TO NITEMS
3130 IF ITRIG(I) <= IDUE AND ITYPE(I) < 100 THEN LPRINT I;TAB(8);MSG$(I)
3140 NEXT I
3150 'For each car, check and print items due
3160 FOR J=1 TO NCARS
3170 IF IMILE(J) <= 0 THEN 3230
3180 LPRINT : LPRINT TAB(8);"Current mileage for ";CARNAME$(J);" is"; IMILE(J);",000 miles"
3190 FOR I=1 TO NITEMS
3200 IF ITYPE(I) = 100+J AND ITRIG(I) <= IMILE(J) THEN IPRINT=1 ELSE IPRINT=0
3210 IF IPRINT THEN LPRINT I;TAB(8);MSG$(I)
3220 NEXT I
3230 ' CONTINUE
3240 NEXT J
3250 LPRINT FORMFEED$
3260 AA$="==> Done..." : GOSUB 10800
3270 RETURN
3280 '
3290 '.................................................................
4000 '"C" - Enter car PM mode by entering milage
4010 '
4020 GOSUB 10730 'New page and print date at top right of screen
4030 I=1
4040 WHILE LEN(CARNAME$(I))<>0
4050 PRINT"Enter mileage for ";CARNAME$(I);" in K-miles or CR";
4060 INPUT IMILE(I)
4070 I=I+1
4080 WEND
4090 PRINT"No. Due-Mi ........Comment........"
4100 PRINT"=== ====== ======================="
4110 J=1
4120 WHILE LEN(CARNAME$(J)) <> 0
4130 FOR I=1 TO NITEMS
4140 IF ITYPE(I)=100+J AND IMILE(J) >= ITRIG(I) THEN PRINT USING "### ###### &";I,ITRIG(I),MSG$(I)
4150 NEXT I
4160 PRINT"=== ====== ======================="
4170 J=J+1
4180 WEND
4190 PRINT
4200 RETURN
4210 '
4220 '.................................................................
5000 '"S" - Save data in new file
5010 '
5020 GOSUB 10730 'New page and print date at top right of screen
5030 PRINT"==> Creating new file..."
5040 OPEN "O",2,"ITEMDATA.$$$"
5050 PRINT#2,"1 'ITEMDATA.DAT - Data file for PMB as of "+TODAY$
5060 PRINT#2,USING "# ,&,&,&,&,#";2;QUO$+CARNAME$(1)+QUO$,QUO$+CARNAME$(2)+QUO$; QUO$+CARNAME$(3)+QUO$;QUO$+CARNAME$(4)+ QUO$;NCARS
5070 FOR I=1 TO NITEMS
5080 PRINT#2,I+2;",";ITYPE(I);",";ITRIG(I);",";QUO$;MSG$(I);QUO$;",";IP1(I) ;",";0;",";0
5090 NEXT I
5100 CLOSE 2
5110 KILL "ITEMDATA.BAK"
5120 NAME "ITEMDATA.DAT" AS "ITEMDATA.BAK"
5130 NAME "ITEMDATA.$$$" AS "ITEMDATA.DAT"
5140 AA$=" ==> File updated, done...": GOSUB 10800
5150 RETURN
5160 '.................................................................
6000 '"I" - Insert item routine
6010 '
6020 GOSUB 10730 'New page and print date at top right of screen
6030 IF NITEMS>MAXITEM-10 THEN PRINT BELL$;"==> Number of items within"; " 10 of maximum allowed in array"
6040 IF NITEMS >= MAXITEM THEN PRINT BELL$;"==> NITEM >=";MAXITEM : RETURN
6050 PRINT
6060 PRINT"Menu of item types:"
6070 PRINT"Type Formula for when message displays"
6080 PRINT"==== =============================="
6090 PRINT" 1 Displays on due date, no update"
6100 PRINT" 2 Displays on fixed periods."
6110 PRINT" 3 Displays on fixed period after last update"
6120 PRINT" 4 Displays on fixed monthly pattern"
6130 PRINT
6140 FOR J=1 TO NCARS
6150 IF LEN(CARNAME$(J)) <> 0 THEN PRINT STR$(100+J); " K-Mileage exceeded for ";CARNAME$(J)
6160 NEXT J
6170 PRINT
6180 IERROR=0 'Set error flag off
6190 PRINT"Current date is: ";IMONTH;"/";IDAY;"/";IYEAR
6200 PRINT "Enter type: "; : INPUT ITYPX
6210 IF ITYPX <= 0 THEN RETURN ELSE NITEMS=NITEMS+1
6220 IF (ITYPX > 4 AND ITYPX < 101) OR (ITYPX > 104 ) THEN GOSUB 10730 : AA$="==> Invalid type number..": GOSUB 10800 : RETURN
6230 PRINT"Enter message: v........................................v"
6240 LINE INPUT " ";MSG$(NITEMS) 'Length <= 50 char
6250 ITYPE(NITEMS)=ITYPX 'Same for all types
6260 'Processing for non-car item:
6270 WHILE ITYPX > 0 AND ITYPX < 10 'For non-cars
6280 IF ITYPX <> 4 THEN INPUT "Enter Month: ";IMOX : INPUT "Enter Day: "; IDYX : INPUT "Enter last two digits of year: ";IYRX ELSE INPUT "Enter Day of month: ";ITRIG(NITEMS) 'Itrig set by subroutine later
6290 IF ITYPX <> 1 AND ITYPX <> 4 THEN INPUT "Enter period: "; IP1(NITEMS)
6300 IF ITYPX = 4 THEN PRINT"Enter JFMAMJJASOND (0-Skip month, 1-Due month)" : INPUT"pattern: ";A$ : K=1 : FOR I=1 TO 12 : K=K+(ASC(MID$(A$,I,1))-ASC("0"))*2^(I-1) : NEXT I : IP1(NITEMS)=K
6310 IF ITYPX = 4 THEN B$="" : FOR I=0 TO 11 : B$=B$+RIGHT$(STR$(1-K MOD 2),1) : K=K/2 : NEXT I : IF A$ <> B$ THEN PRINT "Pattern error, wanted:";A$ : PRINT " got: ";B$ : IERROR=1
6320 IF IYRX MOD 4 = 0 THEN LEPX=2 ELSE LEPX=1
6330 IF ITYPX <> 4 THEN ITEMP2=IDYX+365*(IYRX-80) :FOR I=1 TO IMOX-1 : ITEMP2=ITEMP2+IMONT(I,LEPX) : NEXT I :ITRIG(NITEMS)=ITEMP2 ELSE ITEM=NITEMS : GOSUB 10430 'Subr finds next date from pattern
6340 IF ITYPX=4 THEN IMOX=IMO : IDYX=IDA : IYRX=IYR 'For adding date next
6350 C$=MID$(STR$(IMOX),2)+"/"+MID$(STR$(IDYX),2)+"/"+MID$(STR$(IYRX),2)+ " " : MSG$(NITEMS)=LEFT$(C$,8)+ " = "+MSG$(NITEMS)
6360 ITYPX=0 'ITYPX reset to exit from while/wend loop
6370 WEND
6380 'Processing for car items:
6390 IF ITYPX >100 AND ITYPX <105 THEN INPUT "Enter K-miles due: ";ITRIG(NITEMS) : INPUT "Enter interval, K-miles: ";IP1(NITEMS) : MSG$(NITEMS)=CARNAME$(ITYPX-100)+": "+MSG$(NITEMS)
6400 'Print results of above
6410 IF IERROR=1 THEN AA$=BELL$+" ==> Error...item not saved..." :GOSUB 10800: NITEMS=NITEMS-1 : RETURN
6420 GOSUB 10730 'New page, done
6430 PRINT STR1$ : PRINT STR2$ : PRINT USING F1$;NITEMS;ITYPE(NITEMS); ITRIG(NITEMS);IP1(NITEMS);MSG$(NITEMS) : PRINT
6440 RETURN
6450 '
6460 '.................................................................
7000 '"K" - Kill item in array
7010 '
7020 IF LEN(ANSP$)=0 THEN GOSUB 8000 : AA$=" ==> Kill which one? (or CR) ": GOSUB 10800 :INPUT ANSP$
7030 IF LEN(ANSP$)=0 OR VAL(ANSP$) <= 0 THEN AA$=ABSTR$: GOSUB 10880: PRINT: RETURN ELSE TEMP=VAL(ANSP$) 'Abort if not valid
7040 IF TEMP >NITEMS THEN AA$="==> Cannot kill item above max item": PRINT AA$ : GOSUB 10800 : AA$=ABSTR$: GOSUB 10880: PRINT: RETURN
7050 GOSUB 10730 : PRINT : PRINT "==>Kill this one? ": PRINT : COLOR 0,7 : PRINT SPACE$(24);MSG$(TEMP);" " : COLOR 7,0 : PRINT
7060 AA$=" Enter 'Y' or 'y' for yes:" : GOSUB 10800 : LOCATE IROW,ICOL: INPUT A$ :LOCATE JJ,II : IF A$ <> "Y" AND A$<>"y" THEN AA$=ABSTR$ : PRINT : GOSUB 10880 : PRINT :GOSUB 10800 : RETURN
7070 GOSUB 10730 'New page and print date at top right of screen
7080 IF TEMP=NITEMS THEN NITEMS=NITEMS-1 : AA$=" ==> Done...": GOSUB 10800 : RETURN 'Special case
7090 FOR I=TEMP+1 TO NITEMS 'Move items above down
7100 ITYPE(I-1)=ITYPE(I) : ITRIG(I-1)=ITRIG(I) : MSG$(I-1)=MSG$(I) : IP1(I-1)=IP1(I)
7110 NEXT I
7120 NITEMS=NITEMS-1
7130 AA$="==> Done..." :PRINT AA$ : GOSUB 10800
7140 RETURN
7150 '
7160 '.................................................................
8000 '"L" - List current array with no conversions
8010 '
8020 IF INSTR(ANSP$,"p") OR INSTR(ANSP$,"P") OR INSTR(ANSP$,"l") OR INSTR(ANSP$,"L") THEN LST=1 ELSE LST=0
8030 IF INSTR(ANSP$,"d") OR INSTR(ANSP$,"D") THEN IDUE=1 ELSE IDUE=0
8040 GOSUB 10730 'New page and print date at top right of screen
8050 PRINT : PRINT : IF LST THEN LPRINT : LPRINT
8060 PRINT STR1$
8070 IF LST THEN LPRINT STR1$
8080 PRINT STR2$
8090 IF LST THEN LPRINT STR2$
8100 PRINT : IF LST THEN LPRINT
8110 'Print all non-car or just ones due before end of 7th day
8120 ICOUNT=0
8130 FOR I=1 TO NITEMS
8140 IF ITYPE(I) < 100 AND (IDUE=0 OR ITRIG(I) <= IDATE+7) THEN IPRINT=1 ELSE IPRINT=0
8150 IF IPRINT THEN PRINT USING F1$;I;ITYPE(I);ITRIG(I);IP1(I);MSG$(I)
8160 IF LST AND IPRINT THEN LPRINT USING F1$;I;ITYPE(I);ITRIG(I);IP1(I); MSG$(I)
8170 IF IPRINT=1 THEN ICOUNT=ICOUNT+1 : IF ICOUNT MOD MAXLIN = 0 THEN GOSUB 10630: IF A$<>ABRT$ THEN PRINT STR1$: PRINT STR2$ 'Pause/continue
8180 IF A$=ABRT$ THEN I=NITEMS
8190 NEXT I
8200 IF A$=ABRT$ THEN RETURN
8210 'Print all cars or just ones due
8220 FOR J=1 TO NCARS
8230 IF IMILE(J) <= 0 AND IDUE=1 THEN 8340
8240 PRINT : IF LST THEN LPRINT
8250 PRINT TAB(8);"Current mileage for ";CARNAME$(J);" is"; IMILE(J); ",000 miles"
8260 IF LST THEN LPRINT TAB(8);"Current mileage for ";CARNAME$(J);" is"; IMILE(J);",000 miles"
8270 FOR I=1 TO NITEMS
8280 IF ITYPE(I) = 100+J AND (IDUE = 0 OR ITRIG(I) <= IMILE(J)) THEN IPRINT=1 ELSE IPRINT=0
8290 IF IPRINT THEN PRINT USING F1$;I;ITYPE(I);ITRIG(I);IP1(I); MSG$(I)
8300 IF IPRINT AND LST THEN LPRINT USING F1$;I;ITYPE(I);ITRIG(I); IP1(I);MSG$(I)
8310 IF IPRINT=1 THEN ICOUNT=ICOUNT+1 : IF ICOUNT MOD MAXLIN = 0 THEN GOSUB 10630 : IF A$<>ABRT$ THEN PRINT STR1$ : PRINT STR2$
8320 IF A$=ABRT$ THEN I=NITEMS : J=NCARS 'To exit loop
8330 NEXT I
8340 'continue...
8350 NEXT J
8360 IF A$=ABRT$ THEN RETURN
8370 PRINT : IF LST THEN LPRINT
8380 PRINT"Current date number=";IDATE
8390 IF LST THEN LPRINT"Current date number=";IDATE
8400 PRINT : IF LST THEN LPRINT
8410 IF LST THEN LPRINT FORMFEED$
8420 IF CMD$="K" THEN RETURN 'No pause if called by 'kill routine
8430 GOSUB 10630 'Wait for pause, then new page
8440 RETURN
8450 '
8460 '.................................................................
9000 '"D" - Enter new date or use todays
9010 IF LEN(ANSP$)=0 THEN IYEAR=IYRT : IMONTH=IMOT : IDAY=IDYT : IDATE=IDATT : LEAP=LEPT : GOSUB 10730 : RETURN
9020 ITEMP=INSTR(ANSP$,"/") : ITEMP1=INSTR(ITEMP+1,ANSP$,"/")
9030 IF ITEMP=0 OR ITEMP1=0 THEN PRINT BELL$;"==> Bad form, use: xx/xx/xx" : RETURN
9040 ITEMP2=VAL(MID$(ANSP$,1,ITEMP-1))
9050 ITEMP3=VAL(MID$(ANSP$,ITEMP+1,ITEMP1-ITEMP-1)) 'day?
9060 ITEMP4=VAL(MID$(ANSP$,ITEMP1+1)) 'Year?
9070 IF ITEMP2 < 1 OR ITEMP2 > 12 OR ITEMP3 < 1 OR ITEMP3 > 31 OR ITEMP4 < 80 OR ITEMP4 > 99 THEN PRINT BELL$;"==> Bad argument, use: xx/xx/xx" :RETURN
9080 IMONTH=ITEMP2 : IDAY=ITEMP3 : IYEAR=ITEMP4
9090 GOSUB 10220 'Convert to get IDATE, LEAP
9100 GOSUB 10730 'New page
9110 RETURN
9120 '
9130 '.................................................................
9200 '"H" - Help by printing instructions
9210 GOSUB 10730 'New page and print date at top right of screen
9220 PRINT
9230 PRINT" PMB - Preventive Maintenance Program"
9240 PRINT""
9250 PRINT" o Initially displays all non-car items which are or will"
9260 PRINT" be due within 7 days. Date used read from real-time"
9270 PRINT" clock but can be changed by D command. "
9280 PRINT""
9290 PRINT" o Cars displayed when trigger = mileage for valid cars"
9300 PRINT" specified in data file."
9310 PRINT""
9320 PRINT" o Space must separate command from any parameter."
9330 PRINT""
9340 PRINT" o Commands, param may be upper/lower case."
9350 PRINT""
9360 PRINT" o Dates compared using Julian-like date code where:"
9370 PRINT" Date=(Day of month)+{365*(year-1980)}+"
9380 PRINT" (Number of days from start of year, +1 if leap)"
9390 PRINT""
9400 GOSUB 10630 : IF A$=ABRT$ THEN RETURN 'Wait for ready or abort
9410 PRINT
9420 PRINT" o File format: {line #},{type},{trigger},''Msg'',{P1},0,0"
9430 PRINT" where: line # - Not used, allows data file to be"
9440 PRINT" edited like basic program."
9450 PRINT" type - Type of item"
9460 PRINT" trigger- Trigger is Julian-like date or miles."
9470 PRINT" Trig is calculated at entry"
9480 PRINT" or update and is a 'Next due' value."
9490 PRINT" Msg - The message displayed."
9500 PRINT" P1 - A parameter used by some item types."
9510 PRINT""
9520 PRINT" Type Update formula"
9530 PRINT" ==== =============="
9540 PRINT" 1 One shot. Must be deleted, not updated"
9550 PRINT" 2 Trig = (Old trig) + P1"
9560 PRINT" 3 Trig = (Current date) + P1"
9570 PRINT" 4 Trig = Next month in pattern on fixed day"
9580 PRINT""
9590 PRINT" 101 Trig = (Current mileage) + P1 for car 1"
9600 PRINT" : : : : for car 2, 3"
9610 PRINT" 104 : : : for car 4"
9620 PRINT""
9630 GOSUB 10630 : IF A$=ABRT$ THEN RETURN 'Wait for ready or abort
9640 PRINT""
9650 PRINT" Commands Description"
9660 PRINT" ======== ==========="
9670 PRINT" U n - Update item n (car or non-car) using"
9680 PRINT" current date, mileage."
9690 PRINT" N n - Next items due sent to printer."
9700 PRINT" n=number of days added. Default is"
9710 PRINT" n=14 for next 14 days."
9720 PRINT" C - Car PM. Displays due car items for"
9730 PRINT" miles entered. (No printer)"
9740 PRINT" S - Save updated data in file with old"
9750 PRINT" data to .bak ('itemdata.dat')"
9760 PRINT" I - Insert new item"
9770 PRINT" K n - Kill item n"
9780 PRINT" L x x - List items (all or due if x=d,D)."
9790 PRINT" Send to printer if either x=p,P,l, or L."
9800 PRINT" D m/d/y - Change current date to m/d/y "
9810 PRINT" D - Change current date to today"
9820 PRINT" H - Display this message"
9830 PRINT""
9840 GOSUB 10630 : IF A$=ABRT$ THEN RETURN 'Wait for ready or abort
9850 RETURN
9860 '
9870 '.................................................................
9880 '*** Minor routines ***
9890 '
9900 '.................................................................
9910 '
10000 'Print question on stat line, get answer, convert to upper case if req.
10010 II=POS(O) : JJ=CSRLIN : LOCATE 25,1 :PRINT SPACE$(30); : COLOR 0,7
10020 LOCATE 25,1 : PRINT A$; : COLOR 7,0 : INPUT ANST$ : ANS$=LEFT$(ANST$,1)
10030 LOCATE JJ,II
10040 ITEMP=INSTR(ANST$," ") : IF ITEMP>0 THEN ANSP$=MID$(ANST$,ITEMP+1) ELSE ANSP$=""
10050 IF LEN(ANST$)=0 THEN RETURN
10060 IF ASC(ANS$) > ASC("a")-1 AND ASC(ANS$) < ASC("z")+1 THEN ANS$=CHR$(ASC(ANS$)-&H20) 'Convert to lower case
10070 RETURN
10080 '
10090 '.................................................................
10100 'Get date from real time clock or user routine
10110 '
10120 A$=DATE$+" "+TIME$
10130 PRINT : PRINT : PRINT " Today's date is ";A$
10140 TODAY$=A$
10150 IMONTH=VAL(LEFT$(A$,2)) : IDAY=VAL(MID$(A$,4,2)) : IYEAR=VAL(MID$(A$,9,2))
10160 IF IMONTH<1 OR IMONTH>12 OR IDAY<1 OR IDAY>31 OR IYEAR<83 OR IYEAR>99 THEN PRINT BELL$;BELL$;BELL$;"Error in clock reading "; "routine, enter month,day,year with commas:" : INPUT IMONTH,IDAY,IYEAR
10170 GOSUB 10220 'Convert to get IDATE, LEAP
10180 IYRT=IYEAR: IMOT=IMONTH : IDYT=IDAY : IDATT=IDATE : LEPT=LEAP 'Set "today" constants
10190 RETURN
10200 '
10210 '.................................................................
10220 'Convert IYEAR, IMONTH, IDAY to IDATE, LEAP
10230 IF IYEAR MOD 4 = 0 THEN LEAP=2 ELSE LEAP=1 'Won't use after 1999
10240 IDATE=IDAY+365*(IYEAR-80) 'The almost Julian date without day
10250 IF IMONTH>1 THEN FOR I=1 TO IMONTH-1 : IDATE=IDATE+IMONT(I,LEAP) : NEXT I
10260 RETURN
10270 '
10280 '.................................................................
10290 'Convert "Julian-like" date code to real month, day, year routine
10300 'Variables used are not same as other conversion to avoid conflict
10310 '
10320 IYR=80+INT(IDAT/365) : ITEMP=IDAT MOD 365
10330 IF IYR MOD 4 = 0 THEN LP=2 ELSE LP=1 'Won't use after 1999
10340 ISUM=0 : I=0 'INITIALIZE FOR CONVERSION TO MONTH, DAY
10350 WHILE ISUM < ITEMP
10360 I=I+1 : ISUM=ISUM+IMONT(I,LP)
10370 WEND
10380 IMO=I : IDA=ITEMP-ISUM+IMONT(I,LP)
10390 'PRINT "IDAT = ";IMO;"/";IDA;"/";IYR
10400 RETURN
10410 '
10420 '.................................................................
10430 'Find and set the next date for pattern number for ITYPE=4
10440 'This is used in Insert and Update
10450 K=IP1(ITEM) : C$="" : FOR I=0 TO 11 : C$=C$+RIGHT$(STR$(1-K MOD 2),1): K=K/2 : NEXT I
10460 C$=C$+C$ 'Double length to allow falling into next year
10470 D$="" : IM=IMONTH
10480 WHILE D$ <> "1" AND IM <= 24 'Loop over minimum of 1 year
10490 IM=IM+1 'First check next month
10500 D$=MID$(C$,IM,1)
10510 WEND 'IM should point to next due month
10520 IF IM > 12 THEN IY=IYEAR+1 : IM=IM-12 ELSE IY=IYEAR
10530 IF IY MOD 4 = 0 THEN L=2 ELSE L=1
10540 IDAT=365*(IY-80)+ITRIG(ITEM) 'Include year, day of month
10550 FOR I=1 TO IM-1
10560 IDAT=IDAT+IMONT(I,L)
10570 NEXT I
10580 ITRIG(ITEM)=IDAT
10590 GOSUB 10290 ': PRINT: PRINT"Trig: ";IMO;"/";IDA;"/"IYR 'Find month,day,yr
10600 RETURN
10610 '
10620 '.................................................................
10630 'Wait for Return keypress, then call clean screen
10640 A$="xxx" 'Make different than expected string
10650 WHILE A$="xxx"
10660 AA$="Use CR to cont.,"+ABRT$+" CR to abort: " : GOSUB 10800: LOCATE IROW ,ICOL: INPUT A$: IF LEN(A$)>0 AND A$<>ABRT$ THEN A$="xxx": PRINT BELL$;
10670 LOCATE JJ,II 'Return to last cursor position
10680 WEND
10690 GOSUB 10730
10700 RETURN
10710 '
10720 '.................................................................
10730 'Clean screen and place date at command line
10740 '
10750 CLS: AA$=STRING$(34,28)+" Active Date: "+STR$(IMONTH)+"/"+STR$(IDAY)+"/"+ STR$(IYEAR)+" Real Time: "+TIME$
10760 GOSUB 10800 'Print date, real time
10770 RETURN
10780 '
10790 '.................................................................
10800 'Print status message on 25th line
10810 II=POS(O) : JJ=CSRLIN : LOCATE 25,1 : COLOR 0,7
10820 PRINT AA$; : ICOL=POS(0) : IROW=CSRLIN
10830 COLOR 7,0 : LOCATE JJ,II
10840 RETURN
10850 '
10860 '
10870 '.................................................................
10880 'Print AA$ in reverse video at current location
10890 COLOR 0,7 : PRINT AA$ : COLOR 7,0
10900 RETURN
PMB - Preventive Maintanence, Bill, and Message Program
-------------------------------------------------------
This program provides a way of keeping track of events which
occur periodically such as bills, preventive maintanence items,
dentist appointments, yearly vet checks for the family animal,
and once-only items such as important meetings planned far in
advance. The program is designed to be operated weekly and, when
requested, will print out the items due in the following two
weeks. To operate, you must create two files with an editor or
with BASICA. The file structure is ASCII in a format which
almosts resembles a program to BASICA. This format lets you edit
the file, should you ever need to, using BASICA rather than an
editor. Therefore, the disk containing your files need not have
both an editor and BASICA.
First, enter BASICA and type the following:
1 '
2 ,"CARNAME1","CARNAME2","CARNAME3","CARNAME4",NCAR
The first line is a comment line and will be filled by PMB
each time you save an updated file.
The second line contains a set of 1-4 string names of the
vehicles that you want to place on a mileage-based maintanence
schedule. NCAR is a single digit number of the number of
significant names desired (1,2,3 or 4). Use two double qoutes
for empty entries.
Then type SAVE "ITEMDATA.DAT",A to save the file. REMEMBER
TO APPEND THE 'A' OPTION TO SAVE AN ASCII FILE. Also create a
backup file: SAVE "ITEMDATA.BAK",A
For example, use:
1 '
2 ,"FORD","CHEVY","HONDA","",3
SAVE "ITEMDATA.DAT",A
SAVE "ITEMDATA.BAK",A
LOAD "PMB
RUN
At this point, you can run the program. It should
automatically load the data file and list the commands available.
Test the program by inserting, with the I command, the items
below:
Enter Command: ? I
The program then prints out the instructions for the command
and:
Enter type: ? 1
Enter message: v...........................................v
Time for income tax
Enter Month: ? 2
Enter Day: ? 1
Enter last two digits of year: ? 87
The program should then print:
Num Type TrigNo Para-1 .........Comment........
=== ==== ====== ====== ========================
1 1 1492 0 2/1/84 = Time for income tax
Then save the file with the "S" command. When you load and
run the program, it should only display the once-only message if
the date is within one week of the date given, or later. It will
then continue to display the message each time you run the
program until you kill (K) the message.
When you save the datafile, (S), the program will add a
comment line in line 1 with the creation date and the items you
have inserted, (I). If you then exit, (E) and load itemdata.dat
and list it, you should get:
1 'ITEMDATA.DAT - Data file for PMB as of <what ever the date is>
2 ,"FORD","CHEVY","HONDA","",3
3 , 1 , 1492 ,"2/1/84 = Time for income tax", 0 , 0 , 0
The line number is to allow you to use the BASICA editor if
you want to modify the file. In line 3, the next number is the
item type, 1 means one-shot message, no renewal. The 1492 is the
number of days after 1 Jan 1980 (Its NOT Julian, but then, so
what?) The last 3 numbers are parameters, only one is used. The
remainder are there for growth.
You can try some other examples and change the date with the
D command to test the results.
Roger Coleman
2011 Bradway st NE
Palm Bay, Fl 32905
A Final Note:
Cursor speed constant:
The demonstration program was modified to allow direct
entry of MinCount99 which sets the minimum count between any two
keypresses of the same cursor control arrow. This discriminates
between two finger taps and holding the key down. The latter
means to move the cursor in bigger steps. Unfortunately, this
test makes the software processor speed sensitive.
In retrospect, I should have calculated time using the
system clock rather than relying on processor speed because of
the wide variety of machines in the world. Alas, its too late
now. That will be left for the next version when I add mouse
software.
DEMOPLOT was modified at the last moment to allow you to
select the value for the speed constant. If my suggestions do
not work best for your machine, try doubling the constant by a
factor of 2 to move the cursor quickly when the key is held down.
Reduce the constant by a factor by 2 to allow the cursor to move
in small steps on individual key presses. You can fine tune the
value if you want. The number is typed as a constant.
NEW HIPLOT2:
The current HIPLOT2 version is 10-08-86 8:40PM and it replaces
the version 2-23-86 12:08PM. The only difference is to modify
hardcopy routine for faster output. It now uses INT 17h rather
than the much slower INT 21h.
OLD WARNING MESSAGE:
The documentation has a stiff warning to make the user pay
attention when he first tries it on his system. After using
the software on a number of clones, it appears that the worst
thing that should happen is that HIPLOT2 will not load. It looks
to see if the interrupt is occupied before installing itself.
If the vector is 0000:0000 then it assumes it to be available.
If not, it says that 64h is occupied and returns you to the
system. The Pascal procedures have a function Vcheck which
looks for the 16 bit sequence A55Ah and a valid version number.
To keep the plotting routines as fast as possible, the check is
done only once. If something changes the vector during a plot
than there could be a problem. Just make sure to include
Vcheck in your software and avoid changing int 64h during a plot.
COMPATIBILITIES:
I have found the software to work on:
o IBM PC
o IBM XT
o IBM AT
o PC Limited 8 Mhz AT
o Wells American 8 Mhz
o Wells American 10 Mhz
o Lanier C-2400 AT
o Radio Shack 3000
I have not kept a list of printers that it works on but I know
it has worked on a good number. The only printer that did not work
well with it was a Star Radix-15 which does not work with 123
graphs either for the same reason. The bit mapped graphics are
8 pixels high and a line feed should skip 8 pixels worth. The
Star skips more and leaves a gap. Just my luck that the printer
happens to belong to my fiance'.
INCOMPATIBILITIES:
o Some network software use the same interrupt vector and Hiplot2
will not allow loading. If you network, try not installing the
network software prior to plotting to your printer.
o As I said, the Star Radix-15 skips lines.
R. Coleman 1/18/87
10 ' ***********
20 ' * Rolodex *
30 ' ***********
40 KEY OFF:WIDTH 80:GOSUB 1950:LOCATE ,,0
50 A$="a":Z$="z":AC$="A":ZC$="Z":B$=" "
60 CV%=ASC(AC$)-ASC(A$)
70 DIM NUM%(26)
80 DEF FNCAP$(C$)=CHR$(ASC(C$)+CV%*(C$>=A$)*(C$<=Z$))
90 ' Disk file is Rolodex.dat with a length of 128
100 ' Each address is contained on one record
110 ' The first 16 characters is the last name
120 ' The next 22 characters is the first name or names
130 ' The next 3 sets of 20 characters is the street or mailing address
140 ' The next 9 characters is the zip code
150 ' The next 20 characters is the phone number
160 ' The last character is a sub code
170 OPEN "Rolodex.dat" AS #1 LEN=128
180 FIELD #1,16 AS LAST.NAME$,22 AS FIRST.NAME$,20 AS ADDRESS1$,20 AS ADDRESS2$,20 AS ADDRESS3$,9 AS ZIP.CODE$,20 AS PHONE.NUMBER$,1 AS SUB.CODE$
190 FIELD #1,128 AS GOT$
200 IF LOF(1)>0 THEN 320
210 LOCATE 5:PRINT "The disk in drive A: doesn't have a rolodex data file on it."
220 PRINT "Rolodex requires a data file that will take up most of the space"
230 PRINT "of a single sided disk. Do you want the data file opened and initia-"
240 PRINT "ed, or would you rather not at this moment. It is suggested that"
250 PRINT "you have only DOS, BASIC, ROLODEX, and it's data file on the disk"
260 PRINT:PRINT "Do you want to 1 Initialize the disk or 2 stop here";
270 INPUT " (1 or 2)";WHICH
280 IF WHICH<1 OR WHICH>2 THEN 260 ELSE IF WHICH=2 THEN CLOSE:KILL"Rolodex.dat":END
290 LOCATE 14,14:PRINT "Initializing the address data file"
300 LSET GOT$=""
310 FOR I=1 TO 850:PUT #1,I:NEXT I
320 GOSUB 2280: ' Wave a little flag for Clay Jones
330 GOSUB 1950:LOCATE 5,,0:PRINT "A = Enter new addresses"
340 PRINT:PRINT "B = Edit existing addresses"
350 PRINT:PRINT "C = List addresses"
360 PRINT:PRINT "D = End"
370 PRINT:PRINT:PRINT "Press the key for the option you want"
380 L$="ABCD"
390 CMD$=INKEY$:IF CMD$="" THEN 390
400 CMD$=FNCAP$(CMD$)
410 CMD%=INSTR(L$,CMD$):IF CMD%=0 THEN SOUND 1000,1:SOUND 2000,2:BEEP:GOTO 390
420 SOUND 1000,1:SOUND 2000,2:SOUND 3000,2:ON CMD% GOTO 430,660,970,1840
430 GOSUB 1960:LOCATE 5,13:COLOR 0,7:PRINT "End adding":COLOR 7,0:LOCATE 24,1:PRINT "[PgUp] to start over entering";
440 LOCATE 5,13:MAX.IN=16:GOSUB 2070
450 IF IN$="" THEN GOTO 330
460 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LAST$=IN$
470 IF FNCAP$(IN$)<"A" OR FNCAP$(IN$)>"Z" THEN LOCATE 5,30:PRINT "That is an invalid last name":GOSUB 1920:GOTO 430
480 LOCATE 7,13:MAX.IN=22:GOSUB 2070
490 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE FIRST$=IN$
500 LOCATE 9,13:MAX.IN=20:GOSUB 2070
510 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LINE1$=IN$
520 LOCATE 11,13:MAX.IN=20:GOSUB 2070
530 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LINE2$=IN$
540 LOCATE 13,13:MAX.IN=20:GOSUB 2070
550 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE LINE3$=IN$
560 LOCATE 15,13:MAX.IN=9:GOSUB 2070
570 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE ZIP$=IN$
580 LOCATE 17,13:MAX.IN=20:GOSUB 2070
590 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE PHONE$=IN$
600 LOCATE 19,13:MAX.IN=1:GOSUB 2070
610 IF IN$=CHR$(1) OR IN$=CHR$(2) THEN 430 ELSE CODE$=FNCAP$(IN$+" ")
620 START%=(ASC(FNCAP$(LEFT$(LAST$,1)))-ASC(AC$))
630 START%=START%*30+1
640 GET #1,START%:IF ASC(FIRST.NAME$)<>ASC(B$) AND ASC(FIRST.NAME$)<>ASC("*") THEN START%=START%+1:GOTO 640
650 NUMBER=START%:GOSUB 1760:GOTO 430
660 GOSUB 1950:LOCATE 5:PRINT "Last name ";:COLOR 0,7:PRINT ":End editing"SPC(5):COLOR 7,0
670 LOCATE 7,1:PRINT "Terminate with a ? to search for part of a name":PRINT "ie. ";:COLOR 0,7:PRINT ":A? ";:COLOR 7,0:PRINT " will search for all last names starting with A"
680 LOCATE 5,13:MAX.IN=16:GOSUB 2070:IF IN$="" THEN 330
690 GOSUB 1850:IF NUM=-1 THEN LOCATE 5,30:PRINT "Invalid name":GOSUB 1920:GOTO 660
700 IF NUM=0 THEN LOCATE 5,30:PRINT "No such last name on file":GOSUB 1920:GOTO 660
710 IF NUM=1 THEN NUMBER=NUM%(1):GOTO 750
720 GOSUB 1950:PRINT:FOR I=1 TO NUM:PRINT I;:GET #1,NUM%(I):PRINT LAST.NAME$;FIRST.NAME$:NEXT I
730 INPUT "Which one";W:IF W=0 THEN 660 ELSE IF W<1 OR W>NUM THEN 710
740 NUMBER=NUM%(W)
750 GOSUB 1670:GOSUB 1960:LOCATE 24,1:PRINT "[PgUp] to redisplay address - [PgDn] to end without corredtions";
760 COLOR 0,7:LOCATE 5,13:PRINT LAST$;:COLOR 7,0:PRINT " Enter an * here to delete":COLOR 0,7:LOCATE 7,13:PRINT FIRST$:LOCATE 9,13:PRINT LINE1$
770 LOCATE 11,13:PRINT LINE2$:LOCATE 13,13:PRINT LINE3$:LOCATE 15,13:PRINT ZIP$:LOCATE 17,13:PRINT PHONE$
780 LOCATE 19,13:PRINT CODE$:COLOR 7,0
790 MAX.IN=16:LOCATE 5,13:GOSUB 2070:IF IN$="*" THEN LAST$="*":GOTO 950 ELSE PRINT SPC(30)
800 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660
810 IF IN$<>"" THEN IF LEFT$(IN$,1)<>LEFT$(LAST$,1) THEN PRINT "You can`t change the first letter of the last name":FOR I=1 TO 1000:NEXT I:GOTO 710 ELSE LAST$=IN$
820 MAX.IN=22:LOCATE 7,13:GOSUB 2070
830 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN FIRST$=IN$
840 LOCATE 9,13:MAX.IN=20:GOSUB 2070
850 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN LINE1$=IN$
860 LOCATE 11,13:GOSUB 2070
870 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN LINE2$=IN$
880 LOCATE 13,13:GOSUB 2070
890 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN LINE3$=IN$
900 LOCATE 15,13:MAX.IN=10:GOSUB 2070
910 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN ZIP$=IN$
920 LOCATE 17,13:MAX.IN=20:GOSUB 2070
930 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN PHONE$=IN$
940 LOCATE 19,13:MAX.IN=1:GOSUB 2070
950 IF IN$=CHR$(1) THEN 710 ELSE IF IN$=CHR$(2) THEN 660 ELSE IF IN$<>"" THEN CODE$=FNCAP$(IN$)
960 GOSUB 1760:GOTO 660
970 GOSUB 1950:LOCATE 5:PRINT "A = Print only 1 address"
980 PRINT:PRINT "B = Print addresses with a specific last name"
990 PRINT:PRINT "C = Print all addresses":PRINT:PRINT "D = Print according to sub code"
1000 PRINT:PRINT "E = End Printing"
1010 PRINT:PRINT:PRINT "Press the key for your choice"
1020 CMD$=INKEY$:IF CMD$="" THEN 1020 ELSE CMD%=INSTR("ABCDE",FNCAP$(CMD$)):IF CMD%=0 THEN SOUND 1000,1:SOUND 2000,1:BEEP:GOTO 1020
1030 SOUND 1000,1:SOUND 2000,2:SOUND 3000,2:IF CMD%=5 THEN 330 ELSE IF CMD%>1 THEN 1150
1040 GOSUB 1950:PRINT:PRINT "List addresses":LOCATE 5:PRINT "Last name ";:COLOR 0,7:PRINT ":End "SPC(5):COLOR 7,0
1050 LOCATE 7,1:PRINT "Terminate with a ? to search for part of a name":PRINT "ie. ";:COLOR 0,7:PRINT ":A? ";:COLOR 7,0:PRINT " will search for all last names starting with A"
1060 LOCATE 5,13:MAX.IN=16:GOSUB 2070:PRINT:PRINT:IF IN$="" THEN 970
1070 GOSUB 1850:IF NUM=-1 THEN LOCATE 5,30:PRINT "Invalid name":GOSUB 1920:GOTO 1040
1080 IF NUM=0 THEN LOCATE 5,30:PRINT "No such last name on file":GOSUB 1920:GOTO 1040
1090 IF NUM=1 THEN NUMBER=NUM%(1):GOTO 1140
1100 GOSUB 1950:PRINT:FOR I=1 TO NUM:PRINT I;:GET #1,NUM%(I):PRINT LAST.NAME$;FIRST.NAME$:NEXT I
1110 INPUT "Which one";W:IF W=0 THEN 970 ELSE IF W<1 OR W>NUM THEN 1090
1120 NUMBER=NUM%(W)
1130 GOSUB 1630:IF WHICH=-1 THEN 1040
1140 GOSUB 1670:GOSUB 1480:FOR I=1 TO 2000:NEXT I:GOTO 970
1150 IF CMD%>2 THEN 1230
1160 GOSUB 1950:LOCATE 3:PRINT "List addresses":LOCATE 5:PRINT "Last name ";:COLOR 0,7:PRINT ":End";SPC(13):COLOR 7,0
1170 LOCATE 7,1:PRINT "Terminate with a ? to search for part of a name":PRINT "ie. ";:COLOR 0,7:PRINT ":A? ";:COLOR 7,0:PRINT " will search for all last names starting with A"
1180 LOCATE 5,13:MAX.IN=16:GOSUB 2070:IF IN$="" THEN 970
1190 PRINT:PRINT:GOSUB 1850:IF NUM<0 THEN LOCATE 5,30:PRINT "Invalid":GOSUB 1920:GOTO 1160
1200 IF NUM=0 THEN LOCATE 5,30:PRINT "None saved under that name":GOSUB 1920:GOTO 1160
1210 GOSUB 1630:IF WHICH=-1 THEN 1160
1220 FOR L=1 TO NUM:NUMBER=NUM%(L):GOSUB 1670:GOSUB 1480:NEXT L:FOR I=1 TO 3000:NEXT I:GOTO 970
1230 IF CMD%=4 THEN 1350
1240 GOSUB 1950:LOCATE 3:PRINT "List all addresses on file":GOSUB 1630:P=0
1250 GOSUB 1630:IF WHICH=-1 THEN 970
1260 FOR LTR=ASC("A") TO ASC("Z")
1270 IN$=CHR$(LTR)+"?":GOSUB 1850
1280 IF NUM=0 THEN 1320
1290 P=P+NUM:FOR L=1 TO NUM
1300 NUMBER=NUM%(L):GOSUB 1670:GOSUB 1480
1310 NEXT L
1320 NEXT LTR
1330 IF P=0 THEN PRINT "None saved on file" ELSE PRINT P;"addresses saved."
1340 FOR L=1 TO 3000:NEXT L:GOTO 970
1350 GOSUB 1950:LOCATE 5:PRINT "What sub codes ";:COLOR 0,7:PRINT ":";SPC(10);:COLOR 7,0
1360 PRINT:PRINT:PRINT "All names with the entered codes will be printed (space is a code also).":LOCATE 5,17:MAX.IN=10:GOSUB 2070
1370 IF IN$=CHR$(1) OR IN$=CHR$(2) OR IN$="" THEN 970 ELSE GOSUB 2060:LOOK.CODE$=IN$
1380 GOSUB 1630:P=0:IF WHICH=-1 THEN 1350
1390 FOR LTR=ASC("A") TO ASC("Z")
1400 IN$=CHR$(LTR)+"?":GOSUB 1850
1410 IF NUM=0 THEN 1450
1420 FOR L=1 TO NUM
1430 NUMBER=NUM%(L):GOSUB 1670:IF INSTR(LOOK.CODE$,CODE$)<>0 THEN P=P+1:GOSUB 1480
1440 NEXT L
1450 NEXT LTR
1460 IF P=0 THEN PRINT "None saved under that code" ELSE PRINT P;"saved under that code"
1470 FOR L=1 TO 3000:NEXT L:GOTO 970
1480 IF WHICH=1 THEN 1560
1490 FOR I=LEN(FIRST$) TO 1 STEP -1:IF MID$(FIRST$,I,1)<>B$ THEN 1500 ELSE NEXT I
1500 LPRINT TAB(T);LEFT$(FIRST$,I);" ";LAST$:LPRINT TAB(T);LINE1$:LPRINT TAB(T);LINE2$;
1510 FOR I=LEN(LINE3$) TO 1 STEP -1:IF MID$(LINE3$,I,1)<>B$ THEN 1520 ELSE NEXT I:LPRINT " ";ZIP$:GOTO 1530
1520 LPRINT:LPRINT TAB(T);LINE3$;" ";ZIP$
1530 IF PHONE=1 THEN LPRINT TAB(T);PHONE$ ELSE LPRINT
1540 LPRINT:IF I=0 THEN LPRINT
1550 IF WHICH=2 THEN RETURN
1560 FOR I=LEN(FIRST$) TO 1 STEP -1:IF MID$(FIRST$,I,1)<>B$ THEN 1570 ELSE NEXT I
1570 PRINT TAB(T);LEFT$(FIRST$,I);" ";LAST$:PRINT TAB(T);LINE1$:PRINT TAB(T);LINE2$;
1580 FOR I=LEN(LINE3$) TO 1 STEP -1:IF MID$(LINE3$,I,1)<>B$ THEN 1590 ELSE NEXT I:PRINT " ";ZIP$:GOTO 1600
1590 PRINT:PRINT TAB(T);LINE3$;" ";ZIP$
1600 IF PHONE=1 THEN PRINT TAB(T);PHONE$ ELSE PRINT
1610 PRINT:IF I=0 THEN PRINT
1620 RETURN
1630 LOCATE 10,1:INPUT "1 = on screen 2 = on printer (labels) 3 = both";WHICH$:IF WHICH$="" THEN WHICH=-1:RETURN ELSE WHICH=VAL(WHICH$)
1640 IF WHICH=0 THEN WHICH=1
1650 PRINT:INPUT "0 = Don't print phone number 1 = Do print phone number";PHONE$:IF PHONE$="" THEN 1630 ELSE PHONE=VAL(PHONE$)
1660 RETURN
1670 GET #1,NUMBER
1680 LAST$=LAST.NAME$:FIRST$=FIRST.NAME$
1690 LINE1$=ADDRESS1$
1700 LINE2$=ADDRESS2$
1710 LINE3$=ADDRESS3$
1720 ZIP$=ZIP.CODE$
1730 PHONE$=PHONE.NUMBER$
1740 CODE$=SUB.CODE$
1750 RETURN
1760 LSET LAST.NAME$=LAST$:LSET FIRST.NAME$=FIRST$
1770 LSET ADDRESS1$=LINE1$
1780 LSET ADDRESS2$=LINE2$
1790 LSET ADDRESS3$=LINE3$
1800 LSET ZIP.CODE$=ZIP$
1810 LSET PHONE.NUMBER$=PHONE$
1820 LSET SUB.CODE$=CODE$
1830 PUT #1,NUMBER:RETURN
1840 CLEAR:END
1850 START%=ASC(FNCAP$(LEFT$(IN$,1)))-ASC(AC$):NUM=0
1860 START%=START%*30+1:LSET LAST.NAME$=IN$:IN$=LAST.NAME$:NUM=0:GOSUB 2060:F$=IN$
1870 IF START%<0 OR START%>3000 THEN NUM=-1:RETURN
1880 DIST%=INSTR(F$,"?")-1:IF DIST%<0 THEN DIST%=LEN(F$)
1890 GET #1,START%:IF ASC(LAST.NAME$)=32 THEN RETURN
1900 IN$=LAST.NAME$:GOSUB 2060:IF LEFT$(IN$,DIST%)<>LEFT$(F$,DIST%) THEN START%=START%+1:GOTO 1890
1910 NUM=NUM+1:NUM%(NUM)=START%:START%=START%+1:GOTO 1890
1920 SOUND 2000,1:SOUND 1000,1
1930 FOR I=1 TO 1000:NEXT I
1940 RETURN
1950 CLS:PRINT TAB(30);"Rolodex":RETURN
1960 GOSUB 1950
1970 LOCATE 5 :PRINT "Last name ";:COLOR 0,7:PRINT ":";SPC(16):COLOR 7,0
1980 PRINT:PRINT:PRINT "First name ";:COLOR 0,7:PRINT ":";SPC(22):COLOR 7,0
1990 PRINT:PRINT:PRINT "Address ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0
2000 PRINT:PRINT:PRINT "Address ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0
2010 PRINT:PRINT:PRINT "Address ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0
2020 PRINT:PRINT:PRINT "Zip Code ";:COLOR 0,7:PRINT ":";SPC(9):COLOR 7,0
2030 PRINT:PRINT:PRINT "Phone ";:COLOR 0,7:PRINT ":";SPC(20):COLOR 7,0
2040 PRINT:PRINT:PRINT "Sub Code ";:COLOR 0,7:PRINT ": ":COLOR 7,0
2050 RETURN
2060 FOR I=1 TO LEN(IN$):MID$(IN$,I,1)=FNCAP$(MID$(IN$,I,1)):NEXT I:RETURN
2070 LFT=POS(0):IN$=""
2080 LOCATE ,,1,5,5:COLOR 0,7
2090 CMD$=INKEY$:IF CMD$="" THEN 2090
2100 IF LEN(CMD$)=1 THEN 2180
2110 IF RIGHT$(CMD$,1)<>CHR$(83) THEN 2140
2120 IF RIGHT$(IN$,1)=B$ OR POS(0)=LFT THEN 2090 ELSE LOCATE ,POS(0)-1:PRINT SPC(1);:LOCATE ,POS(0)-1:IN$=LEFT$(IN$,LEN(IN$)-1):GOTO 2090
2130 CMD$=CHR$(8):GOTO 2220
2140 IF RIGHT$(CMD$,1)<>CHR$(73) THEN 2160
2150 IN$=CHR$(1):GOTO 2200
2160 IF RIGHT$(CMD$,1)<>CHR$(81) THEN 2090
2170 IN$=CHR$(2):GOTO 2200
2180 IF CMD$=CHR$(27) THEN COLOR 7,0:LOCATE ,,,7,7:STOP
2190 IF CMD$<>CHR$(13) THEN 2220
2200 LOCATE ,LFT+MAX.IN:LOCATE ,,0,7,7:COLOR 7,0
2210 RETURN
2220 IF CMD$=CHR$(8) AND POS(0)=LFT THEN 2090
2230 IF CMD$=CHR$(8) THEN LOCATE ,POS(0)-1:PRINT SPC(1);:LOCATE ,POS(0)-1:IN$=LEFT$(IN$,LEN(IN$)-1):GOTO 2090
2240 IF POS(0)=LFT+MAX.IN THEN BEEP:GOTO 2090
2250 IF POS(0)=LFT THEN PRINT SPC(MAX.IN);:LOCATE ,LFT
2260 IN$=IN$+CMD$:PRINT CMD$;
2270 GOTO 2090
2280 ' ******************************************************************
2290 ' * Subroutine to tell everyone that Clay Jones wrote this program *
2300 ' ******************************************************************
2310 SCREEN 1:FOR I=6 TO 94 STEP 8:LINE (I,I)-(319-I,199-I),,B:SOUND 32+5*I,2:NEXT I
2320 FOR I=82 TO 2 STEP -8:LINE (I,I)-(319-I,199-I),,B:SOUND 32+5*I,2:NEXT I
2330 FOR I=4 TO 84 STEP 8:LINE (I,I)-(319-I,199-I),,B:SOUND 32+5*I,2:NEXT I
2340 LOCATE 13,16:PRINT "Clay Jones"
2350 FOR I=1 TO 20:FOR L=1 TO 20:NEXT L:LINE (120,104)-(198,104),2*(I MOD 2):NEXT I
2360 LOCATE 13,16:PRINT " Rolodex "
2370 LOCATE 24,8:PRINT " press any key to begin ";
2380 IF INKEY$<>"" THEN SOUND 1000,1:SOUND 2000,1:SOUND 1000,1:SOUND 2000,1:SCREEN 0:WIDTH 80:RETURN
2390 I=(I=0):FOR L=1 TO 20:NEXT L:LINE (128,104)-(182,104),-2*I:GOTO 2380
Rolodex
The Rolodex program is very limited. It was created simply
to be a computerized Rolodex. It only keeps track of names,
addresses, zip codes, and phone numbers.
The first time the program is run, it will give a message
about the program's data file. The data file is very large, and
doesn't change size as more addresses are added. For this reason
it is suggested that you have only DOS, BASIC, ROLODEX, and its
data file on the disk.
The program seperates the data file into 26 sections much
the same as a rolodex would, with one section for each letter of
the alphabet. The maximum number of addresses is around 800. The
program doesn't check to see how many addresses there are
because this would slow it down alot.
Inputting names and addresses is fairly straight forward.
After the lights and music have died (you can delete it if you
want, I just get a kick out of seeing my own name) you choose
the A option and enter the data with an enter at the end of
each. The only thing the program has to have, is a letter (A -
Z) as the first character of each last name. Everything else
doesn't really matter. You don't even have to put number in for
the phone number.
The rolodex also has a built in Sub Code, which means that
you can store several mailing lists in the same data file. For
instance, you could store a list of clients with a sub code of C
and a list of relatives with a sub code of R. Then when you
wanted to address for clients, just use the option to list
according to sub code and choose either C or R.
The zip code is large enough to hold the new zip codes, or
even a Euoropean Post Code. The phone number is large enough to
hold two seven digit numbers, or 1 long distance number. It can
even hold a full European number.
The page-up and page-down keys have function in a few areas.
It is best to just experiment with these and see exactly what
they do. It is always harmless to press them.
Any time that the program needs to search for a record, you
will be asked for the last name. You may either enter the entire
last name, or a part of it. But if you enter a part of it you
must put a question mark at the end. Thus to search for someone
with the last name of Jones, you could search for Jones, Jones?,
Jone?, Jon?, Jo?, or J?. As you must expect, the first character
must be a letter. Also note that if you type J? you will get a
list of every person whose last name starts with J. Also
searching for Jo? could get Jones, Johnson, or any other
starting with Jo.
If more than one person qualifies in your search, you will
be shown a numbered list of the people and asked which one you
were after. If you want none of them, a blank return will get
you out. Also, if you are editing a record, hitting the return
without typing anything over the previous data will leave that
data unaltered.
As for printing out the names and addresses, the program has
been set up to print standard mailing labels. It would print an
address every 6 lines. You always have the option of printing
the phone number or not.
You can easily add to the program in any way you care to.
You could easily put in routines to be sure that names are
printed in alphabetical order. It would be a little more tricky
to put them in zip code order, but it is possible.
Requires IBM-PC -w- about 48K and Disk Basic.
This disk copy was originally provided by "The Public Library",
the software library of the Houston Area League of PC Users.
Programs are available from the Public Library at $2 per disk
on user-provided disks. To get a listing of the disks in the
Public Library, send a self-addressed, stamped envelope to
Nelson Ford, P.O.Box 61565, Houston, TX 77208.
99 '=====================FIRST LINE OF THE PROGRAM======================
100 DRIVE$="b:" 'sets default data dr..
120 '=====================MAIN SCREEN ==================================
130 KEY OFF 'turns off 25th line
140 IF CHECK=1 THEN SCREEN ,,1 :GOTO 405 'when check,show scrn 1
150 SCREEN ,,1 'sets input to screen s
160 CLS 'clear screen 1
170 LOCATE 9,1 'go to line 9, column 1
180 PRINT" SELECT:
190 LOCATE ,20:PRINT"1-See a certain date Schedule
200 LOCATE ,20:PRINT"2-Add in the Schedule
210 LOCATE ,20:PRINT"3-Initilize disk
220 LOCATE ,20:PRINT"4-Change defalult drive
230 LOCATE ,20:PRINT"5-Clear part of data
240 LOCATE ,20:PRINT"6-Add constant occuring activity
250 LOCATE ,20:PRINT"7-Print Activity on printer
260 LOCATE ,20:PRINT"8 or Esc-End Program
265 LOCATE 20,20:PRINT "Drive:" 'displays default drv.
270 LOCATE 9,20:FOR Z=1 TO 37:PRINT CHR$(205);:NEXT 'graphs upper line
280 PRINT CHR$(187) 'graphs corner
290 FOR Z=10 TO 18:LOCATE Z,57:PRINT CHR$(186):NEXT 'graphs right horzline
300 LOCATE 18,57:PRINT CHR$(188) 'graphs corner
310 FOR Z=56 TO 20 STEP -1:LOCATE 18,Z:PRINT CHR$(205):NEXT 'bottom line
320 LOCATE 18,19:PRINT CHR$(200) 'graphs corner
330 FOR Z=17 TO 10 STEP -1:LOCATE Z,19:PRINT CHR$(186):NEXT 'left line
340 LOCATE 9,19:PRINT CHR$(201) 'graphs corner
350 LOCATE 3,1:FOR Z=1 TO 80:PRINT CHR$(223);:NEXT 'uper line
360 FOR Z=3 TO 21:LOCATE Z,80:PRINT CHR$(219):NEXT 'right line
370 FOR Z=79 TO 1 STEP -1:LOCATE 21,Z:PRINT CHR$(220):NEXT 'down line
380 FOR Z=21 TO 3 STEP -1 :LOCATE Z,1:PRINT CHR$(219):NEXT 'left line
390 CHECK=1
400 '================= cheking which key was pressed ===========================
405 LOCATE 20,26:IF DRIVE$=""THEN PRINT "current" ELSE PRINT LEFT$(DRIVE$,1)+" "
407 LOCATE 20,32:PRINT" Date:" DATE$ " " TIME$ " "
410 K$=INKEY$:IF K$="" THEN 407 'waiting for input
420 IF K$="1" THEN SCREEN ,,0,0: GOTO 1590 'see day appointments
430 IF K$="2" THEN SCREEN ,,0,0:CLS:GOTO 1740 'write day appointment
440 IF K$="3" THEN SCREEN ,,0,0:CLS:GOTO 1900 'initialize disk
450 IF K$="4" THEN SCREEN ,,0,0:CLS:GOTO 2000 'change default drive
460 IF K$="5" THEN SCREEN ,,0,0:CLS:GOTO 2100 'clear part of data
470 IF K$="6" THEN SCREEN ,,0,0: GOTO 2200 'add const. occ. actv.
480 IF K$="7" THEN SCREEN ,,0,0: GOTO 2300 'Print time activity
490 IF K$="8" OR K$=CHR$(27) THEN SCREEN 0,0,0:CLS:KEY 9,"key on":KEY ON:LOCATE 12,20: PRINT"PROGRAM ENDED":END
500 IF (K$="h") OR (K$="H") THEN SCREEN ,,0:SCREEN ,,,0:PRINT"N. AVAILABLE":END
505 IF RIGHT$(K$,1)="I" THEN SCREEN ,,,0:GOTO 410
506 IF RIGHT$(K$,1)="Q" THEN 140
510 DEF SEG=0: POKE 1050, PEEK (1052) 'clear buffer
520 BEEP: LOCATE 22,1:PRINT SPC(24) "Choose from 1 to 8 !!!
530 FOR A=1 TO 1000:NEXT 'delay loop
540 DEF SEG=0: POKE 1050, PEEK (1052) 'clear buffer
550 LOCATE 22,9:PRINT " "'erase
560 GOTO 410 'goto Mn Scrn
570 '
580 '================== inputing month =========================================
590 '
600 CLS
610 LOCATE 25,1:COLOR 0,7:PRINT" E a s y E d i t M o d e Esc = Main Screen ";: COLOR 7,0
615 DEF SEG = &H40: POKE &H17, PEEK(&H17) AND 171 'turn off Caps Lock
620 LOCATE 2,2:PRINT"Choose a Month? ";
630 COLOR 16+7 : PRINT "_" : COLOR 7 '========== prnt cursor
640 K$=INKEY$:IF K$="" OR K$=CHR$(8) OR K$=CHR$(13) THEN 640
650 IF K$=CHR$(27) THEN 120 '========================== Esc=Mn Scrn
660 LOCATE 2,18:PRINT K$;
670 IF K$="f" OR K$="F" THEN MNT$="february":LOCATE 2,18: PRINT MNT$:GOTO 910
680 IF K$="s" OR K$="S" THEN MNT$="september":LOCATE 2,18: PRINT MNT$:GOTO 910
690 IF K$="o" OR K$="O" THEN MNT$="october" :LOCATE 2,18: PRINT MNT$:GOTO 910
700 IF K$="n" OR K$="N" THEN MNT$="november":LOCATE 2,18: PRINT MNT$:GOTO 910
710 IF K$="d" OR K$="D" THEN MNT$="december":LOCATE 2,18: PRINT MNT$:GOTO 910
720 COLOR 16+7 : PRINT "_" : COLOR 7 '================== prnt cursor
730 LOCATE 25,1:COLOR 0,7:PRINT"Cursor keys disabled. Esc= start again";: COLOR 7,0
740 K2$=INKEY$:IF LEN(K2$)<>1 OR K2$=CHR$(8) THEN 740
750 IF K2$=CHR$(27) THEN 600
760 LOCATE 2,19:PRINT K2$;
770 COLOR 16+7 : LOCATE 2,20:PRINT "_" : COLOR 7
780 IF (K$="a" OR K$="A") AND (K2$="u" OR K2$="U") THEN MNT$="august" : LOCATE 2,18: PRINT MNT$:GOTO 910
790 IF (K$="a" OR K$="A") AND (K2$="p" OR K2$="P") THEN MNT$="april" : LOCATE 2,18: PRINT MNT$:GOTO 910
800 IF (K$="j" OR K$="J") AND (K2$="a" OR K2$="A") THEN MNT$="january" :LOCATE 2,18: PRINT MNT$:GOTO 910
810 K3$=INKEY$:IF LEN(K3$)<>1 OR K3$=CHR$(8) THEN 810
820 IF K3$=CHR$(27) THEN 600
830 LOCATE 2,20:PRINT K3$;
840 COLOR 16+7 : PRINT "_" : COLOR 7
850 IF (K$="j" OR K$="J") AND (K2$="u" OR K2$="U") AND (K3$="n" OR K3$="N") THEN MNT$="june":LOCATE 2,18:PRINT MNT$:GOTO 910
860 IF (K$="j" OR K$="J") AND (K2$="u" OR K2$="U") AND (K3$="l" OR K3$="L") THEN MNT$="july":LOCATE 2,18:PRINT MNT$:GOTO 910
870 IF (K$="m" OR K$="M") AND (K2$="a" OR K2$="A") AND (K3$="r" OR K3$="R") THEN MNT$="march":LOCATE 2,18:PRINT MNT$:GOTO 910
880 IF (K$="m" OR K$="M") AND (K2$="a" OR K2$="A") AND (K3$="y" OR K3$="y") THEN MNT$="may":LOCATE 2,18:PRINT MNT$+" ":GOTO 910
890 BEEP:CLS:LOCATE 25,1:COLOR 0,7:PRINT"Invalid month name....Begin again" SPC(45);:COLOR 7,0
891 GOTO 620
892 '=========== subroutine to determine name of day ==================
893 DEF FNZEL(M,D,Y)=(D+M+M+INT((M+1)*.6)+Y+Y\4-Y\100+Y\400+1) MOD 7
894 DEF FNDAY$(D)=MID$("SunMonTueWedThuFriSat",D*3+1,3)
895 DEF FNMON$(M)=MID$("JanFebMarAprMayJunJulAugSepOctNovDec",(M-1)*3+1,3)
896 MONTH=MONTH: DAY=DAY: YEAR=1984 '=================================
897 IF YEAR<100 THEN YEAR=YEAR+1900 ' Assume 20th century if not specified
898 IF YEAR<1582 THEN 901 ELSE IF YEAR>1582 THEN 902
899 IF MONTH<10 THEN 901 ELSE IF MONTH>10 THEN 902
900 IF DAY>14 THEN 902
901 PRINT "Not valid before Oct 15, 1582"
902 IF MONTH<1 OR MONTH>12 THEN PRINT "Month Invalid" :STOP
903 IF MONTH > 2 THEN 906
904 DAY.OF.WEEK=FNZEL(MONTH+12,DAY,YEAR-1) ' Jan & Feb
905 GOTO 907
906 DAY.OF.WEEK=FNZEL(MONTH,DAY,YEAR) ' Mar-Dec
907 DAY$=STR$(DAY)
908 WEEKDAY$=FNDAY$(DAY.OF.WEEK)
909 RETURN
910 '========= assigning end, begin value according to month ===================
920 IF MNT$="january" THEN BEGIN=1 :EN=31 :MONTH=1:GOTO 1050
930 IF MNT$="february" THEN BEGIN=32 :EN=59 :MONTH=2:GOTO 1050
940 IF MNT$="march" THEN BEGIN=60 :EN=90 :MONTH=3:GOTO 1050
950 IF MNT$="april" THEN BEGIN=91 :EN=120:MONTH=4:GOTO 1050
960 IF MNT$="may" THEN BEGIN=121 :EN=151:MONTH=5:GOTO 1050
970 IF MNT$="june" THEN BEGIN=152 :EN=181:MONTH=6:GOTO 1050
980 IF MNT$="july" THEN BEGIN=182 :EN=212:MONTH=7:GOTO 1050
990 IF MNT$="august" THEN BEGIN=213 :EN=243:MONTH=8:GOTO 1050
1000 IF MNT$="september" THEN BEGIN=244 :EN=273:MONTH=9:GOTO 1050
1010 IF MNT$="october" THEN BEGIN=274 :EN=304:MONTH=10:GOTO 1050
1020 IF MNT$="november" THEN BEGIN=305 :EN=334:MONTH=11:GOTO 1050
1030 IF MNT$="december" THEN BEGIN=335 :EN=365:MONTH=12:GOTO 1050
1040 PRINT"invalid month!":GOTO 600
1050 '
1060 '========= finding the particular day ======================================
1065 PLAY"L35A+G-"
1070 LOCATE 25,1:COLOR 0,7:PRINT"Cursor keys enabled. enter day=o to start again";: COLOR 7,0
1080 LOCATE 3,1
1090 DEF SEG=0: POKE 1050, PEEK (1052)
1100 FOR DELAY=1 TO 99: NEXT
1110 INPUT" Which day";DAY
1120 IF DAY=0 THEN 600
1125 IF DAY>32 THEN 1110
1127 GOSUB 892
1130 RETURN
1140 '============== writing information to disk ================================
1150 LOCATE 2,1
1160 EMP$=""
1170 OPEN DRIVE$+"scd" AS #1 LEN=25
1175 DEF SEG =&H40: POKE &H17, PEEK (&H17) OR 64
1180 FIELD #1, 25 AS F$
1190 R=2: C=1:J=0: SWITCH=0
1200 FOR A=1 TO 5:EMP$=EMP$ + CHR$( SCREEN(R,C+A+J)):NEXT
1210 COLOR 15 : LOCATE R,C+1+J: PRINT EMP$
1220 K$=INKEY$: IF K$="" THEN :COLOR 7:LOCATE 22,10:PRINT TIME$:GOTO 1220
1230 IF K$=CHR$(13) THEN 1290
1235 IF K$="r" OR K$="R" THEN CLOSE:GOTO 1610 'go to reading mode
1240 IF LEN(K$)<>2 AND K$<>CHR$(13) THEN BEEP: GOTO 1220
1250 R$=RIGHT$(K$,1)
1255 IF R$="H" THEN R2=R:R=R-1:IF J=39 AND R=1 THEN J=0:R=17:SWITCH=39:GOTO 1280 ELSE IF J=0 AND R=1 THEN R=2:GOTO 1220 ELSE GOTO 1280
1260 IF R$="P" THEN R2=R:R=R+1:IF R=18 AND J=0 THEN J=39:R=2:SWITCH=-39:GOTO 1280 ELSE IF R=18 AND J=39 THEN R=17:GOTO 1220 ELSE GOTO 1280
1270 IF R$="O" THEN 1350 ELSE GOTO 1220
1280 LOCATE R2,C+1+J+SWITCH: COLOR 7: PRINT EMP$: EMP$="":SWITCH=0:GOTO 1200
1290 LOCATE R,C+7+J: COLOR 7:LINE INPUT DAT$
1295 IF DAT$="" THEN DAT$=CHR$(32)
1300 LSET F$=DAT$
1310 IF J=0 THEN ADD=0 ELSE IF J=39 THEN ADD=16 ELSE PRINT"error":STOP
1320 PUT # 1,INT(32*(BEGIN+DAY-2)+ADD+ R-1)
1340 R=R+1: R2=R-1:IF R=18 THEN R=17
1345 GOTO 1280
1350 CLOSE: COLOR 7
1360 RETURN
1370 '=============== readong info from disk ====================================
1380 OPEN DRIVE$+"scd" AS #1 LEN=25
1390 FIELD #1, 25 AS E$
1410 COLOR 0,7:LOCATE 1:PRINT" TIME ACTIVITY TIME ACTIVITY ":COLOR 7,0
1420 COUNT=5.5
1430 Y$="00": Z$="30":CON=1
1440 FOR I=1 TO 16
1450 COUNT=COUNT+.5: IF COUNT>9.5 THEN CON=0
1460 IF COUNT>12.5 THEN CON=1
1470 GET # 1,INT(32*(BEGIN+DAY-2)+I)
1480 SWAP Z$,Y$
1490 IF COUNT>12.99 THEN COUNT =1
1500 LOCATE I+1,1+CON:PRINT STR$( INT(COUNT) );":";Z$;: LOCATE I+1,8:PRINT E$;
1510 NEXT
1520 CON=0
1530 FOR I=1 TO 16
1540 GET # 1,INT(32*(BEGIN+DAY-2)+I+16):COUNT=COUNT+.5: SWAP Z$, Y$: IF COUNT>9.600001 THEN CON=-1
1550 LOCATE I+1,40+CON :PRINT STR$( INT(COUNT) );":";Z$;: LOCATE I+1,47:PRINT E$;
1560 NEXT
1570 CLOSE
1580 RETURN
1590 '====================== seeing a certain date schedules ====================
1600 GOSUB 580: CLS 'get month and day
1610 GOSUB 1370 'go to seeing module
1620 LOCATE 18,1:COLOR 0,7: 'reverse vidio setting
1630 LOCATE 18,1:COLOR 0,7:PRINT" Reading Mode. Strike a Key to Continue ":COLOR 7,0
1640 LOCATE 19:PRINT CHR$(221);" DATE: KEYS:" SPC(18):LOCATE 19,79:PRINT CHR$(222)
1650 LOCATE 20:PRINT CHR$(221);" Day:";WEEKDAY$;" "DAY;:LOCATE ,50:PRINT " Pg Up:Perv day":LOCATE 20,79:PRINT CHR$(222)
1660 LOCATE 21:PRINT CHR$(221);" Month:";MNT$;:LOCATE ,52:PRINT"Pg Dn:next day" :LOCATE 21,79:PRINT CHR$(222)
1670 PRINT CHR$(221);" TIME: W:Go to Writing Mode ": LOCATE 22,79:PRINT CHR$(222)
1680 COLOR 0,7:PRINT " ": COLOR 7,0
1685 LOCATE 19,58:COLOR 23:PRINT "_":COLOR 7 'display blinking cursr
1690 K$=INKEY$:IF K$="" THEN LOCATE 22,10: PRINT TIME$:GOTO 1690
1700 K$=RIGHT$(K$,1) '=the rightmost charctr
1705 IF K$="W" OR K$="w" THEN 1762 'go to Write subroutine
1710 IF K$="I" THEN IF DAY>1 THEN LET DAY=DAY-1:GOSUB 893:GOTO 1610 ELSE IF DAY=1 THEN 1690
1720 IF K$="Q" THEN IF DAY<32 THEN DAY=DAY+1:GOSUB 893:GOTO 1610 ELSE GOTO 1690
1730 GOTO 120 'go to main screen
1740 '================ writing schedule =============
1750 GOSUB 580: CLS 'get month and day
1760 GOSUB 1370 'display info
1762 LOCATE 18,1:COLOR 0,7:PRINT " Writing Mode ":COLOR 7,0
1763 LOCATE 19:PRINT CHR$(221);" DATE: KEYS: R:Go to Reading Mode":LOCATE 19,79:PRINT CHR$(222)
1764 LOCATE 20 :PRINT CHR$(221);" Day:";WEEKDAY$DAY;:LOCATE ,50:PRINT "<ENTER>:Write ":LOCATE 20,79:PRINT CHR$(222)
1765 LOCATE 21:PRINT CHR$(221);" Month:";MNT$;:LOCATE ,52:PRINT CHR$(24) " & " CHR$(25) ":Move Cursor": LOCATE 21,79:PRINT CHR$(222)
1766 PRINT CHR$(221) " TIME:"; :LOCATE ,54:PRINT "End:Save & go to Mn Scrn":LOCATE 22,79:PRINT CHR$(222)
1767 COLOR 0,7 :PRINT " ": COLOR 7,0
1770 GOSUB 1140 'go to write info 2dsk
1780 GOTO 120 'go to min acreen
1900 '================= initilizig the disk ===============================
1902 PRINT "Are You Sure?"
1903 K$=INKEY$: IF K$="y" OR K$="Y" THEN 1905 ELSE IF K$="" THEN 1903 ELSE GOTO 120
1905 PRINT"this is gonna take a couple of minutes. So.."'print message-
1906 PRINT "Relax, tell you hear the beep." ,SPC(80) 'at the top
1910 OPEN DRIVE$+"scd" AS #1 LEN=25 'open scd data file
1920 FIELD #1, 25 AS F$ 'sets field buffer
1925 FOR AA%=1 TO 11680 'loops the whole-
1930 DAT$=CHR$(32) 'data file, and -
1940 LSET F$=DAT$ 'inserts chr$(32)-
1950 PUT # 1,AA% 'to every record -
1955 NEXT 'in the file
1970 CLOSE 'closes file
1980 BEEP: PRINT" disk initilized" 'beeps
1985 FOR A=1 TO 1509: NEXT 'delay loop
1999 GOTO 120 'goto main screen
2000 '================ changing default drive ===========================
2010 LOCATE ,,1:PRINT"Select drive ?"; 'print message @top
2020 K$=INKEY$:IF K$ ="" THEN 2020 'looks for input
2030 PRINT 'print empty line
2045 LOCATE ,,0 'turn off cursor
2060 DRIVE$=K$+":" 'sets value of dr..
2070 GOTO 120 'go to main screen
2100 '================== erasing part of data ==================================
2110 CLS
2120 PRINT"Data to be cleared beginning:" 'print message @ top
2130 GOSUB 610 'get begin and day
2132 START= 32*(BEGIN+DAY-2) 'calculate start
2135 CLS 'clear screen
2140 PRINT"Data to be cleared until & including:" 'prnt message @ top
2150 GOSUB 610 'begin&day for finsh
2155 FINISH=32*(BEGIN+DAY-2)+32 'calcualte finish
2160 PRINT"Erasing........" 'print message
2170 OPEN DRIVE$+"scd" AS #1 LEN=25 'open file to erase-
2180 FIELD #1, 25 AS F$ 'the part assigned
2182 FOR A%=START+1 TO FINISH 'loop to add a blank
2183 IF A=0 THEN A=1 'ords
2190 DAT$=CHR$(32) 'ords
2192 LSET F$=DAT$ 'ords
2194 PUT # 1,A%
2195 NEXT
2196 BEEP:CLOSE: COLOR 7 'beep when finish
2197 GOTO 120 'goto main screen
2200 '================== adding constant occuring activity =====================
2210 CLS
2220 PRINT"Data to be entered beginning:" 'print message @ top
2230 GOSUB 610 'get begin and day
2232 START= 32*(BEGIN+DAY-2) 'calculate start
2235 CLS 'clear screen
2240 PRINT"Data to be entered until & including:" 'prnt message @ top
2250 GOSUB 610 'begin&day for finsh
2255 FINISH=32*(BEGIN+DAY-2)+32 'calcualte finish
2257 PRINT "TIME:":INPUT "Hour";HR:HR=INT(HR)
2258 INPUT "Minute (0 or 30)";MIN: IF MIN <>0 AND MIN<>30 THEN 2258
2260 LOCATE ,,1 :PRINT"AM or PM?";
2262 K$=INKEY$: IF K$="" THEN 2262
2264 IF K$<>"a" AND K$<>"A" AND K$<>"p" AND K$<>"P" THEN BEEP: GOTO 2262 ELSE LOCATE ,,0:PRINT K$
2265 IF K$="p" OR K$="P" THEN XX=HR*2+12
2266 IF K$="a" OR K$="A" THEN XX=HR*2-12
2267 INPUT "Activity?";ACT$
2268 IF MIN=30 THEN XX=XX+1
2270 OPEN DRIVE$+"scd" AS #1 LEN=25 'open file to erase-
2280 FIELD #1, 25 AS F$ 'the part assigned
2282 FOR A%=START+1+XX TO FINISH STEP 32 'loop to add a blank
2283 IF A=0 THEN A=1 'ords
2290 DAT$=ACT$
2292 LSET F$=DAT$ 'ords
2294 PUT # 1,A%
2295 NEXT
2296 BEEP:CLOSE: COLOR 7 'beep when finish
2297 GOTO 120 'goto main screen
2300 '================ printing module =========================================
2305 GOSUB 590 'month & day input
2310 CLS 'clear screen
2320 PRINT "Turn printer on then strike a key"
2330 IF INKEY$="" THEN 2330 'waiting for Keypressed
2340 CLS:GOSUB 1380 'display activites
2345 LOCATE 19,20:PRINT "Month:" MNT$ ". Day:" DAY
2346 PRINT
2347 LOCATE ,20:COLOR 0,7:PRINT " P R I N T I N G ! ! !":COLOR 7,0
2350 LPRINT CHR$(14);"TIME ACTIVITY TIME ACTIVITY":LPRINT CHR$(18)
2360 FOR LIN=2 TO 19
2370 FOR COLUMN=1 TO 78
2380 LPRINT CHR$(SCREEN(LIN,COLUMN));
2390 NEXT
2400 LPRINT CHR$(0)
2500 NEXT
2600 GOTO 140
2700 '===================LAST LINE=============================================
DOCUMENTATION FOR SCHEDULE.BAS
PROGRAM WRITTEN BY:
MOHAMMAD ALTUFAIF
#71046,1025
Last edited in June, 20th 1984
1
Schedule.bas allows you to set and organize your appoi-
ntments or activities that you want to do. You can write your
appointments or activities for the whole year. There is room
provided for each day of the year. Each day can hold your acti-
vities from 6 o'clock in the morning till 10 o'clock at night for
each half hour.
REQUIREMENTS:
Double sided disk. color graphics card (see below
for monochrome card modification)
RECOMMENDDED HARDWARE:
2 double sided drives, or a drive and a harddisk
HOW TO BEGIN USING THIS PROGRAM:
Because of the large file needed to hold this
immense amount of data, you need an empty diskette
to hold the 289k file created. The program works
best on a 2 disk drive system.
If You Have 2 Disk Drives:
-Save the program on a diskette at drive A (usually
along with your other Basic Programs.)
-Put an empty formatted disk on drive B.
-Load BASICA. (BASICA is supposedly on drive a)
-Load SCHEDU.BAS and run it.
The program assumes that the data file SCD is on drive B
If You Have One Disk Drive
-Modify line 100 into: 100 DRIVE$="A:"
-Load BASICA
-Load SCHEDU.BAS
-Remove your diskette and put an empty formatted
disk on the drive.
-Run the program SCHEDU.BAS
Needles to say, you only format the diskkette the first
time you use the program, or you will erase your data each
time you format it.
2
HOW TO USE THIS PROGRAM:
Upon running the program, you will see the first
screen of the program. You can select any of the 8
options you have. But before doing anything, you
must initalize your data file. This can be easily
accomplished by choosing option #3. Remember that
you only have to do this the first time you use the
program. If there are any data in the data file, it
will all be erased. After initalizing the data
file, you can choose any of the options from 1 to
8. initalizing the file is a process that takes a
long time to complete, but you only need to do it
once.
EXPLANATIONS OF THE 8 OPTIONS:
OPTION 1:
Allows you to see the activities that you scheduled
some time ago. When you strike 1, you will be asked
to enter the month name (not the month number) and
the day at which you want to see the activities.
Note that you do not have to type the whole name of
the month.
Example:
If you want to see the activities scheduled on
the 5th of april, you enter the letter A, then P.
The program will assume that you wanted to enter
april, so it will directly prints april, and then
asks you for the day. Now type 5, then strike
(ENTER.) If you wanted to select another
month, say december, enter 0 at the "Which day"
prombt. Now you press d and the program will assume
that you wanted to enter the month december. The
Last line at the bottom always displays your op-
tions along with some suggestions.
After the program displays the activities scheduled at the
specified date, you have the options to:
-See the activities of the next day by pressing the
Pg Dn key
-See the activities of the day before by pressing
the Pg Up key
-Write activities by pressing W (see option 2)
-Go to the main screen by striking any other key.
3
OPTION 2:
Allows you to write activities. After entering the
month and the day,you will see a menu displaying
the activities scheduled for the specifyed date if
any. You will see the time 6:00 highlighted. To
write an activity, select any time of that day by
pressing the up or down arrow, then press ENTER.
Now type your activity( up to 25 characters only).
When finished, press ENTER. Now the next TIME will
be automatically highlighted. if you want to write
activity at this time, press ENTER and repeat the
procedure, otherwise choose the appropriate time.
These are the options that you have during this writing
mode:
-Up and Down arrow: Allows you to select the time
at which you want to write your activity.
-End: Saves your activites and takes you to the
main screen.
-R : Switches you to the Reading mode. This is
helpful when you want to see or write at the next
or the preceeded day.
Note:
1-Those above options can not be selected while you
are typing an activity.
2-You can not write directly to the next or the
preceeded day. You must first switch to the Reading
Mode by pressing R, and then use the Pg Up or Pg
Dn, then switch to the Writing Mode by pressing W.
3-Pressing ENTER after writing at the time 1:30
will not automatically takes you up to 2:00 time.
Press the Down key to go there.
4-When you are writing an activity, the input
control is handed to the BASICA interpreter. You,
therfore have to be careful in using the editing
keys, since you may accidentally disturb the data
displayed on the screen. It is therefore,
recommended that you only use the left and the
right arrow when writing an activity.
5-The WRITING mode can be accessed by either stri-
king 2 at the main screen, or striking W when at
the READING mode.
4
OPTION 3:
Allows you to innitlize the data file: This should
be done the first time you use the program. inita-
lizing the 9000 records contained in the data file
takes a long time to complete. A beep will
indicate that the initialization is complete.
OPTION 4:
Changes the default drive at which the data file
resides.
OPTION 5:
Clears part of data. Suppose that you want to erase
all the activities during a certain period. You
select the date this period begins, and the date it
ends. A beep will indicate that the erasing is
finished.
OPTION 6:
Add a constant occuring activity for a certain
period of time. This is helpful if there are some
activities that you do every day. For example you
may want to assign to time 6:00 the activity (WAKE
UP.) or assign at time 12:00 the activity (LUNCH.),
and so on.
OPTION 7:
Print A Certain Day Schedule. This option prints a
certain day schedule, supporting the I.B.M/Epson's
dot matrix printers.
OPTION 8:
Ends the program. Pressing Esc will do the same
thing.
UNDOCUMENTED FEATURE:
Pressing PgUp at the Main Screen will show the
last screen you have just exited. PgDn will re-
turn you back to the Main screen. This may be
helpful if you have just got out of a screen, and
decided to glance on it after you got to the main
screen
IF YOU HAVE THE MONOCHROME CARD:
Modify the program by erasing the SCREEN functions,
and modify line 140 so that check=0. This can be
easily achieved on your word processor, using the
search and replace functions.All the graphics done
on the screen is done using the 255 characters that
are supported by the the monochrome and the color
card.
5
IF YOU HAVE THE COLOR GRAPHICS CARD:
If you have a color monitor, play around with the
COLOR function to set the colors you prefer. Be
aware that there is a lot of highlighting and video
reversing. The Search and Replace function in your
word proceesor will be of a great help. If you have
a white and black monitor like me, well, you are
lucky 'cause you do not need to modify or set any
color.
GENERAL NOTES:
-The diskette that contains the data file should
not contain any other files. There is just no room
for any other file unless you are running DOS2.?
-The program does not check to see if your day
falls on the month you specify or not. If, for
example you specified april, 31 to write your acti-
vities, your data will be saved under may, 1st
because april is 30 days long.
-Each year, line 896 should be changed to reflect
the current year. The default value is the year
1984.
-Running the Program under BASICA is required.
-Any one is welcomed to compile the program or
improve it, then upload it again to the Compuserve
software library.
-Send your comments, bug findings, or suggestions
via EMAIL.
6
This disk copy was originally provided by "The Public Library",
the software library of the Houston Area League of PC Users.
Programs are available from the Public Library at $2 per disk
on user-provided disks. To get a listing of the disks in the
Public Library, send a self-addressed, stamped envelope to
Nelson Ford, P.O.Box 61565, Houston, TX 77208.
Volume in drive A has no label
Directory of A:\
INDXCARD BAS 20608 11-21-83 2:55p
INDXCARD CMP 1024 5-03-83 12:19p
INDXCARD DOC 34540 5-02-83 6:47p
INDXCARD HDR 384 4-12-83 8:54p
INDXCARD BAT 105 4-29-83 10:49a
INDXCARD DTA 9856 5-03-83 11:44a
INDXCARD FRM 1024 5-03-83 11:13a
INDXCARD INX 512 5-03-83 11:43a
INDXCARD KEY 1536 5-03-83 11:37a
INDXCARD RPT 128 4-14-83 9:30p
WEATHER FRM 384 8-17-82
BARRGOLD FRM 384 8-07-82
PC^3LOG FRM 384 8-07-82
WSJSTOCK FRM 256 8-07-82
VWREPAIR FRM 384 8-21-82
TEST FRM 384 8-14-82
FILECAB BAS 13626 2-25-84 7:57p
FRM BAS 3730 2-25-84 7:51p
BOOKINV BAS 5253 2-25-84 9:05p
MAIL1 BAS 20480 2-15-83 2:27p
MAIL1 DOC 2816 1-02-83 11:59p
PMB15 BAS 26304 1-11-87 4:27p
SCHEDU BAS 18739 5-31-84 7:51p
SCHEDU DOC 13230 6-30-84 6:48p
ADDRESS BAS 12672 3-25-84 10:06a
ADDRESS1 FIL 2376 3-25-84 10:12a
ROLODEX BAS 10624 3-09-84 9:10p
ROLODEX DOC 4310 7-15-84 6:48p
FILES317 TXT 2040 1-28-87 7:12p
ITEMDATA BAK 38 1-11-87 4:00p
PMB15 BAK 3651 1-11-87 4:30p
ITEMDATA DAT 158 1-11-87 4:02p
PMB15 DOC 3651 1-11-87 4:34p
GRAPHICS <DIR>
34 file(s) 215591 bytes
Directory of A:\GRAPHICS
. <DIR>
.. <DIR>
DEMOPLOT PAS 7829 9-19-86 8:32a
HIPLOT2 EXE 3840 10-08-86 8:46p
HIRESPLT PAS 34771 9-19-86 8:24a
PLOTTER DOC 19983 1-18-87 11:12a
README DOC 3326 1-18-87 11:06a
HIRESPLT ARC 32858 1-18-87 11:12a
README NOW 1011 1-19-87 7:38a
README BAK 728 1-19-87 7:32a
10 file(s) 104346 bytes
Total files listed:
44 file(s) 319937 bytes
20480 bytes free