mca2.a

;ACME 0.96.2
; Name		mca2
; Purpose	multiple choice adventure 2
; Author	(c) Marco Baye, 2017
; Licence	Free software
; Changes:
;  3 Sep 2016	First try, posted to forum64
;  4 Sep 2016	added some comments and shaved off a byte
; 24 Jun 2017	started work to convert from original mca to mca2
; 26 Jun 2017	got it to work
; 16 Aug 2017	looks finished enough to release v1.1 of demo game

	!src <6502/std.a>	; for +bit16
	;!ct pet	; disabled, strings are now in ISO 8859-1 or UTF-8

; helper values
	MODIFIED8	= $ff
	LIST_LEN_LIMIT	= 24	; with prompt underneath, screen shouldn't scroll

; -- start of program binary --

	* = load_addr
!if MAKE_BASIC_HEADER {
		!wo line2, 2017
		+arch_basicstuff	; add architecture-specific basic instructions
		!by $9e, $20	; "sys "
		!by '0' + entry % 10000 / 1000
		!by '0' + entry %  1000 /  100
		!by '0' + entry %   100 /   10
		!by '0' + entry %    10
		!by $3a, $8f, $20	; ":rem "
		!pet "saufbox!", 0
line2		!wo 0
} else {
		+arch_header
}
; main program
entry ; entry point for SYS
		; init
		cld
		tsx
		stx sp_buffer
		+arch_init
		+arch_output_init	; setup own charset, vic registers, etc.
		; FIXME - fade in!
		jsr my_primm	: !tx color_std, controlcode_CLEAR, 0
		+arch_set_colors	; FIXME - should be called after credits screen!
; now enter actual main loop:
		jsr engine_check_restart	; reset vars to default?
		jsr indent1
		lda #<proc_intro
		ldy #>proc_intro
		jsr interpreter_run_YYAA
		jsr engine_new_location	; show start location
		jsr inventory	; show inventory once without being asked
; actual main loop:
		; wait for command
.get			jsr show_paths
			jsr get_key
			ldx #0
--				cmp keys_start, x
				bne +
					; found, so call action handler
					lda action_lo, x
					sta .call
					lda action_hi, x
					sta .call + 1
					jsr MODIFIED16	: .call = * - 2
					jmp .get
+				inx
				cpx #keys_end - keys_start
				bne --
			jsr my_primm
!if DEUTSCH {	!tx "(falsche Taste, dr", ü, "ck '?' f", ü, "r Hilfe)", cr, 0
} else {	!tx "(wrong key, press '?' for help)", cr, 0 }
			jmp .get

help ; "?" command
		jsr my_primm
!if DEUTSCH {	!tx cr, "M", ö, "gliche Befehle:", cr, color_emph
		!tx "  Nord S", ü, "d West Ost Hoch Runter", cr
		!tx "  Inventar(=F3) Grabsch Verliere", cr
		!tx "  Untersuche Benutze Kombiniere", cr, color_std
		!tx "Immer nur den ersten Buchstaben tippen!", cr
		!tx "CLR/HOME(=F1) baut den Bildschirm neu auf.", cr
		!tx "Zum Bewegen k", ö, "nnen auch "
		!if ALLOW_CURSOR {
			!tx "die Cursortasten und "
		}
		!tx "+/- benutzt werden"
		!if ALLOW_KEYPAD {
			!tx ", au", ß, "erdem die Zehnertastatur."
		}
		!tx "."
} else {	!tx "Allowed commands:", cr
		!tx "  North South West East Up Down", cr
		!tx "Inventory(=F3) Take Lose", cr
		!tx "eXamine Apply Combine", cr
		!tx "Type the first character only!", cr
		!tx "CLR/HOME(=F1) will redisplay the screen.", cr
		!tx "Moving around can also be done using "
		!if ALLOW_CURSOR {
			!tx "the cursor keys and "
		}
		!tx "the +/- keys"
		!if ALLOW_KEYPAD {
			!tx ", and the numerical keypad is also possible"
		}
		!tx "."
}
		!tx cr, 0
		rts

!ct raw {
	!if KEYBOARD_IS_PETSCII {
		!ct pet	; if sys_getin returns petscii, use petscii for these tables as well:
	}

keys_start
		!if ALLOW_CURSOR {
			!tx controlcode_UP, controlcode_DOWN, controlcode_LEFT, controlcode_RIGHT
		}
		!tx "+-"
		!if ALLOW_KEYPAD {
			!tx "82465"
		}
		!tx controlcode_CLEAR, controlcode_HOME, petscii_F1, petscii_F3	; FIXME - move F1/F3 to arch macro!
		!if DEUTSCH {
			!tx "?nswohrigvubk"
		} else {
			!tx "?nsweuditlxac"
		}
keys_end
}	; back to standard encoding

action_lo
		!if ALLOW_CURSOR {
			!by <go_n, <go_s, <go_w, <go_e
		}
		!by <go_u, <go_d
		!if ALLOW_KEYPAD {
			!by <go_n, <go_s, <go_w, <go_e, <redisp
		}
		!by <redisp, <redisp, <redisp, <inventory
		!by <help, <go_n, <go_s, <go_w, <go_e, <go_u, <go_d, <inventory, <take, <lose, <examine, <use, <combine
action_hi
		!if ALLOW_CURSOR {
			!by >go_n, >go_s, >go_w, >go_e
		}
		!by >go_u, >go_d
		!if ALLOW_KEYPAD {
			!by >go_n, >go_s, >go_w, >go_e, >redisp
		}
		!by >redisp, >redisp, >redisp, >inventory
		!by >help, >go_n, >go_s, >go_w, >go_e, >go_u, >go_d, >inventory, >take, >lose, >examine, >use, >combine

; "redisplay" command
	redisp = engine_new_location

; direction commands
go_n		ldx #offset_NORTH
		+bit16
go_s		ldx #offset_SOUTH
		+bit16
go_w		ldx #offset_WEST
		+bit16
go_e		ldx #offset_EAST
		+bit16
go_u		ldx #offset_UP
		+bit16
go_d		ldx #offset_DOWN
		lda directions_hi, x
		bne +
			; player chose an illegal direction
			jsr indent1
			jsr my_primm
!if DEUTSCH {		!tx "Richtung nicht m", ö, "glich, bitte eine andere w", ä, "hlen.", cr, 0
} else {		!tx "Illegal direction, please choose another.", cr, 0	}
			rts
+		tay
		lda directions_lo, x
		sty gamevars_hi + vo_PLAYER
		sta gamevars_lo + vo_PLAYER
		jmp engine_new_location

inventory ; "inventory" command
		jsr my_primm
!if DEUTSCH {	!tx "Dinge im Inventar:", 0
} else {	!tx "Things in inventory:", 0	}
		ldy #>location_INVENTORY
		lda #<location_INVENTORY
		jsr itemlist_at_YYAA_new
		jmp itemlist_list

take ; "take" command
		jsr my_primm
!if DEUTSCH {	!tx "Grabsch:", cr, 0
} else {	!tx "Take:", cr, 0	}
		ldy gamevars_hi + vo_PLAYER
		lda gamevars_lo + vo_PLAYER
		jsr itemlist_at_YYAA_new	; returns number in Y, A and Z ;)
		bne +
			jsr my_primm
!if DEUTSCH {		!tx " Nichts da zum Grabschen!", cr, 0
} else {		!tx " There is nothing to take!", cr, 0	}
			rts
+		ldx #1	; yes, do size checking
		jsr itemlist_menu_X_X	; returns first illegal index in X
		jsr select	; returns status in C and maybe index in X
		bcc +
			jsr my_primm
!if DEUTSCH {		!tx "- nichts gegrabscht!", cr, 0
} else {		!tx "- nothing taken!", cr, 0	}
			rts
+		jsr my_primm	: !tx ":", cr, 0
		; check size
		lda item_weight, x
		bpl +
			jsr my_primm
!if DEUTSCH {		!tx "Nein, das kann man nicht mitnehmen!", cr, 0
} else {		!tx "No, you cannot take that with you!", cr, 0	}
			rts
+		; take: set item's location to INVENTORY
		lda #>location_INVENTORY
		sta gamevars_hi, x
		lda #<location_INVENTORY
		sta gamevars_lo, x
		jsr my_primm
!if DEUTSCH {	!tx "Ok, gegrabscht!", cr, 0
} else {	!tx "Ok, took it!", cr, 0	}
		rts

lose ; "lose" command
		jsr my_primm
!if DEUTSCH {	!tx "Verliere:", cr, 0
} else {	!tx "Lose:", cr, 0	}
		ldy #>location_INVENTORY
		lda #<location_INVENTORY
		jsr itemlist_at_YYAA_new	; returns number in Y, A and Z ;)
		bne +
			jsr my_primm
!if DEUTSCH {		!tx " Nichts da zum Verlieren!", cr, 0
} else {		!tx " There is nothing to lose!", cr, 0	}
			rts
+		ldx #0	; no size check
		jsr itemlist_menu_X_X	; returns first illegal index in X
		jsr select	; returns status in C and maybe index in X
		bcc +
			jsr my_primm
!if DEUTSCH {		!tx "- nichts verloren!", cr, 0
} else {		!tx "- nothing lost!", cr, 0	}
			rts
+		jsr my_primm	: !tx ":", cr, 0
		; drop: copy player's location to item's location
		lda gamevars_hi + vo_PLAYER
		sta gamevars_hi, x
		lda gamevars_lo + vo_PLAYER
		sta gamevars_lo, x
		jsr my_primm
!if DEUTSCH {	!tx "Ok, verloren!", cr, 0
} else {	!tx "Ok, lost it!", cr, 0	}
		rts

examine ; "examine" command
		jsr my_primm
!if DEUTSCH {	!tx "Untersuche:", cr, 0
} else {	!tx "Examine:", cr, 0	}
		; get list of items at location
		ldy gamevars_hi + vo_PLAYER
		lda gamevars_lo + vo_PLAYER
		jsr itemlist_at_YYAA_new
		; extend list with items in inventory
		ldy #>location_INVENTORY
		lda #<location_INVENTORY
		jsr itemlist_at_YYAA_add	; returns number in Y, A and Z ;)
		bne +
			jsr my_primm
!if DEUTSCH {		!tx " Nichts da zum Untersuchen!", cr, 0
} else {		!tx " There is nothing to examine!", cr, 0	}
			rts
+		ldx #0	; no size check
		jsr itemlist_menu_X_X	; returns first illegal index in X
		jsr select	; returns status in C and maybe index in X
		bcc +
			jsr my_primm
!if DEUTSCH {		!tx "- nichts untersucht!", cr, 0
} else {		!tx "- nothing examined!", cr, 0	}
			rts
+		jsr my_primm	: !tx ":", cr, 0
		; examine: execute item's description code
		jsr indent1
		jsr engine_describe_X
		jsr my_primm	: !tx color_std, cr, 0
		rts

use ; "use" command
		jsr my_primm
!if DEUTSCH {	!tx "Benutze:", cr, 0
} else {	!tx "Use:", cr, 0	}
		; get list of items in inventory
		ldy #>location_INVENTORY
		lda #<location_INVENTORY
		jsr itemlist_at_YYAA_new
		; extend list with items at location
		ldy gamevars_hi + vo_PLAYER
		lda gamevars_lo + vo_PLAYER
		jsr itemlist_at_YYAA_add	; returns number in Y, A and Z ;)
		bne +
			jsr my_primm
!if DEUTSCH {		!tx " Nichts da zum Benutzen!", cr, 0
} else {		!tx " There is nothing to use!", cr, 0	}
			rts
+		ldx #0	; no size check
		jsr itemlist_menu_X_X	; returns first illegal index in X
		jsr select	; returns status in C and maybe index in X
		bcc +
.no_use			jsr my_primm
!if DEUTSCH {		!tx "- nichts benutzt!", cr, 0
} else {		!tx "- nothing used!", cr, 0	}
			rts
+		jsr my_primm	: !tx ":", cr, 0
		; use: execute item's usage code
		jsr indent1
		jsr engine_use_X
		jmp end_of_use_and_combine

combine ; "combine" command
		jsr my_primm
!if DEUTSCH {	!tx "Kombiniere:", cr, 0
} else {	!tx "Combine:", cr, 0	}
		; get list of items in inventory
		ldy #>location_INVENTORY
		lda #<location_INVENTORY
		jsr itemlist_at_YYAA_new
		; extend list with items at location
		ldy gamevars_hi + vo_PLAYER
		lda gamevars_lo + vo_PLAYER
		jsr itemlist_at_YYAA_add	; returns number in Y, A and Z ;)
		bne +
			jsr my_primm
!if DEUTSCH {		!tx " Nichts da zum Kombinieren!", cr, 0
} else {		!tx " There is nothing to combine!", cr, 0	}
			rts
+		; choose first item
		ldx #0	; no size check
		jsr itemlist_menu_X_X	; returns first illegal index in X
		jsr select	; returns status in C and maybe index in X
		bcc +
.no_combi		jsr my_primm
!if DEUTSCH {		!tx "- nichts kombiniert!", cr, 0
} else {		!tx "- nothing combined!", cr, 0	}
			rts
+		stx .hinz
		; choose second item
		; FIXME - inhibit "use X with X"!
		jsr my_primm
!if DEUTSCH {	!tx " mit:", cr, 0
} else {	!tx " with:", cr, 0	}
		ldx #0	; no size check
		jsr itemlist_menu_X_X	; returns first illegal index in X
		jsr select	; returns status in C and maybe index in X
		bcs .no_combi
		;stx .kunz
		jsr my_primm	: !tx ":", cr, 0
		lda #MODIFIED8	: .hinz = * - 1
		; use: call engine with both items
		jsr engine_combine_A_with_X
end_of_use_and_combine
		bcc +
			jsr my_primm
!if DEUTSCH {		!tx "Das geht nicht!", cr, 0
} else {		!tx "That does not work!", cr, 0	}
+		rts

!zone
select ; ask user to select one of the items in the current list (X must be first illegal index)
		stx .limit
		jsr get_key
		sec
!if KEYBOARD_IS_PETSCII {
	!ct pet	; if sys_getin returns petscii, use petscii for comparison character as well:
}
		sbc #'a'	; might be either petscii or ascii/iso/utf8
	!ct raw	; back to standard
		bcc .illegal_key
		cmp #MODIFIED8	: .limit = * - 1
		bcs .illegal_key
		tax	; remember index (list offset)
		clc
		adc #'a'	; ascii/iso/utf8 'a'
		jsr my_chrout
		; convert list offset to item offset
		lda itemlist_buf, x
		tax
		; return result
		clc	; ok
		rts
.illegal_key	sec	; fail
		rts

!zone
;internal_error	jsr my_primm
;		!tx "Internal error!", CR, 0
exit		ldx #MODIFIED8	: sp_buffer = * - 1
		txs
		rts

pre_situation ; called before a new situation (to init screen)
		; make some space
		jsr indent0
		jsr my_primm	: !tx color_std, petscii_CLEAR, petscii_REVSON, 0
		+arch_invert_title
		rts

;---------------------------------------
; helper functions

wait_A_tenths ; wait for the number of .1 seconds given in A
		; convert .1s unit to frames:
		;	for PAL (50Hz), multiply by 5 (4+1)
		;	for NTSC (60Hz), multiply by 6 (4+1+1)
		sta .tenths
		asl	; *2
		asl	; *4
		clc
		adc #MODIFIED8	: .tenths = * - 1	; *5
		; for NTSC, add another time
		ldx is_PAL
		bne +
			clc
			adc .tenths	; *6
+		;FALLTHROUGH
wait_A_frames ; wait for the number of frames given in A
		tax
		+arch_wait_X_frames
		rts

get_key ; wait for user to press key
		lda #0
		jsr my_chrout	; force flushing of word wrap buffer
---			jsr sys_getin
			beq ---
		rts

keep_spinning ; the end of the game
		jmp *