Lighthouse, night and fog

User projects written in or related to FreeBASIC.
lrcvs
Posts: 569
Joined: Mar 06, 2008 19:27
Location: Spain

Lighthouse, night and fog

Postby lrcvs » Oct 13, 2012 10:28

lighthouse, night and fog

Code: Select all


dim as integer  x, y, x1, y1,  sx, sy, r, rot, x2, y2, an, j, k, x3, y3, d, a, w, c, c2, p
dim as double grad, n, gra, pi

cls
sx = 800
sy = 600
screenres sx, sy
randomize ,3
pi = 4 * atn (1)
r = sx
c = 8 'color niebla/frog
c2 = 14 'color luz faro/ lighthouse

'put fog
for gra = 0 to 360
grad = (gra * (2*(pi))) / 360
for n = 0 to r
x3 = cos (grad) * n : y3 = sin (grad) * n
d = (rnd * 10) 'densidad niebla/density frog
if d = 1 then color c :pset (int(x3+(sx/2)),int(y3+(sy/2)))
next n
next gra

'rotate lighthouse
r = sx/2
an = 30
for gra = 0 to 3600
     
'light     
for n = 0 to r   
grad = (gra * (2*(pi))) / 360       
x3 = cos (grad) * n : y3 = sin (grad) * n
a = int(((an) * (2*(pi))) / 360)
x2 = int((x3 * cos (a)) - (y3 * sin (a)))
y2 = int((x3 * sin (a)) + (y3 * cos (a)))
if point (int(x2+(sx/2)),int(y2+(sy/2))) = c then color c2 :pset (int(x2+(sx/2)),int(y2+(sy/2)))
next n

'dark
for n = 0 to r
grad = ((gra - an) * (2*(pi))) / 360     
x3 = cos (grad) * n : y3 = sin (grad) * n
if point (int(x3+(sx/2)),int(y3+(sy/2))) = c2 then color c :pset (int(x3+(sx/2)),int(y3+(sy/2)))
next n

sleep 50
next gra
sleep
end

BasicCoder2
Posts: 3359
Joined: Jan 01, 2009 7:03

Re: Lighthouse, night and fog

Postby BasicCoder2 » Oct 13, 2012 19:38

This shows another way you might trace a light beam,

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

'size of window client area
const scrw = 480
const scrh = 480

sub shootRay(x1 As Integer,y1 As Integer,angle As Double,c As uinteger)
    Dim As Double dx,dy,change,aa,x,y
   
    dx = Cos(angle)
    dy = Sin(angle)
    y = y1
    x = x1

    If Abs(dx)>abs(dy) Then
        change = Abs(dy)/Abs(dx)
        If dx<0 Then
            aa = -1
        Else
            aa =  1
        End If
        If dy<0 Then
            change = - change
        End If

        While x>=0 And x<scrw And y>=0 And y<scrh
            x = x + aa
            y = y + change
            if point(x,y)<>rgb(0,0,0) then
                Pset(x,y),c
            end if
        Wend
    Else
        change = Abs(dx)/Abs(dy)
        If dy<0 Then
            aa = -1
        Else
            aa = 1
        End If
        If dx<0 Then
            change = -change
        End If

        While x>=0 And x<scrw And y>=0 And y<scrh
            y = y + aa
            x = x + change
            if point(x,y)<>rgb(0,0,0) then
                Pset(x,y),c
            end if
        Wend       
    End If
   
End sub


Screenres scrw,scrh,32,2

dim as integer ox,oy
ox = scrw\2
oy = scrh\2


screenset 1,0   'select page
        'draw fog
        Cls
        for j as integer = 0 to scrh-1
            for i as integer = 0 to scrw-1
                if int(rnd(1)*2)=1 then
                    pset(i,j),rgb(129,129,129)
                else
                    pset(i,j),rgb(0,0,0)
                end if
            next i
        next j
'==========   MAIN LOOP =====================

    for angle as double = 0 to 360
       
        'clear ray out of fog data
        for j as integer = 0 to scrh-1
            for i as integer = 0 to scrw-1
                if point(i,j)<>rgb(0,0,0) then
                    pset(i,j),rgb(129,129,129)
                end if
            next i
        next j
   
        'draw light house
        Circle (ox,oy),15,rgb(255,0,255),,,,f   
        For w as double = angle to angle + 20 step .5
            shootRay(ox,oy,w*DtoR,rgb(255,255,0)) 'draw yellow line
        Next w

        screencopy
        sleep 5
    next angle

End
Last edited by BasicCoder2 on Oct 13, 2012 20:45, edited 1 time in total.
lrcvs
Posts: 569
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Lighthouse, night and fog

Postby lrcvs » Oct 13, 2012 20:35

Hi, BasicCoder2:

True, your program is better than mine.!

The fog is better distributed and represented.

It is also best for your program detecting the particle of fog and the light ray of the lighthouse.

Very good, your program.!!!!

Regards
dodicat
Posts: 5828
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Lighthouse, night and fog

Postby dodicat » Oct 13, 2012 23:34

Hi Ircvs.
Fog or no fog, a Radar is is a handy bit of kit, if used correctly.

Code: Select all

 

declare Sub draw_string(xpos As Integer,ypos As Integer,text As String,colour As Uinteger,size As Single,textangle As Single=0,charangle as single=0,im as any pointer=0)
draw_string(0,0,"",0,0)
declare sub box_compass
declare sub beacon

Type d2
    As Single mx,my
End Type

#macro rotate2(pivot,p,a,d)
Type<d2>(d*(Cos(a*.0174533)*(p.mx-pivot.mx)-Sin(a*.0174533)*(p.my-pivot.my)) +pivot.mx,_
d*(Sin(a*.0174533)*(p.mx-pivot.mx)+Cos(a*.0174533)*(p.my-pivot.my)) +pivot.my)
#endmacro

#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius

dim shared as integer xres,yres
screenres 1000,650,32
screeninfo xres,yres
xres=xres-400
dim as double a=180
dim as uinteger green
dim as single sx,sy

dim shared as any pointer im
im=imagecreate(606,650)
box_compass
dim as single light=.1*yres
do
screenlock
cls
line im,(605,0)-(605,yres),rgb(100,100,100)
beacon
put(0,0),im,trans
draw_string(500,10,"RADAR|VIEW",rgb(100,0,0),2)
draw_string(610,10,"LOOKOUT'S|VIEW",rgb(100,0,0),2)
if light>yres/2-15 then
 draw_string(200,550,"CRUNCH",rgb(255,0,0),4,0,0)
screenunlock
exit do
end if   
a=a+1
green=(a+100)/2.5
line im,(xres/2,yres/2)-(xres/2,0),rgb(50,50,50)
if a=1 then
light=light+10
end if
draw_string(xres/2,light,"-",rgb(100,255-green,0),2,0,0,im)
draw_string(xres/2,yres/2,"O ...   -------    ........................",rgb(100,100,10),.75,(a+270),-(a+270),im)
draw_string(xres/2,yres/2,"O ...   -------    ........................",rgb(00,00,00),.75,(a+269.95),-(a+270),im)
draw_string(.35*xres,.8*yres,"Watson Watt technology 1935",rgb(100,0,0),1,0,0,im)
for x as integer=0 to 40
    sx=rnd*xres:sy=rnd*yres
    if incircle(xres/2,yres/2,250,sx,sy) then
    circle im,(sx,sy),5,rgb(0,0,0),,,,f
    end if
next x
for x as integer=0 to 250 step 50
    circle im,(xres/2,yres/2+5),x,rgb(50,50,50)
    next x
if a>=360 then a=0
screenunlock
sleep 1,1
loop until inkey<>""
sleep
imagedestroy im


sub beacon
    static as single d
    d=d+.0002
    dim as uinteger col
dim as d2 p=type<d2>(750,.8*yres),p1,p2,r1,r2,lx
    for x as single=-5 to 5 step .05
        p1=type<d2>(800+x,250)
        p2=type<d2>(800+5*x,yres-50)
        r1=rotate2(p,p1,0,d)
        if abs(x)<.01 then lx=r1
        r2=rotate2(p,p2,0,d)
        line(r1.mx,r1.my)-(r2.mx,r2.my),rgb(0,100-20*x,0)
       if x mod 3 =0 then
           line (r1.mx-1,r1.my)-(r1.mx-1,r1.my+10*d),rgb(100-20*x,100-20*x,100-20*x)
       end if
    next x
    var c=sin(50*d)
    if (sin(50*d))<.8 then col=rgb(100*c,100*c,100*c) else col=rgb(255,255,255)
    circle(lx.mx,lx.my-10*d),10*d*sin(50*d),col,,,,f
end sub

sub box_compass
    dim as single cr=0.01745329,cx=xres/2,cy=yres/2,k=.02,x,y
    dim as integer cz
    for z as integer=0 to 360 step 1
        cz=z+90
        if cz>360 then cz=cz-360
        x=cx+300*cos(z*cr)
        y=cy+300*sin(z*cr)
        if z mod 10=0 then
            draw_string(x+.08*(xres/2-x)-10,y+.08*(yres/2-y)-5,str(cz),rgb(100,100,100),1,0,0,im)
            k=.06
        else
            k=.02
        end if
        if (z mod 5=0) and (z mod 10 <> 0) then k=.04
        line im,(x,y)-(x+k*(xres/2-x),y+k*(yres/2-y)),rgb(100,100,100)
    next z
    end sub

Sub draw_string(xpos As Integer,ypos As Integer,text As String,colour As Uinteger,size As Single,textangle As Single=0,charangle As Single=0,im As Any Pointer=0)
    Type point2d
        As Single x,y
        As Uinteger col
    End Type
    Dim As Integer flag,codenum=256
    if instr(text,"|") then flag=1
    Static As Integer runflag
    Static As point2d infoarray()
    Redim Preserve As point2d infoarray(64,codenum)
    If runflag=0 Then   
        Dim As Uinteger background=0
        Screenres 10,10 
        Dim count As Integer
        For ch As Integer=1 To codenum
            Cls
            Draw String(1,1),Chr(ch)
            For x As Integer=1 To 8 
                For y As Integer=1 To 8
                    If Point(x,y)<>background Then
                        count=count+1
                        infoarray(count,ch)=Type<point2d>(x,y)
                    End If
                Next y
            Next x
            count=0
        Next ch
        runflag=1
    End If
    If size=0 Then Exit Sub
    Dim As point2d temp(1 To 64,codenum),np
    Dim As Single cr= 0.01745329
    #macro rotate(p1,p2,a,d)
    np.col=p2.col
    np.x=d*(Cos(a*cr)*(p2.x-p1.x)-Sin(a*cr)*(p2.y-p1.y)) +p1.x
    np.y=d*(Sin(a*cr)*(p2.x-p1.x)+Cos(a*cr)*(p2.y-p1.y)) +p1.y
    #endmacro
   
    Dim As point2d cpt(1 To 64),c=Type<point2d>(xpos,ypos),c2
    Dim As Integer dx=xpos,dy=ypos
    For z6 As Integer=1 To Len(text)
        var asci=text[z6-1]
        If asci=124 Then
            if charangle<>0 then xpos=xpos+12*sin(charangle*cr)
            dx=xpos:dy=dy+12:Goto skip 'pipe | for new line
        End If
        For _x1 As Integer=1 To 64
            temp(_x1,asci).x=infoarray(_x1,asci).x+dx
            temp(_x1,asci).y=infoarray(_x1,asci).y+dy
            temp(_x1,asci).col=colour
            rotate(c,temp(_x1,asci),textangle,size)
            cpt(_x1)=np
            var copyy=np.y
            If charangle<>0 Then
              if flag then var p=1 else  p=(z6-1)
c2=Type<point2d>(xpos+(size*8)*p*(Cos(textangle*cr)),ypos+(size*8)*p*(Sin(textangle*cr)))
                rotate(c2,cpt(_x1),charangle,1)
               if flag then np.y=copyy
                cpt(_x1)=np
            End If
            If infoarray(_x1,asci).x<>0 Then 
                If Abs(size)>1 Then
                    line(cpt(_x1).x-size/2,cpt(_x1).y-size/2)-(cpt(_x1).x+size/2,cpt(_x1).y+size/2),cpt(_x1).col,bf
                Else
                    Pset im,(cpt(_x1).x,cpt(_x1).y),cpt(_x1).col
                End If
            End If
        Next _x1
        dx=dx+8+4*(sin(charangle*cr))*flag
        skip:
    Next z6
End Sub
 
lrcvs
Posts: 569
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Lighthouse, night and fog

Postby lrcvs » Oct 14, 2012 4:25

Hi, DodiCat:

Unsurpassed, fantastic, very very very good.!!

Your imaginacon mathematical knowledge and possibly be overcome by your high level of programming and / or vice versa.

After seeing your program, I need three days to study and try to understand, but I like to study, are very well done and structured.

Here we say: "The imagination and culture to power ...!"

Moreover, without a comment of yours to my programs, I would be depressed, are very good.

Regards
fxm
Posts: 9021
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Lighthouse, night and fog

Postby fxm » Oct 14, 2012 8:27

And then, the radar sweep well rotates in the clockwise!
lrcvs
Posts: 569
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Lighthouse, night and fog

Postby lrcvs » Oct 14, 2012 12:15

Hi, fxm:

(LOL):

English can be a radar.!

Like cars, run counter to the rest, from our point of view.

For them, the rest going in reverse.!

Regards!
Kot
Posts: 336
Joined: Dec 28, 2006 10:34

Re: Lighthouse, night and fog

Postby Kot » Oct 14, 2012 17:44

I heard it has happened for real... http://www.youtube.com/watch?v=Ca0eO9Pjf8A
BasicCoder2
Posts: 3359
Joined: Jan 01, 2009 7:03

Re: Lighthouse, night and fog

Postby BasicCoder2 » Oct 14, 2012 18:47

Dodicat has changed it from a lighthouse to radar which of course isn't the same subject.
A 3d game involving sailing ships and navigating the coast using light houses before radar became available might interest some?
Today computers generate the display for radar data but the older technology I think were something like this?
I haven't added any fading blips.

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

const scrw = 600
const scrh = 600

Screenres scrw,scrh,32,2

sub DrawRadar(direction as double)

    cls
    color rgb(1,1,1)  'color for printed data

     
    dim as integer ox,oy,v,c   
    dim as double dx,dy
    dim as string word

    ox = scrw\2
    oy = scrh\2
    'metal frame
    line (0,0)-(scrw-1,scrh-1),rgb(100,100,100),bf
    'green phospher display
    circle (ox,oy),200,rgb(100,255,100),,,,f
    circle (ox,oy),201,rgb(1,1,1)
   
    'draw fading beams
    for i as double = 0 to 7 step 0.05
        dx = Cos((direction+i)*DtoR)
        dy = Sin((direction+i)*DtoR)
        line (ox,oy)-(ox+dx*200,oy+dy*200),rgb(100-i*10,255,100-i*10)
    next i
   
    'draw steps of 5 degrees
    c = 0
    for a as double = 0 to 359
        dx = Cos(a*DtoR)
        dy = Sin(a*DtoR)
        if c = 0 then
            line (ox+dx*240,oy+dy*240)- (ox+dx*250,oy+dy*250),rgb(1,1,1)
            word = str(a)
            v = (len(word)*8)\2  'center of word
            draw string (ox+dx*260-v,oy+dy*260),word
        else
            line (ox+dx*245,oy+dy*245)- (ox+dx*250,oy+dy*250),rgb(1,1,1)
        end if
        c = c + 1
        if c = 10 then
            c = 0
        end if
    next a
   
    'draw expanding circles measuring distance in 50km
    for r as integer = 50 to 200 step 50
        circle (ox,oy),r,rgb(100,100,100)
        draw string (ox-23,oy-r-8),str(r\10)+" km"
    next r
   
    'draw the screws
    circle (24,24),15,rgb(1,1,1)
    line (9,24)-(39,24),rgb(1,1,1)
    circle (576,576),15,rgb(1,1,1)
    line (561,576)-(591,576),rgb(1,1,1)
    circle (24,576),15,rgb(1,1,1)
    line (9,576)-(39,576),rgb(1,1,1)
    circle (576,24),15,rgb(1,1,1)
    line (561,24)-(591,24),rgb(1,1,1)
   
end sub

screenset 1,0   'select page

dim as double d  'direction of radar
d = 0
while inkey=""
    drawRadar(d)
    screencopy
    d = d + .2
    if d >= 360 then d = 0
wend

End
Destructosoft
Posts: 88
Joined: Apr 03, 2011 3:44
Location: Inside the bomb
Contact:

Re: Lighthouse, night and fog

Postby Destructosoft » Oct 14, 2012 21:28

BasicCoder2 wrote:Dodicat has changed it from a lighthouse to radar which of course isn't the same subject.
Wait until Chung shows up and adds helicopters.
lrcvs
Posts: 569
Joined: Mar 06, 2008 19:27
Location: Spain

Re: Lighthouse, night and fog

Postby lrcvs » Oct 16, 2012 17:36

Hi, BasicCoder2:

Apologies for not having made ​​any comments about your modifications to the "Radar" Dodicat, I have not seen yet.

The details you added, give a great resemblance to reality and finished perfect picture, Fantastico!

Both are great programmers!!

Regards
BasicCoder2
Posts: 3359
Joined: Jan 01, 2009 7:03

Re: Lighthouse, night and fog

Postby BasicCoder2 » Oct 16, 2012 19:17

lrcvs wrote:Apologies for not having made ​​any comments about your modifications to the "Radar" Dodicat, I have not seen yet.

Comments are not expected so you have nothing to apologize for.
Your program showed a creative solution to a problem and that I think is the important thing as anyone can learn to program with enough practice.
My programming skills are in fact very limited because I don't write object orientated code or use macros and so on.
There are some advanced programmers that have written FreeBasic code my favorite being DJPeters (Joshy) because he provided webcam code enabling me to try out some real time visual processing using a webcam but I don't actually understand how his code works.
Richard
Posts: 2944
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Lighthouse, night and fog

Postby Richard » Oct 16, 2012 19:32

@ Kot.
http://en.wikipedia.org/wiki/Lighthouse ... ban_legend

@ dodicat.
The Scottish Engineer Robert Watson-Watt may be famed in Britain for his initial work in 1935 on what became radar, but in 1936 the “Plan Position Indicator” (PPI) was patented in Germany. It was first used in the German “Hunting Lodge” radar prior to the start of WW2, that was before Watson-Watt gave instructions for it's development in Britain.

@ BasicCoder2
Marine PPI radar antennas usually rotate about 26 times per minute = 2.3 seconds per sweep. The display obviously has the same sweep update rate. Dedicated “close range” radar using shorter wavelengths and have stronger received signals from nearby, so the antenna is smaller and the sweep rate can be increased. Most vessels are now fitted independently with both systems. Your simulated rotation rate is a bit too fast for either.
bfuller
Posts: 328
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

Re: Lighthouse, night and fog

Postby bfuller » Oct 16, 2012 23:38

Frequency, doppler shift, pulse width, The Scan rate, Pulse repetition rate, antenna gain, beamwidth, height, min range, maximum range, multiple target discrimination (in both range and bearing) and so on are effectively all design trade offs, and the speed of light does not compromise. I think it was "Skolnik" who wrote my textbook----even with modern digital techniques, the old Maths is still relevant.

The PPI simulators above are very, very good for what they are (I like the fading sweep, that looks neat---digital emulating what was essentially an analog display characteristic), but they are not "Radar" simulators yet by a long shot.
Richard
Posts: 2944
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Lighthouse, night and fog

Postby Richard » Oct 17, 2012 2:20

Yes, Skolnik edited the "RADAR Handbook". Essential reading to any ELINT or EW officer.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 1 guest