home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 15
/
015.d81
/
baudleship
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
6KB
|
219 lines
120 open1,2,3,chr$(6):rem open rs-232 channel
130 dim b%(10,10): rem ship grid matrix
140 poke53280,0:poke53281,0:poke54272+24,8
150 bt$=""
160 m$=left$(bt$,16)
170 me$="":for q=1to39:me$=me$+" ":next
180 bl$=me$:my$=me$:s6=54272
190 cr$=chr$(13):f1$=chr$(133):ds$="$"
200 c$(0)="[158]":c$(1)=""
210 printchr$(147)chr$(142)chr$(8)
220 s$(1)=chr$(28)+chr$(42)
230 for x=2to5:reads$(x):next
240 data submarine,destroyer,cruiser,battleship
250 ts=14:hs=14:bp=1:goto1460
260 gosub 2230:rem both players ready?
270 ifn$<>""then330
280 n$="c64":input"[147]your name";n$
290 ifn$=""then280
300 print"wait..."
310 gosub1950:rem send name to other computer, wait for his
330 rem input ship coordinates
340 print"[147]":p=0:gosub680:rem print grid
350 for x=2to5:gosub1370
360 for j=1to10
370 : for k=1to10
380 : ifb%(j,k)=xthenb%(j,k)=0
390 nextk,j
400 gosub890:rem erase direction aid
410 printm$"enter "s$(x)" "
420 gosub1140:rem get coordinates
430 ifb%(v,h)<>0thengosub1060:goto360:rem ship there already
440 gosub840:rem print direction aid
450 poke198,0:wait198,1:getd$
460 ck=0:for y=1to8
470 ifmid$("tyugjbnm",y,1)=d$then490
480 nexty:gosub1060:goto450
490 onygoto500,510,520,530,540,550,560,570
500 xd=-1:yd=-1:goto580
510 xd= 0:yd=-1:goto580
520 xd= 1:yd=-1:goto580
530 xd=-1:yd= 0:goto580
540 xd= 1:yd= 0:goto580
550 xd=-1:yd= 1:goto580
560 xd= 0:yd= 1:goto580
570 xd= 1:yd= 1:goto580
580 l=1:b%(v,h)=x
590 x1=h+xd:y1=v+yd:l=l+1
600 ifx1>10ory1>10thengosub1060:goto360
610 ifx1<1ory1<1thengosub1060:goto360
620 ifb%(y1,x1)<>0thengosub1060:goto360
630 b%(y1,x1)=x
640 ifl<xthenh=x1:v=y1:goto590
650 g=0:gosub940
660 nextx:gosub890
670 goto 1400 :rem skip to play routines
680 rem grid drawing subroutine
690 print tab(p*18)chr$(19)c$(p)
700 print tab(p*18)" [175][175][175][175][175][175][175][175][175][175]"
710 print tab(p*18)"0[170][186][186][186][186][186][186][186][186][186][186]"
720 print tab(p*18)"1[170][186][186][186][186][186][186][186][186][186][186]"
730 print tab(p*18)"2[170][186][186][186][186][186][186][186][186][186][186]"
740 print tab(p*18)"3[170][186][186][186][186][186][186][186][186][186][186]"
750 print tab(p*18)"4[170][186][186][186][186][186][186][186][186][186][186]"
760 print tab(p*18)"5[170][186][186][186][186][186][186][186][186][186][186]"
770 print tab(p*18)"6[170][186][186][186][186][186][186][186][186][186][186]"
780 print tab(p*18)"7[170][186][186][186][186][186][186][186][186][186][186]"
790 print tab(p*18)"8[170][186][186][186][186][186][186][186][186][186][186]"
800 print tab(p*18)"9[170][186][186][186][186][186][186][186][186][186][186]"
810 print tab(p*18)" [183][183][183][183][183][183][183][183][183][183]"
820 print tab(p*18)" abcdefghij"
830 return
840 print" direction?"
850 printtab(13)"tyu"
860 printtab(13)"g j"
870 printtab(13)"bnm"
880 return
890 print" "
900 printtab(13)" "
910 printtab(13)" "
920 printtab(13)" "
930 return
940 rem draw ships on grid subroutine
950 gosub1370:print"";
960 for j=1to10
970 print""tab(g*18)
980 for k=1to10
990 s=b%(j,k):ifs=0thenprint"";:goto1020
1000 ifs=1thenprint" [146]";:goto1020
1010 printchr$(18)chr$(5)left$(s$(s),1)chr$(146);
1020 nextk:print:nextj:return
1030 rem beeps subroutine
1040 gosub1120:pokes6+1,130:pokes6+5,9:pokes6+15,30:pokes6+24,5
1050 pokes6+4,21:for de=1to25:next:pokes6+4,20:pokes6+24,0:return
1060 rem bapps subroutine
1070 printm$"bad entry"
1080 poke s6+24,12:pokes6+6,240:pokes6+4,17
1090 for a=1to2 : for b=1to255 step25
1100 poke s6+1,b:nextb,a :pokes6+4,32
1110 poke s6+4,32
1120 for q=0to24:pokes6+q,0:next
1130 printm$" ":return
1140 rem coordinate input subroutine
1150 printleft$(bt$,17)"coordinates? (v,h)"
1160 print" ":print"[145]";
1170 poke198,0:wait198,1:getv$
1180 ifasc(v$)<48orasc(v$)>57thengosub1060:goto1170
1190 printm$""v$"-";
1200 poke198,0:wait198,1:geth$
1210 ifasc(h$)<65orasc(h$)>74thengosub1060:goto1200
1220 printm$""h$
1230 h=asc(h$)-64:v=asc(v$)-47
1240 return
1250 rem hit noise subroutine
1260 for q=0to24:pokes6+q,0:next:pokes6+24,8
1270 pokes6+5,192:pokes6+6,250
1280 for q=120to80step-1
1290 pokes6+1,q:pokes6+4,17:for de=1to8:nextde,q
1300 poke 53280,2:poke53281,2
1310 pokes6+24,15:pokes6+1,15:pokes6+4,128
1320 for vo=15to0step-1:for de=1to10:nextde:pokes6+24,vo:next
1330 poke 53280,0:poke53281,0: return
1340 poke s6+24,9:pokes6+5,9:pokes6+1,20
1350 poke s6+4,128:for d=1to10:next:pokes6+4,129:goto1310
1360 rem clear message screen subroutine
1370 printm$bl$:for q=1to3:printbl$:next:return
1380 rem
1390 rem ready for game
1400 gosub1370 : rem clear message area
1410 p=0
1420 gosub680 : rem draw grid
1430 p=1:gosub680
1440 print"[158] "n$tab(18)" "n1$
1450 gosub940:rem draw on grid
1460 gv=0:printleft$(bt$,21);
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)
1480 ifbp=0thengosub 2140:rem other player ready?
1490 rem main playing loop
1500 rem ***** input from other computer
1510 get#1,a$:ifa$=""orst<>0then1600
1520 ifa$=f1$then1790:rem coords coming
1530 ifa$=chr$(134)then1870:rem report of hit & value
1540 ifa$=chr$(135)then1910:rem report of miss
1550 ifa$<" "ora$>"z"then1600
1560 ifa$=chr$(136)then250
1570 me$=right$(me$+a$,39)
1580 print"[159]"left$(bt$,20)me$:poke212,0
1590 rem ***** from you to him
1600 ifmf=1andgv=0andbp=0thengosub1370:printm$"your turn (f1)"
1610 ifmf=0andgv=0andbp=0thengosub1370
1620 ifbpthenprintm$"press f1 to play"
1630 geta$:ifgv=1then1660
1640 ifa$=f1$andmf=1andbp=0then1760:rem get coordinates
1650 ifa$=f1$andbp=1thenbp=0:goto260:rem end initial chat mode
1660 ifhs=0thengv=1:gosub1370:printm$n$" wins!":gosub2220:goto250
1670 ifts=0thengv=1:gosub1370:printm$n1$" wins!":gosub2220:goto250
1680 ifa$>="[193]"anda$<="[218]"thena$=chr$(asc(a$)-128)
1690 ifa$=chr$(160)thena$=" "
1700 ifa$<" "ora$>"z"then1510
1710 a1$=a$:ifa$=chr$(34)thena1$="'"
1720 my$=right$(my$+a1$,39)
1730 print"[158]"left$(bt$,22)my$chr$(19)
1740 print#1,a$;:goto1510
1750 rem get coordinates
1760 gosub1370:gosub1140:gosub1370
1770 print#1,f1$chr$(h)chr$(v);
1780 mf=0:goto1490
1790 rem get other computers coordinates
1800 get#1,h$:ifh$=""then1800
1810 get#1,v$:ifv$=""then1810
1820 h=asc(h$):v=asc(v$):mf=1:b=b%(v,h)
1830 ifb=0orb=1thenprint#1,chr$(135);:printm$""n1$" missed"
1835 ifb=0orb=1thengosub2210:goto1600
1840 print#1,chr$(134)chr$(b);
1850 gosub1250:printm$""n1$" gets a hit!":ts=ts-1:gosub2210
1860 b%(v,h)=1:gosub940:goto1600
1870 get#1,b$:ifb$=""then1870
1880 b=asc(b$):hs=hs-1
1890 b$=""+left$(s$(b),1)+"[146]":gosub1340
1900 goto 1920
1910 b$="*"
1920 print"":for q=1tov:print:next
1930 printtab(1+18+h)"[158]"b$
1940 goto1600
1950 rem send name to other computer
1960 rem forq=1to100:print#1,chr$(0);:next
1970 print#1,f1$;
1980 get#1,a$:ifa$<>f1$then1970
1990 for q=1tolen(n$):print#1,mid$(n$,q,1);:next:print#1,cr$;
2000 n1$=""
2010 get#1,a$:ifa$>=" "anda$<="z"thenn1$=n1$+a$
2020 ifa$<>chr$(13)then2010
2030 rem who goes first?
2040 for x=1to100:print#1,chr$(0);:next
2050 wf$=chr$(int(rnd(0)*100)+150)
2060 print#1,wf$;
2070 get#1,a$:ifa$=""then2060
2080 ifasc(a$)<150orasc(a$)>249then2070
2090 ifwf$=a$then2040
2100 mf=0:mf$="second":ifwf$>a$thenmf=1:mf$="first"
2110 gosub1370:printm$"we go "mf$
2120 for x=1to100:print#1,chr$(0);:next
2130 return
2140 rem other player ready? *******
2150 print#1,ds$
2160 get#1,a$:ifa$=ds$then2180
2170 printm$"please wait...":goto2150
2180 print#1,chr$(255);
2190 get#1,a$:ifa$<>chr$(255)then2190
2200 return
2210 for delay=1to1000:next:return
2220 print#1,chr$(136);:gosub2210:return
2230 rem signal other computer you are
2240 rem ready, wait for his signal.
2250 print"[147]waiting for other player..."
2260 print#1," push the f1 key. (i have!) "
2270 print#1,chr$(7);
2280 get#1,a$:ifa$<>chr$(7)then2270
2290 for x=1to10:print#1,chr$(7);:next:return