OpenGl Ufo

[peter]

Hello,


lovely openGl ufo by Charles Pegge, (OxygenBasic forum).
Converted to ThinBasic by Peter.


It is a bit different, is mirror-inverted and has a nicely copper color.
Mirror-inverted looks a bit better for an ufo.


Uses "ui"
#INCLUDE "api.inc"


DWord hwnd = Canvas_Window("api_app",xMid(800),yMid(600),800,600)
Canvas_Attach(hwnd,0,%TRUE)
DWord hdc = Canvas_GetDC()


Long xs, ys, a, b, c, i, m, n, p, x, st, s
Single q, r, y, ia
xs=1 : ys=1 : a=700 : b=a*a : c=600 : ia=1/a


While IsWindow hwnd And KeyDown(27)=0
Canvas_Clear 0
For x = 0 To a Step xs
s = x*x
p = Sqr(b - s)
st=6*ys
For i = -p To p Step st
r = Sqr(s + i * i) /a
q = (r -1.0) * Sin(24 * r)
y = Int(i/3 + q * c)
If i=-p Then
m=y
n=y
End If
If y > m Then m = y
If y < n Then n = y
If m=y Or n=y Then
Canvas_SetPixel -x/2+400, (y/2)+300, &h8080FF
Canvas_SetPixel x/2+400, (y/2)+300, &h8080FF
End If
Next
Next
Canvas_Redraw
Wend
Canvas_Window End

[peter]

Hi,

here is the oxygenbasic source code.


include "sw.inc"
Window 800,600,1


w = GetWidth ()/2
h = GetHeight()/2
img = NewImage 800,600


single xs = 1
single ys = 1
single a = 700
single b = a * a
single c = 600
single q,r,y
single i,m,n,p,x,st
single ia = 1/a

Cls 0
Redraw


For x = 0 to a step xs
s = x * x
p = sqr(b - s)
st=6*ys
For i = -p to p step st
r = sqr(s + i * i) /a
q = (r -1) * sin(24 * r)
y = i/3 + q * c
if i=-p then
m=y
n=y
end if
if y > m then m = y
if y < n then n = y
if m=y or n=y then
SetPixel -x/2+w, y/2+h, sw_bred
SetPixel x/2+w, y/2+h, sw_bred
end if
Next
Next
Redraw


sys ny
For my=600 to 0 step -1
For mx=0 to 800
px=GetPixel( mx,my )
SetImagePixel( img,mx,ny,px )
Next
ny +=1
Next


DrawImageRect( img,0,0,800,600,0,0 )
Text 10,10,"WHAT UFO?",sw_white
WaitKey()
CloseWindow

[peter]

For Mister Pegge, Ufo Melissa.


include "sw.inc"
Window 800,600,1


w = GetWidth ()/2
h = GetHeight()/2
img = NewImage 800,600


single xs = 1
single ys = 1
single a = 700
single b = a * a
single c = 600
single q,r,y
single i,m,n,p,x,st
single ia = 1/a
single xa


Cls 0
Redraw


while key(27)=0
cls 0
For x = 0 to a step xs
s = x * x
p = sqr(b - s)
st=6*ys
For i = -p to p step st
r = sqr(s + i * i) /a
q = (r -1) * sin(-48 * r)
y = i/3 + q * c
if i=-p then
m=y
n=y
end if
if y > m then m = y
if y < n then n = y
if m=y or n=y then
SetPixel -x/2+w+sin(rad(xa))*40, y/2+h+cos(rad(xa))*20, sw_bred
SetPixel x/2+w+sin(rad(xa))*40, y/2+h+cos(rad(xa))*20, sw_bred
end if
Next
Next


xa +=10
if xa >=360 then xa = -xa
Redraw
wend
CloseWindow

[Charles Pegge]

Hi Peter, lets go 3d :)

[peter]

I think is OpenGl.

I am sorry Charles, I cannot do this with ThinBasic.

May be I find some tricks to draw a flying ufo what looks like OpenGl.

[Petr Schreiber]

You bet you can do that in ThinBASIC ;)

Charles, which approach did you picked for the soft shadow?


Petr

[Petr Schreiber]

Peter,

nice demos, thanks for sharing. Works great on Windows 8, no issues observed.

Because the scene is static, it is enough to draw it just once. Canvas takes care of repainting automagically (thanks to fact it is baked to bitmap).
To prevent 100% CPU usage of single core, Dialog Doevents is added:


Uses "ui"
#INCLUDE "api.inc"


DWord hwnd = Canvas_Window("api_app",xMid(800),yMid(600),800,600)
Canvas_Attach(hwnd,0,%TRUE)
DWord hdc = Canvas_GetDC()

Long xs, ys, a, b, c, i, m, n, p, x, st, s
Single q, r, y, ia
xs=1 : ys=1 : a=700 : b=a*a : c=600 : ia=1/a

' -- Draw the image just once, no need to keep it refreshing, it is done automagically!
Canvas_Clear 0
For x = 0 To a Step xs
s = x*x
p = Sqr(b - s)
st=6*ys
For i = -p To p Step st
r = Sqr(s + i * i) /a
q = (r -1.0) * Sin(24 * r)
y = Int(i/3 + q * c)
If i=-p Then
m=y
n=y
End If
If y > m Then m = y
If y < n Then n = y
If m=y Or n=y Then
Canvas_SetPixel -x/2+400, (y/2)+300, &h8080FF
Canvas_SetPixel x/2+400, (y/2)+300, &h8080FF
End If
Next
Next
Canvas_Redraw

' -- Loop with DoEvents won't hog CPU too much
While IsWindow(hwnd) And KeyDown(27)=0
Dialog DoEvents 0
Wend

If IsWindow(hwnd) Then
Canvas_Window End
End If


Note: Peter's API can be retrieved here:
Api Update (http://www.thinbasic.com/community/showthread.php?t=12351&p=90736#post90736)

Petr

[peter]

Thanks Petr.

I found a bug!

Automagically! should be: Automatically :D

[peter]

Hello,

Ancient stories about ufos, man in moon and who has masked my cornfield.

http://www.dudeman.net/siriusly/ufo/

[peter]

Hello,

more ufos here.


Uses "ui"
#INCLUDE "api.inc"


DWord hwnd = Canvas_Window("api_app",xMid(450),yMid(240),450,240)
Canvas_Attach(hwnd,0,%TRUE)
DWord hdc = Canvas_GetDC()
Canvas_Font "courier",16, %CANVAS_FONTSTYLE_BOLD


Canvas_Clear Rgb(200,200,248)
Long x, y, rx, ry, drx, dry, br, bg
x=120 : y=110 : rx=100 : ry=80 : drx=-20 : dry=0


br = Rgb(255, 0, 0)
bg = Rgb(255,255,0)
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,br
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,bg
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,br
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,bg
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,br
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,bg


x=340 : y=110 : rx=20 : ry=100 : drx=20 : dry=-20
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,br
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,bg
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,br
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,bg
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,br
rx += drx
ry += dry
Canvas_Ellipse x-rx,y-ry,x+rx,y+ry,-1,bg

DrawText 20,0,"SOME UFOS 3D",Rgb 55,48,248
Canvas_Redraw


While IsWindow(hwnd)And KeyDown(27)=0
Sleep 20
Wend
Canvas_Window End