home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / utils / miscutil.zip / SLEEVE1.ZIP / SLEEVE.BAS
BASIC Source File  |  1987-08-02  |  11KB  |  208 lines
  1. 10  '***********************************
  2. 20  '**                               **
  3. 30  '**       SLEEVE / DIRECTORY      **
  4. 40  '**                               **
  5. 50  '**   (C) Copyright 1984, 1987    **
  6. 60  '**              by               **
  7. 70  '**       Glenn M. Dickson        **
  8. 80  '**        654 Gilpin St.         **
  9. 90  '**        Houston, Texas         **
  10. 100 '**             77034             **
  11. 110 '**        (713) 944-3937         **
  12. 120 '**  (Replies only if S.A.S.E.)   **
  13. 130 '***********************************
  14. 140 '  >>> IBM Proprinter Version  <<<
  15. 150 '***********************************
  16. 160 '*    This program will print the  *
  17. 170 '* disk directory and the outline  *
  18. 180 '* of a disk sleeve (jacket) on a  *
  19. 190 '* sheet of paper. Cut it out,     *
  20. 200 '* fold and glue. You have a disk  *
  21. 210 '* sleeve with the directory       *
  22. 220 '* printed on it. No more pieces   *
  23. 230 '* of paper to loose.              *
  24. 240 '***********************************
  25. 250 DEF SEG=0:POKE 1047,PEEK(1047) OR 64:DEF SEG
  26. 260 CLEAR:WIDTH 80:KEY OFF:CLS:WIDTH "LPT1:",255
  27. 270 DIM TB$(144),AB$(144),TT$(24)
  28. 280 INFO$=SPACE$(44)
  29. 290 FOR X=1 TO 44
  30. 300 READ BYTE$
  31. 310 MID$(INFO$,X,1)=CHR$(VAL("&H"+BYTE$))
  32. 320 NEXT X
  33. 330 '
  34. 340 HC=45:   'Horizontal printed character
  35. 350 VC=124:  'Vertical printed character
  36. 360 '
  37. 370 LOCATE 11,31:PRINT "DO YOU WANT COLOR?"
  38. 380 LOCATE 14,31:PRINT "( Yes ) or ( No )"
  39. 390 IN$=INKEY$:IF IN$=CHR$(13) THEN IN$="Y"
  40. 400 IF (IN$="Y") OR (IN$="y") THEN CLR=1 ELSE IF (IN$="N") OR (IN$="n") THEN CLR=0 ELSE 390
  41. 410 CLR=1
  42. 420 IF CLR THEN COLOR 2,0,0
  43. 430 CLS
  44. 440 T=16
  45. 450 R=6
  46. 460 LOCATE R,1
  47. 470 PRINT TAB(T)"▒▒▒▒▒▒▄ ▒▒▄     ▒▒▒▒▒▒▄ ▒▒▒▒▒▒▄ ▒▒▄   ▒▒▄ ▒▒▒▒▒▒▄"
  48. 480 PRINT TAB(T)"▒▒█▀▀▀▀ ▒▒█     ▒▒█▀▀▀▀ ▒▒█▀▀▀▀ ▒▒█   ▒▒█ ▒▒█▀▀▀▀"
  49. 490 PRINT TAB(T)"▒▒▒▒▒▒▄ ▒▒█     ▒▒▒▒▒▄  ▒▒▒▒▒▄  ▒▒█   ▒▒█ ▒▒▒▒▒▄ "
  50. 500 PRINT TAB(T)" ▀▀▀▒▒█ ▒▒█     ▒▒█▀▀▀  ▒▒█▀▀▀   ▒▒▄ ▒▒█▀ ▒▒█▀▀▀ "
  51. 510 PRINT TAB(T)"▒▒▒▒▒▒█ ▒▒▒▒▒▒▄ ▒▒▒▒▒▒▄ ▒▒▒▒▒▒▄    ▒▒█▀▀  ▒▒▒▒▒▒▄"
  52. 520 PRINT TAB(T)" ▀▀▀▀▀▀  ▀▀▀▀▀▀  ▀▀▀▀▀▀  ▀▀▀▀▀▀     ▀▀     ▀▀▀▀▀▀"
  53. 530 LOCATE R+7,25:PRINT"Version 1.0 for IBM Proprinter"
  54. 540 IF CLR THEN COLOR 6
  55. 550 LOCATE 21,24:PRINT "Press 'P' for Program Information"
  56. 560 IF CLR THEN COLOR 2
  57. 570 LOCATE 23,8:PRINT "(c) Copyright 1984, 1987 by Glenn M. Dickson, All Rights Reserved"
  58. 580 IF CLR THEN COLOR 6
  59. 590 LOCATE 25,28:PRINT "Press any key to continue";
  60. 600 IN$=INKEY$:IF IN$="" THEN 600
  61. 610 LOCATE ,28:PRINT "                         ";
  62. 620 IF IN$="P" OR IN$="p" THEN GOSUB 1830
  63. 630 '**************************** ENTER DATE ****************************
  64. 640 IF CLR THEN COLOR 14,1,1
  65. 650 CLS:LOCATE 2,10:PRINT "Enter the date:"
  66. 660 IF CLR THEN COLOR 7
  67. 670 LOCATE 3,25:PRINT "Type 'B' to leave blank":LOCATE 4,25:PRINT "Press 'ENTER' to use the system date"
  68. 680 IN$=INKEY$:IF IN$="" THEN 680
  69. 690 IF CLR THEN COLOR 15
  70. 700 IF IN$=CHR$(13) THEN FDATE$=LEFT$(DATE$,6)+RIGHT$(DATE$,2):LOCATE 2,27:PRINT FDATE$;:GOTO 730
  71. 710 IF (IN$="B") OR (IN$="b") THEN FDATE$="        ":LOCATE 2,27:PRINT "(blank)";
  72. 720 '**************************** SELECT DRIVE **************************
  73. 730 IF CLR THEN COLOR 14
  74. 740 LOCATE 6,10:PRINT "Drive A or B:"
  75. 750 IF CLR THEN COLOR 7
  76. 760 LOCATE 7,25:PRINT "Enter drive to read from, A or B"
  77. 770 IF CLR THEN COLOR 15
  78. 780 LOCATE 6,27
  79. 790 DR$=INKEY$:IF DR$="" THEN 790
  80. 800 IF DR$="A" OR DR$="a" THEN PRINT "A":DR=65:GOTO 830
  81. 810 IF DR$="B" OR DR$="b" THEN PRINT "B":DR=66 ELSE 780
  82. 820 '**************************** ENTER DISK NAME ***********************
  83. 830 IF CLR THEN COLOR 14
  84. 840 LOCATE 9,10:PRINT "Name of disk:"
  85. 850 IF CLR THEN COLOR 7
  86. 860 LOCATE 10,25:PRINT "19 characters maximum"
  87. 870 IF CLR THEN COLOR 15
  88. 880 LOCATE 9,27
  89. 890 LINE INPUT;"";DNAME$
  90. 900 IF LEN(DNAME$) > 19 THEN DNAME$=LEFT$(DNAME$,19):LOCATE 9,27:PRINT STRING$(53," ");:LOCATE ,27:PRINT DNAME$
  91. 910 IF LEN(DNAME$)=0 THEN LOCATE 9,27:PRINT "(blank)"
  92. 920 '**************************** ENTER DISK NUMBER *********************
  93. 930 IF CLR THEN COLOR 14
  94. 940 LOCATE 12,10:PRINT "Disk Number:"
  95. 950 IF CLR THEN COLOR 7
  96. 960 LOCATE 13,25:PRINT "8 characters maximum"
  97. 970 LOCATE 14,25:PRINT "Press 'ENTER' for blank"
  98. 980 IF CLR THEN COLOR 15
  99. 990 LOCATE 12,27
  100. 1000 LINE INPUT;"";DNUM$
  101. 1010 IF LEN(DNUM$)=0 THEN LOCATE 12,27:PRINT "(blank)"
  102. 1020 IF LEN(DNUM$) > 8 THEN DNUM$=LEFT$(DNUM$,8):LOCATE 12,27:PRINT STRING$(53," ");:LOCATE ,27:PRINT DNUM$
  103. 1030 IF LEN(DNUM$) < 8 THEN DNUM$=" "+DNUM$:GOTO 1030
  104. 1040 GOSUB 1680:DEF SEG=0
  105. 1050 '*************************** GET DISK DIRECTORY ********************
  106. 1060 IF CLR THEN COLOR 15,1,1
  107. 1070 CLS
  108. 1080 PRINT "READING DIRECTORY....."
  109. 1090 FSPEC$=DR$+":*.*"
  110. 1100 HEAD=1050:TAIL=1052:BUFFER=1054:C=0
  111. 1110 ON ERROR GOTO 1130
  112. 1120 FILES FSPEC$:ON ERROR GOTO 0:GOTO 1150
  113. 1130 IF CLR THEN COLOR 4,0,0
  114. 1140 BEEP:CLS:LOCATE 12,24:PRINT "Cannot read directory on drive "DR$:ON ERROR GOTO 0:END
  115. 1150 LOCATE 3,1:ROWS=0
  116. 1160 POKE HEAD,30:POKE TAIL,34:POKE BUFFER,0:POKE BUFFER+1,79:POKE BUFFER+2,13:POKE BUFFER+3,28
  117. 1170 LINE INPUT TT$(ROWS):IF TT$(ROWS)<>"" THEN ROWS=ROWS+1:GOTO 1160
  118. 1180 ROWS=ROWS-1:FOR I=0 TO ROWS:FOR J=0 TO 3
  119. 1190 T$=MID$(TT$(I),J*18+1,12)
  120. 1200 IF T$<>"" THEN TB$(C)=T$:C=C+1
  121. 1210 NEXT J:NEXT I:ERASE TT$:DEF SEG
  122. 1220 IF C>135 THEN GOSUB 1770:' Too many files
  123. 1230 '*************************** SORT ROUTINE **************************
  124. 1240 IF CLR THEN COLOR 14
  125. 1250 LOCATE 24,22:PRINT "Do you want a sorted listing ? [Y/N]";
  126. 1260 AN$=INKEY$:IF AN$="" THEN 1260
  127. 1270 IF AN$="N" OR AN$="n" THEN 1340
  128. 1280 CLS:PRINT "Sorting Directory....."
  129. 1290 Z$=CHR$(255):E=1
  130. 1300 FOR A=0 TO C-1:C$=Z$:FOR B=0 TO C-1:IF C$<TB$(B) THEN 1320
  131. 1310 C$=TB$(B):D=B
  132. 1320 NEXT:AB$(E)=C$:E=E+1:TB$(D)=Z$:NEXT
  133. 1330 '*************************** PRINT ROUTINE *************************
  134. 1340 CLS:PRINT "Printing Sleeve.....":KT=0:SK=1:Z=21:Y=0
  135. 1350 LPRINT CHR$(27)"0";CHR$(15);CHR$(27)"U""1":'Set 8 LPI & Condensed (17.1 CPI)
  136. 1360 LPRINT TAB(15);"F";TAB(110);"F":LPRINT "C";TAB(15);"O";TAB(110);"O";TAB(124);"C":LPRINT "U"; TAB(15);"L";TAB(110);"L";TAB(124);"U":LPRINT "T";TAB(15);"D";TAB(110);"D";TAB(124);"T"
  137. 1370 LPRINT CHR$(VC);STRING$(122,CHR$(HC));CHR$(VC);"CUT":KT=KT+1
  138. 1380 LPRINT CHR$(VC);TAB(15);CHR$(VC);TAB(20);DNAME$;TAB(60);FDATE$;TAB(97);DNUM$;TAB(110);CHR$(VC);TAB(124);CHR$(VC):KT=KT+1
  139. 1390 LPRINT CHR$(VC);TAB(15);CHR$(VC);STRING$(94,CHR$(HC));CHR$(VC);TAB(124);CHR$(VC):KT=KT+1
  140. 1400 LPRINT CHR$(VC);TAB(15);CHR$(VC);TAB(19);C;"Files";TAB(85);
  141. 1410 LPRINT USING "#,###,### bytes free";BYTES%*SECTORS%*CLUSTERS%;
  142. 1420 LPRINT TAB(110);CHR$(VC);TAB(124);CHR$(VC):KT=KT+1
  143. 1430 LPRINT CHR$(VC);TAB(15);CHR$(VC);STRING$(94,CHR$(HC));CHR$(VC);TAB(124);CHR$(VC):KT=KT+1
  144. 1440 FOR W=1 TO C
  145. 1450 IF Y=0 THEN LPRINT CHR$(VC);TAB(15);CHR$(VC);TAB(Z);AB$(W); ELSE IF Y=1 THEN LPRINT TAB(Z);AB$(W);
  146. 1460 Y=1:Z=Z+18:IF Z>100 THEN Y=0:LPRINT TAB(110);CHR$(VC);TAB(124);CHR$(VC):Z=21:KT=KT+1
  147. 1470 NEXT W
  148. 1480 IF Z>22 THEN LPRINT TAB(110);CHR$(VC);TAB(124);CHR$(VC):KT=KT+1
  149. 1490 FOR L=KT TO 30
  150. 1500 LPRINT CHR$(VC);TAB(15);CHR$(VC);TAB(110);CHR$(VC);TAB(124);CHR$(VC)
  151. 1510 NEXT L
  152. 1520 LPRINT CHR$(VC);STRING$(13,CHR$(HC));CHR$(VC);TAB(110);CHR$(VC);STRING$(13,CHR$(HC));CHR$(VC);"CUT"
  153. 1530 LPRINT TAB(11);"FOLD";CHR$(VC);STRING$(94,CHR$(HC));CHR$(VC);"FOLD"
  154. 1540 FOR L=1 TO 37
  155. 1550 LPRINT TAB(15);CHR$(VC);TAB(110);CHR$(VC)
  156. 1560 NEXT L
  157. 1570 LPRINT TAB(12);"CUT";CHR$(VC);STRING$(94,CHR$(HC));CHR$(VC);"CUT"
  158. 1580 LPRINT TAB(15);"C";TAB(110);"C":LPRINT TAB(15);"U";TAB(110);"U":LPRINT TAB(15);"T";TAB(110);"T"
  159. 1590 FOR L=1 TO 9:LPRINT:NEXT L
  160. 1600 IF CLR THEN COLOR 14
  161. 1610 CLS
  162. 1620 LOCATE 11,25:PRINT"MAKE ANOTHER SLEEVE OR QUIT ?"
  163. 1630 LOCATE 13,30:PRINT "[A]nother or [Q]uit"
  164. 1640 AN$=INKEY$:IF AN$="" THEN 1640
  165. 1650 IF AN$="a" OR AN$="A" THEN CLS:GOTO 830
  166. 1660 IF AN$="q" OR AN$="Q" THEN CLS:END ELSE 1640
  167. 1670 '*************************** FREESPACE ROUTINE *********************
  168. 1680 DRIVE%=DR:BYTES%=0:SECTORS%=0:CLUSTERS%=0:TOTAL%=0
  169. 1690 XX=VARPTR(INFO$)
  170. 1700 DISKINFO=PEEK(XX+1) + 256 * PEEK(XX+2)
  171. 1710 CALL DISKINFO(DRIVE%,BYTES%,SECTORS%,CLUSTERS%,TOTAL%)
  172. 1720 RETURN
  173. 1730 DATA 55,89,E5,8B,76,0E,8B,14,80,FA,00
  174. 1740 DATA 74,03,80,EA,40,B4,36,CD,21,8B,76
  175. 1750 DATA 0C,89,0C,8B,76,0A,89,04,8B,76,08
  176. 1760 DATA 89,1C,8B,76,06,89,14,5D,CA,0A,00
  177. 1770 IF CLR THEN COLOR 12,0,0
  178. 1780 CLS:LOCATE 12,19:PRINT "You have"C"files.  I will print 135 of them."
  179. 1790 LOCATE 25,28:PRINT "Press any key to continue";
  180. 1800 IF INKEY$="" THEN 1800 ELSE LOCATE ,28:PRINT "                         ";
  181. 1810 RETURN
  182. 1820 '*************************** PROGRAM INFO **************************
  183. 1830 IF CLR THEN COLOR 15,1,1
  184. 1840 CLS
  185. 1850 LOCATE 1,30:PRINT " SLEEVE / DIRECTORY "
  186. 1860 PRINT:PRINT TAB(29)"IBM Proprinter version"
  187. 1870 PRINT:PRINT "   This program will print the outline of a disk sleeve and then print the disk directory in the outline.  All you have to do is cut it out, fold, and glue or"
  188. 1880 PRINT "tape the flaps.  You will have a disk sleeve (jacket) with the directory printedon it.  No more pieces of paper to loose or get mixed up."
  189. 1890 PRINT:PRINT "   This program is hereby entered into the PUBLIC DOMAIN.  No one may charge    anything for the use or distribution of this program."
  190. 1900 PRINT:PRINT "Share this program with others.  If you modify and improve this program I would appreciate a copy of the modified version."
  191. 1910 PRINT:PRINT "   Since this program is being distributed via freeware and modifications to    the code will certainly result, I can make no claims as to the suitability of"
  192. 1920 PRINT "this program for use on any particular computer or printer.  There are no       warranties or claims, express or implied.  While I have made every effort to    insure that there are no bugs in this program, you use it entirely at your own"
  193. 1930 PRINT "risk.  This program is furnished 'AS IS'."
  194. 1940 GOSUB 2030
  195. 1950 CLS
  196. 1960 PRINT "   I originally wrote this program back in 1983 for use on the Radio Shack      Color Computer.  I decided it was time to rework it for use on IBM types."
  197. 1970 PRINT:PRINT"   The print routines are from the original program.  The disk free bytes       routine is from PC Magazine, December 23, 1986, page 264.  The routine to read  the disk directory is by Gregory Jackmond, address unknown."
  198. 1980 PRINT:PRINT "   Live long and prosper."
  199. 1990 PRINT:PRINT TAB(30)"Glenn M. Dickson"
  200. 2000 PRINT TAB(31)"654 Gilpin St."
  201. 2010 PRINT TAB(29)"Houston, TX, 77034"
  202. 2020 GOSUB 2030:RETURN
  203. 2030 IF CLR THEN COLOR 12
  204. 2040 LOCATE 25,27:PRINT "Press any key to continue";
  205. 2050 IN$=INKEY$:IF IN$="" THEN 2050 ELSE LOCATE 25,27:PRINT "                         ";
  206. 2060 IF CLR THEN COLOR 15
  207. 2070 RETURN
  208.