This time if I use use -gen gcc, I get a pile of errors.
Code: Select all
#cmdline " -Wc -O2"
Type Point
As Single x,y,z
As Ulong col
End Type
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 drawpolygon(p() As Point, col As Ulong,im As Any Ptr=0)
Dim k As Long=Ubound(p)+1
Dim As Long index,nextindex
Dim As Single cx,cy,counter
For n As Long=1 To Ubound(p)
counter+=1
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=1
cx+=p(index).x:cy+=p(index).y
Line im,(p(index).x,p(index).y)-(p(nextindex).x,p(nextindex).y),col
Next
cx=cx/counter:cy=cy/counter
p(0)=Type<Point>(cx,cy)
Line im,(p(4).x,p(4).y)-(p(36).x,p(36).y),col
Paint im,((p(1).x+p(4).x)\2,p(1).y),Rgb(0,0,0),col'prop
Paint im,(cx,cy),col,col
For n As Long=8 To 10
Line im,(p(n).x,p(n).y)-(p(n+1).x,p(n+1).y),Rgb(200,0,0)
Next n
Line im,(p(11).x,p(11).y)-(p(8).x,p(8).y),Rgb(200,0,0)
Paint im,((p(8).x+p(10).x)/2,(p(8).y+p(10).y)/2),Rgb(100,100,255),Rgb(200,0,0)
for n as long=-1 to 1
line(p(16).x,p(16).y+n)-(p(21).x,p(21).y+n),rgb(0,0,0)
next
End Sub
Function RotatePoint(c As Point,p As Point,angle As Point,scale As Point=Type<Point>(1,1,1)) As Point
Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<Point>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
(scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
(scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z,p.col)
End Function
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 cloud(x As Long, y As Long,length As Long=100,Alpha As Long=105, Zoom As Single = 0,im As Any Ptr=0)
Static As Long r=255,b=255,g=255
Dim As Double pi=3.14159
Static As Long cl,p
cl=cl+1
If cl Mod 100000=0 Then
p=p+1
Draw String(x/50+8*p,400),"_____",Rgb(255,255,255)
End If
If Length<=1 Or Alpha<=1 Then Exit Sub
Dim As Single rnded = -pi+rnd*1*pi*3
Dim As Single rnded2 = -pi+rnd*-3*pi*3
If Alpha<15 Then
For i As long = 0 To 255-Alpha Step 100
Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),Rgba(R,G,B,Alpha)
Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),Rgba(R,G,B,Alpha)
Next
End If
cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom,im)
cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom,im)
cloud(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom,im)
End Sub
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 Filter(Byref tim As Ulong Pointer,_
Byval rad As Single,_
Byval destroy As long=1,_
Byval fade As long=0) As Ulong Pointer
#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
If fade<0 Then fade=0:If fade>100 Then fade=100
Type p2
As Long x,y
As Ulong col
End Type
#macro average()
ar=0:ag=0:ab=0:inc=0
xmin=x:If xmin>rad Then xmin=rad
xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
ymin=y:If ymin>rad Then ymin=rad
ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
For y1 As long=-ymin To ymax
For x1 As long=-xmin To xmax
inc=inc+1
ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
ab=ab+(NewPoints(x+x1,y+y1).col And 255)
Next x1
Next y1
If fade=0 Then
averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
Else
averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
End If
#endmacro
Dim As Single fd=map(0,100,fade,1,0)
Dim As Integer _x,_y
Imageinfo tim,_x,_y
Dim As Ulong Pointer im=Imagecreate(_x,_y)
Dim As Ulong col
Dim As p2 NewPoints(_x-1,_y-1)
For y As long=0 To (_y)-1
For x As long=0 To (_x)-1
col=Point(x,y,tim)
NewPoints(x,y)=Type<p2>(x,y,col)
Next x
Next y
Dim As Ulong averagecolour
Dim As long ar,ag,ab
Dim As long xmin,xmax,ymin,ymax,inc
For y As long=0 To _y-1
For x As long=0 To _x-1
average()
Pset im,((NewPoints(x,y).x),(NewPoints(x,y).y)),averagecolour
Next x
Next y
If destroy Then Imagedestroy tim: tim = 0
Function= im
End Function
Function range(f As Long,l As Long) As Long
Return Int(Rnd*((l+1)-(f)))+f
End Function
Function go As Long
#macro backdrop()
Scope
#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
Dim As Single minx,maxx,miny,maxy,lasty,grad
Dim As Long ctr
#macro paintsketch(_function,r,g,b,im,sz,set)
Randomize 1
ctr=0
For x As Double=minx To maxx Step (maxx-minx)/5000
ctr+=1
If ctr=4500 Then Randomize 1
Dim As Double x1=(xres)*(x-minx)/(maxx-minx)
Dim As Double y1=(yres)*(_function-maxy)/(miny-maxy)
If ctr Mod set=0 Then
Var xx=x1+rnd*5-rnd*5,yy=y1+rnd*set/4
tree(im,xx,yy,sz,90+(rnd*10-rnd*10),12,Rgb(100,10+rnd*50,0),Rgb(rnd*50,100+rnd*100,0))
End If
grad=y1-lasty
lasty=y1
grad=grad*250
Line im,(x1,yres)-(x1,y1),Rgb(r+grad,g+grad,b)
Next x
#endmacro
#macro _window(topleftX,topleftY,bottomrightX,bottomrightY)
minx=topleftX
maxx=bottomrightX
miny=bottomrightY
maxy=topleftY
#endmacro
#macro sea
For z As Long=0 To .7*yres
Var r=map(0,(.7*yres),z,0,250)
Var g=map(0,(.7*yres),z,0,250)
Var b=map(0,(.7*yres),z,200,250)
Line im2,(0,z)-(xres,z),Rgb(r,g,b)
Next z
#endmacro
sea
Dim As Single pi=4*Atn(1)
_window(-4*pi,3,4*pi,-1.2)
paintsketch(.05*Sin(x)+.05*Sin(2*x),50,100,50,imgs(1),15,100)
_window(-3*pi,2,3*pi,-.8)
paintsketch(.1*Sin(x),50,120,0,imgs(2),25,100)
_window(-2*pi,2,2*pi,-.6)
paintsketch(.1*Sin(x),50,150,0,imgs(3),30,150)
_window(-pi,2,pi,-.5)
paintsketch(.2*Sin(x),50,170,0,imgs(4),55,150)
Var x=xres,y=yres
Randomize 2
For a As Long = 1 To 7
If a<=5 Then
cloud(x*1.5/a, y*1/a, Range(60,80)/2, Range(40,60),5,im2)
cloud(x*1.4/a, y*2/a, range(60,80)/2, range(40,60),2,im2)
End If
If a=6 Then cloud(x/2,y/4,150,250,1,im2)
If a=7 Then cloud(.8*x,.1*y,100,80,5,im2)
Next
im2=filter(im2,2)
Line im2,(0,.7*yres)-(xres,.9*yres),Rgb(0,50,200),bf
End Scope
#endmacro
#macro Sweep(p,_step,sz)
For z As Long=0 To (sz)\4 -_step
Swap p[z],p[z+_step]
Next z
#endmacro
Dim As Integer xres,yres
Screenres 1024,768,32,,64
Screeninfo xres,yres
Width xres\8,yres\16
Dim As Any Ptr sim=Imagecreate(150,25)
Draw String sim,(5,10),"D-CAT",Rgb(0,0,0)
Draw String sim,(129,10),"|||",Rgb(0,0,0)
Circle sim,(90,15),35,Rgb(0,10,0),,,.1,f
Dim As Any Ptr im2=Imagecreate(xres,yres)
Dim As Any Ptr imgs(1 To 4)={Imagecreate(xres,yres),Imagecreate(xres,yres),Imagecreate(xres,yres),Imagecreate(xres,yres)}
Draw String(20,406),"[",Rgb(255,255,255)
Draw String(690,406),"]",Rgb(255,255,255)
backdrop()
Dim As Ulong Ptr p(1 To 4),p2
Dim As long size,size2
For n As Long=1 To 4
Imageinfo imgs(n),,,,,p(n),size
Next n
Imageinfo im2,,,,,p2,size2
Dim As Point pt(0 To 38),rot(0 To 38)
For n As Long=1 To 38: Read pt(n).x:pt(n).x+=410: Next
For n As Long=1 To 38: Read pt(n).y:pt(n).y+=350: Next
drawpolygon(pt(),Rgb(0,0,0))
Dim As Point ctr=pt(0)
Dim As Single pi=4*Atn(1)
Dim As Single a
Dim As Long k2=1.5
Dim As String i
Dim As String s="Going on holiday"
Dim As Any Ptr im(1 To Len(s))
Dim As Long sz=10,fps
For n As Long=1 To Len(s)
im(n)=Imagecreate(sz*3,sz*3)
Draw String im(n),(10,5),Chr(s[n-1]),Rgb(255,rnd*255,rnd*255)
Put(n*sz,400),im(n),trans
Next
Dim As Single angl,d=50
Dim As Single x1,y1,x2,y2
Dim As Single x3,y3,x4,y4,yy=100
Do
i=Inkey
For n As Long=1 To 4
sweep(p(n),k2*n,size) 'hills
Next n
sweep(p2,1,size2) 'sky
angl+=.1
a=.1*Sin(angl)
Screenlock
Cls
Put(0,0),im2,Pset
For n As Long=1 To 3
Put(0,0),imgs(n),trans
Next n
For n As Long=1 To 38
pt(n).y+=a*5
rot(n)= rotatepoint(ctr,pt(n),Type<Point>(0,0,a),Type<Point>(.8,.8,.8))
Next n
drawpolygon(rot(),Rgb(88,73,00))
Circle(rot(22).x,rot(22).y),3,0,,,,f
rotateimage(,sim,-a,rot(0).x-75,rot(0).y-12.5,1,,true)
For n As Long=1 To Ubound(im)
Var k=n+2,k1=k+1
If n=1 Then
x1=k*3*sz-d:y1=400+30*Sin(angl+n/2)-20
x2=k*3*sz-d:y2=400+30*Sin(angl+n/2)+40
End If
If n=Ubound(im) Then
x3=k1*3*sz-d:y3=400+30*Sin(angl+(n+1)/2)-20
x4=k1*3*sz-d:y4=400+30*Sin(angl+(n+1)/2)+40
End If
Pset(k*3*sz-d,400+30*Sin(angl+n/2)-20+yy),Rgb(200,0,1)
Line -((k+1)*3*sz-d,400+30*Sin(angl+(n+1)/2)-20+yy),Rgb(200,0,1)
Pset(k*3*sz-d,400+30*Sin(angl+n/2)+40+yy),Rgb(0,0,1)
Line -((k+1)*3*sz-d,400+30*Sin(angl+(n+1)/2)+40+yy),Rgb(200,0,1)
Next
Line(x1,y1+yy)-(x2,y2+yy),Rgb(200,0,1)
Line(x3,y3+yy)-(x4,y4+yy),Rgb(200,0,1)
Paint(100,400+30*Sin(angl+(1)/2)+10+yy),Rgb(0,100,200),Rgb(200,0,1)
For n As Long=1 To Ubound(im)
Var k=n+2
rotateimage(,im(n),(Sin((angl+n/2)))/4-0,k*3*sz-d-15,400+30*Sin(angl+n/2)+yy-20,2)
Next n
Line(x3,y3+yy)-(rot(22).x,rot(22).y),Rgb(0,0,0)
Line(x4,y4+yy)-(rot(22).x,rot(22).y),Rgb(0,0,0)
Put(0,0),imgs(4),trans
Line(0,750)-(xres,768),Rgb(200,200,200),bf
Draw String(400,755),"Framerate = "&fps,Rgb(200,0,0)
Screenunlock
Sleep regulate(40,fps),1
Loop Until i=Chr(27)
For n As Long=Lbound(im) To Ubound(im)
Imagedestroy im(n)
Next
Imagedestroy im2
Imagedestroy sim
For n As Long=1 To 4
Imagedestroy(imgs(n))
Next n
Sleep
Return 0
End Function
Data _
498, 489, 487, 481, 454, 420, 399, 390, 381, 369, 359, 331, 297, 272, 255, 247, 237, 228, 217, 205, 202, 205, 219, 228, 251, 288, 319, 347, 359, 401, 418, 440, 440, 457, 471, 480, 486, 488
Data _
165, 158, 116, 157, 153, 152, 151, 151, 144, 143, 146, 145, 148, 151, 151, 149, 134, 124, 120, 133, 152, 167, 174, 174, 178, 184, 189, 191, 193, 196, 195, 200, 193, 190, 182, 174, 218, 177
End go