home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1989 / USER1289.MSA / LISTINGS_BATTLEX.BSC < prev    next >
Text File  |  1989-09-28  |  6KB  |  282 lines
  1. REM Serial battleships
  2. REM by Julia Forester
  3. REM (c) Atari St User
  4. REM Requires 96k workspace
  5. PROCinit
  6. REPEAT
  7. REPEAT
  8. PROCdrawmap
  9. PROCclearbuf
  10. PROCposition
  11. PROCstart
  12. REPEAT
  13. IF at THEN PROCdefend ELSE PROCattack
  14. at=at EOR 1
  15. UNTIL score=bits OR hits=bits
  16. UNTIL FNfini
  17. END
  18.  
  19. DEF PROCsend(X%,Y%,H%)
  20. bytes(0)=X%+32:bytes(1)=Y%+32:bytes(2)=H%+32
  21. bytes(3)=(X%+Y%+H%+32)
  22. REPEAT
  23. REPEAT:PROCput(19):UNTIL FNget=17
  24. FOR i=0 TO 3
  25. PROCput(bytes(i))
  26. NEXT
  27. IF FNget=0 THEN PROCmsg("Error sending"):sent=0:ELSE sent=1
  28. UNTIL sent
  29. PROCmsg("Message received ok")
  30. ENDPROC
  31.  
  32. DEF PROCreceive
  33. okts=1
  34. REPEAT
  35. REPEAT:UNTIL FNget=19:PROCput(17)
  36. FOR i=0 TO 3:bytes(i)=FNget:NEXT
  37. sum=0
  38. FOR j=0 TO 2:sum=sum+bytes(j)-32:NEXT
  39. IF sum+32=bytes(3) THEN okts=0
  40. IF okts THEN PROCput(0) ELSE PROCput(19)
  41. UNTIL okts=0
  42. PROCmsg("Message received ok")
  43. FOR j=0 TO 2:bytes(j)=bytes(j)-32:NEXT
  44. ENDPROC
  45.  
  46. DEF PROCput(byte)
  47. PROCmsg("Sending data...")
  48. REPEAT:UNTIL OUTSTAT(1)
  49. OUT (1),byte
  50. ENDPROC
  51.  
  52. DEF FNget
  53. PROCmsg("Waiting for data...")
  54. REPEAT:UNTIL INPSTAT(1)
  55. a=INP(1)
  56. =a
  57.  
  58. DEF PROCinit
  59. a=RND(-TIME)
  60. IF SCREENMODE THEN a=ALERT("[1][|16 colour version| |Change to low rez!][Right away Maam!]",1):END
  61. DIM number(6),coords(32,19),attack(32,19),bytes(3)
  62. RESERVE screen2,32512
  63. screen2=(screen2+512) AND $FFFFFF00
  64. screen1=PHYSBASE
  65. RS232 0,0
  66. PROCassemble
  67. GRAFRECT 0,0,320,200
  68. TXTRECT 0,0,320,200
  69. RESTORE colour:
  70. FOR n=0 TO 10:READ a,b,c,d:SETCOL a,b,c,d:NEXT
  71. CLG 13
  72. a=ALERT("[1][|BATTLESHIPS RS232|by Julia Forester|for Atari ST User][So this is healthy living?]",1)
  73. a=ALERT("[1][|Eat healthy things...| |Roast a vegetarian!][and they call this humor?]",1)
  74. SETMOUSE 3,0
  75. land$="ABCDEFGHIJJHIFHGGIJIIHGEFFEDDCBBA"
  76. ENDPROC
  77.  
  78. DEF PROCattack
  79. PHYSBASE=screen2
  80. LOGBASE=PHYSBASE
  81. PROCmsg("")
  82. PRINT TAB(2,1)"Attack phase - select square to bomb "
  83. REPEAT
  84. PROCcursor
  85. IF attack(X%,Y%)<>255 THEN VDU7:PROCalrt("Already attacked there!")
  86. UNTIL attack(X%,Y%)=255
  87. PROCatrect(X%,Y%,0)
  88. PROCsend(X%,Y%,1)
  89. PROCreceive
  90. h=bytes(2)
  91. IF h=0 THEN PROCalrt("Oops, we missed!")
  92. IF h<>0 THEN PROCalrt("Great shot kid!"):score=score+1
  93. PROCatrect(X%,Y%,h)
  94. ENDPROC
  95.  
  96. DEF PROCdefend
  97. PHYSBASE=screen1
  98. LOGBASE=PHYSBASE
  99. PROCmsg("")
  100. PRINT TAB(2,1)" Defence phase - here they come..."
  101. PROCreceive
  102. x=bytes(0):y=bytes(1)
  103. IF coords(x,y)<>14 AND coords(x,y)<>15 THEN
  104. PROCalrt("We've been hit!"):PROCsend(x,y,coords(x,y)):hits=hits+1 
  105. ELSE PROCalrt("They missed us"):PROCsend(x,y,0)
  106. ENDIF
  107. PROCrect(x,y,0)
  108. ENDPROC
  109.  
  110. DEF PROCdrawmap
  111. FOR x%=0 TO 32
  112. FOR y%=0 TO 19
  113. attack(x%,y%)=255:coords(x%,y%)=0
  114. NEXT:NEXT
  115. i%=0
  116. HIDEMOUSE
  117. FOR X=0 TO 319 STEP 10
  118. i%=i%+1
  119. land=ASC(MID$(land$,i%,1))-ASC"A"
  120. FOR Y=29 TO 189 STEP 10
  121. land=land-1
  122. IF land>0 THEN PROCrect(X/10,Y/10,14) ELSE PROCrect(X/10,Y/10,15)
  123. NEXT
  124. NEXT
  125. CALL code
  126. SHOWMOUSE
  127. ENDPROC
  128.  
  129. DEF PROCposition
  130. RESTORE
  131. PRINT TAB(11,1)"Positional phase";
  132. PROCalrt("Starting positional phase")
  133. score=0:hits=0:bits=0:at=1
  134. FOR n=1 TO 6:READ number(n):NEXT
  135. FOR n=1 TO 6
  136. FOR i=0 TO number(n)
  137. REPEAT:oops=0
  138. PROCname(n,i)
  139. PROCcursor
  140. PROCitem(X%,Y%,n,n+1)
  141. UNTIL oops=0
  142. NEXT
  143. NEXT
  144. ENDPROC
  145.  
  146. DEF PROCrect(x%,y%,c%)
  147. FILLCOL c%
  148. RECT x%*10+1,y%*10+1,x%*10+9,y%*10+9
  149. coords(x%,y%)=c%
  150. ENDPROC
  151.  
  152. DEFPROCatrect(x%,y%,c%)
  153. FILLCOL c%
  154. RECT x%*10+1,y%*10+1,x%*10+9,y%*10+9
  155. attack(x%,y%)=c%
  156. ENDPROC
  157.  
  158. DEF PROCcursor
  159. REPEAT
  160. MOUSE a,a,B%,a
  161. UNTIL (B% AND 1)=0
  162. REPEAT
  163. MOUSE X%,Y%,B%,K%
  164. UNTIL (B% AND 1) AND Y%>20 AND Y%<192 
  165. X%=(X% DIV 10):Y%=(Y% DIV 10)
  166. ENDPROC
  167.  
  168. DEF PROCitem(x%,y%,item,c%)
  169. IF FNtest(x%,y%,item,c%)=0 THEN PROCalrt("Can't put "+name$+" there"):oops=1:SETMOUSE 3,1:ENDPROC
  170. RESTORE ("set"+STR$(item))
  171. READ name$,items,a
  172. FOR i%=1 TO items
  173. READ xo%,yo%
  174. IF items>0 THEN PROCrect(x%+xo%,y%+yo%,c%):bits=bits+1
  175. NEXT
  176. PROCrect(x%,y%,c%):bits=bits+1
  177. ENDPROC
  178.  
  179. DEF PROCname(item,num)
  180. RESTORE ("set"+STR$(item))
  181. READ name$:PROCmsg("Position:"+name$+" #"+STR$(num+1))
  182. ENDPROC
  183.  
  184. DEF PROCmsg(txt$)
  185. FILLCOL 0:RECT 0,192,319,200
  186. PRINT TAB(0,24);txt$;
  187. ENDPROC
  188.  
  189. DEF FNtest(x%,y%,item,c%)
  190. ok=1
  191. RESTORE ("set"+STR$(item))
  192. READ name$,items,colour
  193. FOR i%=1 TO items
  194. READ xo%,yo%
  195. IF x%+xo%>0 AND x%+xo%<32 AND y%+yo%>0 AND y%+yo%<19 THEN PROCchk ELSE ok=0
  196. NEXT
  197. IF coords(x%,y%)<>colour THEN ok=0
  198. =ok
  199.  
  200. DEF PROCchk
  201. IF coords(x%+xo%,y%+yo%)<>colour THEN ok=0
  202. ENDPROC
  203.  
  204. DEF PROCalrt(msg$)
  205. GRAB 0,0,319,199:LOCAL x,y
  206. FILLCOL 0:FRRECT 40,75,280,150
  207. FOR x=0 TO 10 STEP 2
  208. LINECOL x
  209. RRECT 40+x,75+x,280-x,150-x
  210. NEXT
  211. PRINT TAB(7,12)"Guru Meditation Commander"
  212. PRINT TAB(20-LEN(msg$)/2,14)msg$
  213. TIME=0:REPEAT:UNTIL TIME>300
  214. PUT 0,0,3
  215. ENDPROC
  216.  
  217. DEFPROCclearbuf
  218. PROCalrt("Clearing buffer")
  219. REPEAT:IF INPSTAT(1) THEN n=INP(1)
  220. PROCmsg(STR$(n)):UNTIL INPSTAT(1)=0
  221. PROCmsg("Ok. Buffer cleared!")
  222. ENDPROC
  223.  
  224. DEFPROCstart
  225. at=FNwhosFirst
  226. IF at THEN PROCalrt("Prepare to defend thyself") ELSE PROCalrt("May victory be swift!")
  227. ENDPROC
  228.  
  229. DEFFNwhosFirst
  230. a=ALERT("[2][| |Will you be attacker|or defender][Attack|Defend|Auto]",3)-1
  231. IF a=2 THEN IF INPSTAT(1)=0 THEN OUT(1),64:a=0 ELSE IF a=2 THEN a=1
  232. =a
  233.  
  234. DEFFNfini
  235. IF score=bits THEN 
  236. a=ALERT("[1][| Congratulations|Enemy force repelled...][Play!|Quit]",1)-1
  237. ELSE a=ALERT("[1][|Attack force destroyed|All is lost...][Play|Surrender]",1)-1
  238. ENDIF
  239. IF a=0 THEN RUN
  240. =a
  241.  
  242. DEF PROCassemble
  243. RESERVE code,200
  244. FOR pass=0 TO 2 STEP 2
  245. [
  246. OPT pass,"L-W+"
  247. ORG 0,code
  248. transfer
  249. MOVE.L #PHYSBASE,A0
  250. MOVE.L #screen2,A1
  251. MOVE #8000,D0
  252. loop
  253. MOVE.L (A0)+,(A1)+
  254. DBRA D0,loop
  255. RTS
  256. ]
  257. NEXT
  258. ENDPROC
  259.  
  260. items:
  261. DATA 3,5,6,5,4,3
  262.  
  263. set1:
  264. DATA "Artillery",4,14,2,0,1,1,0,2,2,2
  265. set2:
  266. DATA "Infantry ",0,14,0,0
  267. set3:
  268. DATA "Cruiser",2,15,1,0,2,0
  269. set4:
  270. DATA "Aircraft",4,15,-1,1,0,1,1,1,0,2
  271. set5:
  272. DATA "Submarine",1,15,1,0
  273. set6:
  274. DATA "Carrier",5,15,1,0,2,0,3,0,4,0,2,-1
  275.  
  276. colour:
  277. DATA 11,0,3,2, 13,0,1,4, 0,0,0,0
  278. DATA 1,5,5,5, 2,7,1,1, 4,0,7,7
  279. DATA 6,7,5,5, 3,5,6,7, 5,4,7,2
  280. DATA 14,0,0,0, 15,7,7,7
  281.  
  282.