I know fxm, I had to change things.
If you have some graphics code and want to show it in mono then your ide can change rgb to o rgb where rgb was bracketed before.
Now I must also change rgb.
Code: Select all
#define mono
#define RGBcol(r,g,b) (CULng((CUByte(r) Shl 16) Or (CUByte(g) Shl 8) Or CUByte(b) Or (&hFF000000ul)))
#ifdef mono
Function o(c As Ulong) As Ulong
Var v=.299*((c Shr 16)And 255)+.587*((c Shr 8)And 255)+.114*(c And 255)
Return Rgb(v,v,v)
End Function
#else
#define o
#endif
Screen 20,32
Dim Shared As Integer xres,yres
Screeninfo xres,yres
Type Point
As Single x,y,z
#define vct Type<Point>
End Type
Type Line
As Single x1,y1,x2,y2
End Type
Type particle
As Point position,velocity
End Type
Type screendata
As Integer w,h,depth,bpp,pitch
As Any Pointer row
As Ulong Pointer pixel
As Ubyte Pointer pixel8
End Type
Dim Shared As screendata s
With s
Screeninfo .w,.h,.depth,.bpp,.pitch
.row=Screenptr
End With
Operator + (v1 As Point,v2 As Point) As Point
Return vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(v1 As Point,v2 As Point) As Point
Return vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (f As Single,v1 As Point) As Point 'scalar*point
Return vct(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator * (v1 As Point,f As Single) As Point 'point*scalar
Return f*v1
End Operator
Function length(v As Point) As Single
Return Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
End Function
Function normalize(v As Point) As Point
Dim n As Single=length(v)
If n=0 Then n=1e-20
Return vct(v.x/n,v.y/n,v.z/n)
End Function
Sub bline(sd As screendata,x1 As Long,y1 As Long,x2 As Long,y2 As Long,col As Ulong)
#macro ppset(_x,_y,colour)
sd.pixel=sd.row+sd.pitch*(_y)+(_x) Shl 2
*sd.pixel=(colour)
#endmacro
#macro ppset8(_x,_y,colour)
sd.pixel8=sd.row+sd.pitch*(_y)+(_x)
*sd.pixel8=(colour)
#endmacro
#define onscreen ((x1+x)>=0) And ((x1+x)<(sd.w-1)) And ((y1+y)>=0) And ((y1+y)<(sd.h-1))
Var dx=Abs(x2-x1),dy=Abs(y2-y1),sx=Sgn(x2-x1),sy=Sgn(y2-y1)
Dim As Long e
If dx<dy Then e=dx\2 Else e=dy\2
Do
For x As Long=0 To 1
For y As Long=0 To 1
If onscreen Then
If sd.depth=8 Then: ppset8((x1+x),(y1+y),col):End If
If sd.depth=32 Then: ppset((x1+x),(y1+y),col):End If
End If
Next y
Next x
If x1 = x2 Then If y1 = y2 Then Exit Do
If dx > dy Then
x1 += sx : e -= dy : If e < 0 Then e += dx : y1 += sy
Else
y1 += sy : e -= dx : If e < 0 Then e += dy : x1 += sx
End If
Loop
End Sub
Sub thickline(sd As screendata,_
x1 As Long,_
y1 As Long,_
x2 As Long,_
y2 As Long,_
thickness As Long,_
colour As Ulong)
Dim As Single yp,s,h,c
h=Sqr((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))
s=(y1-y2)/h
c=(x2-x1)/h
For yp=-thickness/2 To thickness/2
bline(sd,x1+(s*yp),y1+(c*yp),x2+(s*yp),y2+(c*yp),colour)
Next yp
End Sub
'=================================
Sub LINETO(L As Line,lngth As Single,Byref x As Single=0,Byref y As Single=0,col As Ulong=1,th As Single=1)
Dim As Single diffx=L.x2-L.x1,diffy=L.y2-L.y1,ln=Sqr(diffx*diffx+diffy*diffy)
Dim As Single nx=diffx/ln,ny=diffy/ln 'normalize
thickline(s,L.x1,L.y1,L.x1+lngth*nx,L.y1+lngth*ny,th,col)
x=L.x1+lngth*nx
y=L.y1+lngth*ny
End Sub
Function swing(px As Single,inc As Single) As Single
Return px+200*Cos(inc)+15
End Function
Sub Tree(i As Any Ptr=0,x1 As Single,y1 As Single,size As Single,angle As Single,depth As Single,colb As Ulong=0,colL As Ulong=0)
Dim As Single spread,scale,x2,y2
spread=25
scale=.76
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
x2=x1-.25*size*Cos(angle*.01745329)
y2=y1-.25*size*Sin(angle*.01745329)
Static As Long count,fx,fy,sz,z
If count=0 Then fx=x1:fy=y1:sz=size:z=2^(depth+1)-1
Line i,(x1,y1)-(x2,y2),colb
If count=0 Then fx=x2:fy=y2:sz=size
count=count+1
If count>z Then count=0
If incircle(fx,fy,(.45*sz),x2,y2)=0 Then Circle i,(x2,y2),.01*sz,colL
If depth>0 Then
Tree(i,x2, y2, size * Scale, angle - Spread, depth - 1,colB,colL)
Tree(i,x2, y2, size * Scale, angle + Spread, depth - 1,colB,colL)
End If
End Sub
Function legs2(xpos As Single,ypos As Single,inc As Single,thick As Single=9,lngth As Single=60) As Long
Dim As Single endx,endy
ypos+=5
Static As Single dx,dy,ynow
dx-=1*.5
xpos+=dx
ypos-=(dy)
If dy<>0 Then ynow=ypos
If xpos>279 Then dy-=.7*.5 Else ypos=ynow:dy=0
If xpos<130 Then ynow+=5
Var _ypos=ypos+.1*lngth*Sin(2*inc)
Dim As Line start=Type(xpos,_ypos,swing(xpos,inc),600)
Dim As Line body=Type<Line>(xpos,_ypos,-.5*xres,-2*yres)
lineto(body,1.2*lngth,endx,endy,o rgbcol(0,200,0),thick)
Circle(endx,endy),.015*yres,o rgbcol(200,200,0),,,,f
lineto(start,lngth,endx,endy,o rgbcol(200,50,50),thick)
start=Type(endx,endy,swing(xpos+200,inc-1),600)
lineto(start,1.1*lngth,endx,endy,o rgbcol(200,50,50),thick)
Var diff=4*Atn(1)
start=Type(xpos,_ypos,swing(xpos,diff+inc),600)
lineto(start,lngth,endx,endy,o rgbcol(200,50,50),thick)
start=Type(endx,endy,swing(xpos+200,diff+inc-1),600)
lineto(start,1.1*lngth,endx,endy,o rgbcol(200,50,50),thick)
Return ypos
End Function
'==================================================
Sub drawline(x As Long,y As Long,angle As Single,lngth As Double,col As Ulong,Byref x2 As Single=0,Byref y2 As Single=0,flag As Long=1)
angle=angle*Atn(1)/45
x2=x+lngth*Cos(angle)
y2=y-lngth*Sin(angle)
If flag Then ThickLine(s,x,y,x2,y2,0,col)
End Sub
Sub drawstep(x As Long,y As Long,angle As Single,lngth As Double,col As Ulong,Byref x2 As Single=0,Byref y2 As Single=0,flag As Long=1)
drawline(x,y,angle+180,.8*lngth,col,x2,y2,flag)
drawline(x2,y2,angle-90,.6*lngth,col,x2,y2,flag)
ThickLine(s,x,y,x2,y2,0,col)
End Sub
Sub star(starX As Single,starY As Single,size As Single,col As Ulong,num As Long=5,rot As Single=0,cut As Single=.4)
Var count=0,rad=0.0,_px=0.0,_py=0.0,pi=4*Atn(1),prime=o rgbcol(255,254,253)
For x As Long=1 To 2
For z As Single=0+.28 +rot To 2*pi+.1+.28 +rot Step 2*pi/(2*num)
count=count+1
If count Mod 2=0 Then rad=size Else rad=cut*size
_px=starx+rad*Cos(z)
_py=stary+rad*Sin(z)
If count=1 Then Pset (_px,_py)Else Line -(_px,_py),prime
Next z
Paint (starx,stary),prime,prime
count=0:prime=col
Next x
End Sub
Sub trace(In() As Point,Outarray() As Point,roundedness As Single=60)
Dim As particle p:roundedness=roundedness/10
If roundedness<1 Then roundedness=1
If roundedness>100 Then roundedness=10
p.position=In(Lbound(In))
p.velocity=normalize(Type<Point>(In(Lbound(In)+1)-In(Lbound(In))))
Redim Preserve Outarray(1 To Ubound(Outarray)+1)
Outarray(Ubound(Outarray))=Type<Point>(In(Lbound(In)).x,In(Lbound(In)).y,In(Lbound(In)).z)
Dim As Point f
For n As Long=Lbound(In) To Ubound(In)-1
Do
Var dist=length(p.position-In(n+1))
f=(1/(Ubound(In)))*f+normalize(In(n+1)-p.position)
p.velocity= roundedness*normalize(p.velocity+f)
p.position=p.position+p.velocity
Redim Preserve Outarray(1 To Ubound(Outarray)+1)
Outarray(Ubound(Outarray))=Type<Point>(p.position.x,p.position.y,p.position.z)
If dist<5*roundedness Then Exit Do
Loop Until Len(Inkey)
Next n
Redim Preserve Outarray(1 To Ubound(Outarray)+1)
Outarray(Ubound(Outarray))=Type<Point>(In(Ubound(In)).x,In(Ubound(In)).y,In(Ubound(In)).z)
End Sub
Sub setpoints(In() As Point)
Dim As Long x1,y1,x2,y2
Dim As Single pi=4*Atn(1)
Dim As Long X',Y
#define Y (y2-y1)*(X-x1)/(x2-x1) + y1
#define ub Ubound(in)
#macro arcs(xc,yc,R,b,e,s)
For z As Single=b To e Step s
Var xx=xc+R*Cos(z),yy=yc+R*Sin(z)
Redim Preserve in(1 To ub+1)
in(ub)=vct(xx,yy,0)
Next z
#endmacro
x1=.3*xres
y1=.56*yres
x2=.8*xres
y2=.1*yres
Redim in(1 To 5)
in(1)=vct(x1,y1,0)
X=.4*xres
in(2)=vct(X,Y,0)
X=.6*yres
in(3)=vct(X,Y,0)
X=.7*xres
in(4)=vct(X,Y,0)
in(5)=vct(.8*xres,Y,0)
Var rad=.15*yres
Var cx=x2,cy=Y+rad
arcs(cx,cy,(rad),((3/4)*2*pi+.2),((3/4)*2*pi+1*pi),.3)
Redim Preserve in(1 To ub+1)
in(ub)=vct(in(4).x,.488*yres,0)
Redim Preserve in(1 To ub+1)
in(ub)=vct(x1,.85*yres,0)
Redim Preserve in(1 To ub+1)
in(ub)=vct(x1-.12*xres,.85*yres,0)
cx=.18*xres:cy=.7*yres
arcs(cx,cy,rad,pi/2,((3/4)*2*pi),.3)
Redim Preserve in(1 To ub+1)
in(ub)=vct(x1,y1,0)
X=.31*xres
'in(2)=vct(X,Y,0)
Redim Preserve in(1 To ub+1)
'in(ub)=vct(in(2).x,in(2).y,0)
in(ub)=vct(X,Y,0)
End Sub
Function _mod(n As Long) As Long
If n Mod 41=0 Then Return 1
Return n Mod 41
End Function
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) 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
Sub createscene(Byref i As Any Ptr)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
#define range(f,l) Int(Rnd*((l+1)-(f))+(f))
Line i,(0,0)-(1024,768),0,bf
For n As Long=0 To 600
Var red=map(0,600,n,0,255)
Var green=map(0,600,n,0,255)
Var blue=map(0,600,n,100,255)
Line i,(0,n)-(1024,n),o rgbcol(red,green,blue)
Next
Circle i,(512,10000),10000-410,o rgbcol(200,100,0),,,,f
For n As Long=1 To 300
Var xpos=Rnd*1024,ypos=range(420,868)
Var rd=range(0,200)
Var sz=map(420,768,ypos,5,150)
If ypos<550 Then Circle i,(xpos,ypos),sz/3,o rgbcol(100,50,0),,,.2,f
Tree(i,xpos,ypos,sz,range(80,100),12,o rgbcol(20,10,0),o rgbcol(rd,range(rd,250),20))
Next n
End Sub
Redim As Point in(0)
setpoints(in())
Redim As Point PTS(0)
trace(in(),PTS(),20)
'840 gap 40 ish
Dim As Long gap=Ubound(PTS)/40
Dim As Long k,n,fps,flag
Dim As Single angle,pi2=8*Atn(1)
Dim As Single inc
Dim As Any Ptr i=Imagecreate(1024,768)
createscene(i)
Do
k=k+1
angle=angle+.019
k=_mod(k)
inc=inc+.06
If inc>=pi2 Then inc=0
If angle>=pi2 Then angle=0
Screenlock
Cls
Put(0,0),i,Pset
'stanchions
thickline(s,.26*xres,.49*yres,.26*xres,yres,10,o rgbcol(0,100,200))
thickline(s,.68*xres,.25*yres,.68*xres,yres,10,o rgbcol(0,100,200))
thickline(s,.7*xres,.54*yres,.7*xres,yres,10,o rgbcol(50,0,200))
thickline(s,.275*xres,.81*yres,.275*xres,yres,10,o rgbcol(50,0,200))
thickline(s,.79*xres,.35*yres,.79*xres,yres,20,o rgbcol(50,0,20))
thickline(s,.16*xres,.71*yres,.16*xres,yres,20,o rgbcol(50,0,20))
Var snooze=regulate(55,fps)
Draw String(20,20),"FPS " & fps
For n =k-2*gap To Ubound(PTS) Step gap\2
If n>0 Then
drawstep(PTS(n).x,PTS(n).y,0,1.1*gap,o rgbcol(200,0,0))
End If
Next n
'main gears
star(.79*xres,.35*yres,yres/7.5,o rgbcol(100,40,0),18,angle,.8)
star(.16*xres,.71*yres,yres/7.5,o rgbcol(0,40,100),18,angle,.8)
'rollers
star(.26*xres,.49*yres,yres/15,o rgbcol(100,40,0),18,-angle,.8)
star(.68*xres,.255*yres,yres/30,o rgbcol(100,100,100),20,2*angle,.9)
star(.275*xres,.81*yres,yres/30,o rgbcol(100,100,100),20,2*angle,.9)
star(.7*xres,.54*yres,yres/30,o rgbcol(100,100,100),20,-2*angle,.9)
If legs2(.6*xres,.14*yres,inc,.012*yres,.05*yres)>750 Then flag=1
Screenunlock
Sleep snooze,1
If flag Then Exit Do
Loop Until Len(Inkey)
Sleep
Imagedestroy i
It is no big deal really, the ide can search and replace rgb with o rgbcol, after I have defined rgbcol.