1 'PCFORM 11/01/82 Forms-oriented data entry routines
2 '
3 'COPYRIGHT (c) 1982 by Buzz Hamilton
4 '                      29 Crawford Street
5 '                      Northboro, MA 01532 (617) 393-3199
6 '
7 'Permission to copy this program is hereby granted except for commercial gain.
8 '
9 '
10 'These routines handle the left-cursor(75), right-cursor(77),
11 '  insert(82), delete(83), and back-space(8) keys in a way
12 '  which is similar to the PCBASIC screen editor.
13 '
14 ' Each field is described by five items:
15 '   1 ROW
16 '   2 COLUMN
17 '   3 LENGTH    (negative length means FULL FIELD REQUIRED)
18 '   4 TYPE      (0=text  1=numeric)
19 '   5 PROMPT
20 '
100 CLEAR
110 DEF FNB(Z$,Z)=ASC(MID$(Z$,Z)):DEF FNFILL$(Z,Z9)=STRING$(Z9-LEN(STR$(Z))+1,48)+MID$(STR$(Z),2)
120 E$=CHR$(7):L9=0
130 READ N:FOR I=1 TO N:READ A$:P1=1:F=0
140 FOR P2=P1 TO LEN(A$):IF MID$(A$,P2,1)="|" THEN 160
150 NEXT P2:IF F<4 THEN PRINT"Missing field - ";A$:END
160 F=F+1:IF F<5 THEN J=VAL(MID$(A$,P1,P2-P1))
170 ON F GOTO 180,190,200,220,230
180 Y=J:GOTO 240
190 X=J:GOTO 240
200 L=J:IF L<0 THEN L=127-L
210 GOTO 240
220 T=J:GOTO 240
230 P$=MID$(A$,P1,P2-P1):K=P1
240 IF F<5 THEN P1=P2+1:GOTO 140
250 IF I=1 THEN 350
260 '------ CHECK FOR FIELD OVERLAP
270 FOR J=1 TO I-1
280 IF FNB(Y$,J)<>Y THEN 330
290 L0=FNB(LF$,J):IF L0>127 THEN L0=L0-127
300 IF (X+L+LEN(P$))<(FNB(X$,J)-L0) OR X>=(FNB(X$,J)+L0) THEN 330
310 PRINT"Position conflict between":PRINT I;"-";P$;
320 RESTORE:READ N:FOR K=1 TO J:READ A$:NEXT K:P=FNB(PD$,J):PRINT" and ";J;"-";MID$(A$,P,FNB(LP$,J)):END
330 NEXT J
340 '------ PACK NUMERIC PARAMETERS INTO STRINGS
350 X$=X$+CHR$(X+LEN(P$)+1):Y$=Y$+CHR$(Y)
360 LP$=LP$+CHR$(LEN(P$)):LF$=LF$+CHR$(L):T$=T$+CHR$(T):PD$=PD$+CHR$(K):PR$=PR$+CHR$(L9)
370 L2=L:IF L2>127 THEN L2=L2-127
380 L9=L9+L2:NEXT I
390 '------ DISPLAY PROMPTS
400 COLOR 7,0:CLS:RESTORE:READ N
410 FOR I=1 TO N
420 READ A$
430 L=FNB(LP$,I):IF L<>0 THEN LOCATE FNB(Y$,I),FNB(X$,I)-L:P1=FNB(PD$,I):PRINT MID$(A$,P1,FNB(LP$,I));
440 NEXT I
450 '------ ENTER DATA
460 REC$=SPACE$(L9)
470 INSF=0
480 FOR I=1 TO N
490 O=FNB(PR$,I):L0=FNB(LF$,I):L=L0:IF L0>127 THEN L=L0-127
500 P=1:IF L=0 THEN 820
510 Y=FNB(Y$,I):X=FNB(X$,I)
520 COLOR 0,7
530 LOCATE Y,X:PRINT MID$(REC$,O+1,L)
540 COLOR 7,0
550 IF P<=L THEN LOCATE Y,X+P-1:CI=FNB(REC$,O+P):PRINT CHR$(CI);:LOCATE Y,X+P-1
560 I$=INKEY$:IF I$="" THEN 560
570 IF E<>0 THEN LOCATE 25,1:COLOR 7,0:PRINT SPACE$(79);:E=0:LOCATE Y,X+P-1
580 C=ASC(I$):IF C=27 THEN COLOR 7,0:CLS:END
590 COLOR 0,7:IF C=8 THEN 640
600 IF LEN(I$)=1 THEN 700 ELSE C=FNB(I$,2):IF C<>75 AND C<>77 AND C<>82 AND C<>83 THEN 550
610 IF C=82 THEN INSF=1-INSF:IF INSF=0 THEN 540 ELSE COLOR 16,7:GOTO 550
620 INSF=0:IF C<>83 AND P<=L THEN PRINT CHR$(CI);
630 IF C<>75 THEN 660
640 IF P=1 THEN IF I=1 THEN P$="AT FIRST FIELD":GOSUB 920:GOTO 550 ELSE IF C=75 THEN I=I-1:GOTO 490 ELSE P$="AT BEGINNING OF FIELD":GOSUB 920:GOTO 550
650 P=P-1
660 IF C=83 OR C=8 THEN MID$(REC$,O+P,L-P)=MID$(REC$,O+P+1,L-P):MID$(REC$,O+L,1)=" ":IF C=8 THEN LOCATE Y,X+P-1
670 IF C<>75 AND C<>77 THEN PRINT MID$(REC$,O+P,L-P+1);
680 IF C=77 THEN IF P=L THEN 750 ELSE P=P+1
690 GOTO 540
700 IF C=13 THEN 760
710 IF P>L THEN 750
720 IF INSF=1 THEN IF MID$(REC$,O+L,1)<>" " THEN 750 ELSE MID$(REC$,O+P+1,L-P)=MID$(REC$,O+P,L-P):MID$(REC$,O+P,1)=I$:PRINT MID$(REC$,O+P,L-P+1);:P=P+1:COLOR 16,7:GOTO 550
730 PRINT I$;:IF FNB(T$,I)=1 THEN IF C<48 OR C>57 THEN P$="NUMERICS ONLY":GOSUB 920:GOTO 550
740 MID$(REC$,O+P,1)=I$:IF P<=L THEN P=P+1:GOTO 550
750 P$="FIELD IS FULL":GOSUB 920:GOTO 550
760 J=L:IF P<=L THEN PRINT CHR$(CI);:FOR J=L TO 1 STEP -1:IF MID$(REC$,O+J,1)=" " THEN NEXT J
770 IF J127 THEN P$="FULL FIELD REQUIRED":GOSUB 920:GOTO 550
780 IF FNB(T$,I)<>1 THEN 800
790 MID$(REC$,O+1,L)=FNFILL$(VAL(MID$(REC$,O+1,L)),L):GOTO 810
800 LOCATE Y,X+J:COLOR 7,0:PRINT SPACE$(L-J+1);
810 '  (additional field validation would occur here)
820 INSF=0:NEXT I
830 '  (record REC$ is complete)
840 '------ BLANK DATA FIELDS TO PREPARE FOR NEXT RECORD ENTRY
850 COLOR 7,0
860 FOR I=2 TO N
870 L=FNB(LF$,I):IF L>127 THEN L=L-127
880 IF L<>0 THEN LOCATE FNB(Y$,I),FNB(X$,I):PRINT SPACE$(L);
890 NEXT I
900 GOTO 460
910 '------ ERROR MESSAGE
920 LOCATE 25,1:PRINT">>";:COLOR 16,7:PRINT P$;:COLOR 0,7:PRINT "<<";E$;:E=1:RETURN
930 DATA 5
940 DATA 01|01|20|0|NAME
950 DATA 03|01|20|0|ADDRESS
960 DATA 05|01|15|0|CITY
970 DATA 05|22|-2|0|STATE
980 DATA 05|31|05|1|ZIP