my first try using TBGL and OXYGEN

[D.J.Peters]

[up,down,left,right] = move around
[+,-] on number pad = zoom in / out
[space] = togle color animation on/off

Joshy

#MINVERSION 1.7.7.0

Uses "TBGL"
Uses "OXYGEN"


dim as string src$ = "

;by d.j.peters (Joshy)

var long arg_pixel at [ebp+ 8]
var long arg_color at [ebp+12]
var long arg_tsize at [ebp+16] ' texture size power of (32,64,256,512 ...)
var long arg_max at [ebp+20] ' max iteras
var double arg_imin at [ebp+24]
var double arg_rmin at [ebp+32]
var double arg_step at [ebp+40]
def arg_ret 40

var long var_x2y2 at [ebp-4]
var double var_i at [ebp-12]
var double var_r at [ebp-20]


push ebp ; prolog
mov ebp,esp
push edi
push esi
sub esp,100

mov ebx,4
mov edx, arg_max

mov edi, arg_pixel ; texture
mov esi, arg_color ; colors
fld qword arg_imin ; i=imin
fstp qword var_i
mov ecx, arg_tsize ; For y = 1 To h
for_y:
push ecx
fld qword arg_rmin ; r=rmin
fstp qword var_r
mov ecx, arg_tsize ; For x = 1 To w
for_x:
push ecx
XOR ecx,ecx
fld qword var_r ; r
fld qword var_i ; i,r
fldz ; x2,i,r
fldz ; y2,x2,i,r
fldz ; x,y2,x2,i,r
fldz ; y,x,y2,x2,i,r
iterastep:
inc ecx ; itera+=1
cmp ecx,edx ; itera>=max_itera
je exit_itera

fld st(0) ; y,y,x,y2,x2,i,r
fadd st(0),st(1) ; 2*y
fmul st(0),st(2) ; 2*y*x
fadd st(0),st(5) ; 2*y*x+i
fxch st(1) ; y,2*y*x*i,x,y2,x2,i,r
fstp st(0) ; y,x,y2,x2,i,r
fld st(3) ; x2 ,y,x,y2,x2,i,r
fsub st(0),st(3) ; x2y2 ,y,x,y2,x2,i,r
fadd st(0),st(6) ; x2y2r,y,x,y2,x2,i,r
fxch st(2) ; x,y,x2y2r,x2,i,r
fstp st(0) ; y,x,y2,x2,i,r
fld st(1) ; x,y,x,y2,x2,i,r
fmul st(0) ; xx,y,x,y2,x2,i,r
fxch st(4) ; x2,y,x,y2,xx,i,r
fstp st(0) ; y,x,y2,x2,i,r
fld st(0) ; y ,y,x,y2,x2,i,r
fmul st(0) ; y*y,y,x,y2,x2,i,r
fxch st(3)
fstp st(0) ; y,x,y2,x2,i,r

fld st(2) ; y2,y,x,y2,x2,i,r
fadd st(0),st(4) ; y2+x2,y,x,y2,x2,i,r
fistp dword var_x2y2 ; y,x,y2,x2,i,r
mov eax, var_x2y2
cmp eax,ebx ; (x*x+y*y)>4
jg exit_itera
jmp Long iterastep

exit_itera:
mov eax,[esi+ecx*4] ; Colors(itera)
mov [edi],eax ; red,green,blue
Add edi,4 ; next pixel
fstp st(0) ; x,y2,x2,i,r
fstp st(0) ; y2,x2,i,r
fstp st(0) ; x2,i,r
fstp st(0) ; i,r
fstp st(0) ; r
fadd qword arg_step ; r+step
fstp qword var_r ; fpu stack is empty
pop ecx ; Next x
dec ecx
jz exit_for_x
jmp Long for_x

exit_for_x:
fld qword arg_step ; step
fadd qword var_i ; i+=step
fstp qword var_i ; fpu stack is empty
pop ecx ; Next y
dec ecx
jz exit_for_y
jmp Long for_y
exit_for_y:
add esp,100
pop esi
pop edi
pop ebp
ret arg_ret
"


O2_BUF 1
O2_ASMO src$
If Len(O2_ERROR) Then
MsgBox 0,O2_ERROR
Stop
End If
Declare Sub FillTexture (ByVal ptex As Long, _
ByVal pcol As Long, _
ByVal tsize As Long, _
ByVal imax As Long, _
ByVal imin As Double, _
ByVal rmin As Double, _
ByVal irstep As Double) At O2_BUF 1



%window_w = 512
%window_h = 512
%txtsize = 256
%npixels = %txtsize*%txtsize
%maxitera = 168 '<=255

Dim strBuffer As String
Dim ColorBuffer(%npixels) As Long
Dim Colors(256) As Long
Dim imin,rmin,irstep As Double
Dim rdiff,idiff,roffset,ioffset,zoom As Double
Dim Anim,c,counter,tmp,WinID As Long
Dim tStart,tNow,Frames As Long

idiff=3.2:rdiff=3.2:zoom=1.0
Anim=1

For c=1 To 255
Colors(1+c)=Rgb((c*1) And &HFF, _
(c*3) And &HFF, _
(c*7) And &HFF)
Next
Colors(1)=0:Colors(%maxitera+1)=0

WinID = TBGL_CreateWindowEx("first test", _
%window_w, %window_h, 32, _
%TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_UseTexturing %TRUE

tStart=GetTickCount

While TBGL_IsWindow(WinID)
Frames+=1
irstep=(rdiff*zoom) / %txtsize
rmin=roffset-(rdiff*zoom*0.5)
imin=ioffset-(idiff*zoom*0.5)

FillTexture (VarPtr(ColorBuffer(1)), _
VarPtr(Colors(1)), _
%txtsize,%maxitera, _
imin, rmin, irstep)

strBuffer = Peek$(VarPtr(ColorBuffer(1)), %npixels * 4)
TBGL_MakeTexture strBuffer, %TBGL_DATA_RGBA, _
%txtsize,%txtsize, _
1, %TBGL_TEX_ANISO, 16
TBGL_BindTexture 1
TBGL_ResetKeyState()


TBGL_ClearFrame
TBGL_Camera 0,0,2.4, 0,0,0

TBGL_BeginPoly %GL_QUADS
TBGL_TexCoord2D 0, 0: TBGL_Vertex -1,-1, 0
TBGL_TexCoord2D 1, 0: TBGL_Vertex 1,-1, 0
TBGL_TexCoord2D 1, 1: TBGL_Vertex 1, 1, 0
TBGL_TexCoord2D 0, 1: TBGL_Vertex -1, 1, 0
TBGL_EndPoly
TBGL_DrawFrame
counter+=1

If TBGL_GetWindowKeyState(WinID, %VK_ESCAPE) Then
Exit While
End If

If TBGL_GetWindowKeyState(WinID, %VK_ADD ) Then
Zoom-=irStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_SUBTRACT ) Then
Zoom+=irStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_UP ) Then
iOffset+=irStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_DOWN ) Then
iOffset-=irStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_LEFT ) Then
rOffset-=irStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_RIGHT) Then
rOffset+=irStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_SPACE) Then
Anim=Anim XOR 1
End If
tNow=GetTickCount

If anim And (tNow-tStart)>=100 Then
tmp=Colors(2)
For c=2 To %maxitera
Colors(c)=Colors(c+1)
Next
Colors(%maxitera)=tmp
tStart=tNow
End If
Wend

TBGL_DestroyWindow

[ErosOlmi]

What a "first try" :eusaclap: absolutely great.

Color changing in real time.

[Petr Schreiber]

Hi Joshy,

very cool code! Very smooth

Just two things to inform you

#1 display lists, textures, models and GBuffers are garbage collected in TBGL, so you don't have to explicitly delete the texture in the end.

#2 it is possible to write strings across multiple lines, when following rules. That is, having the external " on own line. That means you can do:


Dim s As String

s = "
Now this is text across
multiple
lines
great
way
to
write
oxygen
code
"

MsgBox 0, s

... so you don't have to use that big string concatenation with +$CR+ yourself.

Looking forward to next examples!


Petr

[D.J.Peters]

... so you don't have to use that big string concatenation with +$CR+ yourself.
i'm sure you can't do it
please try it out with the source code i'm posted

i can tell you why it dosn't work :mrgreen:

Joshy

[kryton9]

Oh my goodness, that is so impressive. I am speechless. Amazing!

[D.J.Peters]

Oh my goodness, that is so impressive. I am speechless. Amazing!
thank you
but if you are speechless after my first try
i hope you won't never be blind if i post a more advanced code :lol:

Joshy

[Petr Schreiber]

I see,

you cannot use this when you dynamically build the string using other string variables, that caused the problem.
If it would be just pure source code, it would work.

So here little mod for you, I think it is quite comfortable to do this way:


#MINVERSION 1.7.7.0

Uses "TBGL"
Uses "OXYGEN"

Dim arg_pixel$
Dim arg_color$
Dim arg_tsize$ ' texture size power of (32,64,256,512 ...)
Dim arg_max$ ' max iteras
Dim arg_imin$
Dim arg_rmin$
Dim arg_istep$
Dim arg_rstep$
Dim arg_ret$
Dim src$
Dim var_x2y2$
Dim var_i$
Dim var_r$

arg_pixel$ = "[ebp+ 8]" ' Long
arg_color$ = "[ebp+12]" ' Long
arg_tsize$ = "[ebp+16]" ' Long
arg_max$ = "[ebp+20]" ' Long
arg_imin$ = "[ebp+24]" ' Double
arg_rmin$ = "[ebp+32]" ' Double
arg_istep$ = "[ebp+40]" ' Double
arg_rstep$ = "[ebp+48]" ' Double
arg_ret$ = "52"

var_x2y2$ = "[ebp-4]"
var_i$ = "[ebp-12]"
var_r$ = "[ebp-20]"

src$ = "
;by d.j.peters (Joshy)
push ebp ; prolog
mov ebp,esp
push eax
push ebx
push ecx
push edx
push edi
push esi
sub esp,100

mov ebx,4
mov edx, $arg_max$

mov edi, $arg_pixel$ ; texture
mov esi, $arg_color$ ; colors
fld qword $arg_imin$ ; i=imin
fstp qword $var_i$
mov ecx, $arg_tsize$ ; For y = 1 To h

for_y:
push ecx
fld qword $arg_rmin$ ; r=rmin
fstp qword $var_r$
mov ecx, $arg_tsize$ ; For x = 1 To w

for_x:
push ecx
XOR ecx,ecx
fld qword $var_r$ ; r
fld qword $var_i$ ; i,r
fldz ; x2,i,r
fldz ; y2,x2,i,r
fldz ; x,y2,x2,i,r
fldz ; y,x,y2,x2,i,r

iterastep:
fld st(0) ; y,y,x,y2,x2,i,r
inc ecx ; itera+=1
fadd st(0),st(1) ; 2*y
fmul st(0),st(2) ; 2*y*x
fadd st(0),st(5) ; 2*y*x+i
fxch st(1) ; y,2*y*x*i,x,y2,x2,i,r
fstp st(0) ; y,x,y2,x2,i,r
fld st(3) ; x2 ,y,x,y2,x2,i,r
fsub st(0),st(3) ; x2y2 ,y,x,y2,x2,i,r
fadd st(0),st(6) ; x2y2r,y,x,y2,x2,i,r
fxch st(2) ; x,y,x2y2r,x2,i,r
fstp st(0) ; y,x,y2,x2,i,r
fld st(1) ; x,y,x,y2,x2,i,r
fmul st(0) ; xx,y,x,y2,x2,i,r
fxch st(4) ; x2,y,x,y2,xx,i,r
fstp st(0) ; y,x,y2,x2,i,r
fld st(0) ; y ,y,x,y2,x2,i,r
fmul st(0) ; y*y,y,x,y2,x2,i,r
fxch st(3)
fstp st(0) ; y,x,y2,x2,i,r
cmp ecx,edx ; itera>=max_itera
jge exit_itera
fld st(2) ; y2,y,x,y2,x2,i,r
fadd st(0),st(4) ; y2+x2,y,x,y2,x2,i,r
fistp dword $var_x2y2$ ; y,x,y2,x2,i,r
mov eax, $var_x2y2$
cmp eax,ebx ; (x*x+y*y)>4
jg exit_itera
jmp Long iterastep

exit_itera:
mov eax,[esi+ecx*4] ; Colors(itera)
mov [edi],eax ; red,green,blue
Add edi,4 ; next pixel
fstp st(0) ; x,y2,x2,i,r
fstp st(0) ; y2,x2,i,r
fstp st(0) ; x2,i,r
fstp st(0) ; i,r
fstp st(0) ; r
fadd qword $arg_rstep$ ; r+rstep
fstp qword $var_r$ ; fpu stack is empty
pop ecx ; Next x
dec ecx
jz exit_for_x
jmp Long for_x

exit_for_x:
fld qword $arg_istep$ ; istep
fadd qword $var_i$ ; istep+i,istep
fstp qword $var_i$ ; istep
pop ecx ; Next y
dec ecx
jz exit_for_y
jmp Long for_y

exit_for_y:
add esp,100
pop esi
pop edi
pop edx
pop ecx
pop ebx
pop eax
pop ebp
ret $arg_ret$
"

' -- Perform substitution
src$ = Replace$(src$, "$arg_pixel$", arg_pixel$)
src$ = Replace$(src$, "$arg_color$", arg_color$)
src$ = Replace$(src$, "$arg_tsize$", arg_tsize$)
src$ = Replace$(src$, "$arg_max$" , arg_max$)
src$ = Replace$(src$, "$arg_imin$" , arg_imin$)
src$ = Replace$(src$, "$arg_rmin$" , arg_rmin$)
src$ = Replace$(src$, "$arg_istep$", arg_istep$)
src$ = Replace$(src$, "$arg_rstep$", arg_rstep$)
src$ = Replace$(src$, "$arg_ret$" , arg_ret$)
src$ = Replace$(src$, "$var_x2y2$" , var_x2y2$)
src$ = Replace$(src$, "$var_i$" , var_i$)
src$ = Replace$(src$, "$var_r$" , var_r$)

O2_BUF 1
O2_ASMO src$
If Len(O2_ERROR) Then
MsgBox 0,O2_ERROR
Stop
End If
Declare Sub FillTexture (ByVal ptex As Long, _
ByVal pcol As Long, _
ByVal tsize As Long, _
ByVal imax As Long, _
ByVal imin As Double, _
ByVal rmin As Double, _
ByVal istep As Double, _
ByVal rstep As Double) At O2_BUF 1



%window_w = 512
%window_h = 512
%txtsize = 256
%npixels = %txtsize*%txtsize
%maxitera = 168 '<=255

Dim strBuffer As String
Dim ColorBuffer(%npixels) As Long
Dim Colors(256) As Long
Dim imin,rmin,istep,rstep As Double
Dim rdiff,idiff,roffset,ioffset,zoom As Double
Dim Anim,c,counter,tmp,WinID As Long
Dim tStart,tNow,Frames As Long

idiff=3.2:rdiff=3.2:zoom=1.0
Anim=1

For c=1 To 255
Colors(1+c)=Rgb((c*1) And &HFF, _
(c*2) And &HFF, _
(c*3) And &HFF)
Next
Colors(1)=0:Colors(%maxitera+1)=0

WinID = TBGL_CreateWindowEx("first test", _
%window_w, %window_h, 32, _
%TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_UseTexturing %TRUE

tStart=GetTickCount

While TBGL_IsWindow(WinID)
Frames+=1
rstep=(rdiff*zoom) / %txtsize
istep=(idiff*zoom) / %txtsize
rmin=roffset-(rdiff*zoom*0.5)
imin=ioffset-(idiff*zoom*0.5)

FillTexture (VarPtr(ColorBuffer(1)), _
VarPtr(Colors(1)), _
%txtsize,%maxitera, _
imin, rmin, istep, rstep)

strBuffer = Peek$(VarPtr(ColorBuffer(1)), %npixels * 4)
TBGL_MakeTexture strBuffer, %TBGL_DATA_RGBA, _
%txtsize,%txtsize, _
1, %TBGL_TEX_ANISO, 16
TBGL_BindTexture 1
TBGL_ResetKeyState()


TBGL_ClearFrame
TBGL_Camera 0,0,2.4, 0,0,0

TBGL_BeginPoly %GL_QUADS
TBGL_TexCoord2D 0, 0: TBGL_Vertex -1,-1, 0
TBGL_TexCoord2D 1, 0: TBGL_Vertex 1,-1, 0
TBGL_TexCoord2D 1, 1: TBGL_Vertex 1, 1, 0
TBGL_TexCoord2D 0, 1: TBGL_Vertex -1, 1, 0
TBGL_EndPoly
TBGL_DrawFrame
counter+=1

If TBGL_GetWindowKeyState(WinID, %VK_ESCAPE) Then
Exit While
End If

If TBGL_GetWindowKeyState(WinID, %VK_ADD ) Then
zoom-=rStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_SUBTRACT ) Then
zoom+=rStep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_UP ) Then
ioffset+=istep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_DOWN ) Then
ioffset-=istep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_LEFT ) Then
roffset-=rstep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_RIGHT) Then
roffset+=rstep*8
End If
If TBGL_GetWindowKeyState(WinID, %VK_SPACE) Then
anim=anim XOR 1
End If
tNow=GetTickCount

If (anim<>0) And (tNow-tStart)>=100 Then
tmp=Colors(2)
For c=2 To %maxitera
Colors(c)=Colors(c+1)
Next
Colors(%maxitera)=tmp
tStart=tNow
End If
Wend

TBGL_DeleteTexture 1
TBGL_DestroyWindow



Petr

[Charles Pegge]

Many thanks Joshy, this is a really great performer!

I've been studying your code and the modifications the Petr produced, and there is a further simplification you can do: Assembler variables can be explicitly defined like this:



;by d.j.peters (Joshy)

var long arg_pixel at [ebp+8]
var long arg_color at [ebp+12]
var long arg_tsize at [ebp+16] ' texture size power of (32,64,256,512 ...)
var long arg_max at [ebp+20] ' max iteras
var double arg_imin at [ebp+24]
var double arg_rmin at [ebp+32]
var double arg_istep at [ebp+40]
var double arg_rstep at [ebp+48]

def arg_ret 52

var double var_x2y2 at [ebp-4]
var double var_i at [ebp-12]
var double var_r at [ebp-20]



I hope this will make coding in Oxygen Asm a little easier.

Charles

[D.J.Peters]

Hello Petr and Charles Pegge
thank you both for your infos.

By the way,
it's an bit crazy "an script interpreter" with "inline assembler".

But it's realy cool i like it.

Joshy

[sblank]

Joshy!!

Wow... that is amazing. It reminds me of the old Fractint DOS program. Very elegant and very nicely done.

I agree with you... somewhat of a paradox to have an interpreted language with assembly code? Who would have thought that?

Cheers,

Stan