hola, no se si alguien se esperaba que terminara este programa pero lo consegui finalmente. no estoy tan orgulloso de el pues lo hice un poco a la rapida en el ultimo segundo pues me comia el tiempo. pero… bueno, ya funciona, no entiendo bien mi codigo, pero, luego intentare estudiarlo y dividirlo por mi cuenta. tengo varias versiones de mi codigo dividido que deje a medias, alguien del discord de freebasic me recomendo que no perdiera el tiempo en intentar dividir mi codigo, sino que primero aprenderia a utilizar el lenguaje he hiciera todo en un archivo. le hice caso, a medias. pero bueno, digamos que esta es la versión 0.7 o no se, la verdad no se como funcionan las versiones. ahi me dicen que opinan, no se me ocurre ningun nombre. ya si alguien me da sugerencias luego lo publico en algo como github o codeberg, o donde me digan que sea mas conveniente. la verdad despues de hacer eso, no se si el lenguaje de programación es facil en comparación de otros lenguajes como c. pero la verdad si hay cosas que me gustaron, sobretodo su forma de “terminar las cosas” ese “end function” por ejemplo, no se, ahi me dicen que opinan ustedes
' primer programa en freebasic
#include "fbgfx.bi"
#include "FreeImage.bi"
'-----------------------------
' Constantes globales
'-----------------------------
const ANCHO = 800, ALTO = 600
const COLOR_TEXTO = &HFFFFFFFF ' Blanco
const COLOR_CORAZON = &HFFFF007F ' Rosa fuerte para corazones
'-----------------------------
' Inicializa pantalla y aleatorio
'-----------------------------
screenres ANCHO, ALTO, 32
randomize()
'============================================================
function aleatorio(minimo as integer, maximo as integer) as integer
return int(rnd * (maximo - minimo + 1)) + minimo
end function
'============================================================
sub escribirMaquina(texto as string, x as integer, y as integer, colorTexto as uinteger, retardo as integer)
dim i as integer = 1
dim px as integer = x, py as integer = y
while i <= len(texto)
dim cantidad as integer = 1 + int(rnd * 2)
if i + cantidad - 1 > len(texto) then cantidad = len(texto) - i + 1
dim frag as string = mid(texto, i, cantidad)
if px + len(frag)*8 > ANCHO then
px = x
py += 16
end if
draw string (px, py), frag, colorTexto
select case right(frag, 1)
case ".": sleep 200
case ",": sleep 80
case else: sleep retardo + int(rnd*20)
end select
px += len(frag)*8
i += cantidad
wend
end sub
'============================================================
sub dibujarCorazon(xc as integer, yc as integer, escala as single, colorCorazon as uinteger)
for y as single = 3.0 to -3.0 step -0.01
for x as single = -2.5 to 2.5 step 0.01
dim eq as single = (x^2 + y^2 - 1)^3 - x^2*y^3
if eq < 0 then pset(xc + x * escala, yc - y * escala), colorCorazon
next
next
end sub
'============================================================
sub animarCorazonOverlay()
for paso as integer = 1 to 150
dibujarCorazon 400, 300, paso / 1.0, COLOR_CORAZON
sleep 10
next
end sub
'============================================================
sub llenarPantallaConCorazones()
for i as integer = 1 to 500
dibujarCorazon aleatorio(0, ANCHO), aleatorio(0, ALTO), aleatorio(20, 50), rgb(aleatorio(100,255),0,0)
next
end sub
'============================================================
function FI_Load(filename As String) As Any Ptr
If Len(filename) = 0 Then Return NULL
Dim As FREE_IMAGE_FORMAT form = FreeImage_GetFileType(StrPtr(filename), 0)
If form = FIF_UNKNOWN Then form = FreeImage_GetFIFFromFilename(StrPtr(filename))
If form = FIF_UNKNOWN Then Return NULL
Dim As UInteger flags = 0
If form = FIF_JPEG Then flags = JPEG_ACCURATE
Dim As FIBITMAP Ptr image = FreeImage_Load(form, StrPtr(filename), flags)
If image = NULL Then Return NULL
FreeImage_FlipVertical(image)
Dim As FIBITMAP Ptr image32 = FreeImage_ConvertTo32Bits(image)
Dim As UInteger w = FreeImage_GetWidth(image32)
Dim As UInteger h = FreeImage_GetHeight(image32)
Dim As fb.Image Ptr sprite = ImageCreate(w, h)
Dim As Byte Ptr target = CPtr(Byte Ptr, sprite + 1)
Dim As Integer target_pitch = sprite->pitch
Dim As Any Ptr source = FreeImage_GetBits(image32)
Dim As Integer source_pitch = FreeImage_GetPitch(image32)
For yy As Integer = 0 To h - 1
memcpy(target + (yy * target_pitch), source + (yy * source_pitch), w * 4)
Next
FreeImage_Unload(image32)
FreeImage_Unload(image)
Return sprite
end function
'============================================================
sub mostrarTextos()
dim textos(0 to 4) as string
textos(0) = ""
textos(1) = ""
textos(2) = ""
textos(3) = ""
textos(4) = ""
for i as integer = 0 to 3
cls
escribirMaquina(textos(i), 20, 40, COLOR_TEXTO, 20)
if i = 3 then animarCorazonOverlay()
draw string (20, ALTO - 20), "[Presiona una tecla para continuar...]", COLOR_TEXTO
sleep
next
cls
escribirMaquina(textos(4), 20, 40, COLOR_TEXTO, 20)
draw string (20, ALTO - 20), "[Presiona una tecla para la lluvia de corazones...]", COLOR_TEXTO
sleep
cls
llenarPantallaConCorazones()
draw string (20, ALTO - 20), "[Presiona una tecla para mostrar la imagen...]", COLOR_TEXTO
sleep
' Cargar y escalar imagen JPG
dim as string nombreImagen = "imagen.jpg"
dim as any ptr imagenFondo = FI_Load(nombreImagen)
if imagenFondo <> 0 then
dim as integer iw, ih
imageinfo imagenFondo, iw, ih
dim as single factor = 0.3 ' escala de reducción
dim as integer nw = iw * factor, nh = ih * factor
dim as any ptr imagenEscalada = imagecreate(nw, nh)
for y as integer = 0 to nh - 1
for x as integer = 0 to nw - 1
dim as uinteger col = point(x / factor, y / factor, imagenFondo)
pset imagenEscalada, (x, y), col
next
next
dim as integer x0 = (ANCHO - nw) \ 2
dim as integer y0 = (ALTO - nh) \ 2
put (x0, y0), imagenEscalada, alpha
imagedestroy(imagenEscalada)
else
draw string (20, 20), "No se pudo cargar la imagen JPG: " + nombreImagen, rgb(255, 0, 0)
end if
draw string (20, ALTO - 20), "[Presiona una tecla para salir]", COLOR_TEXTO
sleep
if imagenFondo then imagedestroy(imagenFondo)
end sub
'============================================================
mostrarTextos()
sleep
