uxn

Varvara Ordinator, written in ANSI C(SDL2)
git clone https://git.eamoncaddigan.net/uxn.git
Log | Files | Refs | README | LICENSE

cube3d.tal (3632B)


      1 ( Cube3d: Just a cube, y'know )
      2 
      3 |00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
      4 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
      5 |000
      6 
      7 	@cube &v0 $8 &v4 $8
      8 	@center &x $2 &y $2
      9 	@timer $1
     10 
     11 |100
     12 
     13 @on-reset ( -> )
     14 	( | theme )
     15 	#4fcd .System/r DEO2
     16 	#4fc3 .System/g DEO2
     17 	#dfc2 .System/b DEO2
     18 	( | center )
     19 	.Screen/width DEI2 #01 SFT2 #0040 SUB2 .center/x STZ2
     20 	.Screen/height DEI2 #01 SFT2 #0040 SUB2 .center/y STZ2
     21 	( | begin. )
     22 	;on-frame .Screen/vector DEO2
     23 
     24 @on-frame ( -> )
     25 	[ LIT &f $1 ] INCk ,&f STR
     26 	DUP #01 AND ?{ POP BRK }
     27 	#01 SFT .timer STZ
     28 	( | clear )
     29 	#0000 DUP2 .Screen/x DEO2
     30 	.Screen/y DEO2
     31 	[ LIT2 80 -Screen/pixel ] DEO
     32 	( | draw )
     33 	<draw-cube>
     34 	BRK
     35 
     36 @<draw-cube> ( frame -- )
     37 	( | create box )
     38 	#0800
     39 	&>loop ( -- )
     40 		STHk [ LIT2 00 -timer ] LDZ #00 STHkr INC #07 AND #60 SFT ADD2 #00ff AND2 ;table ADD2 LDA #01 SFT #00 .timer LDZ #00 STHkr #60 SFT ADD2 #00ff AND2 ;table ADD2 LDA #02 SFT #00 STHkr #62 SFT2 ADD2 .cube/v0 STHr DUP ADD ADD STZ2
     41 		INC GTHk ?&>loop
     42 	POP2
     43 	( | vertices )
     44 	#0800
     45 	&>ver-loop ( -- )
     46 		DUP DUP ADD LDZ2 <draw-vertex>
     47 		INC GTHk ?&>ver-loop
     48 	POP2
     49 	( lines ) #0400
     50 	&>line-loop ( -- )
     51 		STHk .cube/v0 STHkr DUP ADD ADD .cube/v0 STHkr INC #03 AND DUP ADD ADD <draw-edge>
     52 		.cube/v0 STHkr DUP ADD ADD .cube/v4 STHkr DUP ADD ADD <draw-edge>
     53 		.cube/v4 STHkr DUP ADD ADD .cube/v4 STHr INC #03 AND DUP ADD ADD <draw-edge>
     54 		INC GTHk ?&>line-loop
     55 	POP2 JMP2r
     56 
     57 @<draw-edge> ( a b -- )
     58 	STH
     59 	STH
     60 	( ) #00 STHkr LDZ .center/x LDZ2 ADD2
     61 	( ) #00 STHr INC LDZ .center/y LDZ2 ADD2
     62 	( ) #00 STHkr LDZ .center/x LDZ2 ADD2
     63 	( ) #00 STHr INC LDZ .center/y LDZ2 ADD2 #05 !<draw-line>
     64 
     65 @<draw-vertex> ( x y -- )
     66 	#00 SWP #0004 SUB2 .center/y LDZ2 ADD2 .Screen/y DEO2
     67 	#00 SWP #0003 SUB2 .center/x LDZ2 ADD2 .Screen/x DEO2
     68 	;&icn .Screen/addr DEO2
     69 	[ LIT2 05 -Screen/sprite ] DEO
     70 	JMP2r
     71 	&icn [ 0000 387c 7c7c 3800 ]
     72 
     73 @<draw-line> ( x1* y1* x2* y2* color -- )
     74 	,&color STR
     75 	,&y STR2
     76 	,&x STR2
     77 	,&y2 STR2
     78 	,&x2 STR2
     79 	,&x LDR2 ,&x2 LDR2 SUB2 abs2 ,&dx STR2
     80 	#0000 ,&y LDR2 ,&y2 LDR2 SUB2 abs2 SUB2 ,&dy STR2
     81 	#ffff [ LIT2 00 _&x2 ] LDR2 ,&x LDR2 lts2 DUP2 ADD2 ADD2 ,&sx STR2
     82 	#ffff [ LIT2 00 _&y2 ] LDR2 ,&y LDR2 lts2 DUP2 ADD2 ADD2 ,&sy STR2
     83 	[ LIT2 &dx $2 ] [ LIT2 &dy $2 ] ADD2 STH2
     84 	&while ( -- )
     85 	[ LIT2 &x2 $2 ] DUP2 .Screen/x DEO2
     86 	[ LIT2 &x $2 ] EQU2 [ LIT2 &y2 $2 ] DUP2 .Screen/y DEO2
     87 	[ LIT2 &y $2 ] EQU2 [ LIT2 &color $1 -Screen/pixel ] DEO
     88 	AND ?&end
     89 	STH2kr DUP2 ADD2 DUP2 ,&dy LDR2 lts2 ?&skipy
     90 	STH2r ,&dy LDR2 ADD2 STH2
     91 	,&x2 LDR2 [ LIT2 &sx $2 ] ADD2 ,&x2 STR2
     92 	&skipy ( -- )
     93 	,&dx LDR2 gts2 ?&while
     94 	STH2r ,&dx LDR2 ADD2 STH2
     95 	,&y2 LDR2 [ LIT2 &sy $2 ] ADD2 ,&y2 STR2
     96 	!&while
     97 	&end POP2r JMP2r
     98 
     99 @abs2 ( a* -- f )
    100 	DUP2 #0f SFT2 EQU ?{ #0000 SWP2 SUB2 }
    101 	JMP2r
    102 
    103 @lts2 ( a* b* -- f )
    104 	#8000 STH2k ADD2 SWP2 STH2r ADD2 GTH2 JMP2r
    105 
    106 @gts2 ( a* b* -- f )
    107 	#8000 STH2k ADD2 SWP2 STH2r ADD2 LTH2 JMP2r
    108 
    109 @table ( 256 xy )
    110 	[
    111 	f7f8 f9fa fbfc fcfd fefe ffff ffff ffff
    112 	ffff ffff fffe fefd fcfc fbfa f9f8 f7f6
    113 	f5f3 f2f0 efed ecea e8e6 e4e2 e0de dcda
    114 	d8d5 d3d1 cecc c9c7 c4c1 bfbc b9b6 b3b0
    115 	aeab a8a5 a29f 9c98 9592 8f8c 8986 8380
    116 	7c79 7673 706d 6a67 6360 5d5a 5754 514f
    117 	4c49 4643 403e 3b38 3633 312e 2c2a 2725
    118 	2321 1f1d 1b19 1715 1312 100f 0d0c 0a09
    119 	0807 0605 0403 0302 0101 0000 0000 0000
    120 	0000 0000 0001 0102 0303 0405 0607 0809
    121 	0a0c 0d0f 1012 1315 1719 1b1d 1f21 2325
    122 	272a 2c2e 3133 3638 3b3e 4043 4649 4c4f
    123 	5154 575a 5d60 6367 6a6d 7073 7679 7c7f
    124 	8386 898c 8f92 9598 9c9f a2a5 a8ab aeb0
    125 	b3b6 b9bc bfc1 c4c7 c9cc ced1 d3d5 d8da
    126 	dcde e0e2 e4e6 e8ea eced eff0 f2f3 f5f6 ]
    127