home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / hove / homelist.bas < prev    next >
BASIC Source File  |  1990-09-29  |  19KB  |  458 lines
  1. 10 '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2. 20 '
  3. 30 '                      HOMELIST    by Don Hammer
  4. 40 '
  5. 50 '                           Ver 1.0  10/84
  6. 60 '
  7. 70 '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  8. 80 '
  9. 90 '   Homelist was written to serve as an inventory program for the home.  It
  10. 100 '  is suggested that you inventory your belongings at least twice a year
  11. 110 '  and put a copy in your safety deposit box.  At the time of a fire or
  12. 120 '  theft, those records could be worth their weight in diamonds.
  13. 130 '
  14. 131 '**************************************************************************
  15. 132 '  ***** Disregard below - this program modified for generic MS-DOS *****
  16. 133 '  ******** To modify back for TIPC remove 'fixes' listed below *********
  17. 134 '**************************************************************************
  18. 140 '  This program was written for the TI Professional Computer and may be
  19. 150 '  modified for other MS-DOS computers by eliminating the graphic routines.
  20. 160 '  Hint:  Change color statements on lines 6120 and 6190.  Remove the first
  21. 170 '  ' on line 6230 to jump the graphics.  Remove the ' in line 3015 to jump
  22. 180 '  the printer check.
  23. 190 '
  24. 200 '  Note:  This program is set up for a maximum of 300 items per room.
  25. 210 '
  26. 220 '
  27. 230 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  28. 240 '
  29. 250 '
  30. 260 CLS:GOTO 6000
  31. 270 CLS:GOSUB 8000
  32. 280 CLS
  33. 290 OPEN "R",#1,FILE$,60
  34. 300 FIELD #1,3 AS EA$, 8 AS PD$, 20 AS DI$, 7 AS PR$, 7 AS TOT$
  35. 310 FIELD #1,5 AS R$,55 AS S$
  36. 320 GET #1,1
  37. 330 R=VAL(R$)
  38. 340 ROW=8:COL=29:ITEMS=6:OB=1:RESTORE 10010
  39. 350 COLOR 7,0:LOCATE 18,39-(LEN(ROOM$(II))/2):PRINT ROOM$(II);:COLOR 15,0
  40. 360 LOCATE 2,27:PRINT "What would you like to do?";:GOSUB 5000
  41. 370 ON BO GOTO 380,390,410,420,430,440
  42. 380 GOSUB 2000:GOTO 280
  43. 390 GOSUB 1000:GOTO 280
  44. 400 GOSUB 4000:GOTO 280
  45. 410 GOSUB 9000:GOTO 280
  46. 420 GOSUB 3000:GOTO 280
  47. 430 CLOSE:GOTO 270
  48. 440 GOTO 4380
  49. 1000 '-------------------------  Write a record  ----------------------------
  50. 1010 K=R:LNA=11:LNB=12:LNC=13:GOSUB 8500:COLOR 15,0
  51. 1020 LOCATE 5,20,0:PRINT "Press RETURN by itself to go to the menu.":LOCATE  14,1,0
  52. 1030 LD=0:CO=K+1:K=K-9:LNA=1:LNB=2:LNC=3
  53. 1040 IF K<=0 THEN PT=1:K=1
  54. 1050 V$(K)=""
  55. 1060 GET#1,K+1
  56. 1070 EA=VAL(EA$)
  57. 1080 PD1$=PD$
  58. 1090 DI1$=DI$
  59. 1100 PR=VAL(PR$)
  60. 1110 TOT=VAL(TOT$)
  61. 1120 IF CO=K+1 THEN COLOR 7,0 ELSE COLOR 15,0
  62. 1130 IF K=CO THEN 1150
  63. 1140 LD=LD+1:IF LD>20 THEN 1150 ELSE 1220
  64. 1150 COLOR 15,0:GOTO 1310
  65. 1160 COLOR 15,0
  66. 1170 ON INSTR("FfBbEeQq",IK$) GOTO 1190,1190
  67. 1180 SOUND 100,1:GOTO 1150
  68. 1190 CO=0:LD2=LD:LD=0
  69. 1200 IF PT=1 THEN LD=LD2:LOCATE CSRLIN,1,0:PT=0:GOTO 1060
  70. 1210 LOCATE 14,1,0:GOTO 1060
  71. 1220 IF K>R THEN 1260
  72. 1230 PRINT "#";K;"--"; TAB(9)EA TAB(21)PD$ TAB(36)DI$ TAB(62);USING U$;PR;:PRINT TAB(72);USING U$;TOT:COLOR 15,0
  73. 1240 K=K+1:GOTO 1060
  74. 1250 CLOSE:RETURN
  75. 1260 COLOR 7,0:PRINT BL$:PRINT TAB(40-(LEN(EF$)/2))EF$:COLOR 15,0
  76. 1270 FOR I=CSRLIN TO 23
  77. 1280 LOCATE I,1:PRINT BL$
  78. 1290 NEXT I
  79. 1300 GOTO 1150
  80. 1310 COLOR 7,0:LOCATE 25,1:PRINT "#";R+1 TAB(12)"ea" TAB(16)"Date:" TAB(31)"Item:" TAB(58)"Price:";:COLOR 15,0
  81. 1320 ROW=25:COL=10:LE=2:GOSUB 7000:EA=VAL(BB$):IF EA=0 THEN 1500
  82. 1330 COL=21:LE=8:GOSUB 7000:PD1$=BB$:IF FNDV%(PD1$,1) THEN 1340 ELSE GOSUB 11010:GOTO 1330
  83. 1340 COL=36:LE=20:GOSUB 7000:DI1$=(BB$)
  84. 1350 COL=64:LE=7:GOSUB 7000:PR=VAL(BB$):PR=FNRD#(PR)
  85. 1360 TOT=EA*PR
  86. 1370 COL=1
  87. 1380 LSET EA$=STR$(EA)
  88. 1390 LSET PD$=PD1$
  89. 1400 LSET DI$=DI1$
  90. 1410 LSET PR$=STR$(PR)
  91. 1420 LSET TOT$=STR$(TOT)
  92. 1430 R=R+1
  93. 1440 PUT #1,R+1
  94. 1450 LSET R$=STR$(R)
  95. 1460 LSET S$=" "
  96. 1470 PUT #1,1
  97. 1480 LOCATE 25,1,0:PRINT BL$
  98. 1490 LOCATE 14,1,0:GOTO 1030
  99. 1500 CLOSE:RETURN
  100. 2000 '------------------------  Retrieve data from file  -----------------------
  101. 2010 CLS:LD=0:LOCATE 10,23:COLOR 15:PRINT "Press RETURN to start at record #1":COLOR 7
  102. 2020 LOCATE 25,26:PRINT"Which record do you want? "
  103. 2030 ROW=25:COL=53:LE=3:GOSUB 7000:K=VAL(BB$)
  104. 2040 IF BB$="" THEN 2050 ELSE 2060
  105. 2050 K=1:LD=0:CO=19:GOTO 2080
  106. 2060 IF VAL(BB$)<18 THEN CO=K+1:K=1:GOTO 2080
  107. 2070 LD=0:CO=K+1:K=K-17
  108. 2080 GOSUB 8500:GOSUB 8580
  109. 2090 GET#1,K+1
  110. 2100 IF CSRLIN=4 THEN PTR=K
  111. 2110 EA=VAL(EA$)
  112. 2120 PD1$=PD$
  113. 2130 DI1$=DI$
  114. 2140 PR=VAL(PR$)
  115. 2150 TOT=VAL(TOT$)
  116. 2160 IF CO=K+1 THEN COLOR 7,0 ELSE COLOR 15,0
  117. 2170 IF K=CO THEN 2200
  118. 2180 LD=LD+1:IF LD>18 THEN 2190 ELSE 2270
  119. 2190 '
  120. 2200 IK$=INKEY$:IF IK$="" THEN 2200
  121. 2210 COLOR 15,0
  122. 2220 ON INSTR("FfBbEeQq",IK$) GOTO 2240,2240,2370,2370,400,400,2310,2310
  123. 2230 SOUND 100,1:GOTO 2200
  124. 2240 CO=0:LD2=LD:LD=0
  125. 2250 IF PT=1 THEN LD=LD2:LOCATE CSRLIN,1,0:PT=0:GOTO 2090
  126. 2260 LOCATE 4,1,0:GOTO 2090
  127. 2270 IF K>R THEN 2320
  128. 2280 PRINT "#";K;"--"; TAB(9)EA TAB(21)PD$ TAB(36)DI$ TAB(62);USING U$;PR;:PRINT TAB(72);USING U$;TOT:COLOR 15,0
  129. 2290 K=K+1:GOTO 2090
  130. 2300 CLOSE:RETURN
  131. 2310 CLOSE:GOTO 280
  132. 2320 COLOR 7,0:PRINT TAB(40-(LEN(EF$)/2))EF$:COLOR 15,0
  133. 2330 FOR I=CSRLIN TO 23
  134. 2340 LOCATE I,1:PRINT BL$
  135. 2350 NEXT I
  136. 2360 GOTO 2200
  137. 2370 '----- backward -----
  138. 2380 LD=0:CO=0:K=PTR-18:IF K<1 THEN K=1
  139. 2390 LOCATE 4,1,0:GOTO 2090
  140. 3000 '---------------------------  Print records  -----------------------------
  141. 3010 CLS:GTOT=0:LIN=6:HDG$=ROOM$(II)+"Inventory Report":K=1:PG=1
  142. 3015 GOTO 3065:'   <=====<< Jump TI printer checks
  143. 3020 WHILE INP(9)<>198
  144. 3030 LOCATE 10,6:COLOR 0,2
  145. 3040 PRINT "Please turn your printer on line  ------   or press any key to not print."
  146. 3050 IK$=INKEY$:IF IK$<>""THEN CLOSE:RETURN
  147. 3060 WEND
  148. 3065 COLOR 7,0:CLS:LOCATE 3,1:PRINT STRING$(80,205)
  149. 3070 COLOR 15,0:PRINT TAB(39-LEN(HDG$)/2)HDG$:COLOR 7,0
  150. 3075 PRINT STRING$(80,205)
  151. 3080 LPRINT STRING$(80,"*")
  152. 3085 LPRINT TAB(39-LEN(HDG$)/2)HDG$
  153. 3090 LPRINT STRING$(80,"*"):LPRINT
  154. 3100 LIN=LIN+4
  155. 3110 COLOR 15,0:GOSUB 3350
  156. 3120 GET #1,R
  157. 3130 WHILE K<R+1
  158. 3140 GET #1,K+1
  159. 3150 EA=VAL(EA$)
  160. 3160 PD1$=PD$
  161. 3170 DI1$=DI$
  162. 3180 PR=VAL(PR$)
  163. 3190 TOT=VAL(TOT$)
  164. 3200 GTOT=GTOT+TOT
  165. 3210 LOCATE 10,1
  166. 3220 IF LIN=62 THEN LPRINT:LPRINT:LPRINT TAB(36) "Pg#"PG:LPRINT CHR$(12);:LIN=6:GOSUB 3350:PG=PG+1
  167. 3230 PRINT "#";K;"--"; TAB(9)EA;"ea";TAB(21)PD$ TAB(36)DI$ TAB(62);USING U$;PR;:PRINT TAB(72);USING U$;TOT
  168. 3240 LPRINT "#";K;"--"; TAB(9)EA TAB(21)PD$ TAB(36)DI$ TAB(62);USING U$;PR;:LPRINT TAB(72);USING U$;TOT
  169. 3250 K=K+1:LIN=LIN+1
  170. 3260 WEND
  171. 3270 IF LIN <=59 THEN 3280
  172. 3272 WHILE LIN<>64
  173. 3274 LPRINT:LIN=LIN+1
  174. 3276 WEND
  175. 3278 LPRINT TAB(36) "Pg#"PG:LPRINT CHR$(12);:PG=PG+1:LIN=6
  176. 3280 LPRINT:LPRINT STRING$(80,196)
  177. 3290 LPRINT TAB(30) ROOM$(II);"Grand Total -----   ";:LPRINT TAB(67) USING "$$###,###.##";GTOT:LIN=LIN+3
  178. 3300 WHILE LIN < 64
  179. 3310 LPRINT:LIN=LIN+1
  180. 3320 WEND
  181. 3330 LPRINT TAB(36) "Pg#"PG
  182. 3340 CLOSE:LPRINT CHR$(12);:RETURN
  183. 3350 '------- Page heading --------
  184. 3355 COLOR 7,0
  185. 3360 LOCATE 8,1:PRINT "NO." TAB(9)"QUAN." TAB(23)"DATE" TAB(40)"DISCRIPTION" TAB(64)"PRICE" TAB(74)"FWD."
  186. 3370 LOCATE 9,1:PRINT "___" TAB(9)"_____" TAB(23)"____" TAB(40)"___________" TAB(64)"_____" TAB(74)"____"
  187. 3375 COLOR 15,0
  188. 3380 LPRINT "NO." TAB(9)"QUAN." TAB(23)"DATE" TAB(40)"DISCRIPTION" TAB(64)"PRICE" TAB(74)"FWD."
  189. 3390 LPRINT "___" TAB(9)"_____" TAB(23)"____" TAB(40)"___________" TAB(64)"_____" TAB(74)"____"
  190. 3400 LPRINT:LIN=LIN+3:RETURN
  191. 4000 '--------------------------   Modify a record    -------------------------
  192. 4010 CO=K
  193. 4020 LOCATE 25,1:PRINT BL$;
  194. 4030 LOCATE 25,20
  195. 4040 PRINT "Which record do you want to change?";:ROW=25:COL=56:LE=3:GOSUB 7000:K=VAL(BB$):IF K<1 THEN K=1
  196. 4050 FOR I=23 TO 25:LOCATE I,1:PRINT BL$;:NEXT I
  197. 4060 LOCATE 22,1:COLOR 7,0:PRINT STRING$(80,249):COLOR 15,0
  198. 4070 IF R<1 THEN R=1
  199. 4080 GET #1,R
  200. 4090 GET #1,K+1
  201. 4100 EA=VAL(EA$)
  202. 4110 PD1$=PD$
  203. 4120 DI1$=DI$
  204. 4130 PR=VAL(PR$)
  205. 4140 TOT=VAL(TOT$)
  206. 4150 LOCATE 23,1
  207. 4160 PRINT "#";K;"--"; TAB(9)EA TAB(21)PD$ TAB(36)DI$ TAB(62);USING U$;PR;:PRINT TAB(72);USING U$;TOT
  208. 4170 LOCATE 25,1:PRINT "#";K TAB(12)"ea" TAB(16)"Date:" TAB(31)"Item:" TAB(58)"Price:";
  209. 4180 ROW=25:COL=10:LE=2:GOSUB 7000:EA=VAL(BB$)
  210. 4190 COL=21:LE=8:GOSUB 7000:PD1$=BB$
  211. 4200 COL=36:LE=20:GOSUB 7000:DI1$=(BB$)
  212. 4210 COL=64:LE=7:GOSUB 7000:PR=VAL(BB$)
  213. 4220 TOT=EA*PR
  214. 4230 LOCATE 23,1
  215. 4240 PRINT "#";K;"--"; TAB(10)EA TAB(19)PD1$ TAB(36)DI1$ TAB(64);USING U$;PR;:PRINT TAB(72);USING U$;TOT
  216. 4250 LSET EA$=STR$(EA)
  217. 4260 LSET PD$=PD1$
  218. 4270 LSET DI$=DI1$
  219. 4280 LSET PR$=STR$(PR)
  220. 4290 LSET TOT$=STR$(TOT)
  221. 4300 PUT #1,K+1:GOSUB 4390
  222. 4310 LOCATE 25,1:PRINT BL$;:LOCATE 25,22
  223. 4320 PRINT "Any more records to change? (Y/N)  ";
  224. 4330 IK$=INKEY$:IF IK$="" THEN 4330
  225. 4340 ON INSTR("YyNn",IK$) GOTO 4360,4360,4370,4370
  226. 4350 SOUND 100,1:GOTO 4330
  227. 4360 GOTO 4020
  228. 4370 CLOSE:RETURN
  229. 4380 CLS:END
  230. 4390 '------------- rewrite the screen ----------------
  231. 4400 LOCATE 23,1:PRINT BL$;
  232. 4410 LOCATE 4,1,0:K=CO-18:IF K<1 THEN K=1
  233. 4420 GET#1,K+1
  234. 4430 EA=VAL(EA$)
  235. 4440 PD1$=PD$
  236. 4450 DI1$=DI$
  237. 4460 PR=VAL(PR$)
  238. 4470 TOT=VAL(TOT$)
  239. 4480 IF K=CO-2 THEN COLOR 15,0:RETURN
  240. 4490 COLOR 15,0:PRINT "#";K;"--"; TAB(9)EA TAB(21)PD$ TAB(36)DI$ TAB(62);USING U$;PR;:PRINT TAB(72);USING U$;TOT:COLOR 15,0
  241. 4500 K=K+1:GOTO 4420
  242. 5000 ' ------------------    Subroutine for menu selection    -----------------
  243. 5010 '
  244. 5020 GOSUB 5050
  245. 5030 IF ESCKEY=1 THEN CLS:COLOR 15,0:PRINT "Aborted choice":END
  246. 5040 CLS:COLOR 15,0:RETURN
  247. 5050 ESCKEY=0:BG=7:FG=0:LOCATE ROW,COL,0
  248. 5060 FOR I=1 TO ITEMS
  249. 5070 READ BB$(I):COLOR 15,0:PRINT TAB(COL);CHR$(16);"  ";:COLOR 15,0:PRINT BB$(I);
  250. 5080 NEXT
  251. 5090 GOSUB 7500
  252. 5100 LOCATE 24,15:COLOR 15,0:PRINT "Make selection with the arrow keys - Press return";
  253. 5110 BO=OB:GOSUB 5280
  254. 5120 X$="":WHILE LEN(X$)=0:X$=INKEY$:WEND
  255. 5130 IF ASC(X$)=13 THEN COLOR 7,0:RETURN
  256. 5140 IF ASC(X$)=27 THEN ESCKEY=1:COLOR 7,0:RETURN
  257. 5150 IF LEN(X$)<2 THEN SOUND 100,3:GOTO 5120
  258. 5160 IF ASC(MID$(X$,2,1))=72 THEN 5230
  259. 5170 IF ASC(MID$(X$,2,1))<>80 THEN SOUND 100,1:GOTO 5120
  260. 5180 OB=BO
  261. 5190 IF BO=ITEMS THEN BO=1 ELSE BO=BO+1
  262. 5200 SWAP BO,OB:GOSUB 5300
  263. 5210 SWAP BO,OB:GOSUB 5280
  264. 5220 GOTO 5120
  265. 5230 OB=BO
  266. 5240 IF BO=1 THEN BO=ITEMS ELSE BO=BO-1
  267. 5250 SWAP BO,OB:GOSUB 5300
  268. 5260 SWAP BO,OB:GOSUB 5280
  269. 5270 GOTO 5120
  270. 5280 COLOR FG,BG:LOCATE ROW+(BO-1),COL+3:PRINT BB$(BO);
  271. 5290 RETURN
  272. 5300 BG=0:FG=7:GOSUB 5280:BG=7:FG=0
  273. 5310 RETURN
  274. 6000 '------------------  Initializaion & introduction  ----------------------
  275. 6010 KEY OFF:COLOR 15,0:CLS:CLEAR:U$="####.##":BL$=STRING$(80," "):NUM$="1234567890"+CHR$(8)+CHR$(13)
  276. 6020 EF$=">>>>>>>>>>>>>>>>>>>>>>>>>>>>   END OF THE FILE   <<<<<<<<<<<<<<<<<<<<<<<<<<<<"
  277. 6030 Q$=CHR$(209):Z$=CHR$(205):LNA=1:LNB=2:LNC=3
  278. 6040 DEF FNQE%(A1$)=(ASC(MID$(A1$,1))<58) AND (ASC(MID$(A1$,1))>47) OR (ASC(MID$(A1$,1))=8) OR (ASC(MID$(A1$,1))=13)
  279. 6050 DEF FNQF%(A1$)=(ASC(MID$(A1$,1))<58) AND (ASC(MID$(A1$,1))>47) OR (ASC(MID$(A1$,1))=8) OR (ASC(MID$(A1$,1))=13) OR A1$="/" OR A1$="-"
  280. 6060 DEF FNQG%(A1$)=(ASC(MID$(A1$,1))<58) AND (ASC(MID$(A1$,1))>47) OR (ASC(MID$(A1$,1))=8) OR (ASC(MID$(A1$,1))=13) OR AA$="."
  281. 6070 DEF FNDV%(A1$,A2%)=(VAL(A1$)>0)AND(VAL(A1$)<13)AND(VAL(MID$(A1$,4))>0)AND(VAL(MID$(A1$,4))<32)AND(VAL(MID$(A1$,7))>=A2%)AND(LEN(A1$)=8) OR A1$="00/00/00"
  282. 6080 DEF FNRD#(A1#)=FIX((FIX(A1#*1000#)+SGN(A1#)*5)/10#)/100#
  283. 6090 MK$=CHR$(200)+STRING$(7,Z$)+Q$+Z$+Z$+Q$+STRING$(7,Z$)+Q$+STRING$(8,Z$)+Q$+STRING$(5,Z$)+Q$+STRING$(20,Z$)+Q$+STRING$(4,Z$)+Q$+STRING$(8,Z$)+Q$+STRING$(8,Z$)+Q$+CHR$(188)
  284. 6100 DIM V$(300), B(30), E(30), ROOM$(12), BB$(12):U$="####.##"
  285. 6110 RESTORE 10020:FOR II=1 TO 10:READ ROOM$(II):NEXT:RESTORE 10020
  286. 6120 COLOR 0,7
  287. 6130 FOR I=2 TO 23:LOCATE I,1
  288. 6140 PRINT CHR$(186);:LOCATE I,80
  289. 6150 PRINT CHR$(186);
  290. 6160 NEXT
  291. 6170 LOCATE 1,1:PRINT CHR$(201);STRING$(78,205);CHR$(187);
  292. 6180 LOCATE 24,1:PRINT CHR$(200);STRING$(78,205);CHR$(188);
  293. 6190 COLOR 15,0
  294. 6200 A$="H O M E L I S T":LOCATE 9,40-(LEN(A$)/2):PRINT A$;
  295. 6210 LOCATE 11,39:PRINT "by";:LOCATE 13,35:PRINT "Don Hammer";
  296. 6220 LOCATE 20,27:PRINT "For MS-DOS Personal Computers";
  297. 6230 GOTO 6380 '         <=======<< Jumps TI Graphics
  298. 6240 GOSUB 6260:GOTO 6390
  299. 6250 '----- TI Logo -----
  300. 6260 XO%=65:YO%=205:C%=2:B%=7:RESTORE 6260:GOSUB 6290:RETURN:DATA L,0,20,25,20,25,0,48,0,48,8,-1:DATA C,58,4,12,7,1.2,1.4:DATA C,82,34,30,24,.4,.6:DATA C,100,13,9,8,.9,1.4:DATA C,97,26,6,6,1.53,.4:DATA C,100,45,30,12,.55,1.14
  301. 6270 DATA C,75,26,38,24,1.1,1.47:DATA L,38,33,32,33,25,36,-1:DATA C,23,32,8,4,1,1.55:DATA C,27,20,27,13,1,1.33:DATA L,61,12,67,12,61,26,55,26,61,12,-1:DATA L,56,10,54,15,45,15,43,21,51,21,48,28,-1
  302. 6280 DATA L,74,10,72,15,79,15,77,21,69,21,66,28,71,28,-1:DATA C,59,29,12,6,1,2:DATA C,67,6,4,2,0,2:DATA P,60,40,P,60,20,P,67,6,E
  303. 6290 READ A$:IF A$<>"L" THEN 6330
  304. 6300 READ X1%,Y1%
  305. 6310 READ X2%:IF X2%=-1 THEN 6290
  306. 6320 READ Y2%:LINE(X1%+XO%,Y1%+YO%)-(X2%+XO%,Y2%+YO%),B%:X1%=X2%:Y1%=Y2%:GOTO 6310
  307. 6330 IF A$<>"C" THEN 6350
  308. 6340 READ X1%,Y1%,XR,YR,S,E:PI=3.14159:CIRCLE(X1%+XO%,Y1%+YO%),XR,B%,S*PI,E*PI,YR/XR:GOTO 6290
  309. 6350 IF A$<>"P" THEN 6370
  310. 6360 READ X1%,Y1%:PAINT(X1%+XO%,Y1%+YO%),C%,B%:GOTO 6290
  311. 6370 IF A$<>"E" THEN RETURN
  312. 6380 FOR DE=1 TO 2000:NEXT DE
  313. 6390 COLOR 15,0:GOTO 270
  314. 7000 '-------------------------    Sub for input   ----------------------------
  315. 7010 ' This routine needs ROW,COL & LE returns BB$
  316. 7020 BB$=""
  317. 7030 FOR X=1 TO LE
  318. 7040 BB$=BB$+CHR$(45)
  319. 7050 NEXT X
  320. 7060 PTR=1:AA$=" "
  321. 7070 COLOR 0,15:LOCATE ROW,COL
  322. 7080 PRINT BB$;
  323. 7090 WHILE (ASC(AA$)<>13)
  324. 7100 AA$=INPUT$(1)
  325. 7110 IF ASC(AA$)>96 AND ASC(AA$)<123 THEN AA$=CHR$(ASC(AA$)-32)
  326. 7120 IF COL=36 THEN 7170
  327. 7130 IF COL=10 THEN IF FNQE%(AA$) THEN 7170 ELSE GOSUB 11030:GOTO 7070
  328. 7140 IF COL=21 THEN IF FNQF%(AA$) THEN 7170 ELSE GOSUB 11010:GOTO 7070
  329. 7150 IF COL=53 THEN IF INSTR(NUM$,AA$) THEN 7170 ELSE GOSUB 11040:GOTO 7070
  330. 7160 IF COL=64 THEN IF FNQG%(AA$) THEN 7170 ELSE 7070
  331. 7170 IF (PTR>LE) AND (ASC(AA$)=13) THEN 7290
  332. 7180 IF (PTR>LE) AND (ASC(AA$)=8) THEN 7240
  333. 7190 IF (PTR>LE) THEN BEEP:GOTO 7290
  334. 7200 IF (ASC(AA$)>=32) THEN MID$(BB$,PTR,1)=AA$:PTR=PTR+1:GOTO 7270
  335. 7210 IF (PTR=1) AND (ASC(AA$)=8) THEN BEEP:GOTO 7270
  336. 7220 IF (ASC(AA$)<>8) THEN 7260
  337. 7230 MID$(BB$,PTR,1)=CHR$(45)
  338. 7240 MID$(BB$,PTR-1,1)=CHR$(45)
  339. 7250 PTR=PTR-1
  340. 7260 IF (ASC(AA$)=13) THEN BB$=MID$(BB$,1,PTR-1):PTR=LE+1
  341. 7270 LOCATE ROW,COL
  342. 7280 PRINT BB$
  343. 7290 WEND
  344. 7300 COLOR 15,0:RETURN
  345. 7500 '---------------------------   draw the box   ---------------------------
  346. 7510 FOR I=1 TO 20:LOCATE I,15
  347. 7520 PRINT CHR$(186);:LOCATE I,65
  348. 7530 PRINT CHR$(186);
  349. 7540 NEXT
  350. 7550 LOCATE 1,15:PRINT CHR$(201);STRING$(49,205);CHR$(187);
  351. 7560 LOCATE 20,15:PRINT CHR$(200);STRING$(49,205);CHR$(188);
  352. 7570 LOCATE 3,15:PRINT CHR$(199);STRING$(49,196);CHR$(182);
  353. 7580 RETURN
  354. 8000 '------------------------   Which room?  --------------------------------
  355. 8010 ROW=6:COL=30:ITEMS=11:OB=1:RESTORE 10020
  356. 8020 LOCATE 2,24:PRINT "Select room to process inventory":GOSUB 5000
  357. 8030 II=BO:BO$=STR$(BO)
  358. 8040 IF BO>=0 THEN BO$=RIGHT$(BO$,LEN(BO$)-1)
  359. 8050 IF BO=11 THEN 8070
  360. 8060 FILE$="data"+BO$+".fil":RETURN
  361. 8070 COLOR 15,0:END
  362. 8500 '----------------------------  Page heading  -----------------------------
  363. 8510 CLS:LOCATE LNB,1,0:PRINT TAB(9)"Quan." TAB(23)"Date" TAB(42)"Discription" TAB(64)"Price" TAB(74)"Fwd.";
  364. 8520 LOCATE LNB,1,0:COLOR 7,0
  365. 8530 PRINT CHR$(186);:LOCATE LNB,80,0
  366. 8540 PRINT CHR$(186);
  367. 8550 LOCATE LNA,1,0:PRINT CHR$(201);STRING$(78,205);CHR$(187);
  368. 8560 LOCATE LNC,1,0:PRINT MK$
  369. 8570 RETURN
  370. 8580 '------ Page end ------
  371. 8590 LOCATE 25,1,0:COLOR 0,7,:PRINT"       (F)orward     (B)ackward     (E)dit a file     (Q)uit this section      ";
  372. 8600 LOCATE 4,1,0
  373. 8610 COLOR 15,0:RETURN
  374. 9000 '---------------------------   SORT SETUP   -----------------------------
  375. 9010 ZK=1:K=1
  376. 9020 GET #1,1
  377. 9030 R=VAL(R$)
  378. 9040 COLOR 7,0:LOCATE 10,1:PRINT BL$:LOCATE 10,20,0:PRINT "--- Retrieving records for sorting ---"
  379. 9050 FOR I=1 TO R+1:V$(I)="":NEXT I
  380. 9060 WHILE K <> R+1
  381. 9070 GET #1,K+1
  382. 9080 EA1$=EA$
  383. 9090 PD1$=PD$
  384. 9100 DI1$=DI$
  385. 9110 PR1$=PR$
  386. 9120 TOT1$=TOT$
  387. 9130 IF VAL(EA$)=0 THEN K=K+1:GOTO 9070
  388. 9140 V$(ZK)=DI1$+EA1$+PD1$+PR1$+TOT1$
  389. 9150 ZK=ZK+1
  390. 9160 K=K+1
  391. 9170 WEND
  392. 9180 SN=K
  393. 9190 COLOR 7,0:LOCATE 10,1:PRINT BL$:LOCATE 10,27,0:PRINT "--- Sorting records ---"
  394. 9200 GOSUB 9250:GOSUB 9500:RETURN
  395. 9210 '--------  Singleton  sort ----------
  396. 9220 ' This routine needs items in V$(SN) & SN= number in array.
  397. 9230 ' also dim v$(n), b(30), e(30)
  398. 9240 '
  399. 9250 Z9$=CHR$(127):SL=1:SH=SN:SS=0:V$(0)="":V$(SN+1)=Z9$:GOTO 9360
  400. 9260 SJ=SJ-1
  401. 9270 IF SV$<V$(SJ) THEN 9260 ELSE IF SI>=SJ THEN 9310 ELSE V$(SI)=V$(SJ)
  402. 9280 SI=SI+1
  403. 9290 IF V$(SI)<SV$ THEN 9280
  404. 9300 IF SI<SJ THEN V$(SJ)=V$(SI):GOTO 9260 ELSE SI=SJ
  405. 9310 SWAP V$(SI),SV$:SS=SS+1
  406. 9320 IF SI-SL<SH-SI THEN B(SS)=SI+1:E(SS)=SH:SH=SI-1 ELSE B(SS)=SL:E(SS)=SI-1:SL=SI+1
  407. 9330 IF SL=SH-2 THEN 9430 ELSE IF SL<SH-2 THEN 9360
  408. 9340 IF V$(SL)>V$(SL+1) THEN SWAP V$(SL),V$(SL+1)
  409. 9350 SL=B(SS):SH=E(SS):SS=SS-1:IF SS>=0 THEN 9330 ELSE RETURN
  410. 9360 SI=SL:SJ=SH:SK=(SI+SJ)/2:SX$=V$(SI):SY$=V$(SK):SZ$=V$(SJ)
  411. 9370 IF SX$>=SY$ THEN 9390 ELSE IF SX$>=SZ$ THEN 9420
  412. 9380 IF SY$<SZ$ THEN 9410 ELSE GOTO 9400
  413. 9390 IF SX$>Z$ THEN IF SY$<=SZ$ THEN 9400 ELSE GOTO 9410 ELSE GOTO 9420
  414. 9400 SV$=SZ$:GOTO 9290
  415. 9410 SV$=SY$:V$(SK)=SZ$:GOTO 9290
  416. 9420 SV$=SX$:GOTO 9270
  417. 9430 SK=SL+1:SX$=V$(SL):SY$=V$(SK):SZ$=V$(SH)
  418. 9440 IF SX$>SY$ THEN 9470 ELSE IF SY$<=SZ$ THEN 9350
  419. 9450 V$(SH)=SY$:IF SX$>SZ$ THEN V$(SL)=SZ$:V$(SK)=SX$:GOTO 9350
  420. 9460 V$(SK)=SZ$:GOTO 9350
  421. 9470 IF SX$<=SZ$ THEN V$(SL)=SY$:V$(SK)=SX$:GOTO 9350
  422. 9480 V$(SH)=SX$:IF SY$<SZ$ THEN V$(SL)=SY$:V$(SK)=SZ$:GOTO 9350
  423. 9490 V$(SL)=SZ$:GOTO 9350
  424. 9500 '-------- write back to file --------
  425. 9510 COLOR 7,0:LOCATE 10,19,0:PRINT "--- Writing records back to the file ---":COLOR 15,0
  426. 9520 R=0
  427. 9530 FOR I=2 TO K+1
  428. 9540 SA$=V$(I)
  429. 9550 IF VAL(MID$(SA$,21,3))=0 THEN 9680
  430. 9560 DI1$=MID$(SA$,1,20)
  431. 9570 EA1$=MID$(SA$,21,3)
  432. 9580 PD1$=MID$(SA$,24,8)
  433. 9590 PR1$=MID$(SA$,32,7)
  434. 9600 TOT1$=MID$(SA$,39,7)
  435. 9610 LSET EA$=EA1$
  436. 9620 LSET PD$=PD1$
  437. 9630 LSET DI$=DI1$
  438. 9640 LSET PR$=PR1$
  439. 9650 LSET TOT$=TOT1$
  440. 9660 R=R+1
  441. 9670 PUT #1,R+1
  442. 9680 NEXT I
  443. 9690 LSET R$=STR$(R)
  444. 9700 LSET S$=" "
  445. 9710 PUT #1,1
  446. 9720 CLOSE:RETURN
  447. 10000 '-------------------------    DATA Items   ----------------------------
  448. 10010 DATA " View/Edit records "," Add a record "," Sort/Purge room file "," Print records "," Another room "," End this program "
  449. 10020 DATA " Living Room "," Dining Room "," Den "," Kitchen "," Bath/Linen "," Garage "," Bedroom #1 "," Bedroom #2 "," Bedroom #3 "," Bedroom #4 "," End this program "
  450. 11000 '-------------------------  Error messages  ----------------------------
  451. 11010 LOCATE 5,11,0:COLOR 15,0:PRINT "Date must be entered in the following format -- MM/DD/YY
  452. 11020 GOTO 11050
  453. 11030 LOCATE 5,12,0:COLOR 15,0:PRINT "This must be a two digit entry.  How many do you have?"
  454. 11040 LOCATE 5,20,0:COLOR 15,0:PRINT "Only numbers are allowed in this field.":GOTO 11050
  455. 11050 SOUND 100,1:FOR DE=1 TO 1200:NEXT DE:LOCATE 5,1:PRINT BL$
  456. 11060 RETURN
  457. 65000 '----------------------  End of the program  ----------------------------
  458.