Hi Ircvs.
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
