home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / utilitys / 93 / labels / labelprt.bas next >
Encoding:
BASIC Source File  |  1987-10-12  |  8.1 KB  |  277 lines
  1. 100 option base 1 :' sets lower bound of arrays at zero or one
  2. 120 dim line1$(100),line2$(100),line3$(100),line4$(100),line5$(100)
  3. 140 fullw 2: clearw 2
  4. 160 color 1,3,3,2,2 : fill 0,0
  5. 180 tc=1:th=14:te=9 :wm=2
  6. 200 gosub set
  7. 220 gotoxy 10,1: ? "L A B E L P R T  vers 3.147 "
  8. 240 tc=2:th=12:te=1 :wm=3
  9. 260 gosub set
  10. 280 gotoxy 40,1:? "Gary Hilbert"
  11. 300 tc=2:th=9 :te=0 :wm=0
  12. 320 gosub set
  13. 340 gotoxy 10,5 :?  "leave messages on HelpKey II "
  14. 360 gotoxy 10,6 : ? "or on DELPHI leave mail for KAPTANMW"
  15. 380 th=9
  16. 400 gosub set
  17. 420 gotoxy 10,17:? "      much useful information from: "
  18. 440 gotoxy 10,18:? "James Luczak, ANALOG-June 1986--GEM stuff "
  19. 460 gotoxy 10,19:? "Mathew Spolin, ANALOG-November 1986--ALERT boxes"
  20. 480 gotoxy 10,20:? "COMPUTE's 1st Book of ATARI ST for file handling info"
  21. 500 gotoxy 10,22:? "     compiled with LDW Basic Compiler v1.0"
  22. 520 goto fini
  23. 1340 fini:
  24. 1360 tc=1:th=9:te=0:  ' normal settings
  25. 1380 gosub set
  26. 1400 for i = 1 to 1500: next i
  27. 1420 box$= "ok let's make labels"
  28. 1440 button$="continue|quit"
  29. 1460 icon=0:priority=1
  30. 1480 gosub boxform
  31. 1500 on keychoice goto disklabl,quitter
  32. 1540 disklabl:  '      COMPUTE 1st book of atarti ST  pg 155
  33. 1560 ' address list    this source program works with LDW compiler
  34. 1580 gosub initialize
  35. 1600 goto    readfile
  36. 1620 recovery:
  37. 1640 gosub enternames
  38. 1660 gosub printlist
  39. 1680 if c-1>recordsread then gosub writefile
  40. 1700 goto choice     : ' the setup routine for label printing
  41. 1720 '
  42. 1740 initialize:
  43. 1760 c=0
  44. 1780 fullw 2:clearw 2
  45. 1800 return
  46. 1820 '
  47. 1840 readfile:
  48. 1860 on error goto 2900
  49. 1880 open "I",#1,"labelprt.dat"
  50. 1900 rem                                    on error goto 0
  51. 1920 while not eof(1)
  52. 1940 c=c+1
  53. 1960 input #1, line1$(C),line2$(C),line3$(C),line4$(C),line5$(C)
  54. 1980 wend
  55. 2000 recordsread=c
  56. 2020 close #1
  57. 2040 retread:
  58. 2060 goto recovery
  59. 2080 '
  60. 2100 enternames:
  61. 2120 print  " enter   end   End    or    END  to quit inputting addresses"
  62. 2140 print "for MAIL or RETURN ADDRESS size            | dont pass this mark"
  63. 2150 print "for SPECIAL mode using 3 inch label stock             |"
  64. 2155 print "for SPECIAL mode using 3 1/2 inch label stock                 |"
  65. 2160 c=c+1
  66. 2180 input "line1:      ";line1$(c)
  67. 2200 if line1$(c)="END" or line1$(c)="end" or line1$(c)="End" then goto endent
  68. 2220 input "line2:      ";line2$(c)
  69. 2240 input "line3:      ";line3$(c)
  70. 2260 input "line4:      ";line4$(c)
  71. 2280 input "line5:      ";line5$(c)
  72. 2300 print
  73. 2320 goto enternames
  74. 2340 endent:
  75. 2360 return
  76. 2380 '
  77. 2400 writefile:
  78. 2420 open "O",#1,"labelprt.dat"
  79. 2440 for i=1 to c-1
  80. 2460 write #1,  line1$(i),line2$(i),line3$(i),line4$(i),line5$(i)
  81. 2480 next
  82. 2500 close #1
  83. 2520 print "the file  labelprt.dat  has been modified on your disk"
  84. 2540 print "press  any key to continue":keepontruckin=inp(2)
  85. 2560 return
  86. 2580 '
  87. 2600 printlist:
  88. 2620 clearw 2
  89. 2640 for i=1 to c
  90. 2660 if line1$(i)="END" or line1$(i)="end" or line1$(i)="End" then goto nxtrev
  91. 2680 print i,line1$(i)
  92. 2700 print i,line2$(i)
  93. 2720 print i,line3$(i)
  94. 2740 print i,line4$(i)
  95. 2760 print i,line5$(i)
  96. 2780 next
  97. 2800 nxtrev:
  98. 2820 print "hit   ANY  key to continue"
  99. 2840 keepontruckin=inp(2)
  100. 2860 return
  101. 2880 '
  102. 2900 errtrap:
  103. 2920 if err=53 then goto 2040
  104. 2940 if err=62 then goto 2000
  105. 2960 print "error # ";err; "in line ";erl
  106. 2980 end
  107. 3000 choice:
  108. 3020 clearw 2 :fullw 2
  109. 3040 color 1,3 : fill 0,0
  110. 3060 box$="WARNING if paper-out|detector disabled,|count repeats carefully"
  111. 3080 button$="continue|quit"
  112. 3100 icon=1:priority=1
  113. 3120 gosub boxform
  114. 3140 on keychoice goto poalert,quitter
  115. 3160 poalert:   rem this is the alert box
  116. 3180 box$="want to disable|printers paper-out|cutoff switch"
  117. 3200 button$="yes|no|quit"
  118. 3220 icon=2 :priority=2
  119. 3240 gosub boxform
  120. 3260 lprint chr$(27);chr$(64):rem re-initialize printer control codes
  121. 3280 on keychoice goto poyes,pono,quitter
  122. 3300 poyes:      lprint chr$(27);chr$(56)
  123. 3320 pono:
  124. 3340 clearw 2
  125. 3360 for i = 1 to c
  126. 3380 if line1$(i)="END" or line1$(i)="end" or line1$(i)="End" then goto nxtpr
  127. 3400 print i,line1$(i)
  128. 3420 if i=20 then goto  view
  129. 3421 if i=40 then goto  view
  130. 3422 if i=60 then goto  view
  131. 3423 if i=80 then goto  view
  132. 3445 goto dontview  
  133. 3450 view:  ' a crude "MORE?" facility with return to top of list capability
  134. 3460 print " remember the number you want...and hit  ANY key to continue"
  135. 3470 viewer=inp(2) 
  136. 3480 if viewer = 1 then goto pono   
  137. 3490 dontview:
  138. 3500 next
  139. 3520 nxtpr:
  140. 3620 picker:
  141. 3640 input "pick a number";pick
  142. 3660 input "enter number of repeats";num
  143. 3680 box$= "1 large MAIL label | 2 RETURN ADDRESS per label | the SPECIAL-- maximum  | characters @17/inch"
  144. 3700 button$="mail|retrnadr|special"
  145. 3720 icon=0:priority=1
  146. 3740 gosub boxform
  147. 3760 on keychoice goto twomail,fourreturn,special
  148. 3780 fourreturn:
  149. 3800 width lprint 66 
  150. 3820 lprint chr$(15):rem condensed
  151. 3840 lprint chr$(27);chr$(71):rem /dble-strike
  152. 3860 printrl:
  153. 3880 box$="adjust printer to|top of labels|CAUTION do not turn|printer off"
  154. 3900 button$="ok|quit"
  155. 3920 icon=3:priority=1
  156. 3940 gosub boxform
  157. 3960 on keychoice goto doitrl,quitter
  158. 3980 doitrl:
  159. 4000 for repeats=1 to num
  160. 4020 lprint
  161. 4040 x1$=line1$(pick)
  162. 4060 x2$=line2$(pick)
  163. 4080 x3$=line3$(pick)
  164. 4100 x4$=line4$(pick)
  165. 4120 x5$=line5$(pick)
  166. 4140 lprint x1$;tab(32);x1$
  167. 4160 lprint x2$;tab(32);x2$
  168. 4180 lprint x3$;tab(32);x3$
  169. 4200 lprint x4$;tab(32);x4$
  170. 4220 lprint x5$;tab(32);x5$
  171. 4240 next repeats
  172. 4260 goto choice
  173. 4280 twomail:
  174. 4300 width lprint 35   
  175. 4320 lprint chr$(18):rem pica          
  176. 4340 lprint chr$(27);chr$(71):rem /dble-strike
  177. 4360 printml:
  178. 4380 box$="adjust printer to|top of labels|CAUTION do not turn|printer off"
  179. 4400 button$="ok|quit"
  180. 4420 icon=3:priority=1
  181. 4440 gosub boxform
  182. 4460 on keychoice goto doitml,quitter
  183. 4480 doitml:
  184. 4500 for repeats=1 to num
  185. 4520 lprint
  186. 4540 x1$=line1$(pick)
  187. 4560 x2$=line2$(pick)
  188. 4580 x3$=line3$(pick)
  189. 4600 x4$=line4$(pick)
  190. 4620 x5$=line5$(pick)
  191. 4640 lprint x1$
  192. 4660 lprint x2$
  193. 4680 lprint x3$
  194. 4700 lprint x4$
  195. 4720 lprint x5$
  196. 4740 next repeats
  197. 4760 goto choice
  198. 4765 special:
  199. 4767 width lprint 66 
  200. 4769 lprint chr$(15):rem condensed
  201. 4771 lprint chr$(27);chr$(71):rem /dble-strike
  202. 4773 printspc:
  203. 4775 box$="adjust printer to|top of labels|CAUTION do not turn|printer off"
  204. 4779 button$="ok|quit"
  205. 4781 icon=3:priority=1
  206. 4783 gosub boxform
  207. 4785 on keychoice goto doitspc,quitter
  208. 4787 doitspc:
  209. 4789 for repeats=1 to num
  210. 4791 lprint
  211. 4793 x1$=line1$(pick)
  212. 4795 x2$=line2$(pick)
  213. 4797 x3$=line3$(pick)
  214. 4799 x4$=line4$(pick)
  215. 4800 x5$=line5$(pick)
  216. 4802 lprint x1$
  217. 4804 lprint x2$
  218. 4806 lprint x3$
  219. 4808 lprint x4$
  220. 4810 lprint x5$
  221. 4812 next repeats
  222. 4814 goto choice
  223. 5600 quitter:
  224. 5610 goto finish
  225. 5620 boxform:' Subroutine to make alert box
  226. 5640 BOX2$=STR$(icon)+"][|"+box$+"|]["+button$+"]"
  227. 5660 box$=box2$
  228. 5680 a#=gb:gintin=peek(A#+8):gintout=peek(A#+12)
  229. 5700 n#=peek(A#+16):poke gintin,priority
  230. 5720 ' poke n#,varptr(box2$) : ' for ST Basic
  231. 5740 ptsp#=varptr(box2$):strngaddr#=peek(ptsp#): 'for LDW compiler
  232. 5960 poke n#,strngaddr#: ' modified for LDW compiler
  233. 5980 gemsys(52):keychoice=peek(gintout)   
  234. 6000 return
  235. 6540 settings:
  236. 6560 set:
  237. 6580 poke contrl,22:'OPCODE
  238. 6600 poke contrl+2,0
  239. 6620 poke contrl+6,1
  240. 6640 poke intin,tc:'Text color index
  241. 6660 vdisys(1)
  242. 6680 poke contrl,106:'OPCODE
  243. 6700 poke contrl+2,0
  244. 6720 poke contrl+6,1
  245. 6740 poke intin,te:'Text effect word
  246. 6760 vdisys(1)
  247. 6780 ' theight
  248. 6800 poke contrl,12:'OPCODE
  249. 6820 poke contrl+2,1
  250. 6840 poke contrl+6,0
  251. 6860 poke ptsin,0
  252. 6880 poke ptsin+2,th:'Character height
  253. 6900 vdisys(1)
  254. 6920 charw=peek(ptsout):'Character width
  255. 6940 charh=peek(ptsout+2):'Character height
  256. 6960 cellw=peek(ptsout+4):'Cell width
  257. 6980 cellh=peek(ptsout+6):'Cell height
  258. 7000 ' THEIGHTP:
  259. 7020 poke contrl,107:'OPCODE
  260. 7040 poke contrl+2,0
  261. 7060 poke contrl+6,1
  262. 7080 poke intin,th:'Cell height
  263. 7100 vdisys(1)
  264. 7120 charw=peek(ptsout):'Character width
  265. 7140 charh=peek(ptsout+2):'Character height
  266. 7160 cellw=peek(ptsout+4):'Cell width
  267. 7180 cellh=peek(ptsout+6):'Cell height
  268. 7200 ' WMODE
  269. 7220 poke contrl,32:' OPCODE
  270. 7240 poke contrl+2,0
  271. 7260 poke contrl+6,1
  272. 7280 poke intin,wm: 'writing mode code
  273. 7300 vdisys(1)
  274. 7320 return
  275. 8020 finish:
  276. 8040 end
  277.