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 |
Register
Wiki
Blog
Search
Turing
Chat Room
Members
)
so i get 75min of free time in that class
)