Programming C, C++, Java, PHP, Ruby, Turing, VB
Computer Science Canada 
Programming C, C++, Java, PHP, Ruby, Turing, VB  

Username:   Password: 
 RegisterRegister   
 [source] ASCII
Index -> Programming, Turing -> Turing Submissions
View previous topic Printable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic
Author Message
Catalyst




PostPosted: Wed Oct 08, 2003 6:30 pm   Post subject: [source] ASCII

Once again compsci class proves to be very dull (weve made it to the draw functions Laughing )

so i made this
(used to use locate but font.draw is faster)

code:
setscreen ("offscreenonly,nobuttonbar,graphics:480;480,position:500;500")
cls
module ASCII

    export all
    const maxchar := 255
    var letterDensity : array 1 .. maxchar of real

    fcn GetLetterDensity (c : char) : real
        cls
        var total : real := 0
        color (7)
        colorback (0)
        put c
        View.Update
        for x : 1 .. 8
            for y : maxy - 12 .. maxy
                if (whatdotcolor (x, y) = 7) then
                    total += 1
                end if
            end for
        end for
        result total / (8 * 12)
    end GetLetterDensity

    var hold : int

    fcn GetRow (y : int) : int
        hold := (y div 12)
        if (hold >= 1 and hold <= maxrow) then
            result hold
        else
            result 1
        end if
    end GetRow

    fcn GetCol (x : int) : int
        hold := (x div 8)
        if (hold >= 1 and hold <= maxcol) then
            result hold
        else
            result 1
        end if
    end GetCol

    proc Init
        for i : 1 .. maxchar
            letterDensity (i) := GetLetterDensity (chr (i))
        end for
    end Init
    proc Swap (var x : int, var y : int)
        hold := x
        x := y
        y := hold
    end Swap

    fcn InWindow (x : int, y : int) : boolean
        result (x >= 0 and x <= maxx) and (y <= maxx and y >= 12)
    end InWindow

    var font : int := Font.New ("arial:10:bold")

    proc DrawLine (x, y, x2, y2 : int, c : char)


        var steep : boolean := true
        var sx, sy, dx, dy : int
        var e : real
        var x0, y0, x1, y1 : int
        var hold : int
        x0 := x
        y0 := y
        x1 := x2
        y1 := y2

        dx := abs (x1 - x0)
        if ((x1 - x0) > 0) then
            sx := 1
        else
            sx := -1
        end if
        if ((y1 - y0) > 0) then
            sy := 1
        else
            sy := -1
        end if

        dy := abs (y1 - y0)
        if (dy > dx) then
            steep := false
            Swap (x0, y0)
            Swap (dx, dy)
            Swap (sx, sy)
        end if
        e := round (dy shl 1) - dx
        for i : 0 .. dx by 10
            if (steep) then
                %locate (GetRow (maxy - y0), GetCol (x0))
                % put c ..
                Font.Draw (c, x0, y0, font, 7)
            else
                %locate (GetRow (maxy - x0), GetCol (y0))
                % put c
                Font.Draw (c, y0, x0, font, 7)
            end if
            loop
                if (e >= 0) then
                    y0 += sy * 10
                    e -= (dx shl 1) * 10
                else
                    exit
                end if
            end loop
            x0 += sx * 10
            e += (dy shl 1) * 10

        end for

    end DrawLine


end ASCII

ASCII.Init
var x, y, z : int
loop
    mousewhere (x, y, z)


    ASCII.DrawLine (x - 50, y - 50, x - 50, y + 50, '#')
    ASCII.DrawLine (x + 50, y - 50, x + 50, y + 50, '#')

    ASCII.DrawLine (x - 50, y - 50, x + 50, y - 50, '#')
    ASCII.DrawLine (x - 50, y + 50, x + 50, y + 50, '#')


         ASCII.DrawLine (x + 50, y + 50, maxx, maxy, '*')
         ASCII.DrawLine (x - 50, y - 50, 0, 0, '$')
         ASCII.DrawLine (x + 50, y - 50, maxx, 0, '@')
         ASCII.DrawLine (x - 50, y + 50, 0, maxy, '!')


    View.Update
    cls
end loop
Sponsor
Sponsor
Sponsor
sponsor
Homer_simpson




PostPosted: Wed Oct 08, 2003 6:50 pm   Post subject: (No subject)

hehehe...
still messing with turing... u got too much time man...
nice
Tony




PostPosted: Wed Oct 08, 2003 8:34 pm   Post subject: (No subject)

crazy Laughing
Latest from compsci.ca/blog: Tony's programming blog. DWITE - a programming contest.
Catalyst




PostPosted: Wed Oct 08, 2003 8:48 pm   Post subject: (No subject)

i still have to mess with turing... thats the langage used in ICS3M at my school Evil or Very Mad so i get 75min of free time in that class
Mazer




PostPosted: Wed Oct 08, 2003 10:24 pm   Post subject: (No subject)

hey, you should make an ascii 3d renderer. i saw something like that on the crystal space 3d page. it's totally useless, but kinda cool. (just like turing... except for the cool part Wink )
Display posts from previous:   
   Index -> Programming, Turing -> Turing Submissions
View previous topic Tell A FriendPrintable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic

Page 1 of 1  [ 5 Posts ]
Jump to:   


Style:  
Search: