vforth 1.5 is wonderful for the next.

Discuss game and other programming topics not specifically covered in another forum

Moderator: Programming Moderators

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Mon Sep 27, 2021 12:07 pm

thanks for the information.

now at the end coded to : 0d 0a.

it works now.

greeting

User avatar
Mmattsteel
Posts: 31
Joined: Wed May 31, 2017 5:38 am
Location: Venice Italy
Contact:

Re: vforth 1.5 is wonderful for the next.

Postby Mmattsteel » Mon Sep 27, 2021 12:50 pm

Mmattsteel wrote: Mon Sep 27, 2021 8:50 am
funkheld wrote: Mon Sep 27, 2021 7:17 am hello, this error occurs again.

is it the text editor?
i have notepad ++.

what do you have to consider when entering the text? indentation, spaces ....?

thanks.
greeting
Besides the "empty line" at the end of the file and the maximum length of 510 characters per line, maybe some issue could araise from the encoding, since the file should be encoded as "ASCII 7-bit" with 0x0A or 0x0D as line-terminator.

Sorry, I need to see your .f file.
Send it me privately.

_M.
A workaround is to put a QUIT at the end of file: this immediately stops compilation of source file.
_M.
Matteo.
Backer #1227. ZX Spectrum+ m/c programmer since 1985.
Take a look to https://github.com/mattsteeldue/vforth-next

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Mon Sep 27, 2021 2:05 pm

thank you, the program is running and it works.
I coded it with 0d0a.

greeting
Attachments
fehler3.jpg
fehler3.jpg (103.8 KiB) Viewed 462 times

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Wed Sep 29, 2021 5:47 pm

hello, this is layer2 plot line with floating.

greeting

Code: Select all

needs value
needs to   
needs LAYERS
needs floating

floating
 
 0 value wx 0 value wy 
 0 value grad
 0 value color

 HEX
 : pixeladd ( x y -- a )
   over 5 rshift          
   12 reg@ 2* + mmu7!    
   swap 01F and           
   8 lshift +             
   E000 or                
   ;
decimal
     
: test
  LAYER2
  cls
   
  360 0 do 
    80 0 do 
      grad float deg>rad fsin i float f* fint drop to wx
      grad float deg>rad fcos i float f* fint drop to wy
      color 100 wy + 120 wx + pixeladd c!
    loop    
    grad 10 + to grad
    color 7 + to color
  10 +loop   
  
  0 to grad
 ;
 

with your sine-cosine table it's even faster.

Code: Select all

NEEDS VALUE 
needs to   
needs LAYERS

471 load

 0 value wx 0 value wy 
 0 value grad
 0 value color

 HEX
 : pixeladd ( x y -- a )
   over 5 rshift          
   12 reg@ 2* + mmu7!    
   swap 01F and           
   8 lshift +             
   E000 or                
   ;
decimal

2 constant cell
: sinus@ cell * sine-table + @ ;

: sin 
  dup >r 
  abs 360 mod
  dup 180 > if 180 - -1 else 0 then >r
  dup 90 > if 180 swap - then
  sinus@
  r> +- 
  r> +-  ;

: cos 90 + sin ;
     
: test
  LAYER2
  cls
   
  360 0 do 
    80 0 do 
      grad sin i 10000 */ to wx
      grad cos i 10000 */ to wy
      color 100 wy + 120 wx + pixeladd c!
    loop    
    grad 10 + to grad
    color 7 + to color
  10 +loop   
  
  0 to grad
 ;
 
Attachments
plotsternayer2.jpg
plotsternayer2.jpg (45.83 KiB) Viewed 399 times

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Wed Sep 29, 2021 8:13 pm

here i have a circle demo in layer2.

https://spectrumcomputing.co.uk/forums/ ... cfabbf50b7

greeting

User avatar
Mmattsteel
Posts: 31
Joined: Wed May 31, 2017 5:38 am
Location: Venice Italy
Contact:

Re: vforth 1.5 is wonderful for the next.

Postby Mmattsteel » Thu Sep 30, 2021 7:40 am

I've implemented in vForth this algorithm https://en.wikipedia.org/wiki/Line_drawing_algorithm

Here is the code and the example

Code: Select all

: at. 22 emitc swap emitc emitc ;
: ink. 16 emitc emitc ;
: paper. 17 emitc emitc ;

( plot layer2 )
hex
: pixeladd ( x y -- a )  \ x: vertical  y:horizontal
  over FF and 5 rshift   \ divide x by 32
  12 reg@ 2* + mmu7!     \ fit correct 8K page
  swap 1F and            \ x mod 32
  8 lshift +             \ turn it high byte part
  E000 or
;
hex
: plot  ( x y c -- )     \ x: vertical  y:horizontal
  -rot over 8 lshift over +
  C000 U< if pixeladd c! else drop  2drop  then
;

decimal

( draw-line )
\ draw a line using LAYER 2 mode
\
needs VALUE  
needs TO 
needs +TO
needs 2OVER  
needs DNEGATE
needs LAYERS
\
0    value dx       \ x-distance between P1 and P2
0    value dy       \ y-distance between P1 and P2
0    value sx       \ x-direction from P1 to P2
0    value sy       \ y-direction from P1 to P2
0    value err      \ error at each stage
255  value color
\

: draw-line        ( x2 y2 x1 y1 c -- )
  to color   rot swap                   ( x2 x1 y2 y1 )
  \ determines sx, dx, sy, dy and err
  2over -  1 over +- to sx  abs to dx
  2dup  -  1 over +- to sy  abs negate to dy
  dx dy + to err
  swap -rot                             ( x2 y2 x1 y1 )
  begin
    2dup 256 u< swap 192 u< and  >R     \ pixel in range?
    \ plot current pixel and...
    2dup color plot 2over 2over         \ x2 y2 x1 y1  x2 y2 x1 y1
    \ check if final pixel is reached
    rot - -rot - or  R> AND      \ x2 y2 x1 y1 y1-y2|x2-x1|f
  while
    err dup + >R                   \ x2 y2 x1 y1  R:2err
    R@ dy < not if
      dy +to err swap sx + swap
    endif
    R> dx > not if
      dx +to err      sy +
    endif
    ?terminal if 2drop 2drop exit then
  repeat
  2drop color plot
;


( draw-line example )
LAYER2
1 paper. 216 ink. cls
000 255  000 000  255      draw-line
000 255  191 255  255      draw-line
191 000  191 255  255      draw-line
191 000  000 000  255      draw-line
191 255  000 000  255      draw-line
191 000  000 255  255      draw-line

15 10 at. key quit

Layer2-draw-line.PNG
Layer2-draw-line.PNG (12.4 KiB) Viewed 351 times
Last edited by Mmattsteel on Thu Sep 30, 2021 6:43 pm, edited 1 time in total.
Matteo.
Backer #1227. ZX Spectrum+ m/c programmer since 1985.
Take a look to https://github.com/mattsteeldue/vforth-next

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Thu Sep 30, 2021 3:58 pm

Hi, Thank You.
that's perfect this drawline.

the vforth blooms more and more, like a simple flower to an orchid.

thanks.
greeting

User avatar
Mmattsteel
Posts: 31
Joined: Wed May 31, 2017 5:38 am
Location: Venice Italy
Contact:

Re: vforth 1.5 is wonderful for the next.

Postby Mmattsteel » Thu Sep 30, 2021 6:50 pm

Mhm... there was a missing "2drop" in the else branch of my previous reply's PLOT definition,
Here is the correct version.

Code: Select all

HEX
: plot  ( x y c -- )     \ x: vertical  y:horizontal
  -rot over 8 lshift over +
  C000 U< if \ quick'n'dirty range check...
      pixeladd c! 
   else 
       drop  2drop  
   then
;
_M
Matteo.
Backer #1227. ZX Spectrum+ m/c programmer since 1985.
Take a look to https://github.com/mattsteeldue/vforth-next

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Thu Sep 30, 2021 8:16 pm

hello, thanks for the correktur.

greeting

funkheld
Posts: 77
Joined: Tue May 11, 2021 5:36 pm

Re: vforth 1.5 is wonderful for the next.

Postby funkheld » Thu Oct 07, 2021 6:50 am

Hi good afternoon.

I found something for the tilemap here.
can you please do something like that for the vforth?

thanks.
greeting

there are two screen resolutions.
40x32 und 80x32

40x32 for the vforth?
------------------------------------
NextReg($15,%00010011)
';bit 7 = 1 to enable tilemap
';bit 6 =0 for 40x32, 1 for 80x32
';bit 5 = palette select
';bits 3-0 = transparent index
NextReg($4c,%10000000)
'28 mhz
NextReg(7,3)
-----------------------------------

this demo is from nextbuild.

Code: Select all

ShowLayer2(1) : CLS256(0) :
ClipULA(0,0,1,1)
NextReg($15,%00010011)
';bit 7 = 1 to enable tilemap
';bit 6 =0 for 40x32, 1 for 80x32
';bit 5 = palette select
';bits 3-0 = transparent index
NextReg($4c,%10000000)
'28 mhz
NextReg(7,3)	

' $6b
' 7	1 to enable the tilemap
' 6	0 for 40x32, 1 for 80x32
' 5	1 to eliminate the attribute entry in the tilemap
' 4	palette select (0 = first Tilemap palette, 1 = second)
' 3	enable "text mode"
' 2	Reserved, must be 0
' 1	1 to activate 512 tile mode (bit 0 of tile attribute is ninth bit of tile-id)
' 0 to use bit 0 of tile attribute as "ULA over tilemap" per-tile-selector
' 
' 0	1 to enforce "tilemap over ULA" layer priority
NextReg($6b,%10100001)
' Default Tilemap Attribute Register			$6C Default tile attribute for 8-bit only maps.
NextReg($6c,0)
' Tilemap Base Address Register						$6E	Base address of the 40x32 or 80x32 tile map (similar to text-mode of other computers).
NextReg($6e,$40)	'map data
' Tile Definitions Base Address Register	$6F	Base address of the tiles' graphics.
NextReg($6f,$60)	'tile graphics data  
NextReg($68,%10000000)

'Set up palette, choose layer 3 palette 
';(R/W) 0x43 (67) => Palette Control
' ;  bit 7 = '1' to disable palette write auto-increment.
' ;  bits 6-4 = Select palette for reading or writing:
' ;     000 = ULA first palette
' ;     100 = ULA secondary palette
' ;     001 = Layer 2 first palette
' ;     101 = Layer 2 secondary palette
' ;     010 = Sprites first palette 
' ;     110 = Sprites secondary palette
' ;     011 = tilemap first palette
' ;     111 = tilemap second palette
' ;  bit 3 = Select Sprites palette (0 = first palette, 1 = secondary palette)
' ;  bit 2 = Select Layer 2 palette (0 = first palette, 1 = secondary palette)
' ;  bit 1 = Select ULA palette (0 = first palette, 1 = secondary palette)
' ;  bit 0 = Disable the standard Spectrum flash feature to enable the extra 
' ;          colours. (0 after a reset)
' 
NextReg($43,%00110000)
LoadSD("MM.PAL",$b000,32,0)
PalUpload($b000,16,0)

LoadSD("mm.til",$6000,2048,0)
LoadSD("lev1part1.map",$b000,6144,0)

dim x as ubyte
dim y as ubyte
dim tile as ubyte
dim tilStart as uinteger = $b000 'where map file has been loaded
dim tilDest as uinteger = $4000 'where the tilemap is in memory

' ;Tiles defined at 0x6000 (32 bytes each).  Tilemap starts at 0x4000.  The tilemap is stored in Y major order.  Ie x=0,y=0, x=0,y=1, ..., x=0,y=31, x=1,y=0, ....
' ;Tilemap entry is two bytes:
' ;bits 15-12 : palette offset
' ;bit     11 : x mirror
' ;bit     10 : y mirror
' ;bit      9 : rotate
' ;bit      8 : ula over tilemap
' ;bits   7-0 : tile id

dim a$ as string
dim xs as byte = 0
dim scrollRightStart as ubyte = 40
dim REGACTIVEVIDEOLINEL as ubyte = 31
dim videoLine as ubyte

'clip tile map
ClipTileMap(4,155,0,255)

'draw intial map
for y = 1 to 25
	for x = 1 to 40
		tile = peek(tilStart)
	
		poke (tilDest,tile)

		tilStart = tilStart + 1
		tilDest = tilDest + 1

	next x
	tilStart = tilStart + 256-40

next y

tilStart = $b000 	'where we loaded our map
tilDest = $4000		'where tiles are in memory

do
	
	do
		videoLine = GetReg(REGACTIVEVIDEOLINEL)
	loop until videoLine = 190
	
	'scroll right up to 8 pixels
	xs = xs + 1

	if (xs = 9) then
		scrollRightStart = scrollRightStart + 1
		if scrollRightStart = 216 then
			'wrap back to start
			scrollRightStart = 40
		end if
		ScrollRight()
		xs=0
	end if

	';nextreg 0x30
	' ;x scroll bits 7-0 LSB
	' ;nextreg 0x2f
	' ;x scroll bits 0-1 MSB
	' ;x scroll bits 0-1 MSB
	NextRegA($30,xs)

	a$=inkey$

loop until a$="s"

';nextreg 0x1b:
';clip window for tilemap; the x coords are multiplied by 2 to cover 320 pixel width.
Sub ClipTileMap( byval x1 as ubyte, byval x2 as ubyte, byval y1 as ubyte, byval y2 as ubyte ) 

	asm 
		ld a,(IX+5)    
		DW $92ED : DB 27 			
		ld a,(IX+7)	  
		DW $92ED : DB 27
		ld a,(IX+9)		 
		DW $92ED : DB 27 
		ld a,(IX+11)	
		DW $92ED : DB 27		  
	end asm 
end sub 

sub ScrollRight()

dim mapStart as uinteger
dim y as ubyte
dim mapLoaded as uinteger

mapStart = tilDest
mapLoaded = tilStart + scrollRightStart 

'drag whole map back one byte
memcopy (mapStart+1, mapStart, 968)

for y = 1 to 25

	'do right hand column update
	mapStart = mapStart + 39

	tile = peek(mapLoaded)

	poke (mapStart, tile)

	mapStart = mapStart + 1
	mapLoaded = mapLoaded + 256

next y

end sub
 


Who is online

Users browsing this forum: No registered users and 1 guest