Programa realizado por mí en 1982 con la HP 41C y actualizado con Free42S
1 Lancha 1 casilla
2 Destructor 2 casillas
3 Crucero 3 casillas
4 Acorazado 4 casillas
5 Antiaéreo 1 casilla
Cuadrante código disparo > Columna Fila
XEQ "NAVY " Inicia el Juego
XEQ "GRA" Imprime cuadrante con la situación de los barcos. (opcional)XEQ "DISPARO" Disparo sobre cuadrante
Cada 3 disparos al agua, se destruye 1 avión
1 disparo sobre un antiaéreo destruye 1 avión
Cada barco hundido refuerza la escuadrilla de aviones :
Lancha + 1 avión
Destructor + 2 aviones
Crucero + 3 aviones
Acorazado + 4 aviones
Programa realizado en QBasic por JM, modificado por mí para poder ver el tablero con los barcos, guardando su situación y los datos de la partida realizada en un fichero.
00 { 1093-Byte Prgm }
01▸LBL "NAVY"
02▸LBL F
03 CLRG
04 1.001
05 STO 01
06 1.002
07 STO 02
08 1.003
09 STO 03
10 1.004
11 STO 04
12 0.002
13 STO 06
14 FC? 55
15 GTO G
16 SF 12
17 "BATALLA"
18 PRA
19 SIZE 100
20 CF 12
21▸LBL G
22 CLMENU
23 MENU
24 "NR, BARCOS?"
25 PROMPT
26 STO 08
27 "NR. AVIONES?"
28 PROMPT
29 STO 07
30 CF 21
31 CLST
32 CLMENU
33 "LANCH"
34 KEY 1 XEQ a
35 "DESTR"
36 KEY 2 XEQ b
37 "CRUC"
38 KEY 3 XEQ c
39 "ACOR"
40 KEY 4 XEQ d
41 "ANTI"
42 KEY 5 XEQ e
43 "DISP"
44 KEY 6 XEQ A
45 STOP
46▸LBL a
47 "•LANC"
48 KEY 1 XEQ a
49 " LANC> [LF]"
50 ASTO 91
51 XEQ 09
52 1
53 STO IND 00
54 XEQ 90
55 GTO a
56▸LBL b
57 "•DEST"
58 KEY 2 XEQ b
59 " DEST> [LF]"
60 ASTO 91
61 XEQ 09
62 2
63 STO IND 00
64 XEQ 90
65 GTO b
66▸LBL c
67 "•CRUC"
68 KEY 3 XEQ c
69 " CRUC> [LF]"
70 ASTO 91
71 XEQ 09
72 3
73 STO IND 00
74 XEQ 90
75 GTO c
76▸LBL d
77 "•ACOR"
78 KEY 4 XEQ d
79 " ACOR> [LF]"
80 ASTO 91
81 XEQ 09
82 4
83 STO IND 00
84 XEQ 90
85 GTO d
86▸LBL e
87 "•ANTI"
88 KEY 5 XEQ e
89 " ANTI> [LF]"
90 ASTO 91
91 XEQ 09
92 5
93 STO IND 00
94 XEQ 90
95 GTO e
96▸LBL 09
97 "CUADRO?"
98 PROMPT
99 STO 00
100 RTN
101▸LBL 15
102 DSE 08
103 GTO 18
104 GTO 16
105▸LBL 18
106 AVIEW
107 PSE
108 0
109 STO IND 00
110 GTO A
111▸LBL "GRA"
112 SF 21
113 CLA
114 " 1 2 3 4 5 6 "
115 ├"7 8 9"
116 AVIEW
117 CLA
118 "1>"
119 ARCL 11
120 ARCL 12
121 ARCL 13
122 ARCL 14
123 ARCL 15
124 ARCL 16
125 ARCL 17
126 ARCL 18
127 ARCL 19
128 AVIEW
129 CLA
130 ARCL 21
131 "2>"
132 ARCL 21
133 ARCL 22
134 ARCL 23
135 ARCL 24
136 ARCL 25
137 ARCL 26
138 ARCL 27
139 ARCL 28
140 ARCL 29
141 AVIEW
142 CLA
143 "3>"
144 ARCL 31
145 ARCL 32
146 ARCL 33
147 ARCL 34
148 ARCL 35
149 ARCL 36
150 ARCL 37
151 ARCL 38
152 ARCL 39
153 AVIEW
154 CLA
155 "4>"
156 ARCL 41
157 ARCL 42
158 ARCL 43
159 ARCL 44
160 ARCL 45
161 ARCL 46
162 ARCL 47
163 ARCL 48
164 ARCL 49
165 AVIEW
166 CLA
167 "5>"
168 ARCL 51
169 ARCL 52
170 ARCL 53
171 ARCL 54
172 ARCL 55
173 ARCL 56
174 ARCL 57
175 ARCL 58
176 ARCL 59
177 AVIEW
178 CLA
179 "6>"
180 ARCL 61
181 ARCL 62
182 ARCL 63
183 ARCL 64
184 ARCL 65
185 ARCL 66
186 ARCL 67
187 ARCL 68
188 ARCL 69
189 AVIEW
190 STOP
191 RTN
192▸LBL "DISP"
193▸LBL A
194 CLMENU
195 CF 01
196 FS? 55
197 SF 21
198 FIX 00
199 "•DISP"
200 KEY 6 XEQ A
201 MENU
202 "DISPARO>"
203 PROMPT
204 STO 00
205 RCL IND 00
206 1
207 X<>Y
208 X=Y?
209 GTO 01
210 2
211 X<>Y
212 X=Y?
213 GTO 02
214 3
215 X<>Y
216 X=Y?
217 GTO 03
218 4
219 X<>Y
220 X=Y?
221 GTO 04
222 5
223 X<>Y
224 X=Y?
225 GTO 05
226 ISG 06
227 GTO 07
228 GTO 06
229▸LBL 07
230 "-AGUA ""
231 ARCL 00
232 AVIEW
233 PSE
234 GTO A
235▸LBL 01
236 ISG 01
237 GTO 21
238 GTO 11
239▸LBL 21
240 "LANCHA "
241 XEQ 00
242 RTN
243▸LBL 02
244 ISG 02
245 GTO 22
246 GTO 12
247▸LBL 22
248 "DESTRUCTOR "
249 XEQ 00
250 RTN
251▸LBL 03
252 ISG 03
253 GTO 23
254 GTO 13
255▸LBL 23
256 "CRUCERO "
257 XEQ 00
258 RTN
259▸LBL 04
260 ISG 04
261 GTO 24
262 GTO 14
263▸LBL 24
264 "ACORAZADO "
265 XEQ 00
266 RTN
267▸LBL 05
268 TONE 4
269 CF 26
270 SF 01
271 "ANTIAEREO "
272 XEQ 00
273▸LBL 06
274 CF 01
275 SF 26
276 TONE 8
277 TONE 7
278 TONE 6
279 DSE 07
280 GTO 19
281 GTO 08
282▸LBL 19
283 "*** DESTR. AVIO"
284 ├"N + "
285 ARCL 07
286 AVIEW
287 0.002
288 STO 06
289 GTO A
290▸LBL 00
291 TONE 0
292 TONE 4
293 ARCL 00
294 AVIEW
295 PSE
296 0
297 STO IND 00
298 0.002
299 STO 06
300 FS? 01
301 RTN
302 GTO A
303▸LBL 11
304 SF 01
305 XEQ 21
306 TONE 5
307 1
308 STO+ 07
309 "++++HUNDI.LANCH"
310 ├"A +++"
311 XEQ 15
312▸LBL 12
313 SF 01
314 XEQ 22
315 2
316 STO+ 07
317 TONE 6
318 "+++HUNDI.DESTR"
319 ├"UCTOR +++"
320 XEQ 15
321▸LBL 13
322 SF 01
323 XEQ 23
324 TONE 7
325 3
326 STO+ 07
327 "+++HUNDI.CRUCE"
328 ├"RO +++"
329 XEQ 15
330▸LBL 14
331 SF 01
332 XEQ 24
333 TONE 8
334 4
335 STO+ 07
336 "+++HUNDI.ACORA"
337 ├"ZADO +++"
338 XEQ 15
339▸LBL 16
340 BEEP
341 "BASE NAVAL DEST"
342 ├"RUIDA"
343 AVIEW
344 STOP
345▸LBL 08
346 BEEP
347 "ESCUADRILLA DES"
348 ├"TRUIDA"
349 AVIEW
350 STOP
351 RTN
352▸LBL 90
353 ARCL 91
354 ARCL 00
355 AVIEW
356 PSE
357 RTN
358 END
' JUEGO MEMORIZAR TABLERO BARCOS
' (Entra XX para visualizar situacion barcos modo grafico)
'________________________BARCMemo____________________________
' (Para ver situación barcos modo texto >> Entrar)
DECLARE FUNCTION prueba! (c$)
DECLARE SUB ponerbarco (l!)
DECLARE SUB pinta.mi ()
Dim Shared mi.mar(0 To 9, 0 To 9)
Dim Shared tu.mar(0 To 9, 0 To 9)
Randomize Timer
I = 0
XX = 0
Color 9, 1: Cls
Locate 24, 55: Print "Para salir escribir 00";
Rem dibuja el tablero de juego
Palette 1, 8
Palette 12, 36
For v = 3 To 12
Color 15: Locate v, 8: Print Chr$(62 + v)
For h = 10 To 28 Step 2
Color 15: Locate 2, h - 1: Print (h / 2) - 5
Color 9: Locate v, h: Print "ú"
Next
Next
Rem coloca los barcos en el tablero
For n = 2 To 6
ponerbarco n
Next
Rem borra el fichero de registro
Outputfile$ = "Barfile.txt"
Open Outputfile$ For Output As #2
Close #2
Barcopinta (XX)
Rem comienza la jugada
Color 15
Do
Color 3
Locate 20, 10: Print Space$(60)
Locate 21, 10: Print Space$(60)
XX = XX + 2
Locate 20, 10: Input "Coordenada: ", coord$
Locate 15, 10: Print " "
coord1$ = UCase$(coord$)
letra$ = UCase$(Mid$(coord$, 1, 1))
Rem****** compueba en el archivo Barfile.txt y si no se repite la adjunta (variable cct<>1)
cct = 0
Open Outputfile$ For Input As #2
Do While Not EOF(2)
Line Input #2, coord2$
coord3$ = Mid$(coord2$, 1, 2)
If coord3$ = coord1$ Then cct = 1
Loop
Close #2
If cct <> 1 Then Archiva (coord$)
num = Val(Mid$(coord$, 2, 1))
If cct <> 1 Then Locate 15, 5: Print letra$; num
ccc = prueba(coord$)
coord1$ = UCase$(coord$)
If coord1$ = "XX" Then Barcopinta (XX)
If coord1$ = "" Then Barcolectura
Rem If coord1$ = "YY" Then Barcotocado
comp = prueba(coord$)
If comp = 1 Then ccc = 1
letra3$ = UCase$(Mid$(coord$, 3, 3))
If letra3$ <> "" Then ccc = 1
If ccc = 1 Then
Rem Print , , "Coordenada no valida"
Beep
Else
v = Asc(letra$) - 65
h = num
vv = v + 3
hh = (h * 2) + 10
Select Case mi.mar(v, h)
Case 0: Tip$ = "W": Color 9: Locate vv, hh: Print "": If cct <> 1 Then Sound 200, 3: Locate 15, 10: Print "agua "
Case Else: Tip$ = "S": Color 12: Locate vv, hh: Print "+": If cct <> 1 Then Sound 2000, 3: Locate 15, 10: Print "Barco"
End Select
Color 15
End If
Loop Until coord$ = "00"
Sub Barcolectura
Rem lectura archivo Barcofile.txt
Barcotocado
Locate 25, 1
Barcofile$ = "Barcofile.txt"
Open Barcofile$ For Input As #1
Do While Not EOF(1)
Line Input #1, linea$
Print linea$; "-";
Loop
Close #1
Sleep 5
Barcoborra
End Sub
Sub Barcoborra
Rem Borra la linea inferior
Locate 24, 1
Print linea$; " ";
Locate 25, 1
Print linea$; " ";
End Sub
Sub ponerbarco (l)
Do
ocu = 0
If Rnd < .5 Then
alto = l: ancho = 1: h = Int(Rnd * 10): v = Int(Rnd * (10 - l))
Else
alto = 1: ancho = l: v = Int(Rnd * 10): h = Int(Rnd * (10 - l))
End If
For hh = h To h + ancho - 1
For vv = v To v + alto - 1
If mi.mar(hh, vv) <> 0 Then ocu = ocu + 1
Next
Next
Loop Until ocu = 0
For hh = h To h + ancho - 1
For vv = v To v + alto - 1
mi.mar(hh, vv) = l
Next
Next
End Sub
Sub Barcotocado
Rem lectura archivo Barfile.txt
Locate 24, 1
Barfile$ = "Barfile.txt"
Rem Open Barfile$ For Input As #1
Rem Do While Not EOF(1)
Rem Line Input #1, linea$
Rem Loop
Rem Close #1
Rem Sleep 5
Rem Borra la pantalla y dibuja el tablero
Color 9, 1: Cls
Locate 25, 55: Print "XX >> Situacion Barcos Barcofile.txt >> Salir 00 "; Rem "Entrar";
Rem (Barco=S Agua=W)
Rem Locate 24, 55: Print "Para salir escribir 00";
Palette 1, 8
Palette 12, 36
For v = 3 To 12
Color 15: Locate v, 8: Print Chr$(62 + v)
For h = 10 To 28 Step 2
Color 15: Locate 2, h - 1: Print (h / 2) - 5
Color 9: Locate v, h: Print "ú"
Next
Next
Open Barfile$ For Input As #1
Color 7: Locate 21, 1
Do While Not EOF(1)
Line Input #1, linea$
coord$ = Mid$(linea$, 1, 2)
restaura (coord$)
Rem letra3$ = UCase$(Mid$(linea$, 3, 3))
Rem If letra3$ = "S" Then Print Letra12$; "-";
Loop
Close #1
End Sub
Sub restaura (coord$)
Rem restaura situacion jugada
letra$ = UCase$(Mid$(coord$, 1, 1))
num = Val(Mid$(coord$, 2, 1))
Rem ccc = prueba(coord$)
Rem ccc = 1 Then Print , , "" Else
v = Asc(letra$) - 65
h = num
vv = v + 3
hh = (h * 2) + 10
Select Case mi.mar(v, h)
Case 0: Color 9: Locate vv, hh: Print ""
Case Else: Color 12: Locate vv, hh: Print "+"
End Select
End Sub
Sub Barcopinta (XX)
Rem las subrutina no guarda los valores de las variables y al comenzar las pone todas a 0
Rem I = 0 no hace falta poner la variable del contador a 0
Barcofile$ = "Barcofile.txt"
Open Barcofile$ For Output As #1
Do
Locate 20, 10: Print Space$(60)
Locate 21, 10: Print Space$(60)
I = I + 1
If I < 102 Then
' If I = 1 Then coord$ = "A0" Else If I = 2 Then coord$ = "A1" Else If I = 3 Then coord$ = "A2" Else If I = 4 Then coord$ = "A3"
' If I = 5 Then coord$ = "A4" Else If I = 6 Then coord$ = "A5" Else If I = 7 Then coord$ = "A6" Else If I = 8 Then coord$ = "A7" Else If I = 9 Then coord$ = "A8" Else If I = 10 Then coord$ = "A9" ......
Select Case I
Case 1
coord$ = "A0"
Case 2
coord$ = "A1"
Case 3
coord$ = "A2"
Case 4
coord$ = "A3"
Case 5
coord$ = "A4"
Case 6
coord$ = "A5"
Case 7
coord$ = "A6"
Case 8
coord$ = "A7"
Case 9
coord$ = "A8"
Case 10
coord$ = "A9"
Case 11
coord$ = "B0"
Case 12
coord$ = "B1"
Case 13
coord$ = "B2"
Case 14
coord$ = "B3"
Case 15
coord$ = "B4"
Case 16
coord$ = "B5"
Case 17
coord$ = "B6"
Case 18
coord$ = "B7"
Case 19
coord$ = "B8"
Case 20
coord$ = "B9"
Case 21
coord$ = "C0"
Case 22
coord$ = "C1"
Case 23
coord$ = "C2"
Case 24
coord$ = "C3"
Case 25
coord$ = "C4"
Case 26
coord$ = "C5"
Case 27
coord$ = "C6"
Case 28
coord$ = "C7"
Case 29
coord$ = "C8"
Case 30
coord$ = "C9"
Case 31
coord$ = "D0"
Case 32
coord$ = "D1"
Case 33
coord$ = "D2"
Case 34
coord$ = "D3"
Case 35
coord$ = "D4"
Case 36
coord$ = "D5"
Case 37
coord$ = "D6"
Case 38
coord$ = "D7"
Case 39
coord$ = "D8"
Case 40
coord$ = "D9"
Case 41
coord$ = "E0"
Case 42
coord$ = "E1"
Case 43
coord$ = "E2"
Case 44
coord$ = "E3"
Case 45
coord$ = "E4"
Case 46
coord$ = "E5"
Case 47
coord$ = "E6"
Case 48
coord$ = "E7"
Case 49
coord$ = "E8"
Case 50
coord$ = "E9"
Case 51
coord$ = "F0"
Case 52
coord$ = "F1"
Case 53
coord$ = "F2"
Case 54
coord$ = "F3"
Case 55
coord$ = "F4"
Case 56
coord$ = "F5"
Case 57
coord$ = "F6"
Case 58
coord$ = "F7"
Case 59
coord$ = "F8"
Case 60
coord$ = "F9"
Case 61
coord$ = "G0"
Case 62
coord$ = "G1"
Case 63
coord$ = "G2"
Case 64
coord$ = "G3"
Case 65
coord$ = "G4"
Case 66
coord$ = "G5"
Case 67
coord$ = "G6"
Case 68
coord$ = "G7"
Case 69
coord$ = "G8"
Case 70
coord$ = "G9"
Case 71
coord$ = "H0"
Case 72
coord$ = "H1"
Case 73
coord$ = "H2"
Case 74
coord$ = "H3"
Case 75
coord$ = "H4"
Case 76
coord$ = "H5"
Case 77
coord$ = "H6"
Case 78
coord$ = "H7"
Case 79
coord$ = "H8"
Case 80
coord$ = "H9"
Case 81
coord$ = "I0"
Case 82
coord$ = "I1"
Case 83
coord$ = "I2"
Case 84
coord$ = "I3"
Case 85
coord$ = "I4"
Case 86
coord$ = "I5"
Case 87
coord$ = "I6"
Case 88
coord$ = "I7"
Case 89
coord$ = "I8"
Case 90
coord$ = "I9"
Case 91
coord$ = "J0"
Case 92
coord$ = "J1"
Case 93
coord$ = "J2"
Case 94
coord$ = "J3"
Case 95
coord$ = "J4"
Case 96
coord$ = "J5"
Case 97
coord$ = "J6"
Case 98
coord$ = "J7"
Case 99
coord$ = "J8"
Case 100
coord$ = "J9"
Case 101
coord$ = "00"
End Select
End If
letra$ = UCase$(Mid$(coord$, 1, 1))
num = Val(Mid$(coord$, 2, 1))
ccc = prueba(coord$)
If ccc = 1 Then
Print , , ""
Else
v = Asc(letra$) - 65
h = num
vv = v + 3
hh = (h * 2) + 10
Select Case mi.mar(v, h)
Case 0: Color 9: Locate vv, hh: Print ""
Case Else: Color 12: Locate vv, hh: Print "+"
Rem graba posicion Barco en archivo
Print #1, coord$
End Select
Color 15
End If
Loop Until coord$ = "00"
Close #1
If XX > 1 Then Sleep 2
Rem Input "Dibujo el tablero "
Color 9, 1: Cls
Locate 25, 55: Print "XX >> Situacion Barcos Barcofile.txt >> Salir 00 ";
Rem (Barco=S Agua=W) "
Rem Locate 24, 55: Print "Para salir escribir 00";
Palette 1, 8
Palette 12, 36
For v = 3 To 12
Color 15: Locate v, 8: Print Chr$(62 + v)
For h = 10 To 28 Step 2
Color 15: Locate 2, h - 1: Print (h / 2) - 5
Color 9: Locate v, h: Print "ú"
Next
Next
Barcotocado
End Sub
'______________________________________________________________________
'
Sub Archiva (coord$)
Rem tipifica el disparo W=agua S=Barco
letra$ = UCase$(Mid$(coord$, 1, 1))
letra2$ = UCase$(Mid$(coord$, 2, 2))
If letra$ = "X" Then GoTo Fin
If letra$ = "Y" Then GoTo Fin
If letra$ = "" Then GoTo Fin
comp = prueba(coord$)
If comp = 1 Then GoTo Fin
If letra2$ = "10" Then GoTo Fin
If letra2$ = "11" Then GoTo Fin
num = Val(Mid$(coord$, 2, 1))
v = Asc(letra$) - 65
h = num
vv = v + 3
hh = (h * 2) + 10
Select Case mi.mar(v, h)
Case 0: Tip$ = "W"
Case Else: Tip$ = "S"
End Select
coord1$ = UCase$(coord$)
Outputfile$ = "Barfile.txt"
Open Outputfile$ For Append As #2
Print #2, coord1$; Tip$
Fin:
Close #2
End Sub
'______________________________________________________________________
'
Function prueba (coord$)
comp = 0
Select Case UCase$(Mid$(coord$, 1, 1))
Case "A"
Case "B"
Case "C"
Case "D"
Case "E"
Case "F"
Case "G"
Case "H"
Case "I"
Case "J"
Case Else: comp = 1
End Select
prueba = comp
End Function