Un programa algo especial

Software
1

los que han visto un poco de mi participación ya habran visto que freebasic me ha interesado, me ha visto con ojos algo golozos y bueno… estoy intentando programar un pequeño programita para mi novia con motivo de su cumpleaños, yo ya tengo un regalo asi que no quisiera algo barato y de ultima hora, nada que ver, pero igualmente queria darle una “sorpresita” asi con ayuda de deepseek y mis pocos conocimientos de del lenguaje de programacion he hecho esta pequeña demo, que no esta terminada, y es mas, el codigo es un destrozo de momento lleno de comentarios, tranquilos que lo pienso programar de cero y mejorare ese aspecto, solo ando probando cosas un poco a lo loco.

este es el codigo chapuzas que he hecho, por si a alguien le intereza:

' cabeceras
#include "fbgfx.bi"

' configuración modo gráfico
ScreenRes 800, 600, 32
Const COLOR_ROJO As UInteger = &HFFFF0000
Const COLOR_TEXTO As UInteger = &HFFFFFFFF
Dim Shared As Integer textoPausado ' controlador de pausa


' Función para el corazón
Sub DibujarCorazon()
    Dim As Single x, y, ecuacion
    For x = -2.5 To 2.5 Step 0.01
        For y = -3.0 To 3.0 Step 0.01
            ecuacion = (x^2 + y^2 - 1)^3 - x^2 * y^3
            If ecuacion < 0 Then
                Pset (400 + x * 100, 300 - y * 100), COLOR_ROJO
            End If
        Next y
    Next x
End Sub

' Maquina de escribir modo grafico
Sub EfectoMaquina( _
	Byval texto As String, _
	Byref x As Integer, _ 
	Byref y As Integer, _
	Byval col As Integer, _
	Byval retardo As Integer)

	'#include "fbgfx.bi" ' Necesario para Draw string
	Dim As Integer i, j
	for i = 1 To Len(texto)
		' Verificar pausa
		While MultiKey(FB.SC_P) ' SC_P código de tecla p
			textoPausado = 1
			Sleep 100 
		Wend

		If textoPausado then
			Draw String (10, 10), "[PAUSA] Presiona P para continuar", col
			While textoPausado
				If MultiKey(FB.SC_P) Then 
					textoPausado = 0
					Cls
					DibujarCorazon() ' Redibujar al reanudar
					' Volver a dibujar texto previo
					For j = 1 To i - 1
						Draw String (x + (j - 1) * 8, y), Mid(texto, j, 1), col
					Next j
				End If
				Sleep 100
			Wend
		End If

		' Dibujar nuevo caracter
		Draw String (x + (i - 1) * 8, y), Mid(texto, i, 1), col
		' Posicionar cursor (modo consola / coordenadas)
		'Locate y, x ' Para modo consola (Screen 0)
		' Para modo gráfico
		'Color col
		'Print Mid(texto, i, 1); ' Imprimir caracter de a uno
		'Draw String (x, y), Mid(texto, i, 1)
		Sleep retardo + Rnd * 20 ' Retraso variable

		' Actualizar posición horizontal
		'x += 8
	Next i
End Sub



' Configurar modo gráfico de alta resolución con 32 bits de color
'ScreenRes 800, 600, 32

' Función para dibujar corazón usando coordenadas normalizadas
'Sub DibujarCorazon()
    'Dim As Single x, y, ecuacion
    
    ' Recorrer área de trabajo (coordenadas adaptadas a pantalla 800x600)
    'For x = -2.5 To 2.5 Step 0.01
        'For y = -3.0 To 3.0 Step 0.01
            ' Ecuación del corazón corregida
            'ecuacion = (x^2 + y^2 - 1)^3 - x^2 * y^3
            
            'If ecuacion < 0 Then
                ' Convertir coordenadas matemáticas a píxeles
                'Pset (400 + x * 100, 300 - y * 100), COLOR_ROJO
            'End If
        'Next y
    'Next x
'End Sub

' Programa principal

'ScreenRes 800, 600 32

'Screen 0

'Cls

'EfectoMaquina("prueba", _
	'(80 - Len("prueba 2")) \ 2, _
	'12, _
	'14, _
	'50)

' texto posicionado sobre gráficos
'Screen 12
Cls

DibujarCorazon()

' Escribir sobre el corazón
EfectoMaquina("a ver... intentare un mensaje mas largo para notar el efecto de maquina de escribir  vere si se reproduce adecuadamente", 350, 280, COLOR_TEXTO, 30) ' Blanco, Posición (350,280)

Sleep

¿sugerencias? ¿preguntas? ¿algo? a decir verdad aun no entiendo del todo el codigo que he hecho, mas o menos funciona de momento, aclaro que esto lo hice a escasas horas antes de irme a dormir. y nada mas quiero ver que me dicen. evidentemente este es un trabajo que he de hacer yo, no tiene mucho sentido pedirles ayuda a programarlo pues la novia es mia, no suya, pero bueno, digo, una opinion no viene mal, creo… si acaso luego esto lo subo a github, codeberg o lo que sea con licencia 100% libre por si alguien quiere, solo que claro, el mensaje personal… ese lo borro antes de subirlo. pues nada, ahi me cuentan que les parece. por cierto… no se como gestionar varios archivos y luego soltar un ejecutable… estoy intentando ver la documentación de la pagina, pero mi escaso entendimiento en ingles hace que vaya un poco a ciegas. ya me las apañare con eso. pues nada, chao y me voy a dormir

2 Me gusta
2

¡Aló!

Pos a decir verdad, está bién, no puedo decir mucho sobre el código porque no sé FreeBASIC y tendría que echarle una pasada al viejo libro de informática que heredé de mi madre para ello. :confused:

Pero, por inducción veo que la función DibujarCorazon se declara dos veces, aunque no pasa nada porque la última tendrá siempre prioridad.

Si lo deseas puedes dejarlo aquí de todas formas, la licencia que todas las publicaciones en el foro tienen es la CC BY-SA tal como respondí en Script para controlar el swap - nº 4 por Carlinux.

1 me gusta
3

he visto la pagina de freebasic y dice que es compatible con qbasic. al menos hasta cierto punto porque freebasic añade sus cosas

4

¿en serio? no lo sabia. bueno, lo ire dejando aqui mientras considere que esta verde verde el asunto. ya luego lo quiero poner en lugar mas “formal” por decirlo de alguna forma, vamos que se pueda descargar de forma comoda pues… y creo que te haz confundido, si no mal entiendo mi propio codigo, no es que la función se defina 2 veces, es que la segunda vez esta completamente comentada, hay parte de codigo que estan comentadas y no hacen nada que no he borrado porque… ¿la gente pueda aprender de mis errores? supongo. o sea, es como una especie de registro barato de donde estaban las cosas antes o que habian o que no habian. pero creo que me he asegurado de que no se escriba todo 2 veces.

1 me gusta