rnd

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Muttonhead
Posts: 139
Joined: May 28, 2009 20:07

rnd

Post by Muttonhead »

playing with rnd function, far away from the origin intension, :)

Code: Select all

const as single doublepi  =atn (1) * 8
const as single pi        =atn (1) * 4
const as single halfpi    =atn (1) * 2
const as single quarterpi =atn (1)
const as integer Xo=400
const as integer Yo=300

'xpos,ypos  Startkoordinaten, es gilt ein karthesisches System dessen Ursprung auf dem Screen mit Xo,Yo definiert ist
'direction  Initialrichtung
'fd         Laufweite in Pixel, aus wievielen Pixeln besteht die Linie, keine Entfernungsangabe
'mma        maximale zulässige Abweichung von Initialrichtung
declare sub RandomWalk(xpos as single, ypos as single, direction as single, fd as integer=0,mma as single=3.14)
screen 19,32

randomize timer

dim as single d=pi + halfpi'270 grd
do
  cls
  'Erzeugt ein "Büschel" von 8 Zufallslinien
  for i as integer=1 to 8

    RandomWalk(0,100,d,400)
  next i
  sleep 200
loop until inkey=chr(27)
sleep

sub RandomWalk(xpos as single, ypos as single, direction as single, fd as integer=0,mma as single=3.14)
  static as integer fulldist,actdist,ix,iy
  static as single initdirection,max_misaligned
  dim as ubyte component
  dim as single nx,ny

  if fd>0 then
    fulldist=fd
    actdist=0
    ix=int(xpos)
    iy=int(ypos)
    pset(Xo+ix,Yo-iy),&HFFFFFF
    initdirection=direction
    max_misaligned=mma
  end if
  'Veränderung der Richtung
  '           Zufallwert         Zufallsvorzeichen
  direction +=rnd * .25      *     sgn(rnd-.5) 'die Ausgangsrichtung(Bogenmaß) um einen zufälligen Wert verändern

  'Limiter, die aktuelle Richtung darf nur in einem bestimmten Maß von der Initialrichtung abweichen
  'dadurch ergibt sich indirekt eine Art von Streuungskegel
  if direction>initdirection+max_misaligned then direction=initdirection+max_misaligned
  if direction<initdirection-max_misaligned then direction=initdirection-max_misaligned

  nx=xpos + cos(direction)
  ny=ypos + sin(direction)

  if (int(nx)<>ix) or (int(ny)<>iy) then'nur wenn die neue Position(nx,ny) nach Integerrundung ein Pixel neben der alten liegt
    actdist +=1
    component=255 * ((fulldist-actdist)/fulldist)
    ix=int(xpos)
    iy=int(ypos)
    line -(Xo+ix,Yo-iy),rgb(component,component,component)
  end if

  if actdist<fulldist then RandomWalk(nx,ny,direction)   'sollte Gesamtlänge noch nicht erreicht sein, "rekursives Verlängern"
end sub

Mutton
Roland Chastain
Posts: 993
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: rnd

Post by Roland Chastain »

Beautiful!
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: rnd

Post by BasicCoder2 »

Here is a lightning globe version :)

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

screenres 500,500,32
dim as integer posX,posY
dim as double angle,dx,dy
dim as ubyte r,g,b,a
dim as double time1
time1 = timer
do
    if timer > time1+0.05 then
        time1 = timer
        screenlock
        cls
        circle (250,250),205,rgb(20,20,100),,,,f
        for j as integer = 0 to 5
            posX = 250
            posY = 250
            angle = int(rnd(1)*360)
            r = int(rnd(1)*255)
            g = int(rnd(1)*255)
            b = int(rnd(1)*255)
            while sqr((250-posx)^2+(250-posY)^2)<200
                r = 255-sqr((250-posx)^2+(250-posY)^2)
                angle = angle + int(rnd(1)*30)-15
                dx = cos(angle*DtoR)*5
                dy = sin(angle*DtoR)*5
                line (posX,posY)-(posX+dx,posY+dy),rgb(r,r,r)
                posX = posX+dx
                posY = posY+dy
            wend
        next j
        circle (250,250),5,rgb(200,200,200),,,,f
        screenunlock
    end if
    
    sleep 2
loop until multikey(&H01)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: rnd

Post by dodicat »

Well done Muttonhead and BasicCoder2.
Here is my contribution:

Code: Select all

 
Sub drawline(x As Integer,y As Integer,angle As Double,length As Double,col As Uinteger,Byref x2 As Integer=0,Byref y2 As Integer=0)
    angle=angle*.0174532925199433  'degrees to radians
    x2=x+length*Cos(angle)
    y2=y-length*Sin(angle)
    Line(x,y)-(x2,y2),col
End Sub
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define range(f,l) int(Rnd*((l+1)-(f))+(f))

Dim As Integer a(1 To 6),l(1 To 6),x2,y2,da
Screenres 800,600,32
Do
    For n As Integer=1 To 6:a(n)=range(250,290):l(n)=range(10,20):Next'refresh
        Screenlock
        Cls
        Circle(400,300),5,Rgb(255,255,255),,,,f
        For z As Integer=1 To 6 'six prongs
            drawline(400,300,a(z),l(z),Rgb(255,255,255),x2,y2) 'start off
            For z2 As Integer=1 To 30 '30 deviations (extensions) on each prong
                if x2<400 then da=range(30,-40) else da=range(-30,40)
                a(z)+=da
                Var q=map(1,30,z2,255,20)'fade map
                drawline(x2,y2,a(z),l(z)+range(0,5),Rgb(q,q,q),x2,y2)
            Next z2
        Next z   
        Screenunlock
        Sleep 200
    Loop Until Len(Inkey)
    Sleep
    
Muttonhead
Posts: 139
Joined: May 28, 2009 20:07

Re: rnd

Post by Muttonhead »

take "the scream" by Edvard Munch,
this effect as an alien with tentacles in the background
and the string theme from the psycho movie
:D

Mutton
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Re: rnd

Post by anonymous1337 »

I can dig it!
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Re: rnd

Post by anonymous1337 »

I follow up with...

Code: Select all

#include once "fbgfx.bi"
randomize(timer())
Sub drawline(x As Integer,y As Integer,angle As Double,length As Double,col As Uinteger,Byref x2 As Integer=0,Byref y2 As Integer=0)
    angle=angle*.0174532925199433  'degrees to radians
    x2=x+length*Cos(angle)
    y2=y-length*Sin(angle)
    Line(x,y)-(x2,y2),col
End Sub
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define range(f,l) int(Rnd*((l+1)-(f))+(f))

Dim As Integer a(1 To 6),l(1 To 6),x2,y2,da
Screenres 800,600,32,, fb.GFX_ALPHA_PRIMITIVES
Do
    For n As Integer=1 To 6
        a(n) += range(-5,5)
        l(n) += range(-5,5)
    Next
    
    Screenlock
    line(0, 0)-(800, 600), rgba(0,0,0, 30), bf
    For z As Integer=1 To 6 'six prongs
        drawline(400,300,a(z),l(z),Rgb(255,255,255),x2,y2) 'start off
        For z2 As Integer=1 To 30 '30 deviations (extensions) on each prong
            Var q=map(1,30,z2,255,20)'fade map
            
            da=range(-10, 10)
            a(z)+=da
            
            drawline(x2,y2,a(z),l(z)+range(0,5),Rgb(255-q,128+q mod 256,q),x2,y2)
        Next z2
    Next z   
    Screenunlock
    sleep 100
Loop Until Len(Inkey)
Lothar Schirm
Posts: 436
Joined: Sep 28, 2013 15:08
Location: Germany

Re: rnd

Post by Lothar Schirm »

Whow! Strong!
Post Reply