home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
DATABASE
/
DIMS103.ARK
/
DCFORM.ASC
< prev
next >
Wrap
Text File
|
1986-12-07
|
9KB
|
271 lines
1000 DEFINT A-Z
1010 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1020 DIM SQ(31),L$(6)
1030 PRINT CHR$(12);:FOR I=1 TO 10:NEXT 'TERM DEP
1040 T1$="1234567890"'
1050 PRINT"DCFORM March 20, 1982
1055 ' by Dan Dugan -- public domain
1060 PRINT"Design your file format on paper first, using forms provided.
1070 PRINT"To change you have to re-enter all data under same file name.
1080 PRINT:PRINT"Position the paper so the printhead is at the upper left corner of the paper.
1090 PRINT"Set the TOF switch.
1100 PRINT:PRINT"Would you like the program to type you a blank form for
1110 PRINT"designing a 24 x 80 screen? (n/y) ";
1120 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
1130 PRINT A$:IF A$="n" THEN 1450 'next form
1140 IF A$="y" THEN 1160
1150 GOTO 1100
1160 '
TYPE SCREEN FORM
1170 ' SET PRINTER
1180 LPRINT CHR$(27);CHR$(31);CHR$(12); ' 11/in
1190 LPRINT CHR$(27);CHR$(30);CHR$(6); ' vert spc
1200 LPRINT CHR$(27);CHR$(137);CHR$(133); ' margin 5
1210 LPRINT CHR$(27);"9";CHR$(13); ' set margin & CR
1220 LPRINT:LPRINT:LPRINT"DIMS CFORM screen design form for file "F$;
1230 LPRINT TAB(48)"Format name:"TAB(67)"Date:
1240 LPRINT:LPRINT SPC(3);
1250 FOR I=1 TO 8
1260 LPRINT SPC(8);STR$(I);
1270 NEXT
1280 LPRINT:LPRINT SPC(3);
1290 T$="1234567890"
1300 FOR I=1 TO 8
1310 LPRINT T$;
1320 NEXT
1330 LPRINT
1340 T$="=========+"
1350 FOR I=1 TO 24
1360 LPRINT USING"## ";I
1370 LPRINT SPC(3);
1380 FOR J=1 TO 8
1390 LPRINT T$;
1400 NEXT
1410 LPRINT
1420 NEXT
1430 LPRINT:LPRINT"(This form is typed 11/in, HMI = 9)
1440 LPRINT CHR$(12) ' FF
1450 PRINT:PRINT
"Would you like the program to type you a format specification form? (n/y) ";
1460 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
1470 PRINT A$:IF A$="n" THEN GOTO 2470 ' entry of data
1480 IF A$="y" THEN 1890
1490 GOTO 1450
1500 '
DESCRIPTION OF VARIABLES
GENERAL STUFF
1510 DATA"Format file name", FO$
1520 DATA"Author, date", FFD$
1530 DATA"Top Margin lines", TM, LTM
1540 DATA"Left Margin spaces", (na), LLM
1550 DATA Width, SW, LW
1560 DATA"Records/screen or page", RS, RP
1570 DATA"Conditional page line", (na), LLP
1580 DATA"120ths of inch per space (10=12/in)", HMI
1590 DATA"48ths of inch per line (8=6/in)", VMI
1600 DATA"(NOT IMPLEMENTED YET) Field separator chars. (use ,'s, 0 at end)",FSC$
1610 DATA"Screen heading line 1, space at end actuates page no.",HL1$
1620 DATA"Screen heading line 2", HL2$
1630 DATA"Screen heading line 3", HL3$
1640 DATA"Printer heading line 1, ditto page no.",LHL1$
1650 DATA"Printer heading line 2", LHL2$
1660 DATA"Printer heading line 3", LHL3$
1670 DATA"Blank lines after heading (0 or number)", HB, LHB
1680 '
RECORD NUMBER
1690 DATA"Record no. mode (0=off, 1=on)", RM, LRM
1700 DATA"Rec. no. Location Line", RLL, LRLL
1710 DATA"Rec. no. Location Column", RLC, LRLC
1720 DATA"No. blank lines after number", RNB, LRNB
1730 '
SEQUENCE OF FIELDS
1740 DATA"Field no.'s in seq, 0 at end", SQ()
1750 DATA"no. blank lines after record", EB, LEB
1760 '
EACH FIELD
1770 DATA"Field name mode (0/1/2)", FM(), LFM()
1780 DATA"Screen field name (mode 2)", F2$()
1790 DATA"Printer field name (mode 2)", LF2$()
1800 DATA"Name Location Line", NLL(), LNLL()
1810 DATA"Name Location Column", NLC(), LNLC()
1820 DATA"No. blank lines after name", FMB(), LFMB()
1830 DATA"Data Location Line", DLL(), LDLL()
1840 DATA"Data Location Column", DLC(), LDLC()
1850 DATA"Screen numeric PRINT USING string", PU$()
1860 DATA"Printer numeric PRINT USING string", LPU$()
1870 DATA"Field length (0 for random, -1 to skip)", FL(), LFL()
1880 DATA"no. blank lines after field", FB(), LFB()
1890 '
PRINT BLANK FORM
1900 ' SET PRINTER
1910 LPRINT CHR$(27);CHR$(31);CHR$(11); ' 12/in
1920 LPRINT CHR$(27);CHR$(30);CHR$(137); 'vert 6/in
1930 LPRINT CHR$(27);CHR$(137);CHR$(135); 'margin 6
1940 LPRINT CHR$(27);"9";CHR$(13); 'set, CR
1950 T$=STRING$(20,95)
1960 T2$=STRING$(3,95)
1970 RESTORE
1980 GOTO 2080
1990 '
SUBROUTINES
2000 READ A$,B$:RETURN
2010 READ A$,B$,C$:RETURN
2020 LPRINT A$ TAB(40) B$ TAB(46) T2$:RETURN
2030 LPRINT A$ TAB(40) B$ TAB(46) T2$
TAB(53) C$ TAB(61) T2$:RETURN
2040 LPRINT A$ TAB(40) B$ TAB(46) T$:LPRINT:RETURN
2050 GOSUB 2000:GOSUB 2020:RETURN
2060 GOSUB 2010:GOSUB 2030:RETURN
2070 '
BEGIN PRINTING
2080 LPRINT:LPRINT:LPRINT:LPRINT"CFORM for file "F$:LPRINT
2090 LPRINT"DESCRIPTION"TAB(40)"SCREEN"TAB(53)"PRINTER":LPRINT
2100 FOR I=1 TO 2
2110 GOSUB 2000:GOSUB 2040
2120 NEXT
2130 FOR I=1 TO 5:GOSUB 2060:NEXT
2140 LPRINT
2150 LPRINT"The next two items refer to the Diablo only:
2160 FOR I=1 TO 2
2170 GOSUB 2000:LPRINT A$ TAB(53) B$ TAB(61) CHR$(95);CHR$(95);CHR$(95)
2180 NEXT
2190 LPRINT
2200 GOSUB 2000:GOSUB 2040
2210 FOR I=1 TO 3
2220 GOSUB 2000:LPRINT A$+" ("+B$+")":
FOR J=1 TO 8:LPRINT T1$;:NEXT:LPRINT:LPRINT:LPRINT
2230 NEXT
2240 FOR I=1 TO 3
2250 GOSUB 2000:LPRINT A$+" ("+B$+")":
FOR J=1 TO 9:LPRINT T1$;:NEXT:LPRINT:LPRINT:LPRINT
2260 NEXT
2270 GOSUB 2060:LPRINT
2280 LPRINT TAB(5)"(If Location Line number is 0, then output will scroll.
2290 LPRINT TAB(5)"Use a 'blank line' for CR/LF after last field on line.
2300 LPRINT:LPRINT"Specifications for each record:":LPRINT
2310 FOR I=1 TO 4:GOSUB 2060:NEXT
2320 LPRINT:GOSUB 2000:GOSUB 2040
2330 GOSUB 2060
2340 LPRINT:LPRINT
"Specifications for each field in record (fill in names in seq.):"
2350 FOR I=1 TO NC
2360 RESTORE 1760:LPRINT CHR$(12)
2370 LPRINT:LPRINT STRING$(70,"*"):LPRINT
2380 LPRINT"Format instructions for (field name)":LPRINT
2390 GOSUB 2060
2400 LPRINT:FOR J=1 TO 2:GOSUB 2000:GOSUB 2040:NEXT
2410 FOR J=1 TO 5:GOSUB 2060:NEXT
2420 IF I=1 THEN LPRINT:LPRINT"(PRINT USING strings follow MBASIC rules)"
2430 LPRINT:FOR J=1 TO 2:GOSUB 2000:GOSUB 2040:NEXT
2440 FOR J=1 TO 2:GOSUB 2060:NEXT
2450 NEXT
2460 GOTO 1450
2470 '
ENTER DATA
2480 PRINT:PRINT"Do you want to enter data now? (y/n) ";
2490 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
2500 PRINT A$:IF A$="n" THEN 3060
2510 IF A$<>"y" THEN 2480
2520 PRINT:PRINT"ENTER DATA FOR NEW (OR REVISED) FORMAT":PRINT
2530 RESTORE
2540 GOTO 2620
2550 '
subroutines
2560 GOSUB 2000:PRINT A$ TAB(40) B$ TAB(46);:RETURN 'two var
2570 GOSUB 2010:PRINT A$ TAB(40) B$ TAB(46);:RETURN ' with next line makes 3
2580 PRINT TAB(53) C$ TAB(59);:RETURN
2590 GOSUB 2560:LINE INPUT"? ";D$:PRINT#3,D$:RETURN
2600 GOSUB 2570:INPUT;D:GOSUB 2580:INPUT E:PRINT#3,D;E:RETURN
2610 '
BEGIN ENTRY
2620 GOSUB 2560:INPUT D$ ' file name
2630 X$=D$:GOSUB 3170:D$=Y$ ' UCV
2640 OPEN"O",3,DD$(5)+D$+".DFO"
2650 PRINT#3,D$
2660 GOSUB 2590 'date read back as LINE
2670 FOR I=1 TO 5
2680 GOSUB 2600
2690 NEXT
2700 FOR I=1 TO 2
2710 GOSUB 2000:PRINT A$ TAB(53) B$ TAB(59);:INPUT D
2720 PRINT#3,D
2730 NEXT
2740 GOSUB 2560:LINE INPUT"? ";D$:IF D$="" THEN D$="0"
2750 PRINT#3,D$
2760 FOR I=1 TO 6 ' heading lines
2770 GOSUB 2000:PRINT A$+" ("+B$+")":
FOR J=1 TO 7:PRINT T1$;:NEXT:PRINT"123456789"
2780 LINE INPUT D$:L$(I)=D$:
IF I>3 THEN IF D$=";" THEN D$=L$(I-3):
PRINT CHR$(13);CHR$(11);D$
2790 PRINT#3,D$
2800 NEXT
2810 GOSUB 2600:PRINT
2820 FOR I=1 TO 4:GOSUB 2600:NEXT
2830 GOSUB 2000 ' dummy read
2840 PRINT:PRINT"As many fields as you want may be shown/printed in any order:
2850 PRINT"Enter number of first field to be printed"
2860 INPUT"(enter 0 as 'next' after last field) ";D
2870 PRINT#3,D;:K=1:SQ(K)=D:IF D=0 THEN 2910 ' K saves # fields for below
2880 INPUT"number of next field to be printed ";D
2890 IF D=0 THEN PRINT#3,D:GOTO 2910 ' includes CR
2900 K=K+1:SQ(K)=D:PRINT#3,D;:GOTO 2880
2910 PRINT:GOSUB 2600
2920 FOR I=1 TO K
2930 RESTORE 1760
2940 PRINT:PRINT"Format instructions for field"SQ(I)"- "N$(SQ(I))
2950 GOSUB 2600 ' mode in D & E
2960 IF D<>2 THEN GOSUB 2000:PRINT#3,:GOTO 2980
2970 GOSUB 2590
2980 IF E<>2 THEN GOSUB 2000:PRINT#3,:GOTO 3000
2990 GOSUB 2590
3000 FOR J=1 TO 5:GOSUB 2600:NEXT
3010 FOR J=1 TO 2:GOSUB 2590:NEXT
3020 FOR J=1 TO 2:GOSUB 2600:NEXT
3030 NEXT
3040 '
FINISH
3050 CLOSE 3:PRINT"Recorded.
3060 PRINT"Do you want to run CFORM again? (n/y) ";
3070 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
3080 PRINT A$:IF A$="n" THEN 3110
3090 IF A$="y" THEN 1100
3100 GOTO 3060
3110 PRINT"Wait while re-loading DEDIT program.
3120 LPRINT CHR$(27);CHR$(31);CHR$(11); ' 12/in
3130 LPRINT CHR$(27);CHR$(30);CHR$(137); ' vert 6/in
3140 LPRINT CHR$(27);CHR$(137);CHR$(133); ' margin 5
3150 LPRINT CHR$(27);"9";CHR$(13); ' set marg & CR
3160 CHAIN DD$(1)+"DEDIT",1000
3170 '
(SUB) UCV
3180 Y$=""
3190 FOR K=1 TO LEN(X$)
3200 Y$=Y$+" "
3210 X=ASC(MID$(X$,K,1))
3220 IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 3240
3230 MID$(Y$,K,1)=MID$(X$,K,1)
3240 NEXT
3250 RETURN
,