home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1987 March & April / rerun-1987-03-04.d64 / dfprint (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1987-01-01  |  14.8 KB  |  469 lines
  1. 10 iffl=0thenfl=1:load"dp] dos5.1",8,1
  2. 11 iffl=1thenfl=2:sys52224:rem(c)commodore
  3. 600 fore=0to24:poke54272+e,0:next:poke54296,15:goto1500
  4. 602 poke54277,58:poke54278,16:poke54273,35:poke54272,134
  5. 604 poke54276,33:fore=1to100:next:poke54276,16:return
  6. 1500 rem dfprint 1.7 for datafile (c)1983-1986 by mike konshak
  7. 1502 clr:print"[147][158]":poke53281,0:poke53280,0:open4,4:open3,3
  8. 1504 d$="":b$=chr$(32):forj=1to80:s$=s$+b$:nextj:pf=4:mf$=d$:rf$=d$:p=0
  9. 1506 nc=0:nl=0:pl=0:f1=0:f2=0:f3=0:l$=d$:rl=0:sb$=d$:cr$=chr$(13)
  10. 1508 a$=d$:c$=d$:t%=6:i=0:j=0:k=0:m=0:n=0:rw=5:sf=0:z=0:e$="eof"
  11. 1510 en=0:em$=d$:et=0:es=0:a1$=d$:a2$=d$:a3$=d$:rw=5:lw=34:lt=1:l=0
  12. 1512 rem-arrays
  13. 1514 dim ml$(17,4),pc(18),tt$(5),hc$(17),rp$(17,4),lp(5),r$(5)
  14. 1516 dim f$(31),t%(31),l%(31),rec$(31)
  15. 1518 lp(1)=1:lp(2)=37:lp(3)=73:lp(4)=109:goto1530
  16. 1520 rem-get
  17. 1521 print"[158]       press the appropriate key       ":return
  18. 1522 geta$:ifa$=""then1522
  19. 1524 return
  20. 1526 rem-start
  21. 1528 print"[147]       datafile fast print program     ":goto1548
  22. 1530 print"[147]       datafile fast print rev 1.7     "
  23. 1532 print"         by mike konshak (c)1986       "
  24. 1534 print"[153] this program will format and print a"
  25. 1536 print" seq[146] file, which was previously created"
  26. 1539 print" by [158]datafile[153][146], directly from the disk"
  27. 1540 print" to the printer.  the order of the"
  28. 1542 print" records will be the same as the most"
  29. 1544 print" recent sort as written in the current"
  30. 1546 print" file.":print"[158] press any key[146][158] to continue"
  31. 1547 gosub1522:gosub2856:goto1528
  32. 1548 printtab(5)"o[153][146]pen record file on disk"
  33. 1550 iffl>0thenprinttab(5)"r[153][146]epeat record file: [146]"nf$"[158][146]"
  34. 1551 printtab(5)"$[153][146] disk directory 4[153][146]"
  35. 1552 printtab(5)"q[153][146]uit program"
  36. 1553 print" transfer to:"
  37. 1554 printtab(5)"d[153][146] datafile dbms"
  38. 1555 printtab(5)"c[153][146] dfcalc calculated reports"
  39. 1556 gosub1521
  40. 1558 gosub1522:ifa$="$"ora$="4"thengosub1628:goto1528
  41. 1559 ifa$="d"thenprint"[147][144]load"chr$(34)"datafile 3.6"chr$(34)",8":goto1565
  42. 1560 ifa$="o"thenfl=1:goto1572
  43. 1561 ifa$="c"thenprint"[147][144]load"chr$(34)"dfcalc"chr$(34)",8":goto1565
  44. 1562 ifa$="r"then1584
  45. 1563 ifa$="q"thenclose5:close15:close3:close4:end
  46. 1564 gosub602:goto1558
  47. 1565 print:print:print:print:print"run[158]"
  48. 1566 poke631,19:poke632,13:poke633,13:poke634,13:poke635,13:poke636,13
  49. 1568 poke198,6:new:end
  50. 1570 rem-file name
  51. 1572 print"[153][147] available record files are:[158]":@"$0:df]*"
  52. 1573 print"[153]name of record file to be printed[158]"
  53. 1574 print"   ";nf$:input"[145] ";nf$:ifnf$=""thenfl=0:goto1528
  54. 1576 open15,8,15
  55. 1578 open5,8,5,"0:df] "+nf$+",s,r":gosub1618:ifen=62thengosub1620:fl=0:goto1528
  56. 1579 input#5,r,f,x:gosub1618:ifet=8then1528                              
  57. 1580 forn=1tof:input#5,f$(n),l%(n):nextn:gosub1618:ifet=8then1528        
  58. 1582 close5:close15                                                      
  59. 1583 rem-print menu
  60. 1584 print"[158][147]         record printout menu          "
  61. 1585 print"[153] print options:";:ifk<>0thenprint:goto1587
  62. 1586 print"[150]no formats present[158]"                                         
  63. 1587 printtab(4)"u[153][146]nformatted list"
  64. 1588 printtab(4)"r[153][146]eport format  [158]"rf$
  65. 1590 printtab(4)"m[153][146]ailing labels [158]"mf$
  66. 1591 print"[153] configure:"
  67. 1592 printtab(4)"l[153][146]abels:[158]"rw"[153]rows,[158]"lw"[153]chrs,[158]"lt"[153]across"
  68. 1594 printtab(4)"p[153][146]rinter: option[158]"p;:ifp=4thenprint"[157][157]screen[146]";
  69. 1595 print:printtab(4)"$[153][146] disk directory 4[153][146]"
  70. 1596 printtab(4)"e[153][146]xit to restart"
  71. 1598 gosub1521
  72. 1600 gosub1522:ifa$="" then1600
  73. 1602 ifa$="u"thenk=1:goto1730
  74. 1604 ifa$="r"thenk=2:goto3118
  75. 1605 ifa$="$"ora$="4"thengosub1628:goto1584
  76. 1606 ifa$="e"then1528
  77. 1608 ifa$="m"thenk=3:goto3118
  78. 1610 ifa$="l"then1940
  79. 1612 ifa$="p"thengosub2856:goto1584
  80. 1614 gosub602:goto1600
  81. 1616 rem-disk error
  82. 1618 input#15,en,em$,et,es:if(en<20)or(en=62)thenet=0:return
  83. 1620 print" [150]disk error[146]"en"[157], "em$","et"[157],"es"[158]":et=8
  84. 1622 print"[153] press any key[153][146] to restart program[158]"
  85. 1624 gosub1522:close5:close15:return
  86. 1626 rem-directory
  87. 1628 print"[147][158]";:@"$":printtab(25)"[153]press any key[158][146]":gosub1522:return
  88. 1666 rem-load report
  89. 1668 print"[153][147] available report files are[158]:":@"$0:rp]*"
  90. 1669 print"[153] name of report format file?[158]"
  91. 1670 print"   [158]";nf$:input"[145] ";rf$:ifrf$=""then1528
  92. 1672 open15,8,15:open5,8,5,"0:rp] "+rf$+",s,r":gosub1618:ifet=8then1528
  93. 1674 ifen=62thengosub1620:goto1528
  94. 1676 input#5,pw,nl,nc:gosub1618:ifet=8then1528
  95. 1678 forj=1tonl
  96. 1680 input#5,tt$(j):gosub1618:ifet=8then1528
  97. 1682 nextj
  98. 1684 fori=1tonc
  99. 1686 input#5,pc(i),hc$(i):gosub1618:ifet=8then1528
  100. 1688 forn=1to3
  101. 1690 input#5,rp$(i,n):gosub1618:ifet=8then1528                           
  102. 1692 nextn:nexti:input#5,a1$:z=val(a1$)
  103. 1694 s=st:ifs<>0then1698
  104. 1696 input#5,e$
  105. 1698 close5:close15
  106. 1700 goto2980
  107. 1702 rem-load label
  108. 1704 print"[153][147] available label files are:[158]":@"$0:ml]*"
  109. 1705 print"[153] name of mailing label format file?"
  110. 1706 print"   [158]";nf$:input"[145] ";mf$:ifmf$=""then1528
  111. 1708 open15,8,15:open5,8,5,"0:ml] "+mf$+",s,r":gosub1618:ifet=8then1528
  112. 1710 ifen=62thengosub1620:goto1528
  113. 1712 input#5,rw
  114. 1714 fori=1torw:forn=1to3
  115. 1716 input#5,ml$(i,n):gosub1618:ifet=8then1528
  116. 1718 nextn
  117. 1720 nexti
  118. 1722 s=st:ifs<>0then1726
  119. 1724 input#5,e$
  120. 1726 close5:close15:goto3068
  121. 1728 rem-open file
  122. 1730 print"[147] positioning drive..."
  123. 1731 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub1618:ifet=8then1528  
  124. 1732 ifen=62thengosub1620:goto1528
  125. 1734 input#5,r,f,x:gosub1618:ifet=8then1528
  126. 1738 forn=1tof:input#5,f$(n),l%(n):nextn:gosub1618:ifet=8then1528
  127. 1740 rem-options
  128. 1742 a0=0:pg=1:pl=0:l=0:print"[147] [158]           print options menu        "
  129. 1743 print"[153] there are [158]"x"[146][153]records in [158]"nf$
  130. 1744 printtab(4)"a[153][146]ll records in file
  131. 1746 [153][163]4)"fprintwaitind records with common fields
  132. 1748 ifk=3andpf=4thenprinttab(4)"t[153][146]est label(s)"
  133. 1750 printtab(4)"e[153][146]xit back to start"
  134. 1752 ifk=2thenprint"[153]position paper in printer at top of page"
  135. 1754 gosub1521
  136. 1756 gosub1522
  137. 1758 ifa$="a"then1806
  138. 1762 ifa$="t"then1918
  139. 1764 ifa$="f"then1772
  140. 1766 ifa$="e"thenclose5:close15:goto3118
  141. 1768 gosub602:goto1756
  142. 1770 rem-find
  143. 1772 print"[158][147]     find records with common items    "
  144. 1774 forn=1tof:print" ";n;"[153][146] ";f$(n):nextn
  145. 1776 input" which field is to be searched";sf
  146. 1778 ifsf<0orsf>fthenprint"[145][145][145]":goto1776
  147. 1780 print"[153] enter common item[153][146] ":print" (the entire string is not required)"
  148. 1782 print" ";f$(sf);"[158][146] ";:inputt$
  149. 1784 print"[147]":ifk=2thengosub1838:gosub1852
  150. 1786 fori=1tox
  151. 1788 ifp<>4thenprint" searching record";i;"[145][145]"                         
  152. 1790 forn=1tof:input#5,rec$(n):ifrec$(n)=">"thenrec$(n)=" "
  153. 1791 nextn:gosub1618:ifet=8then1528
  154. 1792 ift$=left$(rec$(sf),len(t$))thenonkgosub1826,1870,1928:ifk=2thengosub1904
  155. 1796 nexti
  156. 1797 ifl>0andk=3thengosub1936
  157. 1798 close5:close15
  158. 1800 ifk=2then1906
  159. 1801 ifp=4thenprint"[153]press any key[158][146]":gosub1522
  160. 1802 goto1730
  161. 1804 rem-print all
  162. 1806 gosub2898:pl=0:print"[147][158]":ifp<>4andk=2thenprint"[147] printing heading"
  163. 1807 ifk=2thengosub1838:gosub1852
  164. 1808 fori=stox:ifp<>4thenprint"[145] reading record #"str$(i)" of"str$(x)    
  165. 1810 forn=1tof:input#5,rec$(n):ifrec$(n)=">"thenrec$(n)=" "
  166. 1811 nextn:gosub1618:ifet=8then1528
  167. 1812 onkgosub1826,1870,1928
  168. 1814 ifk=2thengosub1904
  169. 1816 nexti
  170. 1818 close5:close15
  171. 1820 ifk=2then1906
  172. 1822 goto1801
  173. 1824 rem-nonformatted
  174. 1826 print#pf,"[ record #";i;"   ]";:forj=1to61:print#pf,"-";:nextj:gosub2888
  175. 1828 pl=pl+1:forn=1tof
  176. 1830 print#pf,f$(n);:forj=1to20-len(f$(n)):print#pf,".";:nextj
  177. 1831 ifrec$(n)=">"thenrec$(n)=" "
  178. 1832 print#pf,rec$(n):pl=pl+1:nextn:gosub2888:pl=pl+1
  179. 1834 ifpl+f<=60thenreturn
  180. 1835 forj=1to65-pl:gosub2888:nextj:pl=0:pg=pg+1:print#pf,"page"pg:return 
  181. 1836 rem-title
  182. 1838 forj=1tonl:iftt$(j)<>">"thengosub1846                               
  183. 1842 nextj:return
  184. 1846 b=int((pw-len(tt$(j)))/2):ifp<>1then1849
  185. 1848 print#pf,left$(s$,b)+tt$(j);b1$;:pl=pl+1:return
  186. 1849 print#pf,left$(s$,b)+tt$(j);b1$:pl=pl+1:return
  187. 1850 rem-headings
  188. 1852 gosub1866:pc(nc+1)=pw+3:cw=pc(2)-2-pc(1):ifpc(1)>1then1856
  189. 1854 print#pf,left$(hc$(1),cw);:goto1858
  190. 1856 print#pf,left$(s$,pc(1)-1)+left$(hc$(1),cw);
  191. 1858 ifnc=1then1862
  192. 1859 forj=2tonc:m=pc(j)-len(left$(hc$(j-1),pc(j)-2-pc(j-1)))-pc(j-1)
  193. 1860 print#pf,left$(s$,m)+left$(hc$(j),pc(j+1)-2-pc(j));
  194. 1861 nextj
  195. 1862 gosub2888:gosub1866:pl=pl+3:return
  196. 1864 rem-dashes
  197. 1866 forj=1topw:print#pf,"-";:nextj:gosub2888:return
  198. 1868 rem-data
  199. 1870 f1=val(rp$(1,1)):f2=val(rp$(1,2)):f3=val(rp$(1,3)):cw=pc(2)-2-pc(1) 
  200. 1871 ifnc=1andz=1thenclm$=rec$(val(rp$(1,1))):gosub3148:goto1896
  201. 1872 ifpc(1)>1then1878
  202. 1874 print#pf,left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw);
  203. 1876 goto1882
  204. 1878 print#pf,left$(s$,pc(1)-1);
  205. 1880 print#pf,left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw);
  206. 1882 ifnc=1then1896
  207. 1883 forj=2tonc:cw=pc(j)-2-pc(j-1)
  208. 1884 f1=val(rp$(j-1,1)):f2=val(rp$(j-1,2)):f3=val(rp$(j-1,3))
  209. 1886 m=len(left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw))
  210. 1888 m=pc(j)-m-pc(j-1):cw=pc(j+1)-2-pc(j)
  211. 1890 print#pf,left$(s$,m);
  212. 1891 ifj=ncandz=1thenclm$=rec$(val(rp$(j,1))):gosub3148:goto1896
  213. 1892 f1=val(rp$(j,1)):f2=val(rp$(j,2)):f3=val(rp$(j,3))                  
  214. 1894 print#pf,left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw);
  215. 1895 nextj
  216. 1896 gosub2888:pl=pl+1
  217. 1898 ifpl=60thenforj=1to5:gosub2888:nextj:pl=0:goto1901                  
  218. 1900 return
  219. 1901 pg=pg+1:print#pf,"page"pg:gosub1852:return
  220. 1902 rem-sum
  221. 1904 ifz<>1thenreturn
  222. 1905 a0=a0+val(rec$(val(rp$(nc,1)))):return                              
  223. 1906 ifz<>1then1914
  224. 1908 print#pf,left$(s$,pc(nc)-1);
  225. 1910 fori=1topw-pc(nc)+1:print#pf,"-";:nexti:gosub2888
  226. 1911 ifnc=1then1913
  227. 1912 print#pf,left$(s$,pc(nc)-9)+"total=  ";
  228. 1913 clm$=str$(a0):gosub3148:pl=pl+2
  229. 1914 gosub2888:ifpf=4thenfori=1to66-pl:gosub2888:nexti
  230. 1915 goto1801
  231. 1916 rem-test
  232. 1918 print" printing test label"
  233. 1920 fori=1torw:forj=1tolw:print#pf,right$(str$(j),1);:nextj:gosub2888:nexti
  234. 1922 fori=1tot%-rw:gosub2888:nexti
  235. 1924 goto1742
  236. 1926 rem-labels
  237. 1928 l=l+1:forj=1torw:f1=val(ml$(j,1)):f2=val(ml$(j,2)):f3=val(ml$(j,3))
  238. 1930 rw$(j)=rw$(j)+left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3)+s$,lw)+b$+b$:nextj
  239. 1932 ifi>=xthen1936
  240. 1934 ifl<>ltthenreturn
  241. 1936 forj=1torw:print#pf,left$(rw$(j),lp(lt)+lw-1):rw$(j)="":nextj
  242. 1937 fors=1tot%-rw:gosub2888:nexts:l=0:return
  243. 1938 rem-label size
  244. 1940 print"[147][158]              label size               [146]"
  245. 1941 print"[153] currently:[158]"rw"[153][157] rows,[158]"lw"[153][157] chrs,[158]"lt"[153][157] across [158]"
  246. 1942 printtab(3)"s[153][146]tandard - 5 rows, 34 chrs, 1 up"
  247. 1944 printtab(5)"15/16 inch by 3 1/2 inches"
  248. 1946 printtab(3)"l[153][146]arge    - 8 rows, 34 chrs, 1 up"
  249. 1948 printtab(5)"1 7/16 inch by 3 1/2 inches"
  250. 1950 printtab(3)"c[153][146]hange label size and type"
  251. 1953 printtab(3)"e[153][146]xit"
  252. 1954 print" note: labels are separated by one row"
  253. 1956 printtab(7)"and 2 characters"
  254. 1958 gosub1521
  255. 1960 gosub1522:ifa$="e"then1584
  256. 1962 ifa$="s"thent%=6:rw=5:lw=34:goto1940
  257. 1964 ifa$="l"thent%=9:rw=8:lw=34:goto1940
  258. 1966 ifa$="c"then1968
  259. 1967 gosub602:goto1960
  260. 1968 print"[153] number of rows on label[158]?"rw
  261. 1969 print"[145]"tab(24);:inputrw:t%=rw+1
  262. 1970 print"[153] # of characters per row[158]?"lw
  263. 1971 print"[145]"tab(24);:inputlw
  264. 1972 print"[153] # labels across page   [158]?"lt
  265. 1973 print"[145]"tab(24);:inputlt:iflt<1orlt>4thenprint"[145]":goto1973        
  266. 1974 lp(1)=1:lp(2)=lw+2:lp(3)=2*(lw+2):lp(4)=3*(lw+2)                    
  267. 1975 goto1940
  268. 1976 rem-printer cmds
  269. 1978 print"[158][147]            printer command            [146]"
  270. 1980 print"[153] this routine will send character"
  271. 1982 print" string [chr$()] commands to an ascii"
  272. 1984 print" printer.  commands must be entered in"
  273. 1986 print" the form of integers such as:"
  274. 1988 print"[158] ? 27[153]     (code 1)"
  275. 1990 print"[158] ? 66[153]     (code 2)"
  276. 1992 print"[158] ? 2[153]      (code 3)"
  277. 1994 print"[158] ? *[153]      (end)"
  278. 1996 print" this will be sent to the printer as:"
  279. 1998 print"[158]   print#4,chr$(27)chr$(66)chr$(2)[153]"
  280. 2000 print" up to four(4) numbers may be sent,"
  281. 2002 print" the first normally being [158]27[146][153], the"
  282. 2004 print" escape character.  end the sequence"
  283. 2006 print" by pressing return[153][146] when the asterisk"
  284. 2008 print" is showing.  printers will vary, so"
  285. 2010 print" check your manual for the codes."
  286. 2012 print"    any key[146][153] to continue or e[153][146]xit?"
  287. 2014 gosub1522:ifa$="e"then1584
  288. 2016 print"[158][147]         send printer command          [146]"
  289. 2018 print"[153] enter code, then press return[146][153]"
  290. 2020 print" return[153][146] only to quit[158]"
  291. 2022 fori=1to4:print"[153]code[158]";i;" ? * [157][157][157][157]";:inputi$(i)
  292. 2024 ifi$(i)="*"then2028
  293. 2026 nexti
  294. 2028 on(i-1)goto2030,2032,2034,2036:goto2039
  295. 2030 print#4,chr$(val(i$(1))):goto2038
  296. 2032 print#4,chr$(val(i$(1)))chr$(val(i$(2))):goto2038
  297. 2034 print#4,chr$(val(i$(1)))chr$(val(i$(2)))chr$(val(i$(3))):goto2038
  298. 2036 print#4,chr$(val(i$(1)))chr$(val(i$(2)))chr$(val(i$(3)))chr$(val(i$(4)))
  299. 2038 gosub2888
  300. 2039 printtab(10)"a[153][146]nother code"
  301. 2040 printtab(10)"t[153][146]est change"
  302. 2042 printtab(10)"e[153][146]xit to start"
  303. 2044 gosub1521
  304. 2046 gosub1522:ifa$="a"then2016
  305. 2048 ifa$="t"thenprint#4,"abcdefghijklmnopqrstuvwxyz":gosub2888:goto2046
  306. 2050 ifa$="e"thenreturn
  307. 2052 gosub602:goto2046
  308. 2854 rem-setup
  309. 2856 print"[158][147]     printer or interface configure    "
  310. 2857 ifp<>0thenprint"[153] current option is:[158]"p
  311. 2858 print" [153]press 1[153][146]  cardco a, 1525"
  312. 2860 printtab(7)"2[153][146]  printers w/ graphic interface"
  313. 2862 printtab(7)"3[153][146]  1526, mps801/802/803"
  314. 2863 printtab(7)"4[153][146]  print to screen"
  315. 2864 ifp<>0thenprint"   or  s[153][146]end printer commands"
  316. 2866 ifp<>0thenprinttab(7)"e[153][146]xit to continue"
  317. 2868 gosub1521
  318. 2870 gosub1522
  319. 2872 ifa$="e"thenreturn
  320. 2874 ifa$="s"thengoto1978
  321. 2876 p=val(a$):pf=4
  322. 2878 ifp=1thenb1$=chr$(10):goto2856
  323. 2880 ifp=2thenb1$=chr$(0):goto2856
  324. 2882 ifp=3thenb1$=chr$(0):goto2856
  325. 2883 ifp=4thenb1$=chr$(0):pf=3:goto2856
  326. 2884 gosub602:goto2870
  327. 2886 rem-terminator
  328. 2888 onpgoto2890,2892,2894,2892
  329. 2890 print#pf,b1$;:return
  330. 2892 print#pf,b1$:return
  331. 2894 print#pf:return
  332. 2896 rem-jump to
  333. 2898 input"[147][153] start at record[158]? 1[157][157][157]";s:ifs>x or s<1then2898
  334. 2900 ifs=1thenreturn
  335. 2902 fori=1tos-1:print"[145] bypassing record #"str$(i)" of"str$(x)
  336. 2904 forn=1tof:input#5,rec$(n):nextn:gosub1618:ifet=8then1528
  337. 2906 nexti:return
  338. 2908 rem-report
  339. 2910 print"[153][147]report size[146] up to 136 character wide."
  340. 2912 print"modify printer for widths > 80 chrs."
  341. 2918 print"number of characters[158]?":print"?   [157][157][157]";pw:input"[145]";pw
  342. 2920 ifpw>136then2918
  343. 2922 print"[147][153]title format[146] up to 4 title lines of"
  344. 2924 print"information at the top of the form."
  345. 2926 print"number of lines[158]?":print"?   [157][157][157]";nl:input"[145]";nl:ifnl>4then2926
  346. 2927 ifnl=0thentt$(1)=">":goto2936
  347. 2928 forj=1tonl:print"[153]title #";j:print"[158]? >  [157][157][157]";tt$(j)
  348. 2930 iflen(tt$(j))>37thenprint"[145]";
  349. 2932 input"[145]";tt$(j):iftt$(j)=""thentt$(j)=">"
  350. 2933 tt$(j)=left$(tt$(j),pw)
  351. 2934 nextj
  352. 2936 print"[147][153]column format[146] up to 16 columns with 2"
  353. 2937 print"spaces between columns"
  354. 2938 print"number of columns[158]?":print"?   [157][157][157]";nc:input"[145]";nc:ifnc>16then2938
  355. 2940 forj=1tonc:print"[153]position of column #";j:print"[158]?   [157][157][157]";pc(j)
  356. 2942 input"[145]";pc(j):nextj
  357. 2944 print"[147][153]heading format[146] column headings cannot"
  358. 2946 print"exceed width of columns:"
  359. 2948 forj=1tonc:print"[153]column[158]";j;"[153] heading[158]";
  360. 2950 ifj=ncthenprintpw-pc(j);:goto2954
  361. 2952 printpc(j+1)-2-pc(j);
  362. 2954 print"[153] characters wide"
  363. 2956 print"[158]? >  [157][157][157]";hc$(j):input"[145]";hc$(j):ifhc$(j)=""thenhc$(j)=">"
  364. 2958 nextj
  365. 2960 print"[147][153]choose which fields go under the columns"
  366. 2962 print"[145]enter 0[153][146] if additional fields are":print"not desired."
  367. 2964 forn=1tof:print"";n;"[146][153] ";f$(n):nextn
  368. 2966 forj=1tonc:print"";tab(25)"[153]column[158]";j;""
  369. 2968 forl=1to3:printtab(25)"[145][153]field[158]";l;" 0 [157][157]";rp$(j,l)
  370. 2970 printtab(32);"[145]";:inputrp$(j,l):nextl:nextj
  371. 2972 print"[147][153]do you wish to sum the data in column[158]"str$(nc)"[153]?"
  372. 2974 print"this column must only be formatted with"
  373. 2976 print"only one field. enter 1[153][146] (yes) or 0[153][146] (n0)"
  374. 2978 print"[158]?";z:input"[145]";z
  375. 2980 print"[147][153]do you wish to review your format and/or"
  376. 2982 print"make corrections?  press y[153][146] or n[158][146]"
  377. 2984 gosub1522
  378. 2986 ifa$="y"then2910
  379. 2988 ifa$="n"then2994
  380. 2990 goto2984
  381. 2992 rem-save report
  382. 2994 fl=2:print"[153] save report format[146]?     y[153][146] or n[158][146]"
  383. 2996 gosub1522
  384. 2998 ifa$="n"then3118
  385. 3000 ifa$="y"then3004
  386. 3002 goto2996
  387. 3004 print"[153]save under what file name[158]?":ifrf$=d$orrf$=""thenrf$=nf$
  388. 3006 print"  ";rf$:input"[145]";rf$:ifrf$=""then3118
  389. 3008 open15,8,15:print#15,"s0:rp] "+rf$:gosub1618:ifet=8then3118
  390. 3010 open5,8,5,"0:rp] "+rf$+",s,w":gosub1618:ifet=8then3118
  391. 3012 print#5,pw;cr$;nl;cr$;nc:gosub1618:ifet=8then3118
  392. 3014 forj=1tonl:iftt$(j)=""thentt$(j)=">"
  393. 3016 print#5,tt$(j):gosub1618:ifet=8then3118
  394. 3018 nextj
  395. 3020 fori=1tonc
  396. 3022 print#5,pc(i);cr$;hc$(i):gosub1618:ifet=8then3118
  397. 3024 forn=1to3
  398. 3026 print#5,rp$(i,n):gosub1618:ifet=8then3118
  399. 3028 nextn:nexti:print#5,str$(z);cr$;e$:gosub1618:ifet=8then3118
  400. 3030 close5:close15:goto3118
  401. 3032 rem-labels
  402. 3034 print"[158][147]              label format             "
  403. 3036 print"[153]this format uses 1 to 4 across labels.
  404. 3038 [153]"each label contains up tosys"t%[171]1"print rows.
  405. 3040 print"each row can consist of 1 to 3 fields.
  406. 3042 [153]"if the length of multiple items exceeds
  407. 3044 print"[157][158]"lw"[153]characters, some data will be cutoff"
  408. 3046 print"[153]number of rows[158]?":print"?   [157][157][157]";rw:input"[145]";rw
  409. 3048 ifrw>t%-1thenprint"[145][145][145]":goto3046
  410. 3050 ifrw=0then3118
  411. 3052 print"[147][153]choose which fields go in each row"
  412. 3054 print"enter 0[153][146] if additional fields are":print"not desired."
  413. 3056 forn=1tof:print"";n;"[153][146] ";f$(n):nextn
  414. 3058 for j=1torw:print"";tab(25)"[153]row[158]";j;""
  415. 3060 forl=1to3:printtab(25)"[145][153]field[158]";l;" 0 [157][157]";ml$(j,l)
  416. 3062 printtab(32);"[145]";:inputml$(j,l)
  417. 3064 nextl
  418. 3066 nextj
  419. 3068 print"[147][153]do you wish to review your format and/or"
  420. 3070 print"make corrections?  press y[146][153] or n[158][146]"
  421. 3072 gosub1522
  422. 3074 ifa$="y"then3034
  423. 3076 ifa$="n"then3082
  424. 3078 goto3072
  425. 3080 rem-save label
  426. 3082 fl=3:print"[153]save label format[146]?       y[153][146] or n[158][146]"
  427. 3084 gosub1522
  428. 3086 ifa$="n"then3118
  429. 3088 ifa$="y"then3092
  430. 3090 goto3084
  431. 3092 print"[153]save under what file name[158]?":ifmf$=d$ormf$=""thenmf$=nf$
  432. 3094 print"  ";mf$:input"[145]";mf$:ifmf$=""then3118
  433. 3096 open15,8,15:print#15,"s0:ml] "+mf$:gosub1618:ifet=8then3118
  434. 3098 open5,8,5,"0:ml] "+mf$+",s,w":gosub1618:ifet=8then3118
  435. 3100 print#5,rw
  436. 3102 fori=1torw:forn=1to3
  437. 3104 print#5,ml$(i,n):gosub1618:ifet=8then3118
  438. 3106 nextn:nexti
  439. 3110 print#5,"eof":gosub1618:ifet=8then3118
  440. 3112 close5:close15
  441. 3116 rem-print options
  442. 3118 print"[158][147]          print options menu         "
  443. 3119 print"[153] current record file: [158]"nf$
  444. 3120 print"[153] current format file: [158]";:ifk=2thenprintrf$;:goto3122
  445. 3121 ifk=3thenprintmf$;
  446. 3122 print:printtab(7)"l[153][146]oad old format"
  447. 3123 printtab(7)"c[153][146]reate/change format"
  448. 3124 printtab(7)"s[153][146]ave current format"
  449. 3125 printtab(7)"p[153][146]rint records"
  450. 3126 printtab(7)"$[153][146] disk directory 4[153][146]"
  451. 3128 printtab(7)"e[153][146]xit"
  452. 3130 gosub1521
  453. 3132 gosub1522
  454. 3134 ifa$="l"thenonkgoto3132,1668,1704
  455. 3136 ifa$="s"thenonkgoto3132,3004,3092
  456. 3138 ifa$="c"thenonkgoto3132,2910,3034
  457. 3140 ifa$="4"ora$="$"thengosub1628:goto3118
  458. 3141 ifa$="p"then1730
  459. 3142 ifa$="e"then1584
  460. 3144 gosub602:goto3132
  461. 3146 rem-right justify
  462. 3148 d=2:clm$=str$(int(val(clm$)*10^2+.5))
  463. 3150 ifleft$(clm$,1)=" "thenclm$=mid$(clm$,d)
  464. 3152 ifd>len(clm$)thenclm$=right$("00000000"+clm$,d)
  465. 3154 ifdthenclm$=left$(clm$,len(clm$)-d)+"."+right$(clm$,d)
  466. 3156 iflen(clm$)<cwthenclm$=right$(s$+clm$,cw)
  467. 3158 iflen(clm$)>cwthenclm$=left$(clm$,cw)
  468. 3160 print#pf,clm$;:return
  469.