mark@unisec.UUCP (05/15/87)
Here's the source to MRterm, as promised. Remember, you'll need my C-ASSM
assembler (C-Power compatible assembler) and C-Power in order to assemble
and link this source.
My apologies to anyone who feels that I've saturated this group with my
postings this past week. I've been wanting to do this for while but haven't
found and free time. If I don't get beat up too badly, I'll post some more
C-Power stuff next week.
Mark
-------------------------------- c u t h e r e -----------------------------
#! /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:
# buffer.a
# configure.a
# diskutil.a
# This archive created: Fri May 15 15:02:58 1987
export PATH; PATH=/bin:$PATH
if test -f 'buffer.a'
then
echo shar: will not over-write existing file "'buffer.a'"
else
cat << \SHAR_EOF > 'buffer.a'
;MRTERM Buffer Management
;Filename: buffer.a
;History:
; 04/20/87 - 3.5 - tbuf is now an external symbol, defined at the
; end of MRTERM. This allows all unused space
; to be claimed by the buffer.
; 08/12/86 - 2.3 - implemented Print Buffer command
; 08/16/86 - 2.4 - fixed sprite color problem
; 08/18/86 - 2.4 - optimized with printpkt,
; i$tbuf zeroes buffer
; 09/28/86 - 3.3 - added Clear Buffer command
;
#include "mrterm.i"
#include "mem.i"
#include "kernal.i"
#include "char.i"
#include "printpkt.i"
;External Definitions
.ref asc2cbm
.ref atoi
.ref bkrd
.ref bkwt
.ref buzz
.ref cbm2asc
.ref center
.ref ckdisk
.ref disk$status
.ref ed$start,ed$end,ed$max,edit
.ref errmsg
.ref fclose
.ref filprmpt
.ref gets
.ref hilite
.ref kbwait
.ref mdmrd
.ref mdmwrt
.ref menu,menu$title,menu$list
.ref mfill
.ref offline,online
.ref open$seq
.ref openmodem
.ref pdvc,pinit,psa
.ref print,println,printpkt
.ref tbuf
.ref typenum
;Note: The current buffer range overlaps the
;BASIC ROM area. This implies that BASIC
;must be switched out to access the buffer
;tbuf = $6000 ;terminal buffer start (24576)
etbuf = $c000 ;terminal buffer end + 1
bufsize .word 0 ;buffer size
tbufsw .byte 0 ;buffer switch
bufspadr = 832 ;address of buffer sprite
;Buffer sprite definition data
;Should look like man with parachute.
bufsprite
.byte 0,0,0,0,0,0,0,0
.byte 0,0,255,0,1,129,128,2
.byte 66,64,4,36,32,15,255,240
.byte 4,0,32,2,0,64,1,0
.byte 128,0,129,0,0,126,0,0
.byte 66,0,0,24,0,0,24,0
.byte 0,126,0,0,90,0,0,24
.byte 0,0,36,0,0,36,0,77
;**************************************
fullmsg .byte "BUFFER FULL!",0
fullpkt
.byte PP$RVS|PP$BUZZ|PP$CR
.byte 255,255 ;current row/column
.word fullmsg
m$quit .byte "Quit",0
m$clear .byte "Clear Buffer",0
m$edit .byte "Edit/View Buffer",0
m$load .byte "Load Buffer from File",0
m$prnt .byte "Print Buffer",0
m$save .byte "Save Buffer to File",0
m$tran .byte "Transfer Buffer to Host",0
buftitl .byte "Buffer Utilities",0
buflist
.word m$quit
.word m$clear
.word m$edit
.word m$tran
.word m$load
.word m$save
.word m$prnt
null
.word 0
bufdsp ;dispatch table
.word 0 ;quit
.word clrbuf
.word edbuf
.word trbuf
.word lodbuf
.word savbuf
.word prntbuf
.word 0
dfn .byte 0 ;disk file number
;Main driver
.def bufutil
bufutil
lda #<buftitl
sta menu$title
lda #>buftitl
sta menu$title+1
lda #<buflist
sta menu$list
lda #>buflist
sta menu$list+1
jsr menu
cmp #0 ;quit?
beq bufx
clc
rol A
tay
lda bufdsp,y
sta bufjmp+1
lda bufdsp+1,y
sta bufjmp+2
lda #clrscrn
jsr chrout
lda buflist,y
tax
lda buflist+1,y
tay
jsr center
jsr bufjmp
jmp bufutil
bufx
rts
bufjmp ;dispatch jump
jmp $ffff
;Edit buffer
edbuf
lda tbuf
sta ed$start
lda tbuf+1
sta ed$start+1
lda bufpnt
sta ed$end
lda bufpnt+1
sta ed$end+1
lda #<etbuf
sta ed$max
lda #>etbuf
sta ed$max+1
jsr edit
lda ed$end ;update buffer pointer
sta bufpnt
lda ed$end+1
sta bufpnt+1
rts
;Load buffer from seq file
lodprmpt .byte "INPUT File: ",0
fullflg .byte 0
lodbuf
lda #0
sta fullflg
ldx #<lodprmpt
ldy #>lodprmpt
jsr filprmpt
lda buf ;null response?
beq lodbufx ;abort
ldx #<buf
ldy #>buf
lda #'r ;read access
jsr open$seq
sta dfn
bne lodbuf0
jmp showstatus
lodbuf0
ldx tbuf
ldy tbuf+1
stx ptr1
sty ptr1+1
ldx bufsize
ldy bufsize+1
lda dfn
jsr bkrd ;read block from file
bne lodbuf1 ;should get 64 (EOF)
inc fullflg
jmp lodbuf2 ;save what we can
lodbuf1
cmp #64 ;end of file is good
beq lodbuf2
jsr ckdisk ;get disk status
ldx #<disk$status
ldy #>disk$status
jsr errmsg
jmp lodbuf3
lodbuf2
lda ptr1 ;update buffer pointer
sta bufpnt
lda ptr1+1
sta bufpnt+1
lodbuf3
lda dfn
jsr fclose
lda fullflg ;buffer overflow?
beq lodbufx
ldx #<fullmsg
ldy #>fullmsg
jsr errmsg
lodbufx
rts
;Save buffer to seq file
savprmpt .byte "OUTPUT File: ",0
savbuf
ldx #<savprmpt
ldy #>savprmpt
jsr filprmpt
lda buf ;null response?
beq savbufx
ldx #<buf
ldy #>buf
lda #'w ;write access
jsr open$seq
sta dfn
bne savbuf1
showstatus
ldx #<disk$status
ldy #>disk$status
jsr errmsg
savbufx
lda dfn
jsr fclose
rts
savbuf1
lda tbuf ;starting address
sta ptr1
lda tbuf+1
sta ptr1+1
sec ;block length
lda bufpnt
sbc tbuf
tax
lda bufpnt+1
sbc tbuf+1
tay
lda dfn
jsr bkwt
php ;save carry status
lda dfn
jsr fclose
plp
bcc savbufx
jsr ckdisk
jmp showstatus
rts
;Print Buffer
prntmsg1 .byte "Position printer to top of form...",13,13
.byte "Continuous (c) or Paginated (p)? ",0
prntpkt1
.byte PP$NULL|PP$EOS|PP$GONG|PP$WAIT
.byte 10,0
.word prntmsg1
prntmsg2 .byte 13,13,"Press STOP to abort printing",0
prntmode .byte 0 ;mode: 'c' or 'p'
prntlc .byte 0
prntbuf
lda #mdmfn ;close modem
jsr close
lda #pfn
pha
jsr close
pla
ldx pdvc
ldy psa
jsr setlfs
lda pinit
ldx #<pinit+1
ldy #>pinit+1
jsr setnam
jsr open
lda #0
sta prntlc
prntbuf1
lda hilite
sta color
ldx #<prntpkt1
ldy #>prntpkt1
jsr printpkt
sta prntmode
cmp #13
beq prntbufx
cmp #'c
beq prntbuf2
cmp #'p
bne prntbuf1
jsr prntskp ;top margin, 1st page
prntbuf2
ldx #<prntmsg2
ldy #>prntmsg2
jsr println
lda tbuf ;set buffer pointer
sta ptr1
lda tbuf+1
sta ptr1+1
prntbuf3
sec
lda ptr1
sbc bufpnt
lda ptr1+1
sbc bufpnt+1
bcs prntbufx ;whole buffer printed
jsr getin ;STOP key pressed?
cmp #$03
beq prntbufx
lda prntmode ;paginated print?
cmp #'p
bne prntbuf30
lda prntlc
cmp #63
bcc prntbuf30
jsr prntskp ;bottom margin
lda #0
sta prntlc
jsr prntskp ;top margin
prntbuf30
ldx #pfn
jsr chkout
ldy #0
lda (ptr1),y
cmp #13
bne prntbuf31
inc prntlc
prntbuf31
jsr chrout
jsr clrchn
inc ptr1
bne prntbuf3
inc ptr1+1
bne prntbuf3
prntbufx
jsr prntskp
lda offline
sta color
lda #pfn
jsr close
lda #mdmfn ;reopen modem
jsr openmodem
rts
;Skip 3 lines on printer
prntskp
ldx #pfn
jsr chkout
ldy #3
prntskp1
dey
beq prntskpx
lda #13
jsr chrout
inc prntlc
bne prntskp1
prntskpx
jsr clrchn
rts
;Transfer Buffer to Host
crmsg .byte "CR substition (none): ",0
crpkt
.byte PP$WAIT|PP$BELL
.byte 5,0
.word crmsg
dlymsg .byte "Delay (0-30) (none): ",0
dlypkt
.byte PP$EOL|PP$BELL
.byte 7,0
.word dlymsg
donemsg .byte "Transfer done.",0
infomsg .byte "Press SPACEBAR to pause, STOP to abort",0
pausemsg .byte "Pausing...any key continues.",0
subc .byte 0 ;substitute this for CR
delay .byte 0 ;delay between chars
trbuf
lda #0
sta subc
sta delay
lda hilite
sta color
ldx #<crpkt
ldy #>crpkt
jsr printpkt
cmp #13 ;CR?
beq trbuf2
sta subc ;save it
jsr chrout ;and echo it
trbuf2
trbuf21
lda #$ff ;default color
ldx #<dlypkt
ldy #>dlypkt
jsr printpkt
lda #3 ;3 char max
jsr gets ;get response
lda #13
jsr chrout
lda buf
beq trbuf3 ;no response?
ldx #<buf
ldy #>buf
jsr atoi
cpy #0 ;compare to 30
beq trbuf22
baddelay
jsr buzz
jmp trbuf21
trbuf22
cpx #31
bcs baddelay
stx delay
trbuf3
lda tbuf ;set up pointer to buffer
sta ptr3
lda tbuf+1
sta ptr3+1
lda #0 ;reset delay timer
sta jclock+2
lda online
sta color
trbuf4 ;main loop
jsr mdmrd ;read host
bcs trbuf40
tax
lda asc2cbm,x ;translate
jsr chrout ;print
trbuf40
jsr clrchn
jsr getin ;keyboard pressed?
cmp #0
beq trbuf5
cmp #$03 ;STOP?
beq trbufx ;yes - abort
cmp #32 ;CR?
beq trbuf41
jsr buzz ;signal bad character
jmp trbuf4
trbuf41
lda #13 ;scroll last line
jsr chrout
ldx #<pausemsg
ldy #>pausemsg
jsr errmsg
trbuf5
sec ;are we done?
lda ptr3
sbc bufpnt
lda ptr3+1
sbc bufpnt+1
bcs trbufx
lda jclock+2 ;delay time over?
cmp delay
bcs trbuf6
jmp trbuf4
trbuf6
ldy #0
lda (ptr3),y
cmp #13 ;carriage return?
bne trbuf61
ldx subc ;want to substitute?
beq trbuf7
lda #32 ;substitute space for CR
bne trbuf7
trbuf61
cmp subc ;substitute character?
bne trbuf7
lda #13 ;replace with CR
trbuf7
tax ;translate character
lda cbm2asc,x
jsr mdmwrt ;output to modem
inc ptr3
bne trbuf71
inc ptr3+1
trbuf71
lda #0
sta jclock+2 ;reset jiffy timer
jmp trbuf4
trbufx
ldx #<donemsg
ldy #>donemsg
jsr errmsg
rts
;**************************************
;The following short subroutine stores
;one character into the buffer, then
;increments the buffer pointer. Other
;routines in this package modify the
;buffer pointer, which is actually the
;address field of an STA instruction.
bufstore
.byte $8d ;sta (absolute)
.def bufpnt
bufpnt
.word tbuf
inc bufpnt
bne bufstorex
inc bufpnt+1
bufstorex
rts
;**************************************
;Initialize terminal buffer
.def i$tbuf
i$tbuf
sec
lda #<etbuf
sbc tbuf
sta bufsize
lda #>etbuf
sbc tbuf+1
sta bufsize+1
lda tbuf
sta bufpnt
sta ptr1
lda tbuf+1
sta bufpnt+1
sta ptr1+1
ldx bufsize ;fill buffer with zero
ldy bufsize+1
lda #0
jsr mfill
ldx #0
i$tbuf1 ;copy sprite data to buffer area
lda bufsprite,x
sta bufspadr,x
inx
cpx #64
bne i$tbuf1
lda #13 ;sprite buffer block number
sta 2040 ;832/64 = 13
;This will eventually get replaced by
;calls to a sprite handling package
lda $d010 ;set msb of sprite x
ora #1
sta $d010 ;msigx
lda #64 ;320-256 = sprite x
sta $d000 ;sp0x
lda #30 ;highest visible position
sta $d001 - sp0y
lda $d015 ;spena - disable sprite display
and #$fe
sta $d015
lda $d01b ;spbgpr - give sprite
and #$fe ;foreground priority
sta $d01b
jsr bufspcol
rts
;Set Buffer Sprite Color
.def bufspcol
bufspcol
lda hilite
sta $d027
rts
;Clear Buffer
clrmsg .byte "Clear the buffer? ",0
clrpkt
.byte PP$EOS|PP$BELL|PP$WAIT
.byte 10,0
.word clrmsg
clrbuf
lda offline
ldx #<clrpkt
ldy #>clrpkt
jsr printpkt
cmp #'y
bne clrbufx
jsr i$tbuf
clrbufx
rts
;Toggle Buffer Switch
.def togglebuf
togglebuf
lda tbufsw
eor #$01
sta tbufsw
beq togglebuf2
jsr pcspr ;position sprite
lda #13 ;set buffer location
sta 2040
jsr bufspcol
lda $d015 ;enable sprite
ora #1
sta $d015
rts
togglebuf2
lda $d015 ;disable sprite
and #$fe
sta $d015
rts
;Put character in buffer
;Called with:
; ACC = character to store (CBM ASCII)
.def pcbuf
pcbuf
ldx tbufsw ;buffer on?
beq pcbufx
ldx bufpnt+1 ;buffer full?
cpx #>etbuf
bcc pcbuf1 ;nope
jsr togglebuf ;disable buffer
lda #13
jsr chrout
lda hilite
ldx #<fullmsg
ldy #>fullmsg
jsr printpkt
pcbufx
rts ;yes - ignore
pcbuf1
cmp #32 ;control character?
bcs pcbuf2
cmp #13 ;carriage return?
beq pcbuf2
cmp #10 ;line feed?
beq pcbuf2
cmp #$14 ;DEL?
beq pcdel
jmp pcspr ;ignore control character
pcbuf2
jsr bufstore ;store character
jmp pcspr
pcdel ;delete buffer character
lda bufpnt+1 ;at least 1 character?
cmp tbuf+1
bne pcdel1
lda bufpnt
cmp tbuf
beq pcbufx ;nothing in buffer
pcdel1
dec bufpnt
lda bufpnt
cmp #$ff ;transition negative?
bne pcspr
dec bufpnt+1
;All store operations end up here.
;Update the buffer sprite vertical
;position.
pcspr
sec
lda #>etbuf ;use msb of
sbc bufpnt+1 ;buffer amount left
cmp #96 ;design maximum
bcc pcspr1
lda #96 ;set maximum
pcspr1
clc
rol A ;256's * 2
sta ptr1 ;at 24k, max is 192
lda #242 ;min 50, max 242
sec
sbc ptr1
sta $d001 ;set vertical position
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'configure.a'
then
echo shar: will not over-write existing file "'configure.a'"
else
cat << \SHAR_EOF > 'configure.a'
;
; MRTERM Configuration Routines
; Filename: configure.a
;
; History:
; 07/27/86 - Allow user to edit the dial command
; 08/16/86 - 2.4 - set buffer sprite color
; 08/21/86 - 2.4 - add printpkt calls
; 09/15/86 - 3.1 - add XMODEM/CRC, XMODEM/CHECKSUM
.nlst
#include "mem.i"
#include "kernal.i"
#include "char.i"
#include "printpkt.i"
.list
;Global data references
.ref background,border
.ref dialcmd
.ref hilite,online,offline
.ref baud,databits,parity,stopbits
.ref protocol,modemtype
;Other external support
.ref bufspcol
.ref buzz
.ref center
.ref eraseeol
.ref gets
.ref kbwait
.ref menu,menu$title,menu$list
.ref lpf,spf
.ref openmodem
.ref print,println,printpkt
.ref rvsoff,rvson
.ref strcpy,string$1,string$2
;Main menu title string
cfgtitle .byte "Configure MRTERM",0
;Menu command strings (alpha order)
cfgclr .byte "Colors",0
cfglod .byte "Load Parameters",0
cfgmdm .byte "Modem/Communications Parameters",0
cfgquit .byte "Quit",0
cfgsav .byte "Save Parameters",0
;Menu string array (menu order)
cfglist
.word cfgquit
.word cfgmdm
.word cfgclr
.word cfglod
.word cfgsav
null
.word 0 ;end of list marker
;Main configuration menu dispatch vectors
cfgvect
.word 0 ;quit handled specially
.word cfgmodem
.word cfgcolors
.word cfgload
.word cfgsave
cfgjump ;address modified at run time
jmp $ffff
.def configure
configure
lda #<cfgtitle
sta menu$title
lda #>cfgtitle
sta menu$title+1
lda #<cfglist
sta menu$list
lda #>cfglist
sta menu$list+1
jsr menu ;get command
cmp #0 ;quit command?
beq configurex
clc
rol A ;times two
pha ;save index
lda #clrscrn
jsr chrout
pla
pha
tay
lda cfglist,y
tax
lda cfglist+1,y
tay
jsr center
pla
tax
lda cfgvect,x
sta cfgjump+1
lda cfgvect+1,x
sta cfgjump+2
jsr cfgjump
jmp configure ;do it again
configurex
rts
;Configure Modem Parameters
NMODEMOPT = 7 ;number of modem options
mdmbaud .byte "Baud Rate",0
mdmdata .byte "Data Bits",0
mdmpar .byte "Parity",0
mdmprot .byte "Protocol",0
mdmstop .byte "Stop Bits",0
mdmtype .byte "Modem Type",0
mdmdial .byte "Dial Command",0
mdmlist
.word mdmbaud
.word mdmdata
.word mdmstop
.word mdmpar
.word mdmprot
.word mdmtype
.word mdmdial
.word 0 ;end of list
baudopt .byte "300,1200",0
dataopt .byte "8,7,6,5",0
stopopt .byte "1,2",0
paropt .byte "None,Odd,Even,Mark,Space",0
protopt .byte "Punter,XMODEM/CRC,XMODEM/CHECKSUM",0
typeopt .byte "1650/1660,Hayes",0
dialopt .byte 0
;Option string array
optlist
.word baudopt
.word dataopt
.word stopopt
.word paropt
.word protopt
.word typeopt
.word dialopt
.word 0
mdmvect ;vector list
.word cfgbaud
.word cfgdata
.word cfgstop
.word cfgpar
.word cfgprot
.word cfgtype
.word cfgdial
spmsg .byte "Press SPACEBAR to change options",0
sppkt
.byte PP$EOS
.byte 23,0
.word spmsg
edflg .byte 0 ;edit flag
opx .byte 0 ;option index
sadr .word 0 ;saves option name string
svrow .word 0 ;saves option row
trm .byte 0 ;terminating character
cfgmodem
lda hilite
ldx #<sppkt
ldy #>sppkt
jsr printpkt
lda #0
sta edflg
sta opx
lda #csrdn
sta trm
cfgmodem1
clc
lda opx ;compute row
pha
adc #5
tax
stx svrow
ldy #0
jsr plot
pla ;get option name string
clc
rol A
tax
lda mdmlist+1,x ;high byte
tay
lda mdmlist,x ;lo byte
tax
stx sadr
sty sadr+1
jsr rvson
jsr print
jsr rvsoff
clc ;compute switch(opx) vector
lda opx
rol A
tax
lda mdmvect,x
sta mdmjump+1
lda mdmvect+1,x
sta mdmjump+2
mdmjump
jmp $ffff ;modified above
cfgbaud
lda baud ;current value
ldx #2 ;number of option values
jsr option
sta baud
jmp cfgmodem2
cfgdata
lda databits
ldx #4
jsr option
sta databits
jmp cfgmodem2
cfgstop
lda stopbits
ldx #2
jsr option
sta stopbits
jmp cfgmodem2
cfgpar
lda parity
ldx #5
jsr option
sta parity
jmp cfgmodem2
cfgprot
lda protocol
ldx #3
jsr option
sta protocol
jmp cfgmodem2
cfgtype
lda modemtype
ldx #2
jsr option
sta modemtype
jmp cfgmodem2
cfgdial
jsr edial
jmp cfgmodem2
cfgmodem2
clc
ldx svrow
ldy #0
jsr plot
ldx sadr
ldy sadr+1
jsr print
lda trm ;terminating character
cmp #13 ;carriage return?
bne cfgmodem3
lda #5
jsr openmodem ;re-open modem
rts
cfgmodemjmp
jmp cfgmodem1
cfgmodem3
cmp #csrdn ;down?
bne cfgmodem4
inc opx
lda opx
sec
sbc #NMODEMOPT
bcc cfgmodemjmp
inc edflg ;enable edit mode
lda #0
sta opx
beq cfgmodemjmp
cfgmodem4
cmp #csrup
bne cfgmodemjmp
dec opx
bpl cfgmodemjmp
lda #NMODEMOPT-1
sta opx
bne cfgmodemjmp
;Get legal option edit/position key
optkey
jsr kbwait
sta trm
cmp #csrdn
beq optkx
cmp #csrup
beq optkx
cmp #13
beq optkx
cmp #$20
beq optkx
jsr buzz
jmp optkey
optkx
rts
;Position cursor at option field
;and erase the field.
optplot
lda opx ;row = option index + 5
clc
adc #5
tax
ldy #20 ;col = 20
jsr eraseeol
rts
;Select a modem option
;Called with:
; ACC = current option value
; X = number of option values
; opx = current option index
opmax .byte 0 ;max value
opval .byte 0 ;current value
option
stx opmax
sta opval
option0
jsr showopt
lda edflg ;display only?
beq optionx
option1
jsr optkey
cmp #$20 ;space?
bne optionx ;up/down or CR
inc opval
lda opval
cmp opmax
bcc option0
lda #0
sta opval
beq option0
optionx
lda opval
rts
;Show one modem option value
;Called with:
; opx = option index
; opmax = max option value
; opval = current value
showopt
jsr optplot
showopt0
lda opx
clc
rol A
tax
lda optlist,x
sta ptr1
lda optlist+1,x
sta ptr1+1
ldx #0 ;comma count
ldy #0 ;character index
showopt1
cpx opval ;at selected value?
beq showopt4 ;yes
showopt2
lda (ptr1),y ;get character
cmp #', ;comma?
bne showopt3
iny ;skip comma
inx ;count comma
bne showopt1
showopt3
iny ;next character
bne showopt2
showopt4
lda (ptr1),y
beq showoptx
cmp #', ;next option?
beq showoptx
jsr chrout ;print character
iny
bne showopt4
showoptx
rts
;Display/Edit Dial command
edial
jsr optplot
ldx #<dialcmd
ldy #>dialcmd
jsr print
lda edflg
beq edialx
edial1
jsr optkey
cmp #$20
bne edialx
jsr optplot
lda #8 ;max length of dial command
jsr gets
lda #<buf
sta string$2
lda #>buf
sta string$2+1
lda #<dialcmd
sta string$1
lda #>dialcmd
sta string$1+1
jsr strcpy
edialx
rts
;Configure Colors
f1str .byte "F1 - Background",0
f2str .byte "F2 - Border",0
f3str .byte "F3 - Online",0
f4str .byte "F4 - Highlight",0
f5str .byte "F5 - Offline",0
cr2quit .byte 13,"Press RETURN to quit",0
cfgcolors
jsr setcolors
clc
ldx #5
ldy #0
jsr plot
ldx #<f1str
ldy #>f1str
jsr println
ldx #<f2str
ldy #>f2str
jsr println
lda online ;set current color to online
sta color
ldx #<f3str
ldy #>f3str
jsr println
lda hilite
sta color
ldx #<f4str
ldy #>f4str
jsr println
lda offline
sta color
ldx #<f5str
ldy #>f5str
jsr println
lda hilite
sta color
ldx #<cr2quit
ldy #>cr2quit
jsr println
lda offline
sta color
jsr kbwait
cmp #13 ;return?
bne chkf1
rts ;exit
chkf1
cmp #f1
bne chkf2
ldx #<background
ldy #>background
bcs cfgcolr1
chkf2
cmp #f2
bne chkf3
ldx #<border
ldy #>border
bcs cfgcolr1
chkf3
cmp #f3
bne chkf4
ldx #<online
ldy #>online
bcs cfgcolr1
chkf4
cmp #f4
bne chkf5
ldx #<hilite
ldy #>hilite
bcs cfgcolr1
chkf5
cmp #f5
bne badfkey
ldx #<offline
ldy #>offline
bcs cfgcolr1
badfkey
jsr buzz
jmp cfgcolors
cfgcolr1
stx ptr1
sty ptr1+1
ldy #0
clc
lda (ptr1),y
adc #1
and #15 ;must be 15 or less
sta (ptr1),y
jmp cfgcolors
;Load Parameter File
cfgload
jsr pfprmpt ;prompt for file name
jsr lpf
beq cfgloadx ;load failed?
jsr setcolors ;good load - set new colors
lda #5 ;and re-open modem
jsr openmodem
cfgloadx
rts
;Save Parameter File
cfgsave
jsr pfprmpt
jsr spf
rts
;Prompt for parameter file name
;Returns:
; X,Y = Filename string address (buf)
pfpmsg
.byte "Enter parameter file name",13
.byte "(RETURN=default): ",0
pfpkt
.byte PP$GONG|PP$EOS
.byte 10,0
.word pfpmsg
pfprmpt
lda hilite
ldx #<pfpkt ;prompt string
ldy #>pfpkt
jsr printpkt
lda #0 ;insure a null
sta buf
lda #20 ;max name length
jsr gets ;get string
ldx #<buf
ldy #>buf
rts
;Set colors per configuration data
.def setcolors
setcolors
lda border
sta 53280
lda background
sta 53281
lda offline
sta color
jsr bufspcol ;set buffer sprite color
rts
SHAR_EOF
fi # end of overwriting check
if test -f 'diskutil.a'
then
echo shar: will not over-write existing file "'diskutil.a'"
else
cat << \SHAR_EOF > 'diskutil.a'
;MRTERM Disk Utilities Package
;Filename: diskutil.a
;History:
; 08/22/86 - 2.4 - use printpkt
; 08/28/86 - 2.5 - added printer option
.nlst
#include "mem.i"
#include "kernal.i"
#include "char.i"
#include "printpkt.i"
#include "mrterm.i"
.list
.ref itoa,imath$val
.ref center,crwait
.ref ckdisk,fclose
.ref clsptr
.ref disk$dvc,disk$cmd,disk$status,fil$num
.ref disk$blks,disk$fnam,disk$ftyp
.ref eraseeos
.ref errmsg
.ref gdk$ccf
.ref getdir
.ref gets
.ref hilite
.ref kbwait
.ref menu,menu$title,menu$list
.ref offline,online
.ref open$dir
.ref openmodem
.ref opnptr
.ref print,println,printpkt
.ref prtchr
.ref scratch
.ref scrndmp
.ref strcat,strcpy,strlen,string$1,string$2
.ref tabstr
cmdbuf .bss 60 ;command string buffer
filcnt .byte 0
dfn .byte 0 ;disk file number
disktitle .byte "Disk/File Utilities",0
bkscmd .byte "Blocks Free",0
dircmd .byte "Directory",0
execmd .byte "Execute Disk Commands",0
fmtcmd .byte "Format Disk (new ID)",0
initcmd .byte "Initialize Disk (same ID)",0
quitcmd .byte "Quit",0
rnmcmd .byte "Rename File",0
scrcmd .byte "Scratch File(s)",0
disklist
.word quitcmd
.word bkscmd
.word dircmd
.word execmd
.word fmtcmd
.word initcmd
.word rnmcmd
.word scrcmd
null ;dual-purpose: end of list, null bytes
.word 0
;
diskvect
.word diskutilx
.word bkfree
.word lstdir
.word dsend
.word fmtdsk
.word indisk
.word rename
.word scrfil
;
diskjmp jmp $ffff
.def diskutil
diskutil
lda #mdmfn ;close the modem
jsr close
diskutil1
lda #<disktitle
sta menu$title
lda #>disktitle
sta menu$title+1
lda #<disklist
sta menu$list
lda #>disklist
sta menu$list+1
jsr menu
cmp #0 ;quit?
beq diskutilx
clc
rol A ;command index * 2
pha ;save adjusted index
tax
lda diskvect,x
sta diskjmp+1
lda diskvect+1,x
sta diskjmp+2
lda #clrscrn ;clear screen
jsr chrout
pla ;print title
tay
lda disklist,y
tax
lda disklist+1,y
tay
jsr center
lda #13
jsr chrout
jsr diskjmp ;call routine
jmp diskutil1 ;keep looping
diskutilx ;exit
lda #mdmfn ;re-open modem
jsr openmodem
rts
;
;Display Blocks Free
;This is actually a cheap imitation
;of the directory command.
bkname .byte "$",0 ;invalid name
bkfree
ldx #<bkname
ldy #>bkname
jmp lstdir0
;Warn user that he is about to destroy
;the data on a diskette.
warnmsg
.byte "Insert the diskette to be formatted or",13
.byte "initialized. All data on the diskette",13
.byte "will be lost",13,13
.byte "Enter 'y' to continue, 'n' to abort: ",0
warnpkt
.byte PP$EOS|PP$BELL|PP$WAIT
.byte 3,0
.word warnmsg
warn
lda hilite
ldx #<warnpkt
ldy #>warnpkt
jsr printpkt
cmp #'y
beq warnx
cmp #'n
bne warn
warnx
rts
fmtdcmd .byte "n0:",0
fmtflg .byte 0
namemsg .byte "Disk name (16): ",0
namepkt
.byte PP$BELL
.byte 10,0
.word namemsg
idmsg .byte "Disk ID (2): ",0
idpkt
.byte PP$BELL
.byte 11,0
.word idmsg
;Format a disk
fmtdsk
lda #1 ;format mode (not initialize)
sta fmtflg
fmtdsk0
ldx #2
jsr eraseeos
ldx #<fmtdcmd
ldy #>fmtdcmd
jsr setcmd
jsr warn
cmp #'y
beq fmtdsk1
jmp fmtx
fmtdsk1
lda hilite
ldx #<namepkt
ldy #>namepkt
jsr printpkt
lda #16
jsr gets
lda buf
beq fmtdsk0
lda #<buf ;add name to command
sta string$2
lda #>buf
sta string$2+1
lda #<cmdbuf
sta string$1
lda #>cmdbuf
sta string$1+1
jsr strcat
lda fmtflg
beq fmtdsk2
lda hilite
ldx #<idpkt
ldy #>idpkt
jsr printpkt
lda #2
jsr gets
lda buf
beq fmtdsk0 ;null response
lda #',
jsr addchr ;add a comma to command
lda #<cmdbuf ;append disk id
sta string$1
lda #>cmdbuf
sta string$1+1
lda #<buf
sta string$2
lda #>buf
sta string$2+1
jsr strcat
fmtdsk2
jsr cmddsk ;send command to disk
jsr crwait
jmp fmtdsk0
fmtx
rts
;Initialize a disk (quick format).
indisk
lda #0
sta fmtflg
jmp fmtdsk0
;
;List directory
;
pors .byte "Printer (p) or Screen (s)? ",0
porspkt
.byte PP$BELL|PP$EOS|PP$WAIT
.byte 5,0
.word pors
;Get printer or screen mode
;Returns:
; lstmode = 0 => screen
; lstmode = 1 => printer
getmode
lda #0
sta lstmode
lda hilite
ldx #<porspkt
ldy #>porspkt
jsr printpkt
cmp #13
beq getmodex
cmp #'s
beq getmodex
cmp #'p
bne getmode ;try again
inc lstmode
jsr opnptr ;open the printer
getmodex
rts
;Select screen or printer as output device
selout
jsr clrchn
lda lstmode
beq seloutx
ldx #pfn
jsr chkout
seloutx
rts
lstmsg .byte "STOP to quit, any other key for more",0
lstmode .byte 0
enddir .byte 0 ;1 => end of directory
lstdir
jsr getmode
lda #clrscrn ;clear the screen
jsr chrout
ldx #<null ;null specification
ldy #>null
lstdir0
jsr open$dir
sta dfn ;save file number
cmp #0 ;open?
bne lstdir01 ;no
jmp lstdirx1
lstdir01
ldy #0
sty enddir
tax
jsr chkin
jsr getin ;discard load address bytes
jsr getin
lda #0
sta filcnt ;initialize file count
lstdir1
lda enddir ;end of directory?
beq lstdir10
jmp lstdirx
lstdir10
ldx dfn
jsr chkin
jsr getin ;discard link address
jsr getin
jsr getdir ;get directory entry
beq lstdir11 ;end of directory?
inc enddir
lstdir11
jsr fmtdir ;format directory entry
lstdir3
inc filcnt ;count files printed
lda lstmode
bne lstdir4
lda filcnt
cmp #23
bne lstdir1
lda #13
jsr chrout
ldx #<lstmsg
ldy #>lstmsg
jsr errmsg ;wait for key
cmp #$03 ;STOP key?
beq lstdirx
jsr scrndmp ;test for screen dump
lda #clrscrn ;clear screen
jsr chrout
lda #0
sta filcnt
lstdir4
jsr clrchn
jmp lstdir1
lstdirx
jsr clrchn
lda lstmode
beq lstdirx0
jsr clsptr
jmp lstdirx1
lstdirx0
lda filcnt ;anything left on screen?
beq lstdirx1
jsr crwait ;yes - wait for user to read it
lstdirx1
lda dfn ;close directory file
jsr fclose
rts
;Format and print one directory entry
;or 'blocks free' if enddir != 0.
bksmsg .byte " blocks free",0
fmtdir
lda disk$blks
sta imath$val
lda disk$blks+1
sta imath$val+1
ldx #<cmdbuf
ldy #>cmdbuf
jsr itoa ;convert integer to ascii
ldx #<cmdbuf
ldy #>cmdbuf
lda enddir ;is this 'blocks free'?
beq fmtdir0
jsr print
ldx #<bksmsg
ldy #>bksmsg
jsr println
jmp fmtdirx ;exit
fmtdir0
lda #4
jsr tabstr ;pad with spaces
jsr selout ;select output device
ldx #<cmdbuf
ldy #>cmdbuf
jsr print
lda #'"
jsr chrout
ldx #<disk$fnam
ldy #>disk$fnam
jsr print
lda #'"
jsr chrout
ldx #<disk$fnam ;compute padding
ldy #>disk$fnam
jsr strlen
tay
fmtdir1
lda #32 ;output spaces
jsr chrout
iny
cpy #20
bne fmtdir1
ldx #<disk$ftyp
ldy #>disk$ftyp
jsr println
fmtdirx
jsr clrchn
rts
;
;Send commands to disk
;
dsendmsg
.byte "Enter disk command or RETURN to quit",0
dsendpkt
.byte PP$BELL
.byte 12,0
.word dsendmsg
dprmpt
.byte ">",0
dprpkt
.byte PP$EOL|PP$BELL
.byte 14,0
.word dprmpt
dsend
lda hilite
ldx #<dsendpkt
ldy #>dsendpkt
jsr printpkt
dsend1
lda hilite
ldx #<dprpkt
ldy #>dprpkt
jsr printpkt
lda #58 ;design maximum?
jsr gets
beq dsendx ;null response?
jsr gdk$ccf ;get command channel fn
jsr chkout
ldx #<buf
ldy #>buf
jsr println ;print to disk
jsr clrchn
jsr pdkst
jmp dsend1
dsendx
rts
;Print disk status
dkstpkt
.byte PP$EOL
.byte 16,0
.word disk$status
pdkst
jsr ckdisk ;test status
lda hilite
ldx #<dkstpkt
ldy #>dkstpkt
jsr printpkt
rts
;Send command (in cmdbuf) to disk,
;then display status
cmddsk
jsr gdk$ccf
jsr chkout
ldx #<cmdbuf
ldy #>cmdbuf
jsr println
jsr clrchn
jsr pdkst
rts
;Rename a file
rn .byte "r0:",0
newp .byte "NEW filename (16): ",0
newpkt
.byte PP$EOS|PP$BELL
.byte 12,0
.word newp
oldp .byte "OLD filename (16): ",0
oldpkt
.byte PP$EOS|PP$BELL
.byte 13,0
.word oldp
rename
ldx #<rn
ldy #>rn
jsr setcmd
ldx #<newpkt
ldy #>newpkt
jsr getnam
beq renamex
jsr catbuf
lda #'= ;append '=' to command
jsr addchr
ldx #<oldpkt
ldy #>oldpkt
jsr getnam
beq renamex
jsr catbuf
jsr cmddsk
jsr crwait
jmp rename
renamex
rts
;Get filename
;Called with:
; X,Y = prompt string packet
;Returns:
; ACC = First response character
; BUF = file name
getnam
lda hilite
jsr printpkt
lda #16
jsr gets
lda buf
rts
;Scratch File(s)
scrmsg .byte "File(s) to scratch or RETURN to quit:",13,0
scrpkt
.byte PP$EOS|PP$BELL
.byte 10,0
.word scrmsg
scrfil
lda hilite
ldx #<scrpkt
ldy #>scrpkt
jsr printpkt
lda #55 ; (58 - 's0:')
jsr gets
lda buf
beq scrfilx
ldx #<buf
ldy #>buf
jsr scratch
jsr pdkst ;print disk status
jsr crwait
jmp scrfil
scrfilx
rts
;Setup disk command string
setcmd
stx string$2
sty string$2+1
lda #<cmdbuf ;store command part
sta string$1 ;of string
lda #>cmdbuf
sta string$1+1
jsr strcpy
rts
;Add a character to the end of the
;command string.
;Called with:
; ACC = character to append
addchr
pha ;save character to append
ldx #<cmdbuf ;append comma
ldy #>cmdbuf
jsr strlen
tax
pla ;retrieve character
sta cmdbuf,x
inx
lda #0
sta cmdbuf,x
rts
;Catenate the contents of BUF with
;cmdbuf
catbuf
lda #<cmdbuf
sta string$1
lda #>cmdbuf
sta string$1+1
lda #<buf
sta string$2
lda #>buf
sta string$2+1
jsr strcat
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 |