RosettaCodeData/Task/24-game/FreeBASIC/24-game.basic

109 lines
3.0 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

' The 24 game en FreeBASIC
Const operaciones = "*/+-"
Declare Sub Encabezado
Declare Function escoge4() As String
Declare Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Declare Function evaluaEntrada(cadena As String) As Integer
Declare Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim Shared As String serie, entrada, cadena
Dim As Integer resultado
Sub Encabezado
Cls: Color 15
Print "The 24 Game"
Print "============" + Chr(13) + Chr(10)
Print "Dados cuatro dígitos en el rango de 1 a 9, que pueden repetirse, "
Print "usando solo los operadores aritméticos suma (+), resta (-), "
Print "multiplicación (*) y división (/) intentar obtener un resultado de 24." + Chr(13) + Chr(10)
Print "Use la notación polaca inversa (primero los operandos y luego los operadores)."
Print "Por ejemplo: en lugar de 2 + 4, escriba 2 4 +" + Chr(13) + Chr(10)
End Sub
Function escoge4() As String
Dim As Byte i
Dim As String a, b
Print "Los dígitos a utilizar son: ";
For i = 1 To 4
a = Str(Int(Rnd*9)+1)
Print a;" ";
b = b + a
Next i
escoge4 = b
End Function
Function evaluaEntrada(cadena As String) As Integer
Dim As Byte oper1, oper2, n(4), i
Dim As String op
oper1 = 0: oper2 = 0: i = 0
While cadena <> ""
op = Left(cadena, 1)
entrada = Mid(cadena, 2)
If Instr(serie, op) Then
i = i + 1
n(i) = Val(op)
Elseif Instr(operaciones, op) Then
oper2 = n(i)
n(i) = 0
i = i - 1
oper1 = n(i)
n(i) = evaluador(oper1, oper2, op)
Else
Print "Signo no v lido"
End If
Wend
evaluaEntrada = n(i)
End Function
Function evaluador(oper1 As Byte, oper2 As Byte, operacion As String) As Integer
Dim As Integer t
Select Case operacion
Case "+": t = oper1 + oper2
Case "-": t = oper1 - oper2
Case "*": t = oper1 * oper2
Case "/": t = oper1 / oper2
End Select
evaluador = t
End Function
Function quitaEspacios(cadena As String, subcadena1 As String, subcadena2 As String) As String
Dim As Byte len1 = Len(subcadena1), len2 = Len(subcadena2)
Dim As Byte i
i = Instr(cadena, subcadena1)
While i
cadena = Left(cadena, i - 1) & subcadena2 & Mid(cadena, i + len1)
i = Instr(i + len2, cadena, subcadena1)
Wend
quitaEspacios = cadena
End Function
'--- Programa Principal ---
Randomize Timer
Do
Encabezado
serie = escoge4
Print: Line Input "Introduzca su fórmula en notación polaca inversa: ", entrada
entrada = quitaEspacios(entrada, " ", "")
If (Len(entrada) <> 7) Then
Print "Error en la serie introducida."
Else
resultado = evaluaEntrada(entrada)
Print "El resultado es = "; resultado
If resultado = 24 Then
Print "¡Correcto!"
Else
Print "¡Error!"
End If
End If
Print "¿Otra ronda? (Pulsa S para salir, u otra tecla para continuar)"
Loop Until (Ucase(Input(1)) = "S")
End
'--------------------------