engine.a

;ACME 0.96.2

	!src <6502/std.a>	; for bit16 macro

; helper values
!addr	MODIFIED16	= $ffff
	MAX_RECURSIONS	= 64	; ought to be enough for anybody (tm)

itemlist_at_YYAA_new ; make list of items at a given place
		ldx #0	; delete old list
		stx itemlist_len
itemlist_at_YYAA_add ; extend current list with list of items at a given place
		sty .hi
		sta .lo
		ldy #MODIFIED8	: itemlist_len = * - 1
		ldx #1	; skip PLAYER
		bne +++
		;--
---			lda gamevars_lo, x
			cmp #MODIFIED8	: .lo = * - 1
			bne +
				lda gamevars_hi, x
				cmp #MODIFIED8	: .hi = * - 1
				bne +
					; item matches, so add to list
					txa
					sta itemlist_buf, y
					iny
+			inx
+++			cpx #gamevars_ITEMCOUNT
			bne ---
		sty itemlist_len	; store list length
		tya	; now result is in A, Y and Z flag ;)
		rts

itemlist_list ; list items
		lda itemlist_len
		beq none
		jsr indent1
		lda #0	; dummy separator
		sta .idx	; and start index
---			jsr my_chrout	; output separator (dummy or comma)
			jsr my_primm	: !tx " ", color_emph, 0
			ldx #MODIFIED8	: .idx = * - 1
			lda itemlist_buf, x
			tax
			ldy item_name_lo, x
			lda item_name_hi, x
			jsr print_AAYY
			;lda #color_std	; this would allow the comma separator to appear at start of next line!
			;jsr my_chrout
			lda #','	; separator for next iteration, if there is one
			inc .idx
			ldx .idx
			cpx itemlist_len
			bne ---
		jsr my_primm	: !tx color_std, cr, 0
		rts

none ; show string instead of empty item list
		jsr my_primm	: !tx color_out
!if DEUTSCH {	!tx " (keine)"	} else {	!tx " (none)"	}
		!tx color_std, cr, 0
		rts
!zone
itemlist_menu_X_X ; list up items with characters (DO NOT CALL IF LIST IS EMPTY!)
; X says whether to do size check on items (influences color)
; X returns limiting (illegal) index
		stx .size_check
		lda itemlist_len
		cmp #LIST_LEN_LIMIT	; if too many, limit
		bcc +
			lda #LIST_LEN_LIMIT
+		sta .limit
		jsr indent0
		lda #'a'	; first list key
		sta .character
		lda #0	; start index
		sta .idx
---			jsr my_primm	: !tx " [", 0
			lda #color_emph	; set color to "item can be used"
			jsr my_chrout
			; check for size?
			ldx #MODIFIED8	: .size_check = * - 1
			beq .show_char
				; check size
				ldx .idx
				lda itemlist_buf, x
				tax
				lda item_weight, x
				bpl .show_char
					; change color to "item cannot be used"
					lda #color_out
					jsr my_chrout
.show_char		jsr my_primm
.character	!tx MODIFIED8, color_std, "] ", 0
			ldx #MODIFIED8	: .idx = * - 1
			lda itemlist_buf, x
			tax
			ldy item_name_lo, x
			lda item_name_hi, x
			jsr print_AAYY
			lda #cr
			jsr my_chrout
			inc .character
			inc .idx
			ldx .idx
			cpx #MODIFIED8	: .limit = * - 1
			bne ---
		rts	; X returns limiting (illegal!) index

engine_use_X ; scan "usages" for correct code sequence and execute	FIXME - better use a table than a list!
		stx .hinz
		; scan chain
		lda #<uses
		ldx #>uses
		jmp .entry
.next_entry		lda #MODIFIED8	: .link_lo = * - 1
			ldx #MODIFIED8	: .link_hi = * - 1
.entry			sta runptr
			stx runptr + 1
			ldy #0
			lda (runptr), y	; get link, low
			sta .link_lo
			iny
			lda (runptr), y	; get link, high
			bne +
				; end_of_chain
				sec	; return "no match found"
				rts
+			sta .link_hi
			; now check current combination
			iny
			lda (runptr), y	; get item
			cmp #MODIFIED8	: .hinz = * - 1
			bne .next_entry
		; found match
		ldy runptr + 1
		lda #3
		clc
		adc runptr
		bcc +
			iny
+		jsr interpreter_run_YYAA
		lda #cr
		jsr my_chrout
		clc	; return "ok, usage has been found and called"
		rts

!zone

engine_combine_A_with_X ; scan "combinations" for correct code sequence and execute
		; if A is larger, exchange A and X
		sta .hinz
		stx .kunz
		cpx .hinz
		bcs +
			; exchange
			stx .hinz
			sta .kunz
+		; scan chain
		lda #<combis
		ldx #>combis
		jmp .entry
.next_entry		lda #MODIFIED8	: .link_lo = * - 1
			ldx #MODIFIED8	: .link_hi = * - 1
.entry			sta runptr
			stx runptr + 1
			ldy #0
			lda (runptr), y	; get link, low
			sta .link_lo
			iny
			lda (runptr), y	; get link, high
			bne +
				; end_of_chain
				sec	; return "no match found"
				rts
+			sta .link_hi
			; now check current combination
			iny
			lda (runptr), y	; get first item
			;beq .match1	; zero matches ANYTHING
			; FIXME - this "match ANYTHING" idea will not work, because of item ordering!
			cmp #MODIFIED8	: .hinz = * - 1
			bne .next_entry
.match1			iny
			lda (runptr), y	; get second item
			;beq .match2	; zero matches ANYTHING
			cmp #MODIFIED8	: .kunz = * - 1
			bne .next_entry
.match2		; both items match!
		ldy runptr + 1
		lda #4
		clc
		adc runptr
		bcc +
			iny
+		jsr interpreter_run_YYAA
		lda #cr
		jsr my_chrout
		clc	; return "ok, combination has been found and called"
		rts

engine_check_restart
		; check "restart" flag:
		lda #MODIFIED8	: restart_flag = * - 1
		beq ++
			; re-init vars with default values
			; effectively this algo limits game vars to a maximum of 255
			ldx #gamevars_COUNT
--				lda gamevars_defaults_lo - 1, x
				sta gamevars_lo - 1, x
				lda gamevars_defaults_hi - 1, x
				sta gamevars_hi - 1, x
				dex
			bne --
			stx restart_flag	; inhibit this until someone requests it again
++		rts

engine_new_location ; show current location
		; clear directions
		lda #0
		ldx #6
--			sta directions_hi - 1, x	; no need to zero low as well
			dex
			bne --
		jsr pre_situation	; clear screen and invert title bar,
		; so next line output will become title
		; execute code from current location
		lda gamevars_lo + vo_PLAYER
		ldy gamevars_hi + vo_PLAYER
		jsr interpreter_run_YYAA
		; now text should be on screen and possible directions in buffers.
		; show local items:
		jsr my_primm
!if DEUTSCH {	!tx cr, "Dinge:", 0	} else {	!tx cr, "Items:", 0	}
		lda gamevars_lo	+ vo_PLAYER
		ldy gamevars_hi	+ vo_PLAYER
		jsr itemlist_at_YYAA_new	; scan items
		jmp itemlist_list

show_paths ; output list of possible directions:
		jsr my_primm
!if DEUTSCH {	!tx cr, "Wege:", 0	} else {	!tx cr, "Paths:", 0	}
		ldx #0
---
			lda #' '
			jsr my_chrout	; output separator
			ldy #color_out
			lda directions_hi, x	; check high byte for zero (if zero, assume low byte is zero as well)
			beq +
				ldy #color_emph
+			tya
			jsr my_chrout
			ldy dirs_lo, x
			lda dirs_hi, x
			jsr print_AAYY
			inx
			cpx #6
			bne ---
		jsr my_primm	: !tx color_std, cr, cr, 0
		rts

!macro unknown_cmd { ; error handler called on illegal byte code
		dec restart_flag
		jsr my_primm
!if DEUTSCH {
		!tx CR, CR, "BUG: unbekannte Byte-Code-Anweisung!", 0
} else {
		!tx CR, CR, "BUG: encountered unknown instruction!", 0
}
		jmp exit
}

!macro too_deep { ; error handler called if recursion too deep
		dec restart_flag
		jsr my_primm
!if DEUTSCH {
		!tx CR, CR, "BUG: Rekursion zu tief!", 0
} else {
		!tx CR, CR, "BUG: recursion too deep!", 0
}
		jmp exit
}

; bytecode interpreter:

engine_describe_X ; execute code to describe item X
		lda item_desc_lo, x
		ldy item_desc_hi, x
		; FALLTHROUGH
interpreter_run_YYAA ; execute bytecode block
		sta runptr
		sty runptr + 1
		lda #0	; no offset and no recursion
		sta recursion_depth
interpreter_go_on ; enter with A = offset to add
		clc
		adc runptr
		sta runptr
		bcc +
			inc runptr + 1
+		; get byte code and execute
		ldy #0
		lda (runptr), y
		cmp #CMDLIMIT
		bcc +
			+unknown_cmd
+		asl
		tax
; FIXME - why this ASL:TAX stuff? Just use separate tables for lo/hi!
		lda cmd_table, x
		sta .vector
		lda cmd_table + 1, x
		sta .vector + 1
		jmp MODIFIED16	: .vector = * - 2
;---------------------------------------
	; macro magic to assign instruction codes and put pointers into table
	!macro instruction ~.code, ~.ptr {
.ptr
		.code = instruction_enum
		!set instruction_enum = instruction_enum + 1
		; if we know where the command table is, write to it
		.buf = *	; outside of ifdef to make sure locals are counted correctly
		!ifdef cmd_table {
			* = cmd_table + 2 * .code
			!wo .ptr
			* = .buf	; go back to where we came from
		}
	}
;---------------------------------------
	!set instruction_enum = 0	; let's go!
;---------------------------------------
; all command handlers are entered with runptr pointing to command and Y=0
;---------------------------------------
	!macro end_itemdesc	{!by CMD_ENDOFBLOCK	}
	!macro end_use		{!by CMD_ENDOFBLOCK	}
	!macro end_combi	{!by CMD_ENDOFBLOCK	}
	!macro end_procedure	{!by CMD_ENDOFBLOCK	}
	!macro end_location	{!by CMD_ENDOFBLOCK	}
+instruction ~CMD_ENDOFBLOCK, ~cmd_endofblock
		ldx recursion_depth
		bne +
			rts	; no recursion? then return to caller
+		; leave recursion level
		dex
		lda softstack_lo, x
		sta runptr
		lda softstack_hi, x
		sta runptr + 1
		stx recursion_depth
		lda #3	; skip "GOSUB" command and two parameter bytes
		jmp interpreter_go_on
;---------------------------------------
	!macro print		{!by CMD_PRINT	}
	!macro terminate	{!by 0		}
			jsr indent0
--			jsr my_chrout
+instruction ~CMD_PRINT, ~cmd_print
			inc runptr
			bne +
				inc runptr + 1
+			lda (runptr), y
			bne --
		; if text does not end on CR, word wrap buffer will be flushed by main loop
		lda #1
		jmp interpreter_go_on
;---------------------------------------
	!macro north	.target	{!by CMD_NORTH:	!wo .target	}
	!macro south	.target {!by CMD_SOUTH:	!wo .target	}
	!macro west	.target {!by CMD_WEST:	!wo .target	}
	!macro east	.target {!by CMD_EAST:	!wo .target	}
	!macro up	.target {!by CMD_UP:	!wo .target	}
	!macro down	.target {!by CMD_DOWN:	!wo .target	}
+instruction ~CMD_NORTH, ~cmd_north
		ldx #offset_NORTH
		+bit16
+instruction ~CMD_SOUTH, ~cmd_south
		ldx #offset_SOUTH
		+bit16
+instruction ~CMD_WEST, ~cmd_west
		ldx #offset_WEST
		+bit16
+instruction ~CMD_EAST, ~cmd_east
		ldx #offset_EAST
		+bit16
+instruction ~CMD_UP, ~cmd_up
		ldx #offset_UP
		+bit16
+instruction ~CMD_DOWN, ~cmd_down
		ldx #offset_DOWN
		iny
		lda (runptr), y
		sta directions_lo, x
		iny
		lda (runptr), y
		sta directions_hi, x
		lda #3
		jmp interpreter_go_on

!if DEUTSCH {
north	!tx "Nord", 0
south	!tx "S", ü, "d", 0
west	!tx "West", 0
east	!tx "Ost", 0
up	!tx "Hoch", 0
down	!tx "Runter", 0
} else {
north	!tx "North", 0
south	!tx "South", 0
west	!tx "West", 0
east	!tx "East", 0
up	!tx "Up", 0
down	!tx "Down", 0
}
dirs_lo	!by <north, <south, <west, <east, <up, <down	; FIXME - use offsets to build table?
dirs_hi	!by >north, >south, >west, >east, >up, >down
	offset_NORTH	= 0
	offset_SOUTH	= 1
	offset_WEST	= 2
	offset_EAST	= 3
	offset_UP	= 4
	offset_DOWN	= 5
;---------------------------------------
	; CAUTION! a macro like "if a < b then execute block" is internally
	; implemented as "if not a < b then goto after block", therefore all
	; the actual bytecode commands use negated conditions here!
	!macro if_equal			.vo1, .vo2, .t	{!by CMD_IFNOTEQUAL,		.vo1, .vo2	: !wo .t	}
	!macro if_not_equal		.vo1, .vo2, .t	{!by CMD_IFEQUAL,		.vo1, .vo2	: !wo .t	}
	!macro if_smaller		.vo1, .vo2, .t	{!by CMD_IFGREATEROREQUAL,	.vo1, .vo2	: !wo .t	}
	!macro if_smaller_or_equal	.vo1, .vo2, .t	{!by CMD_IFGREATER,		.vo1, .vo2	: !wo .t	}
	; CAUTION! there is no need to implement "smaller than", as we can just
	; use "greater than" with swapped operands. Same for "smaller or equal".
	!macro if_greater		.vo1, .vo2, .t	{!by CMD_IFGREATEROREQUAL,	.vo2, .vo1	: !wo .t	}
	!macro if_greater_or_equal	.vo1, .vo2, .t	{!by CMD_IFGREATER,		.vo2, .vo1	: !wo .t	}
; virtual flags	for:	<	>	unused	==
.flags		!by	%0001,	%1101,	0,	%0110	; bits mean  >   >=   ==   !=
+instruction ~CMD_IFNOTEQUAL,		~cmd_ifnotequal
		lda #%0001
		+bit16
+instruction ~CMD_IFEQUAL,		~cmd_ifequal
		lda #%0010
		+bit16
+instruction ~CMD_IFGREATEROREQUAL,	~cmd_ifgreaterorequal
		lda #%0100
		+bit16
+instruction ~CMD_IFGREATER,		~cmd_ifgreater
		lda #%1000
		sta .wanted_bit
		; get var offsets
		iny
		lda (runptr), y
		tax	; X = var offset 1
		iny
		lda (runptr), y
		tay	; Y = var offset 2
		; subtract
		sec
		lda gamevars_lo, x
		sbc gamevars_lo, y
		sta .low
		lda gamevars_hi, x
		sbc gamevars_hi, y		; C set means: v1 >= v2, C clear means: v1 < v2
		ldy #2	; restore Y to be prepared for possible GOTO
		ora #MODIFIED8	: .low = * - 1	; Z set means: v1 == v2, Z clear means: v1 != v2
		; convert flags to bit mask
		php
		pla
		and #%00000011	; of %NV-BDIZC, only keep ZC
		; %00 means less than, %01 means more than, %10 is impossible, %11 means equal
		; convert result type to virtual flags
		tax
		lda .flags, x
		; now check for desired flag
		and #MODIFIED8	: .wanted_bit = * - 1
		bne cmd_goto
			lda #5
			jmp interpreter_go_on
;---------------------------------------
	!macro gosub	.target {!by CMD_GOSUB:	!wo .target	}
+instruction ~CMD_GOSUB, ~cmd_gosub
		; recursed too far?
		ldx recursion_depth
		cpx #MAX_RECURSIONS
		bcc +
			+too_deep
+		; no, then stack current pointer
		lda runptr
		sta softstack_lo, x
		lda runptr + 1
		sta softstack_hi, x
		; CAUTION - pointer must be advanced when returning!
		; change recursion depth
		inx
		stx recursion_depth
		;FALLTHROUGH to "goto"
;---------------------------------------
	!macro goto	.target	{!by CMD_GOTO:	!wo .target	}
+instruction ~CMD_GOTO, ~cmd_goto	; to implement if/else/endif blocks and "callproc"
; this entry point is also used by the "gosub" macro ("callproc")
; this entry point is used by the four "if" macros as well when they jump!
		iny
		lda (runptr), y
		tax
		iny
		lda (runptr), y
		stx runptr
		sta runptr + 1
		lda #0
		jmp interpreter_go_on
;---------------------------------------
	!macro callasm	.target	{!by CMD_CALLASM:	!wo .target	}
+instruction ~CMD_CALLASM, ~cmd_callasm
		iny
		lda (runptr), y
		sta .jsr_arg
		iny
		lda (runptr), y
		sta .jsr_arg + 1
		jsr MODIFIED16	: .jsr_arg = * - 2
		lda #3
		jmp interpreter_go_on
;---------------------------------------
	!macro delay	.var_offset	{!by CMD_DELAY, .var_offset	}
+instruction ~CMD_DELAY, ~cmd_delay
		iny
		lda (runptr), y
		tax
		lda gamevars_lo, x
		jsr wait_A_tenths
		lda #2
		jmp interpreter_go_on
;---------------------------------------
	!macro varinc	.var_offset	{!by CMD_VARINC, .var_offset	}
	!macro vardec	.var_offset	{!by CMD_VARDEC, .var_offset	}
+instruction ~CMD_VARINC, ~cmd_varinc
		iny
		lda (runptr), y
		tax
		inc gamevars_lo, x
		bne +++
			inc gamevars_hi, x
			jmp +++
+instruction ~CMD_VARDEC, ~cmd_vardec
		iny
		lda (runptr), y
		tax
		lda gamevars_lo, x
		bne +
			dec gamevars_hi, x
+		dec gamevars_lo, x
+++		lda #2
		jmp interpreter_go_on
;---------------------------------------
	!macro varcopy	.vo_target, .vo_source {!by CMD_VARCOPY, .vo_source, .vo_target	}
+instruction ~CMD_VARCOPY, ~cmd_varcopy
		iny
		lda (runptr), y
		tax
		lda gamevars_lo, x
		pha
			lda gamevars_hi, x
			pha
				iny
				lda (runptr), y
				tax
			pla
			sta gamevars_hi, x
		pla
		sta gamevars_lo, x
		lda #3
		jmp interpreter_go_on
;---------------------------------------
	!macro varloadimm	.vo_target, .literal {!by CMD_VARLOADIMM, .vo_target: !wo .literal	}
+instruction ~CMD_VARLOADIMM, ~cmd_varloadimm
		; get target offset
		iny
		lda (runptr), y
		tax
		; copy low byte
		iny
		lda (runptr), y
		sta gamevars_lo, x
		; copy high byte
		iny
		lda (runptr), y
		sta gamevars_hi, x
		lda #4
		jmp interpreter_go_on
;---------------------------------------
	; add more instructions here
;---------------------------------------
	CMDLIMIT = instruction_enum

cmd_table
		; reserve space for command pointers
		* = * + 2 * CMDLIMIT
		; table will be filled in by "instruction" macro in later pass!

	; special macro for "usages" list: make sure to put smaller value first
	!macro ordered .hinz, .kunz {
		; commented out because not needed, actually (values are assigned first)
		;.dummy = .hinz + .kunz	; make sure we do passes until both are resolved
		;!ifdef .dummy {
			!if .hinz < .kunz {
				!by .hinz, .kunz
			} else {
				!by .kunz, .hinz
			}
		;} else {
		;	!by 0, 0	; make sure to produce same length
		;}
	}

;---------------------------------------
; now that all engine macros are defined,
; we can call the macro containing the game description tables:
	+game_tables