home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 100 / 23 / dunshop.bas < prev    next >
BASIC Source File  |  1985-03-24  |  12KB  |  292 lines
  1. 10 'DUNSHOP  THE SUPPLY SHOPPE - EQUIP CHARACTERS
  2. 20   SCREEN 3
  3. 30   KEY OFF
  4. 40      WIDTH 20
  5. 50      COLOR 1,4
  6. 60      CLS
  7. 70      LOCATE 4,1
  8. 80      PRINT "       THE"
  9. 90      LOCATE 7,1
  10. 100     PRINT "      SUPPLY"
  11. 110     LOCATE 10,1
  12. 120     PRINT "      SHOPPE"
  13. 130 'KILL TIME
  14. 140     SV.TIMER = TIMER+5
  15. 150     GOSUB 490 'OPEN FILES
  16. 160     IF TIMER < SV.TIMER THEN GOTO 160
  17. 170 'PRINT MENU
  18. 180     SCREEN 1
  19. 190     WIDTH 40
  20. 200     COLOR 4,1
  21. 210     CLS
  22. 220     LOCATE 3,1
  23. 230     PRINT "           THE SUPPLY SHOPPE"
  24. 240     PRINT
  25. 250     PRINT "    1. BUY SUPPLIES"
  26. 260     PRINT
  27. 270     PRINT "    2. SELL SUPPLIES"
  28. 280     PRINT
  29. 290     PRINT "    3. ADD A NEW ITEM TO THE STORE"
  30. 300     PRINT
  31. 310     PRINT "    4. CHANGE AN ITEM IN THE STORE"
  32. 320     PRINT
  33. 330     PRINT "    5. LIST SUPPLIES"
  34. 340     PRINT
  35. 350     PRINT "    9. END"
  36. 360     GOSUB 440 'GET REPLY
  37. 370     IF REPLY$ = "1" THEN GOSUB 590:  GOTO 170
  38. 380     IF REPLY$ = "2" THEN GOSUB 1150: GOTO 170
  39. 390      IF REPLY$ = "3" THEN GOSUB 1740: GOTO 170
  40. 400      IF REPLY$ = "4" THEN GOSUB 2380: GOTO 170
  41. 410     IF REPLY$ = "5" THEN GOSUB 2780: GOTO 170
  42. 420     IF REPLY$ ="9" THEN GOTO 2220
  43. 430     GOTO 170
  44. 440 'GET REPLY
  45. 450     DEF SEG=0: POKE 1050,PEEK(1052) 'CLEAR KEYBOARD BUFFER
  46. 460     REPLY$ = INKEY$
  47. 470     IF REPLY$ = "" THEN GOTO 460
  48. 480 RETURN
  49. 490 'OPEN FILES
  50. 500     OPEN "DUNCHAR" AS #1 LEN=122
  51. 510     FIELD #1,2 AS STRN$,2 AS INTL$,2 AS WIS$,2 AS DEX$,2 AS CON$,2 AS CHA$, 10 AS CLAS$,2 AS HIT$,4 AS MONEY$,2 AS LVL$,2 AS ARM$,2 AS SV.POISON$,2 AS SV.MAGIC$,2 AS SV.STONE$,2 AS SV.DRAG$,2 AS SV.SPELL$,4 AS EXPR$,24 AS NM$,7 AS ALIGN$,45 AS D$
  52. 520     OPEN "DUNSHOP" AS #2 LEN=44
  53. 530     FIELD #2,2 AS SID$,1 AS SCLASS$,15 AS SNAME$,2 AS SCOST$,2 AS SDAM$,2 AS SWT$,2 AS P1$,2 AS P2$,2 AS P3$,2 AS P4$,2 AS P5$,2 AS P6$,2 AS P7$,2 AS P8$,2 AS P9$,2 AS P10$
  54. 540 '
  55. 550 '    DAMAGE IS ARMOR CLASS FOR ARMOR, CHARACTER TYPE FOR SPELLS
  56. 560 '    WEIGHT IS LEVEL FOR SPELLS
  57. 570 '
  58. 580 RETURN
  59. 590 'BUY SUPPLIES
  60. 600     GOSUB 2260 'GET PLAYER
  61. 610     CLS: PRINT "          BUY SUPPLIES"
  62. 620    PRINT "YOU HAVE";CVS(MONEY$);"GOLD PIECES"
  63. 630     LOCATE 25,1: PRINT "TO BUY ENTER HOW MANY,TO SKIP HIT SPACE";:LOCATE 2,1
  64. 640     LET SNO=0
  65. 650 'GO THRU FILE
  66. 660     SNO=SNO+1
  67. 670     GET #2,SNO
  68. 680     IF SID$ <> "DS" THEN GOTO 1120
  69. 690    IF LEFT$(SNAME$,5)="CURSE" OR LEFT$(SNAME$,5)="MAGIC" THEN GOTO 650
  70. 700     IF CLAS$="CLERIC    " AND (SNO=5 OR SNO=8 OR SNO=9 OR SNO=10 OR SNO=11)            GOTO 650
  71. 710     IF SCLASS$ <> "S" THEN GOTO 870
  72. 720     ON RNO GOTO 730,740,750,760,770,780,790,800,810,820
  73. 730      SQUAN = CVI(P1$): GOTO 830
  74. 740      SQUAN = CVI(P2$): GOTO 830
  75. 750      SQUAN = CVI(P3$): GOTO 830
  76. 760      SQUAN = CVI(P4$): GOTO 830
  77. 770      SQUAN = CVI(P5$): GOTO 830
  78. 780      SQUAN = CVI(P6$): GOTO 830
  79. 790      SQUAN = CVI(P7$): GOTO 830
  80. 800      SQUAN = CVI(P8$): GOTO 830
  81. 810      SQUAN = CVI(P9$): GOTO 830
  82. 820      SQUAN = CVI(P10)$): GOTO 830
  83. 830     IF CLAS$="CLERIC    " AND CVI(SDAM$) = 1 THEN GOTO 860
  84. 840    IF CVI(SDAM$) <> 3 THEN GOTO 650
  85. 850     IF CLAS$="ELF       " OR CLAS$="MAGIC-USER" THEN GOTO 860                         ELSE GOTO 650
  86. 860     IF CVI(SWT$) > CVI(LVL$) THEN GOTO 650
  87. 870     PRINT SNAME$;"COST";CVI(SCOST$);"WEIGHT";CVI(SWT$)
  88. 880     GOSUB 440
  89. 890     IF REPLY$ = " " THEN GOTO 650
  90. 900    QUAN=VAL(REPLY$)
  91. 910     IF QUAN=0 THEN GOTO 650
  92. 920     IF SCLASS$ <> "S" THEN GOTO 950
  93. 930    MAX.SPELLS = (CVI(LVL$)-CVI(SWT$))+1
  94. 940    IF (QUAN+SQUAN) > MAX.SPELLS THEN PRINT "YOU CAN ONLY GET ";MAX.SPELLS-SQUAN: GOTO 880
  95. 950     PRICE = QUAN * CVI(SCOST$)
  96. 960     IF PRICE > CVS(MONEY$) THEN PRINT "YOU CAN'T AFFORD ";QUAN:                       PRINT "YOU HAVE ";CVS(MONEY$)";GOLD PIECES":  GOTO 880
  97. 970     LSET MONEY$ = MKS$(CVS(MONEY$) - PRICE)
  98. 980    PRINT "YOU HAVE ";CVS(MONEY$);"GOLD PIECES"
  99. 990     ON RNO GOTO 1000,1010,1020,1030,1040,1050,1060,1070,1080,1090
  100. 1000     LSET P1$ = MKI$(QUAN + CVI(P1$)): GOTO 1100
  101. 1010      LSET P2$ = MKI$(QUAN + CVI(P2$)): GOTO 1100
  102. 1020      LSET P3$ = MKI$(QUAN + CVI(P3$)): GOTO 1100
  103. 1030      LSET P4$ = MKI$(QUAN + CVI(P4$)): GOTO 1100
  104. 1040      LSET P5$ = MKI$(QUAN + CVI(P5$)): GOTO 1100
  105. 1050      LSET P6$ = MKI$(QUAN + CVI(P6$)): GOTO 1100
  106. 1060      LSET P7$ = MKI$(QUAN + CVI(P7$)): GOTO 1100
  107. 1070      LSET P8$ = MKI$(QUAN + CVI(P8$)): GOTO 1100
  108. 1080      LSET P9$ = MKI$(QUAN + CVI(P9$)): GOTO 1100
  109. 1090      LSET P10$ = MKI$(QUAN + CVI(P10$)): GOTO 1100
  110. 1100     PUT #2,SNO
  111. 1110     GOTO 650
  112. 1120 'END OF SHOPPING
  113. 1130     PUT #1,RNO
  114. 1140 RETURN
  115. 1150 'SELL SUPPLIES
  116. 1160     GOSUB 2260
  117. 1170     CLS: PRINT "          SELL SUPPLIES"
  118. 1180     LOCATE 25,1: PRINT "TO SELL ENTER HOW MANY, SPACE TO SKIP";: LOCATE 2,1
  119. 1190     LET SNO=0
  120. 1200 'GO THRU FILE
  121. 1210     SNO=SNO+1
  122. 1220     GET #2,SNO
  123. 1230     IF SID$ <> "DS" THEN GOTO 1680 'END OF FILE
  124. 1240     ON RNO GOTO 1250,1260,1270,1280,1290,1300,1310,1320,1330,1340
  125. 1250     QUAN = CVI(P1$): GOTO 1350
  126. 1260     QUAN = CVI(P2$): GOTO 1350
  127. 1270      QUAN = CVI(P3$): GOTO 1350
  128. 1280      QUAN = CVI(P4$): GOTO 1350
  129. 1290      QUAN = CVI(P5$): GOTO 1350
  130. 1300      QUAN = CVI(P6$): GOTO 1350
  131. 1310      QUAN = CVI(P7$): GOTO 1350
  132. 1320      QUAN = CVI(P8$): GOTO 1350
  133. 1330      QUAN = CVI(P9$): GOTO 1350
  134. 1340      QUAN = CVI(P10)$): GOTO 1350
  135. 1350    IF QUAN=0 THEN GOTO 1200
  136. 1360    PRINT "YOU HAVE";QUAN;SNAME$;"COST";CVI(SCOST$);
  137. 1370    GOSUB 440
  138. 1380    IF (VAL(REPLY$) > 0) AND (LEFT$(SNAME$,5)="CURSE") THEN PRINT "DON'T YOU WISH": GOTO 1360
  139. 1390    IF VAL(REPLY$) => QUAN THEN GOTO 1480
  140. 1400    IF CLAS$="CLERIC    " AND (SNO=5 OR SNO=8 OR SNO=9 OR SNO=10 OR SNO=11            OR SNO=34) THEN PRINT "CLERICS CAN'T USED EDGED WEAPONS": GOTO 1360
  141. 1410    IF SCLASS$ <> "S" THEN GOTO 1480
  142. 1420    IF CLAS$="CLERIC    " AND CVI(SDAM$) = 1 THEN GOTO 1450
  143. 1430    IF CVI(SDAM$) <> 3 THEN PRINT "YOU CAN'T USE THIS SPELL": GOTO 1360
  144. 1440    IF CLAS$="ELF       " OR CLAS$="MAGIC-USER" THEN GOTO 1450                        ELSE PRINT "YOU CAN'T USE THIS SPELL": GOTO 1360
  145. 1450    IF CVI(SWT$) > CVI(LVL$) THEN PRINT "YOU CAN'T USE THIS SPELL":                   GOTO 1360
  146. 1460    MAX.SPELLS = (CVI(LVL$)-CVI(SWT$))+1
  147. 1470    IF (QUAN-VAL(REPLY$)) > MAX.SPELLS THEN PRINT "YOU MUST SELL ";(QUAN-MAX.SPELLS):                  GOTO 1360
  148. 1480    IF REPLY$ = " " THEN GOTO 1200
  149. 1490    LET SQUAN = VAL(REPLY$)
  150. 1500    IF SQUAN = 0 THEN GOTO 1200
  151. 1510    PRICE = SQUAN * CVI(SCOST$)
  152. 1520    IF SQUAN > QUAN THEN PRINT "YOU DON'T HAVE ";SQUAN: GOTO 1370
  153. 1530    LSET MONEY$ = MKS$(CVS(MONEY$) + PRICE)
  154. 1540    QUAN = QUAN - SQUAN
  155. 1550    ON RNO GOTO 1560,1570,1580,1590,1600,1610,1620,1630,1640,1650
  156. 1560    LSET P1$ = MKI$(QUAN): GOTO 1660
  157. 1570     LSET P2$ = MKI$(QUAN): GOTO 1660
  158. 1580     LSET P3$ = MKI$(QUAN): GOTO 1660
  159. 1590     LSET P4$ = MKI$(QUAN): GOTO 1660
  160. 1600     LSET P5$ = MKI$(QUAN): GOTO 1660
  161. 1610     LSET P6$ = MKI$(QUAN): GOTO 1660
  162. 1620     LSET P7$ = MKI$(QUAN): GOTO 1660
  163. 1630     LSET P8$ = MKI$(QUAN): GOTO 1660
  164. 1640     LSET P9$ = MKI$(QUAN): GOTO 1660
  165. 1650     LSET P10$ = MKI$(QUAN): GOTO 1660
  166. 1660    PUT #2,SNO
  167. 1670    GOTO 1200
  168. 1680 'END OF FILE
  169. 1690    PRINT "YOU HAVE";CVS(MONEY$);"GOLD PIECES"
  170. 1700    SV.TIMER!=TIMER+2
  171. 1710    IF TIMER < SV.TIMER! GOTO 1710
  172. 1720    PUT #1,RNO
  173. 1730 RETURN
  174. 1740 'ADD A NEW ITEM
  175. 1750    CLS: PRINT "          ADD A NEW ITEM"
  176. 1760    LOCATE 25,1: PRINT "ENTER END TO QUIT";: LOCATE 2,1
  177. 1770    PRINT
  178. 1780    PRINT
  179. 1790    PRINT "ENTER NAME OF ITEM"
  180. 1800    LOCATE 5,1: PRINT "..............."
  181. 1810    LOCATE 5,1
  182. 1820    INPUT "",WNAME$
  183. 1830    IF WNAME$ = "END" THEN GOTO 2210
  184. 1840    INPUT "ENTER COST (IN GOLD PIECES) ",WCOST
  185. 1850    PRINT "ENTER TYPE  A=ARMOR, W=WEAPON"
  186. 1860    PRINT "      E=EQUIPMENT, S=SPELL"
  187. 1870    INPUT WCLASS$
  188. 1880    IF WCLASS$ <> "A" AND WCLASS$ <> "W" AND WCLASS$ <> "E" AND                       WCLASS$ <> "S" THEN PRINT "YOU MUST ENTER A-W-E-S": GOTO 1850
  189. 1890    IF WCLASS$ = "A" THEN INPUT "ENTER ARMOR CLASS ",WDAM
  190. 1900    IF WCLASS$ = "W" THEN INPUT "ENTER DAMAGE POINTS ",WDAM
  191. 1910    IF WCLASS$ <> "S" THEN GOTO 1950
  192. 1920    PRINT "ENTER PLAYER CLASS "
  193. 1930    PRINT "1=CLERIC 3=ELF & MAGIC-USER"
  194. 1940    INPUT WDAM
  195. 1950    IF WCLASS$ <> "S" THEN INPUT "ENTER WEIGHT (IN GOLD PIECES) ",WWT                  ELSE INPUT "ENTER LEVEL ",WWT
  196. 1960    PRINT "IS THE ABOVE OK?"
  197. 1970    GOSUB 440
  198. 1980    IF REPLY$ <> "Y" THEN GOTO 1740
  199. 1990 'FIND END OF FILE
  200. 2000    SNO = SNO+1
  201. 2010    GET #2,SNO
  202. 2020    IF SID$ = "DS" THEN GOTO 1990
  203. 2030    LSET SID$ = "DS"
  204. 2040    LSET SCLASS$ = WCLASS$
  205. 2050    LSET SNAME$ = WNAME$
  206. 2060    LSET SCOST$ = MKI$(WCOST)
  207. 2070    LSET SDAM$ = MKI$(WDAM)
  208. 2080    LSET SWT$ = MKI$(WWT)
  209. 2090    LSET P1$ = MKI$(0)
  210. 2100    LSET P2$ = MKI$(0)
  211. 2110    LSET P3$ = MKI$(0)
  212. 2120    LSET P4$ = MKI$(0)
  213. 2130    LSET P5$ = MKI$(0)
  214. 2140    LSET P6$ = MKI$(0)
  215. 2150    LSET P7$ = MKI$(0)
  216. 2160    LSET P8$ = MKI$(0)
  217. 2170    LSET P9$ = MKI$(0)
  218. 2180    LSET P10$ = MKI$(0)
  219. 2190    PUT #2,SNO
  220. 2200    GOTO 1740
  221. 2210  RETURN
  222. 2220 'END
  223. 2230    CLS
  224. 2240    CLOSE
  225. 2250    CHAIN "MENU",1000
  226. 2260 'GET PLAYER
  227. 2270    CLS
  228. 2280    PRINT "ENTER YOUR PLAYER NUMBER "
  229. 2290    GOSUB 440: RNO=VAL(REPLY$)
  230. 2300    IF RNO < 1 OR RNO > 9 THEN PRINT "ENTER A NUMBER FROM 1 TO 9 ": GOTO 2280
  231. 2310    GET #1,RNO
  232. 2320    IF NM$ = SPACE$(24) THEN PRINT "THAT NUMBER IS NOT VALID": GOTO 2280
  233. 2330    PRINT "YOUR ARE ";NM$;"?"
  234. 2340    PRINT "Yes/No"
  235. 2350    GOSUB 440
  236. 2360    IF REPLY$ <> "Y" THEN GOTO 2260
  237. 2370 RETURN
  238. 2380 'CHANGE AN ITEM
  239. 2390    CLS
  240. 2400    PRINT "         CHANGE AN ITEM"
  241. 2410    PRINT
  242. 2420    PRINT "ENTER NAME OF ITEM (ENTER E TO END)"
  243. 2430    INPUT WNAME$
  244. 2440    IF WNAME$ = "E" THEN GOTO 2770 'END
  245. 2450    SKNM$=SPACE$(15)
  246. 2460    LSET SKNM$=WNAME$
  247. 2470    SNO=0
  248. 2480 'LOOK FOR ITEM
  249. 2490    SNO=SNO+1
  250. 2500    GET #2,SNO
  251. 2510    IF SID$ = "DS" THEN GOTO 2550
  252. 2520    PRINT SKNM$;" NOT FOUND"
  253. 2530    FOR X=1 TO 500: NEXT X 'KILL TIME
  254. 2540    GOTO 2380
  255. 2550    IF SNAME$ <> SKNM$ THEN GOTO 2480
  256. 2560    PRINT "1. ITEM ";SNAME$
  257. 2570    PRINT "2. CLASS ";SCLASS$
  258. 2580    PRINT "3. PRICE ";CVI(SCOST$)
  259. 2590    IF SCLASS$ = "W" THEN PRINT "4. DAMAGE ";CVI(SDAM$)
  260. 2600    IF SCLASS$ = "A" THEN PRINT "4. ARMOR CLASS ";CVI(SDAM$)
  261. 2610    IF SCLASS$ = "S" THEN PRINT "4. CHARACTER  ";CVI(SDAM$)
  262. 2620    IF SCLASS$ = "S" THEN PRINT "5. LEVEL "                                             ELSE PRINT "5. WEIGHT ";CVI(SWT$)
  263. 2630    PRINT "ENTER NUMBER OF FIELD TO CHANGE"
  264. 2640    INPUT CFLD
  265. 2650    IF CFLD=1 THEN INPUT "ENTER NEW NAME ";WNAME$: LSET SNAME$=WNAME$:                GOTO 2750
  266. 2660    IF CFLD=3 THEN INPUT "ENTER NEW PRICE ";WCOST: LSET SCOST$=MKI$(WCOST):           GOTO 2750
  267. 2670    IF CFLD=4 THEN INPUT "ENTER NEW DAMAGE/ARM CLASS/CHAR ";WDAM: LSET SDAM$=MKI$(WDAM):           GOTO 2750
  268. 2680    IF CFLD=5 THEN INPUT "ENTER NEW WEIGHT/LVL ";WWT: LSET SWT$=MKI$(WWT):               GOTO 2750
  269. 2690    IF CFLD <> 2 THEN GOTO 2560
  270. 2700    PRINT "ENTER TYPE  A=ARMOR, W=WEAPON"
  271. 2710    PRINT "      E=EQUIPMENT, S=SPELL"
  272. 2720    INPUT WCLASS$
  273. 2730    IF WCLASS$ <> "A" AND WCLASS$ <> "W" AND WCLASS$ <> "E" AND                       WCLASS$ <> "E" THEN PRINT "YOU MUST ENTER A-W-E-S": GOTO 2720
  274. 2740    LSET SCLASS$=WCLASS$
  275. 2750    PUT #2,SNO
  276. 2760    GOTO 2380
  277. 2770 RETURN
  278. 2780 'LIST SUPPLIES
  279. 2790    LPRINT "          THE SUPPLY SHOP  ";DATE$
  280. 2800    LPRINT: LPRINT
  281. 2810    LPRINT "CLASS","PRICE","DAM/AC/LVL","WEIGHT"
  282. 2820    SNO=0
  283. 2830 'LIST ITEMS
  284. 2840    SNO=SNO+1
  285. 2850    GET #2,SNO
  286. 2860    IF SID$ <> "DS" THEN GOTO 2910
  287. 2870    MSG$=STR$(SNO)+" "+SNAME$
  288. 2880    LPRINT MSG$
  289. 2890    LPRINT SCLASS$,CVI(SCOST$),CVI(SDAM$),CVI(SWT$)
  290. 2900    GOTO 2830
  291. 2910 RETURN
  292.