V-FORTH - Forth-83 for the VIC

[funkheld]

Hello thanks for the information.

I wish you a nice holiday

greeting

[funkheld]

Hi good afternoon.

the name ": testcase" has colligated.
without case he must be ": test"

Can you please write me a simple case program for the vforth?

thanks.
greeting

Code: Select all

hex

: case
?comp  csp  @  !csp  4  ;   immediate

: of
4  ?pairs  compile over  compile  =  compile  0branch  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

decimal

: test
.....
.....
....
;

: setze
dup 81 = if  1 . test then 
dup 87 = if  2 . test then 
    69 = if  3 . test then  ;
		
: gehe  
cr  begin
key  setze ?terminal  until  ;

[funkheld]

Hello, good day.

please look here :
Sun Sep 29, 2019 7:17 pm

greeting

[funkheld]

Hi good afternoon.

demo.fs (maze) with autosave does not work anymore with vforth 3.9.

it's running with vforth 3.4.

Greeting

[funkheld]

Plot sinus , cosinus with VForth .

greeting

Code: Select all

variable bxg 
variable byg 

: 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
8048 4352 do 0 i c! loop
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 ;

: text
12 36864 c! 22 36866 c! 174 36867 c! 192 36869 c! ;

: table create does> swap 2* + @ ;
table tsin
0 , 175 , 349 , 523 ,
698 , 872 , 1045 , 1219 ,
1392 , 1564 , 1736 , 1908 ,
2079 , 2250 , 2419 , 2588 ,
2756 , 2924 , 3090 , 3256 ,
3420 , 3584 , 3746 , 3907 ,
4067 , 4226 , 4384 , 4540 ,
4695 , 4848 , 5000 , 5150 ,
5299 , 5446 , 5592 , 5736 ,
5878 , 6018 , 6157 , 6293 ,
6428 , 6561 , 6691 , 6820 ,
6947 , 7071 , 7193 , 7314 ,
7431 , 7547 , 7660 , 7771 ,
7880 , 7986 , 8090 , 8192 ,
8290 , 8387 , 8480 , 8572 ,
8660 , 8746 , 8829 , 8910 ,
8988 , 9063 , 9135 , 9205 ,
9272 , 9336 , 9397 , 9455 ,
9511 , 9563 , 9613 , 9659 ,
9703 , 9744 , 9781 , 9816 ,
9848 , 9877 , 9903 , 9925 ,
9945 , 9962 , 9976 , 9986 ,
9994 , 9998 , 10000 ,

: (sin)
dup 90 > if  180 swap -  then
tsin ;

: sin
360 /mod drop dup 0 < 
if 360 +  then  dup 180 >
if 180 - (sin) negate  else  (sin)  then ;

: cos 360 /mod drop 90 + sin ;

: plotsin
336 0 do i 2 / i sin 70 10000 */ 90 + plot 2 +loop ;

: plotcos
336 0 do i 2 / i cos 70 10000 */ 90 + plot 2 +loop ;

: gehe
grafikscr 
0 bxg c! 0 byg c! plotsin 
0 bxg c! 0 byg c! plotcos key . text ;

[funkheld]

Hi good afternoon.
also text can be represented with 8 bits.
you only have to add 16 bytes per ascii because the graphics are 16 bytes long.

greeting

Code: Select all

variable bxg 
variable byg 

: 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
8048 4352 do 0 i c! loop
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 ;

: text
12 36864 c! 22 36866 c! 174 36867 c! 192 36869 c! ;

: table create does> swap 2* + @ ;
table tsin
0 , 175 , 349 , 523 ,
698 , 872 , 1045 , 1219 ,
1392 , 1564 , 1736 , 1908 ,
2079 , 2250 , 2419 , 2588 ,
2756 , 2924 , 3090 , 3256 ,
3420 , 3584 , 3746 , 3907 ,
4067 , 4226 , 4384 , 4540 ,
4695 , 4848 , 5000 , 5150 ,
5299 , 5446 , 5592 , 5736 ,
5878 , 6018 , 6157 , 6293 ,
6428 , 6561 , 6691 , 6820 ,
6947 , 7071 , 7193 , 7314 ,
7431 , 7547 , 7660 , 7771 ,
7880 , 7986 , 8090 , 8192 ,
8290 , 8387 , 8480 , 8572 ,
8660 , 8746 , 8829 , 8910 ,
8988 , 9063 , 9135 , 9205 ,
9272 , 9336 , 9397 , 9455 ,
9511 , 9563 , 9613 , 9659 ,
9703 , 9744 , 9781 , 9816 ,
9848 , 9877 , 9903 , 9925 ,
9945 , 9962 , 9976 , 9986 ,
9994 , 9998 , 10000 ,

: (sin)
dup 90 > if  180 swap -  then
tsin ;

: sin
360 /mod drop dup 0 < 
if 360 +  then  dup 180 >
if 180 - (sin) negate  else  (sin)  then ;

: cos 360 /mod drop 90 + sin ;

: plotsin
336 0 do i 2 / i sin 70 10000 */ 90 + plot 2 +loop ;

: plotcos
336 0 do i 2 / i cos 70 10000 */ 90 + plot 2 +loop ;

: gehe
grafikscr 
0 bxg c! 0 byg c! plotsin 
0 bxg c! 0 byg c! plotcos
8 0 do i 32768 + 8 + c@ 4352 i + c! loop 
5 37888 c!
8 0 do i 32768 + 16 + c@ 4352 16 + i + c! loop 
3 37889 c!
8 0 do i 32768 + 24  + c@ 4352 32 + i + c! loop 
0 37890 c!
key . text ;

[srowe]

Well done with the curve plotting. I started a hires pixel vocabulary just before I went on holiday.

Where did you get the sine table from? I want to add a maths vocabulary but I couldn't find a fixed point implementation when I looked a while ago.

[funkheld]

Hi good afternoon.
I found it here on the internet.
do not find the address more.

greeting

Code: Select all

: table create does> swap 2* + @ ;
table tsin
0 , 175 , 349 , 523 ,
698 , 872 , 1045 , 1219 ,
1392 , 1564 , 1736 , 1908 ,
2079 , 2250 , 2419 , 2588 ,
2756 , 2924 , 3090 , 3256 ,
3420 , 3584 , 3746 , 3907 ,
4067 , 4226 , 4384 , 4540 ,
4695 , 4848 , 5000 , 5150 ,
5299 , 5446 , 5592 , 5736 ,
5878 , 6018 , 6157 , 6293 ,
6428 , 6561 , 6691 , 6820 ,
6947 , 7071 , 7193 , 7314 ,
7431 , 7547 , 7660 , 7771 ,
7880 , 7986 , 8090 , 8192 ,
8290 , 8387 , 8480 , 8572 ,
8660 , 8746 , 8829 , 8910 ,
8988 , 9063 , 9135 , 9205 ,
9272 , 9336 , 9397 , 9455 ,
9511 , 9563 , 9613 , 9659 ,
9703 , 9744 , 9781 , 9816 ,
9848 , 9877 , 9903 , 9925 ,
9945 , 9962 , 9976 , 9986 ,
9994 , 9998 , 10000 ,

: (sin)
dup 90 > if  180 swap -  then
tsin ;

: sin
360 /mod drop dup 0 <
if 360 +  then  dup 180 >
if 180 - (sin) negate  else  (sin)  then ;

: cos 360 /mod drop 90 + sin ;

[srowe]

Looks like it might be from Quartus Forth?

http://mathforum.org/library/drmath/view/62672.html

[J.E.E.K.]

Well done with the curve plotting. I started a hires pixel vocabulary just before I went on holiday.

Where did you get the sine table from? I want to add a maths vocabulary but I couldn't find a fixed point implementation when I looked a while ago.

Anyone who likes Perl might be happy with this:

Code: Select all

perl -e '$pi=4*atan2(1,1); for my $i (0..90){printf "%d , ", (sin($i*$pi/180)*10000)+0.5;print "\n" if ($i % 4) == 3}'

[funkheld]

-------------------------------
Looks like it might be from Quartus Forth?
-------------------------------

hmm .. I think so. #

hello : demo.fs (maze) with autosave does not work anymore with vforth 3.9.
it's running with vforth 3.4.

greeting

[srowe]

hello : demo.fs (maze) with autosave does not work anymore with vforth 3.9.
it's running with vforth 3.4.

I made a change over a year ago that will have made it stop working. I can't remember why I did that, I'll try and work out how to fix it.

[srowe]

Anyone who likes Perl might be happy with this:

Code: Select all

perl -e '$pi=4*atan2(1,1); for my $i (0..90){printf "%d , ", (sin($i*$pi/180)*10000)+0.5;print "\n" if ($i % 4) == 3}'

I wouldn't normally use "perl" and "happy" in the same sentence these days but that's great. I assume the values are /1000?

[srowe]

Where did you get the sine table from? I want to add a maths vocabulary but I couldn't find a fixed point implementation when I looked a while ago.

Actually I just found a code branch from a year ago where I had created a trig vocabulary from an article in Forth Dimensions V4 N1.

[srowe]

I've just uploaded a new 4.0 release

• fixed 0>
• fixed autosave
• fixed conditional include
• added trig module
• new graphics modules, graphics-usr for user defined characters, graphics-hires for point plotting

Try

Code: Select all

include demo-graphics.fs
plotsin

to see an example of hires graphics.