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)
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-Share Alike 2.5 License.