Programación y Estructuras. RPN / QB64: marzo 2022

NAVY - Hundir la Flota

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

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

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.

' 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 "ú"

Rem coloca los barcos en el tablero

For n = 2 To 6

ponerbarco n

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

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)

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

Loop Until ocu = 0

For hh = h To h + ancho - 1

For vv = v To v + alto - 1

mi.mar(hh, vv) = l

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 "ú"

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

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 "ú"

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

Inicio Entrada antigua

Superficie de triangulos

Emulador HP-41CV. Windows PC

Permite cargar desde un archivo.txt cualquier programa

Program=TRI

STO 00

ᵀA?

PROMPT

STO 01

ᵀB?

PROMPT

STO 02

ᵀC?

PROMPT

STO 03

RCL 01

RCL 02

RCL 03

STO 04

RCL 04

RCL 03

RCL 04

RCL 02

RCL 04

RCL 01

RCL 04

SQRT

ST+ 00

ᵀS=

FIX 2

ARCL 00

AVIEW

STOP

EndProgram

Inicio Entrada antigua

Programa de Biorritmo 1982

Este programa lo realice en 1982 con la HP 41C, usando funciones de ploteo gráfico de la impresora térmica 82143A. necesita la impresora térmica para funcionar.

Los biorritmos pretenden predecir diversos aspectos de la vida de un individuo utilizando ciclos matemáticos sencillos. Se supone que estos ciclos dependen del momento del nacimiento y siguen ondas sinusoidales con un periodo de 23 días para el aspecto físico, 28 para el emocional y 33 para el intelectual.

Blackjack Juego

Blackjack Emulador Free42 HP-42S (original de Richard Garner- adaptada J. Schwarzmann 2023)

Este programa es una reelaboración del programa Blackjack que se encuentra en el paquete de aplicación estándar 41c.

Ejecute CARD y configurará el programa y el menú.

Ingrese su apuesta y presione REPARTIR.

MAS significa añadir otra carta a tu mano.

QUÉDO significa que jugarás las cartas que tengas.

BARAJAR significa que desea barajar manualmente la baraja. Si no desea cambiar su apuesta en la siguiente mano, simplemente presione REPARTIR.

00 { 616-Byte Prgm }

01▸LBL "CARD"

02 CLMENU

03 CLST

04 "REPARTIR"

05 KEY 1 XEQ 34

06 "MAS"

07 KEY 2 XEQ 31

08 "QUEDO"

09 KEY 3 XEQ 32

10 "BARAJAR"

11 KEY 4 XEQ 33

12 SIZE 27

13 FIX 00

14 CF 28

15 CF 29

16 SF 27

17▸LBL 21

18 CLA

19 ASTO 19

20 1

21 STO 15

22 RAN

23 RCL 14

24 ×

25 IP

26 1

27 +

28▸LBL 02

29 RCL IND 15

30 X>Y?

31 GTO 03

32 -

33 ISG 15

34▸LBL 99

35 GTO 02

36▸LBL 03

37 DSE IND 15

38▸LBL 15

39 DSE 14

40 12

41 RCL 14

42 X>Y?

43 GTO 04

44 XEQ 33

45▸LBL 04

46 RCL 15

47 STO 16

48 10

49 X≤Y?

50 GTO 00

51 X<>Y

52 STO 16

53 1

54 X=Y?

55 GTO 41

56 CLA

57 ARCL ST Y

58 GTO 01

59▸LBL 00

60 STO 16

61 CLX

62 10

63 X=Y?

64 GTO 10

65 1

66 +

67 X=Y?

68 GTO J

69 1

70 +

71 X=Y?

72 GTO 25

73 "K"

74 GTO 01

75▸LBL 41

76 "A"

77 CF 07

78 GTO 01

79▸LBL 25

80 "Q"

81 GTO 01

82▸LBL J

83 "J"

84 GTO 01

85▸LBL 10

86 "10"

87▸LBL 01

88 ASTO 19

89 RCL 16

90 MENU

91 RTN

92▸LBL 33

93 "BARAJAR"

94 AVIEW

95 1,013

96 ENTER

97 8

98▸LBL 14

99 STO IND ST Y

100 ISG ST Y

101 GTO 14

102 104

103 STO 14

104 RTN

105▸LBL 34

106 CF 09

107 SF 07

108 ABS

109 IP

110 FS?C 22

111 STO 22

112 RCL 22

113 STO 20

114 SF 06

115 CLA

116 ASTO 26

117 ASTO 25

118 XEQ 21

119 RCL 15

120 STO 17

121 XEQ 21

122 STO 23

123 CF 08

124 FS? 07

125 SF 08

126 CLA

127 ARCL 19

128 ARCL 25

129 ASTO 25

130 "YO MUESTRO "

131 ARCL 25

132 AVIEW

133 SF 07

134 0

135 STO 24

136 XEQ 21

137 XEQ 23

138 XEQ 21

139 XEQ 23

140 RCL 24

141 10

142 FS? 07

143 CLX

144 +

145 21

146 X≠Y?

147 SF 09

148 FS? 09

149 RTN

150 21,5

151 STO 24

152 1,5

153 STO× 20

154 "BLACKJACK"

155 AVIEW

156 PSE

157▸LBL 32

158 CF 06

159 FS? 07

160 GTO 05

161 11

162 RCL 24

163 X>Y?

164 GTO 05

165 10

166 STO+ 24

167▸LBL 05

168 CF 07

169 FS? 08

170 SF 07

171 RCL 17

172 STO 15

173 XEQ 04

174 XEQ 24

175 FS? 07

176 GTO 07

177 11

178 RCL 23

179 X≠Y?

180 GTO 07

181 21,5

182 STO 23

183 "YO TENGO BLACKJAC"

184 ├"K"

185 AVIEW

186 PSE

187 GTO 07

188▸LBL 06

189 XEQ 21

190 XEQ 24

191▸LBL 07

192 FS? 06

193 GTO 09

194 FC? 09

195 GTO 08

196 RCL 23

197 17

198 X≤Y?

199 GTO 08

200 FS? 07

201 GTO 06

202 11

203 RCL 23

204 X>Y?

205 GTO 06

206 7

207 X>Y?

208 GTO 06

209 10

210 STO+ 23

211▸LBL 08

212 21,5

213 RCL 23

214 X>Y?

215 XEQ 22

216 RCL 24

217 -

218 X=0?

219 XEQ 20

220 X>0?

221 SF 06

222▸LBL 09

223 RCL 20

224 FS? 06

225 +/-

226 STO+ 21

227 "TU BANCA ES $"

228 ARCL 21

229 AVIEW

230 RTN

231▸LBL 31

232 XEQ 21

233 XEQ 23

234 RCL 24

235 21,5

236 X>Y?

237 RTN

238 "BUST"

239 AVIEW

240 PSE

241 GTO 05

242▸LBL 22

243 "BUST"

244 AVIEW

245 PSE

246 0

247 RTN

248▸LBL 23

249 STO+ 24

250 CLA

251 ARCL 26

252 ARCL 19

253 ASTO 26

254 "TU TIENES "

255 ARCL 26

256 AVIEW

257 RTN

258▸LBL 24

259 STO+ 23

260 CLA

261 ARCL 25

262 ARCL 19

263 ASTO 25

264 "YO TENGO "

265 ARCL 25

266 AVIEW

267 PSE

268 RTN

269▸LBL 20

270 "EMPATE"

271 AVIEW

272 PSE

273 STO× 20

274 .END.

Inicio Entrada antigua

Descomponer una palabra en caracteres Free 42

Descomponer una palabra en caracteres

(version programa HP 41C realizada en 1982)

Versión FREE 42 Publicada en abril 2023

00 { 172-Byte Prgm }

01▸LBL "DE"

02 CLST

03 CLRG

04 CF 01

05 0

06 STO 20

07 AON

08 "PALABRA?"

09 PROMPT

10 ALENG

11 STO 14

12 7

13 X>Y?

14 GTO 03

15 GTO 01

16▸LBL 02

17 STO 13

18 ASTO 00

19 ASHF

20 ASTO 01

21▸LBL 00

22 " "

23 ARCL 00

24 ASTO 00

25 ASHF

26 FS? 01

27 ARCL 01

28 FS? 01

29 ASTO 01

30 FS? 01

31 ASHF

32 ASTO IND 13

33 DSE 13

34 GTO 00

35 " "

ADV

36 XEQ 10

37 STOP

38▸LBL 03

39 1

40 -

41 GTO 02

42▸LBL 01

43 SF 01

44 RCL 14

45 12

46 X=Y?

47 GTO 04

48 RCL 14

49 11

50 X=Y?

51 GTO 05

52 RCL 14

53 10

54 X=Y?

55 GTO 06

56 RCL 14

57 9

58 X=Y?

59 GTO 07

60 RCL 14

61 8

62 X=Y?

63 GTO 08

64 RCL 14

65 7

66 X=Y?

67 GTO 09

68▸LBL 04

69 GTO 02

70▸LBL 05

71 1

72 +

73 GTO 02

74▸LBL 06

75 2

76 +

77 GTO 02

78▸LBL 07

79 3

80 +

81 GTO 02

82▸LBL 08

83 4

84 +

85 GTO 02

86▸LBL 09

87 5

88 +

89 GTO 02

90▸LBL 10

91 CLA

92 CLST

93 ISG 20

94 CLA

95 ARCL IND 20

96 AVIEW

97 ADV

98 RCL 14

99 RCL 20

100 X=Y?

101 STOP

102 GTO 10

103 RTN

104 .END.

Reescribo el mismo programa en QB 64

Dim TextoI$(30)

Dim T$(30)

Input "ESCRIBA UN TEXTO; ", NB$

LT = Len(NB$)

Print LT

For I = 1 To LT

TextoI$ = Mid$(NB$, I, 1)

T$(I) = TextoI$

For I = 1 To LT

Print T$(I)

Inicio Entrada antigua