Ascii And Low Res Cube
Randomize Timer
'' ************ ASCII CUBE ************
''
''
'' Code : Hezad (Hezad0 at Gmail dot com)
''
''
''
Const _255 = 1/255
Const MAX_Z = 50
Redim Shared As Single ZBuffer(79*25)
#Define Clear_ZBuffer Redim As Single ZBuffer(79*25)
screenres 320,240,8
Palette 0, 10,10,10
Palette 1, 50,38,30
Palette 2, 70,50,50
Palette 3, 90,80,70
Palette 4, 110,100,80
Palette 5, 130,120,90
Palette 6, 150,145,100
Palette 7, 170,160,120
Palette 8, 190,170,130
Palette 9, 210,200,150
Palette 10, 235,215,165
Palette 11, 255,255,255
Dim Shared As Integer Flash, CanFlash
Sub ASCII(x As Integer, y As Integer, gradval As Integer)
If flash Then
Color gradval,Gradval
Else
Color gradval,0
End If
Locate y,x : Print Str(Int(Rnd*2))'"#"'Gradient(GradVal);
End Sub
Sub Flash_It()
Static t As Single
If CanFlash = 1 Then
Flash = 1
t = Timer
CanFlash = 0
Else
If (timer-t)>1 Then Flash = 0
End If
If rnd<.05 And Flash = 0 Then CanFlash = 1
End Sub
'' cube
Type p3d
x As Single
y As Single
z As Single
End Type
Dim Shared As p3d p(7),pos2d(7)
p(0) = Type(-5,-5,-5)
p(1) = Type(5,-5,-5)
p(2) = Type(5,5,-5)
p(3) = Type(-5,5,-5)
p(4) = Type(-5,-5,5)
p(5) = Type(5,-5,5)
p(6) = Type(5,5,5)
p(7) = Type(-5,5,5)
#Macro Z_Buffer_Line(x1,x2,y,_z1,_z2)
Static As Single itx1,itx2
Static As Single xDiv,Cur_Z,_zz1,_zz2,d_Z
Static As Integer Ptr izval,izbuf
izbuf = Cast(Integer Ptr,@Zbuffer(0))
If x1<x2 Then
_zz1 = _z1
_zz2 = _z2
itx1 = x1
itx2 = x2
Else
_zz1 = _z2
_zz2 = _z1
itx1 = x2
itx2 = x1
End If
xDiv = 1/(itx2 - itx1)
d_Z = xDiv * (_zz2 - _zz1)
Cur_Z = _zz1
Static As Integer it
Static As Integer zc
it = y*78 + itx1
For i As Integer = itx1 To itx2-1
If i<78 And i>=0 And y>=0 And y<32 Then
izval = Cast(Integer Ptr,@Cur_Z)
If *izval > izbuf[it] Then
ZBuffer(it) = Cur_Z
zc = 800*(Cur_Z)-50
If zc>255 Then zc = 255
Zc = Zc*10*_255
If Zc>10 Then Zc = 10
ASCII i,y,zc
End If
End If
it+=1
Cur_Z += d_Z
Next
#endmacro
WindowTitle "ASCII Cube"
Sub Render_Opt_Z_Buffer(Byval p0 As p3d, Byval p1 As p3d, Byval p2 As p3d)
'' Sorting Y values
If p1.y < p0.y Then
Swap p1,p0
End If
If p2.y < p0.y Then
Swap p2,p0
End If
If p2.y < p1.y Then
Swap p2,p1
End If
Static As Single dx1,dy1,dx2,dy2,dx3,dy3
Static As Single Slope1,Slope2,Slope3, dYDiv
Static As Single d_z1,d_z2,d_z3,_z1,_z2,_z3
Static As Single _zSlope1,_zSlope2,_zSlope3
_z1 = 1/p0.z
_z2 = 1/p1.z
_z3 = 1/p2.z
'' interpolate 0 to 1
d_z1 = _z2 - _z1
dX1 = p1.x - p0.x
dY1 = p1.y - p0.y
If dY1 Then
dYDiv = 1/dY1
_zSlope1 = d_Z1 * dYDiv
Slope1 = dX1 * dYDiv
Else
_zSlope1 = 0
Slope1 = 0
End If
'' interpolate 1 to 2
d_Z2 = _z3 - _z2
dX2 = p2.x - p1.x
dY2 = p2.y - p1.y
If dY2 Then
dYDiv = 1/dY2
_zSlope2 = d_Z2 * dYDiv
Slope2 = dX2 * dYDiv
Else
_zSlope2 = 0
Slope2 = 0
End If
'' interpolate 0 to 2
d_Z3 = _z1 - _z3
dX3 = p0.x - p2.x
dY3 = p0.y - p2.y
If dY3 Then
dYDiv = 1/dY3
_zSlope3 = d_Z3 * dYDiv
Slope3 = dX3 * dYDiv
Else
_zSlope3 = 0
Slope3 = 0
End If
'' drawing
Static As Single CurX1, CurX2
CurX1=p0.x
CurX2=CurX1
Static As Single Cur_Z1, Cur_Z2
Cur_Z1 = _z1
Cur_Z2 = _z1
For y As Integer = p0.y To p1.y-1
Z_Buffer_Line(CurX1,CurX2,y,Cur_Z1,Cur_Z2)
Cur_Z1 += _zSlope1
Cur_Z2 += _zSlope3
CurX1 += Slope1
CurX2 += Slope3
Next
'' down
Cur_Z1 = _z2
CurX1 = p1.x
For y As Integer = p1.y To p2.y-1
Z_Buffer_Line(CurX1,CurX2,y,Cur_Z1,Cur_Z2)
Cur_Z1 += _zSlope2
Cur_Z2 += _zSlope3
CurX1 += Slope2
CurX2 += Slope3
Next
End Sub
Sub ASCIICube()
Static As Single zDiv,cx,cy,cz,sx,sy,sz,tx=0.03,ty=0.05,tz=-0.01'.007
Static As Single tmpx,tmpy,tmpz
cX = Cos(Tx) : sX = Sin(Tx)
cY = Cos(Ty) : sY = Sin(Ty)
cZ = Cos(Tz) : sZ = Sin(Tz)
'' rotation
For i As Integer = 0 To 7
TmpY = p(i).y * cx - p(i).z * sx
TmpZ = p(i).z * cx + p(i).y * sx
p(i).y = TmpY
p(i).z = TmpZ
TmpZ = p(i).z * cy - p(i).x * sy
TmpX = p(i).x * cy + p(i).z * sy
p(i).x = TmpX
TmpX = p(i).x * cz - p(i).y * sz
TmpY = p(i).y * cz + p(i).x * sz
p(i).x = TmpX
p(i).y = TmpY
p(i).z = TmpZ
Next
'' projection
For i As Integer = 0 To 7
If p(i).z+10>1 And p(i).z+10<50 Then
zDiv = 1/(p(i).z+50)
pos2d(i).x = 22+p(i).x * zDiv * 70
pos2d(i).y = 15+p(i).y * zDiv * 70
pos2d(i).z = p(i).z+10
End If
Next
'' rendering
Render_Opt_Z_Buffer(pos2d(0), pos2d(2), pos2d(1))
Render_Opt_Z_Buffer(pos2d(0), pos2d(2), pos2d(3))
Render_Opt_Z_Buffer(pos2d(1), pos2d(4), pos2d(0))
Render_Opt_Z_Buffer(pos2d(1), pos2d(4), pos2d(5))
Render_Opt_Z_Buffer(pos2d(2), pos2d(5), pos2d(1))
Render_Opt_Z_Buffer(pos2d(2), pos2d(5), pos2d(6))
Render_Opt_Z_Buffer(pos2d(3), pos2d(4), pos2d(0))
Render_Opt_Z_Buffer(pos2d(3), pos2d(4), pos2d(7))
Render_Opt_Z_Buffer(pos2d(4), pos2d(6), pos2d(5))
Render_Opt_Z_Buffer(pos2d(4), pos2d(6), pos2d(7))
Render_Opt_Z_Buffer(pos2d(2), pos2d(7), pos2d(3))
Render_Opt_Z_Buffer(pos2d(2), pos2d(7), pos2d(6))
End Sub
'' ************** MAIN ****************
Do : Cls
Clear_ZBuffer
Flash_It
ASCIICube
If flash Then
Color ,1
Else
Color ,0
End If
Sleep 50
Loop Until multikey(&h01)