crunch.src

	.page
	.subttl 'crunch   30dec83'
;        crunch
;
;  entry:  txtptr points to start of text to crunch
;  exit:   txtptr points to start of crunched text
;  calls:  chrget
;          chrgot
;          reser
;          kloop
;          rem
;          data
;  collapses all reserved words to tokens.  does
;  not alter data or rem.  removes all graphic
;  characters not in quoted strings
;
;
;  an escape token is implemented as follows:
;
;     as each character on a line of text to be crunched is scanned, an
;     indirect jump is performed. anyone wishing to scan for their own
;     commands should grab off this vector, saving the return vector.
;     on entry, if the carry flag is set, it is still up for grabs.
;     the current text pointer is at txtptr. if the escape
;     routine recognizes the command, it should:
;
;            ) put the length of the reserved word in y
;            ) put the desired 'second' token in a
;            ) clear the carry flag
;
;     if it is not your command, leave the acc. and the carry
;     flag intact. note: the reserved word *must* be >= 2 charcters
;     long. exit through the old vector (for daisy chaining). if
;     the carry flag is clear on entry, it means someone else
;     before you recognizes this command. in this case, just pass
;     control through the old vector

crunch
	jmp (icrnch)
ncrnch
	lda txtptr	;save old text loc
	pha
	lda txtptr+1
	pha
crun05
	jsr chrgot
	jmp crun20

crun10
	jsr chrget
crun20
	bcc crun10	;don't crunch numbers
	jmp (iesclk)    ;give others a chance at this. carry is set.
nesclk
	bcc crun95	;carry clear if someone wanted it

	cmp #0		;end of line?
	beq crun90	;yes...
	cmp #':'	;multi-stmt char?
	beq crun10
	cmp #'?'	;print abreviation?
	bne crun30	;no...
	lda #printk     ;substitute print token
	bne crun75	;branch always
crun30
	cmp #$80	;graphics?
	bcc crun40	;no...
	cmp #pi		;yes...pi?
	beq crun10	;o.k....leave alone
	ldy #1
	jsr kloop	;crunch out graphics
	beq crun05	;branch always
crun40
	cmp #'"'	;quote string?
	bne crun60	;no...
crun50
	jsr chrget
	cmp #0		;end of line?
	beq crun90	;yes...
	cmp #'"'	;close quote?
	beq crun10	;yes...
	bne crun50	;no...
crun60
	jsr reser	;reserved word?
	bcc crun10
	cpy #0	   	;anything to move?
	beq crun70	;no...
	jsr kloop	;crunch it out
crun70
	lda count	;put token...
crun75
	ldy #0
	sta (txtptr),y	;in text
	cmp #remtk
	beq crun80
	cmp #datatk
	bne crun10
	jsr chrget
	jsr data
	jmp crun05
crun80
	jsr chrget
	jsr rem
;
;  no other statements can follow a rem
;
crun90	ldx txtptr
	pla
	sta txtptr+1
	pla
	sta txtptr
	sec		;compute length of line
	txa
	sbc txtptr
	tay
	iny
	rts

crun95			;crunch out old text, install an escape token
	pha		;save second token
	dey
	dey		;waste (# of chars) - 2
	jsr kloop
	ldy #0
	lda #esctk
	sta (txtptr),y	;install escape token...
	iny
	pla
	sta (txtptr),y  ;..and second token
	jsr chrget	;skip over token
	jmp crun10	;and continue with line

	.page
;      kloop
;
;  crunch loop.  moves offset .y characters
;  from txtptr to end of line

kloop
	clc		;compute source address
	tya
	adc txtptr
	sta index1
	lda txtptr+1
	adc #0
	sta index1+1
	ldy #0
kloop2
	jsr indin1	;move source
	sta (txtptr),y	;to destination offset
	iny
	cmp #0		;end of line?
	bne kloop2	;no...
	rts
	.page
;      reser
;
;  search reserved word list for a match
;  entry:  (txtptr) is first char of word to match
;  exit:   .y=length of word matched
;	   .c=success/fail (set/clear) flag
;	   count=token value

reser
	lda #>reslst    ;start search here
	ldy #<reslst
	sta index1+1
	sty index1
	ldy #0
	sty count
	dey
rese10
	iny
rese20
	jsr indtxt
	sec
	sbc (index1),y	;does letter match? (ind.ok)
	beq rese10	;yes...continue
	cmp #$80	;no....end of word?
	beq rese60	;yes...c set...done
;
;  find next word
;
rese30
	lda (index1),y	;ind.ok
	bmi rese40	;found end of current
	iny
	bne rese30
rese40	iny		;start of next
	inc count	;value of token
	clc
	tya
	adc index1
	sta index1
	bcc rese50
	inc index1+1
rese50	clc
	ldy #0
	lda (index1),y	; end of list? ind.ok
	bne rese20	;no...
;
;  yes...carry clear...fail
;
rese60	ora count	;.a=$80 if match
	sta count	;token is formed
	rts

;.end