[comp.sys.cbm] C-ASSM Sources - Part 02/02

mark@unisec.usi.com (Mark Rinfret) (05/14/87)

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	mem.i
#	menu.a
#	printpkt.i
#	punter.a
#	screen.a
#	sid.a
#	startup.a
#	stdlib.ctl
#	string.a
#	syslib.ctl
#	termio.a
# This archive created: Thu May 14 06:56:46 1987
export PATH; PATH=/bin:$PATH
if test -f 'mem.i'
then
	echo shar: will not over-write existing file "'mem.i'"
else
cat << \SHAR_EOF > 'mem.i'
;
; C64 Memory Assignments
; Filename: mem.i
;
; Zero-page Equates
; -----------------
;
;History:
;
curx     = $d3 ;cursor 'x' position
col      = $d3 ;an alias for curx
crsw     = $d0 ;screen/keyboard flag
cury     = $d6 ;cursor 'y' position
row      = $d6 ;an alias for cury
d6510    = $00 ;data direction register
dfltn    = $99 ;default input device
dflto    = $9a ;default output device
fa       = $ba ;current device number
fnadr    = $bb ;filename
fnlen    = $b7 ;filename length
indx     = $c8 ;end of logical line
jclock   = $a0 ;jiffy clock
la       = $b8 ;current logical file

lstx     = $c5 ;matrix coord. of last keypress

ptr1     = $fb ;pointer ($fb..$fc)
ptr2     = $fd ;pointer ($fd..$fe)
ptr3     = $c3 ;pointer ($c3..$c4)
;
r6510    = $01 ;memory map register
ribuf    = $f7 ;rs-232 input buffer pointer 
robuf    = $f9 ;rs-232 output buffer pointer
rvs      = $c7 ;reverse video flag
;
sa       = $b9 ;current secondary address
status   = $90 ;kernal i/o status byte
;
; *************************************
;
; Non-Zero Page Variables

baudof   = $299 ;rs-232 bit time
buf      = 512 ;input buffer
color    = 646 ;current character color
colormem = $d800 ;color ram
enabl    = $2a1 ;rs-232 busy flag
m51ajb   = $295 ;rs-232 non-standard bit time
qtsw     = 212 ;quote mode switch
rsstat   = $297 ;rs-232 status register
SHAR_EOF
fi # end of overwriting check
if test -f 'menu.a'
then
	echo shar: will not over-write existing file "'menu.a'"
else
cat << \SHAR_EOF > 'menu.a'
; General Menu Support Routines
; Filename: menu.a
;
 .nlst
#include "mem.i" ;standard memory definitions
#include "char.i" ;character code definitions
#include "kernal.i" ;kernal vectors
#include "printpkt.i" ;printpkt code values
 .list

 .ref buzz
 .ref center
 .ref kbwait
 .ref print,println,printpkt
 .ref rvson,rvsoff

; Package parameters:

 .def menu$list
menu$list
 .word 0 ;list of string pointers

titlpkt
 .byte PP$CLR|PP$CENTER ;clear screen, center text
 .byte 0,0
 .def menu$title
menu$title 
 .word 0 ;title string address

;NOTE: menu$title must NOT be moved!  It
;is part of the title packet.

infomsg
 .byte "Position to the desired command and hit\n"
 .byte "RETURN or enter the first character of\n"
 .byte "any command.",0

infopkt
 .byte PP$NULL
 .byte 21,0 ;row,column
 .word infomsg ;string address

chr .byte 0 ;character temp
index .byte 0
lastx .byte 0 ;last index value

 .def menu
menu
 lda #255
 pha ;save it - we'll use it soon
 ldx #<titlpkt ;display title
 ldy #>titlpkt
 jsr printpkt

 pla
 ldx #<infopkt
 ldy #>infopkt
 jsr printpkt

 lda #0 ;initialize menu index
 sta index

menu1 ;display all commands
 jsr menupos
 jsr menustr
 cpx #0 ;end of list?
 bne menu2
 cpy #0
 bne menu2
 beq menu3

menu2
 jsr println
 lda index ;remember last valid entry
 sta lastx
 inc index
 bne menu1

menu3
 lda #0
 sta index
menu4
 jsr menupos ;set cursor position
 jsr rvson ;set reverse mode
 jsr menustr ;get current menu string
 jsr print
 jsr rvsoff ;disable reverse mode
 jsr kbwait ;wait for keypress
 pha ;save character on stack
 jsr menupos
 jsr menustr ;retrieve menu string
 jsr print ;print it, normal mode
 pla ;check keyboard character
 cmp #13 ;carriage return?
 beq menux ;yep - return
 cmp #csrdn ;down?
 bne menu5

;move down to next item
 ldx index
 cpx lastx ;at last one?
 beq menu3 ;yes - start over
 inc index ;no - advance to next
 bne menu4

menu5
 cmp #csrup ;up?
 bne menu6
 ldx index ;yes
 bne menu51
 ldx lastx ;wrap to end of list
 stx index
 bne menu4

menu51
 dec index ;back up to previous
 bpl menu4

menu6
 sta chr ;save keyboard character
 cmp #'a ;first letter of a command?
 bcc menu7
 cmp #'z+1
 bcc menu8 ;match against strings

menu7 
 jsr buzz ;make a nasty sound
 jmp menu4

menu8 ;check 1st char of all strings
 lda index
 pha ;save index
 lda #0
 sta index
menu9
 jsr menustr ;get menu string
 stx ptr1 ;store in zp pointer
 sty ptr1+1
 ldy #0
 lda (ptr1),y ;get 1st character
 and #$7f ;force lower case
 cmp chr ;same as keyboard?
 beq menu10
 inc index
 ldx lastx
 inx
 cmp index ;beyond last index?
 bcs menu9 ;nope
 pla ;restore old index
 sta index
 bcc menu7 ;go give user a buzz 
menu10
 pla ;discard index from stack
menux
 lda #clrscrn ;clear the screen
 jsr chrout
 lda index  
 rts

;
; Get menu string pointer from 
; string pointer list (menu$list+index).
; Returns:
;   string pointer in X,Y
;
menustr
 clc
 lda index
 rol A ;times 2
 adc menu$list
 sta ptr1
 lda #0
 adc menu$list+1
 sta ptr1+1
 ldy #0
 lda (ptr1),y
 tax
 iny
 lda (ptr1),y
 tay
 rts
  
;
; Set cursor position per 'index'
;
menupos
 clc
 lda index
 adc #3
 tax ;row
 ldy #0 ;column
 jsr plot
 rts

SHAR_EOF
fi # end of overwriting check
if test -f 'printpkt.i'
then
	echo shar: will not over-write existing file "'printpkt.i'"
else
cat << \SHAR_EOF > 'printpkt.i'
;Code Definitons for PRINTPKT routine
;Filename: printpkt.i
;History:
;  08/17/86 - File created
;
;Description:
;
;  This file may be included by any
;application package using the printpkt
;routine.  Each equate defined herein
;represents the value of the bit or
;combination of bits as they appear in
;the code word.  Combinations of bits are
;achieved by OR-ing (||) values together.

PP$NULL   = 0

PP$EOL    = 1  ;bit 0
PP$EOS    = 2  ;bit 1
PP$CLR    = 3  ;bits 0+1

PP$RVS    = 4  ;bit 2

PP$BELL   = 8  ;bit 3
PP$GONG   = 16 ;bit 4
PP$BUZZ   = 24 ;bits 3+4

PP$CENTER = 32 ;bit 5

PP$CR     = 64 ;bit 6

PP$WAIT   =128 ;bit 7
SHAR_EOF
fi # end of overwriting check
if test -f 'punter.a'
then
	echo shar: will not over-write existing file "'punter.a'"
else
cat << \SHAR_EOF > 'punter.a'
;New Punter Protocol
;Adapted for C-ASSM Assembler for Pro-Line C-Power
;by Mark Rinfret
;
;Filename: punter.a
;History:
;  05/08/86 - changed escape key to shift run/stop
;  05/20/86 - disk file number is now
;             externally defined
;  05/21/86 - removed C-Power calls for
;             the asm version.
;  05/22/86 - enable transfer of all control characters,
;             call bell sound effect for bell
;
;Conditional assembly switches:

c$term = 0 ;0 => no terminal loop code


;Externally defined symbols:
;
 .def ppaccept,ppexit,ppinit
 .def pprcv,ppxmit
 .def pprtype,ppterm,ppreset,ppttype
 .def ppbtime,ppftype,ppdiskfn

;The old 'dashes, colons and stars' display
;has been replaced with calls to 'pgood'
;and 'pbad' and pend (good block, bad block 
;end block, respectively).

  .ref pgood,pbad,pend 

  .ref bell ;sound effect for bell code

;Note: The buffer location must be chosen
;with care.  The current location is the
;third line of the screen memory area.
;This allows the first two lines of the
;display to be used for information lines.
;In transmit mode, two buffers are used,
;thus occupying locations $0480-$067f or
;lines 2-16.

buffer   = $0450 ;buffer for block (screen)
fa = $ba ;current device number
pnta = $62
pntb = $64
stat = $96
defto = $9a ;default output device (kernal)
ptr1 = $9e ;tape pass1 error log (kernal)
bufpntr = $a6 ;tape i/o buffer pointer [2]
tape1 = $b2 ;start of tape buffer pointer [2]
ribuf = $f7 ;rs232 input buffer pointer
robuf = $f9 ;rs232 output buffer pointer
ci2cra = $dd0e ;control register a
lastch = $200 ;last used character
ridbe = $29b
ridbs = $29c
rodbs = $29d ;rs232 output buffer start
rodbe = $29e ;rs232 output buffer end
rs232enb = $02a1 ;rs232 enable=128, disable=255
ibsout = $326 ;chrout routine vector (kernal) [2]
shflag = $28d ;shift/logo key flag
ti2alo = $dd04 ;timer 2 lo byte
ti2ahi = $dd05 ;timer 2 hi byte
;
codebuf .byte 0,0,0 ;incoming 3 char codes
bitpnt  .byte 0 ;bit pointer for allowable matches
bitcnt  .byte 0 ;bit counter (0 to 4)
bitpat  .byte 0 ;bit pattern for searches
timer1  .word 0 ;timer for non-received characters (2)
gbsave  .byte 0 ;good bad signal needed
bufcount .word 0 ;number of chrs to buffer into block
delay    .byte 0 ;delay for wait period
skpdelay .byte 0 ;delay skip counter
endflag  .byte 0 ;last block flag
check    .bss 4 ;primary checksum (4)
check1   .bss 4 ;secondary checksum (4)
bufpnt   .byte 0 ;current buffer pointer
recsize  .byte 0 ;received buffer size
maxsize  .byte 255 ;maximum block size
blocknum .word 0 ;block number (2)
ppdiskfn .byte 0 ;disk file number
ppftype .byte 0 ;file type (from basic)
stack    .byte 0 ;stack pointer at entry
dontdash .byte 1 ;suppress dashes and colons
specmode .byte 0 ;special start code flag
oldout .word 0 ;old chrout vector
;
;ppbtime must be set by the calling program.
;The formula for calculating it is
;  ppbtime = 1.02273e6 / baud rate
;         = 852 for 1200 baud
;         = 3409 for 300 baud
;
ppbtime .word 3409 ;??? timer value ???
;
;buffer positions
;
sizepos = 4
numpos = 5
datapos = 7
;
basic4 = $ef06 ;basic call from chrout
basic3 = $ef3b ;basic call from chrout
setup = $ef7e ;set up rs232 to receive again
;
;kernal locations
;
basic1 = $f80d ;basic call from chrout
basic2 = $f864 ;basic call from chrout
readst = $ffb7
chkin  = $ffc6 ;open channel for input
chkout = $ffc9 ;open channel for output
clrchn = $ffcc ;close input and output channels
chrin  = $ffcf ;input character from channel
chrout = $ffd2 ;output character to channel
getin  = $ffe4 ;get a character from keyboard queue
zfffe = $fffe
;
startloc
;
ppaccept
 lda #0 ;sys 49152 accept
 .byte $2c
pprcv
 lda #3 ;sys 49155 receive
 .byte $2c
ppxmit
 lda #6 ;sys 49158 transmit
 .byte $2c
pprtype
 lda #9 ;sys 49161 rectype
 .byte $2c
ppttype
 lda #12 ;sys 49164 trantype
 .byte $2c
ppterm
 lda #15 ;sys 49167 term
 nop
 jmp over
ppreset
 jmp reset
 jmp ppinit
;
over
 sta pnta
 tsx 
 stx stack
 lda #<table
 clc 
 adc pnta
 sta jmppoint+1
 lda #>table
 adc #$00
 sta jmppoint+2
jmppoint
 jmp table
;
table
 jmp accept
 jmp receive
 jmp transmit
 jmp rectype
 jmp trantype
 jmp terminal
 jmp ppinit
;
codes
 .byte "goo"
 .byte "bad"
 .byte "ack"
 .byte "s/b"
 .byte "syn"
;
;accept characters and check for codes
;
accept
 sta bitpat ;save required bit pattern
 lda #$00
 sta codebuf
 sta codebuf+1
 sta codebuf+2
cd1
 lda #$00
 sta timer1 ;clear timer
 sta timer1+1
cd2
 jsr exit
 jsr getnum ;get#5,a$
 lda stat
 bne cd3 ;if no chr, do timer check
 lda codebuf+1
 sta codebuf
 lda codebuf+2
 sta codebuf+1
 lda lastch
 sta codebuf+2
 lda #$00
 sta bitcnt ;clear bit counter
 lda #$01
 sta bitpnt ;initialize bit pointer
cd4
 lda bitpat ;look at bit pattern
 bit bitpnt ;is bit set
 beq cd5 ;no, don't check this code word
 ldy bitcnt
 ldx #$00
cd6
 lda codebuf,x
 cmp codes,y
 bne cd5
 iny
 inx 
 cpx #$03
 bne cd6
 jmp cd7
;
cd5
 asl bitpnt ;shift bit pointer
 lda bitcnt
 clc 
 adc #$03
 sta bitcnt
 cmp #15
 bne cd4
 jmp cd1
;
cd7
 lda #255
 sta timer1
 sta timer1+1
 jmp cd2
;
cd3
 inc timer1
 bne cd9
 inc timer1+1
cd9
 lda timer1+1
 ora timer1
 beq cd8
 lda timer1
 cmp #$07
 lda timer1+1
 cmp #20
 bcc cd2
 lda #$01
 sta stat
 jmp dodelay
;
cd8
 lda #$00
 sta stat
 rts
;
;get# for c64
;
getnum1
 nop 
getnum
 tya 
 pha 
 lda ridbe
 cmp ridbs
 beq get1
 ldy ridbs
 lda (ribuf),y
 pha 
 inc ridbs
 lda #$00
 sta stat
 pla
 sta lastch
 pla
 tay
 jmp dorts
;
get1
 lda #$02
 sta stat
 lda #$00
 sta lastch
 pla
 tay
;
dorts
 pha 
 lda #$03 ;current device = screen
 sta fa
 pla
 rts
;
;send a code
;
sendcode
 ldx #$05
 jsr chkout
 ldx #$00
sn1
 lda codes,y
 jsr chrout
 iny
 inx 
 cpx #$03
 bne sn1
 jmp clrchn
;
;do handshaking for reception end
;
rechand
 sta gbsave ;save good or bad signal as needed
 lda #$00
 sta delay ;no delay
rc1
 lda #$02
 sta pnta
 ldy gbsave
 jsr sendcode ;send g/b signal
rc9
 lda #%00100 ;allow "ack" signals
 jsr accept ;wait for code
 lda stat
 beq rc2 ;if ok, send g/b signal again
 dec pnta
 bne rc9
 jmp rc1
;
rc2
 ldy #$09
 jsr sendcode ;send "s/b" code
 lda endflag
 beq rc5
 lda gbsave
 beq rc6
rc5
 lda buffer+sizepos
 sta bufcount
 sta recsize
 jsr recmodem ;wait for block
 lda stat
 cmp #%0001 ;check for good block
 beq rc4
 cmp #%0010 ;check for blank input
 beq rc2
 cmp #%0100 ;check for loss of signal
 beq rc4
 cmp #%1000 ;check for "ack" signal
 beq rc2
rc4
 rts
;
rc6
 lda #%10000 ;wait for "syn" signal
 jsr accept
 lda stat
 bne rc2 ;if not, send "s/b" again
 lda #10
 sta bufcount
rc8
 ldy #12 ;send "syn" signal
 jsr sendcode
 lda #%01000 ;wait for "s/b" signal
 jsr accept
 lda stat
 beq rc7
 dec bufcount
 bne rc8
rc7
 rts
;
;do handshaking for transmission end
;
tranhand
 lda #$01
 sta delay ;use delay
tx2
 lda specmode
 beq tx20
 ldy #$00
 jsr sendcode ;send a "goo" signal
tx20
 lda #%01011 ;allow "goo", "bad", and "s/b"
 jsr accept ;wait for codes
 lda stat
 bne tx2 ;if no signal, wait again
 lda #$00
 sta specmode
 lda bitcnt
 cmp #$00 ;"good" signal
 bne tx10 ;no, resend old block
 lda endflag
 bne tx4
 inc blocknum
 bne tx7
 inc blocknum+1
tx7
 jsr thisbuf
 ldy #numpos ;block number high order part
 iny
 lda (pntb),y
 cmp #255
 bne tx3
 lda #$01
 sta endflag
 lda bufpnt
 eor #$01
 sta bufpnt
 jsr thisbuf
 jsr dummybl1
 jmp tx1
;
tx3
 jsr dummyblk ;yes, get new block

tx1
 jsr pgood
 jmp tx100

tx10
 jsr pbad ;bad block
tx100
 ldy #$06
 jsr sendcode ;send "ack" code
 lda #%01000 ;allow only "s/b" code
 jsr accept ;wait for code
 lda stat
 bne tx1
 jsr thisbuf
 ldy #sizepos ;block size
 lda (pntb),y
 sta bufcount
 jsr altbuf
 ldx #$05
 jsr chkout
 ldy #$00
tx6
 lda (pntb),y ;transmit alternate buffer
 jsr chrout
 iny
 cpy bufcount
 bne tx6
 jsr clrchn
 lda #$00
 rts
;
tx4
 jsr clrchn
 jsr pend ;last block

 ldy #$06
 jsr sendcode ;send "ack" signal
 lda #%01000
 jsr accept ;wait for "s/b" signal
 lda stat
 bne tx4 ;if not, resend "ack" signal
 lda #10
 sta bufcount
tx5
 ldy #12
 jsr sendcode ;send "syn" signal
 lda #%10000
 jsr accept ;wait for "syn" signal back
 lda stat
 beq tx8
 dec bufcount
 bne tx5
tx8
 lda #$03
 sta bufcount
tx9
 ldy #$09
 jsr sendcode ;send "s/b" signal
 lda #$00000
 jsr accept ;just wait
 dec bufcount
 bne tx9
 lda #$01
 rts
;
;receive a block from the modem
;
; stat returns with:
;
;  bit 0 - buffered all characters successfully
;  bit 1 - no characters received at all
;  bit 2 - insufficient characters received
;  bit 3 - "ack" signal received
;
recmodem
 ldy #$00 ;start index
rcm5
 lda #$00 ;clear timers
 sta timer1
 sta timer1+1
rcm1
 jsr exit
 jsr getnum ;get a chr from the modem
 lda stat
 bne rcm2 ;no character received
 lda lastch
 sta buffer,y ;save chr in buffer
 cpy #$03 ;chr one of the first 3
 bcs rcm3 ;no, skip code check
 sta codebuf,y ;save chr in code buffer
 cpy #$02 ;on the 3rd chr
 bne rcm3 ;no, don't look at chrs yet
 lda codebuf ;check for a "ack" signal
 cmp #'a
 bne rcm3
 lda codebuf+1
 cmp #'c
 bne rcm3
 lda codebuf+2
 cmp #'k
 beq rcm4 ;"ack" found
rcm3
 iny ;inc index
 cpy bufcount ;buffered all chrs
 bne rcm5 ;no, buffer next
 lda #%0001 ;yes, return bit 0 set
 sta stat
 rts
;
rcm4
 lda #$ff ;"syn" found, set timer to -1
 sta timer1
 sta timer1+1
 jmp rcm1 ;see if there is another chr
;
rcm2
 inc timer1 ;inc timer
 bne rcm6
 inc timer1+1
rcm6
 lda timer1
 ora timer1+1 ;timer now at zero
 beq rcm7 ;"syn" found with no following chrs
 lda timer1
 cmp #$06
 lda timer1+1
 cmp #16 ;time out yet
 bne rcm1 ;no, get next chr
 lda #%0010 ;yes, set bit 1
 sta stat
 cpy #$00
 beq rcm9
 lda #%0100 ;but if chrs received, set bit 2
 sta stat
rcm9
 jmp dodelay
;
rcm7
 lda #%1000 ;"ack" found, set bit 2
 sta stat
 rts
;
;create dummy block for transmission
;
dummyblk
 lda bufpnt
 eor #$01
 sta bufpnt
 jsr thisbuf ;read block into "this" buffer
 ldy #numpos ;block number
 lda blocknum
 clc 
 adc #$01
 sta (pntb),y ;set block number low part
 iny
 lda blocknum+1
 adc #$00
 sta (pntb),y ;set block number high part
 ldx ppdiskfn
 jsr chkin
 ldy #datapos ;actual block
db1
 jsr chrin
 sta (pntb),y
 iny
 jsr readst
 bne db4
 cpy maxsize
 bne db1
 tya 
 pha 
 jmp db5
;
db4
 tya 
 pha 
 ldy #numpos ;block number
 iny ;high part
 lda #255
 sta (pntb),y
 jmp db5
;
dummybl1
 pha ;save size of just read block
db5
 jsr clrchn
 jsr reset
 jsr dod2
 jsr reset
 ldy #sizepos ;block size
 lda (pntb),y
 sta bufcount ;set bufcount for checksum
 jsr altbuf
 pla
 ldy #sizepos ;block size
 sta (pntb),y
 jsr checksum
 rts
;
;set pointers for current buffer
;
thisbuf
 lda #<buffer
 sta pntb
 lda bufpnt
 clc 
 adc #>buffer
 sta pntb+1
 rts
;
;set pointer b for alternate buffer
;
altbuf
 lda #<buffer
 sta pntb
 lda bufpnt
 eor #$01
 clc 
 adc #>buffer
 sta pntb+1
 rts
;
;calculate checksum
;
checksum
 lda #$00
 sta check1
 sta check1+1
 sta check1+2
 sta check1+3
 ldy #sizepos
cks1
 lda check1
 clc 
 adc (pntb),y
 sta check1
 bcc cks2
 inc check1+1
cks2
 lda check1+2
 eor (pntb),y
 sta check1+2
 lda check1+3
 rol a ;set or clear carry flag
 rol check1+2
 rol check1+3
 iny
 cpy bufcount
 bne cks1
 ldy #$00
 lda check1
 sta (pntb),y
 iny
 lda check1+1
 sta (pntb),y
 iny
 lda check1+2
 sta (pntb),y
 iny
 lda check1+3
 sta (pntb),y
 rts
;
;transmit a program
;
transmit
 lda #$00
 sta endflag
 sta skpdelay
 sta dontdash
 lda #$01
 sta bufpnt
 lda #$ff
 sta blocknum
 sta blocknum+1
 jsr altbuf
 ldy #sizepos ;block size
 lda #datapos
 sta (pntb),y
 jsr thisbuf
 ldy #numpos ;block number
 lda #$00
 sta (pntb),y
 iny
 sta (pntb),y
trm1
 jsr tranhand
 beq trm1
rec3
 lda #$00
 sta lastch
 rts
;
;receive a file
;
receive
 lda #$01
 sta blocknum
 lda #$00
 sta blocknum+1
 sta endflag
 sta bufpnt
 sta buffer+numpos ;block number
 sta buffer+numpos+1
 sta skpdelay
 lda #datapos
 sta buffer+sizepos ;block size
 lda #$00
rec1
 jsr rechand
 lda endflag
 bne rec3
 jsr match ;do checksums match
 bne rec2 ;no
 jsr clrchn
 lda bufcount
 cmp #datapos
 beq rec7
 ldx ppdiskfn
 jsr chkout
 ldy #datapos
rec6
 lda buffer,y
 jsr chrout
 iny
 cpy bufcount
 bne rec6
 jsr clrchn
rec7
 lda buffer+numpos+1 ;block number high order part
 cmp #$ff
 bne rec4
 lda #$01
 sta endflag

 jsr clrchn
 jsr pend ;signal last block
 jmp rec40

rec4
 jsr pgood ;signal good block

rec40
 jsr reset
 lda #$00
 jmp rec1
;
rec2
 jsr clrchn
 jsr pbad ;signal bad block

 lda recsize
 sta buffer+sizepos
 lda #$03
 jmp rec1
;
;see if checksums match
;
match
 lda buffer
 sta check
 lda buffer+1
 sta check+1
 lda buffer+2
 sta check+2
 lda buffer+3
 sta check+3
 jsr thisbuf
 lda recsize
 sta bufcount
 jsr checksum
 lda buffer
 cmp check
 bne mtc1
 lda buffer+1
 cmp check+1
 bne mtc1
 lda buffer+2
 cmp check+2
 bne mtc1
 lda buffer+3
 cmp check+3
 bne mtc1
 lda #$00
 rts
;
mtc1
 lda #$01
 rts
;
;receive file type block
;
rectype
 lda #$00
 sta blocknum
 sta blocknum+1
 sta endflag
 sta bufpnt
 sta skpdelay
 lda #datapos
 clc 
 adc #$01
 sta buffer+sizepos
 lda #$00
rct3
 jsr rechand
 lda endflag
 bne rct1
 jsr match
 bne rct2
 lda buffer+datapos
 sta ppftype
 lda #$01
 sta endflag
 lda #$00
 jmp rct3
;
rct2
 lda recsize
 sta buffer+sizepos
 lda #$03
 jmp rct3
;
rct1
 lda #$00
 sta lastch
 rts
;
;transmit file type
;
trantype
 lda #$00
 sta endflag
 sta skpdelay
 lda #$01
 sta bufpnt
 sta dontdash
 lda #255
 sta blocknum
 sta blocknum+1
 jsr altbuf
 ldy #sizepos ;block size
 lda #datapos
 clc 
 adc #$01
 sta (pntb),y
 jsr thisbuf
 ldy #numpos ;block number
 lda #255
 sta (pntb),y
 iny
 sta (pntb),y
 ldy #datapos
 lda ppftype
 sta (pntb),y
 lda #$01
 sta specmode
trf1
 jsr tranhand
 beq trf1
 lda #$00
 sta lastch
 rts
;
;do delay for timing
;
dodelay
 inc skpdelay
 lda skpdelay
 cmp #$03
 bcc dod1
 lda #$00
 sta skpdelay
 lda delay
 beq dod2
 bne dod3
;
dod1
 lda delay
 beq dod3
;
dod2
 ldx #$00
lp1
 ldy #$00
lp2
 iny
 bne lp2
 inx 
 cpx #120
 bne lp1
dod3
 rts

 .ifne 0,0 ;don't assemble prtdash
;
;print dash, colon, or star
;
prtdash
 pha 
 lda blocknum
 ora blocknum+1
 beq prtd1
 lda dontdash
 bne prtd1
 pla
 jsr chrout
 pha 
prtd1
 pla
 rts
 .fi ;end of non-assembled code

;
;reset rs232 port
;
reset
 jsr setup
 lda rs232enb
 cmp #$80
 beq reset
 cmp #$92
 beq reset
 rts
;
;terminal emulation routine
;
terminal
 .ifne c$term,0
 jsr cursor
term
 jsr getnum1
 lda stat
 bne keybj
 lda lastch
 and #$7f
 sta lastch
 cmp #$07 ;bell?
 bne term1
 jsr bell ;one ringy-dingy...
 jmp keyboard
term1
 cmp #$08 ;backspace? 
 beq ok1
 cmp #$0d ;return?
 beq ok1
 cmp #$20 ;control character?
 bpl ok1 ;no
 cmp #$0c ;form feed? (clear screen)
 bne keybj
 lda #147 ;commodore clear screen
 jmp ok6
;
keybj
 jmp keyboard
;
ok1
 cmp #'a+$20
 bcc ok2
 cmp #'z+$21
 bcs ok2
 sec 
 sbc #$20
 sta lastch
 jmp ok3
;
ok2
 cmp #$41
 bcc ok3
 cmp #'z+1
 bcs ok3
 clc 
 adc #$80
 sta lastch
;
ok3
 cmp #$08 ;ASCII backspace
 bne ok4
 lda #$14 ;CBM delete
 sta lastch
ok4
 cmp #34 ;quote
 bne ok5
 jsr chrout
 lda #$14 ;delete quote
 jsr chrout
 lda #34 ;??
ok5
 lda lastch
 cmp #$0d
 bne ok6
 lda #$20 ;space before return
 jsr chrout
 lda #$0d
ok6
 jsr chrout
 jsr cursor
;
keyboard
 jsr getin
 beq term
 sta lastch
 cmp #$83 ;shift run/stop key
 beq termout
 cmp #'a
 bcc ok7 ;<"a"
 cmp #'z+1
 bcs ok7 ;>"z"
 clc
 adc #$20 ;to lowercase ascii
 sta lastch
 jmp ok8
;
ok7
 lda lastch
 cmp #'a+$80
 bcc ok8 ;<"a"
 cmp #'z+$81
 bcs ok8 ;>"z"
 sec
 sbc #$80 ;to uppercase ascii
 sta lastch
;
ok8
 cmp #20 ;backspace
 bne ok9
 lda #$08
 sta lastch
ok9
 cmp #$83 ;shift r/s
 bne oka
 lda #$10 ;ctrl p
 sta lastch
oka
 ldx #$05
 jsr chkout
 lda lastch
 jsr chrout
 jsr clrchn
 jmp term
;
termout
 .fi ;end of conditional assembly
 rts ;with shift run/stop
;
 .ifne c$term,0
cursor
 lda #$12
 jsr chrout
 lda #$20
 jsr chrout
 lda #$9d
 jsr chrout
 lda #$92
 jsr chrout
 .fi
;
;check for commodore key
;
exit
 lda shflag ;is commodore key down?
 cmp #$02
 bne exit1
exit2
 pla
 tsx 
 cpx stack
 bne exit2
exit1
 lda #$01
 sta lastch
 rts
;
;Initialize this package.
;move chrout vector if necessary
;
ppinit
 lda ibsout ;been moved yet
 cmp #<newout
 bne ppinit1 ;no, change it
 lda ibsout+1
 cmp #>newout
 beq ppinit2 ;yes, leave it
ppinit1
 lda ibsout ;store old chrout vector
 sta oldout
 lda ibsout+1
 sta oldout+1
 lda #<newout ;set new chrout vector
 sta ibsout
 lda #>newout
 sta ibsout+1
ppinit2
 rts
;
;Restore C-Power environment
;
ppexit
 lda ibsout
 cmp #<newout
 bne ppexitx
 lda ibsout
 cmp #>newout
 bne ppexitx
 sei
 lda oldout
 sta ibsout
 lda oldout+1
 sta ibsout+1
 cli
ppexitx
 rts
;
;new chrout routine to correct for 1200 baud speed problems
;
newout
 pha ;duplicate original kernal routines
 lda defto ;test default output device for
 cmp #$03 ;screen, and...
 bne newout1
 pla ;if so, go back to original rom routines
 jmp (oldout)
;
newout1
 bcc newout2 ;if device number less than 3,
 pla ;also go back to original kernal routines
 jmp (oldout)
;
newout2
 lsr a ;tape or modem?
 pla
 sta ptr1
 txa
 pha
 tya
 pha
 bcc newout9 ;modem
 jsr basic1 ;tape
 bne newout5
 jsr basic2
 bcs newout7
 lda #$02
 ldy #$00
 sta (tape1),y
 iny
 sty bufpntr
newout5
 lda ptr1
 sta (tape1),y
newout6
 clc 
newout7
 pla
 tay
 pla
 tax
 lda ptr1
 bcc newout8
 lda #$00
newout8
 rts
;
;New modem output routine
;
newout9
 jsr newout10
 jmp newout6
;
newout11
 jsr newout12
newout10
 ldy rodbe
 iny
 cpy rodbs
 beq newout11
 sty rodbe
 dey
 lda ptr1
 sta (robuf),y
;
newout12
 lda rs232enb
 lsr a
 bcs newout13
 lda #$10 ;force latched value load
 sta ci2cra
 lda ppbtime ;activate baud rate timer
 sta ti2alo ;timer 2 lo byte
 lda ppbtime+1
 sta ti2ahi ;timer 2 hi byte
 lda #$81
 jsr basic3
 jsr basic4
 lda #$11
 sta ci2cra
newout13
 rts
;
SHAR_EOF
fi # end of overwriting check
if test -f 'screen.a'
then
	echo shar: will not over-write existing file "'screen.a'"
else
cat << \SHAR_EOF > 'screen.a'
;
; Screen Oriented Routines
; Filename: screen.a
;
; History:
;  08/09/86 - MRR - modified BLINKON to
;    set blink counter to 2

#include "mem.i"
#include "kernal.i"

 .ref flush
 .ref gong
 .ref imath$val,itoa
 .ref print,println
 .ref strlen


;Enable blinking cursor

blnct = $cd ;count to next blink
blnon = $cf ;1 = not blinked
blnsw = $cc ;blink switch

 .def blinkon
blinkon
 lda blnsw ;already on?
 beq blinkonx
 lda #0
 sta blnsw
 lda #2 ;set blink count to 2
 sta blnct

blinkonx
 rts


;Disable blinking cursor

 .def blinkoff
blinkoff
 sei ;prevent interrupts
 lda blnon
 bne blnkofx ;char in normal state

 lda #1 ;set blink wait to 1 jiffy
 sta blnct
 cli ;enable interrupts

blnkof1
 lda blnon ;wait for unblink
 beq blnkof1

blnkofx
 lda #1 ;disable further blinking
 sta blnsw
 cli ;enable interrupts
 rts

;
; Center string at current row
; Called with:
;   string pointer in X,Y

leng .byte 0

 .def center
center
 txa ;string address to stack
 pha
 tya
 pha
 jsr strlen
 sta leng
 cmp #38 ;39 or greater?
 bcc center1 ;no
 lda #0
 jmp center2
center1
 lda #40
 sec
 sbc leng
 clc
 ror A ;div. by 2
center2
 tay
 ldx row ;use current row
 clc
 jsr plot ;position cursor
 pla ;retrieve string address
 tay
 pla
 tax
 jsr print
 rts

;
;Wait for carriage return
;
crmsg .byte "Press RETURN to continue...",0

 .def crwait
crwait
 ldx #<crmsg
 ldy #>crmsg
 jsr errmsg
 cmp #13 ;CR?
 bne crwait
 rts

;Erase to end of line
;Called with:
;  X,Y = starting row,column
;Returns:
;  cursor set to starting row,column

 .def eraseeol
eraseeol
 stx ptr1 ;save x and y
 sty ptr1+1
 ldy #39 ;end of line
 jsr $e9f0 ;compute screen line pointer
 jsr $ea24 ;calculate color ram pointer
eraseeol1
 lda #$20 ;space code
 sta ($d1),y ;store space
 jsr $e4da ;store background color
 dey
 cpy ptr1+1 ;at desired column?
 bpl eraseeol1
 clc ;unnecessary?
 ldx ptr1
 ldy ptr1+1
 jsr plot ;position cursor
 rts
 
;Erase to End of Screen
;Called with:
;  X = starting row
 .def eraseeos
eraseeos
 jsr eraseln
 inx
 cpx #25
 bcc eraseeos
 rts

;
;Print flashing error message on line 24,
;wait for a keypress to return.
;Called with:
;  string address in X,Y
;Returns:
;  ACC = response character

errstr .word 0;

 .def errmsg
errmsg
 stx errstr
 sty errstr+1
 ldx #24 ;clear screen line
 jsr eraseln
 jsr flush ;empty keyboard buffer
errmsg1
 jsr gong ;audible alarm
 lda #0
 sta jclock+2 ;zero jiffy clock lsb
 lda rvs ;get reverse flag
 eor #$12 ;toggle bits
 sta rvs
errmsg2
 ldx #24
 ldy #0
 clc
 jsr plot
 ldx errstr
 ldy errstr+1
 jsr print

 jsr getin ;test keyboard
 cmp #0
 bne errmsg3
 lda jclock+2 ;test clock
 cmp #20 ;1/3 second elapsed?
 bcc errmsg2 ;no
 bcs errmsg1 ;yes
errmsg3
 pha ;save response
 jsr rvsoff
 ldx #24 ;erase the line
 jsr eraseln
 pla ;ACC = response
 rts

;Type an integer number at the current
;cursor location.
;Called with:
;  X,Y = number

 .def typenum
typenum
 stx imath$val
 sty imath$val+1
 ldx #<buf ;use edit buffer
 ldy #>buf
 jsr itoa ;integer to ascii
 ldx #<buf
 ldy #>buf
 jsr print
 rts

;
; Enable reverse video
;
 .def rvson
rvson
 pha ;save ACC
 lda #18
rvson1
 sta rvs
 pla ;restore ACC
 rts

;
; Disable reverse video
;
 .def rvsoff
rvsoff
 pha ;save ACC
 lda #0
 beq rvson1 ;share code above


;Enable raster
 .def raster
raster
 lda $d011 ;VIC control register
 ora #$10 ;bit 4 = 1 => enable
 sta $d011
 rts

;Disable raster
 .def noraster
noraster
 lda $d011
 and #$ef ;bit 4 = 0 => disable
 sta $d011
 rts
SHAR_EOF
fi # end of overwriting check
if test -f 'sid.a'
then
	echo shar: will not over-write existing file "'sid.a'"
else
cat << \SHAR_EOF > 'sid.a'
;
;Sound Interface Device (SID) Routines
;Filename: sid.a
;
sid = 54272
sid$lf = sid
sid$hf = sid+1
sid$lp = sid+2
sid$hp = sid+3
sid$wv = sid+4
sid$ad = sid+5
sid$sr = sid+6
;
;
;initialize sid chip
;
 .def sid$init

sid$init
 ldx #0
 lda #0
sid$init1
 sta sid,x
 inx
 cpx #25
 bne sid$init1
 lda #15 ;max volume
 sta sid+24
 rts
;
; buzzing sound
;
 .def buzz
buzz
 lda #0
 sta sid$lf ;freq. lo
 sta sid$ad ;attack/decay
 lda #8
 sta sid$hf
 lda #169 ;sustain/release
 sta sid$sr
 lda #33 ;sawtooth
 sta sid$wv
 lda #32 ;start sustain/release
 sta sid$wv
 rts 
;
;gong sound
;
 .def gong
gong
 lda #12

gong1 ;shared entry
 sta sid$hf

 lda #0
 sta sid$lf
 sta sid$ad ;attack/decay
 lda #169 ;sustain/release
 sta sid$sr
 lda #17 ;triangle
 sta sid$wv

 lda #16 ;start sustain/release
 sta sid$wv
 rts
;
 .def bell
bell
 lda #24 ;twice gong frequency
 bne gong1
SHAR_EOF
fi # end of overwriting check
if test -f 'startup.a'
then
	echo shar: will not over-write existing file "'startup.a'"
else
cat << \SHAR_EOF > 'startup.a'
;
;Provide Assembly Language with a BASIC
;startup statement.  This segment MUST
;be the first segment linked, and the
;program MUST be linked at 2049 (dec)
;for this to work.
;
 .ref start ;external label

 .word link
 .word 100 ;stmt number
 .byte 158 ;'sys'
 .byte "(2063)"
link
 .byte 0,0,0 ;null stmt
;
;This address must match the value in
;parens, above.
;
 jmp start
SHAR_EOF
fi # end of overwriting check
if test -f 'stdlib.ctl'
then
	echo shar: will not over-write existing file "'stdlib.ctl'"
else
cat << \SHAR_EOF > 'stdlib.ctl'
a
imath.o
array.o
string.o
termio.o
disk.o
menu.o
screen.o
sid.o
clock.o

s
stdlib.l
q
SHAR_EOF
fi # end of overwriting check
if test -f 'string.a'
then
	echo shar: will not over-write existing file "'string.a'"
else
cat << \SHAR_EOF > 'string.a'
;;String routines
;Filename: string.a
;History:
; 08/30/86 - added tabstr,gci,pci and modified strlen to use
;            the new get and put routines.
;

#include "mem.i"

; Global Data

 .def string$1,string$2


string$1 .word 0 ;first string parameter
string$2 .word 0 ;second string parameter

; Local Data

length .byte 0 ;short (0-255) length

;Compute string length
;Called with:
; X,Y = string address
;Returns:
; ACC = number of bytes in string

 .def strlen

strlen
 stx gci+1 ;set string pointer
 sty gci+2
 ldy #0

strlen1
 jsr gci
 beq strlen2
 iny 
 bne strlen1
 dey ;string overflow - set max

strlen2
 tya ;return length in A
 rts


;Copy string to string
;Called with:
; string$1 = address of destination
; string$2 = address of source
;
;Note: string 2 MUST be terminated
;with a null byte.  Also, string 1 must
;be long enough to hold all of string 2
;or clobbered storage will result.
  
;Uses zero page pointers ptr1, ptr2

 .def strcpy
strcpy
 lda string$1
 sta ptr1
 lda string$1+1
 sta ptr1+1
strcpy0
 lda string$2
 sta ptr2
 lda string$2+1
 sta ptr2+1
 ldy #0
strcpy1
 lda (ptr2),y
 sta (ptr1),y
 beq strcpyx
 iny
 bne strcpy1
strcpyx
 rts 

;Concatenate string to string
;Called with:
;  string$1 = address of destination
;  string$2 = address of source
;
;Note: a call to strcpy may be followed
;by a call to strcat, without setting up
;string$1 again.  However, multiple calls
;to strcat require restoring string$1
;since it is modified here.

 .def strcat
strcat
 ldx string$1
 ldy string$1+1
 jsr strlen ;compute length of destination string

 clc ;add length to destination address
 adc string$1
 sta string$1

 lda string$1+1
 adc #0
 sta string$1+1
 jmp strcpy ;share code above


;Tabulate String
;This routine pads the argument string
;with spaces up to the specified column
;where column begins with 0.  Thus, calling
;this routine with a column parameter of
;zero has no effect.
;
;Called with:
; ACC = column number (non-inclusive)
; X,Y = string address

 .def tabstr
tabstr
 cmp #0
 beq tabstrx
 pha ;save desired length
 jsr strlen ;get current length
 sta length ;store actual length
 sec ;compute spaces needed
 pla ;retrieve current length
 sbc length
 bcc tabstrx ;already have it
 tay ;Y = number of spaces
 lda gci+1 ;move 'get' address
 sta pci+1 ;to 'put' address
 lda gci+2
 sta pci+2

 lda #32 ;space

tabstr1
 jsr pci
 dey
 bne tabstr1

tabstrx
 rts


;Internal, self-modifying routine to
;get 1 character and increment the
;string pointer if the result is non-zero.
;Prior to calling this routine, the 
;address field of the first instruction
;must be set to the string address.
;Returns:
; ACC = character code
; ZERO flag
;
;Note: the behavior of gci/pci is
;depended upon by certain other routines.
;Modify only with CAUTION!

gci
 lda $ffff
 bne gci1
 rts

gci1
 pha
 inc gci+1
 bne gcix
 inc gci+2

gcix
 pla
 rts


;Internal, self-modifying routine to
;store 1 character and increment the
;address pointer.

pci
 sta $ffff
 inc pci+1
 bne pcix
 inc pci+2

pcix
 rts
SHAR_EOF
fi # end of overwriting check
if test -f 'syslib.ctl'
then
	echo shar: will not over-write existing file "'syslib.ctl'"
else
cat << \SHAR_EOF > 'syslib.ctl'
a
punter.o

s
syslib.l
q
SHAR_EOF
fi # end of overwriting check
if test -f 'termio.a'
then
	echo shar: will not over-write existing file "'termio.a'"
else
cat << \SHAR_EOF > 'termio.a'
;
; MRTERM Terminal Input/Output Routines
; Filename: termio.a
; History:
;   08/13/86 - expand gets legal characters
;   08/21/86 - remove length restriction from print,println
;   08/31/86 - fixed keyclick
 .nlst
#include "kernal.i"
#include "mem.i"
#include "char.i"
#include "printpkt.i"
 .list
 
 .ref bell
 .ref blinkon
 .ref blinkoff
 .ref buzz
 .ref center
 .ref eraseeol
 .ref eraseeos
 .ref gong
 .ref rvson,rvsoff

;External Data

 .def clickon
clickon .byte 0 ;non-zero => enable click

;======================================
;
; Print the null terminated string
; pointed to by X,Y.  The string may
; be any length.
;
print$eol .byte 0 ;end of line flag

 .def print
print
 lda #0

print1
 sta print$eol
 stx ptr1 ;store address in zero
 sty ptr1+1 ;page pointer
 ldy #0

print2
 lda (ptr1),y
 beq print3
 jsr chrout ;print character
 inc ptr1
 bne print2
 inc ptr1+1
 bne print2
;
print3
 lda print$eol ;println?
 beq printx
 jsr chrout ;send return

printx
 rts
;
 .def println
println
 lda #13 ;carriage return
 jmp print1 ;share code


;Packetized Print
;Called With:
;  ACC = color code (255 => current color)
;  X,Y = packet address
;Returns:
;  ACC = keyboard code (if PP$WAIT set)
;
;Notes:
;  This is a very flexible routine which
;will economize on generated code if
;consistently used in an application
;which does lots of cursor positioning
;and screen I/O.  The format of the
;5 byte packet, pointed to by X,Y is:
;
;  Byte 0 - flag word
;
;           bits 0,1 = erase code
;             00 PP$NULL => no erase
;             01 PP$EOL  => erase to end of line before printing
;             10 PP$EOS  => erase to end of screen before printing
;             11 PP$CLR  => erase entire screen
;
;           bit 2 = reverse flag
;           
;           bits 3,4 = sound effect code
;             00 PP$NULL => none
;             01 PP$BELL => bell PP$BELL
;             10 PP$GONG => gong PP$GONG
;             11 PP$BUZZ => buzz PP$BUZZ
;
;           bit 5 PP$CENTER = center
;             The COL parameter will be ignored and
;             the specified text will be centered
;             on the specified ROW
;
;           bit 6 PP$CR = carriage return
;
;           bit 7 PP$WAIT = wait for keypress and
;                           return it in ACC
;             (set to zero)
;
;  Byte 1 - row (0..24) or negative (128..255) (current)
;
;  Byte 2 - column (0..39) or negative (current)
;
;  Bytes 3,4 - address of null-terminated string
;
;Reverse mode is ALWAYS disabled upon
;exiting this routine.  Also, the current
;character color is always restored to
;the color that was current upon entry.
;
pktinfo ;starting address for packet info
code .byte 0 ;print code
prow .byte 0 ;row
pcol .byte 0 ;column
padr .word 0 ;string address

 .def printpkt
printpkt
 stx ptr1
 sty ptr1+1
 ldx color ;save current color
 cmp #$ff ;color specified?
 beq ppkt0 ;no
 sta color ;yes

ppkt0
 txa ;save color code
 pha

 ldy #0
ppkt1
 lda (ptr1),y ;copy packet
 sta pktinfo,y
 iny
 cpy #5
 bne ppkt1

 lda prow ;current row?
 bpl ppkt10
 lda row ;transfer current to parameter
 sta prow 

ppkt10
 lda pcol
 bpl ppkt11
 lda col
 sta pcol

ppkt11
 lda #PP$RVS ;reverse mode?
 bit code
 beq ppkt2
 jsr rvson

ppkt2 ;sound effects?
 lda code
 and #PP$BUZZ
 beq ppkt3 ;no sound
 cmp #PP$BELL
 bne ppkt21
 jsr bell
 jmp ppkt3

ppkt21
 cmp #PP$GONG
 bne ppkt22
 jsr gong
 jmp ppkt3

ppkt22
 jsr buzz
 
ppkt3 ;erase/position
 ldx prow ;prepare to position
 ldy pcol

 lda code
 and #$03 ;get erase code
 beq ppkt4 ;none?
 cmp #PP$EOL ;erase to end of line?
 bne ppkt31
 jsr eraseeol
 jmp ppkt4

ppkt31
 cmp #PP$EOS
 bne ppkt32
 jsr eraseeos
 jmp ppkt4

ppkt32 ;clear screen
 lda #clrscrn
 jsr chrout

  
ppkt4 ;position cursor, test for centering
 clc
 ldx prow
 ldy pcol
 jsr plot ;position cursor

 ldx padr ;get string address
 ldy padr+1
 lda #PP$CENTER ;centering?
 bit code
 beq ppkt41 ;no
 jsr center ;yes
 jmp ppkt42

ppkt41
 jsr print

ppkt42 ;want carriage return?
 lda #PP$CR
 bit code
 beq ppktx
 lda #13
 jsr chrout
 
ppktx
 pla ;restore color
 sta color
 jsr rvsoff ;disable reverse
 lda #PP$WAIT ;wait for keyboard?
 bit code
 beq ppktxx
 jsr kbwait ;wait for a key

ppktxx
 rts

;
;Centralized routine for getting
;characters from the keyboard.
;If a character is gotten, an audible
;click is generated if 'clickon' is
;non-zero.
;Returns:
;  ACC = character or 0
;  Zero flag

voice2 = 54279

 .def kbget
kbget
 jsr getin
 pha
 beq kbgetx
 ldx clickon ;click enabled?
 beq kbgetx
 lda #0 ;kill voice
 sta voice2+4
 lda #90 ;freq-hi
 sta voice2+1
 lda #0 ;A/D
 sta voice2+5
 lda #160 ;S/R
 sta voice2+6
 lda #33
 sta voice2+4 ;start/stop
 ldx #0

kbget1
 nop ;delay loop
 inx
 bne kbget1

 lda #32
 sta voice2+4

kbgetx
 pla
 rts

;
;Wait for keyboard character
;Returns:
;   ACC = character

 .def kbwait
kbwait
 jsr clrchn ;insure defaults
 jsr flush ;empty keyboard buffer

kbwait1
 jsr kbget ;get character
 beq kbwait1
 rts


;
;Flush keyboard input buffer

 .def flush
flush
 lda #0
 sta 198 ;NDX = number of chars buffered
 rts
 
;
;Get a string from the keyboard
;Called with:
; ACC = max input length
;Returns:
; ACC = actual input length
; text stored in system buffer (buf/512)

leng .byte 0
max .byte 0

 .def gets
gets
 sta max
 lda #0
 sta leng

gets1
 jsr blinkon ;enable cursor
 jsr kbget ;get character
 beq gets1
 pha
 jsr blinkoff
 pla
 cmp #13 ;return?
 beq getsx ;exit
 cmp #del ;delete?
 bne gets2
 ldy leng ;length > 0?
 dey
 bmi gets1
 sty leng ;store adjusted length
 pha ;save delete code
 lda #0 ;store null here
 sta buf,y
 pla ;restore delete code
 jsr chrout ;print delete code
 jmp gets1 ;go get some more 

gets2
 cmp #$20 ;control character?
 bcc gets1 ;ignore
 cmp #97
 bcc gets21 ;yes - ok
 cmp #'A ; A <= char <= Z ?
 bcc gets1 ;no - ignore
 cmp #'Z+1
 bcs gets1

gets21
 ldy leng
 cpy max ;at maximum?
 bne gets3
 jsr buzz ;razz him
 jmp gets1 ;don't store it

gets3
 sta buf,y ;store new character
 jsr chrout ;print it
 inc leng
 bne gets1
 
getsx
 ldy leng
 lda #0
 sta buf,y ;null terminator
 tya ;return length
 rts
SHAR_EOF
fi # end of overwriting check
#	End of shell archive
exit 0
-- 
| Mark R. Rinfret, SofTech, Inc.		mark@unisec.usi.com |
| Guest of UniSecure Systems, Inc., Newport, RI                     |
| UUCP:  {gatech|mirror|cbosgd|uiucdcs|ihnp4}!rayssd!unisec!mark    |
| work: (401)-849-4174	home: (401)-846-7639                        |