+- Qbasicnews.com (http://qbasicnews.com/newforum)
+-- Forum: General (http://qbasicnews.com/newforum/forum-6.html)
+--- Forum: General/Misc (http://qbasicnews.com/newforum/forum-18.html)
+--- Thread: freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. (/thread-4948.html)
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - KiZ - 11-08-2004
Everything is sounding so amazingly great, just one mini suggestion:
It would be good if you could include an icon when compiling the exe to make them look more like windows exes, now that they are 32bit, in the same way that you can assign an icon into a program in VB.
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - Jofers - 11-08-2004
Well, now that it seems that this little program is fleshing out, I might as well inquire:
Has anyone done some speed tests with it? You know, the usual memory handling, calculation, etc suite? It would be nice to have a benchmark with other non-basic compilers, seeing as none of 'em have come close to GCC thus yet.
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - v3cz0r - 11-08-2004
It's a 2 months old qb-compatible compiler made by just one person and do you want to compare it with GCC? Nor PowerBASIC that is being hacked in ~10 years can come close to the optimizations done by a modern C compiler.. but yeah, freeBASIC gens better code than FreePascal with complex expressions, for example.. I know you asked about C, screw you :P
If you can fit a horse logo into a 16x16 icon, i'll add them to the Exe's ;)
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - ShadowWolf - 11-08-2004
v3cz0r relax once you have this thing open source there will be lots of people slowly improving the code generation after a couple year who knows.
if there any programming community out there that has the insain drive to push somthing to it's limmit's it's the qb community.
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - relsoft - 11-08-2004
Hahaha!! I just tried to do C convention pointer last night. LOL
I know what's wrong now.
Before:
p = p + 1
Now:
p = p + len(type)
Or would this work?
inc = len(type)
p = p + i
How about structures?
p = p + len(typename) ?
BTW, Made a tinyPTC wrapper last night. More like a Rellib using TinyPTC.
And since you're not on the badlogic channel:
T! = frame
x = Cos(t! *. 6)
Subscript out of range.
Line(H,V, diag)
rects
Putpixel
PUT/GET
all works now. Will optimize using pointers later tonight.
Joe: Speed wise, on a non-scaled window, 20(prolly more) 64 * 64 on full speed on my comp( 233 cyrix)
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - v3cz0r - 11-08-2004
Hey, nice.. i could use that as a QB gfx implementation by now.. LINE, PSET and stuff.
Yeah, there's no pointer arithmetics, you must do by hand: p = p + len( integer ) for example.
Btw, here's an app with the fb icon: http://freebasic.bad-logic.com/downloads/ptc_test-fbicon.zip (horse didn't look that bad :P)
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - relsoft - 11-08-2004
v1c: Get your arse at badlogic(efnet) now. wanna talk something. Not much time, I'm on a luchbreak. :*)
Really not much yet as I was watching Irobot when I made this:
(I'll convert this using pointer notation later)
Autoclipping already supported.
Code:
'//TinyPTC relGFX style
'//Relsoft 2004
'//v3cz0r is da man!
'//
defint a-z
'$include: 'tinyptc.bi'
declare sub cls(byref buffer())
declare sub put_pixel(byref buffer(), byval x as integer, byval y as integer, byval col as integer)
declare sub draw_line(byref buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
declare sub draw_line_h ( byref buffer(), byval x1 as integer, byval y as integer, byval x2 as integer, byval col as integer)
declare sub draw_line_v ( byref buffer(), byval x as integer, byval y1 as integer, byval y2 as integer, byval col as integer)
declare sub draw_rect_fill(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
declare sub draw_rect(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
declare sub put_solid (byref buffer(), byval x as integer, byval y as integer, byref sprite())
declare sub put (byref buffer(), byval x as integer, byval y as integer, byref sprite())
declare sub get_sprite( byref buffer() as integer, byval x1 as integer, byval y1 as integer _
, byval x2 as integer, byval y2 as integer, byref sprite() as integer)
declare function size_of_image(byval x1 as integer, byval y1 as integer, byval x2 as integer _
, byval y2 as integer)
option explicit
const SCR_WIDTH = 320
const SCR_HEIGHT = 240
const SCR_SIZE = SCR_WIDTH*SCR_HEIGHT
const PI = 3.141593
const SPR_WID = 64
const SPR_HEI = 64
const SPR_SIZE = SPR_WID * SPR_HEI
dim shared buffer( 0 to SCR_SIZE-1 ) as integer
dim shared Lcos(0 to 359) as single
dim shared Lsin(0 to 359) as single
'dim shared sprite(0 to (SPR_SIZE - 1) + 2) as integer
redim shared sprite(0 to size_of_image(0,0,SPR_WID - 1, SPR_HEI -1)) as integer
dim frame as long
dim col as integer
dim i as integer
dim j as integer
dim offs as long
dim rot as integer
dim counter as long
dim pixel as integer
dim xptr as long ptr
dim x as integer
dim y as integer
dim x1 as integer
dim y1 as integer
dim x2 as integer
dim y2 as integer
dim t as single
dim angle as integer
dim r as integer
dim g as integer
dim b as integer
if( ptc_open( "freeBASIC v0.01 - RelGFX win demo(Relsoft)", SCR_WIDTH, SCR_HEIGHT ) = 0 ) then
end -1
end if
for i = 0 to 359
Lcos(i) = cos ( i * PI /180)
Lsin(i) = sin ( i * PI /180)
next i
sprite(0) = SPR_WID
sprite(1) = SPR_HEI
for y = 0 to SPR_HEI -1
for x = 0 to SPR_WID -1
r = abs(INT(128 - 127 * SIN(x * PI / 16)))
g = abs(INT(128 - 127 * SIN(y * PI / 32)))
b = abs(INT(128 - 127 * SIN((x+y) * PI / 16)))
put_pixel buffer, x, y , r shl 16 or g shl 8 or b
next x
next y
get_sprite buffer(), 0, 0, SPR_WID -1, SPR_HEI -1, sprite()
counter = 0
frame = 0
angle = 0
do
frame = (frame + 1) and &h7fffffff
angle = (angle + 1) mod 360
x = (Lcos(angle) * (SCR_WIDTH \ 2 ) )
y = (Lsin(angle) * (SCR_HEIGHT \ 2 ) )
cls buffer()
put buffer(), x+ ((SCR_WIDTH \ 2) - 32), y+ ((SCR_HEIGHT \ 2) - 32), sprite()
put buffer(), -x+ ((SCR_WIDTH \ 2) - 32), y+ ((SCR_HEIGHT \ 2) - 32), sprite()
put buffer(), x+ ((SCR_WIDTH \ 2) - 32), -y+ ((SCR_HEIGHT \ 2) - 32), sprite()
put buffer(), -x+ ((SCR_WIDTH \ 2) - 32), -y+ ((SCR_HEIGHT \ 2) - 32), sprite()
ptc_update varptr( buffer(0) )
loop
ptc_close
private sub put_pixel(byref buffer(), byval x as integer, byval y as integer, byval col as integer)
buffer(y * SCR_WIDTH + x) = col
end sub
private sub cls(byref buffer())
dim offset as long
for offset = 0 to SCR_SIZE -1
buffer( offset ) = 0
next offset
end sub
private sub draw_line(byref buffer(), byval x as integer, byval y as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
dim i as integer
dim slope as integer
dim eterm as integer
dim dx as integer
dim dy as integer
dim sx as integer
dim sy as integer
dim notclip as integer
dim temp as integer
const scrxmax = SCR_WIDTH - 1
const scrymax = SCR_HEIGHT - 1
I = 0
Slope = 0
Eterm = 0
IF (X2 - X) > 0 THEN
SX = 1
ELSE
SX = -1
END IF
Dx = ABS(X2 - X)
IF (Y2 - Y) > 0 THEN
SY = 1
ELSE
SY = -1
END IF
Dy = ABS(Y2 - Y)
IF (Dy > Dx) THEN
Slope = 1
temp = x
x = y
y = temp
temp = dx
dx = dy
dy = temp
temp = sx
sx = sy
sy = temp
END IF
Eterm = 2 * Dy - Dx
FOR I = 0 TO Dx - 1
IF Slope = 1 THEN
NotClip = (((Y < 0) + (X < 0) + (Y > scrxmax) + (X > scrymax)) = 0)
IF NotClip THEN buffer(x * SCR_WIDTH + y ) = col
ELSE
NotClip = (((X < 0) + (Y < 0) + (X > scrxmax) + (Y > scrymax)) = 0)
IF NotClip THEN buffer(Y * SCR_WIDTH + X ) = col
END IF
WHILE Eterm >= 0
Y = Y + SY: Eterm = Eterm - 2 * Dx
WEND
X = X + SX: Eterm = Eterm + 2 * Dy
NEXT I
NotClip = (((X2 < 0) + (Y2 < 0) + (X2 > scrxmax) + (Y2 > scrymax)) = 0)
IF NotClip THEN buffer(Y2 * SCR_WIDTH + X2 ) = col
end sub
private sub draw_line_h ( byref buffer(), byval x1 as integer, byval y as integer, byval x2 as integer, byval col as integer)
const SCR_X_MAX = SCR_WIDTH - 1
const SCR_Y_MAX = SCR_HEIGHT - 1
dim wid as integer
dim offset as long
dim counter as integer
dim temp as integer
if (y < 0) or (y > SCR_Y_MAX) then exit sub
if (x1 > x2) then
temp = x1
x1 = x2
x2 = temp
end if
if x1 > SCR_X_MAX then exit sub
if x2 < 0 then exit sub
if x1 < 0 then
x1 = 0
if (x2 - x1) < 0 then exit sub
end if
if x2 > SCR_X_MAX then
x2 = SCR_X_MAX
if (x2 - x1) < 0 then exit sub
end if
wid = (x2 - x1) + 1
if wid <= 0 then exit sub
offset = y * SCR_WIDTH + x1
for counter = 0 to (wid - 1)
buffer( offset ) = col
offset = offset + 1
next counter
end sub
private sub draw_line_v ( byref buffer(), byval x as integer, byval y1 as integer, byval y2 as integer, byval col as integer)
const SCR_X_MAX = SCR_WIDTH - 1
const SCR_Y_MAX = SCR_HEIGHT - 1
dim hite as integer
dim offset as long
dim counter as integer
dim temp as integer
if (x < 0) or (x > SCR_X_MAX) then exit sub
if (y1 > y2) then
temp = y1
y1 = y2
y2 = temp
end if
if y1 > SCR_Y_MAX then exit sub
if y2 < 0 then exit sub
if y1 < 0 then
y1 = 0
if (y2 - y1) < 0 then exit sub
end if
if y2 > SCR_Y_MAX then
y2 = SCR_Y_MAX
if (y2 - y1) < 0 then exit sub
end if
hite = (y2 - y1) + 1
if hite <= 0 then exit sub
offset = y1 * SCR_WIDTH + x
for counter = 0 to (hite - 1)
buffer( offset ) = col
offset = offset + SCR_WIDTH
next counter
end sub
private sub draw_rect_fill(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
const SCR_X_MAX = SCR_WIDTH - 1
const SCR_Y_MAX = SCR_HEIGHT - 1
dim hite as integer
dim wid as integer
dim offset as long
dim xcounter as integer
dim ycounter as integer
dim temp as integer
if (x1 > x2) then
temp = x1
x1 = x2
x2 = temp
end if
if x1 > SCR_X_MAX then exit sub
if x2 < 0 then exit sub
if x1 < 0 then
x1 = 0
if (x2 - x1) < 0 then exit sub
end if
if x2 > SCR_X_MAX then
x2 = SCR_X_MAX
if (x2 - x1) < 0 then exit sub
end if
wid = (x2 - x1) + 1
if wid <= 0 then exit sub
if (y1 > y2) then
temp = y1
y1 = y2
y2 = temp
end if
if y1 > SCR_Y_MAX then exit sub
if y2 < 0 then exit sub
if y1 < 0 then
y1 = 0
if (y2 - y1) < 0 then exit sub
end if
if y2 > SCR_Y_MAX then
y2 = SCR_Y_MAX
if (y2 - y1) < 0 then exit sub
end if
hite = (y2 - y1) + 1
if hite <= 0 then exit sub
offset = y1 * SCR_WIDTH + x1
for ycounter = 0 to (hite - 1)
for xcounter = 0 to (wid - 1)
buffer( offset + xcounter ) = col
next xcounter
offset = offset + SCR_WIDTH
next ycounter
end sub
private sub draw_rect(byref buffer(), byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer, byval col as integer)
draw_line_h buffer(), x1, y1, x2, col
draw_line_v buffer(), x1, y1, y2, col
draw_line_h buffer(), x1, y2, x2, col
draw_line_v buffer(), x2, y1, y2, col
end sub
private function size_of_image(byval x1 as integer, byval y1 as integer, byval x2 as integer, byval y2 as integer)
dim s as integer
dim temp as integer
if x1 > x2 then
temp = x1
x1 = x2
x2 = temp
end if
if y1 > y2 then
temp = y1
y1 = y2
y2 = temp
end if
s = ((x2 - x1) + 1) * ((y2 - y1) + 1) + 2
size_of_image = s
end function
private sub put_solid (byref buffer(), byval x as integer, byval y as integer, byref sprite())
const SCR_X_MAX = SCR_WIDTH - 1
const SCR_Y_MAX = SCR_HEIGHT - 1
dim owid as integer
dim ohei as integer
dim wid as integer
dim hei as integer
dim wcounter as integer
dim hcounter as integer
dim offset as long
dim soffset as long
dim htemp as integer
dim wtemp as integer
if (x > SCR_X_MAX) then exit sub
if (y > SCR_Y_MAX) then exit sub
owid = sprite(0)
ohei = sprite(1)
wid = owid
hei = ohei
soffset = 2
if y < 0 then
y = -y
soffset = soffset + (wid * y)
hei = hei - y
if hei <= 0 then exit sub
y = 0
end if
if (y + hei) > SCR_Y_MAX then
htemp = (y + hei) - SCR_HEIGHT
hei = hei - htemp
if hei <= 0 then exit sub
end if
if x < 0 then
x = -x
soffset= soffset + x
wid = wid - x
if wid <= 0 then exit sub
x = 0
end if
if (x + wid) > SCR_X_MAX then
wtemp = (x + wid) - SCR_WIDTH
wid = wid - wtemp
if (wid <= 0) then exit sub
end if
offset = y * SCR_WIDTH + x
for hcounter = 0 to (hei - 1)
for wcounter = 0 to (wid - 1 )
buffer( offset + wcounter) = sprite(soffset + wcounter)
next wcounter
offset = offset + SCR_WIDTH
soffset = soffset + owid
next hcounter
end sub
private sub put (byref buffer(), byval x as integer, byval y as integer, byref sprite())
const SCR_X_MAX = SCR_WIDTH - 1
const SCR_Y_MAX = SCR_HEIGHT - 1
dim owid as integer
dim ohei as integer
dim wid as integer
dim hei as integer
dim wcounter as integer
dim hcounter as integer
dim offset as long
dim soffset as long
dim htemp as integer
dim wtemp as integer
dim pixel as integer
if (x > SCR_X_MAX) then exit sub
if (y > SCR_Y_MAX) then exit sub
owid = sprite(0)
ohei = sprite(1)
wid = owid
hei = ohei
soffset = 2
if y < 0 then
y = -y
soffset = soffset + (wid * y)
hei = hei - y
if hei <= 0 then exit sub
y = 0
end if
if (y + hei) > SCR_Y_MAX then
htemp = (y + hei) - SCR_HEIGHT
hei = hei - htemp
if hei <= 0 then exit sub
end if
if x < 0 then
x = -x
soffset= soffset + x
wid = wid - x
if wid <= 0 then exit sub
x = 0
end if
if (x + wid) > SCR_X_MAX then
wtemp = (x + wid) - SCR_WIDTH
wid = wid - wtemp
if (wid <= 0) then exit sub
end if
offset = y * SCR_WIDTH + x
for hcounter = 0 to (hei - 1)
for wcounter = 0 to (wid - 1 )
pixel = sprite(soffset + wcounter)
if pixel <> 0 then buffer( offset + wcounter) = pixel
next wcounter
offset = offset + SCR_WIDTH
soffset = soffset + owid
next hcounter
end sub
private sub get_sprite( byref buffer() as integer, byval x1 as integer, byval y1 as integer _
, byval x2 as integer, byval y2 as integer, byref sprite() as integer)
const SCR_X_MAX = SCR_WIDTH - 1
const SCR_Y_MAX = SCR_HEIGHT - 1
dim hite as integer
dim wid as integer
dim offset as long
dim soffset as long
dim xcounter as integer
dim ycounter as integer
dim temp as integer
if (x1 > x2) then
temp = x1
x1 = x2
x2 = temp
end if
if x1 > SCR_X_MAX then exit sub
if x2 < 0 then exit sub
if x1 < 0 then
x1 = 0
if (x2 - x1) < 0 then exit sub
end if
if x2 > SCR_X_MAX then
x2 = SCR_X_MAX
if (x2 - x1) < 0 then exit sub
end if
wid = (x2 - x1) + 1
if wid <= 0 then exit sub
if (y1 > y2) then
temp = y1
y1 = y2
y2 = temp
end if
if y1 > SCR_Y_MAX then exit sub
if y2 < 0 then exit sub
if y1 < 0 then
y1 = 0
if (y2 - y1) < 0 then exit sub
end if
if y2 > SCR_Y_MAX then
y2 = SCR_Y_MAX
if (y2 - y1) < 0 then exit sub
end if
hite = (y2 - y1) + 1
if hite <= 0 then exit sub
sprite(0) = wid
sprite(1) = hite
soffset = 2
offset = y1 * SCR_WIDTH + x1
for ycounter = 0 to (hite - 1)
for xcounter = 0 to (wid -1)
sprite( soffset + xcounter )= buffer( offset + xcounter )
next xcounter
offset = offset + SCR_WIDTH
soffset = soffset + wid
next ycounter
end subfreeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - v3cz0r - 11-08-2004
Whoa, and some ppl say i code too fast ;)
Runs fine here, i barely can see the sprites moving, heh.. if tinyPTC could run in full-screen..
Btw, just found another bug: if an argument has the same name and type as a shared var, fb is accessing the shared var, not the arg.. will fix that later.. another day, another bug.
(and that cos( T! * . 6 ) thing, problem is that there is a space between the dot and the digit.. as QB can parse that, i added that "feature" too.. you need the new version tho)
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - barok - 11-08-2004
I agree with shadow fox... if there is any community out there that is crazy about pushing things to the limits, it's the qb community. We'll (well, maybe people like rel or plasma
) eventually make freebasic one of THE most powerful compilers out there! :lol:
freeBASIC (a 32-bit QB-syntax compatible compiler) preview.. - Jofers - 11-08-2004
Well, duh, It's not going to "compare" compare... I just want a meter guage at FB's speed
When I say no BASIC compiler in the past has compared to GCC, I mean that they compare closer to good ol' QB (and in a few cases, actually lose) I made an ico file with a few formats (winXP, 256, 16 color) for 48x48, 32x32, 16x16 I also replaced the white background with a circle to make it look more like an icon and less like thumbnail:
http://www.betterwebber.com/stuff/Horse.ico
It shows up as 16x16 XP format in firefox 1.0rc...