slightly older
Code: Select all
'#include "inc/aaline.bas"
' ---- aaline.bas
'#include once "imagevars.bas"
' ------- imagevars 2018 Jan 9 - by dafhi --------
#Ifndef floor
#Define floor(x) (((x)*2.0-0.5)shr 1) '' http://www.freebasic.net/forum/viewtopic.php?p=118633
#define ceil(x) (-((-(x)*2.0-0.5)shr 1))
#EndIf
Union UnionARGB
As Ulong col: Type: As UByte B,G,R,A: End Type
End Union
Type sng2D
As Single x,y
End Type
type myint as integer
type imagevars '' 2018 Jan 9 - by dafhi
'1. quick reference for ScreenInfo & ImageInfo
'2. encapsulate standard metrics
'3. convenient additional vars, subs and functions
as myint w,h,bpp,bypp,pitch,rate, wm, hm, pitchBy, num_pages, flags 'helpers
as any ptr im, pixels
as ulong ptr p32
as string driver_name
declare sub get_info(im as any ptr=0)
as single wh, hh, diagonal
declare sub screen_init(w as myint=0, h as myint=0, bpp as myint=32, npages as myint=1, flags as myint=0)
declare sub create(w as myint=0, h as myint=0, col as ulong=&HFF000000)
Declare Sub SkewRect_ScaleRotate(ByVal scale_ As Single = 1.0, ByVal angle_ As Single = 0.0)
Declare Sub SkewRect_Render(ByRef dest As imagevars ptr, _
ByVal x As myint = 0, _
ByVal y As myint = 0, _
ByVal wid As myint = -1, _
ByVal hgt As myint = -1)
declare destructor
private:
As sng2D ptA,ptB,ptC,ptD
declare sub destroy
end type
Destructor.imagevars: destroy
End Destructor
Sub imagevars.Destroy(): If ImageInfo(im) = 0 <> 0 Then ImageDestroy im: im = 0: endif: End Sub
sub imagevars.get_info(im as any ptr)
if im=0 then: pixels=screenptr
ScreenInfo w,h, bpp,, pitch, rate, driver_name: bypp=bpp\8 '2018 Jan 9
elseif Imageinfo(im)=0 then
ImageInfo im, w, h, bypp, pitch, pixels
bpp = bypp * 8: this.im = im
endif: pitchBy=pitch\bypp
wm=w-1: wh=w/2: diagonal = sqr(w*w+h*h)
hm=h-1: hh=h/2: p32=pixels
end sub
sub imagevars.create(w as myint, h as myint, col as ulong)
destroy: get_info imagecreate(w,h,col)
End Sub
Sub imagevars.screen_init(w As myint, h As myint, _bpp as myint, _pages as myint, _flags as myint)
Destroy: ScreenRes w,h,_bpp,_pages,_flags: get_info
num_pages=_pages: flags=_flags: if num_pages > 1 then screenset 0,1
End sub
Sub imagevars.SkewRect_ScaleRotate(ByVal scale_ As Single, ByVal angle_ As Single)
If scale_ = 0 Then Exit Sub
scale_ = 1 / scale_
Dim As Single xLeft = wh * -scale_
Dim As Single xRight = wh * scale_
Dim As Single yTop = hh * -scale_
Dim As Single yBot = hh * scale_
Dim As Single cos_ = Cos( -angle_ )
Dim As single sin_ = Sin( -angle_ )
Dim As Single tmpA,tmpB
#Macro Rot8_Trans(init_a,init_b,dsta, dstb)
dsta = init_a
dstb = init_b
tmpA = cos_ * dsta + sin_ * dstb
tmpB = cos_ * dstb - sin_ * dsta
dsta = tmpA + wh + .5
dstb = tmpB + hh + .5
#EndMacro
Rot8_Trans( xLeft, yTop, ptA.x, ptA.y )
Rot8_Trans( xRight, yTop, ptB.x, ptB.y )
Rot8_Trans( xLeft, yBot, ptC.x, ptC.y )
Rot8_Trans( xRight, yBot, ptD.x, ptD.y )
End Sub
Sub imagevars.SkewRect_Render(ByRef pDest As imagevars ptr, _
ByVal x As myint, ByVal y As myint, _
ByVal wid_ As myint, ByVal hgt_ As myint)
#Macro InterpolatePoint(dest_,from_,to_)
dest_.x = from_.x + lerp * (to_.x - from_.x)
dest_.y = from_.y + lerp * (to_.y - from_.y)
#EndMacro
#Macro LayerSource_Components(aa_mul1, aa_mul2)
aa_fractional = aa_mul1 * aa_mul2
sRed += aa_fractional * ptrSource->R
sGrn += aa_fractional * ptrSource->G
sBlu += aa_fractional * ptrSource->B
#EndMacro
#Macro BoundsCheckSource(aa_mul1, aa_mul2)
If srcY >= 0 Then
If srcX >= 0 Then
If srcY < h Then
If srcX < w Then
LayerSource_Components( aa_mul1, aa_mul2 )
EndIf
EndIf
EndIf
EndIf
#EndMacro
Dim As myint clipLeft,clipTop,xLeft=floor(x+.5),yTop=floor(y+.5)
If x < 0 Then clipLeft = -x: xLeft = 0
If y < 0 Then clipTop = -y: yTop = 0
Dim As myint widM_ = wid_ - 1
Dim As myint hgtM_ = hgt_ - 1
Dim As myint xRight = xleft + widM_
Dim As myint yBot = ytop + hgtM_
If xRight > pDest->wM Then xRight = pDest->wM
If yBot > pDest->hM Then yBot = pDest->hM
Dim As Single aa_fractional, xGridStep = 1 / wid_
For yDest As myint = yTop To yBot
Dim As myint yGrid = yDest + ClipTop
Dim As single lerp = (yGrid - yTop) / hgt_
Dim As sng2D ptAC, ptBD
InterpolatePoint( ptAC, ptA, ptC )
InterpolatePoint( ptBD, ptB, ptD )
Dim As UnionARGB Ptr pixDest = pDest->pixels + yDest * pDest->pitch
For xDest As myint = xLeft To xRight
Dim As myint xGrid = xDest + ClipLeft
Dim As sng2D srcFloatPos
lerp = (xGrid - xLeft) * xGridStep
InterpolatePoint( srcFloatPos, ptAC, ptBD )
Dim As myint srcX = floor(srcFloatPos.x)
Dim As myint srcY = floor(srcFloatPos.y)
Dim As Single aa_Left = srcX + 1 - srcFloatPos.x
Dim As Single aa_Top = srcY + 1 - srcFloatPos.y
Dim As Single aa_Right = 1 - aa_Left
Dim As Single aa_Bot = 1 - aa_Top
Dim As Single sRed
Dim As Single sGrn
Dim As Single sBlu
Dim As UnionARGB ptr ptrSource = pixels
ptrSource += srcY * pitchBy + srcX
BoundsCheckSource( aa_Left, aa_Top ) ''A
srcX += 1
ptrSource += 1
BoundsCheckSource( aa_Right, aa_Top ) ''B
srcY += 1
ptrSource += pitchBy
BoundsCheckSource( aa_Right, aa_Bot ) ''D
srcX -= 1
ptrSource -= 1
BoundsCheckSource( aa_Left, aa_Bot ) ''C
pixDest[xDest].B = sBlu
pixDest[xDest].G = sGrn
pixDest[xDest].R = sRed
Next
Next
End Sub
#ifndef pi
const TwoPi = 8*atn(1)
const Pi = 4*atn(1)
const piBy2 = 2*atn(1)
const iPi = 1/Pi
const piBy4 = atn(1)
#EndIf
'
' -------- imagevars
/' -- Anti-aliased lines - 2018 Jan 10 - by dafhi
' - usage -----------------------
dim as imagevars buf
buf.screen_init 800,600
aaline.render_target @buf
screenlock
line buf.im, (0,0)-(buf.wm, buf.hm), rgb(180,175,160), bf
aaline.wid = 50
aaline.draw 100,100,400,300, rgb(255,255,255)
screenunlock: sleep
' --------------------------------
I will update this project as time permits.
http://www.freebasic.net/forum/viewtopic.php?f=8&t=20719
'/
namespace AaLine
dim As single x0,y0,x1,y1,wid=1,endcap
dim As ulong col = -1
dim As imagevars ptr im
'' private
Type ScanIntercepts
as double ab,cd,bc,da
End Type
dim As single sx0,sy0,sx1,sy1,ax,bx,cx,dx,ay,by,cy,dy
dim As single ayi,byi,cyi,dyi
dim As single dxL,bxR,axL,axR,cxL,cxR
dim As ulong ptr cBL,cBR,cTL,cTR 'window pixels: bottom-left, ..
dim As integer w,wm,hm,pitchx,pitchy,wmprev,hmprev
dim As single abslope_small, abslope_large
dim As single slen,swid, sdx,sdy, angle, scosa,ssina, cenx,ceny
dim As Single lenBy2, smallBy2,largeBy2
dim As single da0,da1,ab0,ab1,bc0,bc1,cd0,cd1
dim As single cenabx, cenaby, cencdx, cencdy
dim As integer yflipped, xyflipped
dim As ScanIntercepts sc0x, sc1x, sc0y, sc1y
dim As single a(Any), _alpha
Sub render_target(byref p as imagevars ptr): im = p '2017 Sep 10
end sub
sub init
wm=im->wm: hm=im->hm
if wm<>wmprev or hm<>hmprev then
dim as integer ubmax = wm: if hm > ubmax then ubmax = hm
if ubmax > ubound(a) then ReDim a(ubmax)
wmprev=wm: hmprev=hm
end If
pitchx=1: pitchy=im->pitchBy
cBL=im->pixels: cTL=cBL+hm*pitchy
cBR=CBL+wm: cTR=cTL+wm: yflipped=0: xyflipped=0: _alpha=256*(col shr 24)/255
End sub
Sub yflip
pitchy=-pitchy: yflipped=-1
swap cBL,cTL: swap cBR,cTR
ceny=hm+1-ceny: ssina=-ssina
end sub
sub xyflip
swap cTL,cBR: xyflipped = -1
swap wm,hm: swap pitchx,pitchy
swap cenx,ceny: swap scosa,ssina
end sub
sub re_center
lenBy2=slen/2
scosa=cos(angle)*lenBy2: ssina=sin(angle)*lenBy2
var dx0=im->wh-x0, dy0=im->hh-y0 ''
var dx1=im->wh-x1, dy1=im->hh-y1 ''
const c = .5
if dx0*dx0+dy0*dy0 < dx1*dx1+dy1*dy1 then 'point 0 closest to center
cenx=x0+scosa+c ''
ceny=y0+ssina+c ''
else
cenx=x1-scosa+c ''
ceny=y1-ssina+c ''
endif
end sub
sub handle_infinity
sdx=x1-x0: sdy=y1-y0 ''
slen=sqr(sdx*sdx+sdy*sdy)
if slen>1e9 then: slen=1e9
const sincos=1e9*sqr(1/2)
sdx=sincos*sgn(sdx)
sdy=sincos*sgn(sdy)
endif
if sdx=0 then
if sdy<0 then: angle= -pi/2
else: angle=pi/2: endif
else: angle=atn(sdy/sdx): if sdx<0 then angle+=pi
endif
re_center
swid=wid
if swid>1e9 then swid=1e9
slen+=endcap*swid
if slen < wid then
angle+=pi/2: swap swid,slen
end if: lenBy2=slen/2
'' fix to make compiler happy
if angle=0 or abs(angle-pi)<0.00001 then angle += 0.0001
scosa=cos(angle)*lenBy2: ssina=sin(angle)*lenBy2
End sub
Sub octant
if scosa<0 then scosa=-scosa: ssina=-ssina
if ssina<0 then yflip
if ssina>scosa then xyflip
w=wm+1
ax=cenx-scosa: bx=cenx+scosa '2017 June 4
ay=ceny-ssina: by=ceny+ssina '2017 June 4
End sub
sub corners
abslope_small=ssina/scosa: smallBy2=abslope_small/2
abslope_large=scosa/ssina: largeBy2=abslope_large/2
dim as single widByLen = swid/slen
dim as single hdxwid = ssina*widByLen, hdywid = scosa*widByLen
cx=bx-hdxwid: dx=ax-hdxwid: ax=ax+hdxwid: bx=bx+hdxwid '2017 June 4
cy=by+hdywid: dy=ay+hdywid: ay=ay-hdywid: by=by-hdywid '2017 June 4
ayi=floor(ay): byi=floor(by): cyi=floor(cy): dyi=floor(dy)
dxL=floor(dx): axL=floor(ax): axR=floor(ax)
bxR=floor(bx): cxL=floor(cx): cxR=floor(cx)
If dxL<0 Then: dxL=0: EndIf: If bxR>wm then: bxR=wm: endif
If axL<0 Then: axL=0: EndIf: If axR>wm Then: axR=wm: EndIf
If cxL<0 Then: cxL=0: EndIf: If cxR>wm Then: cxR=wm: EndIf
End Sub
Function xbound(x As Single) As Integer
return x>=0 And x<w
End Function
Function ybound(yLo As single,yHi As single,y As single) As Integer
return y>=yLo And y<= yHi
End Function
Function areasubt(ceptL As Single,ceptR As Single,edgeL As Single) As Single
Dim As Single len_tri
If ceptL<edgeL Then ' ceptL
len_tri=ceptR-edgeL ' -+-----+
Return len_tri*len_tri*largeBy2 ' \####|
Else: Dim As Integer edgep=edgeL+1 ' \###|
If ceptR<edgep Then ' \##|
Return ceptR-edgeL-smallBy2 ' -----+-+
Else ' ceptR
len_tri=edgep-ceptL
Return 1-len_tri*len_tri*largeby2: EndIf
EndIf
End Function
Sub subt_ab(x0 As single, x1 As single,y As integer)
sc1y.ab=cenaby+(x0-cenabx)*abslope_small
For x As Single=x0 To x1
sc0y.ab=sc1y.ab
sc1y.ab+=abslope_small
a(x)-=areasubt(sc0y.ab,sc1y.ab,y)
Next
end Sub
Sub subt_cd(x0 As single, x1 As single,y As Integer)
sc1y.cd=cencdy+(x0-cencdx)*abslope_small
For x As Single=x0 To x1
sc0y.cd=sc1y.cd
sc1y.cd+=abslope_small
a(x)-=1-areasubt(sc0y.cd,sc1y.cd,y)
Next
end sub
sub subt_da(x0 As single, x1 As single)
For x As Integer=x0 To x1
a(x)-=areasubt(sc1x.da,sc0x.da,x)
Next
end sub
Sub subt_bc(x0 As single, x1 As single)
For x As single=x0 To x1
a(x)-=1-areasubt(sc1x.bc,sc0x.bc,x)
Next
End Sub
Function area_oversubtracted(vx As Single,vy As Single,ix As integer,iy As Integer) As single
vx=Abs(vx-ix)
vy=Abs(vy-iy)
var ceptYleft=vy-vx*abslope_small
Dim As Single areaL
' area "low and left" of vertex
If ceptYleft<0 Then 'triangle
areaL=vy*vy*largeBy2
Else 'trapezoid
areaL=vx*(ceptYleft+vy)/2
End If
' area "low and right" of vertex
Var ceptXBottom=vx+vy*abslope_small
Var ixp=ix+1
If ceptXBottom<=1 Then 'triangle
Return areaL + vy*vy*smallBy2
Else 'trapezoid
Var vx1=1-vx
Return areaL+vx1*(vy-vx1*largeBy2)
EndIf
End Function
Sub scanwrite(xL0 As integer, xR1 as integer, y As integer)
dim as ulong ptr p=@cBL[xL0*pitchx+y*pitchY]
for x as integer=xL0 to xR1
dim as ulong a256 = _alpha * a(x)
*p=((_
(col And &Hff00ff) * a256 + _
(*p And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
(col And &H00ff00) * a256 + _
(*p And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
p+=pitchx
next
End Sub
Function int_lo(in As Single,clip As Single) As Single
If in<clip Then: Return floor(clip): Else: Return floor(in): EndIf
End Function
Function int_hi(in As Single,clip As Single) As Single
If in>clip Then: Return floor(clip): Else: Return floor(in): EndIf
End Function
sub scanlines_abcd(y0 as integer, y1 as single)
if y0<0 then y0=0
if y1>hm then y1=hm
sc0x.cd=sc1x.cd: sc1x.cd=cencdx+(y0-cencdy)*abslope_large
sc0x.bc=sc1x.bc: sc1x.bc=bx-(y0-by)*abslope_small
for y As Integer=y0 to y1
sc0x=sc1x
sc1x.ab+=abslope_large
sc1x.cd+=abslope_large
sc1x.da-=abslope_small
sc1x.bc-=abslope_small
Dim As Integer inda=ybound(ayi,dyi,y)
Dim As Integer inab=ybound(ayi,byi,y)
Dim As Integer incd=ybound(dyi,cyi,y)
Dim As Integer inbc=ybound(byi,cyi,y)
Dim As single xL1=-1,xL0=wm+1
If inda Then
da0=int_lo(sc1x.da,dxL): If da0<xL0 Then xL0=da0
da1=int_hi(sc0x.da,axR): If da1>xL1 Then xL1=da1
EndIf
If incd Then
cd0=int_lo(sc0x.cd,dxL): If cd0<xL0 Then xL0=cd0
cd1=int_hi(sc1x.cd,cxR): If cd1>xL1 Then xL1=cd1
EndIf
Dim As single xR1=-1,xR0=wm+1
If inab Then
ab0=int_lo(sc0x.ab,axL): If ab0<xR0 Then xR0=ab0
ab1=int_hi(sc1x.ab,bxR): If ab1>xR1 Then xR1=ab1
EndIf
If inbc Then
bc0=int_lo(sc1x.bc,cxL): If bc0<xR0 Then xR0=bc0
bc1=int_hi(sc0x.bc,bxR): If bc1>xR1 Then xR1=bc1
EndIf
For x as integer=xL0 to xR1
a(x)=1
Next
If inda Then subt_da da0,da1
If inab Then subt_ab ab0,ab1,y
If inbc Then subt_bc bc0,bc1
If incd Then subt_cd cd0,cd1,y
If y=ayi And xbound(ax) Then
a(axL)+=area_oversubtracted(ax,ay,axL,ayi)
EndIf
If y=byi And xbound(bx) Then
a(bxR)+=area_oversubtracted(by,bx,byi,bxR+1)
EndIf
If y=cyi And xbound(cx) Then
a(cxR)+=area_oversubtracted(cx,cy,cxR+1,cyi+1)
EndIf
If y=dyi And xbound(dx) Then
a(dxL)+=area_oversubtracted(dy,dx,dyi+1,dxL)
EndIf
scanwrite xL0,xR1,y
next
end sub
sub scanlines_adb(y0 as integer, y1 as single)
if y0<0 then y0=0
if y1>hm then y1=hm
if ax < w-cx then 'bc closest
cenabx=bx: cenaby=by
cencdx=cx: cencdy=cy
else
cenabx=ax: cenaby=ay
cencdx=dx: cencdy=dy
end if
sc1x.da=ax-(y0-ay)*abslope_small
sc1x.ab=cenabx+(y0-cenaby)*abslope_large
for y As Integer=y0 to y1
sc0x.da=sc1x.da: sc1x.da-=abslope_small
sc0x.ab=sc1x.ab: sc1x.ab+=abslope_large
Dim As single xL1=-1,xL0=wm+1
da0=int_lo(sc1x.da,dxL): If da0<xL0 Then xL0=da0
da1=int_hi(sc0x.da,axR): If da1>xL1 Then xL1=da1
Dim As single xR1=-1,xR0=wm+1
ab0=int_lo(sc0x.ab,axL): If ab0<xR0 Then xR0=ab0
ab1=int_hi(sc1x.ab,bxR): If ab1>xR1 Then xR1=ab1
For x as integer=xL0 to xR1
a(x)=1
Next
subt_da da0,da1
subt_ab ab0,ab1,y
If y=ayi And xbound(ax) Then
a(axL)+=area_oversubtracted(ax,ay,axL,ayi)
EndIf
scanwrite xL0,xR1,y
next
end sub
sub scanlines_cdb(y0 as integer, y1 as integer)
if y0<0 then y0=0
if y1>hm then y1=hm
for y As Integer=y0 to y1
sc0x.cd=sc1x.cd: sc1x.cd+=abslope_large
sc0x.bc=sc1x.bc: sc1x.bc-=abslope_small
Dim As single xL1=-1,xL0=wm+1
cd0=int_lo(sc0x.cd,dxL): If cd0<xL0 Then xL0=cd0
cd1=int_hi(sc1x.cd,cxR): If cd1>xL1 Then xL1=cd1
Dim As single xR1=-1,xR0=wm+1
bc0=int_lo(sc1x.bc,cxL): If bc0<xR0 Then xR0=bc0
bc1=int_hi(sc0x.bc,bxR): If bc1>xR1 Then xR1=bc1
For x as integer=xL0 to xR1
a(x)=1
Next
subt_bc bc0,bc1
subt_cd cd0,cd1,y
If y=cyi And xbound(cx) Then
a(cxR)+=area_oversubtracted(cx,cy,cxR+1,cyi+1)
EndIf
scanwrite xL0,xR1,y
next
end sub
sub scanlines_db(y0 as integer, y1 as single)
if y0<0 then y0=0
if y1>hm then y1=hm
for y As Integer=y0 to y1
sc0x.ab=sc1x.ab: sc1x.ab+=abslope_large
sc0x.cd=sc1x.cd: sc1x.cd+=abslope_large
Dim As single xL1=-1,xL0=wm+1
cd0=int_lo(sc0x.cd,dxL): If cd0<xL0 Then xL0=cd0
cd1=int_hi(sc1x.cd,cxR): If cd1>xL1 Then xL1=cd1
Dim As single xR1=-1,xR0=wm+1
ab0=int_lo(sc0x.ab,axL): If ab0<xR0 Then xR0=ab0
ab1=int_hi(sc1x.ab,bxR): If ab1>xR1 Then xR1=ab1
For x as integer=xL0 to xR1
a(x)=1
Next
subt_ab ab0,ab1,y
subt_cd cd0,cd1,y
scanwrite xL0,xR1,y
next
end sub
Sub calc
handle_infinity
if slen <= 0 then exit sub
if im=0 or im->bpp <> 32 then
static as integer show_msg=1
if show_msg then
if im->im=0 then: ? "AaLine: invalid render target"
else: ? "AaLine: target must be 32bpp"
end if: sleep 1000: show_msg=0
endif
end if
init
octant
corners
if dyi<=byi then
scanlines_adb ayi,dyi-1
if dyi<byi-1 then
scanlines_abcd dyi, dyi
scanlines_db dyi+1, byi-1
scanlines_abcd byi, byi
else
scanlines_abcd dyi, byi
end if
scanlines_cdb byi+1,cyi
else
scanlines_adb ayi,byi-1
scanlines_abcd byi, dyi
scanlines_cdb dyi+1,cyi
end if
End sub
sub draw(_x0 as single,_y0 as single,_x1 as single,_y1 as single,_col as ulong)
x0=_x0: x1=_x1: y0=_y0: y1=_y1: col=_col: calc
end sub
sub draw_by_vec(x as single, y as single, slen as single, angle as single,_col as ulong)
slen /= 2: dim as single sina = slen*sin(angle), cosa = sLen*cos(angle)
x0=x-cosa: x1=x+cosa: y0=y-sina: y1=y+sina: col=_col: calc
end sub
sub drawme
calc
End Sub
end namespace ' ---- aaline
namespace dodi_gfx
sub render_target(byref p as imagevars ptr)
aaline.render_target p
aaline.endcap = .5
End Sub
Sub tree(x1 As Single,y1 As Single,size As Single,angle As Single,depth As Single,colb As ulong=0,colL As ulong=0,im as any ptr=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 Integer count,fx,fy,sz,z
If count=0 Then fx=x1:fy=y1:sz=size:z=2^(depth+1)-1
aaline.wid = size * .03
aaline.draw 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 im,(x2,y2),.01*sz,colL
If depth>0 Then
Tree(x2, y2, size * Scale, angle - Spread, depth - 1,colB,colL,im)
Tree(x2, y2, size * Scale, angle + Spread, depth - 1,colB,colL,im)
End If
End Sub
end namespace
screenres 800,600,32
dim as imagevars buf: buf.get_info
'dim as imagevars tex: tex.get_info imagecreate( 400, 300, rgb(0,0,0) )
dodi_gfx.render_target @buf
for i as long = 1 to 60
with buf
#define r255 int(rnd*256)
#define rcol rgb(r255,r255,r255)
dodi_gfx.tree rnd*.w, .h-rnd*.hh*1.1, (rnd+.1)*.diagonal/4, 15*(rnd-.5)+90, 1+rnd*11, rcol, rcol, .im
screenlock: screenunlock
end with
'put (0,0), tex.im, pset
next
sleep