; -----------------------------------------------------------
; geosDemo (code: ShadowM)
; demo program for "Intro to GEOS Programming" talk at ECCC 2015
; -----------------------------------------------------------
.if	Pass1
	.include	shadowSym
	.include	shadowMac
.endif
; -----------------------------------------------------------
PROC_RCT	=	0	;process IDs
PROC_GFX	=	1
PROC_STR	=	2
NUM_PROC	=	3
RCT_TXT	=	7	;offsets to demo menu texts
GFX_TXT	=	12
STR_TXT	=	17
; -----------------------------------------------------------
	lda	#2	;50% stipple
	jsr	SetPattern
	LoadB	r2L,0
	LoadB	r2H,199
	LoadW	r3,0
	LoadW	r4,319
	jsr	Rectangle	;clear screen
	jsr	initDAs
	LoadW	r0,frzIcons
	jsr	DoIcons
	LoadW	r0,mainMenu
	lda	#0
	jsr	DoMenu
	jsr	primeRnd
	LoadW	r0,procTbl
	lda	#NUM_PROC	;number of processes
	jsr	InitProcesses	;don't activate
	rts		;to MainLoop
; ------------------------------------------------------------
; Calculate number of items in "geos" sub-menu by counting DAs on
; disk and adding 1 for "info" item; update menu tables. Number of
; DAs is stored in a9L.
; ------------------------------------------------------------
initDAs:	LoadW	r6,DA0Text
	LoadB	r7L,#DESK_ACC
	LoadB	r7H,6	;max. no. of DA's
	LoadW	r10,#0	;never mind permanent name
	jsr	FindFTypes
	txa
	beq	20$
	jmp	errHndlr
20$	lda	#6	
	sec
	sbc	r7H	;r7: 6 - no. of DAs found
	beq	60$
	sta	a9L	;no. of DAs found
	clc
	adc	#2	;for info and font menu items
	pha
	ora	#VERTICAL | CONSTRAINED
	sta	geosMenu+6
	pla
	sta	a0L
	asl	a
	asl	a
	asl	a
	asl	a
	sbc	a0L	;mult. by 16 & sub. twice
	sbc	a0L	;is same as mult. by 14
	adc	#14	;(X-pos. of first selection)
	sta	geosMenu+1
	LoadB	a9H,0	;DA name string length
	LoadW	r0,DA0Text
30$	jsr	strWidth	;find longest DA name
	lda	a0L	;won't be > 256
	cmp	a9H
	bcc	40$
	sta	a9H	;save longest name
40$	dec	a9L	;DA counter
	beq	50$
	AddVW	17,r0	;next DA name
	bra	30$
50$	LoadW	r0,blank	;padding
	jsr	strWidth
	lda	a0L
	asl	a	;on either side
	clc
	adc	a9H
	sta	geosMenu+4
60$	rts
; -----------------------------------------------------------
doInfo:	jsr	GotoFirstMenu
	LoadW	r0,infoDB
	jsr	DoDlgBox
	rts
; -----------------------------------------------------------
doFont:	jsr	GotoFirstMenu
	LoadW	r0,fontDB
	LoadB	r7L,FONT	;search for font files
	LoadW	r5,fontName	;selected font name
	LoadW	r10,0	;ignore permanent name
	jsr	DoDlgBox
	lda	r0L
	cmp	#OK
	bne	30$	;user clicked Cancel icon?
	lda	fontName
	beq	20$	;no fonts found?
	jsr	getPtSiz	;load point sizes, show DB
	bcs	30$	;user canceled?
	lda	strEnabl	;string demo running?
	beq	10$
	LoadW	r0,fontLoad
	jsr	LoadCharSet	;change while running
10$	rts
20$	LoadW	fontMsg,fontMsg0 ;"No fonts found."
	bra	40$
30$	LoadW	fontMsg,fontMsg1 	;"No font selected."
40$	LoadB	fontName,0
	lda	strEnabl
	bne	50$	;no cancel dialog if demo is running
	LoadW	r0,noFontDB
	jsr	DoDlgBox
50$	rts
; -----------------------------------------------------------
doQuit:	jsr	GotoFirstMenu
	ldx	#NUM_PROC-1
10$	jsr	BlockProcess	;doesn't trash .X
	dex
	bpl	10$
	jmp	EnterDeskTop
; -----------------------------------------------------------
frzSvc:	ldx	#0	;"Freeze" icon service routine
10$	lda	rctEnabl,x
	beq	20$
	jsr	FreezeProcess
20$	inx
	cpx	#3
	bne	10$
	LoadW	frzBmp,rsmIcon
	LoadW	frzPtr,rsmSvc
	LoadW	r0,frzIcons
	jsr	DoIcons
	rts
; -----------------------------------------------------------
rsmSvc:	ldx	#0	;"Resume" icon service routine
10$	lda	rctEnabl,x
	beq	20$
	jsr	UnfreezeProcess
20$	inx
	cpx	#3
	bne	10$
	LoadW	frzBmp,frzIcon
	LoadW	frzPtr,frzSvc
	LoadW	r0,frzIcons
	jsr	DoIcons
	rts
; -----------------------------------------------------------
;	Get point sizes for font; prompt user to select one.
;	pass:	name of selected font at fontName
;	return:	carry set if user canceled, clear otherwise
; -----------------------------------------------------------
getPtSiz:	LoadW	r0,fontName
	jsr	OpenRecordFile
	txa
	beq	10$
	jmp	errHndlr
10$	ldx	#2
	LoadB	a9L,0	;record counter
20$	txa
	lsr	a
	tay
	dey		;.Y = record no.
	lda	fileHeader,x
	beq	30$	;empty or unused?
	tya
	ldy	a9L
	sta	points,y
	iny
	sty	a9L
	cpy	#9	;point table full?
	beq	40$
30$	inx
	inx
	bne	20$
40$	lda	#0
	ldy	a9L
	sta	points,y
	ldx	#0	;build point sizes string
	LoadW	a6,lblPts
50$	lda	points,x
	jsr	byte2asc	;.X preserved, .Y set to null
	inx
	lda	points,x	;look ahead
	beq	60$
	lda	#','
	sta	(a6),y	;replaces null
	iny
	lda	#' '
	sta	(a6),y
	iny
	tya
	clc
	adc	a6L
	sta	a6L
	lda	#0
	adc	a6H
	sta	a6H
	bra	50$
60$	LoadW	r0,pointDB
	LoadB	pointSz,0
	LoadW	r5,pointSz
	jsr	DoDlgBox
	lda	r0L
	cmp	#CANCEL	;user clicked Cancel icon?
	beq	100$
	lda	pointSz	;else OK or Return
	beq	100$	;empty string?
	jsr	valPoint	;validate point size
	bcc	70$	;validation OK?
	LoadW	r0,badPntDB
	jsr	DoDlgBox
	bra	60$	;try again
70$	jsr	PointRecord
	txa
	beq	80$
	jmp	errHndlr
80$	LoadW	r2,$6000-fontLoad
	LoadW	r7,fontLoad
	jsr	ReadRecord
	txa
	beq	90$
	jmp	errHndlr
90$	jsr	CloseRecordFile
	clc		;font loaded OK
	rts
100$	jsr	CloseRecordFile
	sec		;user canceled
	rts
; -----------------------------------------------------------
;	Validate point size.
;	pass:	pointSz, entered point size (ASCII)
;	return:	.A, point size (record number)
;		carry set on failure, clear otherwise
; -----------------------------------------------------------
valPoint:	ldx	#0
10$	lda	pointSz,x
	beq	40$
	cmp	#'0'	;numeric?
	bcs	20$
	sec
	rts
20$	cmp	#'9'+1
	bcc	30$
	rts
30$	inx
	bne	10$
40$	dex		;convert point size to binary
	lda	pointSz,x	;one's position
	and	#$0f
	sta	a9L
	dex
	bmi	50$	;two digits?
	lda	pointSz,x	;ten's position
	and	#$0f
	sta	a8L
	lda	#10
	sta	a7L
	ldx	#a8L	;destination
	ldy	#a7L
	jsr	BBMult
	lda	a9L
	clc
	adc	a8L
	sta	a9L	;can't be > 256
50$	ldx	#0	;entered point size in table?
60$	lda	points,x
	bne	70$
	sec		;end of table, not found
	rts
70$	cmp	a9L	;point size to load
	beq	80$
	inx
	bne	60$
80$	clc		;validation successful
	rts
; -----------------------------------------------------------
;	Run a Desk Accessory.
; -----------------------------------------------------------
runDA:	tax
	dex		;DAs start at 2nd menu entry
	dex
	stx	a9L
	jsr	GotoFirstMenu
	lda	a9L	;use menu selection no.
	asl	a	;to index into table of
	asl	a	;DA filenames
	asl	a
	asl	a
	clc		;mult. by 16 and add 1
	adc	a9L	;is same as mult. by 17
	adc	#[DA0Text
	sta	r6L
	lda	#0
	adc	#]DA0Text
	sta	r6H
	LoadB	r0L,0	;standard loading for DA's
	LoadB	r10L,0	;unused (see HHGG)
	jsr	GetFile	;run the DA
;	------------------------------------------------
;	return from DA
;	------------------------------------------------
	txa
	beq	50$
	jmp	errHndlr
50$	MoveB	screencolors,r2L	;restore screen colors
	LoadW	r1,$8C00	;color data (by card)
	LoadW	r0,(25*40)
	jsr	FillRam
	LoadB	r2L,15	;recover screen image
	LoadB	r2H,199
	LoadW	r3,0
	LoadW	r4,319
	jsr	RecoverRectangle
60$	rts
; -----------------------------------------------------------
; Rectangles demo (solid and filled).
; -----------------------------------------------------------
rctDemo:	jsr	GotoFirstMenu
	lda	rctEnabl
	beq	10$
	ldx	#PROC_RCT
	jsr	BlockProcess
	lda	#0
	sta	rctEnabl
	jsr	dsablFrz
	LoadW	demoMenu+RCT_TXT,rctText
	jsr	resetScr
	rts
10$	ldx	#PROC_RCT
	jsr	RestartProcess
	jsr	enablFrz
	lda	#$ff
	sta	rctEnabl
	LoadW	demoMenu+RCT_TXT,rctTextE
	rts
; -----------------------------------------------------------
; Graphics demo: splatter some bitmaps across the screen.
; -----------------------------------------------------------
gfxDemo:	jsr	GotoFirstMenu
	lda	gfxEnabl
	beq	10$
	ldx	#PROC_GFX
	jsr	BlockProcess
	lda	#0
	sta	gfxEnabl
	jsr	dsablFrz
	LoadW	demoMenu+GFX_TXT,gfxText
	jsr	resetScr
	rts
10$	LoadB	whichPic,0
	ldx	#PROC_GFX
	jsr	RestartProcess
	jsr	enablFrz
	lda	#$ff
	sta	gfxEnabl
	LoadW	demoMenu+GFX_TXT,gfxTextE
	rts
; -----------------------------------------------------------
; String handling demo.
; -----------------------------------------------------------
strDemo:	jsr	GotoFirstMenu
	lda	strEnabl
	beq	10$
	ldx	#PROC_STR
	jsr	BlockProcess
	lda	#0
	sta	strEnabl
	jsr	dsablFrz
	LoadW	demoMenu+STR_TXT,strText
	jsr	resetScr
	rts
10$	LoadW	r0,askStrDB
	LoadB	showText,0	;initialize to empty string
	LoadW	r5,showText	;address of input string
	jsr	DoDlgBox
	lda	r0L
	cmp	#CANCEL
	beq	40$	;user clicked Cancel icon?
	lda	showText	;else OK or Return
	beq	40$	;empty string?
	lda	fontName	;font selected?
	beq	20$
	LoadW	r0,fontLoad
	jsr	LoadCharSet
	bra	30$
20$	jsr	UseSystemFont
30$	LoadB	styleNdx,0
	ldx	#PROC_STR
	jsr	RestartProcess
	jsr	enablFrz
	lda	#$ff
	sta	strEnabl
	LoadW	demoMenu+STR_TXT,strTextE
40$	rts
; -----------------------------------------------------------
;	Enable Freeze icon when first demo starts.
; -----------------------------------------------------------
enablFrz:	lda	rctEnabl	;any already running?
	ora	gfxEnabl
	ora	strEnabl
	bne	10$
	LoadW	frzBmp,frzIcon
	LoadW	frzPtr,frzSvc
	LoadW	r0,frzIcons
	jsr	DoIcons
10$	rts
; -----------------------------------------------------------
;	Disable Freeze icon when last demo stops.
; -----------------------------------------------------------
dsablFrz:	lda	rctEnabl	;any still running?
	ora	gfxEnabl
	ora	strEnabl
	bne	10$
	LoadW	frzBmp,frzIconD
	LoadW	frzPtr,0
	LoadW	r0,frzIcons
	jsr	DoIcons
10$	rts
; -----------------------------------------------------------
; Show rectangle at random location (without stepping on menu).
; Sizes range from 24-88 pixels wide and 24-56 high.
; -----------------------------------------------------------
showRct:	LoadW	r2,65	;(88 - 24) + 1
	jsr	sidRnd
	lda	r1L
	clc
	adc	#24
	sta	wd	;width of rectangle
	LoadW	r2,33	;(56 - 24) + 1
	jsr	sidRnd
	lda	r1L
	clc
	adc	#24
	sta	ht	;height of rectangle
;	------------------------------------------------
;	calculate X and Y positions of rectangle
;	------------------------------------------------
	lda	#184	;((200 - ht) - 15) - 1
	sec
	sbc	ht
	sta	r2L
	lda	#0
	sta	r2H
	jsr	sidRnd
	lda	r1L
	clc
	adc	#15	;don't step on menu
	sta	ypos
	lda	#[319	;(320 - [demoMenu+4] - wd) - 1
	sec
	sbc	wd
	sta	r2L
	lda	#]319
	sbc	#0
	sta	r2H
	lda	demoMenu+1	;menu bottom edge
	cmp	ypos
	bcc	10$	;might cover menu?
	lda	r2L
	sec
	sbc	demoMenu+4	;menu right edge
	sta	r2L
	lda	r2H
	sbc	demoMenu+5
	sta	r2H
10$	jsr	sidRnd
	lda	demoMenu+1	;need to correct?
	cmp	ypos
	bcc	20$
	lda	r1L
	clc
	adc	demoMenu+4	;adjust to protect menu
	sta	r1L
	lda	r1H
	adc	demoMenu+5
	sta	r1H
20$	MoveW	r1,xpos
;	------------------------------------------------
;	set up for call to Rectangle or FrameRectangle
;	------------------------------------------------
	lda	ypos
	sta	r2L
	clc
	adc	ht
	sta	r2H
	lda	xpos
	sta	r3L
	clc
	adc	wd
	sta	r4L
	lda	xpos+1
	sta	r3H
	adc	#0
	sta	r4H
;	------------------------------------------------
;	fill some rectangles with a pattern, others frame only
;	------------------------------------------------
	lda	#$ff	;solid line
doRect:	jsr	FrameRectangle
	lda	xpos
	clc
	lsr	a
	bcc	30$	;even ? fill : frame only
	rts
30$	PushW	r2
	LoadW	r2,32	;(0 - 31)
	jsr	sidRnd	;choose random fill pattern
	lda	r1L
	jsr	SetPattern
	PopW	r2
	inc	r2L	;fill within rectangle borders
	dec	r2H
	inc	r3L
	bne	40$
	inc	r3H
40$	lda	r4L
	bne	50$
	dec	r4H
50$	dec	r4L
	jsr	Rectangle	;draw fill pattern
	rts
; -----------------------------------------------------------
; Show bitmap at random location (without stepping on menu).
; Bitmaps are 11 cards wide by 56 pixels high; menu is 15 pixels high.
; -----------------------------------------------------------
showGfx:	LoadW	r2,128	;((200 - 56) - 15) - 1
	jsr	sidRnd
	lda	r1L
	clc
	adc	#15	;don't step on menu
	sta	ypos
	lda	demoMenu+1	;menu buttom edge
	cmp	ypos
	bcc	10$	;might cover menu?
	lda	demoMenu+4	;menu right edge in pixels
	lsr	a
	lsr	a
	lsr	a	;convert to cards
	tax
	inx
	stx	a9L	;adjust to protect menu
	lda	#30	;(40 - a9L - 11) + 1
	sec
	sbc	a9L
	sta	r2L
	lda	#0
	sta	r2H
	jsr	sidRnd
	lda	r1L
	clc
	adc	a9L	;offset from left
	sta	xpos
	bne	20$
10$	LoadW	r2,30	;(40 - 11) + 1 = 30
	jsr	sidRnd
	MoveB	r1L,xpos
20$	lda	whichPic	;get bitmap address and size
	asl	a
	tax
	lda	picAddrs,x
	sta	r0L
	lda	picAddrs+1,x
	sta	r0H
	MoveB	xpos,r1L	;low byte from Ddiv
	MoveB	ypos,r1H	;low byte from Ddiv
	lda	picDims,x
	sta	r2L
	lda	picDims+1,x
	sta	r2H
doBitmap:	jsr	BitmapUp
	ldx	whichPic
	inx
	cpx	#4
	bcc	30$
	ldx	#0
30$	stx	whichPic
	rts
; -----------------------------------------------------------
;	Show string at random location (without stepping on
;	menu), using different font styles. Since PutString uses
;	the baseline as the Y position, take the baseline offset
;	into account.
; -----------------------------------------------------------
showStr:	ldx	styleNdx	;get next style in list
	inx
	cpx	#STYLECNT
	bne	10$
	ldx	#0
10$	stx	styleNdx
	lda	styles,x
	sta	style+1
	lda	styleBits,x
	tax
	lda	showText
	jsr	GetRealSize	;get character dimensions
	sta	a9L	;baseline offset
;	------------------------------------------------
	LoadW	r2,186	;Y position: (200-15-char. height)+1
	lda	r2L
	sec
	sbc	a9L
	sta	r2L
	lda	r2H
	sbc	#0
	sta	r2H
	jsr	sidRnd
	lda	r1L
	clc
	adc	#15
	adc	a9L	;character height
	sta	ypos
;	------------------------------------------------
	LoadW	r2,272	;X position (at least one character)
	lda	ypos
	sec
	sbc	a9L	;baseline offset
	sta	a9H	;position of top of character
	lda	demoMenu+1	;menu bottom edge
	cmp	a9H	;might cover menu?
	bcc	20$
	lda	r2L
	sec
	sbc	demoMenu+4	;menu right edge
	sta	r2L
	lda	r2H
	sbc	demoMenu+5
	sta	r2H
	jsr	sidRnd
	lda	r1L
	clc
	adc	demoMenu+4
	sta	xpos
	lda	r1H
	adc	demoMenu+5
	sta	xpos+1
	bra	30$
20$	jsr	sidRnd
	MoveW	r1,xpos
;	------------------------------------------------
30$	LoadW	StringFaultVec,PutStrFault
	MoveW	xpos,r11
	MoveB	ypos,r1H
	LoadW	r0,style
doString:	jsr	PutString
	LoadW	StringFaultVec,0
	rts
; -----------------------------------------------------------
;	Hack for PutString trying to find the next character
;	that will fit when a margin fault occurs: advance the 
;	pointer to the null at the end of the string. See HHGG.
; -----------------------------------------------------------
PutStrFault:	ldy	#0
10$	inc	r0L	;advance to next character
	bne	20$
	inc	r0H
20$	lda	(r0),y	;read it
	bne	10$	;end of string?
	rts		;yes, we've faked out GetString
; -----------------------------------------------------------
; Convert binary byte to decimal string by repeated subtraction.
;	pass:	.A, binary number
;		a6, address to put string (four bytes)
;	return:	null-terminated decimal string at (a6)
;		.Y points to null byte at end
;	destroyed:	a0L (minuend)
;		a1L (accumulator)
;		a1H (division constant)
; -----------------------------------------------------------
byte2asc:	sta	a0L
	ldy	#0
	sty	a1L
	lda	#100
	sta	a1H
10$	lda	a0L
20$	cmp	a1H
	bcc	30$
	sec
	sbc	a1H
	sta	a0L
	inc	a1L
	bne	20$
30$	lda	a1L
	bne	35$
	cpy	#0	;no leading zeros
	beq	37$
35$	ora	#$30
	sta	(a6),y
	iny
	lda	#0
	sta	a1L
37$	lda	a1H
	cmp	#10
	beq	40$
	lda	#10
	sta	a1H
	bne	10$
40$	lda	a0L
	ora	#$30
	sta	(a6),y
	iny
	lda	#0
	sta	(a6),y
	rts
; -----------------------------------------------------------
; Reset screen (erase except for menu area).
; -----------------------------------------------------------
resetScr:	lda	#2	;50% stipple
	jsr	SetPattern
	LoadB	r2L,15	;don't erase menu
	LoadB	r2H,199
	LoadW	r3,0
	LoadW	r4,319
	jsr	Rectangle	;clear screen
	rts
; -----------------------------------------------------------
;	Get string width in pixels.
;	pass:	string address in r0
;	return:	string width in a0
;	destroyed:	a1L
; -----------------------------------------------------------
strWidth:	ldy	#0
	sty	a0L
	sty	a0H
10$	lda	(r0),y
	beq	20$
	sty	a1L
	jsr	GetCharWidth
	clc
	adc	a0L
	sta	a0L
	lda	#0
	adc	a0H
	sta	a0H
	ldy	a1L
	iny
	bne	10$	;string must be < 256 chars.
20$	rts
; -----------------------------------------------------------
;	Generic beep.
; -----------------------------------------------------------
beep:	jsr	enableIO
	LoadB	$d400,#$31	;voice 1 frequency low
	LoadB	$d401,#$1c	;voice 1 frequency high
	LoadB	$d405,#$00	;voice 1 attack/decay
	LoadB	$d406,#$f9	;voice 1 sustain/release
	LoadB	$d418,#$0c	;no filters, volume 12
	LoadB	$d404,#$11	;gate on triangle, voice 1
	LoadB	$d404,#$10	;gate off voice 1
	jsr	restoreIO
	rts	
; -----------------------------------------------------------
;	Prime SID chip to generate random numbers.
; -----------------------------------------------------------
primeRnd:	jsr	enableIO
	lda	#0
	sta	$d40e	;voice 3 frequency low
	lda	#$80	;frequency to $8000
	sta	$d40f	;voice 3 frequency high
	sta	$d412		;noise waveform, gate off 3
	jsr	restoreIO
	rts
; -----------------------------------------------------------
;	Pseudo-random number generator (uses SID chip).
;	pass:	r2, high limit (1-based)
;	return:	r1, pseudo-random number
;	destroyed:	.A, .X, .Y, r1, r8, r9
; -----------------------------------------------------------
sidRnd:	LoadW	r1,65535	;r2 loaded on entry
	ldx	#r1
	ldy	#r2
	jsr	Ddiv
	MoveW	r1,r2	;r2 = 65535 / high limit	
	jsr	enableIO
	lda	$d41b
	sta	r1L
	ldx	#7	;delay at least 32 cycles
10$	dex
	bne	10$
	lda	$d41b
	sta	r1H
	jsr	restoreIO
	ldx	#r1
	ldy	#r2
	jsr	Ddiv	;r1 = r1 / r2
	rts
; -----------------------------------------------------------
;	Enable/disable IO.
; -----------------------------------------------------------
enableIO:	php
	pla
	sta	flagSave
	sei
	lda	$01
	sta	ioSave
	and	#$f8
	ora	#$05
	sta	$01
	rts
;	------------------------------------------------
restoreIO:	lda	ioSave
	sta	$01
	lda	flagSave
	pha
	plp
	rts
; -----------------------------------------------------------
;	Generic error handler.
;	pass:	error no. in .a (99 denotes internal error)
;	return:	kills program and exits to deskTop
; -----------------------------------------------------------
errHndlr:	pha
	and	#$f0
	lsr	a
	lsr	a
	lsr	a
	lsr	a
	ora	#$30
	sta	errorNum
	pla
	and	#$0f
	ora	#$30
	sta	errorNum+1
	jsr	beep
	LoadW	r0,errorDB
	jsr	DoDlgBox
	jmp	EnterDeskTop