Globe drawing algorithm

[KLBear]

deleted

[dodicat]

Hi KLBear.
Yes, 32 bit graphics is the answer to using OUT or PALLETE commands.
You can use a little mapping function to accurately specify how you want your colours to show.
I notice you use hex for black and white, I cannot read hex straight off, I prefer rgb(), but that's just me, I believe some folk can read hex, but I never did acquire the knack I must admit.
Also UInteger is a a huge range for those small numbers, maybe I would just use long, or even ubyte for red,green and blue.
I suppose your img is for another day maybe?
Anyway, nice globes, here is the map function I speak of:

Code: Select all

' Globe Drawing algorithm By KLBear  12-01-2021
' to compile fbc -s gui globe.bas

function map(a as double,b as double,x as double,c as double,d as double) as double
    return (d-c)*(x-a)/(b-a)+c
end function

Dim As UInteger cnt, r, x, y, Red, Green, Blue
Dim As ULong blk = &hFF000000, wht = &hFFFFFFFF
Dim As Any Ptr img = ImageCreate(800, 600, 32)

ScreenRes(800, 600, 32)
color wht,blk
cls
Draw String (344, 20), "GLOBE TEST"
sleep 1000,1

Do
'Red = 240: Green = 240: Blue = 0
r = RND * 38 + 20
x = RND * 800
y = RND * 600

FOR cnt  = 1 TO r 
    red=map(1,r,cnt,255,50)
    green=map(1,r,cnt,255,50)'or simply green=red here
     blue=0  ' or whatever
CIRCLE (x, y),cnt, RGB(Red, Green, Blue)
CIRCLE (x, y + 1),cnt, RGB(Red, Green, Blue)

'Red = Red - 4
'Green = Green - 4
'Blue = Blue -  4

' comment out sleep to draw faster
' how fast globe is drawn for effect
sleep 1,1
next
Loop Until InKey = CHR(255, 107)  ' X click to quit
ImageDestroy img 

[paul doe]

Here's a simple globe drawing algorithm that I converted from one I wrote more than 12 years ago. The original one used the OUT statement which I was told is deprecated. I am going to use this drawing algorithm in my standard binary clock.

Nice. You can use linear interpolation, so the globes will all look the same regardless of their radius:

Code: Select all

'' Type alias for colors
type as ulong color_t

'' Linearly interpolates between two colors
function lerpColor( a as color_t, b as color_t, x as single ) as color_t
  #define _R( c ) ( culng( c ) shr 16 and 255 )
  #define _G( c ) ( culng( c ) shr 8 and 255 )
  #define _B( c ) ( culng( c ) and 255 )
  #define _A( c ) ( culng( c ) shr 24 )
  
  dim as single iX = 1.0f - x
  
  return( rgba( _
    iX * _R( a ) + x * _R( b ), _
    iX * _G( a ) + x * _G( b ), _
    iX * _B( a ) + x * _B( b ), _
    iX * _A( a ) + x * _A( b ) ) )
end function

sub drawGlobe( x as long, y as long, r as long, c1 as color_t, c2 as color_t )
  for i as integer = 0 TO r
    CIRCLE (x, y), i, lerpColor( c1, c2, i / r )
    CIRCLE (x, y + 1), i, lerpColor( c1, c2, i / r )
    
    ' comment out sleep to draw faster
    ' how fast globe is drawn for effect
    sleep 1,1
  next
end sub

' Globe Drawing algorithm By KLBear  12-01-2021
' to compile fbc -s gui globe.bas

Dim As UInteger cnt, r, x, y, Red, Green, Blue
Dim As ULong blk = &hFF000000, wht = &hFFFFFFFF

ScreenRes(800, 600, 32)
color wht,blk
cls
Draw String (344, 20), "GLOBE TEST"
sleep 1000,1

dim as color_t _
  color1 = rgb( 32, 0, 32 ), color2 = rgb( 255, 1, 121 )

Do
  r = RND * 38 + 20
  x = RND * 800
  y = RND * 600
  
  drawGlobe( x, y, r, color2, color1 )
Loop Until InKey = CHR(255, 107)  ' X click to quit

[KLBear]

deleted

[KLBear]

deleted

[dodicat]

I think it is OK.
map is simple linear mapping from one range into another
viz:
red=map(1,r,cnt,240,50)
as cnt ranges from 1 to r, red ranges from 240 to 50

Code: Select all

function map(a as double,b as double,x as double,c as double,d as double) as double
    return (d-c)*(x-a)/(b-a)+c
end function

screen 20,32

for k as long=1 to 2
for y as long=0 to 768
      if k=1 then
      var red=map(0,768,y,20,255)
      var green=map(0,768,y,100,255)
      var blue=map(0,768,y,200,255)
      line (0,y)-(1024,y),rgb(red,green,blue)
else
      static as double lasth
      var e=map(0,768,y,0,1024)
      var h=map(-2,2,sin(e/50)-cos(2*e/70),690,760)
      var green=map(0,3,abs(lasth-h),120,30)
      line(e,h)-(e,768),rgb(0,green,0)
      line(e+1,h)-(e+1,768),rgb(0,green,0) 
      lasth=h
      end if
next
next k
sleep


 

[KLBear]

deleted

[KLBear]

deleted

[KLBear]

deleted

[badidea]

I added a sleep 300,1 above the Loop in my code because of CPU usage.

Yes, always use a sleep in long duration loops, but a 300 ms interval is a bit much for a clock that displays seconds.
Here a sleep 1 already drops single core cpu usage below 20% and with sleep 10 below 1%.

[KLBear]

deleted

[KLBear]

deleted

[paul doe]

paul doe I added more globes and colors let me know if I am using your interpolation algorithm correctly thanks.

If it works as intended, then you probably are.

But, why three functions that are exactly the same, just with different parameter names? One is quite enough:

Code: Select all

'' Type alias for colors
type as ulong color_t

'' Linearly interpolates between two colors
function lerpColor( a as color_t, b as color_t, x as single ) as color_t
  #define _R( c ) ( culng( c ) shr 16 and 255 )
  #define _G( c ) ( culng( c ) shr 8 and 255 )
  #define _B( c ) ( culng( c ) and 255 )
  #define _A( c ) ( culng( c ) shr 24 )
 
  dim as single iX = 1.0f - x
 
  return( rgba( _
    iX * _R( a ) + x * _R( b ), _
    iX * _G( a ) + x * _G( b ), _
    iX * _B( a ) + x * _B( b ), _
    iX * _A( a ) + x * _A( b ) ) )
end function

sub drawGlobe( x as long, y as long, r as long, c1 as color_t, c2 as color_t )
  for i as integer = 0 TO r
  CIRCLE (x, y), i, lerpColor( c1, c2, i / r )
   CIRCLE (x, y + 1), i, lerpColor( c1, c2, i / r )
 
   ' comment out sleep to draw faster
    ' how fast globe is drawn for effect
    sleep 1,1
 next
end sub

'Sub drawGlobe2( x as long, y as long, r as long, c3 as color_t, c4 as color_t )
'  for i as integer = 0 TO r
'    CIRCLE (x, y), i, lerpColor( c3, c4, i / r )
'    CIRCLE (x, y + 1), i, lerpColor( c3, c4, i / r )
' 
'   ' comment out sleep to draw faster
'    ' how fast globe is drawn for effect
'    sleep 1,1
'  next
'end sub
'
'Sub drawGlobe3( x as long, y as long, r as long, c3 as color_t, c4 as color_t )
'  for i as integer = 0 TO r
'    CIRCLE (x, y), i, lerpColor( c3, c4, i / r )
'    CIRCLE (x, y + 1), i, lerpColor( c3, c4, i / r )
' 
'   ' comment out sleep to draw faster
'    ' how fast globe is drawn for effect
'    sleep 1,1
'  next
'end sub


Dim As UInteger cnt, r, x, y, Red, Green, Blue
Dim As ULong blk = &hFF000000, wht = &hFFFFFFFF

ScreenRes(800, 600, 32)
color wht,blk
cls
Draw String (344, 20), "GLOBE TEST"
sleep 1000,1

dim as color_t _
  color1 = rgb( 32, 0, 32 ), color2 = rgb( 255, 1, 121 )
dim as color_t _
  color3 = rgb( 32, 32, 0 ), color4 = rgb( 255, 255, 0 )
dim as color_t _
  color5 = rgb(32, 0, 32 ), color6 = rgb( 121 ,1, 255 )


Do
  r = RND * 98 + 20
  x = RND * 800
  y = RND * 600
 
  drawGlobe( x, y, r, color2, color1 )
   r = RND * 98 + 20
   x = RND * 800
   y = RND * 600

  drawGlobe( x, y, r, color4, color3 )
   r = RND * 98 + 20
   x = RND * 800
   y = RND * 600

  drawGlobe( x, y, r, color6, color5 )
Loop Until InKey = CHR(255, 107)  ' X click to quit

That is kind of the point of parameterizing functions: to create reusable code...

[KLBear]

deleted