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 >
Text File  |  1986-12-07  |  9KB  |  271 lines
  1. 1000 DEFINT A-Z
  2. 1010 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  3.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  4.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  5. 1020 DIM SQ(31),L$(6)
  6. 1030 PRINT CHR$(12);:FOR I=1 TO 10:NEXT        'TERM DEP
  7. 1040 T1$="1234567890"'
  8.  
  9.  
  10. 1050 PRINT"DCFORM March 20, 1982
  11. 1055 ' by Dan Dugan -- public domain
  12. 1060 PRINT"Design your file format on paper first, using forms provided.
  13. 1070 PRINT"To change you have to re-enter all data under same file name.
  14. 1080 PRINT:PRINT"Position the paper so the printhead is at the upper left corner of the paper.
  15. 1090 PRINT"Set the TOF switch.
  16. 1100 PRINT:PRINT"Would you like the program to type you a blank form for
  17. 1110 PRINT"designing a 24 x 80 screen? (n/y) ";
  18. 1120 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  19. 1130 PRINT A$:IF A$="n" THEN 1450 'next form
  20. 1140 IF A$="y" THEN 1160
  21. 1150 GOTO 1100
  22. 1160 '
  23.  
  24.                 TYPE SCREEN FORM
  25.  
  26. 1170 '    SET PRINTER
  27. 1180 LPRINT CHR$(27);CHR$(31);CHR$(12); ' 11/in
  28. 1190 LPRINT CHR$(27);CHR$(30);CHR$(6); ' vert spc 
  29. 1200 LPRINT CHR$(27);CHR$(137);CHR$(133); ' margin 5
  30. 1210 LPRINT CHR$(27);"9";CHR$(13); ' set margin & CR
  31. 1220 LPRINT:LPRINT:LPRINT"DIMS CFORM screen design form for file "F$;
  32. 1230 LPRINT TAB(48)"Format name:"TAB(67)"Date:
  33. 1240 LPRINT:LPRINT SPC(3);
  34. 1250 FOR I=1 TO 8
  35. 1260    LPRINT SPC(8);STR$(I);
  36. 1270 NEXT
  37. 1280 LPRINT:LPRINT SPC(3);
  38. 1290 T$="1234567890"
  39. 1300 FOR I=1 TO 8
  40. 1310    LPRINT T$;
  41. 1320 NEXT
  42. 1330 LPRINT
  43. 1340 T$="=========+"
  44. 1350 FOR I=1 TO 24
  45. 1360    LPRINT USING"## ";I
  46. 1370    LPRINT SPC(3);
  47. 1380    FOR J=1 TO 8
  48. 1390        LPRINT T$;
  49. 1400    NEXT
  50. 1410    LPRINT
  51. 1420 NEXT
  52. 1430 LPRINT:LPRINT"(This form is typed 11/in, HMI = 9)
  53. 1440 LPRINT CHR$(12) ' FF
  54. 1450 PRINT:PRINT
  55. "Would you like the program to type you a format specification form? (n/y) ";
  56. 1460 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  57. 1470 PRINT A$:IF A$="n" THEN GOTO 2470 ' entry of data
  58. 1480 IF A$="y" THEN 1890
  59. 1490 GOTO 1450
  60. 1500 '
  61.  
  62. DESCRIPTION OF VARIABLES
  63.  
  64. GENERAL STUFF
  65. 1510 DATA"Format file name",        FO$
  66. 1520 DATA"Author, date",            FFD$
  67. 1530 DATA"Top Margin lines",        TM,    LTM
  68. 1540 DATA"Left Margin spaces",        (na),    LLM
  69. 1550 DATA Width,                SW,    LW
  70. 1560 DATA"Records/screen or page",    RS,    RP
  71. 1570 DATA"Conditional page line",    (na),    LLP
  72. 1580 DATA"120ths of inch per space (10=12/in)",        HMI
  73. 1590 DATA"48ths of inch per line (8=6/in)",        VMI
  74. 1600 DATA"(NOT IMPLEMENTED YET) Field separator chars. (use ,'s, 0 at end)",FSC$
  75. 1610 DATA"Screen heading line 1, space at end actuates page no.",HL1$
  76. 1620 DATA"Screen heading line 2",    HL2$
  77. 1630 DATA"Screen heading line 3",    HL3$
  78. 1640 DATA"Printer heading line 1, ditto page no.",LHL1$
  79. 1650 DATA"Printer heading line 2",        LHL2$
  80. 1660 DATA"Printer heading line 3",        LHL3$
  81. 1670 DATA"Blank lines after heading (0 or number)",    HB,    LHB
  82. 1680 '
  83. RECORD NUMBER
  84. 1690 DATA"Record no. mode (0=off, 1=on)",    RM,    LRM
  85. 1700 DATA"Rec. no. Location Line",        RLL,    LRLL
  86. 1710 DATA"Rec. no. Location Column",    RLC,    LRLC
  87. 1720 DATA"No. blank lines after number",    RNB,    LRNB
  88. 1730 '
  89. SEQUENCE OF FIELDS
  90. 1740 DATA"Field no.'s in seq, 0 at end",    SQ()
  91. 1750 DATA"no. blank lines after record",    EB,    LEB
  92. 1760 '
  93. EACH FIELD
  94. 1770 DATA"Field name mode (0/1/2)",    FM(),    LFM()
  95. 1780 DATA"Screen field name (mode 2)",    F2$()
  96. 1790 DATA"Printer field name (mode 2)",        LF2$()
  97. 1800 DATA"Name Location Line",        NLL(),    LNLL()
  98. 1810 DATA"Name Location Column",        NLC(),    LNLC()
  99. 1820 DATA"No. blank lines after name",        FMB(),    LFMB()
  100. 1830 DATA"Data Location Line",        DLL(),    LDLL()
  101. 1840 DATA"Data Location Column",        DLC(),    LDLC()
  102. 1850 DATA"Screen numeric PRINT USING string",    PU$()
  103. 1860 DATA"Printer numeric PRINT USING string",        LPU$()
  104. 1870 DATA"Field length (0 for random, -1 to skip)",        FL(),    LFL()
  105. 1880 DATA"no. blank lines after field",  FB(),    LFB()
  106. 1890 '
  107.  
  108.                 PRINT BLANK FORM
  109.  
  110. 1900 '    SET PRINTER
  111. 1910 LPRINT CHR$(27);CHR$(31);CHR$(11); ' 12/in
  112. 1920 LPRINT CHR$(27);CHR$(30);CHR$(137); 'vert 6/in
  113. 1930 LPRINT CHR$(27);CHR$(137);CHR$(135); 'margin 6
  114. 1940 LPRINT CHR$(27);"9";CHR$(13); 'set, CR
  115. 1950 T$=STRING$(20,95)
  116. 1960 T2$=STRING$(3,95)
  117. 1970 RESTORE
  118. 1980 GOTO 2080
  119. 1990 '
  120.         SUBROUTINES
  121.  
  122. 2000 READ A$,B$:RETURN
  123. 2010 READ A$,B$,C$:RETURN
  124. 2020 LPRINT A$ TAB(40) B$ TAB(46) T2$:RETURN
  125. 2030 LPRINT A$ TAB(40) B$ TAB(46) T2$
  126.     TAB(53) C$ TAB(61) T2$:RETURN
  127. 2040 LPRINT A$ TAB(40) B$ TAB(46) T$:LPRINT:RETURN
  128. 2050 GOSUB 2000:GOSUB 2020:RETURN
  129. 2060 GOSUB 2010:GOSUB 2030:RETURN
  130. 2070 '
  131.         BEGIN PRINTING
  132.  
  133. 2080 LPRINT:LPRINT:LPRINT:LPRINT"CFORM for file "F$:LPRINT
  134. 2090 LPRINT"DESCRIPTION"TAB(40)"SCREEN"TAB(53)"PRINTER":LPRINT
  135. 2100 FOR I=1 TO 2
  136. 2110    GOSUB 2000:GOSUB 2040
  137. 2120 NEXT
  138. 2130 FOR I=1 TO 5:GOSUB 2060:NEXT
  139. 2140 LPRINT
  140. 2150 LPRINT"The next two items refer to the Diablo only:
  141. 2160 FOR I=1 TO 2
  142. 2170    GOSUB 2000:LPRINT A$ TAB(53) B$ TAB(61) CHR$(95);CHR$(95);CHR$(95)
  143. 2180 NEXT
  144. 2190 LPRINT
  145. 2200 GOSUB 2000:GOSUB 2040
  146. 2210 FOR I=1 TO 3
  147. 2220    GOSUB 2000:LPRINT A$+" ("+B$+")":
  148.         FOR J=1 TO 8:LPRINT T1$;:NEXT:LPRINT:LPRINT:LPRINT
  149. 2230 NEXT
  150. 2240 FOR I=1 TO 3
  151. 2250    GOSUB 2000:LPRINT A$+" ("+B$+")":
  152.         FOR J=1 TO 9:LPRINT T1$;:NEXT:LPRINT:LPRINT:LPRINT
  153. 2260 NEXT
  154. 2270 GOSUB 2060:LPRINT
  155. 2280 LPRINT TAB(5)"(If Location Line number is 0, then output will scroll.
  156. 2290 LPRINT TAB(5)"Use a 'blank line' for CR/LF after last field on line.
  157. 2300 LPRINT:LPRINT"Specifications for each record:":LPRINT
  158. 2310 FOR I=1 TO 4:GOSUB 2060:NEXT
  159. 2320 LPRINT:GOSUB 2000:GOSUB 2040
  160. 2330 GOSUB 2060
  161. 2340 LPRINT:LPRINT
  162.     "Specifications for each field in record (fill in names in seq.):"
  163. 2350 FOR I=1 TO NC
  164. 2360    RESTORE 1760:LPRINT CHR$(12)
  165. 2370    LPRINT:LPRINT STRING$(70,"*"):LPRINT
  166. 2380    LPRINT"Format instructions for (field name)":LPRINT
  167. 2390    GOSUB 2060
  168. 2400    LPRINT:FOR J=1 TO 2:GOSUB 2000:GOSUB 2040:NEXT
  169. 2410    FOR J=1 TO 5:GOSUB 2060:NEXT
  170. 2420    IF I=1 THEN LPRINT:LPRINT"(PRINT USING strings follow MBASIC rules)"
  171. 2430    LPRINT:FOR J=1 TO 2:GOSUB 2000:GOSUB 2040:NEXT
  172. 2440    FOR J=1 TO 2:GOSUB 2060:NEXT
  173. 2450 NEXT
  174. 2460 GOTO 1450
  175. 2470 '
  176.  
  177.  
  178.                 ENTER DATA
  179.  
  180. 2480 PRINT:PRINT"Do you want to enter data now? (y/n) ";
  181. 2490 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  182. 2500 PRINT A$:IF A$="n" THEN 3060
  183. 2510 IF A$<>"y" THEN 2480
  184. 2520 PRINT:PRINT"ENTER DATA FOR NEW (OR REVISED) FORMAT":PRINT
  185. 2530 RESTORE
  186. 2540 GOTO 2620
  187. 2550 '
  188.  subroutines
  189. 2560 GOSUB 2000:PRINT A$ TAB(40) B$ TAB(46);:RETURN 'two var
  190. 2570 GOSUB 2010:PRINT A$ TAB(40) B$ TAB(46);:RETURN ' with next line makes 3
  191. 2580 PRINT TAB(53) C$ TAB(59);:RETURN
  192. 2590 GOSUB 2560:LINE INPUT"? ";D$:PRINT#3,D$:RETURN
  193. 2600 GOSUB 2570:INPUT;D:GOSUB 2580:INPUT E:PRINT#3,D;E:RETURN
  194. 2610 '
  195.         BEGIN ENTRY
  196.  
  197. 2620 GOSUB 2560:INPUT D$ ' file name
  198. 2630 X$=D$:GOSUB 3170:D$=Y$ ' UCV
  199. 2640 OPEN"O",3,DD$(5)+D$+".DFO"
  200. 2650 PRINT#3,D$
  201. 2660 GOSUB 2590                'date read back as LINE
  202. 2670 FOR I=1 TO 5
  203. 2680    GOSUB 2600
  204. 2690 NEXT
  205. 2700 FOR I=1 TO 2
  206. 2710    GOSUB 2000:PRINT A$ TAB(53) B$ TAB(59);:INPUT D
  207. 2720    PRINT#3,D
  208. 2730 NEXT
  209. 2740 GOSUB 2560:LINE INPUT"? ";D$:IF D$="" THEN D$="0"
  210. 2750 PRINT#3,D$
  211. 2760 FOR I=1 TO 6 ' heading lines
  212. 2770    GOSUB 2000:PRINT A$+" ("+B$+")":
  213.         FOR J=1 TO 7:PRINT T1$;:NEXT:PRINT"123456789"
  214. 2780    LINE INPUT D$:L$(I)=D$:
  215.         IF I>3 THEN IF D$=";" THEN D$=L$(I-3):
  216.         PRINT CHR$(13);CHR$(11);D$
  217. 2790    PRINT#3,D$
  218. 2800 NEXT
  219. 2810 GOSUB 2600:PRINT
  220. 2820 FOR I=1 TO 4:GOSUB 2600:NEXT
  221. 2830 GOSUB 2000 ' dummy read
  222. 2840 PRINT:PRINT"As many fields as you want may be shown/printed in any order:
  223. 2850 PRINT"Enter number of first field to be printed"
  224. 2860 INPUT"(enter 0 as 'next' after last field)     ";D
  225. 2870 PRINT#3,D;:K=1:SQ(K)=D:IF D=0 THEN 2910    ' K saves # fields for below
  226. 2880 INPUT"number of next field to be printed       ";D
  227. 2890 IF D=0 THEN PRINT#3,D:GOTO 2910 ' includes CR
  228. 2900 K=K+1:SQ(K)=D:PRINT#3,D;:GOTO 2880
  229. 2910 PRINT:GOSUB 2600
  230. 2920 FOR I=1 TO K
  231. 2930    RESTORE 1760
  232. 2940    PRINT:PRINT"Format instructions for field"SQ(I)"- "N$(SQ(I))
  233. 2950    GOSUB 2600 ' mode in D & E
  234. 2960    IF D<>2 THEN GOSUB 2000:PRINT#3,:GOTO 2980
  235. 2970    GOSUB 2590
  236. 2980    IF E<>2 THEN GOSUB 2000:PRINT#3,:GOTO 3000
  237. 2990    GOSUB 2590
  238. 3000    FOR J=1 TO 5:GOSUB 2600:NEXT
  239. 3010    FOR J=1 TO 2:GOSUB 2590:NEXT
  240. 3020    FOR J=1 TO 2:GOSUB 2600:NEXT
  241. 3030 NEXT
  242. 3040 '
  243.  
  244.  
  245.                 FINISH
  246.  
  247. 3050 CLOSE 3:PRINT"Recorded.
  248. 3060 PRINT"Do you want to run CFORM again? (n/y) ";
  249. 3070 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  250. 3080 PRINT A$:IF A$="n" THEN 3110
  251. 3090 IF A$="y" THEN 1100
  252. 3100 GOTO 3060
  253. 3110 PRINT"Wait while re-loading DEDIT program.
  254. 3120 LPRINT CHR$(27);CHR$(31);CHR$(11); ' 12/in
  255. 3130 LPRINT CHR$(27);CHR$(30);CHR$(137); ' vert 6/in
  256. 3140 LPRINT CHR$(27);CHR$(137);CHR$(133); ' margin 5
  257. 3150 LPRINT CHR$(27);"9";CHR$(13); ' set marg & CR
  258. 3160 CHAIN DD$(1)+"DEDIT",1000
  259. 3170 '
  260.  
  261.                 (SUB) UCV
  262.  
  263. 3180 Y$=""
  264. 3190 FOR K=1 TO LEN(X$)
  265. 3200    Y$=Y$+" "
  266. 3210    X=ASC(MID$(X$,K,1))
  267. 3220    IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 3240
  268. 3230    MID$(Y$,K,1)=MID$(X$,K,1)
  269. 3240 NEXT
  270. 3250 RETURN
  271. ,