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