V-FORTH - Forth-83 for the VIC

[funkheld]

Hi good afternoon.

i need please 2 zeropageadressen, which can I use in vforth?

thanks.
greeting

[srowe]

i need please 2 zeropageadressen, which can I use in vforth?

This document explains the usage of zero page

https://eden.mose.org.uk/gitweb/?p=vfor ... xt;hb=HEAD

There are 24 bytes from 0x78 to 0x8F that are labelled as zpad, these are free for you to use.

[srowe]

can you please show me how to move a byte bitwise to another byte?
I want to move 8 bytes from char "A" to char "B".
char "A" is then empty and char "B" is then "A".

I guess you mean you have characters "A" and "B" next to each other on the screen and you want to scroll the character definition of "A" into "B" one pixel at a time.

As we are moving from left to right we need to right shift the eight bytes of "A" into the eight bytes of "B". Each byte of "A" is put in the top byte of a 16-bit integer and the byte of "B" in the bottom byte and then the integer shifted right. The two parts of the integer are then stored back from where they came

Code: Select all

achar c@  8  lshift  bchar  c@  or  ( A in MSB, B in LSB )
1 rshift
dup  255  and  bchar  c!  ( store shifted B)
8  rshift  achar  c!  ( store shifted A )

how can you merge 2 bytes into one word and after shiften you can separate the word again into 2 bytes?

Merging is easy, that's an OR operation of each of the eight bytes. To overlay a sprite over a background (or other sprites) requires double buffering. You need memory that holds each sprite and then merges them on to the actual display memory. I'm not really familiar with the process of doing that, people like Pixel will be far more knowledgeable.

[funkheld]

hello, thanks.

it comes out a wrong value at bchar.

thanks.
greeting

Code: Select all

variable achar
variable bchar

: msblsb
128 achar c! 0 bchar c!
achar c@ 8 lshift bchar c@ or 
1 rshift 
dup 255 and bchar c!
8 rshift achar c!
achar c@ . bchar c@ . ;

[srowe]

You only have the top bit of achar set, try using 129 instead.

[funkheld]

ok , thanks.
my mistake

thank you for your help.
Now how do you move 8 bit from left (bchar) to right to achar?

thanks.
greeting

[funkheld]

Hi good afternoon.
I play with vforth.com in the Vic20

the first start with a sprite is done.
in "A" is the sprite and "B" is empty.
sprite wanders to the right and wanders to the left.

press button "A" 8 x sprite moves to the right
press button "B" 8 x sprite moves to the left.

greeting

Code: Select all

variable charbase
variable z
variable achar
variable bchar
variable aadr
variable badr

5120 charbase !
8192 constant ramhi
32768 constant charset1

create daten
255 c,  129  c, 129  c,  129 c,  129  c,  129  c,  129  c,  255  c,
0 c,  0 c, 0  c,  0 c,  0  c,  0  c,  0  c,  0  c,

: redefset  
charbase  @  ramhi  over  -  cmove
charbase  @  charbase !  ;

: cls
511 0 do 32 i 4096 + c! loop 
0 0 $plot ;

: shiftre
8 0 do
aadr @ 8 + i + c@ achar c!  badr @ 16 + i + c@ bchar c!
achar c@ 8 lshift bchar c@ or 1 rshift 
dup 255 and bchar c!
8 rshift achar c! 
achar c@ i aadr @ 8 + + c!
bchar c@ i badr @ 16 + + c! 
loop ;

: shiftli
8 0 do
badr @ 8 + i + c@ bchar c!  aadr @ 16 + i + c@ achar c!
bchar c@ 8 lshift achar c@ or 1 lshift 
dup 255 and bchar c!
8 rshift achar c! 
achar c@ i aadr @ 8 + + c!
bchar c@ i badr @ 16 + + c! 
loop ;

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

: setze
dup 65 = if shiftre then  
66 = if shiftli then ;

: gehe 
charset1 redefset 
205 36869 c!
0 z c!

cls
0 0 $plot 65 emit 1 0 $plot 66 emit
16 0 do daten i + c@ 5128 i + c! loop 
5120 aadr ! 5120 badr ! 

begin
key  setze ?terminal
until ;

[srowe]

Well done, you seem to be getting the hang of decomposing the problem into pieces so that the words you write are simple and clear to understand.

[funkheld]

Hi good afternoon.

there is not a simple solution for this:
lsr $1200
ror $1201

this is too complicated:
: shiftre
16 0 do
aadr @ i + c@ achar c! badr @ 16 + i + c@ bchar c!
achar c@ 8 lshift bchar c@ or 1 rshift
dup 255 and bchar c!
8 rshift achar c!
achar c@ i aadr @ + c!
bchar c@ i badr @ 16 + + c!
loop ;

greeting

[srowe]

Doing shifts direct to memory isn't really possible because the instructions don't support any indirect addressing modes. It can be done fairly easy using the accumulator however

Code: Select all

include assembler.fs

code rscroll  ( addr1 addr2  --  )
    sec x) lda,  .a lsr,  sec x) sta,
    bot x) lda,  .a ror,  bot x) sta,
    poptwo jmp,
    end-code

code lscroll  ( addr1 addr2  --  )
    bot x) lda,  .a asl,  bot x) sta,
    sec x) lda,  .a rol,  sec x) sta,
    poptwo jmp,
    end-code

These words shift the contents of each address to the other address, rscroll shifts the bottom bit of addr1 into the top bit of addr2 and lscroll shifts the top bit of addr2 into the top bit of addr1.

[funkheld]

hello , thanks for the help.

greeting.

[funkheld]

Hi good afternoon

I would like to save the vforth with my game program.

When I start vforth, I would like to start my game then.

thanks.
greeting

[srowe]

I would like to save the vforth with my game program.

When I start vforth, I would like to start my game then.

You can save the dictionary so that it will automatically start a specific word

Code: Select all

include autosave.fs
' myword autosave filename

You load it back like this

Code: Select all

dload filename

[funkheld]

hello thanks is ok.

greeting

[funkheld]

Hi good afternoon.

it breaks off with Joy. the joy works.

what is going on in the begin ... until?
why is the stack emty ?

i wrote something that works with the keys is ok .
begin
key setze ?terminal until ;

------------------------------------------------------
: setze
oyb @ 22 * oxb @ + pw ! 32 sw @ pw @ + c!
oyb @ 1 + 22 * oxb @ + pw ! 32 sw @ pw @ + c!
dup 81 = if xb @ 1 - xb ! then xb @ 0 < if 0 xb ! then
dup 69 = if xb @ 1 + xb ! then xb @ 21 > if 21 xb ! then
dup 87 = if yb @ 1 - yb ! then yb @ 0 < if 0 yb ! then
dup 83 = if yb @ 1 + yb ! then yb @ 21 > if 21 yb ! then
dup 82 = if fb @ 1 + fb ! then fb @ 7 > if 7 fb ! then
70 = if fb @ 1 - fb ! then fb @ 0 < if 0 fb ! then
--------------------------------------------------------
thanks
greeting


why is the stack emty ?

Code: Select all

variable xb 
variable yb 
variable fb 
variable pw
variable sw 
variable cw
variable oxb 
variable oyb 
variable test1
variable test2
variable test3

variable charbase
variable z

5120 charbase !
8192 constant ramhi
32768 constant charset1

hex
: joy
1  9122  c@  dup  7f  and  9122  c!  
9120  c@  
swap  9122  c!  
80  and  if  1-  then
9111  c@  >r  r@  10  and  0=  if  drop  -1  then
0  r@  4  and  0=  if  1-  else  r@  8  and  0=  if  1+  then  then
1  r>  20  and  if  1-  then  ;
decimal

create daten
24  c,  24  c,  60  c,  126  c,  255  c,  24  c,  36  c,  66  c,
255 c,  129  c, 129  c,  129 c,  129  c,  129  c,  129  c,  255  c,

: redefset  
charbase  @  ramhi  over  -  cmove
charbase  @  charbase !  ;

: cls
511 0 do 32 i 4096 + c! loop 
0 0 $plot ;

: setze
oyb @ 22 * oxb @ + pw ! 32 sw @ pw @ + c!
oyb @ 1 + 22 * oxb @ + pw ! 32 sw @ pw @ + c!
test1 c@ 255 = if xb @ 1 - xb !  then  xb @ 0 < if 0  xb !  then  
test1 c@ 1   = if xb @ 1 + xb !  then  xb @ 21 > if 21 xb ! then  
test2 c@ 255 = if yb @ 1 - yb !  then  yb @ 0 < if 0  yb !  then 
test2 c@ 1   = if yb @ 1 + yb !  then  yb @ 21 > if 21 yb ! then

xb @ oxb c! yb @ oyb c!

yb @ 22 * xb @ + pw ! 
1 sw @ pw @ + c!
fb @ cw @ pw @ + c!

yb @ 1 + 22 * xb @ + pw ! 
0 sw @ pw @ + c!
fb c@ cw @ pw @ + c! ;

: gehe 
charset1 redefset 
205 36869 c!
16 0 do daten i + c@ 5120 i + c! loop 

4096 sw !
37888 cw !

10 yb !  10 xb  ! 5 fb !
xb @ oxb ! yb @ oyb !

cls
setze

begin
joy test3 c! test2 c! test1 c! 
setze
until ;

joy is ok !!!!!!

Code: Select all

variable test1
variable test2
variable test3

hex
: joy
1  9122  c@  dup  7f  and  9122  c!  
9120  c@  
swap  9122  c!  
80  and  if  1-  then
9111  c@  >r  r@  10  and  0=  if  drop  -1  then
0  r@  4  and  0=  if  1-  else  r@  8  and  0=  if  1+  then  then
1  r>  20  and  if  1-  then  ;
decimal

: gehe 
begin
key drop joy test3 c! test2 c! test1 c! ?terminal 
test1 c@ 255 = if ." links" cr then
test1 c@ 1 = if ." rechts" cr then

test2 c@ 255 = if ." hoch" cr then
test2 c@ 1 = if ." runter" cr then

test3 c@ 1 = if ." feuer" cr then
until  ;