Line drawing routines for forth

For this to work, you'll need write access to the frame buffer. And you'll need to tweak it a bit so it can work with the resolution and bit depth of your display.

I think this is basically the Breshenham algorithm. I tweaked the setup a bit to get more accurate lines (not sure if these tweaks are part of the Breshenham algorithm.)

\ This file contains the functions to:
\
\ * manage a buffer, and write it to /dev/fb/0
\ * draw colored lines
\ * clear the screen
\
\
\ To set this up you must do the following:
\
\ * set width to the width of your framebuffer (number of pixels)
\ * set pixel to the number of bytes in a pixel
\ * rewrite pixel! to store a pixel (it now works only on Big Endian machines in 15 or 16 bit color)
\ * make sure your forth system has enough memory. with gforth do:
\       gforth -m <number of bytes>
\
\ And will probably want to:
\
\ * set height to the number of lines your pixel buffer will be (this will be displayed at the top of the screen)
\ * rewrite rgb to pack your pixel format if you want (type fbset at the terminal and it tells you your pixel format)
\
\ EXAMPLE CODE
\
\ See the word "test" at the bottom for a good test and example.


1280 constant width \ CHANGE THIS
1024 constant height \ CHANGE THIS

4 constant pixel  \ Size (in bytes) of a pixel CHANGE THIS
: pixels 4 * ; \ CHANGE THIS
: pixel! ( pixel addr --     store a pixel )
	! ;    \ CHANGE THIS

variable color -1 color !

: rgb ( r g b --   set color from rgb)
	swap 8 lshift + \ CHANGE THIS
	swap 16 lshift +
	color ! ;




create buff width height * pixels dup allot
constant buff-size

: assert dup if . abort" <---file error" then drop ;

s" /dev/fb/0" w/o open-file assert constant file   \ FIX: error detection etc.

: write-buffer buff buff-size file write-file assert file flush-file assert 0 0 file reposition-file assert ;
: clear buff buff-size 4 / 0 do 0 over ! 4 + loop drop ;

clear

variable x 0 x !
variable y 0 y !


: c2a ( x y -- addr   convert x,y to pixel address)
	1+ height swap -  \ invert y
	width * + pixels buff + ;
: setpixel ( x y --   colors pixel at x,y)
	c2a color @ swap pixel! ;

: moveto y ! x ! ;


width pixels constant linebytes

variable h
variable w
variable c
variable r
variable d
variable startx
variable starty

: setxy ( x y -- )
	x @ startx !
	y @ starty !
	y ! x ! ;
: sethw
	x @ startx @ - w !
	y @ starty @ - h ! ;
: line-defaults ( x y -- )
	setxy
	sethw
	pixel r !
	0 linebytes - d ! ;
: r-l ( --  change control variables for line if line is going right)
	w @ 0 < if x @ startx ! y @ starty ! w @ -1 * w ! h @ -1 * h ! then ;
: u-d ( --  change control variables for line if line is going up)
	h @ 0 < if linebytes d ! h @ -1 * h ! then ;
: h-v ( --  change control variables if line is predominantly verticle)
	h @ w @ > if h @ w @ h ! w !  r @ d @ r ! d ! then ;
: pinit ( x y --   setup variables for drawing line to x,y)
	line-defaults r-l u-d h-v ;

: cinit ( --   set c to w, then double w and h)
	w @ 1+ 2 / c ! ;

: line-setup ( x y -- addr "w"   setup everything for line)
	pinit
	startx @ starty @ c2a w @ cinit ;

: w- ( h+c --   decrement c by w)
	w @ - c ! ;

: right ( addr -- addr2  move the pixel address "right")
	r @ + ;

: down ( addr -- addr2  move the pixel address "down")
	d @ + ;

: slant? ( -- h+c w>? )
	c @ h @ + dup w @ > ;

: colorit ( addr --   color the pixel at addr)
	color @ swap pixel! ;

: nextp ( addr -- addr2  move addr to the next pixel in the line. use h, w, and c)
	right slant? if w- down else c ! then ;

: lineto ( x y )
	line-setup over colorit 0 do nextp dup colorit loop drop ;



\ INTERACTIVE COMMANDS (Only useful for calling directly)
\ see also: rgb moveto clear

: l ( x y --   draw a line to x,y)
	lineto write-buffer ;

: test ( spacing --   spacing=how far to spread the lines out. try 12)
	clear
	width height min 1 - over / over *
	\ stack: spacing width
	dup 1+ 0 do 0 i moveto dup i - 0 lineto over +loop
	dup 1+ 0 do i over moveto 0 i lineto over +loop
	dup 1+ 0 do dup dup i - moveto i over lineto over +loop
	2drop
	write-buffer ;