Yes, this was my thread.Dr_D wrote:There was even a little web app that people signed up for which showed locations & stuff.
http://freebasic.net/forum/viewtopic.php?t=3606
My, how things have changed. The website doesn't even exist any more.
Yes, this was my thread.Dr_D wrote:There was even a little web app that people signed up for which showed locations & stuff.
Pretty and Interesting dodicat, but it's not very elegant at the end to finish the loop 'For' by an "out of bounds array access at line 124" (array: bar ()), for people who compile with option -exx.dodicat wrote:Here's a spread of years with Theunis Jansen in the lead.fxm wrote:It comes close to this age group of 7-77 years.fxm wrote:- I love this great mix of age and culture in this forum, almost as well as readers of Tintin (from 7 to 77).
Theunis Jansen Congratulations!
And you, very very young, where are you?Code: Select all
'HISTOGRAM DRAWER Dim As Integer xres,yres screeninfo xres,yres xres=.8*xres yres=.8*yres Dim As Double PLOT_GRADE =10000 dim d as integer=31 'NUMBER OF AGES Dim As double bars(d):bars(0)=0 Dim As Double r,g,b,delta 'the colour variables 'line drawer (bresenham) #macro psetline(xf,yf,zf,xs,ys,zs) scope Dim As Single x1=xf Dim As Single y1=yf Dim As Single z1=zf Dim As Single x2=xs Dim As Single y2=ys Dim As Single z2=zs Dim As Single nx=x2-x1 Dim As Single ny=y2-y1 Dim As Single nz=z2-z1 Dim As Single length=Sqr(nx^2+ny^2+nz^2) nx=nx/length ny=ny/length nz=nz/length For i As Integer=0 To length x1=x1+nx y1=y1+ny z1=z1+nz Dim col As Uinteger=(255-delta)*(z1-zf)/(zs-zf)+delta Pset(x1,y1),rgb(col*r+x1/20,col*g,col*b) Next i end scope #endmacro #macro HISTOGRAM(_function,minx,maxx,miny,maxy) scope For x As Double=minx To maxx Step (maxx-minx)/PLOT_GRADE Dim As Double xx1=(xres)*(x-minx)/(maxx-minx) Dim As Double yy1=(yres)*(_function-maxy)/(miny-maxy) psetline(xx1,yres,0,xx1,yy1,1) Next x end scope #endmacro sub bubblesort(array() as double) dim as integer n=ubound(array) For p1 as integer = 1 To n - 1 For p2 as integer = p1 + 1 To n If (array(p1)) > (array(p2)) Then Swap array(p1),array(p2) Next p2 Next p1 end sub '****************** given values ********************** 'SET VALUES FOR BARS, always from 1 to number of bars randomize for z as integer =1 to d bars(1)=27 'mihail_b 27 bars(2)=28 'Lachie Dazdarian 28 bars(3)=48 'bcohio2001 48 bars(4)=60 'fxm 60 bars(5)=42'roook_ph 42 bars(6)=57'djsfantasi 57 bars(7)=33'rolliebollocks 33 bars(8)=20'KristopherWindsor '20 bars(9)=27'Imortis '27 bars(10)=41'vdecampo '41 bars(11)=65'Dinosaur '65 bars(12)=60'MichaelW '60 bars(13)=41'ike 41 bars(14)=17'Galeon 17 bars(15)=55'mico 55 bars(16)=35'h4tt3n 35 bars(17)=63'jcfuller 63 bars(18)=46'kot 46 bars(19)=33'badidea 33 bars(20)=46'D.J.Peters 46 bars(21)=33'kiyotewolf 33 bars(22)=18'Cherry 18 bars(23)=53'SARG 53 bars(24)=63'nobozoz 63 bars(25)=53'BasicScience 53 bars(26)=21'FotonCat 21 bars(27)=62'Dodicat 62 bars(28)=25'Gonzo 25 bars(29)=20'anonymous1337 20 bars(30)=75'Theunis Jansen 75 bars(31)=37'Dr_D 260/7 =37 next z bubblesort(bars()) ' ******************************************************* 'GET MAX AND MIN OF VERTICAL SCALE Dim As double max = bars(1) Dim As double min = max For count As Integer = 0 To ubound (bars) If bars(count) > max Then max = bars(count) Endif If bars(count) < min Then min = bars(count) Endif Next '******************* EXAMPLE ***************************** 'for z as integer=1 to d:print bars(z):next 'PRINT VALUES TO CONSOLE WINDOW 'SET THE BAR COLOURS r,g and b set 0 to 1 r=.5:g=.5:b=1 delta=0 'DELTA=0, full contrast, DELTA=255, no contrast screenres xres,yres,32,1 HISTOGRAM(bars(int(x)),1,d+1,min,1.1*max) dim count as integer for x as single=0 to xres step xres/(d) count=count+1 draw string(x+5,yres-20),str(bars(count)) line(x,yres)-(x,0),rgb(0,0,0) next x sleep
Code: Select all
'Old Marconi set and fxm
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
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
dim shared as integer xres,yres
screenres 600,600,32
screeninfo xres,yres
dim as double a=180
dim as uinteger green
dim as single sx,sy
box_compass
do
a=(a+1)
green=(a+100)/2.5
line(xres/2,yres/2)-(xres/2,0),rgb(50,50,50)
draw_string(xres/2,.1*yres,"fxm",rgb(100,255-green,0),.75)
draw_string(xres/2,yres/2,"O ... MARCONI ........................",rgb(100,100,10),.75,(a+270),-(a+270))
draw_string(xres/2,yres/2,"O ... MARCONI ........................",rgb(00,00,00),.75,(a+269.95),-(a+270))
draw_string(.4*xres,.9*yres,"Marconi technology 1972",rgb(100,0,0),.8)
for x as integer=0 to 40
sx=rnd*xres:sy=rnd*yres
if incircle(xres/2,yres/2,250,sx,sy) then
circle (sx,sy),5,rgb(0,0,0),,,,f
end if
next x
for x as integer=0 to 250 step 50
circle(xres/2,yres/2+5),x,rgb(50,50,50)
next x
if a>=360 then a=0
loop until inkey<>""
sleep
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)
k=.06
else
k=.02
end if
if (z mod 5=0) and (z mod 10 <> 0) then k=.04
line (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 codenum=128 '(Full Asci 256 if required)
Static As Integer runflag
Static As point2d infoarray()
Redim Preserve As point2d infoarray(64,codenum) '64 = 8 x 8 pixel size
If runflag=0 Then ' 'scan codenum of codepage once
Dim As Uinteger background=Rgb(0,0,0)
Screenres 10,10,32 '8 x 8 pixels on this screen
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 'scan for characters
For y As Integer=1 To 8
If Point(x,y)<>background Then
count=count+1
infoarray(count,ch)=Type<point2d>(x,y)'save pixel position
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,x1,y1,x2,y2 '(4*atn(1))/180=.017453....
#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
#macro box()
Dim As Single dx=x2-x1,dy=y2-y1
Swap dx,dy:dx=-dx
Dim As Single p1x=x1+dx/2,p1y=y1+dy/2
Dim As Single p2x=x1-dx/2,p2y=y1-dy/2
Dim As Single p3x=x2+dx/2,p3y=y2+dy/2
Dim As Single p4x=x2-dx/2,p4y=y2-dy/2
Dim As Uinteger c=Rgb(255,255,254)
For x As Integer=1 To 2
Line im,(p1x,p1y)-(p2x,p2y),c
Line im,(p3x,p3y)-(p4x,p4y),c
Line im,(p1x,p1y)-(p3x,p3y),c
Line im,(p2x,p2y)-(p4x,p4y),c
Paint im,((p1x+p2x+p3x+p4x)/4,(p1y+p2y+p3y+p4y)/4),c,c
c=cpt(z).col
Next x
#endmacro
Dim As point2d cpt(1 To 64),c=type<point2d>(xpos,ypos),c2
Dim As Single sz =size/2
Dim As Integer dx=xpos,dy=ypos,asci
For z6 As Integer=1 To Len(text)
asci=Asc(Mid(text,z6,1))
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
Next x1
c2=type<point2d>(xpos+(size*(z6-1)*8)*Cos(textangle*cr),ypos+(size*(z6-1)*8)*Sin(textangle*cr))
For z2 As Integer=1 To 64
rotate(c,temp(z2,asci),textangle,size)
cpt(z2)=np
if charangle<>0 then
rotate(c2,cpt(z2),charangle,1)
cpt(z2)=np
end if
Next z2
For z As Integer=1 To 64
x1=cpt(z).x-sz*(Cos((textangle+charangle)*cr)):y1=cpt(z).y-sz*(Sin((textangle+CHARANGLE)*cr))
x2=cpt(z).x+sz*(Cos((textangle+charangle)*cr)):y2=cpt(z).y+sz*(Sin((textangle+charangle)*cr))
if infoarray(z,asci).x<>0 then 'paint only relevant points
If Abs(size)>1 Then
box()
Else
Pset im,(cpt(z).x,cpt(z).y),cpt(z).col
End If
end if
Next z
dx=dx+8
Next z6
End Sub
You _know_ it ruins the "fun" if work mixes up with these things :PDr_D wrote:Too bad I don't do any of those things for a living. :p
In a loop 'For', it is preferable not to use floating iterator when the expected number of occurrences is important, because it may depend on rounding:dodicat wrote:Hi fxm ~ strange.
I compile now with -exx, since our silent altercation of a few days ago.
I made especially sure that that bleeding array never got out of bounds, I checked the value of count and it terminates at the array upper bound.
No error here.
fb 21.1 plus an svn of a few days ago.
XP pro.
Hi kiyotewolf
the -exx compiler switch is a strange fish, it is supposed to report errors including array out of bounds, well it does, for some arrays and different people.
Code: Select all
dim count as integer
for x as single=0 to xres step xres/(d)
count=count+1
draw string(x+5,yres-20),str(bars(count))
line(x,yres)-(x,0),rgb(0,0,0)
next x
Code: Select all
for i as integer = 0 to d - 1
draw string(i * xres / d + 5, yres - 20), str(bars(i + 1))
line(i * xres / d, yres)-(i * xres / d, 0), rgb(0, 0, 0)
next i
My grandpa was born in '30 so now is 81 ...Theunis Jansen wrote:Oh well here goes.
I was born on 28 September 1936 so In September I will be 75 years old.