Welcome fbgfx screen

[ron77]

' FreeBASIC code using FBgfx library
' Welcome screen for "Retrocoders Community" with rainbow colors

#Include "fbgfx.bi"

SCREENRES 800, 600, 32
width 800\ 8 , 600 \ 16
Dim As Integer gfx_w, gfx_h

Const As Integer BLACK = &H000000
Const As Integer RED = &HFF0000
Const As Integer ORANGE = &HFF7F00
Const As Integer YELLOW = &HFFFF00
Const As Integer GREEN = &H00FF00
Const As Integer BLUE = &H0000FF
Const As Integer INDIGO = &H4B0082
Const As Integer VIOLET = &H9400D3

' Function to draw a filled rectangle with the specified color
Sub DrawRect(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color1 As Integer)
    line (x1, y1) - (x2, y2), color1 , bf
    line  (x1, y1) - (x2, y2), color1, b
End Sub

sub center(row as long, s as string)
    locate row, (loword(width) - len(s) ) shr 1 : print s
end sub
' Get the width and height of the graphics window
gfx_w = 800
gfx_h = 600

' Clear the graphics window to black
color ,BLACK
cls

' Draw the rainbow rectangles
DrawRect(0, 0, gfx_w \ 7, gfx_h, RED)
DrawRect(gfx_w \ 7, 0, 2 * gfx_w \ 7, gfx_h, ORANGE)
DrawRect(2 * gfx_w \ 7, 0, 3 * gfx_w \ 7, gfx_h, YELLOW)
DrawRect(3 * gfx_w \ 7, 0, 4 * gfx_w \ 7, gfx_h, GREEN)
DrawRect(4 * gfx_w \ 7, 0, 5 * gfx_w \ 7, gfx_h, BLUE)
DrawRect(5 * gfx_w \ 7, 0, 6 * gfx_w \ 7, gfx_h, INDIGO)
DrawRect(6 * gfx_w \ 7, 0, gfx_w, gfx_h, VIOLET)

' Draw the "Retrocoders Community" text in white
color &HFFFFFF
center 15, "Retrocoders Community"

' Wait for the user to close the graphics window
Do
    Sleep(10)
Loop Until INKEY = CHR(13)

You cannot view this attachment.

[ron77]

now using FBTrueType Lib

' FreeBASIC code using FBgfx library
' Welcome screen for "Retrocoders Community" with rainbow colors

#Include "fbgfx.bi"
#include "FBTrueType.bi"

SCREENRES 800, 600, 32
width 800\ 8 , 600 \ 16
Dim As Integer gfx_w, gfx_h

Const As Integer BLACK = &H000000
Const As Integer RED = &HFF0000
Const As Integer ORANGE = &HFF7F00
Const As Integer YELLOW = &HFFFF00
Const As Integer GREEN = &H00FF00
Const As Integer BLUE = &H0000FF
Const As Integer INDIGO = &H4B0082
Const As Integer VIOLET = &H9400D3
const fontfile = "./fonts/tahoma.ttf"
' Function to draw a filled rectangle with the specified color
Sub DrawRect(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color1 As Integer)
    line (x1, y1) - (x2, y2), color1 , bf
    line  (x1, y1) - (x2, y2), color1, b
End Sub

sub center(row as long, s as string)
    locate row, (loword(width) - len(s) ) shr 1 : print s
end sub

' load the font
var font = FontLoad(fontfile)
if font<0 then
  print "error: loading: " & fontfile & " " & ErrorText(font)
  beep : sleep : end 1
end if

' Get the width and height of the graphics window
gfx_w = 800
gfx_h = 600

' Clear the graphics window to black
color ,BLACK
cls

' Draw the rainbow rectangles
DrawRect(0, 0, gfx_w \ 7, gfx_h, RED)
DrawRect(gfx_w \ 7, 0, 2 * gfx_w \ 7, gfx_h, ORANGE)
DrawRect(2 * gfx_w \ 7, 0, 3 * gfx_w \ 7, gfx_h, YELLOW)
DrawRect(3 * gfx_w \ 7, 0, 4 * gfx_w \ 7, gfx_h, GREEN)
DrawRect(4 * gfx_w \ 7, 0, 5 * gfx_w \ 7, gfx_h, BLUE)
DrawRect(5 * gfx_w \ 7, 0, 6 * gfx_w \ 7, gfx_h, INDIGO)
DrawRect(6 * gfx_w \ 7, 0, gfx_w, gfx_h, VIOLET)

' Draw the "Retrocoders Community" text in white
'color &HFFFFFF
'center 15, "Retrocoders Community"

TTPrint font,150,250, "Retrocoders Community",BLUE,35


' Wait for the user to close the graphics window
Do
    Sleep(10)
Loop Until INKEY = CHR(13)

You cannot view this attachment.

Project DropBoc Link: https://www.dropbox.com/s/dq45a0wnmpz7bv1/WELCOME.zip?dl=0

and here is with a red heart in center:

' FreeBASIC code using FBgfx library
' Welcome screen for "Retrocoders Community" with rainbow colors

#Include "fbgfx.bi"
#include "FBTrueType.bi"

SCREENRES 800, 600, 32
width 800\ 8 , 600 \ 16
Dim As Integer gfx_w, gfx_h
Dim As Double x, y, angle

Const As Integer BLACK = &H000000
Const As Integer RED = &HFF0000
Const As Integer ORANGE = &HFF7F00
Const As Integer YELLOW = &HFFFF00
Const As Integer GREEN = &H00FF00
Const As Integer BLUE = &H0000FF
Const As Integer INDIGO = &H4B0082
Const As Integer VIOLET = &H9400D3
const fontfile = "./fonts/tahoma.ttf"
' Function to draw a filled rectangle with the specified color
Sub DrawRect(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, color1 As Integer)
    line (x1, y1) - (x2, y2), color1 , bf
    line  (x1, y1) - (x2, y2), color1, b
End Sub

sub center(row as long, s as string)
	locate row, (loword(width) - len(s) ) shr 1 : print s
end sub

' load the font
var font = FontLoad(fontfile)
if font<0 then
  print "error: loading: " & fontfile & " " & ErrorText(font)
  beep : sleep : end 1
end if

' Get the width and height of the graphics window
gfx_w = 800
gfx_h = 600

' Clear the graphics window to black
color ,BLACK
cls

' Draw the rainbow rectangles
DrawRect(0, 0, gfx_w \ 7, gfx_h, RED)
DrawRect(gfx_w \ 7, 0, 2 * gfx_w \ 7, gfx_h, ORANGE)
DrawRect(2 * gfx_w \ 7, 0, 3 * gfx_w \ 7, gfx_h, YELLOW)
DrawRect(3 * gfx_w \ 7, 0, 4 * gfx_w \ 7, gfx_h, GREEN)
DrawRect(4 * gfx_w \ 7, 0, 5 * gfx_w \ 7, gfx_h, BLUE)
DrawRect(5 * gfx_w \ 7, 0, 6 * gfx_w \ 7, gfx_h, INDIGO)
DrawRect(6 * gfx_w \ 7, 0, gfx_w, gfx_h, VIOLET)

For angle = 0 To 360 Step 0.1
    x = 16 * (Sin(angle))^3
    y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
    x = 400 + 10 * x
    y = 300 - 10 * y
    PSet (x, y), RGB(255, 0, 0)
Next angle

TTPrint font,150,250, "Retrocoders Community",BLUE,35


' Wait for the user to close the graphics window
Do
    Sleep(10)
Loop Until INKEY = CHR(13)

You cannot view this attachment.

[ron77]

Here is another fbgfx example:

#include "fbgfx.bi"

Dim As Double x, y, angle

ScreenRes 800, 600, 32

For angle = 0 To 360 Step 0.1
    x = 16 * (Sin(angle))^3
    y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
    x = 400 + 10 * x
    y = 300 - 10 * y
    PSet (x, y), RGB(255, 0, 0)
Next angle

Sleep
End

You cannot view this attachment.

[CharlieJV]

G'day,

I went searching for information about that library, and I'm not finding any documentation about it.

Is it doing some kind of "dithering" (I don't think that's the right word, but damned if I can think of the right one) ?

[ron77]

G'day G'day!

fbgfx lib is freebasic built-in graphic screen library that comes with freebasic compiler...

don't know if that helps or not...

[ron77]

here another heart fbgfx example:

#include "fbgfx.bi"
 
Dim As Double x, y, angle
 
ScreenRes 800, 600, 32,,fb.gfx_alpha_primitives
 
For angle = 0 To 360 Step 1/8
    x = 16 * (Sin(angle))^3
    y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
    x = 400 + 10 * x
    y = 300 - 10 * y
    
    var iX = cint(int(x)), iY=cint(int(y))        
    var fX = x-iX, fY = y-iY        
    pset (iX  , iY  ), RGBA(255, 0, 0, (1-fX)*(1-fY)*255) 
    pset (iX+1, iY  ), RGBA(255, 0, 0, (  fX)*(1-fY)*255) 
    pset (iX  , iY+1), RGBA(255, 0, 0, (1-fX)*(  fY)*255) 
    pset (iX+1, iY+1), RGBA(255, 0, 0, (  fX)*(  fY)*255)
 
Next angle
 
Sleep
End

[CharlieJV]

For some reason, I couldn't get the program to work right.  Thinking there was something special about that library, come to find out I'm just horrible at copying and pasting.

That was fun.  Sample code below the image: https://basicanywheremachine.neocities.org/sample_programs/BAM_SamplePrograms?page=heart

[ron77]

here is a heart filling up on fbgfx graphic screen

#include "fbgfx.bi"
 
Dim As Double x, y, angle
 
ScreenRes 800, 600, 32,,fb.gfx_alpha_primitives
line(0,0)-(800,600),rgb(0,64,128),bf
 
for S as double = (16*255)/256 to 0 step -1/32
  For angle = 0 To 3.1415 Step 1/256
      
      x = 16 * (Sin(angle))^3
      y = 13 * Cos(angle) - 5 * Cos(2 * angle) - 2 * Cos(3 * angle) - Cos(4 * angle)
      x = S * x : y = S * y
      
      var iX = cint(int(x)), iY=cint(int(y))        
      var fX = x-iX, fY = y-iY        
      
      'dim as long iG=sqr(x*x+y*y)*.1,iR=128+S*8,iB=64-S*4
      dim as long iR=abs(X\2)+128,iB=16+angle*64,iG=abs(Y)*.9
      const iAlpha = 128
      
      pset ((400+iX)  , (300-iY)  ), RGBA(iR, iG, iB, (1-fX)*(1-fY)*iAlpha) 
      pset ((400+iX)+1, (300-iY)  ), RGBA(iR, iG, iB, (  fX)*(1-fY)*iAlpha) 
      pset ((400+iX)  , (300-iY)-1), RGBA(iR, iG, iB, (1-fX)*(  fY)*iAlpha) 
      pset ((400+iX)+1, (300-iY)-1), RGBA(iR, iG, iB, (  fX)*(  fY)*iAlpha)
      
      pset ((400-iX)  , (300-iY)  ), RGBA(iR, iG, iB, (1-fX)*(1-fY)*iAlpha) 
      pset ((400-iX)-1, (300-iY)  ), RGBA(iR, iG, iB, (  fX)*(1-fY)*iAlpha) 
      pset ((400-iX)  , (300-iY)-1), RGBA(iR, iG, iB, (1-fX)*(  fY)*iAlpha) 
      pset ((400-iX)-1, (300-iY)-1), RGBA(iR, iG, iB, (  fX)*(  fY)*iAlpha)
          
  Next angle
  sleep 30
next S
 
Sleep
End

You cannot view this attachment.

[CharlieJV]

Man, that is really beautiful.

[CharlieJV]

Ok, I had to try that one too: https://basicanywheremachine.neocities.org/sample_programs/BAM_SamplePrograms?page=heart2

BAM will never have all of the goodness that is FreeBasic, but it might be useful sometimes to roughly demo what a small FreeBasic program is doing.

Kind of like a very small and occasional sidekick tool for FreeBasic ?

[ron77]

Hi CharlieJV...

It's beautiful! Just like the one in freebasic I love it... thanks for sharing... you are one busy bee...

[CharlieJV]

A rolling stone gathers no moss ? ? ?

Use it (the old sponge) or lose it ? ? ?  Well, may already have lost it.  Jury is still out on that one ...

I'm a huge fan of small snippets of code that do big things and I don't think I'd ever be able to write on my own.

That's very good stuff.  Thank-you for sharing and providing "brain-age games"-style goodies !