Varvara Emulator

|00   @System     &vector $2 &expansion $2 &wst $1 &rst $1 &metadata $2 &r $2 &g $2 &b $2 &debug $1 &state $1
|10   @Console    &vector $2 &read $5 &type $1 &write $1 &error $1
|20   @Screen     &vector $2 &width $2 &height $2 &auto $2 &x &x-hb $1 &x-lb $1 &y &y-hb $1 &y-lb $1 &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 &x-hb $1 &x-lb $1 &y &y-hb $1 &y-lb $1 &state $4 &scrollx &scrollx-hb $1 &scrollx-lb $1 &scrolly &scrolly-hb $1 &scrolly-lb $1
|a0   @File1      &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|b0   @File2      &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2
|c0   @DateTime   &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1

|0000

@even $1
	@pause $1
	@rate $1
	@skip $1
	@reverse $1

|0100 @on-reset ( -> )
	( | init )
	( | theme )
	#0fa5 .System/r DEO2k INC INC DEO2k INC INC DEO2
	( | resize )
	#0100 .Screen/width DEO2k INC INC DEO2
	( | vectors )
	;Screen/on-frame .Screen/vector DEO2
	;Mouse/on-update .Mouse/vector DEO2
	( | screen auto )
	[ LIT2 02 -Screen/auto ] DEO
	BRK

@Screen/on-frame ( -> )
	.pause LDZ ?{
		[ LIT &frame $1 ] INCk ,&frame STR
		.rate LDZ LTH ?/redraw
		.skip LDZ #00
		&while
			run
			INC GTHk ?&while
		POP2
	}
	[ LIT2 00 _&frame ] STR

@Screen/redraw ( -> )
	#1234 ;random/state STA2
	[ LIT2 00 -/x-lb ] DEOk INC INC DEO
	[ LIT2 00 80 ] [ LIT2 c0 -/pixel ] DEOk NIP DEO
		DUP
	&ver ( y x )
		DUP ./x-lb DEO
		SWP
		[ LIT2 00 -/y-lb ] DEO
		&hor
			DUP2 cell/color ./pixel DEO
			INC DUP ?&hor
		SWP INC DUP ?&ver
	POP2
	.Mouse/x-lb DEI .Mouse/y-lb DEI ( x y )
		SWPk ./x-lb DEO ./y-lb DEO
		cell/get #42 ORA ./pixel DEO
	BRK

@cell/color ( x y -- color )
	( random STH POP )
	EORk STH
	DUP2 /get STHk ?{ POP2 STHr POPr JMP2r }
	INC DUP [ LIT2r ={ ] ?/get POP2 #01 JMP2r }
		?{ STHr POPr JMP2r }
	STHr STHr #01 AND ADD JMP2r

@cell/get-mask ( x y -- mask <addr>* )
	#80 OVR #07 AND SFT ROT ROT
	#03 SFT2 ;bank ADD2
	JMP2r

@quad/get ( x y -- a b c d )
	STH2k DUP2
	cell/get
	ROT INC ROT cell/get
	STH2r INC DUP2
	cell/get
	ROT INC ROT ( >> )

@cell/get ( x y -- val )
	/get-mask LDA AND #00 NEQ
	JMP2r

@quad/run ( x y -- )
	INCk ?{ POP2 JMP2r }
	DUP2 /get
	( skip if lo full ) ANDk ?&pop6+jmp2r
	( skip if hi none ) OVR2 ORA ?{ &pop6+jmp2r POP2 POP2 POP2 JMP2r }
	ROT SWP ( a c b d )
	JMPk SWP STH2 JMPk SWP STH2r ( a c | b d )
	ROT SWP ( a b c d )
	EQUk ?/set
	OVR2 EQU ?/set
	SWP ORA2 #0000 SWP2
	( >> )

@quad/set ( x y a b c d -- )
	ROT2 STH2k
	INC SWP INC SWP cell/set
	STH2kr INC cell/set
	STH2kr SWP INC SWP cell/set
	STH2r ( >> )

@cell/set ( val x y -- )
	/get-mask ( val mask addr* )
	STH2k LDA ( val mask byte | addr* )
	ANDk EOR ( val mask byte&~mask | addr* )
	ROT ?{ NIP DUP }
	ORA STH2r STA JMP2r

@run ( -- )
	.reverse LDZ DUP ?{ flip-even }

.even LDZ DUPk
	&while
		DUP2 quad/run
		INC INC ROTk NEQ NIP ?&while
	STH INC INC NEQk STHr SWP ?&while

POP2 POP

[ JMP JMP2r ]
	( >> )

@flip-even ( -- )
	[ LIT2 00 -even ] LDZ EQU .even STZ JMP2r

@Mouse/on-update ( -> )
	./scrolly DEI2 ORAk ?{ POP2 !&end }
		#8000 LTH2
		.pause LDZ ?{
			[ LITr -rate ]
		&scrollclamp ( val | <zv> )
			STHkr LDZ ADDk #00 EQU ?{
				SWP #10 SFT #01 SUB ADD STHkr STZk
			} POP2
			POPr
			!&end
		}
		.reverse LDZk STH STZ STHr
		run
		[ LIT2 02 -/state ] DEI EOR ?{
			[ LITr -skip ]
			[ LIT2 00 &scrolled $1 ] ?{ [ LIT2 01 _&scrolled ] STR #00 STHkr STZ } EQU
			!&scrollclamp
		}
		POP
	&end

[ LIT &prevstate $1 ] ./state DEI DUP ,&prevstate STR

DUP #02 AND ?{
		[ LIT2 00 _&scrolled ] STR
		DUP #04 AND ?{
			NIP #01 AND ?{ BRK }
			#01 !&set
		}
		EORk AND NIP #01 AND ?{
			#00 !&set
		}
		;bank_ ;bank
		&while
			#0000 OVR2 STA2
			INC2 INC2 NEQ2k ?&while
		POP2 POP2
		BRK
	}

POP #02 AND ?{ .pause LDZ #00 EQU .pause STZ } BRK

&set ( val -- )
	./x-lb DEI ./y-lb DEI cell/set
	BRK

@random ( -- number* )  ( 16-bit lfsr, cycles through all values incl 0 )
	[ LIT2 &state ace1 ]
	DUP2 #ace1 NEQ2 ?{
		[ LIT2 &zero 00 00 ] OVR EQU ,&zero STR ?{
			POP2 #0000 JMP2r
		}
	}
	DUP2 #07 SFT2 EOR2
	DUP2 #90 SFT2 EOR2
	DUP2 #0d SFT2 EOR2
	DUP2 ,&state STR2
	JMP2r

@bank $2000 @bank_