multiple entry words (not only two)

r4/3d/dev/cuboiso.txt

@@ -1,9 +1,15 @@
-| cubo iso
+| cubo isometrico
 | PHREDA 2017
-
 ^r4/lib/gui.txt
 
-#xcam 0 #ycam 0 #zcam 50.0
+|------------------------------
+#xcam 0 #ycam 0 #zcam 5.0
+
+#octvert )( 3072 	| 32 niveles de 3 valores*8 vert
+#octvert> 'octvert
+
+#rotsum )( 2048		| 32 niveles de 2 valores*8 vert
+#rotsum> 'rotsum
 
 #ymin #nymin
 #xmin #nxmin
@@ -13,9 +19,6 @@
 #xmax #nxmax
 #zmax
 
-#ozmin
-#ozmax
-
 #mask
 
 #x0 #y0 #z0
@@ -24,98 +27,103 @@
 #x4 #y4 #z4
 
 #x7 #y7 #z7	| centro del cubo
+#n1 #n2 #n3
 
-
-#octvert )( 128
-#octvert> 'octvert
-#verc )( 128
+|---------------
+:id3d3 | id --
+	transform swap rot ;
 
 :fillstart | --
 	'octvert >b
-	0.5 0.5 0.5 transform
-	dup 'x0 ! b!+ dup 'y0 ! b!+ dup 'z0 ! b!+ | 111
-	0.5 0.5 -0.5 transform
-	dup 'x1 ! b!+ dup 'y1 ! b!+ dup 'z1 ! b!+ | 110
-	0.5 -0.5 0.5 transform
-	dup 'x2 ! b!+ dup 'y2 ! b!+ dup 'z2 ! b!+ | 101
-	0.5 -0.5 -0.5 transform
-	b!+ b!+ b!+ | 100
-	-0.5 0.5 0.5 transform
-	dup 'x4 ! b!+ dup 'y4 ! b!+ dup 'z4 ! b!+ | 011
-	-0.5 0.5 -0.5 transform
-	b!+ b!+ b!+ | 010
-	-0.5 -0.5 0.5 transform
-	b!+ b!+ b!+ | 001
-	-0.5 -0.5 -0.5 transform
-	dup x0 + 2/ 'x7 ! b!+ dup y0 + 2/ 'y7 ! b!+ dup z0 + 2/ 'z7 ! b!+ | 000
-	b> 'octvert> ! ;
-
-:getnn
-	3 << 'verc + @+ swap @ ;
-
-:cara1
-	dup getnn op
-	dup 2 xor getnn line
-	dup 3 xor getnn line
-	dup 1 xor getnn line
-	;
-
-:cara2
-	dup getnn op
-	dup 4 xor getnn line
-	dup 6 xor getnn line
-	dup 2 xor getnn line
+	0.5 0.5 0.5 id3d3 b!+ b!+ b!+ | 111
+	0.5 0.5 -0.5 id3d3 b!+ b!+ b!+ | 110
+	0.5 -0.5 0.5 id3d3 b!+ b!+ b!+ | 101
+	0.5 -0.5 -0.5 id3d3 b!+ b!+ b!+ | 100
+	-0.5 0.5 0.5 id3d3 b!+ b!+ b!+ | 011
+	-0.5 0.5 -0.5 id3d3 b!+ b!+ b!+ | 010
+	-0.5 -0.5 0.5 id3d3 b!+ b!+ b!+ | 001
+	-0.5 -0.5 -0.5 id3d3 b!+ b!+ b!+ | 000
+	b>
+	'octvert> !
+	$ff $ff $ff id3d3 'x0 ! 'y0 ! 'z0 !
+	$ff $ff -$ff id3d3 'x1 ! 'y1 ! 'z1 !
+	$ff -$ff $ff id3d3 'x2 ! 'y2 ! 'z2 !
+	-$ff $ff $ff id3d3 'x4 ! 'y4 ! 'z4 !
+	-$ff -$ff -$ff id3d3
+	x0 + 2/ 'x7 ! 
+	y0 + 2/ 'y7 ! 
+	z0 + 2/ 'z7 !
 	;
 
-:cara3
-	dup getnn op
-	dup 1 xor getnn line
-	dup 5 xor getnn line
-	dup 4 xor getnn line
+| PERSPECTIVA
+:id3d | x y z -- u v
+	p3d ;
+
+| ISOMETRICO
+:id3d
+	pick2 over - 0.02 / ox + >r
+	rot + 2/ + 0.02 / oy 2/ + r> swap ;
+
+:fillveciso | --
+	octvert> 96 - >b
+	'rotsum
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@+ id3d rot !+ !+
+	b@+ b@+ b@ id3d rot !+ !+
+	'rotsum> ! ;
+
+:getn | n --
+	3 << 'rotsum + @+ swap @ swap ;
+
+:drawire
+	azul
+	0 getn op 1 getn line 3 getn line 2 getn line 0 getn line
+	4 getn op 5 getn line 7 getn line 6 getn line 4 getn line
+	0 getn op 4 getn line
+	1 getn op 5 getn line
+	2 getn op 6 getn line
+	3 getn op 7 getn line
 	;
 
-:drawq3
-	'verc >b
-	'octvert >a
-	8 ( 1? )(
-		a@+ a@+ a@+ p3d swap b!+ b!+
-		1- ) drop
-	mask
-	cara1
-	cara2
-	cara3 drop ;
-
-|----- modo 1
-:forma1
+:calco
 	x0 x1 - x7 *
 	y0 y1 - y7 * +
 	z0 z1 - z7 * +
-	+? ( 1 )( 0 ) >a drop
+	dup 'n1 !
+	31 >> $1 and
 	x0 x2 - x7 *
 	y0 y2 - y7 * +
 	z0 z2 - z7 * +
-	+? ( 2 a+ ) drop
+	dup 'n2 !
+	31 >> $2 and or
 	x0 x4 - x7 *
 	y0 y4 - y7 * +
 	z0 z4 - z7 * +
-	+? ( 4 a+ ) drop
-	a> 'mask !
+	dup 'n3 !
+	31 >> $4 and or
+	$7 xor 'mask !
 	;
 
-:3dop 3dproject op ;
-:3dline 3dproject line ;
-
-:drawcube
+:dumpvar
 	verde
 	z0 y0 x0 "x0 %f %f %f " print cr
 	z7 y7 x7 "x7 %f %f %f " print cr
 	mask "%d " print cr
-	'octvert >a
-	a@+ a@+ a@+ p3d op
-	a@+ a@+ a@+ p3d line	
+	n3 n2 n1 "%d %d %d" print cr
+
+	cyan 0 getn 1 box
+	blanco mask getn 3 box
+	'rotsum >b
+	8 ( 1? )( 1-
+		b@+ b@+ "%d %d " print cr
+		) drop
 	;
 
-
 :freelook
 	xymouse
 	sh 2/ - 7 << swap
@@ -128,18 +136,16 @@
 	show clrscr blanco
 		dup "%d" print cr
 
-		omode
+		Omode
 		freelook
 		xcam ycam zcam mtrans
 
 		fillstart
-		forma1
-
-		blanco
-        drawcube
+		fillveciso
+		calco
 
-		verde
-|	   	drawq3
+		dumpvar
+		drawire
 
 		[ -0.01 'zcam +! ; ] <up>
 		[ 0.01 'zcam +! ; ] <dn>

r4/3d/dev/iso_5.txt

@@ -35,9 +35,10 @@
 
 :drawaxis
 	violeta x0 y0 4 box
-	azul x0 y0 op x1 y1 2dup line 4 box
-	rojo x0 y0 op x2 y2 2dup line 4 box
-	verde x0 y0 op x3 y3 2dup line 4 box
+	blanco 
+	x0 y0 op x1 y1 2dup line 4 box
+	x0 y0 op x2 y2 2dup line 4 box
+	x0 y0 op x3 y3 2dup line 4 box
 	;
 
 |--------------------------------------
@@ -650,6 +651,12 @@
 
 :main
 	mark
+
+	200 220 'x0 ! 'y0 !
+	215 245 'x1 ! 'y1 !
+	195 245 'x2 ! 'y2 !
+	215 230 'x3 ! 'y3 !
+
 |	"media/3do/xwing.3do"
 |	"media/3do/tie fighter.3do"
 	"media/3do/mario.3do"

r4/3d/dev/tritest.txt

@@ -53,17 +53,26 @@
 :rectri | adr --
 	1 'l +!
 |	same3 1? ( drop draw1p ; ) drop
-	l 10 >? ( 2drop ; ) drop
+	l 20 >? ( 2drop ; ) drop
+
+	dup draw1p
+	dup 8 + draw1p
+	dup 16 + draw1p
 
 	verlist> >a
-	dup @+ a!+ @ a!+
+|	dup @+ a!+ @ a!+
 	dup @ over 8 + @ 10bit2/ a!+
 	dup 4+ @ over 12 + @ colavg a!+
 	dup @ over 16 + @ 10bit2/ a!+
 	dup 4+ @ over 20 + @ colavg a!+
+	dup 16 + @ over 8 + @ 10bit2/ a!+
+	dup 20 + @ over 12 + @ colavg a!+
+|	a> dup @ dup 8 + @ rot 16 + @
+|	=? ( =? ( 2drop ; ) drop ) drop
+
     a> 'verlist> !
 
-    dumpl cr
+|    dumpl cr
     verlist> 24 - rectri
 
 	drop
@@ -78,7 +87,7 @@
 	a@+ 2* a@+ 2* 10 << or a@+ 2* 20 << or b!+ a@+ b!+
 	b> 'verlist> !
 
-    dumpl cr
+|    dumpl cr
 
 	'verlist rectri
 	;

r4/3d/octree/iso_16_2.txt

@@ -165,10 +165,10 @@
 
 |-------------------------------
 :calco |  x y z -- x y z mask
-	pick2 x1 * pick2 y1 * + over z1 * + +? ( 1 )( 0 ) nip
-	pick3 x2 * pick3 y2 * + pick2 z2 * + +? ( 2 )( 0 ) nip +
-	pick3 x4 * pick3 y4 * + pick2 z4 * + +? ( 4 )( 0 ) nip +
-	;
+	pick2 x1 * pick2 y1 * + over z1 * + 31 >> $1 and
+	pick3 x2 * pick3 y2 * + pick2 z2 * + 31 >> $2 and or
+	pick3 x4 * pick3 y4 * + pick2 z4 * + 31 >> $4 and or
+	$7 xor ;
 
 :2/a | a -- b
 	dup 31 >> - 2/ ;

r4/3d/octree/iso_17.txt

@@ -126,10 +126,10 @@
 
 |-------------------------------
 :calco |  x y z -- x y z mask
-	pick2 x1 * pick2 y1 * + over z1 * + +? ( 1 )( 0 ) nip
-	pick3 x2 * pick3 y2 * + pick2 z2 * + +? ( 2 )( 0 ) nip +
-	pick3 x4 * pick3 y4 * + pick2 z4 * + +? ( 4 )( 0 ) nip +
-	;
+	pick2 x1 * pick2 y1 * + over z1 * + 31 >> 1 and
+	pick3 x2 * pick3 y2 * + pick2 z2 * + 31 >> 2 and or
+	pick3 x4 * pick3 y4 * + pick2 z4 * + 31 >> 4 and or
+	$7 xor ;
 
 :oct++ | adr -- adr bitmask
 	@+ dup 8 >> 2 << rot + swap ; |$ff and ;

r4/3d/octree/iso_17_2.txt

@@ -127,10 +127,8 @@
 :calco |  x y z -- x y z mask
 	pick2 x1 * pick2 y1 * + over z1 * + 31 >> 1 and
 	pick3 x2 * pick3 y2 * + pick2 z2 * + 31 >> 2 and or
-	pick3 x4 * pick3 y4 * + pick2 z4 * + 31 >> 4 and or $7 xor ;
-|	pick2 x1 * pick2 y1 * + over z1 * + +? ( 1 )( 0 ) nip
-|	pick3 x2 * pick3 y2 * + pick2 z2 * + +? ( 2 )( 0 ) nip +
-|	pick3 x4 * pick3 y4 * + pick2 z4 * + +? ( 4 )( 0 ) nip + ;
+	pick3 x4 * pick3 y4 * + pick2 z4 * + 31 >> 4 and or
+	$7 xor ;
 
 :oct++ | adr -- adr bitmask
 	@+ dup 8 >> 2 << rot + swap ; |$ff and ;

r4/3d/viewoctree.txt

@@ -4,7 +4,7 @@
 ^r4/lib/gui.txt
 ^r4/lib/dlgfile.txt
 
-^r4/3d/octree/iso_13.txt
+^r4/3d/octree/iso_16.txt
 
 ^r4/lib/trace.txt
 

r4/Compiler/code.asm

@@ -0,0 +1 @@
+;---:r4 compiler code.asm; sqrt44 | a--b | ;L | len:40 | calls:1; vreg:40 R:3 W:2 >W W> (0:41) 11 R:2 W:3 W> (5:39) 22 R:4 W:2 (6:37) 33 R:1 W:2 CPY U C (7:11) 44	 CTE R:1 U $FE (9:10) 05 R:1 W:1 CPY U (16:19) 46	 CTE R:1 CPY U 2 (17:18) 07 R:1 W:1 CPY (21:24) 48	 CTE R:1 CPY U 2 (22:23) 09	 CTE R:1 CPY U 2 (27:28) 010	 CTE R:1 U C $2 (34:35) 0; blocks----; ;IF  (2:4); WHI (12:14:36); IFE (20:29:32); blocks---- 0 0 0 0 0 0 1 0 1 2 0 1 2 3 0 1 2 3 0 1 2 3 4 0 1 2 3 0 1 2 0 1 2 0 1 2 0 1 2 1 2 0 1 2 0 5 1 2 0 5 6 1 2 0 5 1 2 0 1 2 0 1 2 0 7 1 2 0 7 8 1 2 0 7 1 2 0 2 0 1 2 0 1 2 0 1 9 2 0 1 1 2 0 2 0 1 2 0 1 2 0 1 0 1 2 0 1 2 10 0 1 2 0 1 2 0 1 1	; :sqrt44	 0w15:	; 0?	 0or $0,$0; acpx!+46 | ab-- | L | len:38 | calls:7; vreg:50 R:2 W:1 >W (0:28) 11 R:3 W:5 >W (0:36) 22 R:2 W:1 CPY (1:15) 33	 CTE R:1 U $FF00FF (2:3) 04 R:2 W:5 (4:31) 45 R:1 W:6 CPY (5:35) 56	 CTE R:1 U $FF00FF (6:7) 07	 CTE R:1 CPY U 2 (8:9) 08	 CTE R:1 CPY U (10:11) 09	 CTE R:1 U C $8 (12:13) 010	 CTE R:1 U $FF00FF (16:17) 011	 CTE R:1 U $FF00 (20:21) 012	 CTE R:1 U $FF00 (23:24) 013	 CTE R:1 CPY U 1 (25:26) 014	 CTE R:1 U C $8 (29:30) 015	 CTE R:1 U $FF00 (32:33) 0 0 1 0 1 0 1 2 0 1 2 3 0 1 2 0 1 2 4 0 1 2 4 5 0 1 2 4 5 6 0 1 2 4 5 0 1 2 4 5 7 0 1 2 4 5 0 1 2 4 5 8 0 1 2 4 5 0 1 2 4 5 9 0 1 2 4 5 0 1 4 5 2 0 1 4 5 0 1 4 5 10 0 1 4 5 0 1 4 r: 5 0 4 1 r: 5 0 4 1 11 r: 5 0 4 1 r: 5 0 1 4 r: 5 0 1 4 12 r: 5 0 1 4 r: 5 0 1 4 13 r: 5 0 1 4 r: 5 1 4 0 r: 5 1 4 r: 5 1 4 14 r: 5 1 4 r: 5 1 r: 5 1 15 r: 5 1 r: 5 1 5 1	; :acpx!+46	 0 1w16:	; DUP	 0 1	; $FF00FF	 0 1 2	; AND	 0 1 2 3and $0,str0*2