46 'TRS-80 P&T CP/M USES A SINGLE CHR$(12); ADM 3 SERIES USE A SINGLE CHR$(26)
47 CLS$=CHR$(26)
50 RESET:GOTO 110
60 FX=0:IF LEN(CV$)<1 THEN RETURN
70 FOR II=1 TO LEN(CV$):CV%=ASC(MID$(CV$,II,1)):IF CV%=34 THEN FX=ABS(FX-1)
80 IF FX=0 AND CV%>90 THEN CV%=CV% AND 95:MID$(CV$,II,1)=CHR$(CV%)
90 NEXT:RETURN
110 PRINT CLS$;"THE REPORTOR: A PROGRAM THAT WRITES REPORT PROGRAMS.":PRINT"PLACED IN THE PUBLIC DOMAIN BY BRUCE W. TONKIN":PRINT"COPYRIGHT, 1983, BRUCE W. TONKIN"
120 PRINT"THIS PROGRAM MAY NOT BE DISTRIBUTED FOR PROFIT":PRINT"WITHOUT WRITTEN PERMISSION OF THE AUTHOR!"
130 PRINT"BRUCE W. TONKIN":PRINT"34069 HAINESVILLE RD.":PRINT"ROUND LAKE, IL 60073":PRINT"United States of America"
140 PRINT"MAKE AND GIVE AWAY ALL THE COPIES YOU WANT,":PRINT"BUT PLEASE DO NOT REMOVE THIS NOTICE."
150 FOR I=1 TO 3000:NEXT I
160 PRINT CLS$"This is the REPORTOR, a report-writing program. Please choose":PRINT"one of the following:":PRINT:PRINT"Run a previously written program.................Depress R"
170 PRINT"Write a new report...............................Depress W"
180 PRINT"Exit this program................................Depress X"
190 PRINT:PRINT"Please depress the key corresponding to your choice: ";
200 A$=INKEY$:IF A$="" THEN 200:ELSE CV$=A$:GOSUB 60:PRINT CV$:A$=CV$
210 ON INSTR("RWX",A$) GOTO 230,240,2639
220 PRINT"YOU MUST CHOOSE R, W, OR X. PLEASE TRY AGAIN.":FOR I=1 TO 1500:NEXT:GOTO 160
230 PRINT"What is the complete name of your program: ";:LINE INPUT CV$:GOSUB 60:RUN CV$
240 'begin
250 '
260 PRINT"What is to be the name of your program? ";:LINE INPUT CV$:GOSUB 60:PN$=CV$:IF CV$<"A" THEN PRINT"Illegal name!":GOTO 260
270 IF LEN(PN$)>8 THEN PRINT"Name may not be more than 8 characters long!":GOTO 260
280 IF INSTR(PN$,":") THEN PRINT"Do not include the drive letter!":GOTO 260
290 IF INSTR(PN$,".")>0 THEN PRINT"Illegal character in file name!":GOTO 260
350 PRINT"The drives are lettered, A-P. Which drive do you want your":PRINT"program written on: ";
360 DR$=INKEY$:IF DR$="" THEN 360:ELSE PRINT DR$
370 IF DR$<"A" OR DR$>"P" THEN PRINT"Invalid drive!":GOTO 350
390 PN$=DR$+":"+PN$+".BAS"
410 ON ERROR GOTO 2640
420 OPEN"I",1,PN$:ERROR 126
430 OPEN"O",1,PN$:Q$=CHR$(34)
440 PRINT CLS$;"What is to be the title displayed for your report? Type it on":PRINT"the next line or lines."
450 LINE INPUT T$
460 PRINT"What is the name of the file you are going to read for your":PRINT"report? Please type in the FULL name on the next line. Do NOT"
470 PRINT"omit the . and the file type extension, if present. Please":PRINT"EXCLUDE the drive letter, though."
490 LINE INPUT CV$:GOSUB 60:F$=CV$
495 IF INSTR(F$,":")>0 THEN PRINT"Drive letter not allowed!":GOTO 460
500 PRINT"What is the record length of each record in the file? ";:LINE INPUT RL$:RL=VAL(RL$)
510 IF RL>256 OR RL<1 THEN PRINT"Illegal record length (1-256, please!)":GOTO 500
520 PRINT #1,"5 CLS$=";:FOR I=1 TO LEN(CLS$)-1:PRINT #1,"CHR$(";ASC(MID$(CLS$,I,1));")+";:NEXT I:PRINT #1,"CHR$(";ASC(RIGHT$(CLS$,1));")"
600 PRINT #1,"12 DF$=";Q$;F$;Q$
660 PRINT #1,"30 TI$=";Q$;T$;Q$
690 IF RL=256 THEN PRINT #1,"40 OPEN";Q$;"R";Q$;",1,DF$":ELSE PRINT #1,"40 OPEN";Q$;"R";Q$;",1,DF$,";RL
700 PRINT CLS$;"Now you must describe the fields in each record of your file,":PRINT"from left to right, in order. Input the amount of space each":PRINT"field takes up. When you are done, enter 999 for the space."
730 A=1:DIM F%(50),D$(50)
740 PRINT"SPACE REMAINING=";RL-F%(0);"; FIELD NUMBER: ";A;"=";:LINE INPUT F1$:F%(A)=VAL(F1$)
750 IF F%(A)=999 THEN 830 ELSE IF F%(A)>RL THEN PRINT"INVALID. MUST BE";RL;"OR LESS.":GOTO 740
760 F%(0)=F%(0)+F%(A):IF F%(0)>RL THEN PRINT"NOT ENOUGH SPACE LEFT FOR THAT FIELD!":F%(0)=F%(0)-F%(A):GOTO 740
780 PRINT"Is this correct (Y/N)? ";
790 JX$=INKEY$:IF JX$="" THEN 790:ELSE CV$=JX$:GOSUB 60:PRINT CV$:JX$=CV$:IF JX$="N" THEN F%(0)=F%(0)-F%(A):GOTO 740
800 IF JX$<>"Y" THEN 780
810 IF RL-F%(0)<1 THEN A=A+1:GOTO 830
820 A=A+1:GOTO 740
830 XF$="GOSUB 30000"
840 A=A-1:PRINT #1,"30805 FOR IX=1 TO ";A
850 FOR I=1 TO A:PRINT #1,30000+I;"FF(";I;")=";F%(I):NEXT
900 PRINT #1,"50 DIM F$(";A;"),FF(";A;"),P(";A;"),P$(";A;"),C#(50),P#(";A;"),C(50),C$(50),H$(50)"
910 PRINT #1,"60 ";XF$:XF$="GOSUB 30800"
930 PRINT CLS$;"What are your column headings to be? Please enter a legend":PRINT"for each column you intend to use. Type 999 to end."
940 DIM C%(50):FOR J=1 TO 50:C%(J)=J:NEXT
950 DIM C$(50)
960 B=1
980 PRINT"Column number";B;:LINE INPUT C$(B):IF C$(B)="999" THEN C$(B)="":B=B-1:ELSE B=B+1:GOTO 980
990 J=0:FOR JJ=1 TO B-1:IF LEN(C$(C%(JJ)))<LEN(C$(C%(JJ+1))) THEN J=C%(JJ):C%(JJ)=C%(JJ+1):C%(JJ+1)=J:J=1
1000 NEXT:IF J THEN 990:ELSE LN=70
1010 FOR I=1 TO B:I$=MID$(STR$(I),2):PRINT #1,LN;"H$(";I$;")=";Q$;C$(I);Q$:LN=LN+10:NEXT
1040 PRINT CLS$;"Now we need to set the tabs for your";B;"columns. Indicate":PRINT"the tab setting as a number, from 1 to 255."
1050 FOR I=1 TO B:PRINT"Tab setting for column number";I;":";:LINE INPUT F1$:T(I)=VAL(F1$):IF T(I)>255 OR T(I)<1 THEN PRINT"NOT A VALID TAB SETTING!":I=I-1
1070 NEXT
1090 PRINT #1,"31070 DATA ";
1100 FOR I=1 TO B-1:PRINT #1,MID$(STR$(T(I)),2);",";:NEXT
1130 PRINT #1,MID$(STR$(T(B)),2)
1140 LN=LN+10:PRINT #1,LN;"PG=1:'INITIALIZE THE PAGE COUNTER"
1150 PRINT #1,LN+5;"'NOW FOLLOWS THE RECORD RETRIEVAL SECTION"
1160 PRINT"Do you want the pages numbered (Y/N)? ";
1170 CV$=INKEY$:IF CV$="" THEN 1170:ELSE GOSUB 60:PRINT CV$:PG$=CV$:IF PG$<>"Y" AND PG$<>"N" THEN PRINT"ILLEGAL!":GOTO 1160
1180 LN=LN+10:PRINT #1,LN;"FOR I=1 TO 32767"
1190 PRINT #1,LN+5;"IF SR$<>";Q$;"N";Q$;" THEN INPUT #2,I"
1200 LN=LN+10:KZ=LN
1210 IF RL<>256 THEN PRINT #1,LN+1;"IF ZU$=STRING$(";RL;",0) THEN 20000":ELSE PRINT #1,LN+1;"IF ZU$=STRING$(255,0) THEN 20000"
1220 LN=LN+10:PRINT #1,LN;"ON ERROR GOTO 20000"
1230 IF PG$="Y" THEN PRINT"How many lines per page? ";:LINE INPUT F1$:LP=VAL(F1$)-1
1240 PRINT CLS$:J=0:FOR I=1 TO A:IF F%(I)=1 OR F%(I)=2 OR F%(I)=4 OR F%(I)=8 THEN J=1:I=A
1250 NEXT:IF J=0 THEN FOR I=1 TO A:D$(I)="C":NEXT:GOTO 1500
1260 PRINT"You have some fields which might be packed data. Please tell":PRINT"me if they are PH (packed half precision), packed integer (PI),":PRINT"packed single precision (PS) or packed double precision (PD)."
1300 FOR I=1 TO A:IF F%(I)<>1 AND F%(I)<>2 AND F%(I)<>4 AND F%(I)<>8 THEN D$(I)="C":GOTO 1380
1310 PRINT"Field number";I;":Length is";F%(I);": Data type is: ";:INPUT CV$:GOSUB 60:D$(I)=CV$:L=F%(I)
1330 IF D$(I)<>"N" AND D$(I)<>"C" AND D$(I)<>"PH" AND D$(I)<>"PI" AND D$(I)<>"PS" AND D$(I)<>"PD" THEN PRINT"ILLEGAL VARIABLE TYPE!":GOTO 1310
1340 IF (CV$="PH" AND L=1) OR (CV$="PI" AND L=2) OR (CV$="PS" AND L=4) OR (CV$="PD" AND L=8) THEN 1375
1350 IF CV$="N" OR CV$="C" THEN 1375
1370 PRINT"ILLEGAL LENGTH FOR THIS VARIABLE TYPE!":GOTO 1310
1375 PRINT"Is this correct (Y/N)? ";
1376 CV$=INKEY$:IF CV$="" THEN 1376:ELSE GOSUB 60:PRINT CV$
1377 IF CV$="N" THEN 1310:ELSE IF CV$<>"Y" THEN 1375
1380 NEXT
1500 FOR I=1 TO A:I$=MID$(STR$(I),2)
1510 LN=LN+10:IF D$(I)="C" OR D$(I)="N" THEN PRINT #1,LN;"P$(";I$;")=F$(";I$;")"
1520 IF D$(I)="PH" THEN PRINT #1,LN;"P#(";I$;")=ASC(F$(";I$;"))-128"
1530 IF D$(I)="PI" THEN PRINT #1,LN;"P#(";I$;")=CVI(F$(";I$;"))"
1540 IF D$(I)="PS" THEN PRINT #1,LN;"P#(";I$;")=CVS(F$(";I$;"))"
1550 IF D$(I)="PD" THEN PRINT #1,LN;"P#(";I$;")=CVD(F$(";I$;"))"
1560 NEXT:CHAIN"REPORTOR.OVL",1,ALL
2639 CLOSE:END
2640 IF ERR=126 AND ERL=420 THEN PRINT"PROGRAM ALREADY EXISTS. DEPRESS C TO WRITE OVER IT, ANY OTHER":PRINT"TO QUIT":ELSE 2670
2650 Q$=INKEY$:IF Q$="" THEN 2650:ELSE IF Q$="C" THEN CLOSE 1:RESUME 430
2660 IF Q$="c" THEN CLOSE 1:RESUME 430:ELSE CLOSE:END
2670 IF ERR=52 THEN PRINT"YOU ENTERED BASIC WITHOUT SPECIFYING ANY FILES.":PRINT"YOU NEED AT LEAST TWO. GO BACK TO CP/M AND ENTER BASIC CORRECTLY.":CLOSE:END
