run length blit 2024
Re: run length blit - May 12
The draw command is really a little string parser.
Have a look at draw in the help files.
Have a look at draw in the help files.
Re: run length blit - May 12
dafhi matybe you could use angros47 starfield for a game. Although you said vertical scrolling game. I like it because it's a nice starfield effect.
Code: Select all
const w=800: const h=600
screenres w, h, 8
Dim pal(0 To 255) As Integer
dim as single x, y, c, sx, sy, sc
c=1.0
for i as integer=1 to 300
x=w/2: y=h/2
sx=(rnd()*2.0)-1.0
sy=(rnd()*2.0)-1.0
sc=rnd()
do
x+=sx: y+=sy: c+=sc
if c>255.0 then c-=254.0
pset (x,y), c
loop until x<0 orelse x>w orelse y<0 orelse y>h
next
dim t as single
dim speed as single=.01
do
palette using pal
dim d as integer=&hFF0000-(speed *100)
for i as integer=1 to 255
if pal(i) then pal(i)=pal(i)/20*19 and &hFF0000
next
t= (t+speed)
if t>=255.0 then t-=254.0
pal (t+.5)=&hFFFFFF
if multikey(&h49) andalso speed <1 then speed+=.001
if multikey(&h51) andalso speed >0.001 then speed-=.001
'screensync
sleep 1
loop until multikey(1)
Re: run length blit - May 12
After seeing the starfield demo I looked for more 3D type demos and found this qbasic one.
Is there any demo's like this one for FreeBasic? You need to skip ahead to 13 minutes to see the demo.
https://www.youtube.com/watch?v=VL0oGct1S4Q
Is there any demo's like this one for FreeBasic? You need to skip ahead to 13 minutes to see the demo.
https://www.youtube.com/watch?v=VL0oGct1S4Q
Re: run length blit - May 12
i have so much to do before i will have just the graphics part of an engine.
color reduction https://freebasic.net/forum/viewtopic.php?t=25956
procedural + combinatoric ship parts (+ terrain and other stuff)
terminal vel w/ accel consistent across all frame rates (personal 15 year challenge)
dodicat that's a real nice plug-and-play zoom.
color reduction https://freebasic.net/forum/viewtopic.php?t=25956
procedural + combinatoric ship parts (+ terrain and other stuff)
terminal vel w/ accel consistent across all frame rates (personal 15 year challenge)
dodicat that's a real nice plug-and-play zoom.
Re: run length blit - May 12
https://github.com/glasyalabolas/fb-3d-playground
Interactive demo and small framweork for learning some 3D concepts.
Re: run length blit - May 12
Here is a simple starfield similar to your QB thing.neil wrote: ↑May 14, 2023 2:11 After seeing the starfield demo I looked for more 3D type demos and found this qbasic one.
Is there any demo's like this one for FreeBasic? You need to skip ahead to 13 minutes to see the demo.
https://www.youtube.com/watch?v=VL0oGct1S4Q
I have used screenset with flip instead of
screenlock
screenunlock
(any would do)
I have sorted the circles by radius.
Code: Select all
Screen 20,32,2,64
Screenset 1,0
#define irange(f,l) Int(Rnd*(((l)+1)-(f))+(f))
#define ub 100+rnd*155
#define onscreen(x,y) (x>0 and x<1024 and y>0 and y<768)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
'========= set up c sort =========
#include "crt/stdlib.bi"
#define Array(x,start,finish) @X((start)),((finish)-(start)+1),Sizeof(X)
#macro SetCSort(Datatype,FnName,direction,dot)
Function FnName Cdecl(n1 As Const Any Ptr,n2 As Const Any Ptr) As Long
If direction=down Then
If (*Cptr(Datatype Ptr,n1))dot > (*Cptr(Datatype Ptr,n2))dot Then Return -1
If (*Cptr(DataType Ptr,n1))dot < (*Cptr(DataType Ptr,n2))dot Then Return 1
Else
If (*Cptr(Datatype Ptr,n1))dot < (*Cptr(Datatype Ptr,n2))dot Then Return -1
If (*Cptr(DataType Ptr,n1))dot > (*Cptr(DataType Ptr,n2))dot Then Return 1
End If
Return 0
End Function
#endmacro
Enum
up
down
End Enum
Type pt
As Single x,y,z
As Ulong col
r As Long
End Type
setCsort(pt,ptcallback,up,.r)
Sub orb(cx As Long,cy As Long,radius As Long,c As Ulong)
Dim As Ubyte red=Cptr(Ubyte Ptr,@c)[2]
Dim As Ubyte green=Cptr(Ubyte Ptr,@c)[1]
Dim As Ubyte blue=Cptr(Ubyte Ptr,@c)[0]
For d As Single = radius To 0 Step -radius/32
var al=iif(d<.6*radius,255,map(radius,0,d,0,255))
Circle (cx,cy),d,Rgba(red,green,blue,al),,,,F
Next d
End Sub
Function perspective(p As pt,ep As pt) As pt
Dim As Single w=1+(p.z/ep.z)
Return Type((p.x-ep.x)/w+ep.x, (p.y-ep.y)/w+ep.y,(p.z-ep.z)/w+ep.z,p.col)
End Function
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
Static As Double timervalue,_lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
_lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
Dim As pt p(1 To 2500),ret(1 To Ubound(p))
For n As Long=1 To Ubound(p)
p(n)=Type(irange(-300,1100),irange(-300,900),irange(-500,800),Rgb(ub,ub,ub))
Next
Dim As Single x=512,y=768\2
dim as long fps
Do
cls
Draw String(10,10),"Use arrows or space or press ESC to finish"
Draw String(10,50),"Framerate = " &fps
For n As Long=1 To Ubound(p)
p(n).z-=10
ret(n)=perspective(p(n),Type(x,y,1000))
ret(n).r=map(-500,800,ret(n).z,3,1)
If p(n).z<-950 Then p(n).z=irange(100,800)
Next n
qsort(array(ret,Lbound(ret),Ubound(ret)),@ptcallback)
For n As Long=1 To Ubound(ret)
If onscreen(ret(n).x,ret(n).y) Then orb(ret(n).x,ret(n).y,ret(n).r,ret(n).col)
Next n
Flip
If Multikey(&h48) Then y+=1
If Multikey(&h50) Then y-=1
If Multikey(&h4B) Then x-=1
If Multikey(&h4D) Then x+=1
If Multikey(&h39) Then x=512:y=768\2
Sleep regulate(40,fps),1
Loop Until multikey(1)
Last edited by dodicat on May 15, 2023 14:22, edited 1 time in total.
Re: run length blit - May 12
@dodicat
I got error messages:
I got error messages:
Code: Select all
R:\FreeBASIC\FreeBASIC-1.10.0-winlibs-gcc-9.3.0>fbc32 test.bas
test.bas(36) error 265: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 8: Undefined symbol, r in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 3: Expected End-of-Line, found '>' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 265: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 3: Expected End-of-Line, found '<' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 265: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 3: Expected End-of-Line, found '<' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 265: Symbol not a CLASS, ENUM, TYPE or UNION type, before '.' in 'setCsort(pt,ptcallback,up,.r)'
test.bas(36) error 3: Expected End-of-Line, found '>' in 'setCsort(pt,ptcallback,up,.r)'
R:\FreeBASIC\FreeBASIC-1.10.0-winlibs-gcc-9.3.0>
Re: run length blit - May 12
Hi hhr.
No errors in the official build (1.09), but I see what you mean.
I'll look into it for 1.10.
The bog standard quicksort is OK in the meantime.
OK, I have fixed the crt sort in the original starfield.
Extra brackets needed for fb 1.10
No errors in the official build (1.09), but I see what you mean.
I'll look into it for 1.10.
The bog standard quicksort is OK in the meantime.
Code: Select all
Screen 20,32,2,64
Screenset 1,0
#define irange(f,l) Int(Rnd*(((l)+1)-(f))+(f))
#define ub 100+rnd*155
#define onscreen(x,y) (x>0 and x<1024 and y>0 and y<768)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
'========= set up quick sort =========
#define up <,>
#define down >,<
#macro SetQsort(datatype,fname,b1,b2,dot)
Sub fname(array() As datatype,begin As Long,Finish As long)
Dim As Long i=begin,j=finish
Dim As datatype x =array(((I+J)\2))
While I <= J
While array(I)dot b1 X dot:I+=1:Wend
While array(J)dot b2 X dot:J-=1:Wend
If I<=J Then Swap array(I),array(J): I+=1:J-=1
Wend
If J > begin Then fname(array(),begin,J)
If I < Finish Then fname(array(),I,Finish)
End Sub
#endmacro
Type pt
As Single x,y,z
As Ulong col
r As Long
End Type
SetQsort(pt,ptsort,up,.r)
Sub orb(cx As Long,cy As Long,radius As Long,c As Ulong)
Dim As Ubyte red=Cptr(Ubyte Ptr,@c)[2]
Dim As Ubyte green=Cptr(Ubyte Ptr,@c)[1]
Dim As Ubyte blue=Cptr(Ubyte Ptr,@c)[0]
For d As Single = radius To 0 Step -radius/32
var al=iif(d<.6*radius,255,map(radius,0,d,0,255))
Circle (cx,cy),d,Rgba(red,green,blue,al),,,,F
Next d
End Sub
Function perspective(p As pt,ep As pt) As pt
Dim As Single w=1+(p.z/ep.z)
Return Type((p.x-ep.x)/w+ep.x, (p.y-ep.y)/w+ep.y,(p.z-ep.z)/w+ep.z,p.col)
End Function
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
Static As Double timervalue,_lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
_lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
Dim As pt p(1 To 2500),ret(1 To Ubound(p))
For n As Long=1 To Ubound(p)
p(n)=Type(irange(-300,1100),irange(-300,900),irange(-500,800),Rgb(ub,ub,ub))
Next
Dim As Single x=512,y=768\2
dim as long fps
Do
cls
Draw String(10,10),"Use arrows or space or press ESC to finish"
Draw String(10,50),"Framerate = " &fps
For n As Long=1 To Ubound(p)
p(n).z-=10
ret(n)=perspective(p(n),Type(x,y,1000))
ret(n).r=map(-500,800,ret(n).z,3,1)
If p(n).z<-950 Then p(n).z=irange(100,800)
Next n
ptsort(ret(),Lbound(ret),Ubound(ret))
For n As Long=1 To Ubound(ret)
If onscreen(ret(n).x,ret(n).y) Then orb(ret(n).x,ret(n).y,ret(n).r,ret(n).col)
Next n
Flip
If Multikey(&h48) Then y+=1
If Multikey(&h50) Then y-=1
If Multikey(&h4B) Then x-=1
If Multikey(&h4D) Then x+=1
If Multikey(&h39) Then x=512:y=768\2
Sleep regulate(40,fps),1
Loop Until multikey(1)
Extra brackets needed for fb 1.10
Re: run length blit - May 12
@dodicat
This is a very nice 3D starfield effect with colorful orbs.
Now I am trying to figure out how you did it. Thanks for your demo.
This is a very nice 3D starfield effect with colorful orbs.
Now I am trying to figure out how you did it. Thanks for your demo.
Re: run length blit - May 12
dodicat's 3D colorful orbs would be great for a flight simulator.
Maybe a spaceship flight simulator.
Maybe a spaceship flight simulator.
Re: run length blit - May 12
@dodicat
The crt sort and the bog standard quick sort both run fine on Linux using FreeBasic version 1.10.
It was also tested on Windows 10, and both versions run fine.
Is the crt sort version faster?
The crt sort and the bog standard quick sort both run fine on Linux using FreeBasic version 1.10.
It was also tested on Windows 10, and both versions run fine.
Is the crt sort version faster?
Re: run length blit - May 12
the quicksort rabbit hole : )
if i remember correctly, dodicat's beats c
Munair had a fast one, i haven't been able to find it
if i remember correctly, dodicat's beats c
Munair had a fast one, i haven't been able to find it
Re: run length blit - May 12
@dafhi
About quicksort. I ran both versions. I don't see any difference in speed visually with dodicat's 3D-orbs. Anyways now we just need to to put in a window in the 3D-orbs.bas and it will look like were in a spaceship. Maybe something like this.
https://www.youtube.com/watch?v=BHrJDTBvcBA
About quicksort. I ran both versions. I don't see any difference in speed visually with dodicat's 3D-orbs. Anyways now we just need to to put in a window in the 3D-orbs.bas and it will look like were in a spaceship. Maybe something like this.
https://www.youtube.com/watch?v=BHrJDTBvcBA
Re: run length blit - May 12
3d is easy
projection.x = point.x / point.z + screen_w / 2
projection.x = point.x / point.z + screen_w / 2
Re: run length blit - May 12
@dafhi
You wrote "3d is easy" "projection.x = point.x / point.z + screen_w / 2"
How would you make this look more 3D? Like it is really moving.
You wrote "3d is easy" "projection.x = point.x / point.z + screen_w / 2"
How would you make this look more 3D? Like it is really moving.
Code: Select all
function map(a as double,b as double,x as double,c as double,d as double) as double
return (d-c)*(x-a)/(b-a)+c
end function
Dim As Ulong i, j, r, x, y, Red, Green, Blue
Color 15,0
Cls
ScreenRes 800, 600, 32
Locate 10,40:Print "DEMO HAS STARTED"
for j = 1 to 5
sleep 2000,1
Cls
x = 380: y = 160:r = 30
FOR i = 1 TO r
red=map(1,r,i,255,25)
green=map(1,r,i,255,25)
blue=map(1,r,i,255,25)
CIRCLE (x, y),i, RGB(Red, Green, Blue)
CIRCLE (x, y + 1),i, RGB(Red, Green, Blue)
sleep 60,1
next
next
Locate 30,40: Print "DEMO HAS FINISHED"
sleep