Don't see why this time should be any different from the last, here's a 3D starfield in extended Ascii, I will do something better than this soon, but it'll do for now!
'
' Gfxlib Ascii Demo Coded By Shockwave ^ DBF
'
'-------------------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
'-------------------------------------------------------------------------------
' SET SCREEN MODE
'-------------------------------------------------------------------------------
CONST XR = 640: ' XRES
CONST YR = 480: ' YRES
windowtitle ""
SCREENRES XR , YR , 32 , 2 , , 60
setmouse 0,0,0
'
'176 177 178 219
'
dim shared gfxbuffer(80,60) as ubyte :' Will be used to store the ascii character
dim shared ACbuffer(80,60) as ubyte :' Will be used to store the colour weight in ascii
dim shared screenbuffer(160,120):' Will hold the render of the screen to be broken down into 2*2 blocks
dim shared GSbuffer(160,120):' Will hold the colour weight in screen.
declare sub render()
declare sub DB()
'-------------------------------------------------------------------------------
' Init Double Buffering Stuff;
'-------------------------------------------------------------------------------
dim shared as integer workpage,vispage
workpage=0
vispage=1
'-------------------------------------------------------------------------------
' Initialise starfield;
'-------------------------------------------------------------------------------
dim shared as integer a,starnum
starnum = 8000
dim shared as double stx(starnum),sty(starnum),stz(starnum)
for a=1 to starnum
stx(a)=-3000+rnd*(6000)
sty(a)=-3000+rnd*(6000)
stz(a)=rnd*32
next
declare sub stars()
declare sub convert()
'-------------------------------------------------------------------------------
' Initialise Window Scroller;
'-------------------------------------------------------------------------------
dim shared winscroll as string
winscroll=" "
winscroll=winscroll+"THIS LITTLE INTRO IS MY FIRST EVER ASCII / ANSII THING... "
winscroll=winscroll+"AS YOU CAN SEE IT IS QUITE BASIC.. GREETS TO ALL THE GUYZ "
winscroll=winscroll+"ON THIS FORUM, SHOCKWAVE^DBF SIGNING OUT!!!"
winscroll=winscroll+" "
dim shared as integer winscrollp
dim shared as double oldtime
winscrollp=0
declare sub scroller()
'-------------------------------------------------------------------------------
' Main Loop;
'-------------------------------------------------------------------------------
oldtime=timer
DO
if timer-oldtime> . 05 then scroller()
stars()
convert()
render()
DB()
LOOP UNTIL INKEY$=CHR$(27)
END
sub scroller()
oldtime=timer
WINDOWTITLE "(C) SW^DBF >"+mid$(winscroll,winscrollp,40)+"<"+"ALT+ENTER FOR FULLSCREEN"
WINSCROLLP=WINSCROLLP+1
if winscrollp>len(winscroll)-20 then winscrollp=0
end sub
'-------------------------------------------------------------------------------
' Convert Faux screen into ascii;
'-------------------------------------------------------------------------------
sub convert()
dim as integer xx,yy,tally,flx,fly
fly=0
for yy=1 to 118 step 2
flx=0
for xx=1 to 158 step 2
flx=flx+1
tally=0
if screenbuffer(xx,yy) =1 then tally=tally+1
if screenbuffer(xx+1,yy) =1 then tally=tally+1
if screenbuffer(xx+1,yy+1) =1 then tally=tally+1
if screenbuffer(xx,yy+1) =1 then tally=tally+1
if tally=1 then gfxbuffer(flx,fly)=176
if tally=2 then gfxbuffer(flx,fly)=177
if tally=3 then gfxbuffer(flx,fly)=178
if tally=4 then gfxbuffer(flx,fly)=219
ACbuffer(flx,fly) = GSbuffer(xx,yy)+GSbuffer(xx+1,yy)+GSbuffer(xx+1,yy+1)+GSbuffer(xx,yy+1)
next
fly=fly+1
next
end sub
'-------------------------------------------------------------------------------
' This Will Render The Stars To Our Faux 160 * 120 Screen Ready For Conversion!
'-------------------------------------------------------------------------------
sub stars()
dim as integer tx,ty
for a=1 to starnum
tx=(int(stx(a)/stz(a)))+80
ty=(int(sty(a)/stz(a)))+60
if tx>0 and tx<160 and ty>0 and ty<120 then
screenbuffer(tx,ty)=1
gsbuffer(tx,ty)=(int(-stz(a)+32))*5
end if
stz(a)=stz(a)-.3
if stz(a)<0 then
stx(a)=-3000+rnd*(6000)
sty(a)=-3000+rnd*(6000)
stz(a)=32
end if
next
end sub
'-------------------------------------------------------------------------------
' Sub to do Double Buffer;
'-------------------------------------------------------------------------------
sub DB()
'===============
'=DOUBLE BUFFER=
'===============
SCREENSET WORKPAGE,VISPAGE
SCREENSYNC
WORKPAGE XOR = 1
VISPAGE XOR = 1
end sub
'-------------------------------------------------------------------------------
' Sub to render the ascii and also empty out the old ascii buffer;
'-------------------------------------------------------------------------------
sub render()
dim as integer x,y
for x=2 to 79
for y=2 to 59
'===================
'=Render gfxbuffer;=
'===================
color (rgb(ACbuffer(x,y),ACbuffer(x,y),ACbuffer(x,y)))
locate y,x
print chr$(gfxbuffer(x,y))
'==================
'=Clear gfxbuffer;=
'==================
gfxbuffer(x,y)=0
ACbuffer(x,y)=0
next
next
for x=1 to 160
for y=1 to 120
screenbuffer(x,y)=0
GSbuffer(x,y)=0
next
next
end sub
