( a blank file )

%+  { ADD } %-   { SUB }              %/   { DIV }  
%<  { LTH } %>   { GTH }  %=  { EQU } %!   { NEQ } 
%++ { ADD2 } %-- { SUB2 }              %// { DIV2 } 
%<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 }  

%DEBUG  { ;print-hex JSR2 #0a .Console/write DEO }
%DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO }

%RTN { JMP2r }

( devices )

|00 @System     [ &vector $2 &wst      $1 &rst    $1 &pad   $4 &r      $2 &g      $2 &b    $2 &debug  $1 &halt $1 ]
|10 @Console    [ &vector $2 &read     $1 &pad    $5 &write $1 &error  $1 ]
|20 @Screen     [ &vector $2 &width    $2 &height $2 &pad   $2 &x      $2 &y      $2 &addr $2 &pixel  $1 &sprite $1 ]
|30 @Audio0     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|40 @Audio1     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|50 @Audio2     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|60 @Audio3     [ &vector $2 &position $2 &output $1 &pad   $3 &adsr   $2 &length $2 &addr $2 &volume $1 &pitch $1 ]
|80 @Controller [ &vector $2 &button   $1 &key    $1 ]
|90 @Mouse      [ &vector $2 &x        $2 &y      $2 &state $1 &wheel  $1 ]
|a0 @File       [ &vector $2 &success  $2 &offset $2 &pad   $2 &name   $2 &length $2 &load $2 &save   $2 ]
|b0 @DateTime   [ &year   $2 &month    $1 &day    $1 &hour  $1 &minute $1 &second $1 &dotw $1 &doty   $2 &isdst $1 ]

( variables )

|0000

@lista $3
@listb $3
@listc $3

( program )

|0100 ( -> )

	( theme ) 
	#0fe5 .System/r DEO2 
	#0fc5 .System/g DEO2 
	#0f25 .System/b DEO2

	#01 .lista #00 + STZ
	#02 .lista #01 + STZ
	#03 .lista #02 + STZ

	#10 .listb #00 + STZ
	#20 .listb #01 + STZ
	#30 .listb #02 + STZ

	.lista .listb .listc ;add-lists-loop JSR2

	.listc LDZ DEBUG
	.listc #01 + LDZ DEBUG
	.listc #02 + LDZ DEBUG

BRK

( Write a Forth word to add together two integer 
vectors (a.k.a. arrays) of three elements each. )

@add-lists-linear ( a b c -- )
	
	STH
	( a[0] b[0] + ) LDZk STH SWP LDZk STHr + STHkr STZ 
	( a[1] b[1] + ) #01 + LDZk STH SWP #01 + LDZk STHr + STHkr #01 + STZ 
	( a[2] b[2] + ) #01 + LDZ SWP #01 + LDZ + STHr #02 + STZ

RTN

@add-lists-loop ( a b c -- )
	
	STH
	#00 #03
	&loop
		( get incr ) OVR STH
		( get a[x] ) OVR2 STHkr ADD LDZ 
		( get b[x] ) SWP STHkr ADD LDZ 
		( set c[x] ) ADD STHr STHkr ADD STZ
		( incr ) SWP #01 ADD SWP 
		LTHk ,&loop JCN
	POP2 POP2 POPr

JMP2r

@print-hex ( value -- )
	
	STHk #04 SFT ,&parse JSR .Console/write DEO
	STHr #0f AND ,&parse JSR .Console/write DEO
	RTN
	&parse ( value -- char )
		DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN

RTN