Squares and circles, the forum's best threads by far.
I saw the Flying dutchman in 1972, I took a picture and got it enlarged and put it up in the mess room.
I haven't seen that ship since.
Code: Select all
Dim As String zz = _
"S2C0BM50,108M+4,42M+7,7M+1,15M+-6,2M+1,6"_
&"M+38,-1M+-1,-7M+-32,0"_
&"BM+14,4P4294932224,0"_
&"BM+-2,4M+6,7"_
&"M+-2,10M+2,5M+2,17M+2,20M+-1,2M+260,0"_
&"M+16,-10M+9,-13M+5,-16M+5,-11M+14,-7M+14,-6"_
&"M+10,-8M+-55,8M+-13,-6M+-52,3M+-41,3M+-42,1"_
&"M+-22,-2M+-45,-3M+-26,-5M+0,0M+-24,-5M+0,0"_
&"M+-31,-7M+-2,14M+30,1M+1,8M+2,0"_
&"M+0,0M+0,0M+-20,2"_
&"BM+154,32P4288822016,0"_
&"BM+-165,-29M+1,26"_
&"M+-3,18M+0,12M+0,0M+16,-1M+0,-16M+-1,-18"_
&"M+-1,-14M+-2,-6M+-8,-1"_
&"B"_
&"BM+2,-1M+-4,1"_
&""_
&"BM+7,28P4285822068,0"_
&"BM+5,-95M+22,9M+15,9M+4,1M+0,10"_
&"M+16,5M+24,3M+25,4M+8,14M+2,4"_
&"B"_
&"BM+-143,-70M+3,2M+25,7M+3,3M+0,-1"_
&"BM+-28,14M+9,0M+12,5M+9,0M+14,5M+18,7"_
&"M+5,0"_
&"BM+-51,-30M+0,14M+-4,-16M+-1,16M+1,8"_
&"M+-3,10M+8,-10M+-2,14M+8,1M+1,-12"_
&"BM+30,11"_
&"P4285412870,0"_
&"BM+-31,-30P4283708934,0"_
&"BM+195,48M+5,-7M+0,-4M+66,-3M+7,12"_
&""_
&"B"_
&"BM+-80,2M+2,4M+0,-2"_
&"BM+21,-6P4283708934,0"_
&"BM+59,2M+135,-83"_
&"M+-127,87"_
&"BM+6,-7"_
&"B"_
&"BM+-2,5M+1,5"_
&"B"_
&"BM+-6,-13M+-13,6"_
&"BM+16,-1P4279308561,0"_
&"BM+1,-2P4281940281,0"_
&"BM+-39,-10"_
&"BM+6,1M+-8,0"_
&"M+9,-99M+6,1M+-6,98M+-2,0"_
&"BM+0,-23P4281940281,0"_
&"B"_
&"BM+2,-76M+-11,-12M+2,-6M+1,1"_
&"M+25,0M+-3,13M+-8,4M+-2,-1"_
&"B"_
&"BM+-1,-12"_
&"P4294912000,0"_
&"BM+-3,-8M+0,3M+7,-103"_
&"BM+1,1M+3,-1"_
&"M+-2,102M+0,2"_
&"BM+-3,-10"_
&"P4283848278,0"_
&"BM+6,-96M+1,-22"_
&"BM+-136,265M+1,-126M+5,0M+4,125"_
&"BM+-4,-29"_
&"P4283848278,0"_
&"BM+1,-96M+8,-6M+0,-10M+-26,1M+0,8"_
&"M+4,6M+9,2"_
&"BM+-1,-9P4294919424,0"_
&"BM+-1,-8M+4,-123M+4,-1"_
&"M+1,124"_
&"BM+-5,-15P4283256141,0"_
&"BM+-107,106M+9,3M+0,-68M+-6,1"_
&"M+-1,64"_
&"BM+2,-13P4283256141,0"_
&"BM+4,-54M+8,-1M+-1,-8M+-19,0"_
&"M+-1,10M+10,3"_
&"M+11,-5"_
&"BM+-18,-3P4294919424,0"_
&"BM+3,-7M+0,1M+-1,-99M+6,1M+3,98"_
&"BP4283256141,0"_
&"BM+-4,-12"_
&"P4283256141,0"_
&"BM+-1,25M+-15,77M+7,0M+9,-76M+-2,77"_
&"BM+-11,-11"_
&"M+12,-2M+0,-8M+-10,0M+2,-4M+8,0M+0,-5"_
&"M+-10,0M+3,-7M+7,3M+0,-8M+-7,2"_
&"BM+112,-47"_
&"M+-64,136M+9,1M+52,-135M+-44,135M+11,0M+36,-136"_
&"M+-22,136M+6,2M+15,-136M+-58,111M+46,2M+3,-7"_
&"M+-41,-4M+4,-6M+37,1M+1,-8M+-34,-3M+5,-8"_
&"M+27,1M+4,-10M+-28,-2M+4,-8M+22,1M+4,-11"_
&"M+-23,1M+4,-10M+17,0M+3,-9M+-14,-2"_
&"B"_
&"BM+135,-29"_
&"M+-36,114M+8,1M+31,-112M+-25,114M+0,0M+7,-1"_
&"M+0,0M+15,-112M+-5,110M+7,-107M+-6,106M+10,0"_
&"M+-5,-107"_
&"BM+-192,131M+64,3M+0,-4M+-56,-4"_
&"M+-5,5"_
&"BM+24,-2"_
&"BM+0,0P4294955008,0"_
&"BM+0,-58M+-117,-153M+9,2"_
&"M+111,147M+-6,4"_
&"B"_
&"BM+-71,-104P4283848278,0"_
&"BM+71,95P4283848278,0"_
&"BM+-39,54"_
&"M+1,8M+7,0M+-1,-7M+-11,0"_
&""_
&"BM+8,3P4283848278,0"_
&"BM+89,-2M+2,8M+6,0M+1,-8M+-10,0"_
&""_
&"BM+5,5P4283848278,0"_
&"B"_
&"BM+22,-4M+12,-1"_
&"M+0,11M+-13,-1M+1,-9"_
&"BM+3,2P4283848278,0"_
&"BM+27,-4M+14,0"_
&"M+-2,10M+-10,-1M+0,-9"_
&"BM+3,3P4283848278,0"_
&"BM+90,7M+-19,10"_
&"M+-3,-5M+2,-4M+-3,8M+8,6M+0,5M+6,-1"_
&""_
&"B"
Dim As String szz=zz
szz="S1"+Rtrim(zz,"S2")
Dim As String b = _
"C"+Str(Rgb(0,0,0))+"BM0,98M+99,0M+0,-100M+-12,-30M+-16,-15M+-18,-15"_
&"M+2,-24M+-15,1M+4,23M+-21,14M+-15,14M+-5,18"_
&"M+-4,13M+0,101"_
&"B"_
&"BM+49,-51P"+Str(Rgb(255,0,255))+","+Str(Rgb(0,0,0))'4278241280"
Type v2
As Long x,y
End Type
Type d2
As Single mx,my
As Single mw,dy
End Type
#define A_R( c ) ( ( c ) Shr 16 And 255 )
#define A_G( c ) ( ( c ) Shr 8 And 255 )
#define A_B( c ) ( ( c ) And 255 )
Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
Static As Integer pitch,pitchs,xres,yres,runflag
Static As Any Ptr row,rows
Static As Integer ddx,ddy,resultx,resulty
Imageinfo im,ddx,ddy,,pitch,row
If dest=0 Then
Screeninfo xres,yres,,,pitchS
rowS=Screenptr
Else
If sc<>1 Then
Dim As Integer x,y
Imageinfo dest,x,y
Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
End If
Imageinfo dest, xres,yres,,pitchS,rows
End If
Dim As Long centreX=ddx\2,centreY=ddy\2
Dim As Single sx=Sin(angle)
Dim As Single cx=Cos(angle)
Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
Var fx=sc*.7071067811865476,sc2=1/sc
If fixedpivot=false Then
shiftx+=centreX*sc-centrex
shiftY+=centrey*sc-centrey
End If
For y As Long=centrey-fx*mx+1 To centrey+ fx*mx
Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
shfty=y+shifty
For x As Long=centrex-mx*fx To centrex+mx*fx
If x+shiftx >=0 Then 'on the screen
If x+shiftx <xres Then
If shfty >=0 Then
If shfty<yres Then
resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
If resultx >=0 Then 'on the image
If resultx<ddx Then
If resulty>=0 Then
If resulty<ddy Then
Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
End If:End If:End If:End If
End If:End If:End If:End If
Next x
Next y
End Sub
Sub thickline(x1 As Single,_
y1 As Single,_
x2 As Single,_
y2 As Single,_
thickness As Single,_
colour As Ulong, _
i As Any Ptr=0)
If thickness<2 Then
Line i,(x1,y1)-(x2,y2),colour
Else
Var h=Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)) 'hypotenuse
Var s=(y1-y2)/h 'sine
Var c=(x2-x1)/h 'cosine
Dim As Ulong prime=Rgb(253,254,255)
For n As Integer=1 To 2
Line i,(x1+s*thickness/2,y1+c*thickness/2)-(x2+s*thickness/2,y2+c*thickness/2),prime
Line i,(x1-s*thickness/2,y1-c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),prime
Line i,(x1+s*thickness/2,y1+c*thickness/2)-(x1-s*thickness/2,y1-c*thickness/2),prime
Line i,(x2+s*thickness/2,y2+c*thickness/2)-(x2-s*thickness/2,y2-c*thickness/2),prime
Paint i,((x1+x2)/2,(y1+y2)/2),prime,prime
prime=colour
Next n
End If
End Sub
Function r2d (pivotx As Single,pivoty As Single,px As Single,py As Single,a As Single,scale As Single=1) As v2
Return Type(scale*(Cos(a)*(px-pivotx)-Sin(a)*(py-pivoty))+pivotx, _
scale*(Sin(a)*(px-pivotx)+Cos(a)*(py-pivoty))+pivoty)
End Function
Function shortline(fp As v2,p As v2,length As Long) As v2
Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
Return Type(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function
Sub throughview(b As d2,a As Single=2.9)
Static As Ulong _colour(81,81),clr
Static As Long result
#macro rotate(pivotx,pivoty,px,py,a,scale)
Var Newx=scale*((px-pivotx))+pivotx
Var Newy=scale*((py-pivoty))+pivoty
#endmacro
#macro incircle(cx,cy,r,mx,my,a)
If a<=1 Then
result=a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= r*r*a*a
Else
result=a*(cx-mx)*a*(cx-mx) +1*(cy-my)*1*(cy-my)<= (r)*(r)
End If
#endmacro
If b.mw=0 Then b.mw=1
b.mw=Abs(b.mw)
For x As Long=b.mx-40 To b.mx+40
For y As Long=b.my-40 To b.my+40
incircle(b.mx,b.my,40,x,y,a)
If result Then
clr=Point(x,y)
_colour(x-b.mx+40,y-b.my+40)=Rgb(A_R(clr)*.95,A_G(clr)*.95,A_B(clr)*.95)
End If
Next y
Next x
Static As Single dil
For x As Long=b.mx-40 To b.mx+40
For y As Long=b.my-40 To b.my+40
incircle(b.mx,b.my,40,x,y,a)
If result Then
rotate(b.mx,b.my,x,y,0,dil)
Var dist=Sqr((b.mx-newx)*(b.mx-newx)+(b.my-newy)*(b.my-newy))
dil=(b.mw+(.5-b.mw)*dist/(40*b.mw))
Line(NewX-dil/2,NewY-dil/2)-(NewX+dil/2,NewY+dil/2),_colour(x-b.mx+40,y-b.my+40),BF
End If
Next y
Next x
End Sub
Function Regulate(Byval MyFps As long,Byref fps As long) As long
Static As Double timervalue,lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
Screen 20,32
Dim As Any Ptr i,bt,sc,bck,bcki
sc=Imagecreate(1024,768,Rgb(128,50,0))
bck=Imagecreate(1024,768,Rgb(0,100,250))
bcki=Imagecreate(300,200)
Draw bcki,szz
Line bck,(0,500)-(1024,768),Rgb(0,0,100),bf
For x As Long=0 To 1024 Step 10
Line sc,(x,0)-(x,768),Rgb(70,25,0)
Next
i=Imagecreate(300,200,Rgb(0,100,200))
bt=Imagecreate(50,100)
Line i,(0,150)-(300,200),Rgb(0,0,100),bf
For k As Long=-5 To 5
Line i,(k,k)-(300+k,200+k),Rgb(50+5*k,40,0),b
Next k
Circle sc,(750,400),100,Rgb(255,0,255),,,,f
For k As Single=-5 To 5 Step .01
Circle sc,(750,400),100+k,Rgb(148+5*k,50,0)
Next k
Circle sc,(750,400),105,Rgb(0,50,0)
thickline(650,430,650,370,15,Rgb(20,10,0),sc)
thickline(750,290,755,310,4,Rgb(130,10,0),sc)
thickline(750,490,755,510,4,Rgb(130,10,0),sc)
thickline(355,550,655,550,8,Rgb(0,100,0),sc)
thickline(359,550,355,650,8,Rgb(50,10,0),sc)
thickline(651,550,651,650,8,Rgb(50,10,0),sc)
Draw i,zz
Draw bt,b
Put sc,(300,250),i,Pset
Dim As Long fps,mx,my
Dim As Single a,k=1,dx,grad
Dim As d2 bb
Dim As v2 p1=Type(200,700),p2=Type(800,700),rot1,rot2,pt
Do
Getmouse mx,my
a+=.01*k
dx+=1
If a>.3 Or a <-.3 Then k=-k
rot1=r2d(1024\2,768\2,p1.x,p1.y,-Sin(a*5)/5)
rot2=r2d(1024\2,768\2,p2.x,p2.y,-Sin(a*5)/5)
bb=Type(mx+25,my+60,1.5,0)
Screenlock
Cls
Put(0,0),bck,Pset
Put (780-240+dx,340),bcki,Alpha,50
If dx>440 Then dx=0
rotateimage(,sc,Sin(a*5)/5,0,0,2,Rgb(255,0,255),1)
grad=Atn(-(rot1.y-rot2.y)/(rot1.x-rot2.x))
pt=shortline(Type((rot1.x+rot2.x)/2,(rot1.y+rot2.y)/2),rot2,grad*1000-a)
rotateimage(,bt,Sin(a*5)/5,pt.x,pt.y-100,1,Rgb(255,0,255),1)
'Draw String(50,50),"fps "&fps
thickline(rot1.x,rot1.y,rot2.x,rot2.y,14,Rgb(20,10,0))
bb=Type(pt.x+25,pt.y-40,1.5,0)
throughview(bb,2)
Screenunlock
Sleep regulate(15,fps),1
Loop Until Len(Inkey)
Imagedestroy bt
Imagedestroy i
Imagedestroy sc
Imagedestroy bck
Imagedestroy bcki
Sleep