Useful defines

General FreeBASIC programming questions.
deltarho[1859]
Posts: 2698
Joined: Jan 02, 2017 0:34
Location: UK

Re: Useful defines

Postby deltarho[1859] » Jul 03, 2018 17:24

I like ( CULng(Rnd() * &hFFFFFFFFul) ). At first, I thought that it would fall foul of Rnd < 1 but since CULng rounds off then
0 <= ( CULng(Rnd() * &hFFFFFFFFul) ) <= &hFFFFFFFFul.

Neat.
dodicat
Posts: 6726
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Useful defines

Postby dodicat » Jul 05, 2018 2:17

Something looks pictorially wrong with Mr Swiss's method.
I could be wrong of course.
After many loops the minimum colour should be black, and the maximum colour should be white.
Press a key each loop

Code: Select all


Screen 19,32
Dim As Long c
Randomize
Do
    c+=1

    Screenlock
    Cls
    If c Mod 2=0 Then
        Dim As Ulong max=0,min=Rgb(255,255,255)
   
         'randomize 0
       
        Dim As Ulong clr,x
        For x =1 To 5000000
            clr=Rgb(Rnd*255,Rnd*255,Rnd*255)
            If min>clr Then min=clr
            If max<clr Then max=clr
            Pset(Rnd*800,Rnd*600),clr
        Next x
        Print "rgb(rnd*255,rnd*255,rnd*255)"
        Print "min",,,"max"
        Print "rgb ";Cptr(Ubyte Ptr,@min)[2];",";Cptr(Ubyte Ptr,@min)[1];",";Cptr(Ubyte Ptr,@min)[0],,, _
                     Cptr(Ubyte Ptr,@max)[2];",";Cptr(Ubyte Ptr,@max)[1];",";Cptr(Ubyte Ptr,@max)[0]
        Circle(100,300),100,min,,,,f
        Circle(400,300),100,max,,,,f
    Else
        Dim As Ulong max=0,min=Rgb(255,255,255)
   
        'randomize 0
       
        Dim As Ulong clr,x
        For x =1 To 5000000
            clr=CULng(Rnd() * &hFFFFFFFFul)
            If min>clr Then min=clr
            If max<clr Then max=clr
            Rnd   'keep the same number of rnd in each loop.
            Rnd
            Pset(Rnd*800,Rnd*600),clr
        Next x
        Print "CULng(Rnd() * &hFFFFFFFFul)"
        Print "min",,,"max"
        Print "rgb ";Cptr(Ubyte Ptr,@min)[2];",";Cptr(Ubyte Ptr,@min)[1];",";Cptr(Ubyte Ptr,@min)[0],,, _
                     Cptr(Ubyte Ptr,@max)[2];",";Cptr(Ubyte Ptr,@max)[1];",";Cptr(Ubyte Ptr,@max)[0]
        Circle(100,300),100,min,,,,f
        Circle(400,300),100,max,,,,f
    End If
   
    Screenunlock
    Sleep
    Loop Until Inkey=Chr(27)   
bluatigro
Posts: 652
Joined: Apr 25, 2012 10:35
Location: netherlands

Re: Useful defines

Postby bluatigro » Jul 05, 2018 4:19

i do not know if this works but it shoot

Code: Select all

#define a<b<c (((a)<(b))and((b)<(c)))
dodicat
Posts: 6726
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Useful defines

Postby dodicat » Jul 05, 2018 11:44

Here is another route:

Code: Select all

 
#define range(f,l) int(Rnd*(((l)+1)-(f))+(f))
#define black rgb(0,0,0)
#define white rgb(255,255,255)

Screen 19,32
Dim As Long c
Randomize
Do
    c+=1

    Screenlock
    Cls
    If c Mod 2=0 Then
        Dim As Ulong max=0,min=Rgb(255,255,255)
   
         'randomize 0
       
        Dim As Ulong clr,x
        For x =1 To 5000000
            clr=Rgb(Rnd*255,Rnd*255,Rnd*255)
            If min>clr Then min=clr
            If max<clr Then max=clr
            Pset(Rnd*800,Rnd*600),clr
        Next x
        Print "rgb(rnd*255,rnd*255,rnd*255)"
        Print "min",,,"max"
        Print "rgb ";Cptr(Ubyte Ptr,@min)[2];",";Cptr(Ubyte Ptr,@min)[1];",";Cptr(Ubyte Ptr,@min)[0],,, _
                     Cptr(Ubyte Ptr,@max)[2];",";Cptr(Ubyte Ptr,@max)[1];",";Cptr(Ubyte Ptr,@max)[0]
        Circle(100,300),100,min,,,,f
        Circle(400,300),100,max,,,,f
    Else
        Dim As Ulong max=0,min=Rgb(255,255,255)
   
       ' randomize 0
       
        Dim As Ulong clr,x
        For x =1 To 5000000
            clr=range(black,white)'CULng(Rnd() * &hFFFFFFFFul)
            If min>clr Then min=clr
            If max<clr Then max=clr
            Rnd   'keep the same number of rnd in each loop.
            Rnd
            Pset(Rnd*800,Rnd*600),clr
        Next x
        Print "range(black,white)"' "CULng(Rnd() * &hFFFFFFFFul)"
        Print "min",,,"max"
        Print "rgb ";Cptr(Ubyte Ptr,@min)[2];",";Cptr(Ubyte Ptr,@min)[1];",";Cptr(Ubyte Ptr,@min)[0],,, _
                     Cptr(Ubyte Ptr,@max)[2];",";Cptr(Ubyte Ptr,@max)[1];",";Cptr(Ubyte Ptr,@max)[0]
        Circle(100,300),100,min,,,,f
        Circle(400,300),100,max,,,,f
    End If
   
    Screenunlock
    Sleep
    Loop Until Inkey=Chr(27)

And here is a tester

Code: Select all


#define range(f,l) int(Rnd*(((l)+1)-(f))+(f))
#define black rgb(0,0,0)
#define white rgb(255,255,255)
'============================
randomize
#define test rgb(200,56,209)
dim as ulong clr,counter
dim as long a(1 to 3)
do
    counter+=1
   ' clr=CULng(Rnd() * &hFFFFFFFFul)
     clr=range(black,white)
    if clr=white then print "white",counter:a(1)+=1
    if clr=black then print "black",counter:a(2)+=1
    if clr=test then print  " test",counter:a(3)+=1
loop until counter > 200000000
print
print "White hits ";a(1)
print "Black hits ";a(2)
print "Test  hits ";a(3)
sleep

 
badidea
Posts: 2152
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Useful defines

Postby badidea » Oct 09, 2019 22:33

Code: Select all

'lazy RBG macro &hF04 --> &hFF0044
#define hRGB(rgb_) ((((((rgb_) and &hF00) shl 4) or ((rgb_) and &hF00)) shl 8) or (((((rgb_) and &h0F0) shl 4) or ((rgb_) and &h0F0)) shl 4) or ((((rgb_) and &h00F) shl 4) or ((rgb_) and &h00F)))
'test
print hex(hRGB(&h000), 6)
print hex(hRGB(&h123), 6)
print hex(hRGB(&hABC), 6)
print hex(hRGB(&hFFF), 6)

Or

Code: Select all

#define cRGB(r,g,b) (((((r) shl 4) + (r)) shl 16) or ((((g) shl 4) + (g)) shl 8) or (((b) shl 4) + (b)))

const as ulong C_BLACK = cRGB(0,0,0)
const as ulong C_DARK_GRAY = cRGB(4,4,4)
const as ulong C_GRAY = cRGB(8,8,8)
const as ulong C_LIGHT_GRAY = cRGB(12,12,12)
const as ulong C_WHITE = cRGB(15,15,15)
const as ulong C_RED = cRGB(15,0,0)
const as ulong C_YELLOW = cRGB(15,15,0)
const as ulong C_MANGENTA = cRGB(15,0,15)
const as ulong C_DARK_GREEN = cRGB(0,7,0)
const as ulong C_BLUE = cRGB(0,0,15)
MrSwiss
Posts: 3634
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Useful defines

Postby MrSwiss » Oct 09, 2019 23:40

dodicat wrote:Something looks pictorially wrong with Mr Swiss's method.

Yes, it does. Your comparison to RGB is the problem, because I'm doing RGBA ...
#define rnd_clr ( CULng(Rnd() * &hFFFFFFFFul) )
The advantage is: 1 x Rnd() instead of 4 x Rnd() [when using RGBA macro].
MrSwiss
Posts: 3634
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Useful defines

Postby MrSwiss » Oct 10, 2019 12:46

Just to show the difference, between 24 bit RGB vs. 32 bit RGBA:

Code: Select all

#Define rnd_RGBA    ( CULng(Rnd() * &hFFFFFFFFul) )
#Define rnd_RGB     ( CULng(Rnd() * &h00FFFFFFul + &hFF000000ul) )
In rnd_RGB Alpha is always set to: 255/&hFF, as in the original RGB macro.

This assures visibility, even if GFX_ALPHA_PRIMITIVES is set with ScreenRes().
(Alpha = 255/&hFF = fully (100%) opaque color)
dodicat
Posts: 6726
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Useful defines

Postby dodicat » Oct 10, 2019 13:11

Agreed Mr Swiss.
rgba covers 0 to rgba(255,255,255,255), so rnd* this range is good
rgb covers rgb(0,0,0) to rgb(255,255,255) so rnd * rgb(255,255,255) is not good.
Here are the three possibilities.
But WHY does the 32 bit compiler fail completely here?

Code: Select all

#define range2(f,l) int(Rnd*(((l)+1)-(f)))+(f)  'tried double return

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))\((b)-(a))+(c)

function range(f as ulong,l as ulong) as ulong
    return int(Rnd*(((l)+1)-(f)))+(f)
    end function

Dim As Ulong black=Rgb(0,0,0)
dim as ulong white=Rgb(255,255,255)
Dim As Ulong clr,count
Dim As Ulong n=10000000
Dim As Ulong min1=white,max1=0,min2=white,max2=0,min3=white,max3=0
Screenres 900,500,32

Locate 15
Print Tab(10);"range(0,black)";Tab(50);"range(0,white)";Tab(90);"range(black,white)"
Line(199,10)-(601,20),,b
Do
   
    count+=1
    Var z=map(1,n,count,200,600)
    Line(z,11)-(z,19),Rgb(0,200,200)
   
    clr=range(0,black)
    If min1>clr Then min1=clr
    If max1<clr Then max1=clr
   
    Pset(range(0,299),range(150,400)),clr
   
    clr=range(0,white)
    If min2>clr Then min2=clr
    If max2<clr Then max2=clr
   
    Pset(range(301,599),range(150,400)),clr
   
    clr=range(black,white)
    If min3>clr Then min3=clr
    If max3<clr Then max3=clr
   
    Pset(range(601,900),range(150,400)),clr
   
Loop Until count=n

Locate 27
Print Tab(12);"min         max";Tab(50);"min         max";Tab(87);"min          max"
Locate 30
Print Tab(8); _
Cptr(Ubyte Ptr,@min1)[2];",";Cptr(Ubyte Ptr,@min1)[1];",";Cptr(Ubyte Ptr,@min1)[0];Tab(22); _
Cptr(Ubyte Ptr,@max1)[2];",";Cptr(Ubyte Ptr,@max1)[1];",";Cptr(Ubyte Ptr,@max1)[0]';tab(80); _

Locate 30
Print Tab(45); _
Cptr(Ubyte Ptr,@min2)[2];",";Cptr(Ubyte Ptr,@min2)[1];",";Cptr(Ubyte Ptr,@min2)[0];Tab(59); _
Cptr(Ubyte Ptr,@max2)[2];",";Cptr(Ubyte Ptr,@max2)[1];",";Cptr(Ubyte Ptr,@max2)[0]

Locate 30
Print Tab(82); _
Cptr(Ubyte Ptr,@min3)[2];",";Cptr(Ubyte Ptr,@min3)[1];",";Cptr(Ubyte Ptr,@min3)[0];Tab(96); _
Cptr(Ubyte Ptr,@max3)[2];",";Cptr(Ubyte Ptr,@max3)[1];",";Cptr(Ubyte Ptr,@max3)[0] 


Circle(100,300),50,min1,,,,f:Circle(200,300),50,max1,,,,f
Circle(400,300),50,min2,,,,f:Circle(500,300),50,max2,,,,f
Circle(700,300),50,min3,,,,f:Circle(800,300),50,max3,,,,f 
Sleep




 
MrSwiss
Posts: 3634
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Useful defines

Postby MrSwiss » Oct 10, 2019 14:00

dodicat wrote:But WHY does the 32 bit compiler fail completely here?
No idea currently, FBC64 is OK ...
Got to run now, picking up some stuff I've ordered ...
Just remember: black isn't 0 its &hFF000000, or RGBA(0,0,0,255)
dodicat
Posts: 6726
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Useful defines

Postby dodicat » Oct 10, 2019 15:32

Yea, Looks like the uinteger in 32 and 64 bits problem

Code: Select all

 var x= rgb(255,255,255) +1
#print typeof(x)
print x
sleep

'64 bits gives 4294967296
'32 bits gives 0

'x is uinteger in both cases


Have to change the range parameters.
function range(f as double,l as double) as double
return int(Rnd*(((l)+1)-(f)))+(f)
end function

or longint.

Return to “General”

Who is online

Users browsing this forum: No registered users and 14 guests