home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 15 / 015.d81 / baudleship (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  6KB  |  219 lines
  1. 120 open1,2,3,chr$(6):rem open rs-232 channel
  2. 130 dim b%(10,10): rem ship grid matrix
  3. 140 poke53280,0:poke53281,0:poke54272+24,8
  4. 150 bt$=""
  5. 160 m$=left$(bt$,16)
  6. 170 me$="":for q=1to39:me$=me$+" ":next
  7. 180 bl$=me$:my$=me$:s6=54272
  8. 190 cr$=chr$(13):f1$=chr$(133):ds$="$"
  9. 200 c$(0)="[158]":c$(1)=""
  10. 210 printchr$(147)chr$(142)chr$(8)
  11. 220 s$(1)=chr$(28)+chr$(42)
  12. 230 for x=2to5:reads$(x):next
  13. 240 data submarine,destroyer,cruiser,battleship
  14. 250 ts=14:hs=14:bp=1:goto1460
  15. 260 gosub 2230:rem both players ready?
  16. 270 ifn$<>""then330
  17. 280 n$="c64":input"[147]your name";n$
  18. 290 ifn$=""then280
  19. 300 print"wait..."
  20. 310 gosub1950:rem send name to other computer, wait for his
  21. 330 rem input ship coordinates
  22. 340 print"[147]":p=0:gosub680:rem print grid
  23. 350 for x=2to5:gosub1370
  24. 360 for j=1to10
  25. 370 : for k=1to10
  26. 380 : ifb%(j,k)=xthenb%(j,k)=0
  27. 390 nextk,j
  28. 400 gosub890:rem erase direction aid
  29. 410 printm$"enter "s$(x)"   "
  30. 420 gosub1140:rem get coordinates
  31. 430 ifb%(v,h)<>0thengosub1060:goto360:rem ship there already
  32. 440 gosub840:rem print direction aid
  33. 450 poke198,0:wait198,1:getd$
  34. 460 ck=0:for y=1to8
  35. 470 ifmid$("tyugjbnm",y,1)=d$then490
  36. 480 nexty:gosub1060:goto450
  37. 490 onygoto500,510,520,530,540,550,560,570
  38. 500 xd=-1:yd=-1:goto580
  39. 510 xd= 0:yd=-1:goto580
  40. 520 xd= 1:yd=-1:goto580
  41. 530 xd=-1:yd= 0:goto580
  42. 540 xd= 1:yd= 0:goto580
  43. 550 xd=-1:yd= 1:goto580
  44. 560 xd= 0:yd= 1:goto580
  45. 570 xd= 1:yd= 1:goto580
  46. 580 l=1:b%(v,h)=x
  47. 590 x1=h+xd:y1=v+yd:l=l+1
  48. 600 ifx1>10ory1>10thengosub1060:goto360
  49. 610 ifx1<1ory1<1thengosub1060:goto360
  50. 620 ifb%(y1,x1)<>0thengosub1060:goto360
  51. 630 b%(y1,x1)=x
  52. 640 ifl<xthenh=x1:v=y1:goto590
  53. 650 g=0:gosub940
  54. 660 nextx:gosub890
  55. 670 goto 1400 :rem skip to play routines
  56. 680 rem grid drawing subroutine
  57. 690 print tab(p*18)chr$(19)c$(p)
  58. 700 print tab(p*18)"  [175][175][175][175][175][175][175][175][175][175]"
  59. 710 print tab(p*18)"0[170][186][186][186][186][186][186][186][186][186][186]"
  60. 720 print tab(p*18)"1[170][186][186][186][186][186][186][186][186][186][186]"
  61. 730 print tab(p*18)"2[170][186][186][186][186][186][186][186][186][186][186]"
  62. 740 print tab(p*18)"3[170][186][186][186][186][186][186][186][186][186][186]"
  63. 750 print tab(p*18)"4[170][186][186][186][186][186][186][186][186][186][186]"
  64. 760 print tab(p*18)"5[170][186][186][186][186][186][186][186][186][186][186]"
  65. 770 print tab(p*18)"6[170][186][186][186][186][186][186][186][186][186][186]"
  66. 780 print tab(p*18)"7[170][186][186][186][186][186][186][186][186][186][186]"
  67. 790 print tab(p*18)"8[170][186][186][186][186][186][186][186][186][186][186]"
  68. 800 print tab(p*18)"9[170][186][186][186][186][186][186][186][186][186][186]"
  69. 810 print tab(p*18)"  [183][183][183][183][183][183][183][183][183][183]"
  70. 820 print tab(p*18)"  abcdefghij"
  71. 830 return
  72. 840 print"          direction?"
  73. 850 printtab(13)"tyu"
  74. 860 printtab(13)"g j"
  75. 870 printtab(13)"bnm"
  76. 880 return
  77. 890 print"                    "
  78. 900 printtab(13)"   "
  79. 910 printtab(13)"   "
  80. 920 printtab(13)"   "
  81. 930 return
  82. 940 rem draw ships on grid subroutine
  83. 950 gosub1370:print"";
  84. 960 for j=1to10
  85. 970 print""tab(g*18)
  86. 980 for k=1to10
  87. 990 s=b%(j,k):ifs=0thenprint"";:goto1020
  88. 1000 ifs=1thenprint" [146]";:goto1020
  89. 1010 printchr$(18)chr$(5)left$(s$(s),1)chr$(146);
  90. 1020 nextk:print:nextj:return
  91. 1030 rem beeps subroutine
  92. 1040 gosub1120:pokes6+1,130:pokes6+5,9:pokes6+15,30:pokes6+24,5
  93. 1050 pokes6+4,21:for de=1to25:next:pokes6+4,20:pokes6+24,0:return
  94. 1060 rem bapps subroutine
  95. 1070 printm$"bad entry"
  96. 1080 poke s6+24,12:pokes6+6,240:pokes6+4,17
  97. 1090 for a=1to2 : for b=1to255 step25
  98. 1100 poke s6+1,b:nextb,a :pokes6+4,32
  99. 1110 poke s6+4,32
  100. 1120 for q=0to24:pokes6+q,0:next
  101. 1130 printm$"          ":return
  102. 1140 rem coordinate input subroutine
  103. 1150 printleft$(bt$,17)"coordinates? (v,h)"
  104. 1160 print"    ":print"[145]";
  105. 1170 poke198,0:wait198,1:getv$
  106. 1180 ifasc(v$)<48orasc(v$)>57thengosub1060:goto1170
  107. 1190 printm$""v$"-";
  108. 1200 poke198,0:wait198,1:geth$
  109. 1210 ifasc(h$)<65orasc(h$)>74thengosub1060:goto1200
  110. 1220 printm$""h$
  111. 1230 h=asc(h$)-64:v=asc(v$)-47
  112. 1240 return
  113. 1250 rem hit noise subroutine
  114. 1260 for q=0to24:pokes6+q,0:next:pokes6+24,8
  115. 1270 pokes6+5,192:pokes6+6,250
  116. 1280 for q=120to80step-1
  117. 1290 pokes6+1,q:pokes6+4,17:for de=1to8:nextde,q
  118. 1300 poke 53280,2:poke53281,2
  119. 1310 pokes6+24,15:pokes6+1,15:pokes6+4,128
  120. 1320 for vo=15to0step-1:for de=1to10:nextde:pokes6+24,vo:next
  121. 1330 poke 53280,0:poke53281,0: return
  122. 1340 poke s6+24,9:pokes6+5,9:pokes6+1,20
  123. 1350 poke s6+4,128:for d=1to10:next:pokes6+4,129:goto1310
  124. 1360 rem clear message screen subroutine
  125. 1370 printm$bl$:for q=1to3:printbl$:next:return
  126. 1380 rem
  127. 1390 rem ready for game
  128. 1400 gosub1370 : rem clear message area
  129. 1410 p=0
  130. 1420 gosub680 : rem draw grid
  131. 1430 p=1:gosub680
  132. 1440 print"[158]  "n$tab(18)"  "n1$
  133. 1450 gosub940:rem draw on grid
  134. 1460 gv=0:printleft$(bt$,21);
  135. 1470 print"[192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]";chr$(19)
  136. 1480 ifbp=0thengosub 2140:rem other player ready?
  137. 1490 rem main playing loop
  138. 1500 rem ***** input from other computer
  139. 1510 get#1,a$:ifa$=""orst<>0then1600
  140. 1520 ifa$=f1$then1790:rem coords coming
  141. 1530 ifa$=chr$(134)then1870:rem report of hit & value
  142. 1540 ifa$=chr$(135)then1910:rem report of miss
  143. 1550 ifa$<" "ora$>"z"then1600
  144. 1560 ifa$=chr$(136)then250
  145. 1570 me$=right$(me$+a$,39)
  146. 1580 print"[159]"left$(bt$,20)me$:poke212,0
  147. 1590 rem ***** from you to him
  148. 1600 ifmf=1andgv=0andbp=0thengosub1370:printm$"your turn (f1)"
  149. 1610 ifmf=0andgv=0andbp=0thengosub1370
  150. 1620 ifbpthenprintm$"press f1 to play"
  151. 1630 geta$:ifgv=1then1660
  152. 1640 ifa$=f1$andmf=1andbp=0then1760:rem get coordinates
  153. 1650 ifa$=f1$andbp=1thenbp=0:goto260:rem end initial chat mode
  154. 1660 ifhs=0thengv=1:gosub1370:printm$n$" wins!":gosub2220:goto250
  155. 1670 ifts=0thengv=1:gosub1370:printm$n1$" wins!":gosub2220:goto250
  156. 1680 ifa$>="[193]"anda$<="[218]"thena$=chr$(asc(a$)-128)
  157. 1690 ifa$=chr$(160)thena$=" "
  158. 1700 ifa$<" "ora$>"z"then1510
  159. 1710 a1$=a$:ifa$=chr$(34)thena1$="'"
  160. 1720 my$=right$(my$+a1$,39)
  161. 1730 print"[158]"left$(bt$,22)my$chr$(19)
  162. 1740 print#1,a$;:goto1510
  163. 1750 rem get coordinates
  164. 1760 gosub1370:gosub1140:gosub1370
  165. 1770 print#1,f1$chr$(h)chr$(v);
  166. 1780 mf=0:goto1490
  167. 1790 rem get other computers coordinates
  168. 1800 get#1,h$:ifh$=""then1800
  169. 1810 get#1,v$:ifv$=""then1810
  170. 1820 h=asc(h$):v=asc(v$):mf=1:b=b%(v,h)
  171. 1830 ifb=0orb=1thenprint#1,chr$(135);:printm$""n1$" missed"
  172. 1835 ifb=0orb=1thengosub2210:goto1600
  173. 1840 print#1,chr$(134)chr$(b);
  174. 1850 gosub1250:printm$""n1$" gets a hit!":ts=ts-1:gosub2210
  175. 1860 b%(v,h)=1:gosub940:goto1600
  176. 1870 get#1,b$:ifb$=""then1870
  177. 1880 b=asc(b$):hs=hs-1
  178. 1890 b$=""+left$(s$(b),1)+"[146]":gosub1340
  179. 1900 goto 1920
  180. 1910 b$="*"
  181. 1920 print"":for q=1tov:print:next
  182. 1930 printtab(1+18+h)"[158]"b$
  183. 1940 goto1600
  184. 1950 rem send name to other computer
  185. 1960 rem forq=1to100:print#1,chr$(0);:next
  186. 1970 print#1,f1$;
  187. 1980 get#1,a$:ifa$<>f1$then1970
  188. 1990 for q=1tolen(n$):print#1,mid$(n$,q,1);:next:print#1,cr$;
  189. 2000 n1$=""
  190. 2010 get#1,a$:ifa$>=" "anda$<="z"thenn1$=n1$+a$
  191. 2020 ifa$<>chr$(13)then2010
  192. 2030 rem who goes first?
  193. 2040 for x=1to100:print#1,chr$(0);:next
  194. 2050 wf$=chr$(int(rnd(0)*100)+150)
  195. 2060 print#1,wf$;
  196. 2070 get#1,a$:ifa$=""then2060
  197. 2080 ifasc(a$)<150orasc(a$)>249then2070
  198. 2090 ifwf$=a$then2040
  199. 2100 mf=0:mf$="second":ifwf$>a$thenmf=1:mf$="first"
  200. 2110 gosub1370:printm$"we go "mf$
  201. 2120 for x=1to100:print#1,chr$(0);:next
  202. 2130 return
  203. 2140 rem other player ready? *******
  204. 2150 print#1,ds$
  205. 2160 get#1,a$:ifa$=ds$then2180
  206. 2170 printm$"please wait...":goto2150
  207. 2180 print#1,chr$(255);
  208. 2190 get#1,a$:ifa$<>chr$(255)then2190
  209. 2200 return
  210. 2210 for delay=1to1000:next:return
  211. 2220 print#1,chr$(136);:gosub2210:return
  212. 2230 rem signal other computer you are
  213. 2240 rem   ready, wait for his signal.
  214. 2250 print"[147]waiting for other player..."
  215. 2260 print#1,"    push the f1 key. (i have!) "
  216. 2270 print#1,chr$(7);
  217. 2280 get#1,a$:ifa$<>chr$(7)then2270
  218. 2290 for x=1to10:print#1,chr$(7);:next:return
  219.