home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun: Productivity Pak 1 / rerun-productivity-pak-i.d64 / dfprint (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  10KB  |  313 lines
  1. 1500 rem dfprint 1.2 for datafile by mike konshak (c)1985
  2. 1502 clr:print"[147][158]":poke53281,11:poke53280,6:open4,4:rem    gosub2856
  3. 1504 d$=chr$(0):s=0:pw=80:cw=0:b$=chr$(32):rw=5:lw=32:fl=0
  4. 1506 nc=0:nl=0:pg=0:f1=0:f2=0:f3=0:l$=d$:rl=0:sb$=d$:cr$=chr$(13):hn$=d$:id$=d$
  5. 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"
  6. 1510 en=0:em$=d$:et=0:es=0:a1$=d$:a2$=d$:a3$=d$
  7. 1512 rem----dimension arrays
  8. 1514 dim ml$(9,4),pc(10),tt$(5),hc$(9)
  9. 1516 dim f$(31),t%(31),l%(31),rec$(31)
  10. 1518 goto1530
  11. 1520 rem----get
  12. 1522 geta$:ifa$=""then1522
  13. 1524 return
  14. 1526 rem----start menu
  15. 1528 print"[147]          datafile fast print          ":goto1548
  16. 1530 print"[147]      datafile fast print - rev 1.2    "
  17. 1532 print"         by mike konshak (c)1985       "
  18. 1534 print" this program will print a sequential"
  19. 1536 print" file, which was previously written"
  20. 1538 print" and formatted by datafile[146], directly"
  21. 1540 print" to the printer.  the order of the"
  22. 1542 print" records will be the same as the most"
  23. 1544 print" recent sort as written in the current"
  24. 1546 print" file.":print" press any key[146] to continue"
  25. 1547 gosub1522:gosub2856:goto1528
  26. 1548 print"       o[146]pen file on disk"
  27. 1550 iffl<>0thenprint"       r[146]epeat file:[146]";nf$
  28. 1551 print"       p[146]rinter reconfigure"
  29. 1552 print"       $[146] disk directory"
  30. 1554 print"       q[146]uit program"
  31. 1556 print"       press the appropriate key       "
  32. 1558 gosub1522:ifa$="$"then1628
  33. 1560 ifa$="o"thenfl=1:goto1572
  34. 1561 ifa$="p"thengosub2856:goto1528
  35. 1562 ifa$="r"then1584
  36. 1564 ifa$="q"thenclose5:close15:close4:end
  37. 1566 goto1558
  38. 1568 rem --input file name
  39. 1572 print" enter name of datafile to be read"
  40. 1574 print"   ";nf$:input"[145] ";nf$:ifnf$=""then1528
  41. 1576 open15,8,15
  42. 1578 open5,8,5,"0:df] "+nf$+",s,r":gosub1618:ifen=62thengosub1620:goto1528
  43. 1580 close5:close15
  44. 1582 rem----print records menu
  45. 1584 print"[147]         record printout menu          "
  46. 1586 print"      l[146]ist unformatted"
  47. 1588 print"      r[146]eport format"
  48. 1590 print"      m[146]ailing labels"
  49. 1592 print"      c[146]hange label size"
  50. 1594 print"      p[146]rinter reconfigure"
  51. 1596 print"      e[146]xit to restart"
  52. 1598 print"       press the appropriate key       "
  53. 1600 gosub1522:ifa$="" then1600
  54. 1602 ifa$="l"thenk=1:goto1730
  55. 1604 ifa$="r"thenk=2:goto1668
  56. 1606 ifa$="e"then1528
  57. 1608 ifa$="m"thenk=3:goto1704
  58. 1610 ifa$="c"then1940
  59. 1612 ifa$="p"thengosub2856:goto1584
  60. 1614 goto1600
  61. 1616 rem--disk error
  62. 1618 input#15,en,em$,et,es:if(en<20)or(en=62)thenet=0:return
  63. 1620 print" [150]disk error[146]"en"[157], "em$","et"[157],"es"[158]":et=8
  64. 1622 print" press any key[146] to restart program"
  65. 1624 gosub1522:close5:close15:return
  66. 1626 rem--directory
  67. 1628 open15,8,15:open5,8,0,"$0":print"[147]":gosub1618:ifet=8then1528
  68. 1630 get#5,a1$,a2$
  69. 1632 get#5,a1$,a2$
  70. 1634 get#5,a1$,a2$
  71. 1636 ifa1$<>""thena0=asc(a1$)
  72. 1638 ifa2$<>""thena0=a0+asc(a2$)*256
  73. 1640 printmid$(str$(a0),2);tab(3);
  74. 1642 get#5,a2$:ifst<>0then1660
  75. 1644 ifa2$<>chr$(34)then1642
  76. 1646 get#5,a2$:ifa2$<>chr$(34)thenprint""a2$"[146]";:goto1646
  77. 1648 get#5,a2$:ifa2$=chr$(32)then1648
  78. 1650 printtab(20);:a3$=""
  79. 1652 a3$=a3$+a2$:get#5,a2$:ifa2$<>""then1652
  80. 1654 printleft$(a3$,3)
  81. 1656 geta$:ifa$<>""thengosub1664
  82. 1658 ifst=0then1632
  83. 1660 print" blocks free";:a0=0
  84. 1662 close5:close15:printtab(25)"press any key[146]":gosub1522:goto1528
  85. 1664 gosub1522:return
  86. 1666 rem----load report format
  87. 1668 print" name of report format file?"
  88. 1670 print"   ";nf$:input"[145] ";rf$:ifrf$=""then1528
  89. 1672 open15,8,15:open5,8,5,"0:rp] "+rf$+",s,r":gosub1618:ifet=8then1528
  90. 1674 ifen=62thengosub1620:goto1528
  91. 1676 input#5,pw,nl,nc:gosub1618:ifet=8then1528
  92. 1678 forj=1tonl
  93. 1680 input#5,tt$(j):gosub1618:ifet=8then1528
  94. 1682 nextj
  95. 1684 fori=1tonc
  96. 1686 input#5,pc(i),hc$(i):gosub1618:ifet=8then1528
  97. 1688 forn=1to3
  98. 1690 input#5,ml$(i,n):gosub1618:ifet=8then1528
  99. 1692 nextn:nexti:input#5,a1$:z=val(a1$)
  100. 1694 s=st:ifs<>0then1698
  101. 1696 input#5,e$
  102. 1698 close5:close15
  103. 1700 goto1730
  104. 1702 rem-----load mailing label format
  105. 1704 print" name of mailing label format file?"
  106. 1706 print"   ";nf$:input"[145] ";mf$:ifmf$=""then1528
  107. 1708 open15,8,15:open5,8,5,"0:ml] "+mf$+",s,r":gosub1618:ifet=8then1528
  108. 1710 ifen=62thengosub1620:goto1528
  109. 1712 input#5,rw
  110. 1714 fori=1torw:forn=1to3
  111. 1716 input#5,ml$(i,n):gosub1618:ifet=8then1528
  112. 1718 nextn
  113. 1720 nexti
  114. 1722 s=st:ifs<>0then1726
  115. 1724 input#5,e$
  116. 1726 close5:close15
  117. 1728 rem--open datafile channel
  118. 1730 open15,8,15:open5,8,5,"0:df] "+nf$+",s,r":gosub1618:ifet=8then1528
  119. 1732 ifen=62thengosub1620:goto1528
  120. 1734 input#5,r,f,x:gosub1618:ifet=8then1528
  121. 1738 forn=1tof:input#5,f$(n),l%(n):nextn:gosub1618:ifet=8then1528
  122. 1740 rem----search routines menu
  123. 1742 a0=0:print"[147]            print options menu        "
  124. 1743 print" there are "x"[146]records in "nf$
  125. 1744 print"    a[146]ll records in file
  126. 1746 [153]"    fwaitind records with common fields
  127. 1748 ifk=3thenprint"    t[146]est label(s)"
  128. 1750 print"    e[146]xit back to start"
  129. 1752 ifk=2thenprint"position paper in printer at top of page"
  130. 1754 print"       press the appropriate key       "
  131. 1756 getc$:ifc$="" then1756
  132. 1758 ifc$="a"then1806
  133. 1762 ifc$="t"then1918
  134. 1764 ifc$="f"then1772
  135. 1766 ifc$="e"thenclose5:close15:goto1584
  136. 1768 goto1756
  137. 1770 rem----find record (search)
  138. 1772 print"[147]     find records with common items    "
  139. 1774 forn=1tof:print" ";n;"[146] ";f$(n):nextn
  140. 1776 input" which field is to be searched";sf
  141. 1778 ifsf<0orsf>fthenprint"[145][145][145]":goto1776
  142. 1780 print" enter common item[146] ":print" (the entire string is not required)"
  143. 1782 print" ";f$(sf);"[146] ";:inputt$
  144. 1784 ifk=2thengosub1838:gosub1852
  145. 1786 fori=1tox
  146. 1788 print" searching record";i;"[145][145]"
  147. 1790 forn=1tof:input#5,rec$(n):ifrec$(n)=">"thenrec$(n)=" "
  148. 1791 nextn:gosub1618:ifet=8then1528
  149. 1792 ift$=left$(rec$(sf),len(t$))thenonkgosub1826,1870,1928
  150. 1794 ifk=2thengosub1904
  151. 1796 nexti
  152. 1798 close5:close15
  153. 1800 ifk=2then1906
  154. 1802 goto1730
  155. 1804 rem----print all records
  156. 1806 gosub2898:pg=0:print"[147] printing heading":ifk=2thengosub1838:gosub1852
  157. 1808 fori=stox:print"[145] reading record #"str$(i)" of"str$(x)
  158. 1810 forn=1tof:input#5,rec$(n):ifrec$(n)=">"thenrec$(n)=" "
  159. 1811 nextn:gosub1618:ifet=8then1528
  160. 1812 onkgosub1826,1870,1928
  161. 1814 ifk=2thengosub1904
  162. 1816 nexti
  163. 1818 close5:close15
  164. 1820 ifk=2then1906
  165. 1822 goto1730
  166. 1824 rem----print nonformatted listing
  167. 1826 print#4,"[ record #";i;"   ]";:forj=1to62:print#4,"-";:nextj:gosub2888
  168. 1828 pg=pg+1:forn=1tof
  169. 1830 print#4,f$(n);:forj=1to20-len(f$(n)):print#4,".";:nextj
  170. 1831 ifrec$(n)=">"thenrec$(n)=" "
  171. 1832 print#4,rec$(n):pg=pg+1:nextn:gosub2888:pg=pg+1
  172. 1834 ifpg+f<=60thenreturn
  173. 1835 forj=1to66-pg:gosub2888:nextj:pg=0:return
  174. 1836 rem----print report
  175. 1838 pg=0:s$="":forj=1topw:s$=s$+b$:nextj
  176. 1840 forj=1tonl:iftt$(j)<>">"thengosub1846
  177. 1842 nextj:return
  178. 1844 rem----center title
  179. 1846 b=int((pw-len(tt$(j)))/2):ifp<>1then1849
  180. 1848 print#4,left$(s$,b)+tt$(j);b1$;:pg=pg+1:return
  181. 1849 print#4,left$(s$,b)+tt$(j);b1$:pg=pg+1:return
  182. 1850 rem----position headings
  183. 1852 gosub1866:pc(nc+1)=pw+3:cw=pc(2)-2-pc(1):ifpc(1)>1then1856
  184. 1854 print#4,left$(hc$(1),cw);:goto1858
  185. 1856 print#4,left$(s$,pc(1)-1)+left$(hc$(1),cw);
  186. 1858 forj=2tonc:m=pc(j)-len(left$(hc$(j-1),pc(j)-2-pc(j-1)))-pc(j-1)
  187. 1860 print#4,left$(s$,m)+left$(hc$(j),pc(j+1)-2-pc(j));
  188. 1862 nextj:gosub2888:gosub1866:pg=pg+3:return
  189. 1864 rem----print dashed line
  190. 1866 forj=1topw:print#4,"-";:nextj:gosub2888:return
  191. 1868 rem----print report file data
  192. 1870 f1=val(ml$(1,1)):f2=val(ml$(1,2)):f3=val(ml$(1,3)):cw=pc(2)-2-pc(1)
  193. 1872 ifpc(1)>1then1878
  194. 1874 print#4,left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw);
  195. 1876 goto1882
  196. 1878 print#4,left$(s$,pc(1)-1);
  197. 1880 print#4,left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw);
  198. 1882 forj=2tonc:cw=pc(j)-2-pc(j-1)
  199. 1884 f1=val(ml$(j-1,1)):f2=val(ml$(j-1,2)):f3=val(ml$(j-1,3))
  200. 1886 m=len(left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw))
  201. 1888 m=pc(j)-m-pc(j-1):cw=pc(j+1)-2-pc(j)
  202. 1890 print#4,left$(s$,m);
  203. 1892 f1=val(ml$(j,1)):f2=val(ml$(j,2)):f3=val(ml$(j,3))
  204. 1894 print#4,left$(rec$(f1)+b$+rec$(f2)+b$+rec$(f3),cw);
  205. 1896 nextj:gosub2888:pg=pg+1
  206. 1898 ifpg=60thenforj=1to6:gosub2888:nextj:pg=0:gosub1852
  207. 1900 return
  208. 1902 rem----s