Oxygen Basic
Programming => Example Code => Topic started by: Peter on November 13, 2013, 05:46:37 AM
-
Deleted
-
Hi Peter
I just download from thinB forum your o2 version of mike mandelbrot
and what a heck is this ???
image is not persistent is this same in thinbasic to ?
look in my evil-red madelbrot... ;D
.
-
Do not say is by Aurel.
I thought it was a RubenDev production. Good catch Peter. :D
-
The MessageBox is an independent thing, your window screen will be immediately restored.
ha ha
Both of you just babeling ...
NO is NOT RESTORED....
This example is your examlple from thinBasic forum and window is not buffered
because as you can see by moving message box over window background is erased.
And No Red-Mandelbrot is not your,it is version from EBasic mandelbrot translated to oxygen...
so what you can say now :P
I thought it was a RubenDev production. Good catch Peter.
what is so funny moron-lord >:(
-
Liar...
I don't know who is a liar but i am not .
here is my red-mandelbrot if you don't believe that is not yours...
$ filename "MandelRed.exe"
include "rtl32.inc"
include "awinh.inc"
#lookahead
declare function GetTickCount lib "kernel32.dll" () as long
sys t1,t2 : string ts
INT win,c,r
INT w,h
dim i,y,px as INT
dim Z_re2 as FLOAT
dim Z_im2 as FLOAT
dim Z_re as FLOAT
dim Z_im as FLOAT
dim c_re as FLOAT
dim c_im as FLOAT
INT rr,gg,bb
float t
INT hdc, hdcMem, hbmMem, oldBmp, oldBrush, oldPen, oldFont, fColor
INT textX,textY,hBrush
INT ImageWidth=640
INT ImageHeight=480
int z
MinRe = -2.0f
MaxRe = 1.0f
MinIm = -1.2f
MaxIm = MinIm+(MaxRe-MinRe) * ImageHeight/ImageWidth
Re_factor = (MaxRe-MinRe)/(ImageWidth-1)
Im_factor = (MaxIm-MinIm)/(ImageHeight-1)
'window
win = SetWindow("Mandel::Red",0,0,ImageWidth,ImageHeight,0,WS_SYSMENU)
InitDrawing()
FillRect ( hdcMem,rc,CreateSolidBrush RGB(0,0,0) )
t1=GetTickCount()
'---------------------------------------------------------------------
for y = 0 to ImageHeight-1
c_im = MaxIm - y*Im_factor
for px=0 to ImageWidth-1
c_re=MinRe+px*Re_factor
Z_re=c_re
Z_im=c_im
for i = 1 to 30
Z_re2=Z_re*Z_re
Z_im2=Z_im*Z_im
if (Z_re2+Z_im2) > 4
'-> back buffer
Setpixel hdcMem, px, y,RGB(145-(i+5),i*16,i+1)
exit for
end if
Z_im=2*Z_re*Z_im+c_im
Z_re=Z_re2-Z_im2+c_re
next i
next px
next y
t2=GetTickCount()
t= (t2-t1) /1000
ts = str(t)
TextOut hdcMem,10,360, ts, Len(ts) ' 0.731 sec
'----------------------------------------------------------------
Wait()
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
Select wmsg
CASE WM_CLOSE
DestroyWindow win
CleanUp()
PostQuitMessage 0
CASE WM_SIZE
'GetSize(win,0,0,w,h)
CASE WM_PAINT
BitBlt(hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)
End Select
Return DEFAULT
End Function
SUB InitDrawing
''get current size of window
GetSize(win,0,0,w,h)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, w, h)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End SUB
SUB CleanUp
DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))
END SUB
Sub Pix(wnd as int,sys x, y, r, g, b)
hdc=GetDC(wnd)
sys pcolor = RGB(r,g,b)
Setpixel hdcMem, x, y,pcolor
'BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)
ReleaseDC(wnd, hdc)
End Sub
'//////////////////////////////////////////////////////////
SUB DrawGray
INT color,red,green,blue
for y = 0 to ImageHeight-1
for px=0 to ImageWidth-1
cColor = Getpixel( hdc, px, y)
sys color
red = color
green = color - green/256
blue = color - blue/65536
Pix win, px, y,red,green,blue
Next px
Next y
END SUB
Ok now ?
I am not in the mood for freak show at all...
-
(http://media.tumblr.com/tumblr_lmydravAJ01qg5170.jpg)
Keep your guard sir. There are lairs and thieves among us.
If you think it's a bit chilly where you live, how about a minus 136 degrees Fahrenheit (minus 93.2 Celsius), measured in pockets scattered near a high ice ridge between Dome Argus and Dome Fuji, two summits on the East Antarctic Plateau.
-
Here is a code challenge to see who is the top gun of fractals. Relsoft (FreeBASIC past member) back in 2004 wrote this fractal example called Julia Rings. It uses the TinyC compiler with an extension called PTC. (site gone) It would be cool to revive this and create an O2 version. The screen shot is a Windows version running under Wine. The attached zip also includes a full screen version that didn't run under Wine. I may take a shot at this with C BASIC and the SDL_Draw library. It claims to be fast and this might be a good example to test that theory. (Ubuntu 64 bit / SDL 1.2)
(http://files.allbasic.info/C_BASIC/juliarings.png)
// The Lord of the Julia Rings
// The Fellowship of the Julia Rings
// Relsoft
// Rel.Betterwebber.com
// TinyPTC by Gaffer
// www.gaffer.org/tinyptc
//
#include <math.h>
#include "tinyptc.h"
#define SCR_WIDTH 320 * 1
#define SCR_HEIGHT 240 * 1
#define SCR_SIZE SCR_WIDTH*SCR_HEIGHT
#define PI 3.141593
#define MAXITER 20
#define MAXSIZE 4
static int vpage[SCR_SIZE];
static float lx[SCR_WIDTH];
static float ly[SCR_WIDTH];
int main (int argc, char *argv[])
{
int px , py;
float p , q;
float xmin , xmax , ymin , ymax;
float theta;
float deltax , deltay;
float x , y;
float xsquare , ysquare;
float ytemp;
float temp1 , temp2;
int i , pixel;
int *p_buffer;
int *p_bufferl;
unsigned int t, frame;
float ty;
int red , grn , blu;
int tmp , i_last ;
float cmag;
float cmagsq;
float zmag;
float drad;
float drad_L;
float drad_H;
float ztot;
xmin = -2.0;
xmax = 2.0;
ymin = -1.5;
ymax = 1.5;
deltax = (xmax - xmin) / (float)(SCR_WIDTH - 1);
deltay = (ymax - ymin) / (float)(SCR_HEIGHT - 1);
for (i = 0; i < SCR_WIDTH; i++)
lx[i] = xmin + i * deltax;
for (i = 0; i < SCR_HEIGHT; i++)
ly[i] = ymax - i * deltay;
int stime;
float Fps , Fps2;
if (!ptc_open("Julia Rings by Relsoft",SCR_WIDTH,SCR_HEIGHT)) return 1;
frame = 0;
while (1)
{
p_buffer = vpage;
p_bufferl = &vpage[SCR_SIZE-1];
frame = (frame + 1) & 0x7fffffff;
theta = frame * PI / 180.0f;
p = cos(theta) * sin(theta * .7);
q = sin(theta) + sin(theta);
p = p * .6;
q = q * .6;
cmag = sqrt(p *p + q* q);
cmagsq = (p *p + q* q);
drad = 0.04;
drad_L = (cmag - drad);
drad_L = drad_L * drad_L;
drad_H = (cmag + drad);
drad_H = drad_H * drad_H;
for (py = 0; py < (SCR_HEIGHT >> 1); py++)
{
ty = ly[py];
for (px = 0; px < SCR_WIDTH; px++)
{
x = lx[px];
y = ty;
xsquare = 0;
ysquare = 0;
ztot =0;
i = 0;
while (i < MAXITER && ( xsquare + ysquare ) < MAXSIZE)
{
xsquare = x * x;
ysquare = y * y;
ytemp = x * y * 2;
x = xsquare - ysquare + p;
y = ytemp + q;
zmag = (x * x + y * y);
if (zmag < drad_H && zmag > drad_L && i > 0)
{
ztot = ztot + ( 1 - (fabs(zmag - cmagsq) / drad));
i_last = i;
}
i++;
if (zmag > 4.0) break;
}
if (ztot > 0)
i = (int)(sqrt(ztot) * 500);
else
i = 0;
if (i < 256)
red = i;
else
red = 255;
if (i < 512 && i > 255)
grn = i - 256;
else
{
if (i >= 512)
grn = 255;
else
grn = 0;
}
if (i <= 768 && i > 511)
blu = i - 512;
else
{
if (i >= 768)
blu = 255;
else
blu = 0;
}
tmp = (int)((red+grn+blu) * 0.33);
tmp = tmp & 0xFF;
red = (int)((red+grn+tmp) * 0.33);
red = red & 0xFF;
grn = (int)((grn+blu+tmp) * 0.33);
grn = grn & 0xFF;
blu = (int)((blu+red+tmp) * 0.33);
blu = blu & 0xFF;
switch (i_last % 3)
{
case 1:
tmp = red;
red = grn;
grn = blu;
blu = tmp;
break;
case 2:
tmp = red;
blu = grn;
red = blu;
grn = tmp;
break;
}
pixel = red << 16 | grn << 8 | blu;
*p_buffer = pixel;
*p_bufferl = pixel;
p_buffer++;
p_bufferl--;
}
}
ptc_update(vpage);
}
}
.
-
Here is another set of Relsoft's gems (http://rel.phatcode.net/junk.php) done in DOS. I posted it as it uses SDL. (can't imagine how old that library is) Just a follow-up after someone nails the Julia Rings challenge. The following examples were run under dosemu on Ubuntu 64 bit.
(http://files.allbasic.info/C_BASIC/3dtorus_dosemu.png)
(http://files.allbasic.info/C_BASIC/pqtorus2_relsoft.png)
(http://files.allbasic.info/C_BASIC/plasma_relsoft.png)
.
-
Here is the C BASIC version of Relsoft's Julia Rings. (Ubuntu 12.04 LTS 64 bit)
(http://files.allbasic.info/C_BASIC/cbjuliarings.png) http://files.allbasic.info/C_BASIC/juliarings.swf
/*
The Lord of the Julia Rings
The Fellowship of the Julia Rings
Relsoft
Rel.Betterwebber.com
C BASIC version by JRS 12/9/2013
*/
#include <math.h>
#include <tinyptc.h>
#include "cbasic.h"
#define SCR_WIDTH 320 * 1
#define SCR_HEIGHT 240 * 1
#define SCR_SIZE SCR_WIDTH*SCR_HEIGHT
#define PI 3.141593
#define MAXITER 20
#define MAXSIZE 4
DIM AS static int vpage[SCR_SIZE];
DIM AS static float lx[SCR_WIDTH];
DIM AS static float ly[SCR_WIDTH];
MAIN
BEGIN_FUNCTION
DIM AS int px , py, i, pixel, red , grn , blu, tmp, i_last;
DIM AS float p, q, xmin, xmax, ymin, ymax, theta, deltax , deltay, x, y, xsquare, ysquare, ytemp, ty;
DIM AS float cmag, cmagsq, zmag, drad, drad_L, drad_H, ztot;
DIM AS int PTR p_buffer;
DIM AS int PTR p_bufferl;
DIM AS unsigned int frame;
xmin = -2.0;
xmax = 2.0;
ymin = -1.5;
ymax = 1.5;
deltax = (xmax - xmin) / (float)(SCR_WIDTH - 1);
deltay = (ymax - ymin) / (float)(SCR_HEIGHT - 1);
FOR (i = 0 TO i < SCR_WIDTH STEP INCR i)
BEGIN_FOR
lx[i] = xmin + i * deltax;
NEXT
FOR (i = 0 TO i < SCR_HEIGHT STEP INCR i)
BEGIN_FOR
ly[i] = ymax - i * deltay;
NEXT
IF (NOT ptc_open("C BASIC - Julia Rings",SCR_WIDTH,SCR_HEIGHT)) THEN_DO RETURN_FUNCTION(1);
frame = 0;
WHILE (1)
BEGIN_WHILE
p_buffer = vpage;
p_bufferl = AT vpage[SCR_SIZE-1];
frame = (frame + 1) & 0x7fffffff;
theta = frame * PI / 180.0f;
p = cos(theta) * sin(theta * .7);
q = sin(theta) + sin(theta);
p = p * .6;
q = q * .6;
cmag = sqrt(p * p + q * q);
cmagsq = (p * p + q * q);
drad = 0.04;
drad_L = (cmag - drad);
drad_L = drad_L * drad_L;
drad_H = (cmag + drad);
drad_H = drad_H * drad_H;
FOR (py = 0 TO py < (SCR_HEIGHT >> 1) STEP INCR py)
BEGIN_FOR
ty = ly[py];
FOR (px = 0 TO px < SCR_WIDTH STEP INCR px)
BEGIN_FOR
x = lx[px];
y = ty;
xsquare = 0;
ysquare = 0;
ztot =0;
i = 0;
WHILE (i < MAXITER AND (xsquare + ysquare) < MAXSIZE)
BEGIN_WHILE
xsquare = x * x;
ysquare = y * y;
ytemp = x * y * 2;
x = xsquare - ysquare + p;
y = ytemp + q;
zmag = (x * x + y * y);
IF (zmag < drad_H AND zmag > drad_L AND i > 0) THEN
ztot = ztot + ( 1 - (fabs(zmag - cmagsq) / drad));
i_last = i;
END_IF
INCR i;
IF (zmag > 4.0) THEN_DO EXIT_WHILE
WEND
IF (ztot > 0) THEN
i = (int)(sqrt(ztot) * 500);
ELSE
i = 0;
END_IF
IF (i < 256) THEN
red = i;
ELSE
red = 255;
END_IF
IF (i < 512 AND i > 255) THEN
grn = i - 256;
ELSE_IF (i >= 512) THEN
grn = 255;
ELSE
grn = 0;
END_IF
IF (i <= 768 AND i > 511) THEN
blu = i - 512;
ELSE_IF (i >= 768) THEN
blu = 255;
ELSE
blu = 0;
END_IF
tmp = (int)((red + grn + blu) * 0.33);
tmp = tmp & 0xFF;
red = (int)((red + grn + tmp) * 0.33);
red = red & 0xFF;
grn = (int)((grn + blu + tmp) * 0.33);
grn = grn & 0xFF;
blu = (int)((blu + red + tmp) * 0.33);
blu = blu & 0xFF;
SELECT_CASE (i_last MOD 3)
BEGIN_SELECT
CASE 1:
tmp = red;
red = grn;
grn = blu;
blu = tmp;
END_CASE
CASE 2:
tmp = red;
blu = grn;
red = blu;
grn = tmp;
END_CASE
END_SELECT
pixel = red << 16 | grn << 8 | blu;
PTR p_buffer = pixel;
PTR p_bufferl = pixel;
INCR p_buffer;
DECR p_bufferl;
NEXT
NEXT
ptc_update(vpage);
WEND
RETURN_FUNCTION(0);
END_FUNCTION
@Peter - Any chance we are going to see a SW / O2 version of this?
.
-
Very fine Fractal, John.
Some O2/Opengl hi-res renderings:
(http://www.oxygenbasic.org/o2pics/opengl/JuliaRings1.jpg)
(http://www.oxygenbasic.org/o2pics/opengl/JuliaRings2.jpg)
It's slowed right down, but some interesting transitions are still a little too fast to be captured.
.
-
I have to say that justifies giving Mike the bad news he is second place in the top gun fractal code challenge. Outstanding Charles!
A few more. (Running under Wine)
(http://files.allbasic.info/O2/jrgl1.png)
(http://files.allbasic.info/O2/jrgl2.png)
-
http://files.allbasic.info/O2/jro2gl.swf
Sorry about the low res capture. Download Charles's zip to see it live.
-
No i don't need better windows, as i say exactly same fbsl code also erase window background and
i don't know how mike don't see this because he is a some sort of perfectionist.
Or in another words ...
if is properly created on winXP then must work on win7...right?
-
Merry Christmas to you and your Family.
danke Herr Peter
Ihnen und Ihrer Familie alles Gute für Weihnachten :)
-
cool :)
Peter you must try this one created by GWS in Creative basic ....
'$ filename "ftree.exe"
'include "rtl32.inc"
include "awinh.inc"
#lookahead
'Window 500,375,1
int win,winstyle = WS_MINMAXSIZE or WS_CLIPCHILDREN
int w=1024,h=768
win = SetWindow("FracTree",0,0,w,h,0,winstyle)
INT hdc, hdcMem, hbmMem, oldBmp, oldBrush, oldPen, oldFont, fColor
INT textX,textY,hBrush
InitDrawing()
FillRect ( hdcMem,rc,CreateSolidBrush RGB(0,0,0) )
BitBlt(hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)
'============================================================================
single Spread_Ang = 35
single Scaling_Factor = 0.75
int sizeH = 1024 'wW
sys SizeV = 768 'wH
sys Init_Size = 150
TextColor (win,RGB(0,150,0))
wW = 1024
wH = 768
'DrawTree(SizeH / 2, SizeV, Init_Size, -90, 9)
'pythtree((wW/2-wW/12-5), wH-50, (wW/2+wW/12-5), wH-50, 0)
'pythTree(sizeH/2, sizeV, init_size, -90, 0)
pythtree( sizeH/2 - sizeH/12, sizeV-40,sizeH /2 + sizeH/12 , sizeV-40, 0)
'============================================================================
Wait()
'============================================================================
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
'----------------------------------------
CASE win
'----------------------------------------
Select wmsg
CASE WM_CLOSE
CleanUp()
DestroyWindow win
PostQuitMessage 0
CASE WM_PAINT
BitBlt(hDC, 0, 0, w, h, hdcMem, 0, 0, SRCCOPY)
End select
END SELECT
RETURN Default
END FUNCTION
'============================================================================
SUB InitDrawing
''get current size of window
GetSize(win,0,0,w,h)
'get window DC
hdc=GetDC(win)
hdcMem = CreateCompatibleDC(0)
hbmMem = CreateCompatibleBitmap(hdc, w, h)
oldBmp = SelectObject( hdcMem, hbmMem )
oldBrush = SelectObject(hdcMem, CreateSolidBrush( RGB(231,223,231)) )
oldPen = SelectObject(hdcMem, CreatePen(PS_SOLID,1,RGB(231,223,231)))
'fill rectangle memDC with brush color
FillRect ( hdcMem,rc, oldBrush)
SetTextColor( hDC,RGB(0,0,0))
SetBkColor( hDC, RGB(231,223,231))
'blit to memDC
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)
ReleaseDC( win, hdc)
End SUB
'============================================================================
SUB CleanUp
DeleteDC(hdcMem)
DeleteObject(SelectObject(hdcMem, oldBrush))
DeleteObject(SelectObject(hdcMem, oldPen))
DeleteObject(SelectObject(hdcMem, oldBmp))
END SUB
'=================================================
SUB TextColor (wID as INT,byval frontColor as sys)
hdc = GetDC(wID)
sys bColor
fColor=frontColor
bColor = RGB(231,223,231)
SetTextColor( hDC, frontColor)
SetBkColor( hDC, bColor)
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)
ReleaseDC( wID, hdc)
End SUB
'============================================================================
SUB LineXY (wID as INT,Lx as INT,Ly as INT,Lx1 as INT,Ly1 as INT)
hdc = GetDC(wID)
GetSize(wID,0,0,w,h)
SelectObject(hdc, CreatePen(PS_SOLID,1,fColor))
MoveToEx hdc,Lx,Ly,Byval 0
LineTo hdc,Lx1,Ly1
BitBlt(hDCmem, 0, 0, w, h, hdc, 0, 0, SRCCOPY)
ReleaseDC( wID, hdc)
End SUB
'===========================================================================
Sub DrawTree(single x1, y1, Size, theta, depth)
x2 = x1 + cos(rad(theta)) * Size
y2 = y1 + sin(rad(theta)) * Size
LineXY win, x2, y2,x1,y1
LineXY win,x1, y1, x2, y2
iF depth <= 0 Then Return
DrawTree(x2, y2, Size * Scaling_Factor, theta - Spread_Ang, depth - 1)
DrawTree(x2, y2, Size * Scaling_Factor, theta + Spread_Ang, depth - 1)
End Sub
sub pythTree(byval ax as int,byval ay as int,byval bx as int,byval by as int ,byval recur as int)
int red,grn,blu
int cx=0,cy=0,dx=0,dy=0,ex=0,ey=0
cx = ax-ay+by
cy = ax+ay-bx
dx = bx+by-ay
dy = ax-bx+by
ex = 0.5*(cx-cy+dx+dy)
ey = 0.5*(cx+cy-dx+dy)
red = rand(0,200)+55: grn = rand(0,100)+155 :blu = rand(0,200)+55
'frontpen w,rgb(red,grn,blu)
TextColor win,RGB(red,grn,blu)
LineXY win, cx, cy, ax, ay
LineXY win, ax, ay, bx, by
LineXY win, bx, by, dx, dy
LineXY win, dx, dy, cx, cy
LineXY win, cx, cy, ex, ey
LineXY win, ex, ey, dx, dy
if recur < 24
pythTree(cx, cy, ex, ey, recur+rand(0,4)+Scaling_Factor)
pythTree(ex, ey, dx, dy, recur+rand(0,4)Scaling_Factor)
end if
'recur++
'return
end sub
-
Peter you must try this one created by GWS in Creative basic ....
I would give it a try but every time I try to run CB, my screen goes black and I hear children screaming from my speakers.
-
my screen goes black and I hear children screaming from my speakers.
John,John.... ::)
this routine is just created by one very nice old guy Graham and that is all...
why you insinuate pedofilia ?
oh my...