V-FORTH - Forth-83 for the VIC

[srowe]

Having the actual file is important. There might be some control characters in it.

[funkheld]

this is the text with notepad++ .

greeting

[srowe]

Here's a module that draws lines using the usual Bresenham algorithm

Code: Select all

vocabulary draw immediate
draw definitions

variable lastx
0 lastx !
variable lasty
0 lasty !

variable plotw

variable x1
variable y1
variable dx
variable dy
variable sx
variable sy
variable err

: goto    ( x y  --  )
    lasty  !  lastx  !  ;

: lineto    ( x y  --  )
    y1  !  x1  !
    x1  @  lastx  @  -  abs  dx  !
    lastx  @  x1  @  <  if  1  else  -1  then  sx  !
    y1  @  lasty  @  -  abs  dy  !
    lasty  @  y1  @  <  if  1  else  -1  then  sy  !
    dx  @  dy  @  >  if  dx  @  else  dy  @  negate  then  2/  err  !
    begin
	lastx  @  lasty  @  plotw  @  execute   ( plot point )
	lastx  @  x1  @  xor  lasty  @  y1  @  xor  or  while
	    err  @  dup  dx  @  negate  >  if  dy  @  negate err  +!  sx  @  lastx  +!  then
	    dy  @  <  if  dx  @  err  +!  sy  @  lasty  +!  then
    repeat ;

forth definitions

It uses a variable to execute the word that actually plots the point, just replace plotw @ execute with plot if you don't want that.

It uses rather a lot of variables, I did test another implementation that kept lastx and lasty on the stack but it was slower.

[funkheld]

Hi good afternoon.

thank you for your help.

how is goto and lineto recognized now?

MSG # 19 ist the error.

greeting

Code: Select all

vocabulary draw immediate
draw definitions

variable lastx
0 lastx !
variable lasty
0 lasty !

variable x1
variable y1
variable dx
variable dy
variable sx
variable sy
variable err

: goto
    lasty  !  lastx  !  ;

: lineto
    y1  !  x1  !
    x1  @  lastx  @  -  abs  dx  !
    lastx  @  x1  @  <  if  1  else  -1  then  sx  !
    y1  @  lasty  @  -  abs  dy  !
    lasty  @  y1  @  <  if  1  else  -1  then  sy  !
    dx  @  dy  @  >  if  dx  @  else  dy  @  negate  then  2/  err  !
    begin
	lastx  @  lasty  @  plot  @  execute   ( plot point )
	lastx  @  x1  @  xor  lasty  @  y1  @  xor  or  while
	    err  @  dup  dx  @  negate  >  if  dy  @  negate err  +!  sx  @  lastx  +!  then
	    dy  @  <  if  dx  @  err  +!  sy  @  lasty  +!  then
    repeat ;

forth definitions

: getbad
dup  16  /  336  *  swap  15  and  +
swap  8  /  16  *  +  4352  +  ;

create bmask
128  c,  64  c,  32  c,  16  c,  8  c,  4  c,  2  c,  1  c,

: plot
over  swap
getbad  swap  7  and  bmask  +  c@ over  c@ or  swap  c!  ;

: unplot
over  swap
getbad  swap  7  and  bmask  +  c@ not over  c@ and  swap  c!  ;

: xplot
over  swap
getbad  swap  7  and  bmask  +  c@ over  c@ xor  swap  c!  ;

: ti 200 0 do loop ;

: grafikscr
4352 3696 0 fill
151 36867 c! 21 36866 c! 204 36869 c! 14 36864 c!
255 16 do i i 4096 16 - + c! loop
255 16 do 6 i 37888 16 - + c! loop ;

: linetest
20 20 goto
150 30 lineto ;

: gehe
grafikscr 

begin
ti
197 c@ 
dup 17 = if linetest then  
dup 18 = if then  
dup 10 = if then 
    42 = if then
?terminal 
until  ;

[srowe]

If you are going to call plot directly you will have to define lineto after it and change

Code: Select all

lastx  @  lasty  @  plot  @  execute   ( plot point )

to just be

Code: Select all

lastx  @  lasty  @  plot   ( plot point )

[srowe]

Latest release, 4.1, now has the INTERRUPT module along with LOWRES and MULTICOL graphics modules.

[funkheld]

Hi good afternoon.

thanks for your vforth 1.4.1.
thanks for your lineto.

I don't know how to get lineto up and running.
can you please, please put it in the below of my program without "definitions ...?.
just in there to make it work.

Thank you.
greeting

Code: Select all

: getbad
dup  16  /  336  *  swap  15  and  +
swap  8  /  16  *  +  4352  +  ;

create bmask
128  c,  64  c,  32  c,  16  c,  8  c,  4  c,  2  c,  1  c,

: plot
over  swap
getbad  swap  7  and  bmask  +  c@ over  c@ or  swap  c!  ;

: grafikscr
4352 3696 0 fill
151 36867 c! 21 36866 c! 204 36869 c! 14 36864 c!
255 16 do i i 4096 16 - + c! loop
255 16 do 6 i 37888 16 - + c! loop ;

: gehe
grafikscr

begin
ti
197 c@ 17 = if  then  
?terminal 
until  ;

[srowe]

Add this immediately before grafikscr

Code: Select all

variable lastx
0 lastx !
variable lasty
0 lasty !

variable x1
variable y1
variable dx
variable dy
variable sx
variable sy
variable err

: goto    ( x y  --  )
    lasty  !  lastx  !  ;

: lineto    ( x y  --  )
    y1  !  x1  !
    x1  @  lastx  @  -  abs  dx  !
    lastx  @  x1  @  <  if  1  else  -1  then  sx  !
    y1  @  lasty  @  -  abs  dy  !
    lasty  @  y1  @  <  if  1  else  -1  then  sy  !
    dx  @  dy  @  >  if  dx  @  else  dy  @  negate  then  2/  err  !
    begin
	lastx  @  lasty  @  plot   ( plot point )
	lastx  @  x1  @  xor  lasty  @  y1  @  xor  or  while
	    err  @  dup  dx  @  negate  >  if  dy  @  negate err  +!  sx  @  lastx  +!  then
	    dy  @  <  if  dx  @  err  +!  sy  @  lasty  +!  then
    repeat ;

[funkheld]

is not possible yet.

now I did it once as you intended
With :
vocabulary draw immediate
draw definitions

Thank you.
greeting

Code: Select all

vocabulary draw immediate
draw definitions

variable lastx
0 lastx !
variable lasty
0 lasty !

variable x1
variable y1
variable dx
variable dy
variable sx
variable sy
variable err

: getbad
dup  16  /  336  *  swap  15  and  +
swap  8  /  16  *  +  4352  +  ;

create bmask
128  c,  64  c,  32  c,  16  c,  8  c,  4  c,  2  c,  1  c,

: plot
over  swap
getbad  swap  7  and  bmask  +  c@ over  c@ or  swap  c!  ;

: goto    ( x y  --  )
    lasty  !  lastx  !  ;

: lineto    ( x y  --  )
    y1  !  x1  !
    x1  @  lastx  @  -  abs  dx  !
    lastx  @  x1  @  <  if  1  else  -1  then  sx  !
    y1  @  lasty  @  -  abs  dy  !
    lasty  @  y1  @  <  if  1  else  -1  then  sy  !
    dx  @  dy  @  >  if  dx  @  else  dy  @  negate  then  2/  err  !
    begin
	lastx  @  lasty  @   plot 
	lastx  @  x1  @  xor  lasty  @  y1  @  xor  or  while
	    err  @  dup  dx  @  negate  >  if  dy  @  negate err  +!  sx  @  lastx  +!  then
	    dy  @  <  if  dx  @  err  +!  sy  @  lasty  +!  then
    repeat ;

forth definitions

Code: Select all

include draw.fs
draw

: ti 500 0 do loop ;

: grafikscr
4352 3696 0 fill
151 36867 c! 21 36866 c! 204 36869 c! 14 36864 c!
255 16 do i i 4096 16 - + c! loop
255 16 do 6 i 37888 16 - + c! loop ;

: gehe
grafikscr 
ti
10 10 goto
100 80 lineto
key drop ;

[srowe]

Try this file

Code: Select all

: getbad
dup  16  /  336  *  swap  15  and  +
swap  8  /  16  *  +  4352  +  ;

create bmask
128  c,  64  c,  32  c,  16  c,  8  c,  4  c,  2  c,  1  c,

: plot
over  swap
getbad  swap  7  and  bmask  +  c@ over  c@ or  swap  c!  ;

variable lastx
0 lastx !
variable lasty
0 lasty !

variable x1
variable y1
variable dx
variable dy
variable sx
variable sy
variable err

: goto    ( x y  --  )
    lasty  !  lastx  !  ;

: lineto    ( x y  --  )
    y1  !  x1  !
    x1  @  lastx  @  -  abs  dx  !
    lastx  @  x1  @  <  if  1  else  -1  then  sx  !
    y1  @  lasty  @  -  abs  dy  !
    lasty  @  y1  @  <  if  1  else  -1  then  sy  !
    dx  @  dy  @  >  if  dx  @  else  dy  @  negate  then  2/  err  !
    begin
	lastx  @  lasty  @  plot   ( plot point )
	lastx  @  x1  @  xor  lasty  @  y1  @  xor  or  while
	    err  @  dup  dx  @  negate  >  if  dy  @  negate err  +!  sx  @  lastx  +!  then
	    dy  @  <  if  dx  @  err  +!  sy  @  lasty  +!  then
    repeat ;

: grafikscr
4352 3696 0 fill
151 36867 c! 21 36866 c! 204 36869 c! 14 36864 c!
255 16 do i i 4096 16 - + c! loop
255 16 do 6 i 37888 16 - + c! loop ;

: linetest
20 20 goto
150 30 lineto ;

: gehe
grafikscr 

begin
197 c@ 
dup 17 = if linetest then  
dup 18 = if then  
dup 10 = if then 
    42 = if then
?terminal 
until  ;

[funkheld]

it is not yet.
I'll leave it alone for now.

something is disrupting the process.
maybe it comes from the lineto routine?

Thank you.
greeting

[funkheld]

Hi good afternoon.

how does vforth work:
"case, endcase, of, endof" please

can you please create an example?

Thank you.
greeting

[srowe]

Hi good afternoon.

how does vforth work:
"case, endcase, of, endof" please

can you please create an example?

Thank you.
greeting

I've not included an implementation of case mainly due to space. There are many different definitions the simplest from Forth Dimensions V2N3 is this

Code: Select all

: case
    ?comp  csp  @  !csp  4  ;   immediate

: of
    4  ?pairs  compile over  compile  =  compile  ?branch  here  0  ,
    compile  drop  5  ;   immediate

: endof
    5  ?pairs  compile  branch  here  0  ,  swap  2  [compile]  then
    4  ;   immediate

: endcase
    4  ?pairs  compile  drop  begin  sp@  csp  @  =  0=  while
	    2  [compile]  then  repeat  csp  !  ;   immediate


: demo
    begin
	key
	case
	    65  of  ." a"  endof
	    66  of  ." b"  endof
	    67  of  ." c"  endof
	    ." ?"
	endcase
	?terminal  until  ;

[funkheld]

Hello, thanks for your help.

but it doesn't work.
Thank you.
greeting

[srowe]

You're again having some encoding issues, I cut-and-pasted that from a file that I tested.