mirror of https://github.com/callapple/LLUCE.git
Initial Commit of LLUCE sources
This commit is contained in:
Lane Roathe
parent
a9134d714e
commit
d4bd737e57
|
|
@ -0,0 +1,135 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* reconfigure clocks
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
point0 = $11
|
||||
point1 = $14
|
||||
clkdrv = $a00
|
||||
|
||||
DSK REL/CLOCK
|
||||
|
||||
TopBox EXT ; routines external to this file
|
||||
print EXT
|
||||
cls EXT
|
||||
start EXT
|
||||
escape EXT
|
||||
inpnum EXT
|
||||
chinit EXT
|
||||
wrtchg EXT
|
||||
|
||||
gsclock EXT ;gs clock driver
|
||||
serialpro EXT ;serialpro driver
|
||||
thunder EXT ;thunderclock/timemaster driver
|
||||
iicsys EXT ;iic system clock
|
||||
mountain EXT ;mountain clock
|
||||
prodos EXT ;standard prodos stuff
|
||||
nullclk EXT ;no clock
|
||||
noslot EXT ;no slot clock
|
||||
versa EXT ;prometheus versacard
|
||||
ultra EXT ;ultra clock driver
|
||||
|
||||
re_clk ENT
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,30
|
||||
ASC '- Reconfigure Clock -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix C of your user'
|
||||
ASC ' manual for more information.'00
|
||||
|
||||
JSR cls
|
||||
LDX #<start ; setup esc handler
|
||||
LDA #>start
|
||||
JSR escape
|
||||
|
||||
LDA #<clkdrv ;tell it to move the modem
|
||||
STA point1 ;driver
|
||||
LDA #>clkdrv
|
||||
STA point1+1
|
||||
|
||||
IIeClk JSR print
|
||||
DB 1,7,0
|
||||
|
||||
ASC ' 1 - Thunderclock Compatible '
|
||||
ASC ' 7 - ProDOS Compatible Clock'0D
|
||||
ASC ' 2 - A.E. Timemaster II H.O. '
|
||||
ASC ' 8 - Mountain Hardware Clock'0D
|
||||
ASC ' 3 - A.E. Serial Pro '
|
||||
ASC ' 9 - Prometheus Versacard'0D
|
||||
ASC ' 4 - A.E. //c Ultra Clock '
|
||||
ASC '10 - Apple IIgs System Clock'0D
|
||||
ASC ' 5 - A.E. //c System Clock '
|
||||
ASC '11 - No Clock in System'0D
|
||||
ASC ' 6 - SMT No-Slot Clock'0D0D
|
||||
|
||||
ASC 'Which? [1-11] '00
|
||||
|
||||
LDX #11
|
||||
JSR inpnum
|
||||
|
||||
PHA
|
||||
ASL
|
||||
TAX
|
||||
LDA :clktbl,X
|
||||
STA point0
|
||||
INX
|
||||
LDA :clktbl,X
|
||||
STA point0+1
|
||||
|
||||
PLA
|
||||
CMP #4 ;no slot clock
|
||||
BEQ :noslot
|
||||
CMP #5 ;no slot clock
|
||||
BEQ :noslot
|
||||
CMP #6 ;no clock in system
|
||||
BEQ :noslot
|
||||
CMP #10
|
||||
BEQ :noslot
|
||||
CMP #11
|
||||
BNE :slot
|
||||
PHA ; save fake slot
|
||||
PHA ; save fake mode
|
||||
JMP :done
|
||||
|
||||
:slot JSR print
|
||||
DB 1,16,0
|
||||
ASC 'Which slot/port does the clock use? [1-7] ',00
|
||||
|
||||
LDX #7 ; get slot
|
||||
JSR inpnum
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
:noslot PHA ;save slot
|
||||
|
||||
:done LDY #0 ;move the single page
|
||||
:loop LDA (point0),Y ;source
|
||||
STA (point1),Y ;destination
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
LDY #0
|
||||
PLA ;get the slot back
|
||||
STA (point1),Y
|
||||
|
||||
JSR chinit ; check for init
|
||||
JMP wrtchg ; write the changes
|
||||
|
||||
:clktbl DA 0
|
||||
DA thunder
|
||||
DA thunder
|
||||
DA serialpro
|
||||
DA ultra
|
||||
DA noslot
|
||||
DA iicsys
|
||||
DA prodos
|
||||
DA mountain
|
||||
DA versa
|
||||
DA gsclock
|
||||
DA nullclk
|
||||
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* //c System Clock - 24 hr
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/iicsys
|
||||
|
||||
lnbuf equ $200
|
||||
|
||||
ZBUF EQU $41
|
||||
PTR EQU $42
|
||||
|
||||
stat1 equ $c099
|
||||
comm1 equ $c09a
|
||||
stat2 equ $c0a9
|
||||
comm2 equ $c0aa
|
||||
|
||||
bytcnt equ $0e03
|
||||
nullptr equ $0a
|
||||
|
||||
|
||||
iicsys ent
|
||||
|
||||
org $0a00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
slot hex 20
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
; get the date in prodos/gbbs format
|
||||
getdate jsr $bf00 ; read date from MLI
|
||||
hex 82
|
||||
hex 0000
|
||||
|
||||
ldx $bf90
|
||||
lda $bf91
|
||||
|
||||
setdate rts
|
||||
|
||||
; get the current time
|
||||
gettime jsr rdclock ; read the clock
|
||||
|
||||
lda #':'
|
||||
sta timestr+2 ; put time dividers in
|
||||
sta timestr+5
|
||||
|
||||
ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
; read the date time from clock
|
||||
rdclock lda slot
|
||||
cmp #$10
|
||||
beq init1
|
||||
|
||||
lda #<stat2 ; set status port to slot 2
|
||||
sta init3_2+1
|
||||
lda #<comm2 ; set comm port to slot 2
|
||||
sta init1_3+1
|
||||
sta init2+1
|
||||
sta init3_3+1
|
||||
|
||||
init1 lda #64
|
||||
init1_1 pha
|
||||
init1_2 sbc #1
|
||||
bne init1_2
|
||||
pla
|
||||
sbc #1 ; give plenty of setup delay
|
||||
bne init1_1
|
||||
|
||||
php
|
||||
sei
|
||||
init1_3 lda comm1 ; get current setting
|
||||
pha
|
||||
|
||||
ldy #3
|
||||
ldx #22
|
||||
lda #8
|
||||
init2 sta comm1 ; send init sequence to clock
|
||||
|
||||
init2_1 dex ; intra-bit delay
|
||||
bne init2_1
|
||||
|
||||
eor #$a ; toggle back and forth
|
||||
ldx #11
|
||||
dey
|
||||
bne init2 ; keep looping
|
||||
|
||||
ldy #4
|
||||
ldx #8
|
||||
bne init3_2 ; skip initial delay
|
||||
|
||||
init3 lda #$34
|
||||
sta timer ; delay while clock sets up
|
||||
init3_1 dec timer ; to send the date/time
|
||||
bne init3_1
|
||||
|
||||
init3_2 lda stat1 ; shift bit data into nibble
|
||||
rol
|
||||
rol
|
||||
rol
|
||||
ror datestr
|
||||
dex
|
||||
bne init3 ; go back to delay
|
||||
|
||||
lda datestr
|
||||
eor #0 ; save the nibble
|
||||
sta datestr,y
|
||||
|
||||
ldx #8
|
||||
dey
|
||||
bpl init3
|
||||
|
||||
pla
|
||||
init3_3 sta comm1 ; retore uart to initial settings
|
||||
|
||||
ldy #15
|
||||
ldx #4
|
||||
|
||||
init4 lda datestr,x
|
||||
pha
|
||||
and #$f ; process digit (make into ascii)
|
||||
ora #$30
|
||||
sta datestr,y
|
||||
|
||||
dey
|
||||
pla
|
||||
lsr
|
||||
lsr
|
||||
lsr ; process top of nibble
|
||||
lsr
|
||||
ora #$30 ; turn into ascii
|
||||
sta datestr,y
|
||||
|
||||
dey
|
||||
dey
|
||||
dex
|
||||
bpl init4
|
||||
plp
|
||||
rts
|
||||
|
||||
timer hex 00
|
||||
datestr asc '00 00 00'
|
||||
timestr asc '00:00:00 '
|
||||
date hex 0000
|
||||
|
||||
|
|
@ -0,0 +1,54 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Clock Driver Header Block
|
||||
*-------------------------------
|
||||
* Revised Date: 08/01/87
|
||||
*-------------------------------
|
||||
*
|
||||
* driver load info
|
||||
*
|
||||
* $0800 = header block ;offset
|
||||
* $0a00 = Thunder/Timemaster ;2
|
||||
* $0b00 = A.E. Serial Pro ;3
|
||||
* $0c00 = SMT No Slot clock ;4
|
||||
* $0d00 = //c System Clock ;5
|
||||
* $0e00 = Apple //gs Clock ;6
|
||||
* $0f00 = A.E. Ultra Clock ;7
|
||||
* $1000 = prodos compatible ;8
|
||||
* $1100 = Mountain Clock ;9
|
||||
* $1200 = Versacard ;a
|
||||
* $1300 = no clock in system ;b
|
||||
|
||||
rel
|
||||
dsk rel/clocks.hdr
|
||||
|
||||
org $800
|
||||
|
||||
clocks hex 0201
|
||||
asc 'Thunderclock Compatable '
|
||||
hex 0201
|
||||
asc 'A.E. Timemaster II H.O. '
|
||||
hex 0301
|
||||
asc 'A.E. Serial Pro '
|
||||
hex 8401
|
||||
asc 'SMT No Slot Clock '
|
||||
hex 0501
|
||||
asc 'A.E. //c System Clock '
|
||||
hex 8601
|
||||
asc 'Apple //GS built-in clock '
|
||||
hex 8701
|
||||
asc 'A.E. Ultra Clock '
|
||||
hex 8801
|
||||
asc 'ProDOS Compatible Clock '
|
||||
hex 0901
|
||||
asc 'Mountain Hardware Clock '
|
||||
hex 0a01
|
||||
asc 'Prometheus Versacard '
|
||||
hex 8b01
|
||||
asc 'No Clock in System '
|
||||
|
||||
hex 0000
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,213 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* //c System Clock - 24 hr
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/iicsys
|
||||
|
||||
iicsys ent
|
||||
|
||||
org $0a00
|
||||
|
||||
lnbuf equ $200
|
||||
|
||||
ZBUF EQU $41
|
||||
PTR EQU $42
|
||||
|
||||
stat1 equ $c099
|
||||
comm1 equ $c09a
|
||||
stat2 equ $c0a9
|
||||
comm2 equ $c0aa
|
||||
|
||||
bytcnt equ $0e03
|
||||
nullptr equ $0a
|
||||
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
time equ $bf92
|
||||
get_time equ $82
|
||||
|
||||
|
||||
slot hex 20
|
||||
mode db 0
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
rts ; jmp setdate
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
|
||||
getdate jsr mli ; mli call
|
||||
db get_time ; get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
|
||||
gettime jsr rdtime
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* read time from clock
|
||||
*-------------------------------
|
||||
|
||||
rdtime jsr rdclock ; read the clock
|
||||
|
||||
lda #':'
|
||||
sta timestr+2 ; put time dividers in
|
||||
sta timestr+5
|
||||
|
||||
ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
; read the date time from clock
|
||||
rdclock lda #64
|
||||
init1_1 pha
|
||||
init1_2 sbc #1
|
||||
bne init1_2
|
||||
pla
|
||||
sbc #1 ; give plenty of setup delay
|
||||
bne init1_1
|
||||
|
||||
php
|
||||
sei
|
||||
init1_3 lda comm1 ; get current setting
|
||||
pha
|
||||
|
||||
ldy #3
|
||||
ldx #22
|
||||
lda #8
|
||||
init2 sta comm1 ; send init sequence to clock
|
||||
|
||||
init2_1 dex ; intra-bit delay
|
||||
bne init2_1
|
||||
|
||||
eor #$0a ; toggle back and forth
|
||||
ldx #11
|
||||
dey
|
||||
bne init2 ; keep looping
|
||||
|
||||
ldy #4
|
||||
ldx #8
|
||||
bne init3_2 ; skip initial delay
|
||||
|
||||
init3 lda #$34
|
||||
sta timer ; delay while clock sets up
|
||||
init3_1 dec timer ; to send the date/time
|
||||
bne init3_1
|
||||
|
||||
init3_2 lda stat1 ; shift bit data into nibble
|
||||
rol
|
||||
rol
|
||||
rol
|
||||
ror datestr
|
||||
dex
|
||||
bne init3 ; go back to delay
|
||||
|
||||
lda datestr
|
||||
eor #0 ; save the nibble
|
||||
sta datestr,y
|
||||
|
||||
ldx #8
|
||||
dey
|
||||
bpl init3
|
||||
|
||||
pla
|
||||
init3_3 sta comm1 ; retore uart to initial settings
|
||||
|
||||
ldy #15
|
||||
ldx #4
|
||||
|
||||
init4 lda datestr,x
|
||||
pha
|
||||
and #$0f ; process digit (make into ascii)
|
||||
ora #$30
|
||||
sta datestr,y
|
||||
|
||||
dey
|
||||
pla
|
||||
lsr
|
||||
lsr
|
||||
lsr ; process top of nibble
|
||||
lsr
|
||||
ora #$30 ; turn into ascii
|
||||
sta datestr,y
|
||||
|
||||
dey
|
||||
dey
|
||||
dex
|
||||
bpl init4
|
||||
plp
|
||||
rts
|
||||
|
||||
* convert time to 12hr format
|
||||
*----------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
and #$0f
|
||||
tay
|
||||
txa
|
||||
and #$0f
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
ldx #'M'
|
||||
stx timestr+10
|
||||
rts
|
||||
|
||||
timer hex 00
|
||||
datestr asc '00 00 00'
|
||||
timestr asc '00:00:00 '
|
||||
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,170 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Clock driver bios
|
||||
* Written by Andy Nicholas - 07/30/87
|
||||
* rewritten by Andy 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
xc ; goto 65816 mode
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/gsclock
|
||||
|
||||
gsclock ent
|
||||
|
||||
org $A00
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
dow db 0
|
||||
mode db 0
|
||||
|
||||
jmp getdate ;call to get the date
|
||||
jmp gettime ;call to get the time (formatted)
|
||||
jmp setdate ;known return point
|
||||
|
||||
* Read Clock from ProDOS
|
||||
*-------------------------------
|
||||
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
|
||||
getdate jsr mli ;read the clock into
|
||||
hex 82 ;buffer at $200
|
||||
da 0
|
||||
|
||||
ldx date ;read date in compressed form
|
||||
lda date+1 ;into A & X
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
|
||||
gettime jsr rdtime
|
||||
ldy #8
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
ldy #11
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* read time from clock
|
||||
*-------------------------------
|
||||
|
||||
rdtime clc ;go to native mode
|
||||
xce
|
||||
rep #'0' ;and 16 bit A, X, and Y
|
||||
|
||||
pha ;stack space for results
|
||||
pha
|
||||
pha
|
||||
pha
|
||||
ldx #$D03 ;ReadTimeHex
|
||||
jsl $E10000 ;Tool Locater
|
||||
sec
|
||||
xce ;emulation mode
|
||||
|
||||
pla ; seconds
|
||||
jsr bindec8 ; convert to two byte
|
||||
sta timestr+6
|
||||
stx timestr+7
|
||||
pla ; minutes
|
||||
jsr bindec8 ; convert to two byte
|
||||
sta timestr+3
|
||||
stx timestr+4
|
||||
pla ; hour
|
||||
jsr bindec8 ; convert to two byte
|
||||
sta timestr
|
||||
stx timestr+1
|
||||
pla ; year
|
||||
pla ; day of month
|
||||
pla ; month
|
||||
pla ; unused byte
|
||||
pla ; day of the week
|
||||
sta dow
|
||||
|
||||
lda #' '
|
||||
sta timestr+9
|
||||
sta timestr+10
|
||||
|
||||
rts ;bye..
|
||||
|
||||
* convert time to 12hr format
|
||||
*----------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
and #$F
|
||||
tay
|
||||
txa
|
||||
and #$F
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
ldx #'M'
|
||||
stx timestr+10
|
||||
rts
|
||||
|
||||
* translate a binary to text [0-99]
|
||||
*-------------------------------
|
||||
|
||||
bindec8 cmp #60 ; put limit of 59
|
||||
bcc bin8
|
||||
lda #59
|
||||
|
||||
bin8 ldy #0 ; start 10's counter
|
||||
bin8a cmp #10
|
||||
bcc bin8b ; less than 10, were done
|
||||
|
||||
sbc #10 ; minus 10
|
||||
iny ; add 1 to the 10's counter
|
||||
bne bin8a ; loop
|
||||
|
||||
bin8b adc #'0' ; make 1's into text
|
||||
tax ; save
|
||||
tya
|
||||
adc #'0' ; make 10's into text
|
||||
rts ; were done
|
||||
|
||||
* '01234567890
|
||||
timestr asc '12:00:00 '
|
||||
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
asm thunder
|
||||
ds \
|
||||
asm serialpro
|
||||
ds \
|
||||
asm no.slot
|
||||
ds \
|
||||
asm iic.sys
|
||||
ds \
|
||||
asm iigs
|
||||
ds \
|
||||
asm ultra
|
||||
ds \
|
||||
asm prodos
|
||||
ds \
|
||||
asm mountain
|
||||
ds \
|
||||
asm versa
|
||||
ds \
|
||||
asm null
|
||||
|
||||
link rel/thunder
|
||||
ds \
|
||||
link rel/serialpro
|
||||
ds \
|
||||
link rel/no.slot
|
||||
ds \
|
||||
link rel/iic.sys
|
||||
ds \
|
||||
link rel/iigs
|
||||
ds \
|
||||
link rel/ultra
|
||||
ds \
|
||||
link rel/prodos
|
||||
ds \
|
||||
link rel/mountain
|
||||
ds \
|
||||
link rel/versa
|
||||
ds \
|
||||
link rel/null
|
||||
|
||||
|
|
@ -0,0 +1,160 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Mountian Hardware Driver
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/mountain
|
||||
|
||||
mountain ent
|
||||
|
||||
org $0a00
|
||||
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
time equ $bf92
|
||||
get_time equ $82
|
||||
|
||||
|
||||
slot hex 40
|
||||
mode db 0
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
getdate jsr mli ; mli call
|
||||
db get_time ; get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
gettime jsr rdtime
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* get time routine
|
||||
*-------------------
|
||||
rdtime jsr rdclock
|
||||
lda #':' ; clean up format
|
||||
sta timestr+2
|
||||
sta timestr+5
|
||||
rts
|
||||
|
||||
* read time from clock
|
||||
*----------------------
|
||||
rdclock lda $38
|
||||
pha
|
||||
lda $39 ; save zp addresses
|
||||
pha
|
||||
lda slot
|
||||
lsr
|
||||
lsr
|
||||
lsr
|
||||
lsr
|
||||
ora #$c0
|
||||
sta $39 ; point to clock entry
|
||||
sta callclk+2
|
||||
callclk jsr $c000 ; call clock
|
||||
pla
|
||||
sta $39
|
||||
pla ; restore zp
|
||||
sta $38
|
||||
|
||||
ldx #$0d
|
||||
ldy #0
|
||||
movtime lda $286,x ; move returned string
|
||||
and #$7f
|
||||
sta datestr,y
|
||||
iny
|
||||
dex
|
||||
bpl movtime
|
||||
rts
|
||||
|
||||
* convert time to 12hr format
|
||||
*----------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
and #$0f
|
||||
tay
|
||||
txa
|
||||
and #$0f
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
ldx #'M'
|
||||
stx timestr+10
|
||||
rts
|
||||
|
||||
; convert a 2 byte decimal number to binary
|
||||
decbin8 and #$7f
|
||||
sec
|
||||
sbc #'0'
|
||||
sta decbyte ; save 10's digit
|
||||
txa ; move 1's into A
|
||||
and #$7f
|
||||
sec
|
||||
sbc #'0'
|
||||
|
||||
ldy #10
|
||||
dec8a clc
|
||||
adc decbyte ; add the 10's digit, 10 times
|
||||
dey
|
||||
bne dec8a
|
||||
rts ; return with result
|
||||
|
||||
decbyte hex 00
|
||||
datestr asc '00/00/00'
|
||||
timestr asc '00:00:00 '
|
||||
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,191 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* No Slot Clock - 24 hr
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/noslot
|
||||
|
||||
ZBUF EQU $41
|
||||
PTR EQU $42
|
||||
|
||||
YEAR EQU $44
|
||||
HOURS EQU $48
|
||||
TEMP EQU $2F0
|
||||
|
||||
date equ $bf90
|
||||
get_time equ $82
|
||||
|
||||
|
||||
noslot ent
|
||||
|
||||
org $0a00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
db $00
|
||||
MODE dfb $00
|
||||
JMP getdate
|
||||
JMP getime
|
||||
JMP setdate
|
||||
|
||||
*
|
||||
* TIME OUTPUT BUFFER
|
||||
*
|
||||
|
||||
TIME ASC '00:00:00 '
|
||||
*
|
||||
* DEFINE RECOGNITION SEQUENCE FOR NO-SLOT CLOCK
|
||||
*
|
||||
|
||||
RECSEQ db $5C,$A3,$3A,$C5,$5C,$A3,$3A,$C5
|
||||
|
||||
*
|
||||
* FORMAT NO-SLOT CLOCK DATE
|
||||
*
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
|
||||
getdate jsr $bf00 ; mli call
|
||||
db get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
*
|
||||
* FORMAT NO-SLOT CLOCK TIME
|
||||
*
|
||||
|
||||
getime JSR RDCLOCK
|
||||
LDY HOURS
|
||||
LDA MODE
|
||||
BEQ FMT24
|
||||
LDA #'M'
|
||||
STA TIME+10
|
||||
LDX #'A'
|
||||
SED
|
||||
SEC
|
||||
TYA
|
||||
SBC #$12
|
||||
CLD
|
||||
BCC SETHOUR
|
||||
TAY
|
||||
BNE NOTNOON
|
||||
LDY #$12
|
||||
NOTNOON LDX #'P'
|
||||
SETHOUR STX TIME+9
|
||||
TYA
|
||||
BNE FMT24
|
||||
LDY #$12
|
||||
FMT24 TYA
|
||||
LDY #0
|
||||
LDX #0
|
||||
FMT PHA
|
||||
AND #$F0
|
||||
LSR
|
||||
LSR
|
||||
LSR
|
||||
LSR
|
||||
CLC
|
||||
ADC #'0'
|
||||
STA TIME,Y
|
||||
INY
|
||||
PLA
|
||||
AND #$F
|
||||
ADC #'0'
|
||||
STA TIME,Y
|
||||
INY
|
||||
INY
|
||||
INX
|
||||
LDA HOURS,X
|
||||
CPX #3
|
||||
BNE FMT
|
||||
JSR ZRECALL
|
||||
*
|
||||
LDX #<TIME
|
||||
LDA #>TIME
|
||||
RTS
|
||||
*
|
||||
* RECALL PG ZERO BUFFER (ACCESS VIA JMP)
|
||||
*
|
||||
ZRECALL LDY #$A
|
||||
ZRECALL1 LDA TEMP,Y
|
||||
STA PTR,Y
|
||||
DEY
|
||||
BNE ZRECALL1
|
||||
RTS
|
||||
*
|
||||
* READ THE NO-SLOT CLOCK AND RETRIEVE DATE/TIME
|
||||
*
|
||||
RDCLOCK LDY #$A
|
||||
STORBUF LDA ZBUF,Y
|
||||
STA TEMP,Y
|
||||
DEY
|
||||
BNE STORBUF
|
||||
SEI
|
||||
LDA $C015
|
||||
PHA
|
||||
STA $C007
|
||||
LDA $C804
|
||||
LDA #<RECSEQ
|
||||
STA PTR
|
||||
LDA #>RECSEQ
|
||||
STA PTR+1
|
||||
LDY #7
|
||||
RECOG1 LDA (PTR),Y
|
||||
SEC
|
||||
ROR
|
||||
RECOG2 PHA
|
||||
LDA #0
|
||||
ROL
|
||||
TAX
|
||||
LDA $C800,X
|
||||
PLA
|
||||
LSR
|
||||
BNE RECOG2
|
||||
DEY
|
||||
BPL RECOG1
|
||||
LDX #7
|
||||
NEXTREAD LDY #7
|
||||
READBIT LDA $C804
|
||||
ROR
|
||||
ROR YEAR,X
|
||||
DEY
|
||||
BPL READBIT
|
||||
CPX #3
|
||||
BPL STORDATE
|
||||
LDA YEAR,X
|
||||
PHA
|
||||
AND #$F
|
||||
STA YEAR,X
|
||||
PLA
|
||||
AND #$F0
|
||||
LSR
|
||||
LSR
|
||||
LSR
|
||||
LSR
|
||||
TAY
|
||||
BEQ STORDATE
|
||||
LDA #0
|
||||
ADDTENS ADC #10
|
||||
DEY
|
||||
BNE ADDTENS
|
||||
ADC YEAR,X
|
||||
STA YEAR,X
|
||||
STORDATE DEX
|
||||
BPL NEXTREAD
|
||||
PLA
|
||||
ROL
|
||||
BCS RDEND
|
||||
STA $C006
|
||||
RDEND RTS
|
||||
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* No Clock Driver
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/null
|
||||
|
||||
bytcnt equ $0e03
|
||||
nullptr equ $0a
|
||||
|
||||
nullclk ent
|
||||
|
||||
org $D00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
slot hex 00
|
||||
mode db 0
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
* get the date in prodos/gbbs format
|
||||
*-------------------------------
|
||||
|
||||
getdate ldx date
|
||||
lda date+1
|
||||
rts
|
||||
|
||||
* set the date manually
|
||||
*-------------------------------
|
||||
|
||||
setdate cpy #8 ; is it 8 chars long?
|
||||
bne setdt2 ; nope
|
||||
|
||||
stx nullptr ; point to string
|
||||
sta nullptr+1
|
||||
|
||||
ldy #7
|
||||
lda (nullptr),y
|
||||
tax ; process year
|
||||
dey
|
||||
lda (nullptr),y
|
||||
jsr decbin8
|
||||
sta date+1 ; save year
|
||||
|
||||
ldy #4
|
||||
lda (nullptr),y
|
||||
tax ; process day
|
||||
dey
|
||||
lda (nullptr),y
|
||||
jsr decbin8
|
||||
and #%00011111
|
||||
sta date ; save day
|
||||
|
||||
ldy #1
|
||||
lda (nullptr),y
|
||||
tax ; process month
|
||||
dey
|
||||
lda (nullptr),y
|
||||
jsr decbin8
|
||||
and #%00001111 ; get rid of extra junk
|
||||
asl
|
||||
asl
|
||||
asl
|
||||
asl
|
||||
asl
|
||||
rol date+1 ; put bit into year field
|
||||
ora date
|
||||
sta date ; put rest into day field
|
||||
setdt2 rts
|
||||
|
||||
* get the current estimated time
|
||||
*-------------------------------
|
||||
|
||||
gettime lda bytcnt+2 ; show hours
|
||||
jsr bindec8
|
||||
sta timestr
|
||||
stx timestr+1
|
||||
|
||||
lda bytcnt+1 ; show minutes
|
||||
jsr bindec8
|
||||
sta timestr+3
|
||||
stx timestr+4
|
||||
|
||||
lda bytcnt+0 ; show seconds
|
||||
jsr bindec8
|
||||
sta timestr+6
|
||||
stx timestr+7
|
||||
|
||||
ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* convert a 2 byte decimal number to binary
|
||||
*-------------------------------
|
||||
|
||||
decbin8 and #$7f
|
||||
sec
|
||||
sbc #'0'
|
||||
sta decbyte ; save 10's digit
|
||||
txa ; move 1's into A
|
||||
and #$7F
|
||||
sec
|
||||
sbc #'0'
|
||||
|
||||
ldy #10
|
||||
dec8a clc
|
||||
adc decbyte ; add the 10's digit, 10 times
|
||||
dey
|
||||
bne dec8a
|
||||
rts ; return with result
|
||||
|
||||
decbyte hex 00
|
||||
|
||||
* translate a binary to text [0-99]
|
||||
*-------------------------------
|
||||
|
||||
bindec8 cmp #60 ; put limit of 59
|
||||
bcc bin8
|
||||
lda #59
|
||||
|
||||
bin8 ldy #0 ; start 10's counter
|
||||
bin8a cmp #10
|
||||
bcc bin8b ; less than 10, were done
|
||||
|
||||
sbc #10 ; minus 10
|
||||
iny ; add 1 to the 10's counter
|
||||
bne bin8a ; loop
|
||||
|
||||
bin8b adc #'0' ; make 1's into text
|
||||
tax ; save
|
||||
tya
|
||||
adc #'0' ; make 10's into text
|
||||
rts ; were done
|
||||
|
||||
timestr asc '00:00:00 ET'
|
||||
date hex 0000
|
||||
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,144 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* ProDOS Clock Driver
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/prodos
|
||||
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
time equ $bf92
|
||||
get_time equ $82
|
||||
|
||||
prodos ent
|
||||
org $0a00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
db 0
|
||||
mode db 0
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
getdate jsr mli ; mli call
|
||||
db get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
gettime jsr rdtime
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* read time from prodos
|
||||
*-------------------------------
|
||||
rdtime jsr getdate ; update time
|
||||
|
||||
lda time+1 ; get current hour
|
||||
jsr bindec8 ; translate to ascii
|
||||
sta timestr ; save hour
|
||||
stx timestr+1
|
||||
|
||||
lda time ; get minutes
|
||||
jsr bindec8 ; translate to ascii
|
||||
sta timestr+3 ; save minute
|
||||
stx timestr+4
|
||||
|
||||
lda #' ' ; clear out any possible am/pm
|
||||
sta timestr+9
|
||||
sta timestr+10
|
||||
|
||||
rts
|
||||
|
||||
* convert time to 12hr format
|
||||
*----------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
and #$0f
|
||||
tay
|
||||
txa
|
||||
and #$0f
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
ldx #'M'
|
||||
stx timestr+10
|
||||
rts
|
||||
|
||||
* translate a binary to text [0-99]
|
||||
*-------------------------------
|
||||
bindec8 cmp #60 ; put limit of 59
|
||||
bcc bin8
|
||||
lda #59
|
||||
|
||||
bin8 ldy #0 ; start 10's counter
|
||||
bin8a cmp #10
|
||||
bcc bin8b ; less than 10, were done
|
||||
|
||||
sbc #10 ; minus 10
|
||||
iny ; add 1 to the 10's counter
|
||||
bne bin8a ; loop
|
||||
|
||||
bin8b adc #'0' ; make 1's into text
|
||||
tax ; save
|
||||
tya
|
||||
adc #'0' ; make 10's into text
|
||||
rts ; were done
|
||||
|
||||
* '01234567890
|
||||
timestr asc '12:00:00 '
|
||||
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,135 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Serial Pro Driver - 12 hrs
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/serialpro
|
||||
|
||||
lnbuf equ $200
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
get_time equ $82
|
||||
|
||||
serialpro ent
|
||||
|
||||
org $0a00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
slot hex 40
|
||||
mode db 0
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
|
||||
getdate jsr $bf00 ; mli call
|
||||
db get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
|
||||
gettime jsr rdtime
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* read the current time from clock
|
||||
*-------------------------------
|
||||
|
||||
rdtime bit initbyt ; has routine been called before?
|
||||
bmi clock1 ; yep
|
||||
|
||||
lda slot ; get clock slot
|
||||
lsr
|
||||
lsr
|
||||
lsr
|
||||
lsr
|
||||
ora #$C0 ; make into $Cn form
|
||||
|
||||
sta clock2+2 ; modify code for slot
|
||||
sta clock3+2
|
||||
dec initbyt ; show routine has been init'ed
|
||||
|
||||
clock1 lda #"&" ; use "&" mode
|
||||
clock2 jsr $C020 ; modified ($c420)
|
||||
clock3 jsr $C01D ; modified ($c4ld)
|
||||
|
||||
ldy #12
|
||||
ldx #0
|
||||
clock4 lda lnbuf,y
|
||||
sta timestr,x
|
||||
iny
|
||||
inx
|
||||
cpx #8
|
||||
bne clock4
|
||||
rts
|
||||
|
||||
* convert time to 12 hour format
|
||||
*-------------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
conv and #$F
|
||||
tay
|
||||
txa
|
||||
and #$F
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
|
||||
ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
initbyt hex 00
|
||||
timestr asc '00:00:00 AM'00
|
||||
|
||||
|
|
@ -0,0 +1,133 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Thunderclock Driver - 24 hrs
|
||||
*-------------------------------
|
||||
* Date Revised: 08/04/87
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK CLOCKS/REL/THUNDER
|
||||
|
||||
lnbuf = $200
|
||||
|
||||
thunder ENT
|
||||
ORG $A00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
slot HEX 40
|
||||
mode DB 0
|
||||
|
||||
JMP getdate
|
||||
JMP gettime
|
||||
JMP setdate
|
||||
|
||||
; get the date in prodos/gbbs format
|
||||
getdate JSR $BF00
|
||||
HEX 82
|
||||
DW 0
|
||||
|
||||
LDX $BF90
|
||||
LDA $BF91
|
||||
setdate RTS
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
gettime JSR rdtime
|
||||
LDA mode
|
||||
BPL gtime1
|
||||
JSR convert
|
||||
|
||||
gtime1 LDX #<timestr ; point to string
|
||||
LDA #>timestr
|
||||
RTS
|
||||
|
||||
* read time from clock
|
||||
*-------------------------------
|
||||
rdtime BIT initbyt ; has routine been called before?
|
||||
BMI clock1 ; yep
|
||||
|
||||
LDA slot ; get clock slot
|
||||
LUP 4
|
||||
LSR
|
||||
--^
|
||||
ORA #$C0 ; make into $Cn form
|
||||
|
||||
STA clock2+2 ; modify code for slot
|
||||
STA clock3+2
|
||||
DEC initbyt ; show routine has been init'ed
|
||||
|
||||
clock1 LDA #"#" ; use "&" mode (24 hour)
|
||||
clock2 JSR $C00B ; modified ($C40B)
|
||||
clock3 JSR $C008 ; modified ($C408)
|
||||
|
||||
LDY #0
|
||||
clock4 LDA lnbuf+9,y ; get time from input buffer
|
||||
STA timestr,y
|
||||
INY
|
||||
CPY #8
|
||||
BNE clock4
|
||||
LDA #":" ; put colens back into string
|
||||
STA timestr+2
|
||||
STA timestr+5
|
||||
LDA #' '
|
||||
STA timestr+9 ; make sure that the am/pm is reset
|
||||
STA timestr+10
|
||||
RTS
|
||||
|
||||
* convert time to 12 hour format
|
||||
*-------------------------------
|
||||
|
||||
convert LDA timestr ;convert to 12 hour
|
||||
LDX timestr+1
|
||||
|
||||
AND #$F
|
||||
TAY
|
||||
TXA
|
||||
AND #$F
|
||||
|
||||
DEY
|
||||
BMI conv2
|
||||
CLC
|
||||
ADC #10
|
||||
DEY
|
||||
BMI conv2
|
||||
ADC #10
|
||||
|
||||
conv2 CMP #12
|
||||
BNE conv2a
|
||||
LDA #24
|
||||
conv2a TAY
|
||||
BNE conv3
|
||||
LDA #12
|
||||
|
||||
conv3 LDX #'A'
|
||||
CMP #13
|
||||
BCC conv4
|
||||
|
||||
SBC #12
|
||||
LDX #'P'
|
||||
|
||||
conv4 LDY #'0'
|
||||
conv5 CMP #10
|
||||
BCC conv6
|
||||
|
||||
SBC #10
|
||||
INY
|
||||
BNE conv5
|
||||
|
||||
conv6 ORA #'0'
|
||||
STA timestr+1
|
||||
STY timestr
|
||||
STX timestr+9
|
||||
RTS
|
||||
|
||||
* data area
|
||||
*-------------------------
|
||||
initbyt HEX 00
|
||||
timestr ASC '00:00:00 '00
|
||||
|
||||
DS \
|
||||
|
||||
|
|
@ -0,0 +1,153 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Z-RAM Ultra 2-3 - 12 hour
|
||||
*-------------------------------
|
||||
* Date Revised: 05/05/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/ultra
|
||||
|
||||
ultra ent
|
||||
|
||||
org $A00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
get_time equ $82
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
|
||||
hex 00
|
||||
mode db 0
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
|
||||
getdate jsr mli ; mli call
|
||||
db get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
|
||||
gettime jsr rdtime
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* read the current time from clock
|
||||
*-------------------------------
|
||||
|
||||
rdtime lda #$C060
|
||||
holdclk lda #%00000101
|
||||
sta $C06D
|
||||
sta $C06D
|
||||
sta $C06D
|
||||
ldy #30
|
||||
loop lda $C06D
|
||||
and #%00000010
|
||||
beq readtime
|
||||
dey
|
||||
bne loop
|
||||
lda #%00000100
|
||||
sta $C06D
|
||||
sta $C06D
|
||||
sta $C06D
|
||||
bne holdclk
|
||||
|
||||
readtime lda $C065 ; 10's of hour
|
||||
and #$F
|
||||
ora #'0'
|
||||
sta timestr
|
||||
lda $C064 ; 1's of hour
|
||||
and #$F
|
||||
ora #'0'
|
||||
sta timestr+1
|
||||
lda $C063 ; 10's of minute
|
||||
and #$F
|
||||
ora #'0'
|
||||
sta timestr+3
|
||||
lda $C062 ; 1's of minute
|
||||
and #$F
|
||||
ora #'0'
|
||||
sta timestr+4
|
||||
lda $C061 ; 10's of seconds
|
||||
and #$F
|
||||
ora #'0'
|
||||
sta timestr+6
|
||||
lda $C060 ; 1's of seconds
|
||||
and #$F
|
||||
ora #'0'
|
||||
sta timestr+7
|
||||
rts
|
||||
|
||||
* convert time to 12hr format
|
||||
*----------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
and #$F
|
||||
tay
|
||||
txa
|
||||
and #$F
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
ldx #'M'
|
||||
stx timestr+10
|
||||
rts
|
||||
|
||||
* variables
|
||||
*-------------------------------
|
||||
|
||||
timestr asc '00:00:00 '00
|
||||
|
||||
ds \
|
||||
|
||||
|
|
@ -0,0 +1,184 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Promethus Versacard Driver
|
||||
*-------------------------------
|
||||
* Revised Date: 08/02/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk CLOCKS/rel/versa
|
||||
|
||||
versa ent
|
||||
|
||||
org $A00
|
||||
|
||||
*-------------------------------
|
||||
|
||||
get_time equ $82
|
||||
mli equ $bf00
|
||||
date equ $bf90
|
||||
|
||||
slot hex 40
|
||||
mode db 0
|
||||
|
||||
jmp getdate
|
||||
jmp gettime
|
||||
jmp setdate
|
||||
|
||||
* get the date in prodos gbbs format
|
||||
*-------------------------------
|
||||
|
||||
getdate jsr mli ; mli call
|
||||
db get_time
|
||||
hex 0000 ; no pramater table
|
||||
|
||||
ldx date
|
||||
lda date+1
|
||||
setdate rts
|
||||
|
||||
* get the current time
|
||||
*-------------------------------
|
||||
|
||||
gettime jsr rdtime
|
||||
lda mode
|
||||
bpl gtime1
|
||||
jsr convert
|
||||
|
||||
gtime1 ldx #<timestr ; point to string
|
||||
lda #>timestr
|
||||
rts
|
||||
|
||||
* figure the current time
|
||||
*-------------------------------
|
||||
|
||||
rdtime jsr rdclock
|
||||
lda timestr
|
||||
pha ; fix hour (remove) am/pm info)
|
||||
and #%00110011
|
||||
sta timestr
|
||||
pla
|
||||
|
||||
lsr
|
||||
lsr
|
||||
lsr ; move am/pm bit into carry
|
||||
bcc gettim2 ; it is am (default)
|
||||
|
||||
lda #'P' ; change to pm
|
||||
sta timestr+9
|
||||
|
||||
gettim2 lsr ; move 12/24 hour bit into carry
|
||||
bcc gettim3 ; in 12 hour mode, all is well
|
||||
|
||||
lda #' ' ; in 24 hour mode kill am/pm
|
||||
sta timestr+9
|
||||
sta timestr+10
|
||||
|
||||
gettim3 rts
|
||||
|
||||
* read the date from clock
|
||||
*----------------------------
|
||||
|
||||
rdclock ldx #0
|
||||
ldy slot ; get slot offset
|
||||
rdclk2 lda clkparm,x ; get function
|
||||
beq rdclk4
|
||||
bmi rdclk3 ; just ascii data
|
||||
|
||||
and #%00111111 ; kill high status info
|
||||
sta $C082,y ; point to data
|
||||
|
||||
lda $C083,y ; load in data
|
||||
and #%00001111 ; get rid of extra
|
||||
ora #'0' ; make into numeric digit
|
||||
rdclk3 and #$7F ; kill high (from ascii)
|
||||
sta timestr,x
|
||||
inx
|
||||
jmp rdclk2 ; go until out of data
|
||||
|
||||
rdclk4 rts
|
||||
|
||||
* convert time to 12hr format
|
||||
*--------------------------------
|
||||
|
||||
convert lda timestr ;convert to 12 hour
|
||||
ldx timestr+1
|
||||
|
||||
and #$F
|
||||
tay
|
||||
txa
|
||||
and #$F
|
||||
|
||||
dey
|
||||
bmi conv2
|
||||
clc
|
||||
adc #10
|
||||
dey
|
||||
bmi conv2
|
||||
adc #10
|
||||
|
||||
conv2 cmp #12
|
||||
bne conv2a
|
||||
lda #24
|
||||
conv2a tay
|
||||
bne conv3
|
||||
lda #12
|
||||
|
||||
conv3 ldx #'A'
|
||||
cmp #13
|
||||
bcc conv4
|
||||
|
||||
sbc #12
|
||||
ldx #'P'
|
||||
|
||||
conv4 ldy #'0'
|
||||
conv5 cmp #10
|
||||
bcc conv6
|
||||
|
||||
sbc #10
|
||||
iny
|
||||
bne conv5
|
||||
|
||||
conv6 ora #'0'
|
||||
sta timestr+1
|
||||
sty timestr
|
||||
stx timestr+9
|
||||
ldx #'M'
|
||||
stx timestr+10
|
||||
rts
|
||||
|
||||
* convert a 2 byte decimal number to binary
|
||||
*--------------------------------
|
||||
|
||||
decbin8 and #$7F
|
||||
sec
|
||||
sbc #'0'
|
||||
sta decbyte ; save 10's digit
|
||||
txa ; move 1's into A
|
||||
and #$7F
|
||||
sec
|
||||
sbc #'0'
|
||||
|
||||
ldy #10
|
||||
dec8a clc
|
||||
adc decbyte ; add the 10's digit, 10 times
|
||||
dey
|
||||
bne dec8a
|
||||
rts ; return with result
|
||||
|
||||
decbyte hex 00
|
||||
|
||||
* variables
|
||||
*-------------------------
|
||||
|
||||
timestr asc '00:00:00 AM'00
|
||||
|
||||
clkparm hex 1514
|
||||
asc ":"
|
||||
hex 1312
|
||||
asc ":"
|
||||
hex 1110
|
||||
asc " AM"
|
||||
hex 00
|
||||
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK REL/CMD
|
||||
|
||||
cls EXT
|
||||
sv_drvs EXT
|
||||
start EXT
|
||||
init EXT
|
||||
|
||||
*-------------------------------
|
||||
* write the changes back into the drivers file
|
||||
*-------------------------------
|
||||
|
||||
wrtchg ENT
|
||||
JSR cls
|
||||
JSR sv_drvs ; write configuration back to disk
|
||||
JMP start
|
||||
|
||||
*-------------------------------
|
||||
* check to see if in init mode
|
||||
*-------------------------------
|
||||
|
||||
chinit ENT
|
||||
BIT init ; in init mode?
|
||||
BPL :chinit2 ; nope
|
||||
|
||||
PLA ; return to init routine
|
||||
PLA
|
||||
:chinit2 RTS ; return to caller
|
||||
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Date: 12/1/89
|
||||
*-------------------------------
|
||||
* system defaults
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK REL/DEFAULTS
|
||||
|
||||
TopBox EXT
|
||||
print EXT
|
||||
cls EXT
|
||||
get_cr EXT
|
||||
start EXT
|
||||
|
||||
; change system defaults
|
||||
do_dflts ENT
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,27
|
||||
ASC '- Edit System Defaults -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix D of your user'
|
||||
ASC ' manual for more information.'00
|
||||
JSR cls
|
||||
|
||||
JSR print
|
||||
DB 1,10,10
|
||||
ASC 'code for editing the system defaults'
|
||||
ASC ' will go here.'00
|
||||
|
||||
JSR get_cr
|
||||
JMP start
|
||||
|
||||
|
|
@ -0,0 +1,361 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Disk stuff for config
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
cr = $D
|
||||
|
||||
lnbuf = $200
|
||||
drvbuf = $800
|
||||
flname = $300
|
||||
fbuf1 = $1C00
|
||||
fbuf2 = fbuf1
|
||||
fnam1 = $1E00
|
||||
msgbuf = fbuf1
|
||||
mli = $BF00
|
||||
|
||||
DSK REL/DISK
|
||||
|
||||
p_pfx2 EXT
|
||||
logprg EXT
|
||||
drvname EXT
|
||||
movname EXT
|
||||
msgref EXT
|
||||
|
||||
*-------------------------------
|
||||
* verify a that a disk is online
|
||||
|
||||
verify ENT
|
||||
STX verify_p+1 ; point to wanted path
|
||||
STA verify_p+2
|
||||
|
||||
JSR mli
|
||||
DB $C6 ; set prefix
|
||||
DA verify_p
|
||||
BCS :error
|
||||
|
||||
JSR mli ;get prefix for source volume
|
||||
DB $C7 ;get prefix
|
||||
DA p_pfx2 ;point to path
|
||||
:error RTS
|
||||
|
||||
verify_p DB 1
|
||||
DA 0 ;address of path to set
|
||||
|
||||
*-------------------------------
|
||||
* load config/acos.obj from disk
|
||||
|
||||
ld_drvs ENT
|
||||
JSR logprg ; log to the program disk
|
||||
LDX #<drvname
|
||||
LDA #>drvname
|
||||
JSR movname ; move filename
|
||||
JSR open ; open 'LLUCE.DRIVERS'
|
||||
BCS :error ; error
|
||||
|
||||
LDX #<drvbuf ; load config part into buffer
|
||||
LDA #>drvbuf
|
||||
LDY #18 ; read 9 pages (4 blocks)
|
||||
JSR rdblk
|
||||
JSR close ; close file
|
||||
CLC
|
||||
:error RTS
|
||||
|
||||
*-------------------------------
|
||||
* write config/acos.obj back to disk
|
||||
|
||||
sv_drvs ENT
|
||||
JSR logprg ; log to program disk
|
||||
LDX #<drvname
|
||||
LDA #>drvname
|
||||
JSR movname ; move filename
|
||||
JSR open
|
||||
BCS :error
|
||||
|
||||
LDX #<drvbuf ; write config back to disk
|
||||
LDA #>drvbuf
|
||||
LDY #18 ; write 9 pages (4 blocks)
|
||||
JSR wrblk
|
||||
JSR close
|
||||
CLC
|
||||
:error RTS
|
||||
|
||||
refnum ENT
|
||||
DB 0
|
||||
|
||||
create ENT
|
||||
STY p_creat+4 ; save filetype
|
||||
JSR mli
|
||||
DB $C0
|
||||
DA p_creat
|
||||
RTS
|
||||
|
||||
open ENT
|
||||
LDY #0
|
||||
bfopen ENT
|
||||
LDA bufadr,y ; point at buffer
|
||||
STA p_open+4
|
||||
|
||||
JSR mli
|
||||
DB $C8 ; open
|
||||
DA p_open
|
||||
BNE :open2
|
||||
|
||||
LDA p_open+5 ; save refnum
|
||||
STA refnum
|
||||
CLC
|
||||
RTS
|
||||
|
||||
:open2 LDA #-1 ; make sure refnum is illegal
|
||||
STA refnum
|
||||
SEC
|
||||
RTS
|
||||
|
||||
bufadr DB >fbuf1,>fbuf2,>msgbuf
|
||||
|
||||
close ENT
|
||||
LDA refnum ; use refnum
|
||||
STA p_close+1
|
||||
JSR mli
|
||||
DB $CC ; close
|
||||
DA p_close
|
||||
RTS
|
||||
|
||||
flush ENT
|
||||
LDA refnum ; use refnum
|
||||
STA p_close+1
|
||||
JSR mli
|
||||
DB $CD ; flush
|
||||
DA p_close
|
||||
RTS
|
||||
|
||||
; setup for single line read
|
||||
rdlnset ENT
|
||||
LDA refnum
|
||||
STA p_new0+1 ; save refnum
|
||||
STA p_new1+1
|
||||
STA p_rdln+1
|
||||
|
||||
JSR mli
|
||||
DB $C9 ; enable newline
|
||||
DA p_new1
|
||||
RTS
|
||||
|
||||
; read a line from a file
|
||||
rdline ENT
|
||||
JSR mli
|
||||
DB $CA ; read
|
||||
DA p_rdln
|
||||
BNE :rdline2 ; read error
|
||||
|
||||
LDX p_rdln+6 ; is there a cr at end of line?
|
||||
LDA lnbuf-1,x
|
||||
AND #$7F
|
||||
CMP #cr
|
||||
BNE :rdline2 ; no more stuff
|
||||
CLC
|
||||
RTS
|
||||
|
||||
:rdline2 LDA #0 ; no data in line
|
||||
STA lnbuf
|
||||
SEC ; eof
|
||||
RTS
|
||||
|
||||
; read a single byte
|
||||
rdbyte ENT
|
||||
LDA refnum ; save refnum
|
||||
BEQ :rdbyte2
|
||||
|
||||
STA p_rbyt+1
|
||||
JSR mli
|
||||
DB $CA ; read 1 byte
|
||||
DA p_rbyt
|
||||
BNE :rdbyte2
|
||||
|
||||
LDA p_byte ; get byte
|
||||
CLC ; were done
|
||||
RTS
|
||||
|
||||
:rdbyte2 LDA #0 ; fake data
|
||||
SEC
|
||||
RTS
|
||||
|
||||
; write a block for the msg routines
|
||||
wrblk ENT
|
||||
PHA
|
||||
LDA #$CB ; use write call
|
||||
STA rwtype ; --- does modify
|
||||
PLA
|
||||
BRA rwblk
|
||||
|
||||
; read a block for the msg routines
|
||||
rdblk ENT
|
||||
PHA
|
||||
LDA #$CA ; use read call
|
||||
STA rwtype ; --- does modify
|
||||
PLA
|
||||
|
||||
rwblk STX p_rdblk+2
|
||||
STA p_rdblk+3 ; save read address
|
||||
|
||||
LDA #0
|
||||
STA p_rdblk+4
|
||||
STY p_rdblk+5 ; save number of blocks to read
|
||||
|
||||
LSR p_rdblk+5 ; divide by 2 and
|
||||
ROR p_rdblk+4 ; put remainder
|
||||
|
||||
LDA refnum ; get refnum
|
||||
STA p_rdblk+1
|
||||
|
||||
JSR mli ; call mli
|
||||
rwtype DB $CA ; *** modified ***
|
||||
DA p_rdblk
|
||||
RTS
|
||||
|
||||
; write a byte of data
|
||||
wrbyte ENT
|
||||
STA p_byte ; save data
|
||||
PHA
|
||||
LDA refnum
|
||||
BEQ :wrbyte2 ; if no refnum
|
||||
|
||||
STA p_rbyt+1
|
||||
JSR mli
|
||||
DB $CB ; write byte
|
||||
DA p_rbyt
|
||||
CLC ; all is well
|
||||
BEQ :wrbyte3
|
||||
|
||||
:wrbyte2 SEC ; opps, problem
|
||||
:wrbyte3 PLA ; get back data
|
||||
RTS
|
||||
|
||||
; position file
|
||||
posmsg ENT
|
||||
LDY msgref ; save refnum
|
||||
STY refnum
|
||||
|
||||
LSR ; setup Y,A,X w/exact byte
|
||||
TAY
|
||||
TXA
|
||||
ROR
|
||||
PHA
|
||||
LDA #16
|
||||
ROR
|
||||
TAX
|
||||
PLA
|
||||
JMP setpos
|
||||
|
||||
; find the end of file
|
||||
geteof ENT
|
||||
LDA refnum ; save refnum
|
||||
STA p_mark+1
|
||||
JSR mli
|
||||
DB $D1 ; get eof
|
||||
DA p_mark
|
||||
LDX p_mark+2
|
||||
LDA p_mark+3 ; get length
|
||||
LDY p_mark+4
|
||||
RTS
|
||||
|
||||
; set a mark into a file
|
||||
setmark ENT
|
||||
LDY #0
|
||||
; do actual position set within file
|
||||
setpos ENT
|
||||
STX p_mark+2
|
||||
STA p_mark+3 ; point to new location
|
||||
STY p_mark+4
|
||||
|
||||
LDA refnum
|
||||
STA p_mark+1 ; save refnum
|
||||
|
||||
:setpos2 JSR mli
|
||||
DB $CE ; set mark
|
||||
DA p_mark
|
||||
CMP #$4D ; check for out-of-range
|
||||
BNE :setpos3
|
||||
|
||||
JSR mli
|
||||
DB $D0 ; set eof
|
||||
DA p_mark
|
||||
BEQ :setpos2 ; position again
|
||||
|
||||
:setpos3 RTS
|
||||
|
||||
; get current file marker
|
||||
getmark ENT
|
||||
LDA refnum ; save refnum
|
||||
STA p_mark+1
|
||||
JSR mli
|
||||
DB $CF ; get mark
|
||||
DA p_mark
|
||||
SEC
|
||||
BNE :getmrk2 ; opps, error
|
||||
|
||||
CLC
|
||||
LDX p_mark+2 ; all is well
|
||||
LDA p_mark+3
|
||||
:getmrk2 RTS
|
||||
|
||||
; ------ parms ------
|
||||
p_open DB 3
|
||||
DA flname
|
||||
DA fbuf1
|
||||
DB 0
|
||||
|
||||
p_close DB 1
|
||||
DB 0
|
||||
|
||||
p_rbyt DB 4
|
||||
DB 0
|
||||
DA p_byte
|
||||
DA 1
|
||||
DA 0
|
||||
|
||||
p_byte DB 0
|
||||
|
||||
p_mark DB 2
|
||||
DB 0
|
||||
DB 0,0,0
|
||||
|
||||
p_new0 DB 3
|
||||
DB 0
|
||||
DB 0
|
||||
DB 0
|
||||
|
||||
p_new1 DB 3
|
||||
DB 0
|
||||
DB $7F
|
||||
DB $D
|
||||
|
||||
p_rdln DB 4
|
||||
DB 0
|
||||
DA lnbuf
|
||||
DA $FF
|
||||
DA 0
|
||||
|
||||
p_rdblk DB 4
|
||||
DB 0
|
||||
DA 0
|
||||
DA $80
|
||||
DA 0
|
||||
|
||||
p_del DB 1
|
||||
DA flname
|
||||
|
||||
p_creat DB 7
|
||||
DA flname
|
||||
DB $c3
|
||||
DB 0
|
||||
DA 0
|
||||
DB 1
|
||||
DA 0
|
||||
DA 0
|
||||
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
LST OFF
|
||||
tr
|
||||
tr adr
|
||||
********************************
|
||||
* *
|
||||
* Config Program - Equates *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
bs = 8
|
||||
lf = $A
|
||||
up = $B
|
||||
cr = $D
|
||||
fs = $15
|
||||
can = $18
|
||||
esc = $1B
|
||||
del = $7F
|
||||
|
||||
; memory allocation / buffers
|
||||
|
||||
*index = $200 ; offset to skip over lluce header info
|
||||
lnbuf = $200
|
||||
flname = $300
|
||||
fltext = $301
|
||||
reset = $3f2
|
||||
dvrbuf = $800 ; start of driver buffer space
|
||||
prdrv = $900 ; printer driver is at $900-$9ff
|
||||
clkdrv = $A00 ; clocks driver is at $a00-$aff
|
||||
mdmdrv = $B00 ; modem driver is at $b00-$fff
|
||||
pfilter = $1000 ; profanity filter is at $1000-$10ff
|
||||
cdbyte = $10BF ; carrier detect byte
|
||||
ansstr = $10C0 ; modem answer string
|
||||
initstr = $10D0 ; modem init string
|
||||
hdrbuf = $1100 ; buffer for editing the profanity filter
|
||||
|
||||
cdtype = $1FFD
|
||||
modemtype = $1FFE
|
||||
serialtype = $1FFF
|
||||
|
||||
mli = $BF00
|
||||
|
||||
initbuf = $1800
|
||||
ansbuf = $1830
|
||||
fbuf1 = $1C00
|
||||
fnam1 = $1E00
|
||||
|
||||
sortbuf = $8000
|
||||
copybuf = $6000
|
||||
copymax = $5800
|
||||
; zero page usage
|
||||
|
||||
temp = 0
|
||||
temp2 = 2
|
||||
temp3 = 4
|
||||
temp4 = 6
|
||||
x_save = 9
|
||||
y_save = $A
|
||||
chrptr = $B
|
||||
base = $D
|
||||
maxlen = $F
|
||||
inverse = $10
|
||||
point0 = $11
|
||||
point1 = $14
|
||||
prn = $16 ; [4 bytes]
|
||||
numptr = $1A
|
||||
psave = $1C
|
||||
prnt = $1E
|
||||
|
||||
ch = $24
|
||||
cv = $25
|
||||
|
||||
fmparm = $60
|
||||
doszero = $62
|
||||
dosptr = $64
|
||||
part = $66
|
||||
dosbyt = $68
|
||||
|
||||
point3 = $FD
|
||||
|
||||
|
|
@ -0,0 +1,246 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
temp2 = $02
|
||||
|
||||
ch = $24
|
||||
cv = $25
|
||||
|
||||
lnbuf = $200
|
||||
filtbuf = $1000
|
||||
hdrbuf = $1100
|
||||
|
||||
DSK REL/FILTER
|
||||
|
||||
TopBox EXT
|
||||
print EXT
|
||||
cls EXT
|
||||
cout EXT
|
||||
maxlen EXT
|
||||
inpmode EXT
|
||||
inpln EXT
|
||||
inpyn EXT
|
||||
cleos EXT
|
||||
start EXT
|
||||
get_cr EXT
|
||||
|
||||
*-------------------------------
|
||||
* profanity filter
|
||||
*-------------------------------
|
||||
|
||||
; change profanity filter (yuk)
|
||||
|
||||
do_filt ENT
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,27
|
||||
ASC '- Edit Profanity Filter -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix E of your user'
|
||||
ASC ' manual for more information.'00
|
||||
JSR cls
|
||||
|
||||
LDX #0 ; move table to a different space
|
||||
:loop LDA filtbuf,X ; so we don't change it if they abort
|
||||
STA hdrbuf,X
|
||||
DEX
|
||||
BNE :loop
|
||||
|
||||
filt2 LDA #0 ; start at #1
|
||||
STA temp2
|
||||
|
||||
:filt3 LDX temp2 ; get entry number
|
||||
JSR fndword ; find the word
|
||||
BCS filt5 ; opps, end of table
|
||||
|
||||
LDA ch ; save current horiz
|
||||
PHA
|
||||
|
||||
LDA temp2 ; print entry letter
|
||||
CLC
|
||||
ADC #'A'
|
||||
JSR cout
|
||||
INC temp2 ; goto next entry next pass
|
||||
|
||||
LDA #')' ; show a border
|
||||
JSR cout
|
||||
INC ch ; move over 1 space
|
||||
|
||||
:filt4 LDA hdrbuf,Y ; get data
|
||||
PHP
|
||||
JSR cout ; print data
|
||||
INY
|
||||
PLP
|
||||
BPL :filt4 ; keep showing
|
||||
|
||||
PLA
|
||||
CLC
|
||||
ADC #19
|
||||
STA ch ; move over horiz position
|
||||
|
||||
LDA #' ' ; either wrap or move 1 space
|
||||
JSR cout
|
||||
JMP :filt3
|
||||
|
||||
filt5 JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Cmd: A=Add, D=Delete, Q=Quit ? '00
|
||||
|
||||
LDA #1
|
||||
STA maxlen ; get command
|
||||
LDA #%10000000
|
||||
STA inpmode
|
||||
JSR inpln
|
||||
|
||||
LDA lnbuf
|
||||
CMP #'A'
|
||||
BNE :tryd
|
||||
JMP fl_add
|
||||
|
||||
:tryd CMP #'D'
|
||||
BEQ fl_del
|
||||
:tryq CMP #'Q'
|
||||
BNE filt5
|
||||
JMP fl_quit
|
||||
|
||||
*-------------------------------
|
||||
* delete a word from list
|
||||
|
||||
fl_del LDX #20
|
||||
JSR cleos ; clear line
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Delete [A-'00
|
||||
|
||||
CLC
|
||||
LDA temp2
|
||||
ADC #'@'
|
||||
JSR cout ; print range
|
||||
|
||||
JSR print
|
||||
ASC '] ? '00
|
||||
|
||||
LDA #%10000000
|
||||
STA inpmode ; set mode
|
||||
|
||||
JSR inpln ; get data
|
||||
LDA lnbuf
|
||||
CMP #'A'
|
||||
BCC filt5 ; move back, error
|
||||
|
||||
SEC
|
||||
SBC #'A' ; make into [0-xxx] range
|
||||
CMP temp2
|
||||
BCC *+5
|
||||
JMP filt5 ; out of range
|
||||
|
||||
PHA
|
||||
TAX
|
||||
INX
|
||||
JSR fndword ; locate second word
|
||||
STY temp2+1 ; save offset
|
||||
PLA
|
||||
TAX
|
||||
JSR fndword ; locate first word
|
||||
LDX temp2+1 ; point to second word
|
||||
|
||||
:fl_del2 LDA hdrbuf,X ; move data
|
||||
STA hdrbuf,Y
|
||||
INY
|
||||
INX
|
||||
BNE :fl_del2 ; loop
|
||||
JMP filt2 ; show new screen
|
||||
|
||||
; add a word to list
|
||||
fl_add LDX #20
|
||||
JSR cleos ; clear line
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Enter new word: '00
|
||||
|
||||
LDA #16 ; 16 chars max length
|
||||
STA maxlen
|
||||
LDA #%10000000
|
||||
STA inpmode ; set input mode
|
||||
|
||||
JSR inpln ; get the data
|
||||
LDA lnbuf
|
||||
CMP #'A'
|
||||
BCC :fl_add4 ; abort
|
||||
|
||||
LDX temp2 ; get last word
|
||||
JSR fndword ; find end
|
||||
STY temp2+1 ; save current end
|
||||
|
||||
LDX #0
|
||||
:fl_add2 LDA lnbuf,X
|
||||
CMP #'A'
|
||||
BCC :fl_add3
|
||||
|
||||
STA hdrbuf,Y ; add byte
|
||||
INX
|
||||
INY
|
||||
BNE :fl_add2 ; and loop
|
||||
|
||||
LDA #0
|
||||
LDY temp2+1 ; mark old end of table
|
||||
STA hdrbuf,Y
|
||||
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Error: Filter Table Overrun. Press [RETURN] '00
|
||||
JSR get_cr ; wait for cr
|
||||
:fl_add4 JMP filt5 ; get new data
|
||||
|
||||
:fl_add3 LDA #0 ; mark end of table
|
||||
STA hdrbuf,Y
|
||||
DEY
|
||||
LDA hdrbuf,Y ; mark as last char
|
||||
ORA #$80
|
||||
STA hdrbuf,Y
|
||||
JMP filt2 ; show new table
|
||||
|
||||
; quit from filter changer
|
||||
fl_quit LDX #20
|
||||
JSR cleos ; clear bottom of screen
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Is the above table correct [Y/N] ? '00
|
||||
JSR inpyn
|
||||
BCS :fl_q1 ; nope!
|
||||
|
||||
LDX #0 ; put new table in place over
|
||||
:loop LDA hdrbuf,X ; the old table and return
|
||||
STA filtbuf,X
|
||||
BNE :loop
|
||||
:fl_q1 JMP start
|
||||
|
||||
; locate a word [indexed by x]
|
||||
fndword LDY #0
|
||||
CPX #0 ; we done?
|
||||
BEQ :fndwd2 ; yep
|
||||
|
||||
:fndwd1 LDA hdrbuf,Y ; loop until next word
|
||||
BEQ :fndwd4 ; end of table
|
||||
|
||||
INY ; goto next byte
|
||||
ASL ; check high bit
|
||||
BCC :fndwd1
|
||||
|
||||
DEX ; count down entries
|
||||
BNE :fndwd1
|
||||
|
||||
:fndwd2 LDA hdrbuf,Y
|
||||
BEQ :fndwd4 ; opps, that is end marker
|
||||
|
||||
:fndwd3 CLC
|
||||
RTS ; we are done
|
||||
|
||||
:fndwd4 SEC ; opps, end of table
|
||||
RTS
|
||||
|
||||
|
|
@ -0,0 +1,78 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
TTL 'LLUCE - Global page'
|
||||
PAG
|
||||
*-------------------------------
|
||||
* History:
|
||||
*
|
||||
* 11/07/89 AMW
|
||||
* 1. Added history section
|
||||
* 2. Added segment titles
|
||||
* 3. Renamed this section to GLOBALS
|
||||
*
|
||||
* 11/10/89 AMW
|
||||
* Added AppleShare flag
|
||||
*
|
||||
* 11/14/89 AMW
|
||||
* Added ProDOS entry point vector
|
||||
*
|
||||
* 11/21/89 AMW
|
||||
* Moved startup filename to LLUCE
|
||||
*
|
||||
* 11/23/89 AMW
|
||||
* Added CRC16 location
|
||||
*
|
||||
* 11/28/89 AMW
|
||||
* Added time display flag
|
||||
*-------------------------------
|
||||
|
||||
; to be created by the config program
|
||||
NODENUM DB 0
|
||||
DW SEG_NAME
|
||||
MODULE DW 0
|
||||
|
||||
VERSION DDB version
|
||||
|
||||
STPCHR DB ' ' ; stop message char
|
||||
NXTCHR DB 'N' ; next message char
|
||||
|
||||
WIDTH DB 4 ; index for default
|
||||
DB 32,40,64,80
|
||||
|
||||
FILTLOC DB 0
|
||||
|
||||
WWFLAG DB -1 ; word-wrap flag for editor
|
||||
|
||||
REFNUM DB 0
|
||||
MSGREF DB 0
|
||||
DW FBUF2
|
||||
|
||||
SHWTXT DB 0
|
||||
SHWTRC DB 0 ; show program trace
|
||||
|
||||
TOCONST DW 159
|
||||
|
||||
EDLOC DW EDBUF
|
||||
EDITLEN DW EDBUF+EBUFEND
|
||||
EDMEMORY DB 0 ; if negative, buffer in aux
|
||||
FILTFLAG DB 1
|
||||
|
||||
ASHARE DB 0 ; AppleShare flag
|
||||
PDOSVEC DA 0
|
||||
|
||||
CRC DA 0
|
||||
|
||||
TIMEDISP DB $80 ; 0=24 hour, $80=12 hour
|
||||
|
||||
; modem(0) commands in LLUCE
|
||||
M_QUIT DB 'Q'-ctrl ; quit
|
||||
M_LOGIN DB 'G'-ctrl ; enter
|
||||
M_ANSWER DB 'A'-ctrl ; answer
|
||||
|
||||
DS $840-*
|
||||
|
||||
FLNAME DS $40 ; last filename used
|
||||
SEG_NAME DS $40 ; start up segment pathname
|
||||
SYSPFX DS $40 ; system files prefIX
|
||||
|
||||
|
|
@ -0,0 +1,803 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* config/init
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
cr = $D
|
||||
|
||||
temp = 0
|
||||
temp2 = 2
|
||||
temp3 = 4
|
||||
temp4 = 6
|
||||
|
||||
confbuf = $800
|
||||
devnam = $815
|
||||
|
||||
copybuf = $6000
|
||||
copymax = $5800
|
||||
|
||||
mli = $BF00
|
||||
|
||||
DSK REL/INIT
|
||||
|
||||
begin EXT
|
||||
escape EXT
|
||||
cls EXT
|
||||
print EXT
|
||||
maxlen EXT
|
||||
inpmode EXT
|
||||
inpln EXT
|
||||
copyinp EXT
|
||||
ucopyinp EXT
|
||||
prstr EXT
|
||||
inpyn EXT
|
||||
re_mdm EXT
|
||||
re_pr EXT
|
||||
re_clk EXT
|
||||
TopBox EXT
|
||||
inpnum EXT
|
||||
get_cr EXT
|
||||
chkspc EXT
|
||||
bindec8 EXT
|
||||
setspec EXT
|
||||
get_ok EXT
|
||||
setdrv EXT
|
||||
setsys EXT
|
||||
settac EXT
|
||||
makesys EXT
|
||||
maketac1 EXT
|
||||
maketac2 EXT
|
||||
dstpfx EXT
|
||||
do_quit EXT
|
||||
verify EXT
|
||||
p_crpth EXT
|
||||
copy EXT
|
||||
movname EXT
|
||||
logdst EXT
|
||||
open EXT
|
||||
wrblk EXT
|
||||
close EXT
|
||||
create EXT
|
||||
logcon EXT
|
||||
cout EXT
|
||||
|
||||
do_init ENT
|
||||
LDX #<begin ; setup esc handler
|
||||
LDA #>begin
|
||||
JSR escape
|
||||
|
||||
JSR cls
|
||||
|
||||
LDA #30
|
||||
STA maxlen
|
||||
LDA #%00000000
|
||||
STA inpmode
|
||||
|
||||
JSR print
|
||||
ASC 'What are you going to call your system?'0D
|
||||
ASC ':'00
|
||||
JSR inpln
|
||||
|
||||
LDX #<datadef
|
||||
LDA #>datadef
|
||||
LDY #cr
|
||||
JSR copyinp ; copy name into file
|
||||
STX temp4
|
||||
STA temp4+1
|
||||
|
||||
LDA #20 ; limit length
|
||||
STA maxlen
|
||||
|
||||
JSR print
|
||||
HEX 0D
|
||||
ASC 'Enter your FULL name (20 characters max)'0D
|
||||
ASC ':'00
|
||||
JSR inpln ; get name
|
||||
|
||||
LDX #<user ; copy line uppercase
|
||||
LDA #>user
|
||||
LDY #cr
|
||||
JSR ucopyinp
|
||||
LDY #cr
|
||||
JSR copyinp ; copy the line
|
||||
STX temp3
|
||||
STA temp3+1
|
||||
|
||||
LDX temp4
|
||||
LDA temp4+1
|
||||
LDY #cr
|
||||
JSR copyinp
|
||||
STX temp4
|
||||
STA temp4+1
|
||||
|
||||
LDY #0
|
||||
init1d LDA user,Y
|
||||
INY
|
||||
CMP #$20
|
||||
BNE init1d
|
||||
DEY
|
||||
LDA #','
|
||||
STA user,Y
|
||||
|
||||
init2 LDA #%11000000
|
||||
STA inpmode
|
||||
|
||||
JSR print
|
||||
HEX 0D
|
||||
ASC 'Enter your telephone number'0D
|
||||
ASC '(XXX-XXX-XXXX): '00
|
||||
|
||||
JSR inpln ; get tele number
|
||||
CPY #12
|
||||
BNE init2
|
||||
|
||||
LDX #<usrtele
|
||||
LDA #>usrtele
|
||||
LDY #0
|
||||
JSR copyinp ; copy the line
|
||||
|
||||
LDA #16
|
||||
STA maxlen ; set length for city
|
||||
|
||||
JSR print
|
||||
HEX 0D
|
||||
ASC 'What city do you call from (16 char)'0D
|
||||
ASC ':'00
|
||||
|
||||
JSR inpln ; get where from
|
||||
LDX temp3
|
||||
LDA temp3+1
|
||||
LDY #','
|
||||
JSR copyinp ; copy the input
|
||||
STX temp2
|
||||
STA temp2+1
|
||||
|
||||
LDA #2
|
||||
STA maxlen ;set length for state
|
||||
|
||||
init2a JSR print
|
||||
HEX 0D
|
||||
ASC 'What state do you call from (XX):'00
|
||||
|
||||
JSR inpln ;get state
|
||||
CPY #2
|
||||
BNE init2a
|
||||
LDX temp2
|
||||
LDA temp2+1
|
||||
LDY #cr
|
||||
JSR copyinp ;copy to date area
|
||||
|
||||
LDA #8
|
||||
STA maxlen
|
||||
|
||||
init3 JSR cls
|
||||
JSR print
|
||||
ASC 'Enter a 4-8 char password:'00
|
||||
|
||||
JSR inpln
|
||||
CPY #4
|
||||
BCC init3
|
||||
|
||||
LDX #<usrpass
|
||||
LDA #>usrpass
|
||||
LDY #0
|
||||
JSR copyinp ; copy the line
|
||||
|
||||
LDA #20
|
||||
STA maxlen
|
||||
|
||||
JSR print
|
||||
HEX 0D
|
||||
ASC 'Enter a second password for remote logon (1-20 chars)'0D
|
||||
ASC ':'00
|
||||
|
||||
JSR inpln ; get second password
|
||||
LDX temp4
|
||||
LDA temp4+1
|
||||
LDY #cr
|
||||
JSR copyinp ; copy password into data file
|
||||
STX temp4
|
||||
STA temp4+1 ; save new pointers
|
||||
|
||||
LDY #0
|
||||
init3a LDA xdata,Y ; copy rest of the data file
|
||||
STA (temp4),Y
|
||||
INY
|
||||
CMP #0
|
||||
BNE init3a
|
||||
|
||||
JSR cls ; clear screen
|
||||
JSR print
|
||||
DB 1,7,30
|
||||
ASC '- System Information -'0D0D
|
||||
ASC 'System Name: '00
|
||||
|
||||
LDX #<datadef
|
||||
LDA #>datadef
|
||||
LDY #cr+128
|
||||
JSR prstr ; show system name
|
||||
STX temp4
|
||||
STA temp4+1
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Sysop Name: '00
|
||||
|
||||
LDX temp4
|
||||
LDA temp4+1
|
||||
LDY #cr+128
|
||||
JSR prstr ; show sysop name
|
||||
STX temp4
|
||||
STA temp4+1
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Sysop Phone Number: '00
|
||||
|
||||
LDX #<usrtele
|
||||
LDA #>usrtele
|
||||
LDY #13
|
||||
JSR prstr ; show tele number
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Sysop is From: '00
|
||||
|
||||
LDX temp3
|
||||
LDA temp3+1
|
||||
LDY #cr+128
|
||||
JSR prstr ; show where from
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Logon Password: '00
|
||||
|
||||
LDX #<usrpass
|
||||
LDA #>usrpass
|
||||
LDY #9
|
||||
JSR prstr ; show main password
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Remote Password: '00
|
||||
|
||||
LDX temp4
|
||||
LDA temp4+1
|
||||
LDY #cr+128
|
||||
JSR prstr ; show remote password
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Is this information correct? [Y/N] '00
|
||||
|
||||
JSR inpyn
|
||||
BCC init4
|
||||
JMP do_init
|
||||
|
||||
*-------------------------------
|
||||
|
||||
init4 LDA #-1
|
||||
STA init ; set init mode
|
||||
|
||||
einit1 JSR re_mdm
|
||||
einit2 LDX #<einit1
|
||||
LDA #>einit1 ; if esc, go back 1 level
|
||||
JSR escape
|
||||
JSR re_pr
|
||||
einit3 LDX #<einit2
|
||||
LDA #>einit2
|
||||
JSR escape
|
||||
JSR re_clk
|
||||
|
||||
*-------------------------------
|
||||
|
||||
LDY #<devnam
|
||||
LDA #0
|
||||
:loop STA confbuf,Y ; zero out pathname buffer
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
*-------------------------------
|
||||
* start the hardware config
|
||||
|
||||
hard1 LDX #<einit3
|
||||
LDA #>einit3 ; backup 1 level
|
||||
JSR escape
|
||||
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,22
|
||||
ASC '- Copy Files to Mass Storage Device -'
|
||||
DB 1,4,13
|
||||
ASC 'Please refer to your user manual for more information.'00
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'Please enter the slot and drive of your '
|
||||
ASC 'mass storage device. If your media is'0D0D
|
||||
ASC 'removable, then please make sure there '
|
||||
ASC 'is formatted media in place.'0D0D0D
|
||||
ASC ' Slot? [1-7] '00
|
||||
LDX #7
|
||||
JSR inpnum
|
||||
STA slot ; save the slot
|
||||
|
||||
JSR print
|
||||
HEX 0D
|
||||
ASC ' Drive? [1-2] '00
|
||||
LDX #2
|
||||
JSR inpnum
|
||||
STA drive ; save the drive
|
||||
DEC drive ; make into [0-1] range
|
||||
|
||||
JSR print
|
||||
HEX 0D0D0D
|
||||
ASC 'Is the above correct [Y/N] ? '00
|
||||
JSR inpyn
|
||||
BCC *+5
|
||||
JMP hard1 ;nope
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'If you continue, 2 subdirectories will'
|
||||
ASC ' be created on your mass storage'0D0D
|
||||
ASC 'device. (MPRO.SEGS and MPRO.SYS) All'
|
||||
ASC ' needed files will be copied into'0D0D
|
||||
ASC 'these subdirectories. No existing files will be destroyed.'00
|
||||
JSR get_cr
|
||||
|
||||
LDA #0 ; no more turning away..
|
||||
JSR escape ; [p. floyd]
|
||||
|
||||
JSR chkspc ; check drive space
|
||||
CMP #3 ; are there are at least 768 blocks free?
|
||||
BCC *+5 ; not enough room
|
||||
JMP hard2
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'The storage device checked does not '
|
||||
ASC 'contain enough storage space to run'0D0D
|
||||
ASC 'the system. You need to make some '
|
||||
ASC 'more room on the device, or'0D0D
|
||||
ASC 'choose another device.'00
|
||||
|
||||
JSR get_cr
|
||||
JMP hard1 ; goto hard/floppy question
|
||||
|
||||
hard2 JSR cls
|
||||
JSR print
|
||||
ASC 'Should the MultiPro transfer system be installed'
|
||||
ASC 'onto this device? [Y/N] '00
|
||||
|
||||
JSR inpyn
|
||||
BCC :trans
|
||||
LDA #0
|
||||
STA settrans
|
||||
STA superlist ;mark the end of the supertac list as such
|
||||
JMP :notrans
|
||||
|
||||
:trans LDA #1
|
||||
STA settrans
|
||||
|
||||
JSR print
|
||||
HEX 0D0D0D
|
||||
ASC 'Please enter the number of volumes that '
|
||||
ASC 'should be allocated to the MultiPro'0D0D
|
||||
ASC 'file transfer system.'0D0D0D
|
||||
ASC 'Number of volumes? [1-99] '00
|
||||
|
||||
LDX #99 ;max is 99
|
||||
JSR inpnum
|
||||
STA volumes
|
||||
|
||||
JSR bindec8
|
||||
STA stacacc+2 ;sysop high (10's)
|
||||
STX stacacc+3 ;sysop high (1's)
|
||||
STA stacacc+7 ;user high
|
||||
STX stacacc+8 ;user high
|
||||
STA stacacc+12
|
||||
STX stacacc+13 ;elite high
|
||||
STA stacacc+17
|
||||
STX stacacc+18 ;priv high
|
||||
STA stacacc+22
|
||||
STX stacacc+23 ;board manager high
|
||||
|
||||
:notrans JSR setspec
|
||||
JSR chkspc ;reset
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'The configuration program is now going to '
|
||||
ASC 'copy over all the files needed'0D0D
|
||||
ASC 'to run MultiPro onto your mass storage device.'00
|
||||
|
||||
JSR get_ok ; get permission
|
||||
JSR cls
|
||||
|
||||
JSR setdrv ;create & log xxx/mpro.segs
|
||||
JSR make1 ;do copy in 3 parts
|
||||
JSR make2
|
||||
|
||||
JSR chkspc ;reset path to original drive
|
||||
|
||||
JSR setsys ;create & log xxx/mpro.sys
|
||||
JSR make3
|
||||
|
||||
LDA settrans ;did they want a transfer system?
|
||||
BNE :doit ;yes, set it up
|
||||
JMP noxfer ;nope, skip the next step
|
||||
|
||||
:doit JSR settac ;create & log xxx/mpro.sys/transfer/vol.
|
||||
JSR make4
|
||||
|
||||
*-------------------------------
|
||||
* setup supertac volumes
|
||||
|
||||
JSR chkspc ;reset path to /xxx/
|
||||
JSR makesys ;add /xxx/mpro.sys/
|
||||
JSR maketac1 ;add /xxx/mpro.sys/stac
|
||||
JSR maketac2 ;add /xxx/mpro.sys/stac/vol.
|
||||
|
||||
LDA #0
|
||||
STA curvol ;start at volume 1
|
||||
INC dstpfx ;add one to length of destination prefix
|
||||
|
||||
:loop INC curvol ;++current volume
|
||||
LDA curvol ;which volume are we at?
|
||||
CMP #10 ;did we do 10 yet?
|
||||
BCC :less10 ;nope, we have less than 10
|
||||
CMP #11 ;more than 9, but how much more?
|
||||
BCS :over10 ;>= 11, so we not right on 10
|
||||
INC dstpfx ;smack dab on 10, so length is one greater
|
||||
|
||||
:over10 JSR bindec8 ;convert volume we're on to decimal
|
||||
|
||||
LDY dstpfx ;get current length
|
||||
DEY ;character before the end
|
||||
STA dstpfx,Y ;store 10's
|
||||
TXA ;get 1's
|
||||
INY ;next character forward
|
||||
STA dstpfx,Y ;store 1's
|
||||
|
||||
JSR mli ; create /xxx/mpro.sys/stac/vol.XX
|
||||
DB $C0 ; create new path
|
||||
DA p_crpth
|
||||
JMP :over
|
||||
|
||||
:less10 LDX dstpfx ;add single number to end of prefix
|
||||
CLC
|
||||
ADC #'0' ;make it ascii
|
||||
STA dstpfx,X
|
||||
|
||||
JSR mli ; create /xxx/mpro.sys/stac/vol.X
|
||||
DB $C0 ; create new path
|
||||
DA p_crpth
|
||||
|
||||
:over LDA curvol ;how many volumes done
|
||||
CMP volumes ;done 'em all yet?
|
||||
BNE :loop ;nope, do some more
|
||||
|
||||
*-------------------------------
|
||||
|
||||
noxfer JSR cls
|
||||
JSR print
|
||||
ASC 'Your system is now configured and is '
|
||||
ASC 'ready to run. To bring up your system'0D0D
|
||||
ASC 'for operation, do the following:'0D0D0D
|
||||
ASC 'Boot up your mass storage device and '
|
||||
ASC 'type "PREFIX MPRO.SEGS".'0D0D
|
||||
ASC 'Type "-ACOS" to start your system running.'00
|
||||
|
||||
JSR get_cr
|
||||
JMP do_quit
|
||||
|
||||
volumes DB 0
|
||||
curvol DB 0
|
||||
|
||||
*-------------------------------
|
||||
* copy boot stuff over
|
||||
*-------------------------------
|
||||
|
||||
make1 LDX #<disk1 ; is first disk online?
|
||||
LDA #>disk1
|
||||
JSR verify
|
||||
BCC :online ; yes, it is
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'Please place MultiPro Disk #1, /CONFIG, online.'00
|
||||
|
||||
JSR get_ok ; wait for ok
|
||||
JMP make1 ;check it to make sure
|
||||
|
||||
:online JSR cls
|
||||
JSR print
|
||||
ASC 'Copying MultiPro...'00
|
||||
|
||||
LDX #<list1 ; copy acos & acos.obj
|
||||
LDA #>list1
|
||||
JSR copy
|
||||
|
||||
*-------------------------------
|
||||
|
||||
JSR logdst ; log to destination
|
||||
LDX #<gname2
|
||||
LDA #>gname2 ; open file
|
||||
JSR movname
|
||||
JSR open
|
||||
|
||||
LDX #<confbuf
|
||||
LDA #>confbuf ; write configured system out
|
||||
LDY #18 ; write 9 pages (16.5 blocks)
|
||||
JSR wrblk
|
||||
JSR close ; close file
|
||||
|
||||
LDX #<program
|
||||
LDA #>program ; create file named "PROGRAM"
|
||||
JSR movname
|
||||
LDY #$F5 ; make into special type
|
||||
JMP create
|
||||
|
||||
*-------------------------------
|
||||
* copy second set of files into XXX/MPRO.SEGS
|
||||
|
||||
make2 LDX #<disk2 ; is second disk in place?
|
||||
LDA #>disk2
|
||||
JSR verify
|
||||
BCC :online ; yes, it is
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'Please place MultiPro Disk #2, /SEGS, online.'00
|
||||
|
||||
JSR get_ok ; wait for ok
|
||||
JMP make2
|
||||
|
||||
:online JSR cls
|
||||
JSR print
|
||||
ASC 'Copying MultiPro program segments...'00
|
||||
|
||||
LDX #<list2 ; copy segments to xxx/mpro.segs
|
||||
LDA #>list2
|
||||
JMP copy
|
||||
|
||||
*-------------------------------
|
||||
* make main part of disk in XXX/MPRO.SYS
|
||||
|
||||
make3 LDX #<disk3 ; is third disk in place?
|
||||
LDA #>disk3
|
||||
JSR verify
|
||||
BCC :online ; yes, it is
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'Please place MultiPro Disk #3, /FILE, online.'00
|
||||
|
||||
JSR get_ok ; wait for ok
|
||||
JMP make3
|
||||
|
||||
:online JSR cls
|
||||
JSR print
|
||||
ASC 'Copying MultiPro system files...'00
|
||||
|
||||
LDX #<list3 ; copy last 4 files
|
||||
LDA #>list3
|
||||
JSR copy
|
||||
|
||||
JSR logdst ; log to seg sub
|
||||
LDX #<usrname ; open user file
|
||||
LDA #>usrname
|
||||
JSR movname
|
||||
JSR open
|
||||
|
||||
LDX #<user-128 ; write out sysop data
|
||||
LDA #>user-128
|
||||
LDY #2 ; write 1 page (2 blocks)
|
||||
JSR wrblk
|
||||
|
||||
JSR close ; finish up
|
||||
|
||||
LDX #<dtanam1
|
||||
LDA #>dtanam1 ; open data1 file
|
||||
JSR movname
|
||||
JSR open
|
||||
|
||||
LDX #<datadef
|
||||
LDA #>datadef
|
||||
LDY #4 ; write 2 pages (4 blocks)
|
||||
JSR wrblk
|
||||
JSR close
|
||||
JMP logcon ; log back
|
||||
|
||||
*-------------------------------
|
||||
* make supertac segments
|
||||
|
||||
make4 LDX #<list4 ;copy protocol up/down
|
||||
LDA #>list4 ;and xdos
|
||||
JSR copy
|
||||
|
||||
:loop LDX #<disk4 ; is fourth disk in place?
|
||||
LDA #>disk4
|
||||
JSR verify
|
||||
BCC :online ; yes, it is
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'Please place MultiPro Disk #4, /STAC, online.'00
|
||||
|
||||
JSR get_ok ; wait for ok
|
||||
JMP :loop
|
||||
|
||||
:online JSR cls
|
||||
JSR print
|
||||
ASC 'Copying MultiPro transfer system files...'00
|
||||
|
||||
LDX #<list5 ;copy supertac files
|
||||
LDA #>list5
|
||||
JSR copy
|
||||
|
||||
* copy the access file to the supertac stuff
|
||||
|
||||
JSR logdst ;log to supertac seg parts
|
||||
LDX #<access ;open user file
|
||||
LDA #>access
|
||||
JSR movname
|
||||
JSR open
|
||||
|
||||
LDX #<stacacc ;write out sysop data
|
||||
LDA #>stacacc
|
||||
LDY #1 ;write 128 bytes
|
||||
JSR wrblk
|
||||
|
||||
JSR close ;finish up
|
||||
JSR logcon ;log back to config
|
||||
RTS ;oi, we be done!
|
||||
|
||||
*-------------------------------
|
||||
* print the slot or drive
|
||||
|
||||
prslot LDA slot
|
||||
CLC
|
||||
ADC #'0' ; print slot
|
||||
JMP cout
|
||||
|
||||
prdriv LDA drive
|
||||
CLC ; print drive
|
||||
ADC #'1'
|
||||
JMP cout
|
||||
|
||||
*-------------------------------
|
||||
* variables
|
||||
*-------------------------------
|
||||
|
||||
init ENT
|
||||
DB 0
|
||||
|
||||
diskid DB $A2,$20,$A0,0
|
||||
|
||||
gname2 STR 'ACOS.OBJ'
|
||||
program STR 'PROGRAM'
|
||||
access STR 'ACCESS'
|
||||
|
||||
slot ENT
|
||||
DB 0
|
||||
drive ENT
|
||||
DB 0
|
||||
dtanam1 STR 'DATA1'
|
||||
|
||||
user DS 70
|
||||
usrpass ASC ' '
|
||||
usrtele ASC 'xxx-xxx-xxxx'
|
||||
DA 0 ;when$
|
||||
DB %11111110,%11111111,%11111111
|
||||
DB %11111111,%00000111
|
||||
DB $50,0,0,0,0,0,0,0,0,0
|
||||
DS 20 ;bytes
|
||||
|
||||
datadef ASC 'System Name'0D
|
||||
ASC 'Sysop Name'0D
|
||||
ASC 'Second Password'0D
|
||||
|
||||
DS 120
|
||||
|
||||
xdata ASC '---------------------------------------'0D
|
||||
ASC 'Ctrl-S Stop/Start Spacebar to Exit'0D
|
||||
ASC 'Press N for Next Bulletin'0D
|
||||
ASC '1,0'0D
|
||||
DB 0
|
||||
|
||||
condata ASC ' '
|
||||
ASC 'N'
|
||||
DB 2
|
||||
DB 32,40,64,80
|
||||
|
||||
stacacc ASC '1'0D ;sysop low access
|
||||
ASC '50'0D ;sysop high access
|
||||
ASC '1'0D ;user low access
|
||||
ASC '50'0D ;user high access
|
||||
ASC '1'0D ;elite low access
|
||||
ASC '50'0D ;elite high access
|
||||
ASC '1'0D ;priv low access
|
||||
ASC '50'0D ;priv high access
|
||||
ASC '1'0D ;board manager low access
|
||||
ASC '50'0D ;board manager high access
|
||||
HEX 0D0D
|
||||
|
||||
*-------------------------------
|
||||
* lists for identifying files
|
||||
|
||||
disk1 STR '/CONFIG'00
|
||||
disk2 STR '/SEGS'00
|
||||
disk3 STR '/FILE'00
|
||||
disk4 STR '/STAC'00
|
||||
|
||||
usrname ASC 'system/sys.users'00
|
||||
|
||||
list1 ASC 'lluce.system'00
|
||||
ASC 'lluce.druvers'00
|
||||
DB 00
|
||||
|
||||
list2 ASC 'logon.seg.s'00
|
||||
ASC 'main.seg.s'00
|
||||
ASC 'msg.seg.s'00
|
||||
ASC 'system.seg.s'00
|
||||
ASC 'maint.seg.s'00
|
||||
ASC 'mail.seg.s'00
|
||||
|
||||
* supertac segments
|
||||
* a 00 is placed here if they don't want to include the
|
||||
* transfer system's segments
|
||||
|
||||
settrans DB 0
|
||||
superlist ASC 'supertac.s'00
|
||||
ASC 'supertac.sys.s'00
|
||||
ASC 'supertac.aux.s'00
|
||||
ASC 'purge.seg.s'00
|
||||
DB 00
|
||||
|
||||
list3 ASC 'bbs'00
|
||||
ASC 'data'00
|
||||
ASC 'data1'00
|
||||
ASC 'data2'00
|
||||
ASC 'g1'00
|
||||
ASC 'g1.1'00
|
||||
ASC 'g1.2'00
|
||||
ASC 'g1.3'00
|
||||
ASC 'hlp.edit'00
|
||||
ASC 'hlp.main'00
|
||||
ASC 'hlp.msg'00
|
||||
ASC 'hlp.user'00
|
||||
ASC 'mnu.val.40'00
|
||||
ASC 'mnu.val.80'00
|
||||
ASC 'mnu.new'00
|
||||
ASC 'sys.newinfo'00
|
||||
ASC 'sys.news'00
|
||||
ASC 'sys.info'00
|
||||
ASC 'sys.questions'00
|
||||
ASC 'users'00
|
||||
ASC 'v1.1'00
|
||||
ASC 'v1.2'00
|
||||
ASC 'v1.3'00
|
||||
ASC 'v1.4'00
|
||||
ASC 'b1'00
|
||||
|
||||
list4 ASC 'protocol.up'00
|
||||
ASC 'protocol.down'00
|
||||
ASC 'xdos'00
|
||||
DB 00
|
||||
|
||||
list5 ASC 'access'00
|
||||
ASC 'xshow'00
|
||||
ASC 'xcat'00
|
||||
ASC 'menu.supertac'00
|
||||
ASC 'menu.sysop'00
|
||||
ASC 'menu.aux'00
|
||||
ASC 'menu.batch'00
|
||||
DB 00
|
||||
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
|
||||
REL
|
||||
DSK REL/INITSTR
|
||||
|
||||
*-------------------------------
|
||||
* init strings for modems
|
||||
*-------------------------------
|
||||
|
||||
usr2400 ENT
|
||||
ASC 'ATX2S0=0S2=128E0V0F1Q0'0d00
|
||||
|
||||
usr9600 ENT
|
||||
ASC 'ATX6&S1&D2V0S0=0S2=128E0F1Q0'0d00
|
||||
|
||||
cts ENT
|
||||
ASC 'ATX3S0=0S2=128V0E0F1Q0&C1&D2S10=3'0D00
|
||||
|
||||
apl1200 ENT
|
||||
ASC 'ATX1S0=0S2=128V0'0D00
|
||||
|
||||
hayes1200 ENT
|
||||
ASC 'ATS0=0S2=128S18=0V0'0D00
|
||||
|
||||
hayes2400 ENT
|
||||
ASC 'ATX3S0=0&C1&D2S2=128V0'0D00
|
||||
|
||||
pro2400 ENT
|
||||
ASC 'ATX5S0=0S2=128V0'0D00
|
||||
|
||||
generic ENT
|
||||
ASC 'ATS0=0S2=128V0'0D00
|
||||
|
||||
epic ENT
|
||||
ASC 'ATS0=0S2=128&S1&D2V0'0D00
|
||||
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
|
||||
*m_vers = '1' ; make into ascii # (Main Version)
|
||||
*s_vers = '0' ; make into ascii # (Sub Version)
|
||||
*p_vers = '5' ; make into ascii # (Patch Version)
|
||||
|
||||
ORG $2000 ; org to where you want it
|
||||
TYP $FF
|
||||
|
||||
ASM START
|
||||
ASM ROUTINE
|
||||
ASM DISK
|
||||
ASM OSPJUNK
|
||||
ASM VIDEO
|
||||
ASM CMD
|
||||
ASM MODEM
|
||||
ASM PRINTER
|
||||
ASM CLOCK
|
||||
ASM FILTER
|
||||
ASM DEFAULTS
|
||||
ASM INIT
|
||||
|
||||
ASM INITSTR
|
||||
ASM MODEMS/NULLMDM
|
||||
ASM MODEMS/CAT103
|
||||
ASM MODEMS/CAT212
|
||||
ASM MODEMS/MM2
|
||||
ASM MODEMS/SSC
|
||||
ASM MODEMS/GSPORT.SLOT1
|
||||
ASM MODEMS/GSPORT.SLOT2
|
||||
ASM MODEMS/SINGLESPD
|
||||
ASM MODEMS/MULTISPD
|
||||
ASM MODEMS/NOCAR
|
||||
|
||||
ASM CLOCKS/THUNDER
|
||||
ASM CLOCKS/SERIALPRO
|
||||
ASM CLOCKS/ULTRA
|
||||
ASM CLOCKS/NO.SLOT
|
||||
ASM CLOCKS/IIC.SYS
|
||||
ASM CLOCKS/PRODOS
|
||||
ASM CLOCKS/MOUNTAIN
|
||||
ASM CLOCKS/VERSA
|
||||
ASM CLOCKS/IIGS
|
||||
ASM CLOCKS/NULL
|
||||
|
||||
ASM PRINTERS/NULL
|
||||
ASM PRINTERS/PARALLEL
|
||||
ASM PRINTERS/SERIAL
|
||||
ASM PRINTERS/GRAPPLER
|
||||
|
||||
LINK REL/START
|
||||
LINK REL/ROUTINE
|
||||
LINK REL/DISK
|
||||
LINK REL/OSPJUNK
|
||||
LINK REL/VIDEO
|
||||
LINK REL/CMD
|
||||
LINK REL/MODEM
|
||||
LINK REL/PRINTER
|
||||
LINK REL/CLOCK
|
||||
LINK REL/FILTER
|
||||
LINK REL/DEFAULTS
|
||||
LINK REL/INIT
|
||||
|
||||
LINK REL/INITSTR
|
||||
LINK MODEMS/REL/NULLMDM
|
||||
LINK MODEMS/REL/CAT103
|
||||
LINK MODEMS/REL/CAT212
|
||||
LINK MODEMS/REL/MM2
|
||||
LINK MODEMS/REL/SSC
|
||||
LINK MODEMS/REL/GSPORT1
|
||||
LINK MODEMS/REL/GSPORT2
|
||||
LINK MODEMS/REL/SINGLESPD
|
||||
LINK MODEMS/REL/MULTISPD
|
||||
LINK MODEMS/REL/NOCAR
|
||||
|
||||
LINK CLOCKS/REL/THUNDER
|
||||
LINK CLOCKS/REL/SERIALPRO
|
||||
LINK CLOCKS/REL/ULTRA
|
||||
LINK CLOCKS/REL/NOSLOT
|
||||
LINK CLOCKS/REL/IICSYS
|
||||
LINK CLOCKS/REL/PRODOS
|
||||
LINK CLOCKS/REL/MOUNTAIN
|
||||
LINK CLOCKS/REL/VERSA
|
||||
LINK CLOCKS/REL/GSCLOCK
|
||||
LINK CLOCKS/REL/NULL
|
||||
|
||||
LINK PRINTERS/REL/NULL
|
||||
LINK PRINTERS/REL/PARALLEL
|
||||
LINK PRINTERS/REL/SERIAL
|
||||
LINK PRINTERS/REL/GRAPPLER
|
||||
|
||||
SAV CONFIG.SYSTEM
|
||||
|
||||
|
|
@ -0,0 +1,252 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* GBBS Config - Prodos Storage *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
re_stor JSR cls ; clear screen
|
||||
|
||||
LDA #<hdrbuf
|
||||
STA temp
|
||||
LDA #>hdrbuf
|
||||
STA temp+1
|
||||
|
||||
LDX #0 ; start pointers
|
||||
LDY #0
|
||||
STY temp2 ; set device count at zero
|
||||
stor2 LDA devnam,x ; get drive info
|
||||
STA temp2+1
|
||||
|
||||
stor3 LDA devnam,x ; copy pathname
|
||||
STA (temp),y
|
||||
INX
|
||||
INY
|
||||
DEC temp2+1
|
||||
BPL stor3
|
||||
|
||||
CLC
|
||||
LDA temp ; go to next address
|
||||
ADC #128
|
||||
STA temp
|
||||
LDA temp+1
|
||||
ADC #0
|
||||
STA temp+1
|
||||
|
||||
LDY #0
|
||||
INC temp2 ; inc number of pathnames
|
||||
LDA temp2
|
||||
CMP #12 ; done all 12?
|
||||
BNE stor2 ; nope
|
||||
|
||||
stor4 JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,21
|
||||
ASC '- Edit Drive Specifier Allocation -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix D of your user'
|
||||
ASC ' manual for more information.'00
|
||||
JSR cls
|
||||
|
||||
LDX #-1
|
||||
stor5 INX
|
||||
JSR shwpfx ; show drive
|
||||
LDA #cr ; add end of line
|
||||
JSR cout
|
||||
CPX #11
|
||||
BCC stor5 ; show all 12 entries
|
||||
|
||||
stor6 JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Edit: [A-L] or Q=Quit ? '00
|
||||
|
||||
LDA #%10000000
|
||||
STA inpmode ; set mode 0
|
||||
LDA #1
|
||||
STA maxlen ; set length to 1
|
||||
|
||||
JSR inpln ; get input
|
||||
LDA lnbuf
|
||||
CMP #'Q' ; quit?
|
||||
BNE stor7 ; yep
|
||||
|
||||
JMP stor9 ; handle quit
|
||||
|
||||
stor7 SEC
|
||||
SBC #'A' ; make into range
|
||||
CMP #12 ; is it ok?
|
||||
BCS stor6 ; nope
|
||||
|
||||
PHA
|
||||
TAX
|
||||
JSR finddrv ; find the drive location
|
||||
|
||||
LDX #20
|
||||
JSR cleos ; claer last line
|
||||
|
||||
LDX #20 ; position
|
||||
STX cv
|
||||
LDX #0
|
||||
STX ch
|
||||
|
||||
PLA
|
||||
CLC
|
||||
ADC #'A' ; show drive specifier
|
||||
JSR cout
|
||||
JSR print
|
||||
ASC ': /'00
|
||||
|
||||
LDA #30 ; make max length 32 total
|
||||
STA maxlen
|
||||
LDA #%10100001
|
||||
STA inpmode
|
||||
|
||||
JSR inpln
|
||||
LDA lnbuf-1,y
|
||||
CMP #'/' ; check for ending slash
|
||||
BNE stor7f
|
||||
|
||||
LDA #cr ; delete ending slash
|
||||
STA lnbuf-1,y
|
||||
|
||||
stor7f LDA lnbuf ; did they just do a return?
|
||||
CMP #cr
|
||||
BNE stor8 ;nope
|
||||
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Clear contents of this line [Y/N] ? '00
|
||||
|
||||
JSR inpyn ; get answer
|
||||
BCS stor7a ; nope
|
||||
|
||||
LDY #0
|
||||
TYA ; nullify an entry
|
||||
STA (temp4),y
|
||||
stor7a JMP stor4 ; do another
|
||||
|
||||
stor8 LDX #0
|
||||
LDY #2
|
||||
stor8a LDA lnbuf,x ; copy pathname
|
||||
STA (temp4),y
|
||||
INX
|
||||
INY
|
||||
CMP #cr
|
||||
BNE stor8a
|
||||
|
||||
LDY #0 ; save length
|
||||
TXA
|
||||
STA (temp4),y
|
||||
INY
|
||||
LDA #'/' ; add leading slash
|
||||
STA (temp4),y
|
||||
JMP stor4 ; show results
|
||||
|
||||
stor9a JMP start ; abort out
|
||||
|
||||
stor9 LDX #20
|
||||
JSR cleos ; clear bottom
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Is the above correct [Y/N] ? '00
|
||||
JSR inpyn
|
||||
BCS stor9a ; nope
|
||||
|
||||
LDA #<hdrbuf
|
||||
STA temp ; point at pathnames
|
||||
LDA #>hdrbuf
|
||||
STA temp+1
|
||||
|
||||
LDX #0
|
||||
LDY #0
|
||||
STY temp2 ; start with drive A:
|
||||
stor9b LDA (temp),y
|
||||
STA temp2+1 ; save length
|
||||
|
||||
stor9c LDA (temp),y ; get data
|
||||
STA devnam,x
|
||||
INX
|
||||
CPX #$f0 ; is table ok?
|
||||
BEQ stor9d ; nope, it is too big
|
||||
|
||||
INY
|
||||
DEC temp2+1 ; count down length
|
||||
BPL stor9c
|
||||
|
||||
CLC
|
||||
LDA temp
|
||||
ADC #$80 ; go to next field
|
||||
STA temp
|
||||
LDA temp+1
|
||||
ADC #0
|
||||
STA temp+1
|
||||
|
||||
LDY #0 ; reset pointer within field
|
||||
INC temp2
|
||||
LDA temp2 ; done all 12 yet?
|
||||
CMP #12
|
||||
BNE stor9b ; nope, loop
|
||||
JMP wrtchg ; write changes to disk
|
||||
|
||||
stor9d JSR cls
|
||||
JSR print
|
||||
ASC 'ERROR !',0d,0d
|
||||
ASC 'Overflow error. Too much data within '
|
||||
ASC 'drive table. Cut down on the amount',0d,0d
|
||||
ASC 'of data within the table.'
|
||||
DB 1,20,0
|
||||
ASC 'Press [RETURN] to continue... ',00
|
||||
|
||||
stor9e JSR rdkey ; wait for a return
|
||||
CMP #cr
|
||||
BNE stor9e
|
||||
JMP stor4 ; get new stuff
|
||||
|
||||
; point to the pathname of a device
|
||||
finddrv LDA #0 ; set lower to 0
|
||||
STA temp4
|
||||
TXA
|
||||
LSR
|
||||
ROR temp4 ; put extra into low
|
||||
CLC
|
||||
ADC #>hdrbuf
|
||||
STA temp4+1 ; setup high
|
||||
RTS
|
||||
|
||||
; show a pathname of a device
|
||||
shwpfx JSR finddrv ; position
|
||||
TXA
|
||||
CLC
|
||||
ADC #'A' ; show drive name
|
||||
JSR cout
|
||||
|
||||
LDA #':' ; add colon
|
||||
JSR cout
|
||||
|
||||
LDA #' ' ; put in space
|
||||
JSR cout
|
||||
|
||||
LDY #0 ; check for data
|
||||
LDA (temp4),y
|
||||
STA temp2+1
|
||||
BEQ prdrv3 ; nope, there isnt any
|
||||
|
||||
prdrv2 INY
|
||||
LDA (temp4),y ; get byte of name
|
||||
JSR conv
|
||||
JSR cout ; show it
|
||||
DEC temp2+1
|
||||
BNE prdrv2 ; keep going
|
||||
|
||||
CLC
|
||||
RTS
|
||||
|
||||
prdrv3 SEC ; no data
|
||||
RTS
|
||||
|
||||
|
|
@ -0,0 +1,764 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* Config - Print Userlist *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 11/29/86
|
||||
*-------------------------------
|
||||
|
||||
usrlist LDX #<start
|
||||
LDA #>start ; setup esc handler
|
||||
JSR escape
|
||||
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,27
|
||||
ASC '- Sort and Print Userlist -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix F of your user'
|
||||
ASC ' manual for more information.'00
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC ' 1 - Sort by user name'0D
|
||||
ASC ' 2 - Sort by the user number'0D
|
||||
ASC ' 3 - Sort by user password'0D
|
||||
ASC ' 4 - Sort by phone number'0D
|
||||
ASC ' 5 - Sort by last date on'0D
|
||||
ASC ' 6 - Sort by security level'0D
|
||||
ASC ' 7 - Return to main menu'0D0D
|
||||
ASC 'Which? [1-7] '00
|
||||
|
||||
LDX #7 ; get there choice
|
||||
JSR inpnum
|
||||
STA sortyp
|
||||
CMP #7 ; check for abort
|
||||
BNE :over
|
||||
JMP start
|
||||
|
||||
:over LDX #<usrlist ; setup esc handler
|
||||
LDA #>usrlist
|
||||
JSR escape
|
||||
|
||||
list0 JSR cls
|
||||
JSR print
|
||||
HEX 0D
|
||||
ASC 'Show users with which security flags:'0D0D
|
||||
ASC '[0] = Un-Verified Users'0D
|
||||
ASC '[1] = Verified Users'0D
|
||||
ASC '[34] = Sysop Status'0D
|
||||
ASC '[RET] = Print all users'0D0D
|
||||
ASC 'List which users [CR,0-34]: '00
|
||||
|
||||
LDA #%00100000
|
||||
STA inpmode ; set input mode
|
||||
LDA #2
|
||||
STA maxlen ; set input length
|
||||
|
||||
LDA #-1 ; default to all users
|
||||
STA seclvl
|
||||
JSR inpln ; input their choice
|
||||
LDA lnbuf
|
||||
CMP #cr ; show all users?
|
||||
BEQ list0a ; get password status
|
||||
|
||||
LDX #<lnbuf ; change to number
|
||||
LDA #>lnbuf
|
||||
JSR numin
|
||||
STX seclvl ; save the level
|
||||
CPX #35
|
||||
BCC list0a ; out of range
|
||||
JMP list0
|
||||
|
||||
list0a JSR print
|
||||
HEX 0D
|
||||
ASC 'Display Passwords [Y/N] ? '00
|
||||
JSR inpyn
|
||||
LDA #0
|
||||
ROR
|
||||
STA shwpass ; save password status
|
||||
|
||||
JSR print
|
||||
HEX 0D0D
|
||||
ASC 'Make sure printer, config disk, and '
|
||||
ASC 'system disk are on-line and ready.'00
|
||||
:oops JSR getcr
|
||||
LDA #1 ; log to system disk
|
||||
JSR logspec
|
||||
BCS :oops ; opps, error
|
||||
|
||||
JSR cls ; clear screen
|
||||
JSR print
|
||||
DB 1,8,12
|
||||
ASC 'Reading data...'00
|
||||
|
||||
LDX #<usrname ; setup user file name
|
||||
LDA #>usrname
|
||||
JSR movname
|
||||
|
||||
LDX #1 ; start user number at 1
|
||||
STX temp
|
||||
DEX
|
||||
STX temp+1
|
||||
|
||||
LDA #<sortbuf
|
||||
STA temp2 ; point to buffer
|
||||
LDA #>sortbuf
|
||||
STA temp2+1
|
||||
|
||||
JSR open ; open userfile
|
||||
BCC list1a ; all is well
|
||||
|
||||
JSR close
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'Error: Unable to open file USERS'00
|
||||
JSR getcr
|
||||
JMP usrlist ; start over
|
||||
|
||||
list1a LDX #<hdrbuf ; gobble user #0
|
||||
LDA #>hdrbuf
|
||||
LDY #128 ; 128 byte records
|
||||
JSR rdpart
|
||||
|
||||
list_2 LDA #0 ; clear buffer
|
||||
STA hdrbuf
|
||||
LDX #<hdrbuf
|
||||
LDA #>hdrbuf ; read in a user
|
||||
LDY #128 ; 128 byte records
|
||||
JSR rdpart
|
||||
BCS list2c ; opps, end of file
|
||||
|
||||
LDA hdrbuf
|
||||
AND #$7F
|
||||
BEQ list2c ; no more users
|
||||
|
||||
CMP #','
|
||||
BEQ list2a ; opps, no user in that slot
|
||||
|
||||
LDA seclvl ; show all users?
|
||||
BMI list2e ; yep
|
||||
BEQ list2d ; show non-verified
|
||||
|
||||
PHA
|
||||
LSR
|
||||
LSR ; divide by 8
|
||||
LSR
|
||||
TAX ; and make into byte offset
|
||||
PLA
|
||||
AND #%00000111
|
||||
TAY ; get bit offset
|
||||
LDA hdrbuf+92,X ; get byte
|
||||
AND secmap,Y ; check bit
|
||||
BEQ list2a ; nope, dont show
|
||||
BNE list2e ; show it
|
||||
|
||||
list2d LDA hdrbuf+92 ; check for non-verified
|
||||
AND #%00000010
|
||||
BNE list2a ; user is verified, dont show
|
||||
|
||||
list2e JSR list_5 ; handle sort dispatch
|
||||
|
||||
list2a INC temp
|
||||
BNE *+4 ; inc user number
|
||||
INC temp+1
|
||||
JMP list_2 ; loop
|
||||
|
||||
list2c LDY #0
|
||||
TYA ; mark last entry
|
||||
STA (temp2),Y
|
||||
|
||||
LDA sortbuf ; check for no entries
|
||||
BNE list2f ; there is data
|
||||
|
||||
JSR close ; close user file
|
||||
JSR cls
|
||||
JSR print
|
||||
ASC 'No users fit parameters'00
|
||||
JSR getcr
|
||||
JMP usrlist ; restart
|
||||
|
||||
list2f LDA sortbuf+12 ; only 1 user in list?
|
||||
BEQ list2g ; yep
|
||||
|
||||
JSR print
|
||||
DB 1,8,12 ; change on-screen operation
|
||||
ASC 'Sort'00
|
||||
JSR list6 ; sort data
|
||||
|
||||
list2g JSR print
|
||||
DB 1,8,12
|
||||
ASC 'Printing data...'00
|
||||
|
||||
LDA #<sortbuf ; point to data
|
||||
STA temp2
|
||||
LDA #>sortbuf
|
||||
STA temp2+1
|
||||
LDA #0 ; count the page display
|
||||
STA prinit ; set printer to init
|
||||
STA pagecnt
|
||||
|
||||
list_3 LDY #0
|
||||
LDA (temp2),Y
|
||||
BEQ list_4 ; opps, end of list
|
||||
|
||||
LDY #10
|
||||
LDA (temp2),Y ; get user number
|
||||
STA hdrbuf+128
|
||||
TAX
|
||||
INY
|
||||
LDA (temp2),Y
|
||||
STA hdrbuf+129 ; save user number as data
|
||||
JSR gouser
|
||||
|
||||
LDX #<hdrbuf
|
||||
LDA #>hdrbuf ; read in user record
|
||||
LDY #128
|
||||
JSR rdpart
|
||||
|
||||
bit shwpass ; show passwords?
|
||||
BPL list3b ; yep
|
||||
|
||||
LDA #'*'
|
||||
LDX #7
|
||||
list3a STA hdrbuf+70,X ; cover password with *'s
|
||||
DEX
|
||||
BPL list3a
|
||||
|
||||
list3b JSR pruser ; print users data
|
||||
|
||||
CLC
|
||||
LDA temp2
|
||||
ADC #12
|
||||
STA temp2 ; goto next record
|
||||
LDA temp2+1
|
||||
ADC #0
|
||||
STA temp2+1
|
||||
JMP list_3 ; do next user
|
||||
|
||||
list_4 JSR close ; close user file
|
||||
list4a DEC pagecnt ; check page count
|
||||
BEQ list4b
|
||||
|
||||
LDA #cr ; advance page
|
||||
JSR prcout
|
||||
JMP list4a
|
||||
|
||||
list4b LDA #cr ; add 4 last lines
|
||||
JSR prcout
|
||||
JSR prcout
|
||||
JSR prcout
|
||||
JSR prcout
|
||||
JMP usrlist ; we are done
|
||||
|
||||
*-------------------------------
|
||||
* handle moving data for sort
|
||||
|
||||
list_5 LDY #9
|
||||
LDA #' '
|
||||
list5f STA hdrbuf+$100,Y ; fill with blanks just in case
|
||||
DEY
|
||||
BPL list5f
|
||||
|
||||
JSR list5b ; get into 10 byte form
|
||||
|
||||
LDY #11 ; save user record number
|
||||
LDA temp+1
|
||||
STA (temp2),Y
|
||||
DEY
|
||||
LDA temp
|
||||
STA (temp2),Y
|
||||
|
||||
DEY
|
||||
list5a LDA hdrbuf+$100,Y ; copy over data
|
||||
STA (temp2),Y
|
||||
DEY
|
||||
BPL list5a
|
||||
|
||||
CLC
|
||||
LDA temp2 ; go to next record
|
||||
ADC #12
|
||||
STA temp2
|
||||
LDA temp2+1
|
||||
ADC #0
|
||||
STA temp2+1
|
||||
RTS
|
||||
|
||||
sortyp DB 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
list5b LDA sortyp
|
||||
ASL
|
||||
TAX
|
||||
LDA displist,X
|
||||
STA prn
|
||||
INX
|
||||
LDA displist,X
|
||||
STA prn+1
|
||||
JMP (prn)
|
||||
|
||||
displist DA 0
|
||||
DA sname ; sort user name
|
||||
DA sunum ; sort by user number
|
||||
DA spass ; sort by password
|
||||
DA sfone ; sort by phone number
|
||||
DA sdate ; sort by last user
|
||||
DA ssec ; sort by sec level
|
||||
|
||||
*-------------------------------
|
||||
|
||||
sname LDY #-1
|
||||
sname2 INY
|
||||
LDA hdrbuf,Y ; search for divider
|
||||
AND #$7F
|
||||
CMP #' ' ; control char?
|
||||
BCC sunum ; hmm, just blank out
|
||||
CMP #','
|
||||
BNE sname2
|
||||
|
||||
LDX #-1
|
||||
sname3 INX
|
||||
INY
|
||||
LDA hdrbuf,Y ; move byte
|
||||
STA hdrbuf+$100,X
|
||||
AND #$7F
|
||||
CMP #' '
|
||||
BCS sname3 ; loop and finish
|
||||
|
||||
LDY #-1
|
||||
sname4 INY
|
||||
LDA hdrbuf,Y ; add on first name
|
||||
STA hdrbuf+$100,X
|
||||
AND #$7F
|
||||
INX
|
||||
CMP #',' ; done?
|
||||
BNE sname4 ; nope
|
||||
|
||||
sunum RTS ; leave data as blanks
|
||||
|
||||
spass LDY #7
|
||||
spass2 LDA hdrbuf+70,Y ; move password
|
||||
STA hdrbuf+$100,Y
|
||||
DEY
|
||||
BPL spass2
|
||||
RTS
|
||||
|
||||
sfone LDX #0
|
||||
LDY #0
|
||||
sfone2 LDA hdrbuf+78,Y ; get phone number
|
||||
STA hdrbuf+$100,X
|
||||
INX
|
||||
INY
|
||||
CPY #3
|
||||
BNE *+3 ; skip if not at 3
|
||||
INY
|
||||
CPY #7
|
||||
BNE *+3
|
||||
INY
|
||||
CPY #12 ; done?
|
||||
BNE sfone2 ; nope
|
||||
RTS
|
||||
|
||||
sdate LDA hdrbuf+91 ; move date into sort field
|
||||
AND #%00011111 ; get rid of extra stuff
|
||||
STA hdrbuf+$101
|
||||
LDA hdrbuf+90
|
||||
STA hdrbuf+$102
|
||||
RTS
|
||||
|
||||
ssec LDY #3
|
||||
ssec2 LDA hdrbuf+92,Y ; move sec level in
|
||||
STA hdrbuf+$101,Y
|
||||
DEY
|
||||
BPL ssec2
|
||||
RTS
|
||||
|
||||
; sort all the records into order
|
||||
list6 LDA #<sortbuf
|
||||
STA temp ; point to buffer #1
|
||||
LDA #>sortbuf
|
||||
STA temp+1
|
||||
|
||||
LDA #<sortbuf+12
|
||||
STA temp2 ; point to buffer #2
|
||||
LDA #>sortbuf+12
|
||||
STA temp2+1
|
||||
|
||||
list6a LDY #0
|
||||
list6b LDA (temp),Y ; get first byte
|
||||
CMP (temp2),Y ; check againt second
|
||||
BEQ list6c ; all is well
|
||||
BCS list6e
|
||||
BCC list6d ; order is correct
|
||||
|
||||
list6c INY ; go to next char
|
||||
CPY #10 ; there yet?
|
||||
BNE list6b ; nope
|
||||
|
||||
list6d CLC
|
||||
LDA temp ; advance pointer #1
|
||||
ADC #12
|
||||
STA temp
|
||||
LDA temp+1
|
||||
ADC #0
|
||||
STA temp+1
|
||||
|
||||
CLC
|
||||
LDA temp2 ; advance pointer #2
|
||||
ADC #12
|
||||
STA temp2
|
||||
LDA temp2+1
|
||||
ADC #0
|
||||
STA temp2+1
|
||||
|
||||
LDY #0 ; we done?
|
||||
LDA (temp),Y
|
||||
BEQ list6q ; yep
|
||||
|
||||
LDA (temp2),Y ; done?
|
||||
BNE list6a ; nope, do next record
|
||||
list6q RTS
|
||||
|
||||
list6e LDY #11
|
||||
list6f LDA (temp),Y
|
||||
PHA
|
||||
LDA (temp2),Y ; swap data
|
||||
STA (temp),Y
|
||||
PLA
|
||||
STA (temp2),Y
|
||||
DEY
|
||||
BPL list6f ; do 12 bytes
|
||||
|
||||
LDA temp+1
|
||||
CMP #>sortbuf ; at record #1 ?
|
||||
BNE list6g ; nope
|
||||
|
||||
LDA temp
|
||||
CMP #<sortbuf ; at record #1 ?
|
||||
BEQ list6h ; yep
|
||||
|
||||
list6g SEC
|
||||
LDA temp ; backup record #1
|
||||
SBC #12
|
||||
STA temp
|
||||
LDA temp+1
|
||||
SBC #0
|
||||
STA temp+1
|
||||
|
||||
SEC
|
||||
LDA temp2 ; backup record #2
|
||||
SBC #12
|
||||
STA temp2
|
||||
LDA temp2+1
|
||||
SBC #0
|
||||
STA temp2+1
|
||||
list6h JMP list6a
|
||||
|
||||
*-------------------------------
|
||||
; print out a user record
|
||||
pruser DEC pagecnt ; count down list
|
||||
BMI pruser0
|
||||
BNE pruser1
|
||||
|
||||
LDA #cr
|
||||
JSR prcout ; advance page
|
||||
JSR prcout
|
||||
JSR prcout
|
||||
JSR prcout
|
||||
|
||||
pruser0 LDX #<prthdr
|
||||
LDA #>prthdr
|
||||
LDY #-1 ; print page header
|
||||
JSR prdata
|
||||
|
||||
LDA sortyp
|
||||
LUP 4
|
||||
ASL
|
||||
--^
|
||||
TAX
|
||||
pruser3 LDA sortnam-16,X
|
||||
INX
|
||||
JSR prcout
|
||||
ASL
|
||||
BNE pruser3
|
||||
|
||||
LDX #77 ; move over to col 77
|
||||
JSR gocol
|
||||
|
||||
LDX #<prthdr2 ; print rest of header
|
||||
LDA #>prthdr2
|
||||
LDY #-1
|
||||
JSR prdata
|
||||
|
||||
LDA #58
|
||||
STA pagecnt ; reset page counter
|
||||
|
||||
pruser1 LDX #<hdrbuf ; point to buffer with data
|
||||
LDA #>hdrbuf
|
||||
LDY #"," ; print first name
|
||||
JSR prdata
|
||||
STX prn ; save location
|
||||
STA prn+1
|
||||
|
||||
LDA #' ' ; put a space between first & last
|
||||
JSR prcout
|
||||
|
||||
LDX prn ; pick up last location
|
||||
LDA prn+1
|
||||
LDY #cr+128 ; print last name
|
||||
JSR prdata
|
||||
|
||||
LDX #25 ; move over to col 25
|
||||
JSR gocol
|
||||
|
||||
LDX #<hdrbuf+78 ; point buffer to data
|
||||
LDA #>hdrbuf+78
|
||||
LDY #12
|
||||
JSR prdata ; print phone number
|
||||
|
||||
LDX hdrbuf+128
|
||||
LDA hdrbuf+129 ; translate number
|
||||
JSR decmem
|
||||
|
||||
SEC
|
||||
LDA #43
|
||||
SBC txtnum ; move over to print user number
|
||||
TAX
|
||||
JSR gocol
|
||||
|
||||
LDY txtnum
|
||||
LDX #<txtnum+1
|
||||
LDA #>txtnum+1
|
||||
JSR prdata ; print user number
|
||||
|
||||
LDA #'-' ; add in a dash
|
||||
JSR prcout
|
||||
|
||||
LDX #<hdrbuf+70 ; point buffer data
|
||||
LDA #>hdrbuf+70
|
||||
LDY #8
|
||||
JSR prdata ; print password
|
||||
|
||||
LDX #54 ; move over to col 54
|
||||
JSR gocol
|
||||
|
||||
LDA hdrbuf+92
|
||||
LSR ; dont show guest/user flag
|
||||
LDX #7
|
||||
pruser2 LSR
|
||||
PHA
|
||||
LDA #0 ; show 1 or 0 flag status
|
||||
ADC #'0'
|
||||
JSR prcout
|
||||
PLA
|
||||
DEX ; print 7 flags
|
||||
BNE pruser2
|
||||
|
||||
LDX #63 ; move over to col 63
|
||||
JSR gocol
|
||||
|
||||
LDA hdrbuf+90 ; get most of month
|
||||
LSR hdrbuf+91 ; shift last bit into carry
|
||||
ROR ; move bit in
|
||||
LUP 4
|
||||
LSR
|
||||
--^
|
||||
JSR bindec8
|
||||
JSR prdec8 ; print it out
|
||||
LDA #'/'
|
||||
JSR prcout
|
||||
|
||||
LDA hdrbuf+90
|
||||
AND #$1F ; translate month
|
||||
JSR bindec8
|
||||
JSR prdec8 ; print out
|
||||
LDA #'/'
|
||||
JSR prcout
|
||||
|
||||
LDA #'8' ; print out /8x
|
||||
JSR prcout
|
||||
|
||||
LDA hdrbuf+91 ; get year
|
||||
AND #%00001111 ; just use last digit
|
||||
CLC
|
||||
ADC #'0' ; make ascii
|
||||
JSR prcout
|
||||
|
||||
LDA hdrbuf+99
|
||||
AND #%00001111
|
||||
TAX ; display time limit
|
||||
LDA #0
|
||||
JSR decmem
|
||||
|
||||
SEC
|
||||
LDA #75
|
||||
SBC txtnum ; move over to print time limit
|
||||
TAX
|
||||
JSR gocol
|
||||
|
||||
LDY txtnum
|
||||
LDX #<txtnum+1
|
||||
LDA #>txtnum+1
|
||||
JSR prdata ; print time limit
|
||||
|
||||
LDA #'0' ; add on zero (time * 10)
|
||||
JSR prcout
|
||||
LDA #cr ; end of line data
|
||||
JMP prcout
|
||||
|
||||
; print out selected data
|
||||
prdata STX prn ; point to data
|
||||
STA prn+1
|
||||
STY prn+2 ; save delimeter
|
||||
STY prn+3 ; save length
|
||||
|
||||
LDY #0
|
||||
prdata2 LDA (prn),Y ; get data
|
||||
INC prn
|
||||
BNE *+4 ; goto next byte
|
||||
INC prn+1
|
||||
|
||||
ORA #$80 ; set high for ascii check
|
||||
CMP prn+2 ; we done?
|
||||
BEQ prdata3 ; yep
|
||||
|
||||
JSR prcout ; print data
|
||||
DEC prn+3 ; count down length
|
||||
BNE prdata2 ; keep going
|
||||
|
||||
prdata3 LDX prn
|
||||
LDA prn+1 ; get new address
|
||||
RTS
|
||||
|
||||
; go to a specified column
|
||||
gocol STX prn ; save end address
|
||||
gocol2 LDA prcol ; are we done?
|
||||
CMP prn
|
||||
BCS gocol3 ; yep
|
||||
|
||||
LDA #' ' ; move over a space
|
||||
JSR prcout
|
||||
JMP gocol2 ; keep going
|
||||
|
||||
gocol3 RTS
|
||||
|
||||
; print out a 2 byte number [xx]
|
||||
prdec8 JSR prcout ; call
|
||||
TXA ; ... fall into ...
|
||||
|
||||
; print character: A = character
|
||||
prcout PHA ; save all reg's
|
||||
STX prsv_x
|
||||
STY prsv_y
|
||||
|
||||
LDX #$13
|
||||
prcout1 LDA $24,X ; save zero page stuff
|
||||
STA przero,X
|
||||
DEX
|
||||
BPL prcout1
|
||||
|
||||
BIT prinit ; has printer been used?
|
||||
BMI prcout3 ; yep
|
||||
|
||||
LDA #$10
|
||||
STA $26 ; setup slot pointer
|
||||
LDA #>$C100
|
||||
STA $36+1 ; point ($0036) at $c100
|
||||
LDA #0 ; init printer card
|
||||
STA prcol ; reset column
|
||||
TAX
|
||||
TAY
|
||||
STA $24
|
||||
STA $27 ; zero character buffer
|
||||
STA $36
|
||||
|
||||
JSR $C100
|
||||
LDA $36 ; point to output routine
|
||||
STA jpcout2+1
|
||||
LDA $36+1
|
||||
STA jpcout2+2
|
||||
DEC prinit ; show we have done init
|
||||
|
||||
LDA #'I'-$40 ; send ctrl-I 80 n
|
||||
JSR jpcout
|
||||
LDA #'8'
|
||||
JSR jpcout
|
||||
LDA #'0'
|
||||
JSR jpcout
|
||||
LDA #'N'
|
||||
JSR jpcout
|
||||
|
||||
prcout3 LDA #0 ; set ch over to border
|
||||
STA $24
|
||||
INC prcol ; move over 1 col
|
||||
PLA ; get byte to print
|
||||
PHA
|
||||
AND #$7F ; print with high-bit off
|
||||
CMP #cr
|
||||
BNE prcout5
|
||||
|
||||
LDX #0 ; reset column
|
||||
STX prcol
|
||||
prcout5 JSR jpcout
|
||||
|
||||
LDX #$13
|
||||
prcout4 LDA przero,X ; restore zero page
|
||||
STA $24,X
|
||||
DEX
|
||||
BPL prcout4
|
||||
|
||||
LDX prsv_x ; restore reg's
|
||||
LDY prsv_y
|
||||
PLA
|
||||
RTS
|
||||
|
||||
jpcout ORA #$80
|
||||
jpcout2 JMP $C000 ; do output routine
|
||||
|
||||
prinit DB 0
|
||||
prsv_x DB 0
|
||||
prsv_y DB 0
|
||||
przero DS $14
|
||||
|
||||
; position to a user
|
||||
gouser STX temp+1 ; reset scratch bytes
|
||||
LDX #0
|
||||
STX temp
|
||||
|
||||
LSR ; do multipication
|
||||
ROR temp+1
|
||||
ROR temp
|
||||
LDX temp
|
||||
TAY
|
||||
LDA temp+1
|
||||
JMP setpos ; position to user
|
||||
|
||||
seclvl DB 0
|
||||
shwpass DB 0
|
||||
secmap DB 1,2,4,8,$10,$20,$40,$80
|
||||
|
||||
prcol DB 0
|
||||
pagecnt DB 0
|
||||
|
||||
prthdr ASC '++ MultiPro Userlist - Version 1.4 '
|
||||
ASC '- List Sorted By: ',FF
|
||||
prthdr2 ASC '++'0D
|
||||
ASC '[Name] [Phone] [User] '
|
||||
ASC '[Pass] [Sec] [Last] [Time]'0D
|
||||
ASC '[Alias] [Number] [Numb] '
|
||||
ASC '[Word] [Lvl] [Call] [Limit]'0D0D,FF
|
||||
|
||||
sortnam ASC 'User Name '0000
|
||||
ASC 'User Number '0000
|
||||
ASC 'User Password '0000
|
||||
ASC 'Phone Number '0000
|
||||
ASC 'Last Date On '0000
|
||||
ASC 'Security Level'0000
|
||||
|
||||
|
|
@ -0,0 +1,454 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Reconfigure modem
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
cr = $D
|
||||
point0 = $11
|
||||
point1 = $14
|
||||
point3 = $FD
|
||||
lnbuf = $200
|
||||
mdmdrv = $B00
|
||||
initbuf = $1800
|
||||
ansbuf = $1830
|
||||
cdbyte = $10BF ; carrier detect byte
|
||||
ansstr = $10C0 ; modem answer string
|
||||
initstr = $10D0 ; modem init string
|
||||
|
||||
DSK REL/MODEM
|
||||
|
||||
TopBox EXT ; routines external to this file
|
||||
print EXT
|
||||
cls EXT
|
||||
start EXT
|
||||
escape EXT
|
||||
inpnum EXT
|
||||
chinit EXT
|
||||
wrtchg EXT
|
||||
init EXT
|
||||
do_init EXT
|
||||
maxlen EXT
|
||||
inpmode EXT
|
||||
cout EXT
|
||||
inpln EXT
|
||||
|
||||
|
||||
nullmdm EXT ;null modem driver
|
||||
cat103 EXT ;300 baud cat driver
|
||||
cat212 EXT ;1200 baud cat driver
|
||||
mm2 EXT ;micromodem II driver
|
||||
ssc EXT ;super serial driver
|
||||
gsport1 EXT ;location for gs port driver
|
||||
gsport2 EXT ;loc for gs port slot #2
|
||||
singlespd EXT ;single speed driver
|
||||
multispd EXT ;multi-speed <return> driver
|
||||
nocar EXT ;no carrier driver
|
||||
|
||||
*-------------------------------
|
||||
* init strings
|
||||
|
||||
usr2400 EXT ;init string for usr 2400
|
||||
usr9600 EXT ;init string for usr 9600
|
||||
cts EXT ;init string for cts 2424
|
||||
apl1200 EXT
|
||||
hayes1200 EXT
|
||||
hayes2400 EXT
|
||||
pro2400 EXT
|
||||
generic EXT
|
||||
epic EXT
|
||||
|
||||
re_mdm ENT
|
||||
BIT init
|
||||
BMI :re_mdmx
|
||||
|
||||
LDX #<start ; setup esc handler
|
||||
LDA #>start
|
||||
JSR escape
|
||||
JMP :re_mdm0
|
||||
|
||||
:re_mdmx LDX #<do_init
|
||||
LDA #>do_init ; setup aux esc handler
|
||||
JSR escape
|
||||
|
||||
:re_mdm0 LDA #1 ; set input length at 1
|
||||
STA maxlen
|
||||
LDA #%10010000
|
||||
STA inpmode
|
||||
|
||||
:re_mdm3 JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,26
|
||||
ASC '- Reconfigure Modem Driver -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix A of your user'
|
||||
ASC ' manual for more information.'00
|
||||
|
||||
JSR cls
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC ' 1 - No Modem/Local mode '
|
||||
ASC ' External Modem Drivers'0D0D
|
||||
ASC ' Internal Modem Drivers '
|
||||
ASC ' 8 - Super Serial Card driver'0D
|
||||
ASC ' '
|
||||
ASC ' 9 - Apple IIgs Serial Port driver'0D
|
||||
ASC ' 2 - Apple-Cat 103 - 300 baud '
|
||||
ASC '10 - Single Speed SSC driver'0D
|
||||
ASC ' 3 - Apple-Cat 212 - 300/1200 baud '
|
||||
ASC '11 - Multiple Speed SSC driver'0D
|
||||
ASC ' 4 - DC Hayes Micromodem II '
|
||||
ASC '12 - No Carrier SSC driver'0D
|
||||
ASC ' 5 - SSM Modemcard 300'0D
|
||||
ASC ' 6 - Zoom Modem IIe'0D
|
||||
ASC ' 7 - Epic 2400 Classic II'0D0D
|
||||
ASC 'Which? [1-12] '00
|
||||
|
||||
LDX #12 ; get serial device
|
||||
JSR inpnum
|
||||
STA serialtype ;save the device type
|
||||
|
||||
ASL ;point0 points to the
|
||||
TAX ;serial device driver
|
||||
LDA devtable,X
|
||||
STA point0
|
||||
INX
|
||||
LDA devtable,X
|
||||
STA point0+1
|
||||
|
||||
LDA #<mdmdrv ;tell it to move the modem
|
||||
STA point1 ;driver
|
||||
LDA #>mdmdrv
|
||||
STA point1+1
|
||||
|
||||
LDA #12 ;default is generic
|
||||
ASL ;point init string to the
|
||||
TAX ;right place
|
||||
LDA strtable,X
|
||||
STA point3
|
||||
INX
|
||||
LDA strtable,X
|
||||
STA point3+1
|
||||
|
||||
LDA serialtype ;is it internal?
|
||||
CMP #8
|
||||
BCS getinit ;nope, get an init string
|
||||
CMP #7 ;was it the Epic internal?
|
||||
BEQ :epic24 ;yes, set for epic string
|
||||
CMP #1 ;nullmodem?
|
||||
BNE :internal ;nope, just internal
|
||||
PHA ;push garbage data
|
||||
PHA
|
||||
JMP movepage ;move & fix into place
|
||||
|
||||
:internal JMP getslot ;must have been internal, skip next
|
||||
|
||||
:epic24 LDA #1 ;default for epic is &s1&d2
|
||||
ASL ;point init string to the
|
||||
TAX ;right place
|
||||
LDA strtable,X
|
||||
STA point3
|
||||
INX
|
||||
LDA strtable,X
|
||||
STA point3+1
|
||||
JMP setinit
|
||||
|
||||
*-------------------------------
|
||||
* get the init string for the modem
|
||||
|
||||
getinit JSR cls
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC 'Choose Modem:'0D0D
|
||||
ASC ' 1 - Epic 2400 Plus'0D
|
||||
ASC ' 2 - USRobotics Courier 2400'0D
|
||||
ASC ' 3 - USRobotics Courier HST'0D
|
||||
ASC ' 4 - CTS 2424'0D
|
||||
ASC ' 5 - Apple Modem 1200'0D
|
||||
ASC ' 6 - Prometheus Promodem 1200'0D
|
||||
ASC ' 7 - Prometheus Promodem 2400'0D
|
||||
ASC ' 8 - Novation SmartCat'0D
|
||||
ASC ' 9 - Novation Professional 2400'0D
|
||||
ASC '10 - Hayes 1200'0D
|
||||
ASC '11 - Hayes 2400'0D
|
||||
ASC !12 -
|
||||
ASC 'Which? [1-12] '00
|
||||
|
||||
LDX #12
|
||||
JSR inpnum
|
||||
STA modemtype
|
||||
|
||||
ASL ;point init string to the
|
||||
TAX ;right place
|
||||
LDA strtable,X
|
||||
STA point3
|
||||
INX
|
||||
LDA strtable,X
|
||||
STA point3+1
|
||||
|
||||
*-------------------------------
|
||||
|
||||
setinit JSR cls
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC 'The initialization string for this modem is: '0D0D00
|
||||
|
||||
LDY #0
|
||||
:loop LDA (point3),Y
|
||||
STA initbuf,Y
|
||||
BEQ :done
|
||||
JSR cout
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
:done JSR print
|
||||
HEX 0D
|
||||
ASC 'Press [RETURN] to accept this as'
|
||||
ASC ' default, or enter a new init string.'0D
|
||||
ASC ':'00
|
||||
|
||||
LDA #39 ; only allow 39 chars
|
||||
STA maxlen
|
||||
LDA #%10100000
|
||||
STA inpmode ;ascii
|
||||
JSR inpln ; get the input
|
||||
LDY lnbuf
|
||||
CPY #cr
|
||||
BEQ getans ; use default
|
||||
|
||||
LDY #-1
|
||||
:loop2 INY ;move the typed init string
|
||||
LDA lnbuf,Y
|
||||
STA initbuf,Y
|
||||
CMP #cr
|
||||
BNE :loop2
|
||||
|
||||
INY
|
||||
LDA #0
|
||||
STA initbuf,Y
|
||||
|
||||
*-------------------------------
|
||||
* get the answer string
|
||||
|
||||
getans JSR cls
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC 'The default answer string for this modem is: '0D0D00
|
||||
|
||||
LDY #0
|
||||
:loop LDA atastr,Y
|
||||
STA ansbuf,Y
|
||||
BEQ :done
|
||||
JSR cout
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
:done JSR print
|
||||
HEX 0D
|
||||
ASC 'Press [RETURN] to accept this,'
|
||||
ASC ' or enter a new answer string.'0D
|
||||
ASC ':'00
|
||||
|
||||
LDA #15 ; only allow 15 chars
|
||||
STA maxlen
|
||||
JSR inpln ; get the input
|
||||
LDY lnbuf
|
||||
CPY #cr
|
||||
BEQ getdcd ; use default
|
||||
|
||||
LDY #-1
|
||||
:loop2 INY ;move the typed answer string
|
||||
LDA lnbuf,Y
|
||||
STA ansbuf,Y
|
||||
CMP #cr
|
||||
BNE :loop2
|
||||
|
||||
INY
|
||||
LDA #0
|
||||
STA ansbuf,Y
|
||||
|
||||
*-------------------------------
|
||||
* get the dcd drop type
|
||||
|
||||
getdcd JSR print
|
||||
HEX 0D0D
|
||||
ASC 'What type of carrier detect should the'
|
||||
ASC ' driver use?'0D0D
|
||||
ASC ' 1 - DSR Carrier Detect [Normal]'0D
|
||||
ASC ' 2 - DCD Carrier Detect'0D0D
|
||||
ASC 'Which? [1-2] '00
|
||||
|
||||
LDX #2
|
||||
JSR inpnum
|
||||
STA cdtype
|
||||
|
||||
*-------------------------------
|
||||
* get the proper slot
|
||||
|
||||
getslot JSR cls
|
||||
LDA serialtype
|
||||
CMP #9
|
||||
BEQ :gsport
|
||||
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC 'Which slot should the modem driver use? [1-7] '00
|
||||
LDX #7
|
||||
JMP :over
|
||||
|
||||
:gsport JSR print
|
||||
DB 1,7,0
|
||||
ASC 'Which Serial Port? [1-2] '00
|
||||
|
||||
LDX #2
|
||||
:over JSR inpnum
|
||||
PHA
|
||||
|
||||
LDX serialtype
|
||||
cpx #9 ;was it the IIgs serial port?
|
||||
BNE :notgsport ;nope
|
||||
|
||||
CMP #1 ;was it port #1?
|
||||
BNE :port2 ;nope, must be port 2
|
||||
|
||||
LDA #<gsport1 ;move gs port, slot 1
|
||||
STA point0
|
||||
LDA #>gsport1
|
||||
STA point0+1
|
||||
JMP :notgsport
|
||||
|
||||
:port2 LDA #<gsport2 ;move gs port slot 2
|
||||
STA point0
|
||||
LDA #>gsport2
|
||||
STA point0+1
|
||||
|
||||
:notgsport LDA serialtype ;was it an internal?
|
||||
CMP #7
|
||||
BCS :external ;no, init baud needed
|
||||
JMP :internal ;yes, init spd not needed
|
||||
|
||||
:external JSR print
|
||||
DB 1,10,0
|
||||
ASC 'At what baud rate should the port/card be initialized?'0D
|
||||
ASC '(Choose the maximum baud rate of your modem)'0D0D
|
||||
ASC ' 1 - 300 baud'0D
|
||||
ASC ' 2 - 1200 baud'0D
|
||||
ASC ' 3 - 2400 baud'0D
|
||||
ASC ' 4 - 4800 baud'0D
|
||||
ASC ' 5 - 9600 baud'0D
|
||||
ASC ' 6 - 19200 baud'0D0D
|
||||
ASC 'Which? [1-6] '00
|
||||
|
||||
LDX #6
|
||||
JSR inpnum
|
||||
:internal PHA
|
||||
|
||||
movepage LDX #3 ;move 3 illustrious pages
|
||||
:loop2 LDY #0
|
||||
:loop LDA (point0),Y ;source
|
||||
STA (point1),Y ;destination
|
||||
INY
|
||||
BNE :loop
|
||||
INC point0+1
|
||||
INC point1+1
|
||||
DEX
|
||||
BNE :loop2
|
||||
|
||||
LDA mdmdrv
|
||||
STA point1+1
|
||||
LDY #1
|
||||
PLX ;get init speed
|
||||
DEX ;one less
|
||||
TXA
|
||||
STA (point1),Y ;save it
|
||||
|
||||
dey
|
||||
PLA ;get the slot
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
ASL ;a := a*16
|
||||
STA (point1) ;store the slot
|
||||
|
||||
DEC cdtype
|
||||
LDA serialtype
|
||||
CMP #9 ;was it the gs?
|
||||
BNE :notgs ;nope, go there, SSC
|
||||
|
||||
LDA cdtype ;get drop type
|
||||
BNE :notgsdsr ;dcd wanted, so stick it
|
||||
LDA #$20 ;else use dsr drop
|
||||
STA cdbyte
|
||||
BNE copyans
|
||||
|
||||
:notgsdsr LDA #$08 ;setup for dcd drop
|
||||
STA cdbyte
|
||||
BNE copyans
|
||||
|
||||
:notgs LDA cdtype ;ssc
|
||||
BNE :notdsr ;dcd drop wanted, go there
|
||||
LDA #%01000000 ;check only dsr (normal)
|
||||
STA cdbyte
|
||||
BNE copyans
|
||||
|
||||
:notdsr LDA #%00100000 ;otherwise check DCD
|
||||
STA cdbyte
|
||||
|
||||
*-------------------------------
|
||||
|
||||
copyans LDY #0
|
||||
:loop LDA ansbuf,Y ;copy the answer string
|
||||
STA ansstr,Y
|
||||
BEQ copyinit
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
copyinit LDY #0 ;copy the init string
|
||||
:loop LDA initbuf,Y
|
||||
STA initstr,Y
|
||||
BEQ :writeit
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
:writeit JSR chinit ; check for init
|
||||
JMP wrtchg ; write the changes
|
||||
|
||||
cdtype DB 0
|
||||
modemtype DB 0
|
||||
serialtype DB 0
|
||||
|
||||
*-------------------------------
|
||||
* modem drivers
|
||||
|
||||
devtable DA 0 ;extra for offset 0
|
||||
DA nullmdm ;null modem driver
|
||||
DA cat103 ;300 baud cat driver
|
||||
DA cat212 ;1200 baud cat driver
|
||||
DA mm2 ;micromodem II driver
|
||||
DA mm2 ;SSM modemcard
|
||||
DA mm2 ;networker
|
||||
DA ssc ;epic 2400 classic
|
||||
DA ssc ;super serial driver
|
||||
DA gsport2 ;location for gs port driver
|
||||
DA singlespd ;single speed driver
|
||||
DA multispd ;multi-speed <return> driver
|
||||
DA nocar ;no carrier 300 baud driver
|
||||
|
||||
strtable DA 0
|
||||
DA epic
|
||||
DA usr2400
|
||||
DA usr9600
|
||||
DA cts
|
||||
DA apl1200
|
||||
DA usr2400
|
||||
DA usr2400
|
||||
DA usr2400
|
||||
DA pro2400
|
||||
DA hayes1200
|
||||
DA hayes2400
|
||||
DA generic
|
||||
|
||||
atastr ASC 'ATA'0D00
|
||||
|
||||
|
|
@ -0,0 +1,270 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*--------------------------
|
||||
* Internal - Apple Cat 103
|
||||
*--------------------------
|
||||
* Date 3/18/88 - AEN
|
||||
*--------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/cat103
|
||||
|
||||
swbyt EQU $c080
|
||||
shbyt EQU $c082
|
||||
indata EQU $c08b
|
||||
spdbyt EQU $c08b
|
||||
acbyte EQU $c08d
|
||||
xmtbyt EQU $c08d
|
||||
outdat EQU $c08e
|
||||
status1 EQU $c08f
|
||||
|
||||
cat103 ent
|
||||
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
slot dfb $20 ;serial card slot
|
||||
initspd dfb 0 ;initialize speed
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
JMP init
|
||||
JMP ringset
|
||||
JMP ring
|
||||
JMP answer
|
||||
JMP hangup
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
rts ;raise dtr
|
||||
|
||||
*-------------------------------
|
||||
* init the modem card
|
||||
|
||||
init SEI
|
||||
LDX slot ;get slot offset
|
||||
LDY #0
|
||||
init2 LDA initbyt,y ;init all 16 bytes
|
||||
STA $c080,x
|
||||
INX
|
||||
INY
|
||||
CPY #$10
|
||||
BNE init2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup for the call
|
||||
|
||||
ringset LDA #0 ;reset time-on
|
||||
STA bytcnt
|
||||
STA bytcnt+1
|
||||
STA bytcnt+2
|
||||
STA carwait ;reset wait flag
|
||||
TAY set ;300 baud
|
||||
JMP setspd
|
||||
|
||||
*-------------------------------
|
||||
* scan for the ring and handle it
|
||||
|
||||
ring LDX slot ;get offset
|
||||
BIT carwait ;do they want manual-answer?
|
||||
BMI ring2a ;yep
|
||||
|
||||
LDA acbyte,x
|
||||
AND #%00000001
|
||||
BEQ ring4 ;nothing
|
||||
|
||||
ring2 LDA acbyte,x ;wait for ring to clear
|
||||
AND #%00000001
|
||||
BNE ring2
|
||||
|
||||
ring2a LDA #%00000010 ;pick up phone
|
||||
STA shbyt,x
|
||||
|
||||
LDA #80 ;setup carrier wait time
|
||||
STA carwait
|
||||
|
||||
LDA #60 ;wait for things to settle
|
||||
JSR wait
|
||||
|
||||
ring3 LDA #0 ;do big wait...
|
||||
JSR wait
|
||||
|
||||
LDA swbyt,x ;do we have carrier?
|
||||
AND #%00100000
|
||||
BNE ring5 ;yep
|
||||
|
||||
DEC carwait ;loop until count is done
|
||||
BNE ring3
|
||||
|
||||
JSR hangup
|
||||
ring4 CLC ;nothing happened
|
||||
RTS
|
||||
|
||||
ring5 LDA #-1 ;reset carrier timing
|
||||
STA carwait
|
||||
SEC
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* send ata
|
||||
|
||||
answer LDA #-1 ;signal we want manual-answer
|
||||
STA carwait
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* hangup phone
|
||||
|
||||
hangup LDX slot ;get offset
|
||||
LDA #0
|
||||
STA shbyt,x ;hang up phone
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* input data
|
||||
|
||||
inp STX save_x ;save X
|
||||
LDX slot ;get offset
|
||||
LDA status1,x ;get status
|
||||
AND #%00001000
|
||||
CLC
|
||||
BEQ inp2 ;no data
|
||||
|
||||
LDA #$20 ;reset char ready byte
|
||||
STA xmtbyt,x
|
||||
|
||||
LDA indata,x ;get data
|
||||
SEC
|
||||
inp2 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output data
|
||||
|
||||
out STX save_x ;save x
|
||||
DEC timecnt ;count down bytes per second
|
||||
BNE out1 ;not a seconds worth yet
|
||||
|
||||
PHA
|
||||
LDA callspd ;reset counter
|
||||
ASL
|
||||
ASL
|
||||
ASL ;time count = base.rate * 32
|
||||
ASL
|
||||
ASL
|
||||
STA timecnt
|
||||
PLA
|
||||
|
||||
INC bytcnt ;seconds - at 64 yet?
|
||||
BIT bytcnt
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset seconds
|
||||
STX bytcnt
|
||||
|
||||
INC bytcnt+1 ;minutes - at 64 yet?
|
||||
BIT bytcnt+1
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset minutes
|
||||
STX bytcnt+1
|
||||
|
||||
INC bytcnt+2 ;inc hours
|
||||
|
||||
out1 LDX slot
|
||||
|
||||
PHA
|
||||
out2 LDA status1,x ;check status
|
||||
AND #%00010000
|
||||
BEQ out2 ;loop until ready
|
||||
PLA
|
||||
|
||||
STA outdat,x ;output byte
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* check for carrier
|
||||
|
||||
chkdcd STX save_x ;dont kill any reg's
|
||||
PHA
|
||||
|
||||
LDA carwait ;do we have carrier?
|
||||
BEQ chkdcd3 ;nope
|
||||
|
||||
LDX slot
|
||||
LDA swbyt,x ;check carrier
|
||||
AND #%00100000
|
||||
BEQ chkdcd2 ;no carrier
|
||||
|
||||
LDA #-1 ;buffer carrier detect
|
||||
STA carwait
|
||||
SEC
|
||||
BCS chkdcd4 ;use return routine
|
||||
|
||||
chkdcd2 DEC carwait ;count down
|
||||
chkdcd3 CLC
|
||||
chkdcd4 PLA ;restore all & return
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the rs232 speed
|
||||
|
||||
setspd STX save_x
|
||||
LDX slot ;get offset
|
||||
LDA speed,y ;get speed
|
||||
STA spdbyt,x ;set speed
|
||||
|
||||
LDA #1 ;find caller speed (x300)
|
||||
STA callspd
|
||||
CPY #0 ;at 300?
|
||||
BEQ setspd3 ;yep
|
||||
|
||||
ASL callspd ;speed = speed * 2
|
||||
setspd2 ASL callspd ;speed = speed * 2
|
||||
DEY
|
||||
BNE setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* wait routine
|
||||
|
||||
wait SEC ;from apple [+ ref man - pg 147]
|
||||
wait2 PHA
|
||||
wait3 SBC #1
|
||||
BNE wait3
|
||||
PLA
|
||||
SBC #1
|
||||
BNE wait2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* variables
|
||||
|
||||
speed dfb %00100010,%00000000 ;handle 300, 1200
|
||||
|
||||
save_x dfb 0
|
||||
|
||||
timecnt dfb 0
|
||||
carwait dfb 0
|
||||
|
||||
initbyt dfb $00,$81,$00,$06,$00,$80,$00,$06
|
||||
dfb $00,$64,$07,$22,$05,$10,$00,$00
|
||||
|
||||
asc 'Cat103'
|
||||
|
||||
|
|
@ -0,0 +1,321 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*--------------------------
|
||||
* Internal - Apple Cat 212
|
||||
*--------------------------
|
||||
* Date 12/09/86
|
||||
*--------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/cat212
|
||||
|
||||
swbyt EQU $c080
|
||||
byt212 EQU $c080
|
||||
squbyt EQU $c081
|
||||
shbyt EQU $c082
|
||||
indata EQU $c08b
|
||||
spdbyt EQU $c08b
|
||||
acbyte EQU $c08d
|
||||
xmtbyt EQU $c08d
|
||||
outdat EQU $c08e
|
||||
status1 EQU $c08f
|
||||
devbyt EQU $c08f
|
||||
|
||||
cat212 ent
|
||||
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
slot dfb $20 ;serial card slot
|
||||
initspd dfb 0 ;initialize speed
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
JMP init
|
||||
JMP ringset
|
||||
JMP ring
|
||||
JMP answer
|
||||
JMP hangup
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
rts ;raise dtr
|
||||
|
||||
*-------------------------------
|
||||
* init the modem card
|
||||
|
||||
init SEI
|
||||
LDX slot ;get slot offset
|
||||
LDY #0
|
||||
init2 LDA initbyt,y ;init all 16 bytes
|
||||
STA $c080,x
|
||||
INX
|
||||
INY
|
||||
CPY #$10
|
||||
BNE init2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup for call
|
||||
|
||||
ringset LDA #0 ;reset time-on
|
||||
STA bytcnt
|
||||
STA bytcnt+1
|
||||
STA bytcnt+2
|
||||
STA carwait ;reset wait flag
|
||||
TAY ;set 300 baud
|
||||
JMP setspd
|
||||
|
||||
*-------------------------------
|
||||
* scan for ring and handle it
|
||||
|
||||
ring LDX slot ;get offset
|
||||
BIT carwait ;do they want manual-answer?
|
||||
BMI ring2a ;yep
|
||||
|
||||
LDA acbyte,x
|
||||
AND #%00000001
|
||||
BEQ ring4 ;nothing
|
||||
|
||||
ring2 LDA acbyte,x ;wait for ring to clear
|
||||
AND #%00000001
|
||||
BNE ring2
|
||||
|
||||
ring2a LDA #%00000010 ;pick up phone
|
||||
STA shbyt,x
|
||||
|
||||
LDA #80 ;setup carrier wait time
|
||||
STA carwait
|
||||
|
||||
LDA #%10000001 ;disable 212 mode
|
||||
STA squbyt,x
|
||||
|
||||
LDA #128 ;wait
|
||||
JSR wait
|
||||
|
||||
LDA #%00000001 ;enable 212 mode
|
||||
STA squbyt,x
|
||||
|
||||
LDA #60 ;wait for things to settle
|
||||
JSR wait
|
||||
|
||||
ring3 LDA #0 ;do big wait...
|
||||
JSR wait
|
||||
|
||||
LDA swbyt,x ;do we have carrier?
|
||||
AND #%00100000
|
||||
BNE ring5 ;yep
|
||||
|
||||
LDA acbyte,x ;do we have 212 carrier
|
||||
AND #%00000100
|
||||
BNE ring6 ;yep
|
||||
|
||||
DEC carwait ;loop until count is done
|
||||
BNE ring3
|
||||
|
||||
JSR hangup
|
||||
ring4 CLC ;nothing happened
|
||||
RTS
|
||||
|
||||
ring5 LDA #%00010000 ;reset xmtbyt
|
||||
STA xmtbyt,x
|
||||
STA xmtdata
|
||||
LDA #%10000001 ;disable 212 card
|
||||
STA squbyt,x
|
||||
LDA #%00000000 ;send uart to 103 board
|
||||
STA devbyt,x
|
||||
JMP ring7 ;finish connect
|
||||
|
||||
ring6 LDA #%00000101 ;reset 212 card
|
||||
STA byt212,x
|
||||
LDA #%00000001 ;re-enable 212 card
|
||||
STA squbyt,x
|
||||
LDA #%00001010 ;send uart to 212 card
|
||||
STA devbyt,x
|
||||
LDA #%00011111 ;reset xmtbyt
|
||||
STA xmtbyt,x
|
||||
STA xmtdata
|
||||
LDY #1 ;set speed to 1200
|
||||
JSR setspd
|
||||
|
||||
ring7 LDA #-1 ;reset carrier timing
|
||||
STA carwait
|
||||
SEC
|
||||
LDA #0 ;do delay last
|
||||
JMP wait
|
||||
|
||||
*-------------------------------
|
||||
* send ata
|
||||
|
||||
answer LDA #-1 ;signal we want manual-answer
|
||||
STA carwait
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* hangup phone
|
||||
|
||||
hangup LDX slot ;get offset
|
||||
LDA #%00011111
|
||||
STA xmtbyt,x ;turn off 103 carrier
|
||||
LDA #%10000001
|
||||
STA squbyt,x ;turn off 212 carrier
|
||||
LDA #0
|
||||
STA shbyt,x ;hang up phone
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* input data
|
||||
|
||||
inp STX save_x ;save X
|
||||
LDX slot ;get offset
|
||||
LDA status1,x ;get status
|
||||
AND #%00001000
|
||||
CLC
|
||||
BEQ inp2 ;no data
|
||||
|
||||
LDA xmtdata ;reset char ready byte
|
||||
STA xmtbyt,x
|
||||
|
||||
LDA indata,x ;get data
|
||||
SEC
|
||||
inp2 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output data
|
||||
|
||||
out STX save_x ;save x
|
||||
DEC timecnt ;count down bytes per second
|
||||
BNE out1 ;not a seconds worth yet
|
||||
|
||||
PHA
|
||||
LDA callspd ;reset counter
|
||||
ASL
|
||||
ASL
|
||||
ASL ;time count = base.rate * 32
|
||||
ASL
|
||||
ASL
|
||||
STA timecnt
|
||||
PLA
|
||||
|
||||
INC bytcnt ;seconds - at 64 yet?
|
||||
BIT bytcnt
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset seconds
|
||||
STX bytcnt
|
||||
|
||||
INC bytcnt+1 ;minutes - at 64 yet?
|
||||
BIT bytcnt+1
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset minutes
|
||||
STX bytcnt+1
|
||||
|
||||
INC bytcnt+2 ;inc hours
|
||||
|
||||
out1 LDX slot
|
||||
|
||||
PHA
|
||||
out2 LDA status1,x ;check status
|
||||
AND #%00010000
|
||||
BEQ out2 ;loop until ready
|
||||
PLA
|
||||
|
||||
STA outdat,x ;output byte
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* check for carrier
|
||||
|
||||
chkdcd STX save_x ;dont kill any reg's
|
||||
PHA
|
||||
|
||||
LDA carwait ;do we have carrier?
|
||||
BEQ chkdcd3 ;nope
|
||||
|
||||
LDX slot
|
||||
LDA callspd ;check calling speed
|
||||
CMP #4 ;at 1200 baud?
|
||||
BEQ dcd212 ;yep
|
||||
|
||||
LDA swbyt,x ;check carrier
|
||||
AND #%00100000
|
||||
BEQ chkdcd2 ;no carrier
|
||||
|
||||
chkdcd1 LDA #-1 ;buffer carrier detect
|
||||
STA carwait
|
||||
SEC
|
||||
BCS chkdcd4 ;use return routine
|
||||
|
||||
dcd212 LDA acbyte,x ;check 212 carrier
|
||||
AND #%00000100
|
||||
BNE chkdcd1 ;all is well
|
||||
|
||||
chkdcd2 DEC carwait ;count down
|
||||
chkdcd3 CLC
|
||||
chkdcd4 PLA ;restore all & return
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the rs232 speed
|
||||
|
||||
setspd STX save_x
|
||||
LDX slot ;get offset
|
||||
LDA speed,y ;get speed
|
||||
STA spdbyt,x ;set speed
|
||||
|
||||
LDA #1 ;find caller speed (x300)
|
||||
STA callspd
|
||||
CPY #0 ;at 300?
|
||||
BEQ setspd3 ;yep
|
||||
|
||||
ASL callspd ;speed = speed * 2
|
||||
setspd2 ASL callspd ;speed = speed * 2
|
||||
DEY
|
||||
BNE setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
|
||||
*-------------------------------
|
||||
* wait routine
|
||||
|
||||
wait SEC ;from apple ][+ ref man - pg 147
|
||||
wait2 PHA
|
||||
wait3 SBC #1
|
||||
BNE wait3
|
||||
PLA
|
||||
SBC #1
|
||||
BNE wait2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
speed dfb %00100010,%00000000 ;handle 300, 1200
|
||||
|
||||
save_x dfb 0
|
||||
|
||||
timecnt dfb 0
|
||||
carwait dfb 0
|
||||
xmtdata dfb 0
|
||||
|
||||
initbyt dfb $04,$81,$00,$06,$04,$80,$00,$06
|
||||
dfb $00,$64,$07,$22,$05,$1f,$00,$00
|
||||
|
||||
asc 'Cat212'
|
||||
|
||||
|
|
@ -0,0 +1,338 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* USRobotics 2400 driver written by Andy Nicholas
|
||||
* January 19, 1988
|
||||
*-------------------------------
|
||||
|
||||
dsk epic.dvr
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ssc ent
|
||||
|
||||
org $e00
|
||||
|
||||
* jump table
|
||||
*-------------------------------
|
||||
|
||||
slot hex 20 ;serial card slot*16
|
||||
hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answer
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
* init the serial card
|
||||
*-------------------------------
|
||||
|
||||
init lda #0 ;reset bytes
|
||||
ldx slot
|
||||
sta status,x ;reset uart
|
||||
sta command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset ldx slot ;get offset
|
||||
|
||||
lda #%00000000 ;kill DTR, RTS
|
||||
sta command,x
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
|
||||
sei
|
||||
|
||||
ldy #2 ;set init speed (2400)
|
||||
jsr setspd
|
||||
|
||||
lda data,x ;clear data strobe
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
:loop lda #$80
|
||||
jsr wait
|
||||
lda Initstr,x ;get modem init string
|
||||
beq rset3
|
||||
jsr out ;output
|
||||
inx
|
||||
bne :loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts return
|
||||
|
||||
jring jmp ringset ;extend branch to ringset
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc ring5 ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'E'
|
||||
clc
|
||||
bne ring5 ;keep checking
|
||||
|
||||
ring2 jsr inp ;check for char
|
||||
bcc ring2
|
||||
|
||||
ldy #0 ;def = 300 baud
|
||||
and #$7f ;strip high
|
||||
|
||||
cmp #'R' ;oops, "No Carrier" message
|
||||
beq jring
|
||||
|
||||
cmp #cr ;connect 300
|
||||
beq ring3
|
||||
|
||||
cmp #'3' ;connect 300
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;connect 1200
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;connect 2400
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;connect 4800
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'9' ;connect 9600
|
||||
bne ring2
|
||||
|
||||
ring3 jsr setspd ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec ;we have a connection!
|
||||
ring5 rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #0
|
||||
answer2 lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
|
||||
inx
|
||||
bne answer2 ;loop
|
||||
|
||||
answer3 rts
|
||||
|
||||
* hangup phone
|
||||
*-------------------------------
|
||||
|
||||
hangup ldx slot ;get offset
|
||||
lda #0
|
||||
sta command,x ;hang up phone
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp stx save_x ;save X
|
||||
ldx slot ;get offset
|
||||
lda status,x ;get status
|
||||
and #%00001000
|
||||
clc
|
||||
beq inp2 ;no data
|
||||
|
||||
lda data,x
|
||||
sec
|
||||
inp2 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out stx save_x ;save x
|
||||
dec timecnt ;count down 1 section
|
||||
bne out1
|
||||
|
||||
inc bytcnt ;1 second gone by
|
||||
bit bytcnt
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset seconds
|
||||
stx bytcnt
|
||||
|
||||
inc bytcnt+1 ;1 minute gone by
|
||||
bit bytcnt+1
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset minutes
|
||||
stx bytcnt+1
|
||||
|
||||
inc bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 ldx slot
|
||||
|
||||
pha
|
||||
out2 lda status,x ;check status
|
||||
and #%00010000
|
||||
beq out2 ;loop until ready
|
||||
pla
|
||||
|
||||
dataloc sta data ;output byte
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* check for carrier
|
||||
*-------------------------------
|
||||
|
||||
chkdcd stx save_x ;dont kill any reg's
|
||||
pha
|
||||
|
||||
ldx slot ;get offset
|
||||
lda status,x
|
||||
and cdbyte ;check carrier
|
||||
clc
|
||||
bne chkdcd2
|
||||
|
||||
sec
|
||||
chkdcd2 pla restore ;all & return
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* set the rs-232 speed/speed in Y reg
|
||||
*-------------------------------
|
||||
|
||||
setspd stx save_x
|
||||
ldx slot ;get offset
|
||||
lda speed,y ;get speed
|
||||
sta control,x ;set speed
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq setspd3 ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspd2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
save_x dfb 0
|
||||
countlo dfb $FF
|
||||
counthi dfb $FF
|
||||
cdbyte db $40 ;mask dsr only (0=connected)
|
||||
|
||||
initstr asc 'ATS0=1S2=128&S1&D2',0d,00
|
||||
ansstr asc 'ATA',0d,00
|
||||
|
||||
|
|
@ -0,0 +1,446 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #1
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/gsport1
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
gsport1 ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 10 ;serial card slot * 16
|
||||
initspd hex 00 ;init speed for modem
|
||||
|
||||
callspd dfb 0 speed
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answer
|
||||
jmp hangup
|
||||
jmp inp ;get a byte
|
||||
jmp out ;send a byte
|
||||
jmp getcarr ;caller there?
|
||||
jmp setspeed ;speed of port
|
||||
jmp raisedtr ;raise dtr
|
||||
|
||||
doinit jmp $c100
|
||||
doread jmp $c100
|
||||
dowrite jmp $c100
|
||||
dostatus jmp $c100
|
||||
doext jmp $c100
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c10d ;get init address
|
||||
sta doinit+1
|
||||
lda $c10e ;get read address
|
||||
sta doread+1
|
||||
lda $c10f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c110 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c112
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c1 ;are we ready?
|
||||
ldy #$10
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c1 ;yes, read
|
||||
ldy #$10
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx restore ;& return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx save ;x
|
||||
phy save ;y
|
||||
pha save ;a
|
||||
|
||||
out1 ldx #$c1 ;ready for send?
|
||||
ldy #$10
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c1
|
||||
ldy #$10
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* init modem for ring
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc ring5 ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'E'
|
||||
clc
|
||||
bne ring5 ;keep checking
|
||||
|
||||
ring2 jsr inp ;check for char
|
||||
bcc ring2
|
||||
|
||||
ldy #0 ;def = 300 baud
|
||||
and #$7f ;strip high
|
||||
|
||||
cmp #'R' ;oops, "No Carrier" message
|
||||
beq ringset
|
||||
|
||||
cmp #cr ;connect 300
|
||||
beq ring3
|
||||
|
||||
cmp #'3' ;connect 300
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;connect 1200
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;connect 2400
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;connect 4800
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'9' ;connect 9600
|
||||
bne ring2
|
||||
|
||||
ring3 jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec we ;have a connection!
|
||||
ring5 rts
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
phy
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq Do_Baud ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
|
||||
Do_Baud pla get ;y-reg
|
||||
bne Try1200
|
||||
lda #<Baud300
|
||||
sta Baudread+1
|
||||
lda #>Baud300
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try1200 cmp #1
|
||||
bne Try2400
|
||||
lda #<Baud1200
|
||||
sta Baudread+1
|
||||
lda #>Baud1200
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try2400 cmp #2
|
||||
bne Try4800
|
||||
lda #<Baud2400
|
||||
sta Baudread+1
|
||||
lda #>Baud2400
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try4800 cmp #3
|
||||
bne Try9600
|
||||
lda #<Baud4800
|
||||
sta Baudread+1
|
||||
lda #>Baud4800
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try9600 lda #<Baud9600
|
||||
sta Baudread+1
|
||||
lda #>Baud9600
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c1
|
||||
ldy #$10
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* Table of Speeds and other important stuff
|
||||
*-------------------------------
|
||||
|
||||
Buffer equ $1080
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
|
||||
Port_Init ;
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
asc 'GSPort1'
|
||||
|
||||
|
|
@ -0,0 +1,451 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/gsport2
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answer
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c2 ;are we ready?
|
||||
ldy #$20
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c2 ;yes, read
|
||||
ldy #$20
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx restore ;& return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
out1 ldx #$c2 ;ready for send?
|
||||
ldy #$20
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc ring5 ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'E'
|
||||
clc
|
||||
bne ring5 ;keep checking
|
||||
|
||||
ring2 jsr inp ;check for char
|
||||
bcc ring2
|
||||
|
||||
ldy #0 ;def = 300 baud
|
||||
and #$7f ;strip high
|
||||
|
||||
cmp #'R' ;oops, "No Carrier" message
|
||||
beq ringset
|
||||
|
||||
cmp #cr ;connect 300
|
||||
beq ring3
|
||||
|
||||
cmp #'3' ;connect 300
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;connect 1200
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;connect 2400
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;connect 4800
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'9' ;connect 9600
|
||||
bne ring2
|
||||
|
||||
ring3 jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec we ;have a connection!
|
||||
ring5 rts
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
phy
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq Do_Baud ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
|
||||
Do_Baud pla get ;y-reg
|
||||
bne Try1200
|
||||
lda #<Baud300
|
||||
sta Baudread+1
|
||||
lda #>Baud300
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try1200 cmp #1
|
||||
bne Try2400
|
||||
lda #<Baud1200
|
||||
sta Baudread+1
|
||||
lda #>Baud1200
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try2400 cmp #2
|
||||
bne Try4800
|
||||
lda #<Baud2400
|
||||
sta Baudread+1
|
||||
lda #>Baud2400
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try4800 cmp #3
|
||||
bne Try9600
|
||||
lda #<Baud4800
|
||||
sta Baudread+1
|
||||
lda #>Baud4800
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try9600 lda #<Baud9600
|
||||
sta Baudread+1
|
||||
lda #>Baud9600
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c2
|
||||
ldy #$20
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
Buffer equ $1080
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14b'
|
||||
hex 00 ;accept 9600 Baud
|
||||
|
||||
Port_Init ;
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
asc 'GSPort2'
|
||||
|
||||
|
|
@ -0,0 +1,396 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*
|
||||
* Special version for the USR HST & 19200 Baud
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/gsport.hst
|
||||
org $b00
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
Buffer equ $10b0
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport_hst ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd db 00
|
||||
|
||||
callspd dfb 0 speed
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answer
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp initport
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
jsr initport
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 ldy #250 ;check 50 times
|
||||
rset4 dey count ;down
|
||||
beq ringset
|
||||
|
||||
lda #30 ;delay slightly
|
||||
jsr wait
|
||||
jsr inp
|
||||
bcc rset4
|
||||
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
bne rset4
|
||||
|
||||
clc
|
||||
rts return
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc ring5 ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'E'
|
||||
clc
|
||||
bne ring5 ;keep checking
|
||||
|
||||
ring2 jsr inp ;check for char
|
||||
bcc ring2
|
||||
|
||||
ldy #0 ;def = 300 baud
|
||||
and #$7f ;strip high
|
||||
|
||||
cmp #'R' ;oops, "No Carrier" message
|
||||
beq ringset
|
||||
|
||||
cmp #cr ;connect 300
|
||||
beq ring3
|
||||
|
||||
cmp #'3' ;connect 300
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;connect 1200
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;connect 2400
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;connect 4800
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'9' ;connect 9600
|
||||
bne ring2
|
||||
|
||||
ring3 jsr setbyte ;set the correct speed byte
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec we ;have a connection!
|
||||
ring5 rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c2 ;are we ready?
|
||||
ldy #$20
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c2 ;yes, read
|
||||
ldy #$20
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx restore ;& return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx save ;x
|
||||
phy save ;y
|
||||
pha save ;a
|
||||
|
||||
out1 ldx #$c2 ;ready for send?
|
||||
ldy #$20
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
*-------------------------------
|
||||
|
||||
setbyte lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq done ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
done rts
|
||||
|
||||
* reinit the port for 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
initport phx
|
||||
phy
|
||||
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda Baud19200,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt vector
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 Baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
asc 'GSPort/HST'
|
||||
|
||||
|
|
@ -0,0 +1,497 @@
|
|||
* GS Port Driver Bios - Slot #1
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/gsport1
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
Buffer equ $10b0
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
gsport1 ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 10 ;serial card slot * 16
|
||||
initspd hex 00 ;init speed for modem
|
||||
|
||||
callspd dfb 0 speed of current call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp ;get a byte
|
||||
jmp out ;send a byte
|
||||
jmp getcarr ;caller there?
|
||||
jmp setspeed ;speed of port
|
||||
jmp raisedtr ;raise dtr
|
||||
|
||||
doinit jmp $c100
|
||||
doread jmp $c100
|
||||
dowrite jmp $c100
|
||||
dostatus jmp $c100
|
||||
doext jmp $c100
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c10d ;get init address
|
||||
sta doinit+1
|
||||
lda $c10e ;get read address
|
||||
sta doread+1
|
||||
lda $c10f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c110 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c112
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c1 ;are we ready?
|
||||
ldy #$10
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c1 ;yes, read
|
||||
ldy #$10
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx restore ;& return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx save ;x
|
||||
phy save ;y
|
||||
pha save ;a
|
||||
|
||||
out1 ldx #$c1 ;ready for send?
|
||||
ldy #$10
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c1
|
||||
ldy #$10
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* init modem for ring
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" (numeric)
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noring ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noring ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noring
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noring ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
|
||||
dey
|
||||
cmp #'7' ;is it 9600/ARQ?
|
||||
beq ring3
|
||||
|
||||
dey ;no 4800/arq
|
||||
dey
|
||||
cmp #'6'
|
||||
beq ring3 ;2400/ARQ
|
||||
|
||||
dey
|
||||
cmp #'5' ;1200/ARQ
|
||||
beq ring3
|
||||
|
||||
jmp noring
|
||||
|
||||
********************************
|
||||
ring3 jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noring clc
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
phy
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq Do_Baud ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
|
||||
Do_Baud pla ;get y-reg
|
||||
asl a
|
||||
tay
|
||||
lda baudAddresses,y
|
||||
sta Baudread+1
|
||||
lda baudAddresses+1,y
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c1
|
||||
ldy #$10
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
********************************
|
||||
baudAddresses
|
||||
da Baud300
|
||||
da Baud1200
|
||||
da Baud2400
|
||||
da Baud4800
|
||||
da Baud9600
|
||||
da Baud19200
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* Table of Speeds and other important stuff
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init ;
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer 2 bytes
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier status here
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit 7 effects DTR
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code ds 2
|
||||
asc 'GSPort1'
|
||||
|
|
@ -0,0 +1,522 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #1
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/gsport1
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
Buffer equ $10b0
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
gsport1 ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 10 ;serial card slot * 16
|
||||
initspd hex 00 ;init speed for modem
|
||||
|
||||
callspd dfb 0 speed
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp ;get a byte
|
||||
jmp out ;send a byte
|
||||
jmp getcarr ;caller there?
|
||||
jmp setspeed ;speed of port
|
||||
jmp setirq
|
||||
jmp raisedtr ;raise dtr
|
||||
|
||||
doinit jmp $c100
|
||||
doread jmp $c100
|
||||
dowrite jmp $c100
|
||||
dostatus jmp $c100
|
||||
doext jmp $c100
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c10d ;get init address
|
||||
sta doinit+1
|
||||
lda $c10e ;get read address
|
||||
sta doread+1
|
||||
lda $c10f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c110 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c112
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c1 ;are we ready?
|
||||
ldy #$10
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c1 ;yes, read
|
||||
ldy #$10
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx restore ;& return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx save ;x
|
||||
phy save ;y
|
||||
pha save ;a
|
||||
|
||||
out1 ldx #$c1 ;ready for send?
|
||||
ldy #$10
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c1
|
||||
ldy #$10
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* init modem for ring
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" (numeric)
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noRing ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noRing ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
ring3 jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noRing clc
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
phy
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq Do_Baud ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
|
||||
Do_Baud pla ;get y-reg
|
||||
bne Try1200
|
||||
lda #<Baud300
|
||||
sta Baudread+1
|
||||
lda #>Baud300
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try1200 cmp #1
|
||||
bne Try2400
|
||||
lda #<Baud1200
|
||||
sta Baudread+1
|
||||
lda #>Baud1200
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try2400 cmp #2
|
||||
bne Try4800
|
||||
lda #<Baud2400
|
||||
sta Baudread+1
|
||||
lda #>Baud2400
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try4800 cmp #3
|
||||
bne Try9600
|
||||
lda #<Baud4800
|
||||
sta Baudread+1
|
||||
lda #>Baud4800
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try9600 cmp #4
|
||||
bne Try19200
|
||||
lda #<Baud9600
|
||||
sta Baudread+1
|
||||
lda #>Baud9600
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try19200 lda #<Baud19200
|
||||
sta Baudread+1
|
||||
lda #>Baud19200
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c1
|
||||
ldy #$10
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* Table of Speeds and other important stuff
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15b'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init ;
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code ds 2
|
||||
asc 'GSPort1'
|
||||
|
||||
|
|
@ -0,0 +1,504 @@
|
|||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/gsport2
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
Buffer equ $10b0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx ;save x
|
||||
phy
|
||||
ldx #$c2 ;are we ready?
|
||||
ldy #$20
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c2 ;yes, read
|
||||
ldy #$20
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx ;restore & return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
out1 ldx #$c2 ;ready for send?
|
||||
ldy #$20
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla ;get a
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply ;get y
|
||||
plx ;get x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" result
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noRing ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noRing ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
|
||||
dey
|
||||
cmp #'7' ;is it 9600/ARQ?
|
||||
beq ring3
|
||||
|
||||
dey ;no 4800/arq
|
||||
dey
|
||||
cmp #'6'
|
||||
beq ring3 ;2400/ARQ
|
||||
|
||||
dey
|
||||
cmp #'5' ;1200/ARQ
|
||||
beq ring3
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
ring3 jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer ;remove any garbage
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noring clc
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
* 5 = 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
phy
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq Do_Baud ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
|
||||
Do_Baud pla ;get y-reg
|
||||
asl a
|
||||
tay
|
||||
lda baudAddresses,y
|
||||
sta Baudread+1
|
||||
lda baudAddresses+1,y
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c2
|
||||
ldy #$20
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
********************************
|
||||
baudAddresses
|
||||
da Baud300
|
||||
da Baud1200
|
||||
da Baud2400
|
||||
da Baud4800
|
||||
da Baud9600
|
||||
da Baud19200
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer 2 bytes
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier status here
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit 7 effects DTR
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code ds 2 ;2 byte code returned by modem
|
||||
asc 'GSPort2'
|
||||
|
|
@ -0,0 +1,531 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/gsport2
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
Buffer equ $10b0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c2 ;are we ready?
|
||||
ldy #$20
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c2 ;yes, read
|
||||
ldy #$20
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx restore ;& return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
out1 ldx #$c2 ;ready for send?
|
||||
ldy #$20
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" result
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noRing ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noRing ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
ring3 jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer ;remove any garbage
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noRing clc
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
* 5 = 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
phy
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq Do_Baud ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspeed2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspeed2 ;loop until correct speed found
|
||||
|
||||
Do_Baud pla ;get y-reg
|
||||
bne Try1200
|
||||
lda #<Baud300
|
||||
sta Baudread+1
|
||||
lda #>Baud300
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try1200 cmp #1
|
||||
bne Try2400
|
||||
lda #<Baud1200
|
||||
sta Baudread+1
|
||||
lda #>Baud1200
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try2400 cmp #2
|
||||
bne Try4800
|
||||
lda #<Baud2400
|
||||
sta Baudread+1
|
||||
lda #>Baud2400
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try4800 cmp #3
|
||||
bne Try9600
|
||||
lda #<Baud4800
|
||||
sta Baudread+1
|
||||
lda #>Baud4800
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try9600 cmp #4
|
||||
bne Try19200
|
||||
lda #<Baud9600
|
||||
sta Baudread+1
|
||||
lda #>Baud9600
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try19200 lda #<Baud19200
|
||||
sta Baudread+1
|
||||
lda #>Baud19200
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c2
|
||||
ldy #$20
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code ds 2 ;2 byte code returned by modem
|
||||
asc 'GSPort2'
|
||||
|
||||
|
|
@ -0,0 +1,548 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/gsport2.vsm
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
Buffer equ $10b0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $b00
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c2 ;are we ready?
|
||||
ldy #$20
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcc inp2 ;nope, exit
|
||||
|
||||
ldx #$c2 ;yes, read
|
||||
ldy #$20
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
ply
|
||||
plx ;restore & return
|
||||
rts
|
||||
|
||||
inp2 lda #0
|
||||
clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
out1 ldx #$c2 ;ready for send?
|
||||
ldy #$20
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" result
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
noRing clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing cmp #'4' ; is it a '40','46','47' or '48'?
|
||||
beq :gotCode
|
||||
cmp #'5' ; is it a '50'?
|
||||
beq :gotCode ; Yes, check for carrier speed
|
||||
jmp noRing
|
||||
|
||||
:gotCode sta code1
|
||||
|
||||
:nxtchar jsr inp ; get next character
|
||||
bcc :nxtchar ; it MUST be there
|
||||
|
||||
and #$7f
|
||||
cmp #cr
|
||||
beq :startck
|
||||
|
||||
sta code1+1
|
||||
bra :nxtchar
|
||||
|
||||
:startck ldy #32 ;def = 9600 baud carrier
|
||||
ldx #5
|
||||
|
||||
lda code1 ;get the first code char
|
||||
cmp #'5' ;is it a '50'?
|
||||
bne :not9600 ;if not, then check for other carrier speeds
|
||||
|
||||
lda code1+1
|
||||
cmp #'0'
|
||||
beq :setcspd
|
||||
|
||||
:not9600 ldy #1
|
||||
ldx #0
|
||||
lda code1+1 ;is it a 300 baud carrier?
|
||||
cmp #'0'
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #4
|
||||
inx
|
||||
cmp #'6' ;is it a 1200 baud carrier?
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #8
|
||||
inx
|
||||
cmp #'7' ;is it a 2400 baud carrier?
|
||||
beq :setcspd
|
||||
|
||||
ldy #16
|
||||
inx
|
||||
cmp #'8' ;is it a 4800 baud carrier?
|
||||
beq :setcspd
|
||||
jmp noRing
|
||||
|
||||
:setcspd sty carrspd
|
||||
stx portspd
|
||||
|
||||
; check for protocol connections
|
||||
ckptrocl ldy #0
|
||||
:nxtchar jsr inp ; get next character
|
||||
bcc :nxtchar ; it MUST be there
|
||||
|
||||
and #$7f
|
||||
cmp #cr
|
||||
beq :startck
|
||||
|
||||
sta code2,y ; save it...
|
||||
iny
|
||||
bra :nxtchar
|
||||
|
||||
:startck lda code2 ; get first char of protocol
|
||||
cmp #'7' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
lda code2+1 ; get last character of protocol
|
||||
cmp #'0' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
ldx #5
|
||||
stx portspd
|
||||
|
||||
********************************
|
||||
:ring3 ldy portspd ;get the speed to open port at
|
||||
jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer ;remove any garbage
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
* 5 = 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
|
||||
ldx carrspd ;find caller speed (x300)
|
||||
stx callspd
|
||||
|
||||
tya ;get y-reg into a-reg
|
||||
bne Try1200
|
||||
lda #<Baud300
|
||||
sta Baudread+1
|
||||
lda #>Baud300
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try1200 cmp #1
|
||||
bne Try2400
|
||||
lda #<Baud1200
|
||||
sta Baudread+1
|
||||
lda #>Baud1200
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try2400 cmp #2
|
||||
bne Try4800
|
||||
lda #<Baud2400
|
||||
sta Baudread+1
|
||||
lda #>Baud2400
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try4800 cmp #3
|
||||
bne Try9600
|
||||
lda #<Baud4800
|
||||
sta Baudread+1
|
||||
lda #>Baud4800
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try9600 cmp #4
|
||||
bne Try19200
|
||||
lda #<Baud9600
|
||||
sta Baudread+1
|
||||
lda #>Baud9600
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try19200 lda #<Baud19200
|
||||
sta Baudread+1
|
||||
lda #>Baud19200
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c2
|
||||
ldy #$20
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code1 ds 2 ;2 byte code returned by modem
|
||||
code2 ds 2
|
||||
portspd ds 1
|
||||
carrspd ds 1
|
||||
asc 'GSPort2 Hayes VSM'
|
||||
|
||||
|
|
@ -0,0 +1,536 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
slot equ $c2
|
||||
slot1 equ $20
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $e00
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx ;save x
|
||||
phy
|
||||
jsr setcall ;set x & y
|
||||
lda #1
|
||||
jsr dostatus ;is there input ready?
|
||||
bcs :inp2 ;yes, read character
|
||||
|
||||
lda #0
|
||||
clc
|
||||
bra :inp3
|
||||
|
||||
:inp2 jsr setcall ;yes, read
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
:inp3 ply
|
||||
plx ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
out1 jsr setcall ;ready for send?
|
||||
lda #$00
|
||||
jsr dostatus ;ready for send?
|
||||
bcc out1 ;nope
|
||||
|
||||
pla ;get a
|
||||
jsr setcall
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply ;get y
|
||||
plx ;get x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
:rset2 inx ;do pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq :rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra :rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
:rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
:rset4 ldy #$FF
|
||||
:rset5 dey
|
||||
beq :decount
|
||||
|
||||
jsr inp
|
||||
bcc :rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" result
|
||||
beq :leave
|
||||
jmp :rset5
|
||||
|
||||
:decount dec countlo
|
||||
bne :rset4
|
||||
dec counthi
|
||||
bne :rset4
|
||||
jmp ringset
|
||||
|
||||
:leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc :leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
stz bytcnt ;reset byte counter
|
||||
stz bytcnt+1
|
||||
stz bytcnt+2
|
||||
noRing clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing cmp #'4' ; is it a '40','46','47' or '48'?
|
||||
beq :gotCode
|
||||
cmp #'5' ; is it a '50'?
|
||||
beq :gotCode ; Yes, check for carrier speed
|
||||
jmp noRing
|
||||
|
||||
:gotCode sta code1
|
||||
ldy #1
|
||||
|
||||
:nxtchar jsr inp ; get next character
|
||||
bcc :nxtchar ; it MUST be there
|
||||
|
||||
and #$7f
|
||||
cmp #cr
|
||||
beq :nxtchar
|
||||
|
||||
sta code1+1
|
||||
iny
|
||||
cpy #'6'
|
||||
bne :nxtchar
|
||||
|
||||
ldy #32 ;def = 9600 baud carrier
|
||||
ldx #4
|
||||
|
||||
lda code1 ;get the first code char
|
||||
cmp #'5' ;is it a '50'?
|
||||
bne :not9600 ;if not, then check for other carrier speeds
|
||||
|
||||
lda code1+1
|
||||
cmp #'0'
|
||||
beq :setcspd
|
||||
|
||||
:not9600 ldy #1
|
||||
ldx #0
|
||||
lda code1+1 ;is it a 300 baud carrier?
|
||||
cmp #'0'
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #4
|
||||
inx
|
||||
cmp #'6' ;is it a 1200 baud carrier?
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #8
|
||||
inx
|
||||
cmp #'7' ;is it a 2400 baud carrier?
|
||||
beq :setcspd
|
||||
|
||||
ldy #16
|
||||
inx
|
||||
cmp #'8' ;is it a 4800 baud carrier?
|
||||
beq :setcspd
|
||||
jmp noRing
|
||||
|
||||
:setcspd sty carrspd
|
||||
stx portspd
|
||||
|
||||
; check for protocol connections
|
||||
ckptrocl lda code2
|
||||
cmp #'7' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
lda code2+1 ; get last character of protocol
|
||||
cmp #'0' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
ldx #5
|
||||
stx portspd ; save speed to open port at
|
||||
|
||||
********************************
|
||||
:ring3 ldy portspd ;get the speed to open port at
|
||||
jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer ;remove any garbage
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
hex 2c ;skip clc
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #$ff
|
||||
:answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq :answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra :answer2
|
||||
|
||||
:answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
* 5 = 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
|
||||
ldx carrspd ;find caller speed (x300)
|
||||
stx callspd
|
||||
|
||||
tya ;get y-reg into a-reg
|
||||
bne :Try1200
|
||||
lda #<Baud300
|
||||
sta :Baudread+1
|
||||
lda #>Baud300
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try1200 cmp #1
|
||||
bne :Try2400
|
||||
lda #<Baud1200
|
||||
sta :Baudread+1
|
||||
lda #>Baud1200
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try2400 cmp #2
|
||||
bne :Try4800
|
||||
lda #<Baud2400
|
||||
sta :Baudread+1
|
||||
lda #>Baud2400
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try4800 cmp #3
|
||||
bne :Try9600
|
||||
lda #<Baud4800
|
||||
sta :Baudread+1
|
||||
lda #>Baud4800
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try9600 cmp #4
|
||||
bne :Try19200
|
||||
lda #<Baud9600
|
||||
sta :Baudread+1
|
||||
lda #>Baud9600
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try19200 lda #<Baud19200
|
||||
sta :Baudread+1
|
||||
lda #>Baud19200
|
||||
sta :Baudread+2
|
||||
|
||||
:SetBaud jsr setcall ;setup x&y for call
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
:Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra :Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
:Init_Loop lda Port_Init,x
|
||||
beq :donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra :Init_Loop
|
||||
|
||||
:donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------------------------
|
||||
* setup firmware i/o routines
|
||||
|
||||
setcall ldx slot
|
||||
ldy slot1
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code1 ds 2 ;2 byte code returned by modem
|
||||
code2 ds 2
|
||||
code3 ds 2
|
||||
portspd ds 1
|
||||
carrspd ds 1
|
||||
|
||||
Buffer ds $15
|
||||
cdbyte db #$20
|
||||
ansstr asc 'ATA',0d00
|
||||
initstr asc 'ATZ',0d00
|
||||
|
||||
*initstr asc 'ATX1S0=0S2=128&C1&D2&S1&K5E0V0W1M0',0d00
|
||||
|
||||
|
|
@ -0,0 +1,541 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $e00
|
||||
|
||||
protocol hex 00 ;serial card slot * 16
|
||||
initspd hex 05
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx save ;x
|
||||
phy
|
||||
ldx #$c2 ;is there input ready?
|
||||
ldy #$20
|
||||
lda #1
|
||||
jsr dostatus
|
||||
bcs :inp2 yes,
|
||||
|
||||
lda #0
|
||||
clc
|
||||
bra :inp3
|
||||
|
||||
:inp2 ldx #$c2 ;yes, read
|
||||
ldy #$20
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
:inp3 ply
|
||||
plx ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
out1 ldx #$c2 ;ready for send?
|
||||
ldy #$20
|
||||
lda #$00
|
||||
jsr dostatus
|
||||
bcc out1 ;nope
|
||||
|
||||
pla get ;a
|
||||
ldx #$c2
|
||||
ldy #$20
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply get ;y
|
||||
plx get ;x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
rset2 inx do ;pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" result
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
noRing clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing cmp #'4' ; is it a '40','46','47' or '48'?
|
||||
beq :gotCode
|
||||
cmp #'5' ; is it a '50'?
|
||||
beq :gotCode ; Yes, check for carrier speed
|
||||
jmp noRing
|
||||
|
||||
:gotCode sta code1
|
||||
ldy #1
|
||||
|
||||
:nxtchar jsr inp ; get next character
|
||||
bcc :nxtchar ; it MUST be there
|
||||
|
||||
and #$7f
|
||||
cmp #cr
|
||||
bne :valid
|
||||
cpy #5
|
||||
bne :nxtchar
|
||||
bra :next
|
||||
|
||||
:valid sta code1,y
|
||||
iny
|
||||
cpy #6
|
||||
bne :nxtchar
|
||||
|
||||
:next ldy #32 ;def = 9600 baud carrier
|
||||
ldx #4
|
||||
|
||||
lda code1 ;get the first code char
|
||||
cmp #'5' ;is it a '50'?
|
||||
bne :not9600 ;if not, then check for other carrier speeds
|
||||
|
||||
lda code1+1
|
||||
cmp #'0'
|
||||
beq :setcspd
|
||||
|
||||
:not9600 ldy #1
|
||||
ldx #0
|
||||
lda code1+1 ;is it a 300 baud carrier?
|
||||
cmp #'0'
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #4
|
||||
inx
|
||||
cmp #'6' ;is it a 1200 baud carrier?
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #8
|
||||
inx
|
||||
cmp #'7' ;is it a 2400 baud carrier?
|
||||
beq :setcspd
|
||||
|
||||
ldy #16
|
||||
inx
|
||||
cmp #'8' ;is it a 4800 baud carrier?
|
||||
beq :setcspd
|
||||
jmp noRing
|
||||
|
||||
:setcspd sty carrspd
|
||||
stx portspd
|
||||
|
||||
* check for protocol connections
|
||||
lda code2 ; get first char of protocol
|
||||
cmp #'7' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
lda code2+1 ; get last character of protocol
|
||||
cmp #'0' ; is it '70'?
|
||||
beq :ring3
|
||||
|
||||
lda #$80
|
||||
sta protocol ; save indicator of a protocol connection
|
||||
ldx #5
|
||||
stx portspd
|
||||
|
||||
********************************
|
||||
:ring3 ldy portspd ;get the speed to open port at
|
||||
jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer ;remove any garbage
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #$ff
|
||||
answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra answer2
|
||||
|
||||
answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
* 5 = 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
|
||||
ldx carrspd ;find caller speed (x300)
|
||||
stx callspd
|
||||
|
||||
tya ;get y-reg into a-reg
|
||||
bne Try1200
|
||||
lda #<Baud300
|
||||
sta Baudread+1
|
||||
lda #>Baud300
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try1200 cmp #1
|
||||
bne Try2400
|
||||
lda #<Baud1200
|
||||
sta Baudread+1
|
||||
lda #>Baud1200
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try2400 cmp #2
|
||||
bne Try4800
|
||||
lda #<Baud2400
|
||||
sta Baudread+1
|
||||
lda #>Baud2400
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try4800 cmp #3
|
||||
bne Try9600
|
||||
lda #<Baud4800
|
||||
sta Baudread+1
|
||||
lda #>Baud4800
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try9600 cmp #4
|
||||
bne Try19200
|
||||
lda #<Baud9600
|
||||
sta Baudread+1
|
||||
lda #>Baud9600
|
||||
sta Baudread+2
|
||||
bra SetBaud
|
||||
|
||||
Try19200 lda #<Baud19200
|
||||
sta Baudread+1
|
||||
lda #>Baud19200
|
||||
sta Baudread+2
|
||||
|
||||
SetBaud ldx #$c2
|
||||
ldy #$20
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
Init_Loop lda Port_Init,x
|
||||
beq donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra Init_Loop
|
||||
|
||||
donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 ;Carrier status here
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 ;bit 7 effects DTR
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code1 ds 2 ;2 byte carrier speed
|
||||
code2 ds 2 ;2 byte protocol format
|
||||
code3 ds 2 ;2 byte connect speed
|
||||
portspd ds 1
|
||||
carrspd ds 1
|
||||
|
||||
Buffer ds $15
|
||||
cdbyte db #$20
|
||||
ansstr asc 'ATA',0d00
|
||||
initstr asc 'ATZ',0d00
|
||||
|
||||
*initstr asc 'ATX1S0=0S2=128&C1&D2&S1&K5E0V0W1M0'0d00
|
||||
|
||||
|
|
@ -0,0 +1,534 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* GS Port Driver Bios - Slot #2
|
||||
* written by Andy Nicholas on July 26, 1987
|
||||
*-------------------------------
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
slot equ $c2
|
||||
slot1 equ $20
|
||||
|
||||
*-------------------------------
|
||||
|
||||
gsport2 ent
|
||||
|
||||
* Jump Table
|
||||
*-------------------------------
|
||||
|
||||
org $e00
|
||||
|
||||
hex 20 ;serial card slot * 16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp getcarr
|
||||
jmp setspeed
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
doinit jmp $c200
|
||||
doread jmp $c200
|
||||
dowrite jmp $c200
|
||||
dostatus jmp $c200
|
||||
doext jmp $c200
|
||||
|
||||
* init the serial port pascal locations
|
||||
*-------------------------------
|
||||
|
||||
init lda $c20d ;get init address
|
||||
sta doinit+1
|
||||
lda $c20e ;get read address
|
||||
sta doread+1
|
||||
lda $c20f ;get write address
|
||||
sta dowrite+1
|
||||
lda $c210 ;get status address
|
||||
sta dostatus+1
|
||||
lda $c212
|
||||
sta doext+1
|
||||
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp phx ;save x
|
||||
phy
|
||||
ldx slot
|
||||
ldy slot1
|
||||
lda #1
|
||||
jsr dostatus ;is there input ready?
|
||||
bcs :inp2 ;yes, read character
|
||||
|
||||
lda #0
|
||||
clc
|
||||
bra :inp3
|
||||
|
||||
:inp2 ldx slot ;yes, read
|
||||
ldy slot1
|
||||
jsr doread
|
||||
|
||||
sec
|
||||
:inp3 ply
|
||||
plx ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out phx ;save x
|
||||
phy ;save y
|
||||
pha ;save a
|
||||
|
||||
:out1 ldx slot ;ready for send?
|
||||
ldy slot1
|
||||
lda #$00
|
||||
jsr dostatus ;ready for send?
|
||||
bcc :out1 ;nope
|
||||
|
||||
pla ;get a
|
||||
ldx slot
|
||||
ldy slot1
|
||||
jsr dowrite ;send it
|
||||
|
||||
ply ;get y
|
||||
plx ;get x
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset jsr hangup
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #$00
|
||||
jsr gsdtr
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspeed
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #$FF
|
||||
:rset2 inx ;do pre-inc
|
||||
lda initstr,x ;get modem init string
|
||||
beq :rset3 ;we are done
|
||||
|
||||
jsr out ;output
|
||||
bra :rset2 ;loop (Z-bit set after wait)
|
||||
|
||||
:rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
:rset4 ldy #$FF
|
||||
:rset5 dey
|
||||
beq :decount
|
||||
|
||||
jsr inp
|
||||
bcc :rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "0" result
|
||||
beq :leave
|
||||
jmp :rset5
|
||||
|
||||
:decount dec countlo
|
||||
bne :rset4
|
||||
dec counthi
|
||||
bne :rset4
|
||||
jmp ringset
|
||||
|
||||
:leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc :leave
|
||||
|
||||
jsr clearBuffer
|
||||
|
||||
stz bytcnt ;reset byte counter
|
||||
stz bytcnt+1
|
||||
stz bytcnt+2
|
||||
noRing clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* test for a ring and handle it
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing cmp #'4' ; is it a '40','46','47' or '48'?
|
||||
beq :gotCode
|
||||
cmp #'5' ; is it a '50'?
|
||||
beq :gotCode ; Yes, check for carrier speed
|
||||
jmp noRing
|
||||
|
||||
:gotCode sta code1
|
||||
ldy #1
|
||||
|
||||
:nxtchar jsr inp ; get next character
|
||||
bcc :nxtchar ; it MUST be there
|
||||
|
||||
and #$7f
|
||||
cmp #cr
|
||||
beq :nxtchar
|
||||
|
||||
sta code1+1
|
||||
iny
|
||||
cpy #'6'
|
||||
bne :nxtchar
|
||||
|
||||
ldy #32 ;def = 9600 baud carrier
|
||||
ldx #4
|
||||
|
||||
lda code1 ;get the first code char
|
||||
cmp #'5' ;is it a '50'?
|
||||
bne :not9600 ;if not, then check for other carrier speeds
|
||||
|
||||
lda code1+1
|
||||
cmp #'0'
|
||||
beq :setcspd
|
||||
|
||||
:not9600 ldy #1
|
||||
ldx #0
|
||||
lda code1+1 ;is it a 300 baud carrier?
|
||||
cmp #'0'
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #4
|
||||
inx
|
||||
cmp #'6' ;is it a 1200 baud carrier?
|
||||
beq :setcspd ;yes
|
||||
|
||||
ldy #8
|
||||
inx
|
||||
cmp #'7' ;is it a 2400 baud carrier?
|
||||
beq :setcspd
|
||||
|
||||
ldy #16
|
||||
inx
|
||||
cmp #'8' ;is it a 4800 baud carrier?
|
||||
beq :setcspd
|
||||
jmp noRing
|
||||
|
||||
:setcspd sty carrspd
|
||||
stx portspd
|
||||
|
||||
; check for protocol connections
|
||||
ckptrocl lda code2
|
||||
cmp #'7' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
lda code2+1 ; get last character of protocol
|
||||
cmp #'0' ; is it '70'?
|
||||
bne :ring3
|
||||
|
||||
ldx #5
|
||||
stx portspd ; save speed to open port at
|
||||
|
||||
********************************
|
||||
:ring3 ldy portspd ;get the speed to open port at
|
||||
jsr setspeed ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
jsr clearBuffer ;remove any garbage
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* clear the input buffer
|
||||
|
||||
clearBuffer
|
||||
lda #Flush_List
|
||||
ldx #>Flush_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* set DTR on GS Serial Port, and hangup if needed
|
||||
*-------------------------------
|
||||
|
||||
hangup lda #$80 ;blow 'em off (hangup)
|
||||
gsdtr sta DTRstate
|
||||
|
||||
lda #DTR_List
|
||||
ldx #>DTR_List
|
||||
ldy #0
|
||||
jmp doext
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* Check for carrier using Get_Port_Stat routine
|
||||
*-------------------------------
|
||||
|
||||
getcarr phx
|
||||
phy
|
||||
|
||||
lda #carrlist
|
||||
ldx #>carrlist
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
lda carrbits
|
||||
and cdbyte
|
||||
beq nocarr
|
||||
sec
|
||||
hex 2c ;skip clc
|
||||
|
||||
nocarr clc
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #$ff
|
||||
:answer2 inx
|
||||
lda ansstr,x ;get text
|
||||
beq :answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
bra :answer2
|
||||
|
||||
:answer3 rts
|
||||
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
*
|
||||
* 0 = 300 baud
|
||||
* 1 = 1200 baud
|
||||
* 2 = 2400 baud
|
||||
* 3 = 4800 baud
|
||||
* 4 = 9600 baud
|
||||
* 5 = 19200 baud
|
||||
*-------------------------------
|
||||
|
||||
setspeed phx
|
||||
|
||||
ldx carrspd ;find caller speed (x300)
|
||||
stx callspd
|
||||
|
||||
tya ;get y-reg into a-reg
|
||||
bne :Try1200
|
||||
lda #<Baud300
|
||||
sta :Baudread+1
|
||||
lda #>Baud300
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try1200 cmp #1
|
||||
bne :Try2400
|
||||
lda #<Baud1200
|
||||
sta :Baudread+1
|
||||
lda #>Baud1200
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try2400 cmp #2
|
||||
bne :Try4800
|
||||
lda #<Baud2400
|
||||
sta :Baudread+1
|
||||
lda #>Baud2400
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try4800 cmp #3
|
||||
bne :Try9600
|
||||
lda #<Baud4800
|
||||
sta :Baudread+1
|
||||
lda #>Baud4800
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try9600 cmp #4
|
||||
bne :Try19200
|
||||
lda #<Baud9600
|
||||
sta :Baudread+1
|
||||
lda #>Baud9600
|
||||
sta :Baudread+2
|
||||
bra :SetBaud
|
||||
|
||||
:Try19200 lda #<Baud19200
|
||||
sta :Baudread+1
|
||||
lda #>Baud19200
|
||||
sta :Baudread+2
|
||||
|
||||
:SetBaud ldx slot
|
||||
ldy slot1
|
||||
jsr doinit
|
||||
|
||||
ldx #0
|
||||
:Baudread lda $ffff,x
|
||||
beq Fin_Init
|
||||
jsr out
|
||||
inx
|
||||
bra :Baudread
|
||||
|
||||
Fin_Init ldx #0
|
||||
:Init_Loop lda Port_Init,x
|
||||
beq :donebaud
|
||||
jsr out
|
||||
inx
|
||||
bra :Init_Loop
|
||||
|
||||
:donebaud lda #Out_Buf
|
||||
ldx #>Out_Buf
|
||||
ldy #0
|
||||
jsr doext
|
||||
|
||||
plx
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* raise dtr
|
||||
|
||||
raisedtr lda #0
|
||||
phx
|
||||
phy
|
||||
|
||||
jsr gsdtr
|
||||
|
||||
ply
|
||||
plx
|
||||
rts
|
||||
|
||||
* globals
|
||||
*-------------------------------
|
||||
|
||||
counthi db 0
|
||||
countlo db 0
|
||||
|
||||
Baud300 hex 01
|
||||
asc '6B'
|
||||
hex 00 ;accept 300 Baud
|
||||
Baud1200 hex 01
|
||||
asc '8B'
|
||||
hex 00 ;accept 1200 Baud
|
||||
Baud2400 hex 01
|
||||
asc '10B'
|
||||
hex 00 ;accept 2400 Baud
|
||||
Baud4800 hex 01
|
||||
asc '12B'
|
||||
hex 00 ;accept 4800 Baud
|
||||
Baud9600 hex 01
|
||||
asc '14B'
|
||||
hex 00 ;accept 9600 Baud
|
||||
Baud19200 hex 01
|
||||
asc '15B'
|
||||
hex 00 ;accept 19200 baud
|
||||
|
||||
Port_Init
|
||||
hex 01
|
||||
asc '0D' ;8 bits
|
||||
hex 01
|
||||
asc '2P' ;no parity
|
||||
hex 01
|
||||
asc 'AD' ;auto-tabbing
|
||||
hex 01
|
||||
asc 'XD' ;no xoff recognition
|
||||
hex 01
|
||||
asc 'FD' ;no find keyboard
|
||||
hex 01
|
||||
asc 'CD' ;no column overflow
|
||||
hex 01
|
||||
asc 'ED' ;echo disabled
|
||||
hex 01
|
||||
asc 'MD' ;no lf masking
|
||||
hex 01
|
||||
asc 'BE' ;buffering enabled
|
||||
hex 01
|
||||
asc 'Z'
|
||||
hex 00 ;no more control characters
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Out_Buf hex 04 ;Parameters to set the
|
||||
hex 13 ;Output buffer
|
||||
da 0
|
||||
adrl Buffer ;Buffer it where
|
||||
da 2 buffer
|
||||
|
||||
*-------------------------------
|
||||
|
||||
carrlist hex 03 ;Parameter list for
|
||||
hex 06 ;detecting carrier drop
|
||||
da 0
|
||||
carrbits da 0 Carrier
|
||||
|
||||
*-------------------------------
|
||||
|
||||
DTR_List hex 03 ;Parameter list for
|
||||
hex 0b ;setting DTR
|
||||
da 0
|
||||
DTRstate da 0 bit
|
||||
|
||||
*-------------------------------
|
||||
|
||||
Flush_List hex 02 ;parameter list for flushing input queue
|
||||
hex 14
|
||||
da 0
|
||||
|
||||
*-------------------------------
|
||||
|
||||
code1 ds 2 ;2 byte code returned by modem
|
||||
code2 ds 2
|
||||
code3 ds 2
|
||||
portspd ds 1
|
||||
carrspd ds 1
|
||||
|
||||
Buffer ds $15
|
||||
cdbyte db #$20
|
||||
ansstr asc 'ATA',0d00
|
||||
initstr asc 'ATZ',0d00
|
||||
|
||||
*initstr asc 'ATX1S0=0S2=128&C1&D2&S1&K5E0V0W1M0',0d00
|
||||
|
||||
|
|
@ -0,0 +1,243 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*--------------------------
|
||||
*Internal Micromodem ][ //e
|
||||
*--------------------------
|
||||
* Date 12/09/86
|
||||
*--------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/mm2
|
||||
|
||||
data EQU $c087
|
||||
status EQU $c086
|
||||
cr1 EQU $c086
|
||||
ringin EQU $c085
|
||||
cr2 EQU $c085
|
||||
cr3 EQU $c083
|
||||
|
||||
mm2 ent
|
||||
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
slot dfb $20 ;serial card slot
|
||||
dfb 0 ;transmit / receive
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
JMP init
|
||||
JMP ringset
|
||||
JMP ring
|
||||
JMP answer
|
||||
JMP hangup
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
rts ;raise dtr
|
||||
|
||||
*-------------------------------
|
||||
* init the modem card
|
||||
|
||||
init sei
|
||||
LDX slot ;get slot offset
|
||||
LDA %00000000 ;reset tone/speaker
|
||||
STA cr3,x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup for call
|
||||
|
||||
ringset LDA #0 ;reset time-on
|
||||
STA bytcnt
|
||||
STA bytcnt+1
|
||||
STA bytcnt+2
|
||||
STA carwait ;reset wait flag
|
||||
TAY set ;300 baud
|
||||
JMP setspd
|
||||
|
||||
*-------------------------------
|
||||
* scna for ring and handle it
|
||||
|
||||
ring LDX slot ;get offset
|
||||
BIT carwait ;do they want manual-answer?
|
||||
BMI ring2a ;yep
|
||||
|
||||
LDA ringin,x ;check for ring
|
||||
AND %10000000
|
||||
BNE ring4 ;nothing
|
||||
|
||||
ring2 LDA ringin,x ;wait for ring to clear
|
||||
AND %10000000
|
||||
BEQ ring2
|
||||
|
||||
ring2a LDA %00000011 ;reset uart
|
||||
STA cr1,x
|
||||
LDA %00010101 ;set for 8n1
|
||||
STA cr1,x
|
||||
|
||||
LDA %00000000 ;reset modem
|
||||
STA cr2,x
|
||||
LDA %10001011 ;pick up phone [enable carrier]
|
||||
STA cr2,x
|
||||
|
||||
LDA #$50 ;setup carrier wait time
|
||||
STA carwait
|
||||
|
||||
LDA #$3c ;wait for things to settle
|
||||
JSR wait
|
||||
|
||||
ring3 LDA #0 ;do big wait...
|
||||
JSR wait
|
||||
|
||||
LDA data,x
|
||||
LDA status,x ;reset carrier flag
|
||||
LDA status,x ;do we have carrier?
|
||||
AND %00000100
|
||||
BEQ ring5 ;yep
|
||||
|
||||
DEC carwait ;loop until count is done
|
||||
BNE ring3
|
||||
|
||||
JSR hangup
|
||||
ring4 CLC ;nothing happened
|
||||
RTS
|
||||
|
||||
ring5 LDA #-1 ;reset carrier timing
|
||||
STA carwait
|
||||
SEC
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* send ata to phone
|
||||
|
||||
answer LDA #-1 ;signal we want manual-answer
|
||||
STA carwait
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* hangup phone
|
||||
|
||||
hangup LDX slot ;get offset
|
||||
LDA %00000001
|
||||
STA cr2,x ;hang up phone
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* input data
|
||||
|
||||
inp STX save_x ;save X
|
||||
LDX slot ;get offset
|
||||
LDA status,x ;get status
|
||||
AND %00000001
|
||||
CLC
|
||||
BEQ inp2 ;no data
|
||||
|
||||
LDA data,x ;get data
|
||||
SEC
|
||||
inp2 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output data
|
||||
|
||||
out STX save_x ;save x
|
||||
DEC timecnt ;count down bytes per second
|
||||
BNE out1 ;not a seconds worth yet
|
||||
|
||||
PHA
|
||||
LDA callspd ;reset counter
|
||||
ASL
|
||||
ASL
|
||||
ASL ;time count = base.rate * 32
|
||||
ASL
|
||||
ASL
|
||||
STA timecnt
|
||||
PLA
|
||||
|
||||
INC bytcnt ;seconds - at 64 yet?
|
||||
BIT bytcnt
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset seconds
|
||||
STX bytcnt
|
||||
|
||||
INC bytcnt+1 ;minutes - at 64 yet?
|
||||
BIT bytcnt+1
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset minutes
|
||||
STX bytcnt+1
|
||||
|
||||
INC bytcnt+2 ;inc hours
|
||||
|
||||
out1 LDX slot
|
||||
|
||||
PHA
|
||||
out2 LDA status,x ;check status
|
||||
AND %00000110
|
||||
BEQ out2 ;loop until ready
|
||||
PLA
|
||||
|
||||
STA data,x ;output byte
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* check for carrier
|
||||
|
||||
chkdcd STX save_x ;dont kill any reg's
|
||||
PHA
|
||||
|
||||
LDX slot
|
||||
LDA status,x ;reset carrier flag
|
||||
LDA status,x ;check carrier
|
||||
AND %00000100
|
||||
CLC
|
||||
BNE chkdcd2 ;opps, no carrier
|
||||
|
||||
SEC ;sec = we have carrier
|
||||
chkdcd2 PLA ;restore & return
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
|
||||
setspd LDA #1 ;find caller speed (x300)
|
||||
STA callspd
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set up interupts
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* wait routine
|
||||
|
||||
wait SEC ;from apple ][+ ref man - pg 147
|
||||
wait2 PHA
|
||||
wait3 SBC #1
|
||||
BNE wait3
|
||||
PLA
|
||||
SBC #1
|
||||
BNE wait2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* available speeds
|
||||
|
||||
save_x dfb 0
|
||||
|
||||
timecnt dfb 0
|
||||
carwait dfb 0
|
||||
|
||||
asc 'MM2'
|
||||
|
||||
|
|
@ -0,0 +1,357 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Multiple Speed Modem Driver
|
||||
*-------------------------------
|
||||
* 3/18/88 AEN
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/multispd
|
||||
|
||||
cr EQU $0d
|
||||
lf EQU $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
multispd ent
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
slot dfb $20 ;serial card slot
|
||||
initspd db 0 ;init speed
|
||||
callspd db 0 ;speed of call
|
||||
|
||||
bytcnt db 0,0,0
|
||||
|
||||
JMP init
|
||||
JMP ringset
|
||||
JMP ring
|
||||
JMP answer
|
||||
JMP hangup
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
*-------------------------------
|
||||
* init the serial card
|
||||
|
||||
init LDA #0 ;reset bytes
|
||||
LDX slot
|
||||
STA status,x ;reset uart
|
||||
STA command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup for call
|
||||
|
||||
ringset LDX slot ;get offset
|
||||
LDA #%00000000 ;kill DTR, RTS
|
||||
STA command,x
|
||||
|
||||
LDA #0 ;let modem reset
|
||||
JSR wait
|
||||
|
||||
LDA #%00001011 ;turn on DTR, RTS
|
||||
STA command,x
|
||||
|
||||
sei ;disable ints
|
||||
|
||||
LDY initspd ;set init speed
|
||||
JSR setspd
|
||||
|
||||
LDA data,x ;clear data strobe
|
||||
|
||||
lda #0 ;long delay
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
LDX #-1 ;start at -1
|
||||
rset2 INX do ;pre-inc
|
||||
LDA initstr,x ;get modem init string
|
||||
BEQ rset3 ;we are done
|
||||
|
||||
JSR out ;output
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
jmp rset2 ;loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
jring jmp ringset ;128 byte branches!!
|
||||
|
||||
*-------------------------------
|
||||
* scan for ring and handle it
|
||||
|
||||
ring LDX slot
|
||||
LDA status,x ;do we have carrier?
|
||||
AND cdbyte
|
||||
CLC
|
||||
BNE ring3 ;nope
|
||||
|
||||
LDA data,x ;gobble byte(s)
|
||||
LDA data,x
|
||||
LDA #0 ;reset speed byte
|
||||
STA spdata
|
||||
|
||||
LDY #0 ;set default to 300
|
||||
ring1 JSR setspd
|
||||
|
||||
ring2 LDA status,x ;we still get carrier
|
||||
AND cdbyte
|
||||
BNE jring ;nope
|
||||
|
||||
LDA status,x ;have a char waiting?
|
||||
AND #%00001000
|
||||
BEQ ring2 ;nope, check carrier
|
||||
|
||||
LDA status,x ;check framing
|
||||
AND #%00000010
|
||||
BNE ring4 ;oops, framing error
|
||||
|
||||
LDA data,x ;get byte (no framing error)
|
||||
STA spdata ;save speed data
|
||||
AND #$7f
|
||||
CMP #cr ;is it a return?
|
||||
BEQ ring2a ;yep, we have the speed
|
||||
|
||||
AND #%01110000 ;check for higher speed
|
||||
CMP #%01110000
|
||||
BEQ ring5 ;go to up a notch
|
||||
JMP ring2 ;loop back
|
||||
|
||||
ring2a SEC all ;is well, connect
|
||||
ring3 RTS
|
||||
|
||||
ring4 LDA data,x ;empty uart
|
||||
LDA data,x
|
||||
|
||||
LDA spdata ;get last "legal" byte
|
||||
AND #%11100000 ;check for 300 baud overrun
|
||||
CMP #%11100000
|
||||
BEQ ring5 ;looks like a higher speed
|
||||
|
||||
LDY curspd ;what speed
|
||||
BEQ ring2 ;hmm, cant go below 300
|
||||
|
||||
DEY
|
||||
JMP ring1 ;set new speed, check again
|
||||
|
||||
ring5 LDY curspd ;we at 2400?
|
||||
CPY initspd ;as high as we can go?
|
||||
BEQ ring2 ;yep, cant go any higher
|
||||
|
||||
INY
|
||||
JMP ring1 ;set new speed, up 1 notch
|
||||
|
||||
*-------------------------------
|
||||
* send ata to phone
|
||||
|
||||
answer LDX #0
|
||||
answer2 LDA ansstr,x ;get text
|
||||
BEQ answer3 ;we are donw
|
||||
|
||||
JSR out ;send it
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
|
||||
INX
|
||||
BNE answer2 ;loop
|
||||
|
||||
answer3 RTS
|
||||
|
||||
*-------------------------------
|
||||
* hangup phone
|
||||
|
||||
hangup LDX slot ;get offset
|
||||
LDA #0
|
||||
STA command,x ;hang up phone
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* input data
|
||||
|
||||
inp STX save_x ;save X
|
||||
LDX slot ;get offset
|
||||
LDA status,x ;get status
|
||||
AND #%00001000
|
||||
CLC
|
||||
BEQ inp2 ;no data
|
||||
|
||||
LDA data,x
|
||||
SEC
|
||||
inp2 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output data
|
||||
|
||||
out STX save_x ;save x
|
||||
DEC timecnt ;count down 1 section
|
||||
BNE out1
|
||||
|
||||
INC bytcnt ;1 second gone by
|
||||
BIT bytcnt
|
||||
BVC out1
|
||||
|
||||
LDX #0 ;reset seconds
|
||||
STX bytcnt
|
||||
|
||||
INC bytcnt+1 ;1 minute gone by
|
||||
BIT bytcnt+1
|
||||
BVC out1
|
||||
|
||||
LDX #0 ;reset minutes
|
||||
STX bytcnt+1
|
||||
|
||||
INC bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 LDX slot
|
||||
|
||||
PHA
|
||||
out2 LDA status,x ;check status
|
||||
AND #%00010000
|
||||
BEQ out2 ;loop until ready
|
||||
PLA
|
||||
|
||||
dataloc STA data ;output byte
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* check for carrier
|
||||
|
||||
chkdcd STX save_x ;dont kill any reg's
|
||||
PHA
|
||||
|
||||
LDX slot ;get offset
|
||||
LDA status,x
|
||||
AND cdbyte ;check carrier
|
||||
CLC
|
||||
BNE chkdcd2
|
||||
|
||||
SEC
|
||||
chkdcd2 PLA restore ;all & return
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
|
||||
setspd STY curspd ;save current speed
|
||||
STX save_x
|
||||
LDX slot ;get offset
|
||||
LDA speed,y ;get speed
|
||||
STA control,x ;set speed
|
||||
|
||||
LDA #1 ;find caller speed (x300)
|
||||
STA callspd
|
||||
CPY #0 ;at 300?
|
||||
BEQ setspd3 ;yep
|
||||
|
||||
ASL callspd ;speed = speed * 2
|
||||
setspd2 ASL callspd ;speed = speed * 2
|
||||
DEY
|
||||
BNE setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei ;re-disable
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* wait routine
|
||||
|
||||
wait SEC from ;apple ][+ ref man - pg 147
|
||||
wait2 PHA
|
||||
wait3 SBC #1
|
||||
BNE wait3
|
||||
PLA
|
||||
SBC #1
|
||||
BNE wait2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* available speeds
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
db %00011111 ;19200
|
||||
|
||||
countlo db 0
|
||||
counthi db 0
|
||||
curspd dfb 0 ;current speed
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
spdata dfb 0 ;speed data
|
||||
save_x dfb 0
|
||||
;end
|
||||
|
||||
asc 'MultiSpd'
|
||||
|
||||
|
|
@ -0,0 +1,377 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* No Carrier Driver
|
||||
*-------------------------------
|
||||
* 3/18/88 AEN
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/nocar
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0 ;location of init string
|
||||
ansstr equ $10c0 ;location of auto-answer string
|
||||
cdbyte equ $10bf ;location of carrier detect mask
|
||||
|
||||
nocar ent
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
slot dfb $20 ;serial card slot
|
||||
initspd dfb 0
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
JMP init
|
||||
JMP ringset
|
||||
JMP ring
|
||||
JMP answer
|
||||
JMP hangup
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
*-------------------------------
|
||||
* init the serial card
|
||||
|
||||
init LDA #0 ;reset bytes
|
||||
LDX slot
|
||||
STA status,x ;reset uart
|
||||
STA command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup for call
|
||||
|
||||
ringset JSR hangup
|
||||
LDA #%00001011 ;turn on DTR, RTS
|
||||
STA command,x
|
||||
|
||||
sei
|
||||
|
||||
LDY initspd ;set init speed
|
||||
JSR setspd
|
||||
|
||||
LDA data,x ;clear data strobe
|
||||
|
||||
rset LDA #0 ;slight delay (let modem do init)
|
||||
JSR wait
|
||||
JSR wait
|
||||
|
||||
JSR chkok ;is modem out there and ready?
|
||||
BCS rset2 ;yep
|
||||
|
||||
LDX #0 ;print modem init string
|
||||
JSR prstr
|
||||
JMP rset
|
||||
|
||||
rset2 LDA #0
|
||||
STA bytcnt ;reset byte counter
|
||||
STA bytcnt+1
|
||||
STA bytcnt+2
|
||||
CLC
|
||||
RTS return
|
||||
|
||||
rset5 JMP ringset ;extend a branch
|
||||
|
||||
*-------------------------------
|
||||
* scan for ring and handle it
|
||||
|
||||
ring LDA #5 ;make sure timer never triggers
|
||||
STA cdcount+2
|
||||
JSR inp ;check for a char
|
||||
BCC ring5 ;nope...
|
||||
|
||||
AND #$7f ;strip high
|
||||
CMP #'3'
|
||||
BEQ rset5 ;no carrier
|
||||
|
||||
LDY #0
|
||||
CMP #'1' ;connect 300
|
||||
BEQ ring3
|
||||
|
||||
INY
|
||||
CMP #'5' ;connect 1200
|
||||
BEQ ring3
|
||||
|
||||
INY
|
||||
CMP #'6' ;connect 2400
|
||||
BEQ ring3
|
||||
|
||||
CMP #'2' ;check for ring
|
||||
CLC
|
||||
BNE ring5 ;nope, nothing
|
||||
|
||||
LDA #0
|
||||
JSR wait ;slight delay
|
||||
JSR wait
|
||||
|
||||
answer LDX #ansstr
|
||||
JSR prstr ;answer the phone
|
||||
CLC
|
||||
RTS
|
||||
|
||||
ring3 JSR setspd ;set the correct speed
|
||||
|
||||
LDY #5
|
||||
ring4 LDA #0 ;let carrier's settle
|
||||
JSR wait
|
||||
DEY
|
||||
BNE ring4
|
||||
|
||||
JSR inp ;gobble extra stuff coming in
|
||||
JSR inp
|
||||
|
||||
LDA #-1 ;set cd status to connected
|
||||
STA cdstat
|
||||
SEC we ;have a connection!
|
||||
ring5 RTS
|
||||
|
||||
*-------------------------------
|
||||
* hangup phone
|
||||
|
||||
hangup LDX slot ;get offset
|
||||
LDA #0
|
||||
STA cdstat
|
||||
STA command,x ;hang up phone
|
||||
JSR wait
|
||||
CLC *** make
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* input data
|
||||
|
||||
inp STX save_y ;save X
|
||||
INC cdcount
|
||||
BNE inp2
|
||||
INC cdcount+1 ;count up tries
|
||||
BNE inp2 ;all is still ok
|
||||
|
||||
DEC cdcount+2 ;count big stuff
|
||||
BNE inp2
|
||||
|
||||
LDA #5 ;reset counter
|
||||
STA cdcount+2
|
||||
|
||||
JSR chkok ;is modem out there?
|
||||
BCC inp2 ;nope, it isnt, must be user
|
||||
|
||||
LDX #0 ;we have lost CD
|
||||
STX cdstat
|
||||
|
||||
inp2 LDX slot ;get offset
|
||||
LDA status,x ;get status
|
||||
AND #%00001000
|
||||
CLC
|
||||
BEQ inp3 ;no data
|
||||
|
||||
LDA #-1
|
||||
STA cdstat ;reset status & counter
|
||||
LDA #0
|
||||
STA cdcount
|
||||
STA cdcount+1
|
||||
LDA #5
|
||||
STA cdcount+2
|
||||
|
||||
LDA data,x ;get data
|
||||
CMP #28 ;kill connection?
|
||||
SEC
|
||||
BNE inp3 ;nope
|
||||
|
||||
LDX #1
|
||||
STX cdcount+2 ;reset counter
|
||||
|
||||
inp3 LDX save_y ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output data
|
||||
|
||||
out STX save_x ;save x
|
||||
DEC timecnt ;count down 1 section
|
||||
BNE out1
|
||||
|
||||
INC bytcnt ;1 second gone by
|
||||
BIT bytcnt
|
||||
BVC out1
|
||||
|
||||
LDX #0 ;reset seconds
|
||||
STX bytcnt
|
||||
|
||||
INC bytcnt+1 ;1 minute gone by
|
||||
BIT bytcnt+1
|
||||
BVC out1
|
||||
|
||||
LDX #0 ;reset minutes
|
||||
STX bytcnt+1
|
||||
|
||||
INC bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 LDX slot
|
||||
|
||||
PHA
|
||||
out2 LDA status,x ;check status
|
||||
PHA
|
||||
AND #%00000100
|
||||
BEQ out3 ;no error, all is well
|
||||
|
||||
LDA data,x
|
||||
CMP #28 ;was is loss of carrier?
|
||||
BNE out3 ;nope
|
||||
|
||||
LDA #1 ;set count down for CD loss
|
||||
STA cdcount+2
|
||||
|
||||
out3 PLA
|
||||
AND #%00010000
|
||||
BEQ out2 ;loop until ready
|
||||
PLA
|
||||
|
||||
dataloc STA data ;output byte
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* check for carrier
|
||||
|
||||
chkdcd LDA cdstat
|
||||
PHA
|
||||
ASL
|
||||
PLA
|
||||
EOR #$ff
|
||||
prstr2 RTS
|
||||
|
||||
*-------------------------------
|
||||
* print control string to modem
|
||||
|
||||
prstr LDA initstr,x ;get data byte
|
||||
BEQ prstr2 ;did it work?
|
||||
|
||||
INX
|
||||
JSR out ;output byte
|
||||
CMP #cr
|
||||
BNE prstr
|
||||
|
||||
LDA #0 ;slight pause
|
||||
JSR wait
|
||||
BEQ prstr ;loop (z-bit always set)
|
||||
|
||||
*-------------------------------
|
||||
* check for OK from question
|
||||
|
||||
chkok LDX #atstr ;send an AT
|
||||
JSR prstr
|
||||
|
||||
LDY #250 ;check 250 times
|
||||
chkok2 DEY count ;down
|
||||
CLC
|
||||
BEQ chkok3 ;no OK gotton
|
||||
|
||||
LDA #40 ;delay slightly
|
||||
JSR wait
|
||||
JSR inp
|
||||
BCC chkok2
|
||||
|
||||
CMP #'0' ;check for "0" for OK
|
||||
BNE chkok2
|
||||
LDA #80
|
||||
JSR wait
|
||||
JSR inp ;gobble EOL char
|
||||
SEC we ;have confirmation
|
||||
chkok3 RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
|
||||
setspd STX save_x
|
||||
LDX slot ;get offset
|
||||
LDA speed,y ;get speed
|
||||
STA control,x ;set speed
|
||||
|
||||
LDA #1 ;find caller speed (x300)
|
||||
STA callspd
|
||||
CPY #0 ;at 300?
|
||||
BEQ setspd3 ;yep
|
||||
|
||||
ASL callspd ;speed = speed * 2
|
||||
setspd2 ASL callspd ;speed = speed * 2
|
||||
DEY
|
||||
BNE setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* wait routine
|
||||
|
||||
wait SEC from ;apple ][+ ref man - pg 147
|
||||
wait2 PHA
|
||||
wait3 SBC #1
|
||||
BNE wait3
|
||||
PLA
|
||||
SBC #1
|
||||
BNE wait2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* available speeds
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
atstr EQU *-initstr
|
||||
asc 'AT'
|
||||
hex 0808
|
||||
asc ' '
|
||||
hex 08082800
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
cdstat dfb 0 ;carrier status
|
||||
cdcount dfb 0,0,0 ;loss of cd counter
|
||||
save_x dfb 0
|
||||
save_y dfb 0
|
||||
|
||||
asc 'Nocarrier'
|
||||
|
||||
|
|
@ -0,0 +1,62 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Date 01/06/87
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/nullmdm
|
||||
|
||||
nullmdm ent
|
||||
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
dfb 0 ;serial card slot
|
||||
dfb 0 ;init modem at?
|
||||
dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
JMP do_rts
|
||||
JMP do_rts
|
||||
JMP ring
|
||||
JMP do_rts
|
||||
JMP do_rts
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp do_rts
|
||||
jmp do_rts ; set irq's
|
||||
jmp do_rts ; raise dtr
|
||||
|
||||
; init the serial card
|
||||
do_rts RTS
|
||||
|
||||
; scan for ring and handle it
|
||||
ring CLC
|
||||
RTS
|
||||
|
||||
; input data
|
||||
inp LDA #0
|
||||
CLC
|
||||
RTS
|
||||
|
||||
; output data
|
||||
out INC bytcnt ;do byte-counting
|
||||
BNE out1
|
||||
INC bytcnt+1
|
||||
BNE out1
|
||||
INC bytcnt+2
|
||||
|
||||
out1 RTS
|
||||
|
||||
; check for carrier
|
||||
chkdcd CLC
|
||||
RTS
|
||||
|
||||
asc 'NullModem'
|
||||
|
||||
|
|
@ -0,0 +1,306 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Single Speed External
|
||||
*-------------------------------
|
||||
* 3/19/88 Andrew E. Nicholas
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/singlespd
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
singlespd ent
|
||||
org $b00
|
||||
|
||||
*-------------------------------
|
||||
* jump table
|
||||
|
||||
slot dfb $20 ;serial card slot
|
||||
initspd dfb 0 ;transmit / receive
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
JMP init
|
||||
JMP ringset
|
||||
JMP ring
|
||||
JMP answer
|
||||
JMP hangup
|
||||
JMP inp
|
||||
JMP out
|
||||
JMP chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
*-------------------------------
|
||||
* init the serial card
|
||||
|
||||
init LDA #0 ;reset
|
||||
LDX slot
|
||||
STA status,x ;reset uart
|
||||
STA command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup for call
|
||||
|
||||
ringset LDX slot ;get offset
|
||||
LDA #%00001011 ;turn on DTR, RTS
|
||||
STA command,x
|
||||
|
||||
sei ;disable ints
|
||||
|
||||
LDY initspd ;set init speed
|
||||
JSR setspd
|
||||
|
||||
LDA data,x ;clear data strobe
|
||||
|
||||
LDA #0 ;long delay
|
||||
JSR wait
|
||||
jsr wait
|
||||
|
||||
LDX #-1 ;start at -1
|
||||
rset2 INX ;do pre-inc
|
||||
lda #$80
|
||||
jsr wait
|
||||
LDA initstr,x ;get modem init string
|
||||
BEQ rset3 ;we are done
|
||||
jmp rset2
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts ;return
|
||||
|
||||
*-------------------------------
|
||||
* scan for ring and handle it
|
||||
|
||||
ring LDX slot ;get offset
|
||||
LDA status,x
|
||||
AND cdbyte ;strip out CD byte
|
||||
CLC
|
||||
BNE ring3 ;nothing
|
||||
|
||||
SEC ;we have a connection
|
||||
LDX #5
|
||||
ring2 LDA #0 ;delay before going online
|
||||
JSR wait
|
||||
DEX
|
||||
BNE ring2
|
||||
JSR inp ;gobble extra
|
||||
SEC
|
||||
|
||||
ring3 RTS
|
||||
|
||||
*-------------------------------
|
||||
* send ata to phone
|
||||
|
||||
answer LDX #0
|
||||
answer2 LDA ansstr,x ;get text
|
||||
BEQ answer3 ;we are donw
|
||||
|
||||
JSR out ;send it
|
||||
|
||||
lda #$80 ;delay a little
|
||||
jsr wait
|
||||
|
||||
INX
|
||||
BNE answer2 ;loop
|
||||
|
||||
answer3 RTS
|
||||
|
||||
*-------------------------------
|
||||
* hangup phone
|
||||
|
||||
hangup LDX slot ;get offset
|
||||
LDA #0
|
||||
STA command,x ;hang up phone
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* input data
|
||||
|
||||
inp STX save_x ;save X
|
||||
LDX slot ;get offset
|
||||
LDA status,x ;get status
|
||||
AND #%00001000
|
||||
CLC
|
||||
BEQ inp2 ;no data
|
||||
|
||||
LDA data,x
|
||||
SEC
|
||||
inp2 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output data
|
||||
|
||||
out STX save_x ;save x
|
||||
DEC timecnt ;count down bytes per second
|
||||
BNE out1 ;not a seconds worth yet
|
||||
|
||||
PHA
|
||||
LDA callspd ;reset counter
|
||||
ASL
|
||||
ASL
|
||||
ASL ;time count = base.rate * 32
|
||||
ASL
|
||||
ASL
|
||||
STA timecnt
|
||||
PLA
|
||||
|
||||
INC bytcnt ;seconds - at 64 yet?
|
||||
BIT bytcnt
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset seconds
|
||||
STX bytcnt
|
||||
|
||||
INC bytcnt+1 ;minutes - at 64 yet?
|
||||
BIT bytcnt+1
|
||||
BVC out1 ;nope
|
||||
|
||||
LDX #0 ;reset minutes
|
||||
STX bytcnt+1
|
||||
|
||||
INC bytcnt+2 ;inc hours
|
||||
|
||||
out1 LDX slot
|
||||
|
||||
PHA
|
||||
out2 LDA status,x ;check status
|
||||
AND #%00010000
|
||||
BEQ out2 ;loop until ready
|
||||
PLA
|
||||
|
||||
dataloc STA data ;self-modified
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* check for carrier sec = we have carrier
|
||||
|
||||
chkdcd STX save_x ;dont kill any reg's
|
||||
PHA
|
||||
|
||||
LDX slot ;get offset
|
||||
LDA status,x
|
||||
AND cdbyte ;check carrier
|
||||
CLC
|
||||
BNE chkdcd2
|
||||
|
||||
SEC
|
||||
chkdcd2 PLA restore ;all & return
|
||||
LDX save_x
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the rs-232 speed [speed offset in Y]
|
||||
|
||||
setspd STX save_x
|
||||
LDX slot ;get offset
|
||||
LDA speed,y ;get speed
|
||||
STA control,x ;set speed
|
||||
|
||||
LDA #1 ;find caller speed (x300)
|
||||
STA callspd
|
||||
CPY #0 ;at 300?
|
||||
BEQ setspd3 ;yep
|
||||
|
||||
ASL callspd ;speed = speed * 2
|
||||
setspd2 ASL callspd ;speed = speed * 2
|
||||
DEY
|
||||
BNE setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 LDX save_x ;restore & return
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei ;re-disable
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* wait routine
|
||||
|
||||
wait SEC ;from apple ][+ ref man - pg 147
|
||||
wait2 PHA
|
||||
wait3 SBC #1
|
||||
BNE wait3
|
||||
PLA
|
||||
SBC #1
|
||||
BNE wait2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* available speeds
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
countlo db 0
|
||||
counthi db 0
|
||||
save_x dfb 0
|
||||
timecnt dfb 0
|
||||
|
||||
asc 'SingleSpd'
|
||||
|
||||
|
|
@ -0,0 +1,329 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* USRobotics HST 19200 Super Serial driver for acos
|
||||
* written by Andy Nicholas on one cold january night
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/ssc.hst
|
||||
org $0b00
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ssc_hst ent
|
||||
|
||||
* jumptable
|
||||
*-------------------------------
|
||||
|
||||
slot db $20 ;serial card slot*16
|
||||
initspd db 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answer
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
* init the serial card
|
||||
*-------------------------------
|
||||
|
||||
init lda #0 ;reset bytes
|
||||
ldx slot
|
||||
sta status,x ;reset uart
|
||||
sta command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset ldx slot ;get offset
|
||||
|
||||
lda #%00000000 ;kill DTR, RTS
|
||||
sta command,x
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
|
||||
sei
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspd
|
||||
|
||||
lda data,x ;clear data strobe
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
loop lda initstr,x ;get modem init string
|
||||
beq rset3
|
||||
jsr out ;output
|
||||
inx
|
||||
bne loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts return
|
||||
|
||||
jring jmp ringset ;extend branch to ringset
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc ring5 ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'E'
|
||||
clc
|
||||
bne ring5 ;keep checking
|
||||
|
||||
ring2 jsr inp ;check for char
|
||||
bcc ring2
|
||||
|
||||
ldy #0 ;def = 300 baud
|
||||
and #$7f ;strip high
|
||||
|
||||
cmp #'R' ;oops, "No Carrier" message
|
||||
beq jring
|
||||
|
||||
cmp #cr ;connect 300
|
||||
beq ring3
|
||||
|
||||
cmp #'3' ;connect 300
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;connect 1200
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;connect 2400
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;connect 4800
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'9' ;connect 9600
|
||||
bne ring2
|
||||
|
||||
ring3 jsr setspd ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec we ;have a connection!
|
||||
ring5 rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #0
|
||||
answer2 lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
inx
|
||||
bne answer2 ;loop
|
||||
|
||||
answer3 rts
|
||||
|
||||
* hangup phone
|
||||
*-------------------------------
|
||||
|
||||
hangup ldx slot ;get offset
|
||||
lda #0
|
||||
sta command,x ;hang up phone
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp stx save_x ;save X
|
||||
ldx slot ;get offset
|
||||
lda status,x ;get status
|
||||
and #%00001000
|
||||
clc
|
||||
beq inp2 ;no data
|
||||
|
||||
lda data,x
|
||||
sec
|
||||
inp2 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out stx save_x ;save x
|
||||
dec timecnt ;count down 1 section
|
||||
bne out1
|
||||
|
||||
inc bytcnt ;1 second gone by
|
||||
bit bytcnt
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset seconds
|
||||
stx bytcnt
|
||||
|
||||
inc bytcnt+1 ;1 minute gone by
|
||||
bit bytcnt+1
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset minutes
|
||||
stx bytcnt+1
|
||||
|
||||
inc bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 ldx slot
|
||||
|
||||
pha
|
||||
out2 lda status,x ;check status
|
||||
and #%00010000
|
||||
beq out2 ;loop until ready
|
||||
pla
|
||||
|
||||
dataloc sta data ;self modified
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* check for carrier
|
||||
*-------------------------------
|
||||
|
||||
chkdcd stx save_x ;dont kill any reg's
|
||||
pha
|
||||
|
||||
ldx slot ;get offset
|
||||
lda status,x
|
||||
and cdbyte ;check carrier
|
||||
clc
|
||||
bne chkdcd2
|
||||
|
||||
sec
|
||||
chkdcd2 pla restore ;all & return
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* set the rs232 speed/19200 always
|
||||
*-------------------------------
|
||||
|
||||
setspd stx save_x
|
||||
ldx slot ;get offset
|
||||
lda speed ;get speed
|
||||
sta control,x ;set speed
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq setspd3 ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspd2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei ;re-disable interrupts
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec ;from apple ][+ ref man - pg 147
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
speed hex 1F ;19200b all we have to worry about
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
save_x dfb 0
|
||||
countlo dfb $FF
|
||||
counthi dfb $FF
|
||||
|
||||
asc 'SSC/HST'
|
||||
|
||||
|
|
@ -0,0 +1,380 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Numeric SSC driver rewritten by Andy Nicholas
|
||||
* October 27, 1988
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/ssc.numeric
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ssc_numeric ent
|
||||
|
||||
org $b00
|
||||
|
||||
* jump table
|
||||
*-------------------------------
|
||||
|
||||
slot hex 20 ;serial card slot*16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
* init the serial card
|
||||
*-------------------------------
|
||||
|
||||
init lda #0 ;reset bytes
|
||||
ldx slot
|
||||
sta status,x ;reset uart
|
||||
sta command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset ldx slot ;get offset
|
||||
|
||||
lda #%00000000 ;kill DTR, RTS
|
||||
sta command,x
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
|
||||
sei
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspd
|
||||
|
||||
lda data,x ;clear data strobe
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
:loop lda #$80
|
||||
jsr wait
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3
|
||||
jsr out ;output
|
||||
inx
|
||||
bne :loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "OK" (numeric)
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts return
|
||||
|
||||
jring jmp ringset ;extend branch to ringset
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noring ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noring ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noring
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noring ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
jmp noring
|
||||
|
||||
********************************
|
||||
ring3 jsr setspd ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noring clc
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
answer2 lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
|
||||
inx
|
||||
bne answer2 ;loop
|
||||
|
||||
answer3 rts
|
||||
|
||||
* hangup phone
|
||||
*-------------------------------
|
||||
|
||||
hangup ldx slot ;get offset
|
||||
lda #0
|
||||
sta command,x ;hang up phone
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp stx save_x ;save X
|
||||
ldx slot ;get offset
|
||||
lda status,x ;get status
|
||||
and #%00001000
|
||||
clc
|
||||
beq inp2 ;no data
|
||||
|
||||
lda data,x
|
||||
sec
|
||||
inp2 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out stx save_x ;save x
|
||||
dec timecnt ;count down 1 section
|
||||
bne out1
|
||||
|
||||
inc bytcnt ;1 second gone by
|
||||
bit bytcnt
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset seconds
|
||||
stx bytcnt
|
||||
|
||||
inc bytcnt+1 ;1 minute gone by
|
||||
bit bytcnt+1
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset minutes
|
||||
stx bytcnt+1
|
||||
|
||||
inc bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 ldx slot
|
||||
|
||||
pha
|
||||
out2 lda status,x ;check status
|
||||
and #%00010000
|
||||
beq out2 ;loop until ready
|
||||
pla
|
||||
|
||||
dataloc sta data ;self modified
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* check for carrier
|
||||
*-------------------------------
|
||||
|
||||
chkdcd stx save_x ;dont kill any reg's
|
||||
pha
|
||||
|
||||
ldx slot ;get offset
|
||||
lda status,x
|
||||
and cdbyte ;check carrier
|
||||
clc
|
||||
bne chkdcd2
|
||||
|
||||
sec
|
||||
chkdcd2 pla restore ;all & return
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* set the rs-232 speed/speed in Y reg
|
||||
*-------------------------------
|
||||
|
||||
setspd stx save_x
|
||||
ldx slot ;get offset
|
||||
lda speed,y ;get speed
|
||||
sta control,x ;set speed
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq setspd3 ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspd2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
save_x dfb 0
|
||||
countlo dfb $FF
|
||||
counthi dfb $FF
|
||||
code ds 2 ;the code we got from the modem
|
||||
asc 'SSC/Numeric'
|
||||
|
||||
|
|
@ -0,0 +1,383 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Numeric SSC driver rewritten by Andy Nicholas
|
||||
* October 27, 1988
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk MODEMS/rel/ssc
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ssc ent
|
||||
|
||||
org $b00
|
||||
|
||||
* jump table
|
||||
*-------------------------------
|
||||
|
||||
slot hex 20 ;serial card slot*16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp chkdcd
|
||||
jmp setspd
|
||||
jmp setirq
|
||||
jmp raisedtr
|
||||
|
||||
* init the serial card
|
||||
*-------------------------------
|
||||
|
||||
init lda #0 ;reset bytes
|
||||
ldx slot
|
||||
sta status,x ;reset uart
|
||||
sta command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset ldx slot ;get offset
|
||||
|
||||
lda #%00000000 ;kill DTR, RTS
|
||||
sta command,x
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
|
||||
sei
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspd
|
||||
|
||||
lda data,x ;clear data strobe
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
:loop lda #$80
|
||||
jsr wait
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3
|
||||
jsr out ;output
|
||||
inx
|
||||
bne :loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "OK" (numeric)
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts return
|
||||
|
||||
jring jmp ringset ;extend branch to ringset
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noRing ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noRing ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
ring3 jsr setspd ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noRing clc
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
answer2 lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
|
||||
inx
|
||||
bne answer2 ;loop
|
||||
|
||||
answer3 rts
|
||||
|
||||
* hangup phone
|
||||
*-------------------------------
|
||||
|
||||
hangup ldx slot ;get offset
|
||||
lda #0
|
||||
sta command,x ;hang up phone
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp stx save_x ;save X
|
||||
ldx slot ;get offset
|
||||
lda status,x ;get status
|
||||
and #%00001000
|
||||
clc
|
||||
beq inp2 ;no data
|
||||
|
||||
lda data,x
|
||||
sec
|
||||
inp2 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out stx save_x ;save x
|
||||
dec timecnt ;count down 1 section
|
||||
bne out1
|
||||
|
||||
inc bytcnt ;1 second gone by
|
||||
bit bytcnt
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset seconds
|
||||
stx bytcnt
|
||||
|
||||
inc bytcnt+1 ;1 minute gone by
|
||||
bit bytcnt+1
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset minutes
|
||||
stx bytcnt+1
|
||||
|
||||
inc bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 ldx slot
|
||||
|
||||
pha
|
||||
out2 lda status,x ;check status
|
||||
and #%00010000
|
||||
beq out2 ;loop until ready
|
||||
pla
|
||||
|
||||
dataloc sta data ;self modified
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* check for carrier
|
||||
*-------------------------------
|
||||
|
||||
chkdcd stx save_x ;dont kill any reg's
|
||||
pha
|
||||
|
||||
ldx slot ;get offset
|
||||
lda status,x
|
||||
and cdbyte ;check carrier
|
||||
clc
|
||||
bne chkdcd2
|
||||
|
||||
sec
|
||||
chkdcd2 pla restore ;all & return
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* set the rs-232 speed/speed in Y reg
|
||||
*-------------------------------
|
||||
|
||||
setspd stx save_x
|
||||
ldx slot ;get offset
|
||||
lda speed,y ;get speed
|
||||
sta control,x ;set speed
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq setspd3 ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspd2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* setup interupt routine
|
||||
|
||||
setirq rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
save_x dfb 0
|
||||
countlo dfb $FF
|
||||
counthi dfb $FF
|
||||
code ds 2 ;the code we got from the modem
|
||||
asc 'SSC/Numeric'
|
||||
|
||||
|
|
@ -0,0 +1,387 @@
|
|||
|
||||
* Numeric SSC driver rewritten by Andy Nicholas
|
||||
* October 27, 1988
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/ssc
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ssc ent
|
||||
|
||||
org $b00
|
||||
|
||||
* jump table
|
||||
*-------------------------------
|
||||
|
||||
slot hex 20 ;serial card slot*16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answerRing
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp chkdcd
|
||||
jmp setspd
|
||||
jmp raisedtr
|
||||
|
||||
* init the serial card
|
||||
*-------------------------------
|
||||
|
||||
init lda #0 ;reset bytes
|
||||
ldx slot
|
||||
sta status,x ;reset uart
|
||||
sta command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset ldx slot ;get offset
|
||||
|
||||
lda #%00000000 ;kill DTR, RTS
|
||||
sta command,x
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
|
||||
sei
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspd
|
||||
|
||||
lda data,x ;clear data strobe
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
:loop lda #$80
|
||||
jsr wait
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3
|
||||
jsr out ;output
|
||||
inx
|
||||
bne :loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'0' ;check for "OK" (numeric)
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave jsr inp ;grab the <cr> off the tail end of the "0"
|
||||
bcc leave
|
||||
|
||||
lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts return
|
||||
|
||||
jring jmp ringset ;extend branch to ringset
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc noRing ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'2' ;is it a 'ring'? (numeric)
|
||||
bne notRing ;nope, check for connect messages
|
||||
|
||||
********************************
|
||||
grabCR jsr inp ;grab the <cr> off the tail end of the "2"
|
||||
bcc grabCR
|
||||
|
||||
answerRing jsr answer ;the phone rang, so send 'ATA'
|
||||
|
||||
clc
|
||||
rts
|
||||
|
||||
********************************
|
||||
notRing
|
||||
cmp #'1' ;is it a '1' or '10' or '11' or '12' or '14'?
|
||||
beq gotCode ;yes, save it
|
||||
cmp #'5' ;is it connect 1200?
|
||||
bne noRing ;nope
|
||||
|
||||
gotCode sta code
|
||||
|
||||
secondChar jsr inp ;second character will ALWAYS be there
|
||||
bcc secondChar
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #cr ;but might be a <cr>
|
||||
bne multiCode
|
||||
|
||||
********************************
|
||||
singleCode ldy #0 ;connect 300?
|
||||
lda code
|
||||
cmp #'1'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'5' ;connect 1200?
|
||||
beq ring3 ;nope, unknown code, keep checking
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
multiCode
|
||||
sta code+1
|
||||
|
||||
ldy #2 ;def = 2400 baud
|
||||
|
||||
lda code ;get the first code char
|
||||
cmp #'1' ;must be a one
|
||||
bne noRing ;if not, then keep trying
|
||||
|
||||
lda code+1 ;is it 2400?
|
||||
cmp #'0'
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;is it 4800?
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;is it 9600
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;is it 19200?
|
||||
beq ring3
|
||||
|
||||
dey
|
||||
cmp #'7' ;is it 9600/ARQ?
|
||||
beq ring3
|
||||
|
||||
dey ;no 4800/arq
|
||||
dey
|
||||
cmp #'6'
|
||||
beq ring3 ;2400/ARQ
|
||||
|
||||
dey
|
||||
cmp #'5' ;1200/ARQ
|
||||
beq ring3
|
||||
|
||||
jmp noRing
|
||||
|
||||
********************************
|
||||
ring3 jsr setspd ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec ;we have a connection!
|
||||
rts
|
||||
|
||||
noring clc
|
||||
rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer lda #$80
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
answer2 lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
|
||||
inx
|
||||
bne answer2 ;loop
|
||||
|
||||
answer3 rts
|
||||
|
||||
* hangup phone
|
||||
*-------------------------------
|
||||
|
||||
hangup ldx slot ;get offset
|
||||
lda #0
|
||||
sta command,x ;hang up phone
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp stx save_x ;save X
|
||||
ldx slot ;get offset
|
||||
lda status,x ;get status
|
||||
and #%00001000
|
||||
clc
|
||||
beq inp2 ;no data
|
||||
|
||||
lda data,x
|
||||
sec
|
||||
inp2 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out stx save_x ;save x
|
||||
dec timecnt ;count down 1 section
|
||||
bne out1
|
||||
|
||||
inc bytcnt ;1 second gone by
|
||||
bit bytcnt
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset seconds
|
||||
stx bytcnt
|
||||
|
||||
inc bytcnt+1 ;1 minute gone by
|
||||
bit bytcnt+1
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset minutes
|
||||
stx bytcnt+1
|
||||
|
||||
inc bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 ldx slot
|
||||
|
||||
pha
|
||||
out2 lda status,x ;check status
|
||||
and #%00010000
|
||||
beq out2 ;loop until ready
|
||||
pla
|
||||
|
||||
dataloc sta data ;self modified
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* check for carrier
|
||||
*-------------------------------
|
||||
|
||||
chkdcd stx save_x ;dont kill any reg's
|
||||
pha
|
||||
|
||||
ldx slot ;get offset
|
||||
lda status,x
|
||||
and cdbyte ;check carrier
|
||||
clc
|
||||
bne chkdcd2
|
||||
|
||||
sec
|
||||
chkdcd2 pla restore ;all & return
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* set the rs-232 speed/speed in Y reg
|
||||
*-------------------------------
|
||||
|
||||
setspd stx save_x
|
||||
ldx slot ;get offset
|
||||
lda speed,y ;get speed
|
||||
sta control,x ;set speed
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq setspd3 ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspd2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
save_x dfb 0
|
||||
countlo dfb $FF
|
||||
counthi dfb $FF
|
||||
code ds 2 ;the code we got from the modem
|
||||
asc 'SSC/Numeric'
|
||||
|
|
@ -0,0 +1,335 @@
|
|||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* USRobotics 2400 driver written by Andy Nicholas
|
||||
* January 19, 1988
|
||||
*-------------------------------
|
||||
|
||||
rel
|
||||
dsk rel/ssc
|
||||
|
||||
cr equ $0d
|
||||
lf equ $0a
|
||||
|
||||
data equ $c088
|
||||
status equ $c089
|
||||
command equ $c08a
|
||||
control equ $c08b
|
||||
|
||||
initstr equ $10d0
|
||||
ansstr equ $10c0
|
||||
cdbyte equ $10bf
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ssc ent
|
||||
|
||||
org $b00
|
||||
|
||||
* jump table
|
||||
*-------------------------------
|
||||
|
||||
slot hex 20 ;serial card slot*16
|
||||
initspd hex 00
|
||||
|
||||
callspd dfb 0 ;speed of call
|
||||
|
||||
bytcnt dfb 0,0,0
|
||||
|
||||
jmp init
|
||||
jmp ringset
|
||||
jmp ring
|
||||
jmp answer
|
||||
jmp hangup
|
||||
jmp inp
|
||||
jmp out
|
||||
jmp chkdcd
|
||||
jmp setspd
|
||||
jmp raisedtr
|
||||
|
||||
* init the serial card
|
||||
*-------------------------------
|
||||
|
||||
init lda #0 ;reset bytes
|
||||
ldx slot
|
||||
sta status,x ;reset uart
|
||||
sta command,x ;reset command
|
||||
|
||||
clc
|
||||
txa
|
||||
adc #<data
|
||||
sta dataloc+1 ;make into absolute save
|
||||
rts
|
||||
|
||||
* setup for call
|
||||
*-------------------------------
|
||||
|
||||
ringset ldx slot ;get offset
|
||||
|
||||
lda #%00000000 ;kill DTR, RTS
|
||||
sta command,x
|
||||
|
||||
lda #0 ;let modem reset
|
||||
jsr wait
|
||||
jsr wait
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
|
||||
sei
|
||||
|
||||
ldy initspd ;set init speed
|
||||
jsr setspd
|
||||
|
||||
lda data,x ;clear data strobe
|
||||
|
||||
lda #0 ;slight delay (let modem do init)
|
||||
jsr wait
|
||||
|
||||
ldx #0
|
||||
:loop lda #$80
|
||||
jsr wait
|
||||
lda initstr,x ;get modem init string
|
||||
beq rset3
|
||||
jsr out ;output
|
||||
inx
|
||||
bne :loop
|
||||
|
||||
rset3 lda #6
|
||||
sta countlo
|
||||
sta counthi
|
||||
|
||||
rset4 ldy #$FF
|
||||
rset5 dey
|
||||
beq decount
|
||||
|
||||
jsr inp
|
||||
bcc rset5
|
||||
and #$7f
|
||||
cmp #'K' ;check for "OK"
|
||||
beq leave
|
||||
jmp rset5
|
||||
|
||||
decount dec countlo
|
||||
bne rset4
|
||||
dec counthi
|
||||
bne rset4
|
||||
jmp ringset
|
||||
|
||||
leave lda #0
|
||||
sta bytcnt ;reset byte counter
|
||||
sta bytcnt+1
|
||||
sta bytcnt+2
|
||||
clc
|
||||
rts return
|
||||
|
||||
jring jmp ringset ;extend branch to ringset
|
||||
|
||||
* scan for ring and handle it
|
||||
*-------------------------------
|
||||
|
||||
ring jsr inp ;check for a char
|
||||
bcc ring5 ;nope...
|
||||
|
||||
and #$7f ;strip high
|
||||
cmp #'E'
|
||||
clc
|
||||
bne ring5 ;keep checking
|
||||
|
||||
ring2 jsr inp ;check for char
|
||||
bcc ring2
|
||||
|
||||
ldy #0 ;def = 300 baud
|
||||
and #$7f ;strip high
|
||||
|
||||
cmp #'R' ;oops, "No Carrier" message
|
||||
beq jring
|
||||
|
||||
cmp #cr ;connect 300
|
||||
beq ring3
|
||||
|
||||
cmp #'3' ;connect 300
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'1' ;connect 1200
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'2' ;connect 2400
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'4' ;connect 4800
|
||||
beq ring3
|
||||
|
||||
iny
|
||||
cmp #'9' ;connect 9600
|
||||
bne ring2
|
||||
|
||||
ring3 jsr setspd ;set the correct speed
|
||||
|
||||
ldy #5
|
||||
ring4 lda #0 ;let carrier's settle
|
||||
jsr wait
|
||||
dey
|
||||
bne ring4
|
||||
|
||||
sec ;we have a connection!
|
||||
ring5 rts
|
||||
|
||||
* send ata to phone
|
||||
*-------------------------------
|
||||
|
||||
answer ldx #0
|
||||
answer2 lda ansstr,x ;get text
|
||||
beq answer3 ;we are done
|
||||
|
||||
jsr out ;send it
|
||||
|
||||
lda #$80
|
||||
jsr wait
|
||||
|
||||
inx
|
||||
bne answer2 ;loop
|
||||
|
||||
answer3 rts
|
||||
|
||||
* hangup phone
|
||||
*-------------------------------
|
||||
|
||||
hangup ldx slot ;get offset
|
||||
lda #0
|
||||
sta command,x ;hang up phone
|
||||
rts
|
||||
|
||||
* input data
|
||||
*-------------------------------
|
||||
|
||||
inp stx save_x ;save X
|
||||
ldx slot ;get offset
|
||||
lda status,x ;get status
|
||||
and #%00001000
|
||||
clc
|
||||
beq inp2 ;no data
|
||||
|
||||
lda data,x
|
||||
sec
|
||||
inp2 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
* output data
|
||||
*-------------------------------
|
||||
|
||||
out stx save_x ;save x
|
||||
dec timecnt ;count down 1 section
|
||||
bne out1
|
||||
|
||||
inc bytcnt ;1 second gone by
|
||||
bit bytcnt
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset seconds
|
||||
stx bytcnt
|
||||
|
||||
inc bytcnt+1 ;1 minute gone by
|
||||
bit bytcnt+1
|
||||
bvc out1
|
||||
|
||||
ldx #0 ;reset minutes
|
||||
stx bytcnt+1
|
||||
|
||||
inc bytcnt+2 ;1 hour gone by
|
||||
|
||||
out1 ldx slot
|
||||
|
||||
pha
|
||||
out2 lda status,x ;check status
|
||||
and #%00010000
|
||||
beq out2 ;loop until ready
|
||||
pla
|
||||
|
||||
dataloc sta data ;self modified
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* check for carrier
|
||||
*-------------------------------
|
||||
|
||||
chkdcd stx save_x ;dont kill any reg's
|
||||
pha
|
||||
|
||||
ldx slot ;get offset
|
||||
lda status,x
|
||||
and cdbyte ;check carrier
|
||||
clc
|
||||
bne chkdcd2
|
||||
|
||||
sec
|
||||
chkdcd2 pla restore ;all & return
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* set the rs-232 speed/speed in Y reg
|
||||
*-------------------------------
|
||||
|
||||
setspd stx save_x
|
||||
ldx slot ;get offset
|
||||
lda speed,y ;get speed
|
||||
sta control,x ;set speed
|
||||
|
||||
lda #1 ;find caller speed (x300)
|
||||
sta callspd
|
||||
cpy #0 ;at 300?
|
||||
beq setspd3 ;yep
|
||||
|
||||
asl callspd ;speed = speed * 2
|
||||
setspd2 asl callspd ;speed = speed * 2
|
||||
dey
|
||||
bne setspd2 ;loop until correct speed found
|
||||
|
||||
setspd3 ldx save_x ;restore & return
|
||||
rts
|
||||
|
||||
*-------------------------------
|
||||
* turn on dtr/rts
|
||||
|
||||
raisedtr stx save_x
|
||||
ldx slot
|
||||
|
||||
lda #%00001011 ;turn on DTR, RTS
|
||||
sta command,x
|
||||
sei
|
||||
|
||||
ldx save_x
|
||||
rts
|
||||
|
||||
* wait routine
|
||||
*-------------------------------
|
||||
|
||||
wait sec
|
||||
wait2 pha
|
||||
wait3 sbc #1
|
||||
bne wait3
|
||||
pla
|
||||
sbc #1
|
||||
bne wait2
|
||||
rts
|
||||
|
||||
* global data area
|
||||
*-------------------------------
|
||||
|
||||
speed dfb %00010110 ;300
|
||||
dfb %00011000 ;1200
|
||||
dfb %00011010 ;2400
|
||||
dfb %00011100 ;4800
|
||||
dfb %00011110 ;9600
|
||||
dfb %00011111 ;19200
|
||||
|
||||
timecnt dfb 0 ;1-second counter
|
||||
save_x dfb 0
|
||||
countlo dfb $FF
|
||||
counthi dfb $FF
|
||||
|
||||
asc 'SSC'
|
||||
|
||||
|
|
@ -0,0 +1,566 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Config Program - Ospjunk
|
||||
*-------------------------------
|
||||
* Date: 12/2/89
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
temp = 0
|
||||
temp2 = 2
|
||||
temp3 = 4
|
||||
temp4 = 6
|
||||
|
||||
fmparm = $60
|
||||
doszero = $62
|
||||
dosptr = $64
|
||||
part = $66
|
||||
dosbyt = $68
|
||||
|
||||
lnbuf = $200
|
||||
flname = $300
|
||||
devnam = $800
|
||||
fbuf1 = $1C00
|
||||
fnam1 = $1E00
|
||||
fbuf2 = fbuf1
|
||||
fnam2 = fnam1
|
||||
msgbuf = fbuf1
|
||||
msgnam = fnam1
|
||||
miscbuf = fbuf1
|
||||
miscnam = fnam1
|
||||
|
||||
copybuf = $6000
|
||||
copymax = $5800
|
||||
mli = $BF00
|
||||
|
||||
DSK REL/OSPJUNK
|
||||
|
||||
cls EXT
|
||||
print EXT
|
||||
inpln EXT
|
||||
inpmode EXT
|
||||
maxlen EXT
|
||||
ld_drvs EXT
|
||||
getname EXT
|
||||
open EXT
|
||||
geteof EXT
|
||||
rdblk EXT
|
||||
close EXT
|
||||
create EXT
|
||||
wrblk EXT
|
||||
refnum EXT
|
||||
slot EXT
|
||||
drive EXT
|
||||
|
||||
*-------------------------------
|
||||
* load the acos.obj file after find out where it is
|
||||
|
||||
drv_path ENT
|
||||
JSR cls ; clear screen
|
||||
|
||||
JSR print
|
||||
ASC 'Please enter the pathname of the volume or'
|
||||
ASC ' subdirectory which contains the'0D0D
|
||||
ASC 'file: LLUCE.DRIVERS'0D0D0D
|
||||
ASC 'Path: /'00
|
||||
|
||||
LDA #32 ; set maximum pathname at 32
|
||||
STA maxlen
|
||||
LDA #%11000000
|
||||
STA inpmode ; set input mode
|
||||
|
||||
JSR inpln
|
||||
INY
|
||||
STY lnbuf-2 ; save length
|
||||
LDA #'/'
|
||||
STA lnbuf-1 ; save initial '/'
|
||||
|
||||
JSR mli
|
||||
DB $C6 ; set prefix
|
||||
DA p_spfx
|
||||
BCS drv_p2 ; error
|
||||
|
||||
JSR mli
|
||||
DB $C7 ; get prefix and put into
|
||||
DA p_pfx4 ; program byffer
|
||||
|
||||
JSR ld_drvs ; load in the stats
|
||||
BCC logcon ; all is ok
|
||||
|
||||
drv_p2 JMP drv_path ; opps, error
|
||||
|
||||
|
||||
*-------------------------------
|
||||
* log back to the config disk
|
||||
; log back to config disk
|
||||
logcon ENT
|
||||
JSR mli
|
||||
DB $C6 ; set prefix
|
||||
DA p_pfx2
|
||||
; ... later, add in error checking
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* log the destination disk
|
||||
|
||||
logdst ENT
|
||||
JSR mli
|
||||
DB $C6
|
||||
DA p_pfx3
|
||||
; ... later, add in error checking
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* log the program disk
|
||||
|
||||
logprg ENT
|
||||
LDA prgpfx ; has a program prefix been defined?
|
||||
BEQ logcon ; nope, log to config disk
|
||||
|
||||
JSR mli
|
||||
DB $C6 ; log to program disk (with LLUCE.SYSTEM)
|
||||
DA p_pfx4
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* move filename to user routine
|
||||
|
||||
movname ENT
|
||||
STX dosbyt ; point to filename
|
||||
STA dosbyt+1
|
||||
|
||||
LDY #15
|
||||
:movnam2 LDA (dosbyt),y ; copy filename
|
||||
STA flname,y
|
||||
DEY
|
||||
BPL :movnam2
|
||||
RTS
|
||||
; variables and stuff
|
||||
msgref ENT
|
||||
DB 0
|
||||
module DB 0
|
||||
sdvparm DB 0,0,0
|
||||
|
||||
|
||||
copyrts JMP logcon ; log back to main
|
||||
|
||||
*-------------------------------
|
||||
* copy a list of files
|
||||
|
||||
copy ENT
|
||||
STX temp4 ; save pointer for getname
|
||||
STA temp4+1
|
||||
|
||||
:copy2 JSR getname ; get source name
|
||||
BCS copyrts
|
||||
|
||||
JSR logcon ; log to config disk
|
||||
|
||||
LDX #<flname ; get info on file
|
||||
LDA #>flname
|
||||
JSR getinfo
|
||||
BNE :copy2 ; opps, error, skip this file
|
||||
|
||||
JSR open
|
||||
JSR geteof ; get eof marker
|
||||
STX p_geof+2
|
||||
STA p_geof+3 ; save marker
|
||||
STA temp
|
||||
CPX #0 ; save number of pages to read
|
||||
BEQ *+4
|
||||
INC temp
|
||||
|
||||
LDX #<copybuf
|
||||
LDA #>copybuf
|
||||
LDY #>copymax*2 ; get maximum ram space
|
||||
JSR rdblk
|
||||
|
||||
JSR close ; close the file
|
||||
|
||||
JSR logdst ; log to destination
|
||||
|
||||
LDY #0 ; use type $00
|
||||
JSR create ; create file
|
||||
|
||||
JSR open ; open file
|
||||
|
||||
LDA temp
|
||||
ASL ; get number of blocks (1/2 pages) to write
|
||||
TAY
|
||||
LDX #<copybuf
|
||||
LDA #>copybuf
|
||||
JSR wrblk ; write out the block
|
||||
|
||||
JSR seteof ; set end of file
|
||||
JSR close
|
||||
|
||||
LDX #<flname
|
||||
LDA #>flname
|
||||
JSR setinfo ; set file info
|
||||
JMP :copy2
|
||||
|
||||
*-------------------------------
|
||||
* get info on a file
|
||||
|
||||
getinfo ENT
|
||||
STX p_ginfo+1 ; point to filename
|
||||
STA p_ginfo+2
|
||||
LDA #10
|
||||
STA p_ginfo
|
||||
|
||||
JSR mli
|
||||
DB $C4 ; get info
|
||||
DA p_ginfo
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the file info
|
||||
|
||||
setinfo ENT
|
||||
STX p_ginfo+1 ; point to filename
|
||||
STA p_ginfo+2
|
||||
LDA #7
|
||||
STA p_ginfo
|
||||
|
||||
JSR mli
|
||||
DB $C3 ; set info
|
||||
DA p_ginfo
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* set the current end of file
|
||||
|
||||
puteof ENT
|
||||
STX p_geof+2 ; set eof marker
|
||||
STA p_geof+3
|
||||
|
||||
seteof ENT
|
||||
LDA refnum
|
||||
STA p_geof+1
|
||||
|
||||
JSR mli
|
||||
DB $D0 ; set eof
|
||||
DA p_geof
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* rename a file
|
||||
|
||||
rename ENT
|
||||
STX temp4 ; point to data
|
||||
STA temp4+1
|
||||
JSR getname ; get first name
|
||||
|
||||
LDY #63
|
||||
:ren2 LDA flname,y ; copy first name
|
||||
STA lnbuf+128,y
|
||||
DEY
|
||||
BPL :ren2
|
||||
|
||||
JSR getname ; get new name
|
||||
|
||||
JSR mli
|
||||
DB $C2 ; rename file
|
||||
DA p_ren
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* find the config disk
|
||||
|
||||
findcon ENT
|
||||
LDX #23
|
||||
LDA #0
|
||||
:loop STA $BF58,x ; clear prodos system bit-map
|
||||
DEX
|
||||
BNE :loop
|
||||
|
||||
JSR mli
|
||||
DB $C7 ; get prefix
|
||||
DA p_pfx2 ; point to path
|
||||
|
||||
LDA conpfx ; is prefix set to null?
|
||||
BNE :findc2 ; nope
|
||||
|
||||
LDA $BF30 ; get current slot/drive
|
||||
STA p_onlin+1
|
||||
|
||||
JSR mli
|
||||
DB $C5 ; find out prefix of volume
|
||||
DA p_onlin
|
||||
|
||||
LDA conpfx+1
|
||||
AND #$F ; just save name length
|
||||
clc
|
||||
adc #1 ; advance length of prefix
|
||||
STA conpfx
|
||||
|
||||
LDA #'/' ; add leading slash for volume name
|
||||
STA conpfx+1
|
||||
|
||||
:findc2 JMP logcon ; log to config
|
||||
|
||||
*-------------------------------
|
||||
* check free space on volume
|
||||
|
||||
chkspc ENT
|
||||
LDA drive
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
ORA slot ; make into #dsss0000 format
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
|
||||
STA p_onln+1
|
||||
JSR mli
|
||||
DB $C5 ; get drive name
|
||||
DA p_onln
|
||||
BEQ :chkspc2 ; all is well
|
||||
|
||||
LDA #0 ; return 0 blocks free -- error
|
||||
TAX
|
||||
RTS
|
||||
|
||||
:chkspc2 LDA dstpfx+1
|
||||
AND #$F
|
||||
TAX ; make into volume name
|
||||
INX
|
||||
STX dstpfx
|
||||
LDA #'/'
|
||||
STA dstpfx+1
|
||||
|
||||
LDX #<dstpfx
|
||||
LDA #>dstpfx ; get info on volume
|
||||
JSR getinfo
|
||||
|
||||
SEC
|
||||
LDA p_ginfo+5 ; return total number of free blocks
|
||||
SBC p_ginfo+8
|
||||
TAX
|
||||
LDA p_ginfo+6
|
||||
SBC p_ginfo+9
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup initial drive spec list
|
||||
|
||||
setspec ENT
|
||||
JSR chkspc ;reset path to original drive
|
||||
|
||||
JSR makesegs ;tack the /mpro.segs on path
|
||||
|
||||
LDY #0
|
||||
LDA #1
|
||||
JSR coppath ;copy 1 path (A:)
|
||||
|
||||
STY temp
|
||||
JSR chkspc ;reset path
|
||||
JSR makesys
|
||||
LDY temp
|
||||
|
||||
LDA #3 ;copy 3 more paths
|
||||
JSR coppath ;b: - d:
|
||||
|
||||
LDA settrans ;transfer wanted?
|
||||
BNE :trans
|
||||
LDA #3 ;paths to copy
|
||||
JMP :notrans
|
||||
|
||||
:trans STY temp
|
||||
JSR maketac1
|
||||
JSR maketac2
|
||||
LDY temp
|
||||
|
||||
LDA #1
|
||||
JSR coppath ;copy one path (E:)
|
||||
|
||||
STY temp
|
||||
JSR chkspc
|
||||
JSR makesys
|
||||
LDY temp
|
||||
|
||||
LDA #2 ;fill out 2 specs
|
||||
:notrans JSR coppath
|
||||
|
||||
LDA #0 ; mark end of path's
|
||||
STA devnam,y
|
||||
|
||||
RTS
|
||||
|
||||
settrans ENT
|
||||
DB 0
|
||||
|
||||
*-------------------------------
|
||||
* copy a path onto the pathname
|
||||
|
||||
coppath STA temp
|
||||
|
||||
:loop6 LDX #-1
|
||||
:loop5 INX
|
||||
LDA dstpfx,x ; copy in pathname
|
||||
STA devnam,y
|
||||
INY
|
||||
CPX dstpfx ; done?
|
||||
BNE :loop5 ; nope
|
||||
|
||||
DEC temp ; count down paths to enter
|
||||
BNE :loop6
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup /xxx/mpro.segs and log it
|
||||
|
||||
makesegs ENT
|
||||
LDX #0
|
||||
LDY dstpfx
|
||||
:loop LDA pfxname+1,x ; copy on /xxxx/mpro.segs
|
||||
STA dstpfx+1,y
|
||||
INX
|
||||
INY
|
||||
INC dstpfx ; update length
|
||||
CPX pfxname
|
||||
BNE :loop
|
||||
RTS
|
||||
|
||||
setdrv ENT
|
||||
JSR makesegs
|
||||
JSR mli
|
||||
DB $C0 ; create new path
|
||||
DA p_crpth
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup /mpro.sys and log it
|
||||
|
||||
makesys ENT
|
||||
LDX #0
|
||||
LDY dstpfx
|
||||
:loop LDA sysname+1,x ; copy on /xxxx/mpro.sys
|
||||
STA dstpfx+1,y
|
||||
INX
|
||||
INY
|
||||
INC dstpfx ; update length
|
||||
CPX sysname
|
||||
BNE :loop
|
||||
RTS
|
||||
|
||||
setsys ENT
|
||||
JSR makesys
|
||||
|
||||
JSR mli
|
||||
DB $C0 ; create new path
|
||||
DA p_crpth
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* setup /stac and log it
|
||||
|
||||
maketac1 ENT
|
||||
LDX #0
|
||||
LDY dstpfx
|
||||
:loop LDA tac1+1,x ; copy on /xxxx/mpro.sys/stac
|
||||
STA dstpfx+1,y
|
||||
INX
|
||||
INY
|
||||
INC dstpfx ; update length
|
||||
CPX tac1
|
||||
BNE :loop
|
||||
RTS
|
||||
|
||||
maketac2 ENT
|
||||
LDX #0
|
||||
LDY dstpfx
|
||||
:loop LDA tac2+1,x ; copy on /xxxx/mpro.sys/stac/vol./
|
||||
STA dstpfx+1,y
|
||||
INX
|
||||
INY
|
||||
INC dstpfx ; update length
|
||||
CPX tac2
|
||||
BNE :loop
|
||||
RTS
|
||||
|
||||
settac ENT
|
||||
JSR maketac1
|
||||
JSR mli ; create /xxx/mpro.sys/stac/
|
||||
DB $C0 ; create new path
|
||||
DA p_crpth
|
||||
|
||||
JSR maketac2
|
||||
JSR mli ; create /xxx/mpro.sys/stac/vol./
|
||||
DB $C0 ; create new path
|
||||
DA p_crpth
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* variables
|
||||
|
||||
pfxname STR '/MPRO.SEGS'
|
||||
sysname STR '/MPRO.SYS'
|
||||
tac1 STR '/STAC'
|
||||
tac2 STR '/VOL.'
|
||||
|
||||
p_spfx DB 1
|
||||
DA lnbuf-2
|
||||
|
||||
p_geof DB 2
|
||||
DB 0
|
||||
DB 0,0,0
|
||||
|
||||
p_ginfo DB $A
|
||||
DA 0
|
||||
DB 0
|
||||
DB 0
|
||||
DA 0
|
||||
DB 0
|
||||
DA 0
|
||||
DA 0
|
||||
DA 0
|
||||
DA 0
|
||||
DA 0
|
||||
|
||||
p_ren DB 2
|
||||
DA lnbuf+128
|
||||
DA flname
|
||||
|
||||
p_pfx DB 1
|
||||
DA lnbuf
|
||||
|
||||
p_pfx2 ENT
|
||||
DB 1
|
||||
DA conpfx
|
||||
|
||||
p_pfx3 DB 1
|
||||
DA dstpfx
|
||||
|
||||
p_pfx4 DB 1
|
||||
DA prgpfx
|
||||
|
||||
conpfx DS 40 ; max length
|
||||
|
||||
dstpfx ENT
|
||||
DS 40 ; max length
|
||||
|
||||
prgpfx DS 40 ; max length
|
||||
|
||||
p_onlin DB 2
|
||||
DB 0
|
||||
DA conpfx+1
|
||||
|
||||
p_onln DB 2
|
||||
DB 0
|
||||
DA dstpfx+1
|
||||
|
||||
p_crpth ENT
|
||||
DB 7
|
||||
DA dstpfx
|
||||
DB $C3
|
||||
DB $F
|
||||
DA 0
|
||||
DB $D
|
||||
DA 0
|
||||
DA 0
|
||||
|
||||
|
|
@ -0,0 +1,118 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* Printer re-configuration
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
prdrv = $900
|
||||
point0 = $11
|
||||
point1 = $14
|
||||
|
||||
DSK REL/PRINTER
|
||||
|
||||
TopBox EXT
|
||||
print EXT
|
||||
cls EXT
|
||||
start EXT
|
||||
escape EXT
|
||||
inpnum EXT
|
||||
chinit EXT
|
||||
wrtchg EXT
|
||||
|
||||
|
||||
nullprnt EXT ;null printer driver
|
||||
serial EXT ;serial/cout printer driver
|
||||
grappler EXT ;parallel grappler printer driver
|
||||
parallel EXT ;parallel printer driver
|
||||
|
||||
re_pr ENT
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,29
|
||||
ASC '- Printer Interfaces -'
|
||||
DB 1,4,5
|
||||
ASC 'Please refer to Appendix B of your user'
|
||||
ASC ' manual for more information.'00
|
||||
|
||||
JSR cls
|
||||
LDX #<start ; setup esc handler
|
||||
LDA #>start
|
||||
JSR escape
|
||||
|
||||
LDA #<prdrv ;tell it to move the modem
|
||||
STA point1 ;driver
|
||||
LDA #>prdrv
|
||||
STA point1+1
|
||||
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC ' 1 - Apple //c built-in port '
|
||||
ASC ' 7 - Apple Parallel interface'0D
|
||||
ASC ' 2 - Apple Super Serial Card (SSC) '
|
||||
ASC ' 8 - Epson APL printer card'0D
|
||||
ASC ' 3 - Apple IIgs built-in port '
|
||||
ASC ' 9 - Appricorn Parallel card'0D
|
||||
ASC ' 4 - Generic Printer Driver '
|
||||
ASC '10 - Tyvec Printer Interface'0D
|
||||
ASC ' 5 - Star Micronics Grafstar '
|
||||
ASC '11 - No Printer in system'0D
|
||||
ASC ' 6 - Orange Micro Grappler card'0D0D0D
|
||||
ASC 'Which? [1-11] '00
|
||||
|
||||
LDX #11 ;get printer #
|
||||
JSR inpnum
|
||||
|
||||
CMP #5
|
||||
BLT :serial
|
||||
CMP #7
|
||||
BLT :grappler
|
||||
CMP #11
|
||||
BLT :parallel
|
||||
|
||||
:null LDA #<nullprnt
|
||||
STA point0
|
||||
LDA #>nullprnt
|
||||
STA point0+1
|
||||
JMP :noslot
|
||||
|
||||
:serial LDA #<serial
|
||||
LDX #>serial
|
||||
JMP :getslot
|
||||
|
||||
:grappler LDA #<grappler
|
||||
LDX #>grappler
|
||||
JMP :getslot
|
||||
|
||||
:parallel LDA #<parallel
|
||||
LDX #>parallel
|
||||
|
||||
:getslot STA point0
|
||||
STX point0+1
|
||||
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'What slot/port does your printer use? [1-7] '00
|
||||
|
||||
LDX #7 ; get slot
|
||||
JSR inpnum
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
ASL
|
||||
:noslot PHA ;save slot
|
||||
|
||||
LDY #0 ;move the single page
|
||||
:loop LDA (point0),Y ;source
|
||||
STA (point1),Y ;destination
|
||||
INY
|
||||
BNE :loop
|
||||
|
||||
LDY #0
|
||||
PLA ;get the slot back
|
||||
STA (point1),Y
|
||||
|
||||
JSR chinit ; check for init
|
||||
JMP wrtchg ; write the changes
|
||||
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* Grappler Printer Driver *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 12/07/86
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK PRINTERS/REL/GRAPPLER
|
||||
|
||||
cr = $D
|
||||
lf = $A
|
||||
|
||||
grappler ENT
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ORG $900
|
||||
; jump table
|
||||
slot DB $10
|
||||
|
||||
JMP init
|
||||
JMP print
|
||||
JMP clear
|
||||
|
||||
*-------------------------------
|
||||
* init printer
|
||||
|
||||
init RTS ; no init code needed
|
||||
|
||||
*-------------------------------
|
||||
* print character: A = character
|
||||
|
||||
print PHA
|
||||
STX save_x
|
||||
|
||||
LDX slot
|
||||
print2 LDA $C080,X ; check printer status
|
||||
AND #%00000111 ; check busy/wait bits
|
||||
EOR #%00000011 ; turn all bits off
|
||||
BNE print2 ; wait to come ready
|
||||
|
||||
PLA
|
||||
PHA
|
||||
AND #$7F
|
||||
STA $C080,X ; print data
|
||||
CMP #cr
|
||||
BNE print3
|
||||
|
||||
LDA #lf ; add lf to cr
|
||||
LDX save_x
|
||||
JSR print
|
||||
|
||||
print3 LDX save_x ; finish up
|
||||
PLA
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* clear print buffer (not available)
|
||||
|
||||
clear RTS
|
||||
|
||||
save_x DB 0
|
||||
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* No Printer Driver *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 01/03/86
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK PRINTERS/REL/NULL
|
||||
|
||||
nullprnt ENT
|
||||
|
||||
ORG $900
|
||||
; jump table
|
||||
slot DB $10
|
||||
|
||||
JMP init
|
||||
JMP print
|
||||
JMP clear
|
||||
|
||||
; init printer
|
||||
init RTS
|
||||
|
||||
; print character: A = character
|
||||
print RTS
|
||||
|
||||
; clear print buffer (not available)
|
||||
clear RTS
|
||||
|
||||
|
|
@ -0,0 +1,72 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* Parallel Printer Driver *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 12/07/86
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK PRINTERS/REL/PARALLEL
|
||||
|
||||
cr = $D
|
||||
lf = $A
|
||||
|
||||
parallel ENT
|
||||
|
||||
*-------------------------------
|
||||
|
||||
ORG $900
|
||||
|
||||
slot DB $10
|
||||
|
||||
JMP init
|
||||
JMP print
|
||||
JMP clear
|
||||
|
||||
*-------------------------------
|
||||
|
||||
init LDA slot
|
||||
LUP 4
|
||||
LSR
|
||||
--^
|
||||
CLC
|
||||
ADC #$C0 ; get $Cx value
|
||||
STA print2+2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* print character: A = character
|
||||
|
||||
print PHA
|
||||
STX save_x
|
||||
print2 LDA $C1C1 ; is printer ready?
|
||||
BMI print2 ; nope
|
||||
|
||||
PLA
|
||||
PHA
|
||||
LDX slot ; get offset
|
||||
AND #$7F
|
||||
STA $C080,x ; print data
|
||||
CMP #cr
|
||||
BNE print3
|
||||
|
||||
LDA #lf ; add lf to cr
|
||||
LDX save_x
|
||||
JSR print
|
||||
|
||||
print3 LDX save_x ; finish up
|
||||
PLA
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
clear RTS
|
||||
|
||||
save_x DB 0
|
||||
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* Serial Printer Driver *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 12/07/86
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
DSK PRINTERS/REL/SERIAL
|
||||
|
||||
cr = $D
|
||||
lf = $A
|
||||
|
||||
serial ENT
|
||||
|
||||
ORG $900
|
||||
|
||||
*-------------------------------
|
||||
; jump table
|
||||
slot DB $10
|
||||
|
||||
JMP init
|
||||
JMP print
|
||||
JMP clear
|
||||
|
||||
*-------------------------------
|
||||
* flag init status for output
|
||||
|
||||
init PHA
|
||||
LDA #0 ; signal that printer not init'ed
|
||||
STA initflg
|
||||
PLA
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* print character: A = character
|
||||
|
||||
print PHP ; disable int's
|
||||
SEI
|
||||
PHA ; save all reg's
|
||||
STX save_x
|
||||
STY save_y
|
||||
LDA $C082 ; enable roms
|
||||
|
||||
LDX #$13
|
||||
print1 LDA $24,X ; save zero page stuff
|
||||
STA zero,X
|
||||
DEX
|
||||
BPL print1
|
||||
|
||||
BIT initflg ; has printer been used?
|
||||
BMI print3 ; yep
|
||||
|
||||
LDA slot
|
||||
STA $26 ; save slot for card
|
||||
LUP 4
|
||||
LSR ; move down slot
|
||||
--^
|
||||
CLC
|
||||
ADC #$C0
|
||||
STA print2+2
|
||||
STA $36+1 ; point ($0036) at $c100
|
||||
|
||||
LDA #0 ; init printer card
|
||||
TAX
|
||||
TAY
|
||||
STA $24 ; zero horiz offset
|
||||
STA $27 ; zero character buffer
|
||||
STA $36
|
||||
print2 JSR $C100
|
||||
LDA $36 ; point to output routine
|
||||
STA jprint+1
|
||||
LDA $36+1
|
||||
STA jprint+2
|
||||
DEC initflg ; show we have done init
|
||||
|
||||
LDA #'I'-$40 ; send ctrl-I 80 n
|
||||
JSR doprint
|
||||
LDA #'8'
|
||||
JSR doprint
|
||||
LDA #'0'
|
||||
JSR doprint
|
||||
LDA #'N'
|
||||
JSR doprint
|
||||
LDA #cr
|
||||
JSR doprint
|
||||
|
||||
print3 LDA #0 ; set ch over to border
|
||||
STA $24
|
||||
PLA ; get byte to print
|
||||
PHA
|
||||
JSR doprint
|
||||
|
||||
LDX #$13
|
||||
print4 LDA zero,X ; restore zero page
|
||||
STA $24,X
|
||||
DEX
|
||||
BPL print4
|
||||
|
||||
LDA $C083 ; enable ram card
|
||||
LDA $C083
|
||||
LDX save_x ; restore reg's
|
||||
LDY save_y
|
||||
PLA
|
||||
PLP ; restore int status
|
||||
RTS
|
||||
|
||||
doprint ORA #$80 ; print with high-bit set
|
||||
jprint JMP $C000 ; do output routine
|
||||
|
||||
; clear print buffer (not available)
|
||||
clear RTS
|
||||
|
||||
save_x DB 0
|
||||
save_y DB 0
|
||||
initflg DB 0
|
||||
|
||||
zero DS $14
|
||||
|
||||
|
|
@ -0,0 +1,663 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* Config Program - Routine *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
cr = $D ; cariage return
|
||||
bs = 8 ; backspace
|
||||
can = $18 ; ctrl-x
|
||||
esc = $27 ; escape
|
||||
del = $7F ; delete
|
||||
|
||||
temp = 0
|
||||
temp2 = 2
|
||||
*temp3 = 4
|
||||
temp4 = 6
|
||||
x_save = 9
|
||||
y_save = $A
|
||||
numptr = $1A
|
||||
psave = $1C
|
||||
prnt = $1E
|
||||
|
||||
ch = $24
|
||||
cv = $25
|
||||
|
||||
lnbuf = $200
|
||||
flname = $300
|
||||
|
||||
DSK REL/ROUTINE
|
||||
|
||||
cout EXT ; routine that are external to this one
|
||||
plotchr EXT
|
||||
|
||||
*-------------------------------
|
||||
* print a line of text
|
||||
*-------------------------------
|
||||
|
||||
print ENT
|
||||
STA psave ; save all reg's
|
||||
STY psave+1
|
||||
PLA
|
||||
STA prnt ; point to address of data
|
||||
PLA
|
||||
STA prnt+1
|
||||
|
||||
:print2 INC prnt ; inc address
|
||||
BNE :print3
|
||||
INC prnt+1
|
||||
|
||||
:print3 LDY #0
|
||||
LDA (prnt),Y ; get data
|
||||
CMP #1
|
||||
BNE :pr3a
|
||||
|
||||
:pr3v JSR gettmp
|
||||
JSR gettmp ; get horiz/vert address
|
||||
STA cv
|
||||
JSR gettmp
|
||||
STA ch
|
||||
JMP :print3
|
||||
|
||||
:pr3a PHA
|
||||
JSR cout ; display it
|
||||
PLA
|
||||
BNE :print2 ; keep going
|
||||
|
||||
JSR gettmp
|
||||
LDA psave
|
||||
LDY psave+1
|
||||
JMP (prnt)
|
||||
|
||||
*-------------------------------
|
||||
* get a byte from temp and advance pointers
|
||||
*-------------------------------
|
||||
|
||||
gettmp ENT
|
||||
LDY #0
|
||||
LDA (prnt),Y
|
||||
INC prnt
|
||||
BNE :gettmp2
|
||||
INC prnt+1
|
||||
:gettmp2 RTS
|
||||
|
||||
*-------------------------------
|
||||
* put a cursor, get a key, remove cursor, return
|
||||
*-------------------------------
|
||||
|
||||
rdkey ENT
|
||||
STX x_save ; save x & y
|
||||
STY y_save
|
||||
LDA #$5F
|
||||
JSR plotchr ; bypass cout for speed
|
||||
|
||||
:rdkey2 LDA $C000 ; check for a key
|
||||
BPL :rdkey2
|
||||
STA $C010 ; reset flag
|
||||
AND #$7F
|
||||
|
||||
STA $C030
|
||||
STA $C030 ; audio feedback
|
||||
|
||||
PHA
|
||||
LDA #' ' ; remove cursor
|
||||
JSR plotchr
|
||||
PLA
|
||||
LDX x_save
|
||||
LDY y_save
|
||||
JSR chk_esc ; check for escape
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* get a line of input
|
||||
*-------------------------------
|
||||
|
||||
inpln ENT
|
||||
LDY #0 ; start at first byte
|
||||
:inpln1 JSR rdkey ; get data
|
||||
:inpln1a CMP #cr ; return
|
||||
BEQ :inpln6
|
||||
CMP #bs ; back space
|
||||
BEQ :inpln2
|
||||
CMP #can ; ctrl-x / cancel
|
||||
BEQ :inpln2
|
||||
CMP #del ; delete
|
||||
BNE :inpln3
|
||||
|
||||
:inpln2 CPY #0 ; can we back up?
|
||||
BEQ :inpln1 ; nope
|
||||
|
||||
PHA
|
||||
JSR prbs ; backspace w/delete
|
||||
DEY ; decrease line count
|
||||
PLA
|
||||
CMP #can ; if its a cancel
|
||||
BEQ :inpln2 ; keep going
|
||||
BNE :inpln1
|
||||
|
||||
:inpln3 CMP #' ' ; if its a control char...
|
||||
BCC :inpln1
|
||||
|
||||
CPY maxlen ; check for max length
|
||||
BNE :inpln4
|
||||
BRA :inpln1
|
||||
|
||||
:inpln4 BIT inpmode ; do we convert?
|
||||
BPL :inpln4a ; nope
|
||||
|
||||
JSR conv ; convert to upper
|
||||
|
||||
:inpln4a BIT inpmode ; check the inpmode
|
||||
BVC :inpln5
|
||||
|
||||
CMP #',' ; dont accept a comma
|
||||
BEQ :inpln1
|
||||
CMP #' '
|
||||
BNE :inpln5 ; dont accept a space
|
||||
CPY #0 ; for first char of the line
|
||||
BEQ :inpln1
|
||||
|
||||
:inpln5 STA lnbuf,Y ; save char
|
||||
INY
|
||||
JSR cout ; print it
|
||||
JMP :inpln1 ; loop
|
||||
|
||||
:inpln6 LDA #cr
|
||||
STA lnbuf,Y ; save the return
|
||||
CPY #0 ; was is just a return?
|
||||
BNE :inpln7 ; nope
|
||||
|
||||
LDA inpmode ; can we accept a blank line?
|
||||
AND #$20
|
||||
BNE :inpln7 ; yep
|
||||
|
||||
BRA inpln ; dont take, cr, start over
|
||||
|
||||
:inpln7 LDA inpmode ; do cr?
|
||||
AND #$10
|
||||
BNE :inpln8 ; nope
|
||||
|
||||
LDA #cr
|
||||
JMP cout ; print the return AND exit
|
||||
|
||||
:inpln8 RTS
|
||||
|
||||
maxlen ENT
|
||||
DB 0
|
||||
inpmode ENT
|
||||
DB %00000000
|
||||
|
||||
*-------------------------------
|
||||
* input a number in the range [1-x] where x={1-99}
|
||||
*-------------------------------
|
||||
|
||||
inpnum ENT
|
||||
STX maxnum ; save maximum number
|
||||
LDA #2
|
||||
STA maxlen ; set length at 2
|
||||
LDA ch
|
||||
STA prnt+1 ; record currnt horiz offset
|
||||
LDA #%00010000
|
||||
STA inpmode ; use input mode 0
|
||||
|
||||
:inpnum2 JSR inpln ; get line
|
||||
LDA #0
|
||||
STA prnt ; make number init to 0
|
||||
|
||||
LDA lnbuf ; get data
|
||||
SEC
|
||||
SBC #'0'
|
||||
CMP #10 ; in range?
|
||||
BCS :inpnum5 ; nope, we are done
|
||||
|
||||
STA prnt ; update total
|
||||
|
||||
LDA lnbuf+1 ; get more data
|
||||
SEC
|
||||
SBC #'0'
|
||||
CMP #10 ; in range?
|
||||
BCS :inpnum5 ; nope
|
||||
|
||||
:inpnum3 DEC prnt ; count down 10's
|
||||
BMI :inpnum4
|
||||
|
||||
CLC
|
||||
ADC #10 ; add 10 and loop
|
||||
BCC :inpnum3
|
||||
|
||||
:inpnum4 STA prnt ; save new total
|
||||
:inpnum5 LDA prnt
|
||||
BEQ :inpnum7 ; opps, problem
|
||||
|
||||
CMP maxnum ; is it in range?
|
||||
BCC :inpnum8
|
||||
BEQ :inpnum8 ; all is well!
|
||||
|
||||
:inpnum7 LDA ch
|
||||
CMP prnt+1 ; at original spot?
|
||||
BEQ :inpnum2 ; yep
|
||||
|
||||
JSR prbs ; backup
|
||||
JMP :inpnum7
|
||||
|
||||
:inpnum8 RTS
|
||||
|
||||
maxnum DB 0
|
||||
|
||||
*-------------------------------
|
||||
* print a backspace
|
||||
*-------------------------------
|
||||
|
||||
prbs ENT
|
||||
LDA #bs ; do a backspace w/delete
|
||||
JSR cout
|
||||
LDA #' '
|
||||
JSR cout
|
||||
LDA #bs
|
||||
JMP cout
|
||||
|
||||
*-------------------------------
|
||||
* input a 'y' or a 'n' for a yes/no situation
|
||||
*-------------------------------
|
||||
|
||||
inpyn ENT
|
||||
LDA #1 ; max length 1
|
||||
STA maxlen
|
||||
LDA ch ; save horiz position
|
||||
STA temp+1
|
||||
LDA #%10010000
|
||||
STA inpmode
|
||||
|
||||
:inpyn2 JSR inpln ; get the line
|
||||
LDA lnbuf
|
||||
CMP #'Y' ; did they say 'YES' ?
|
||||
CLC
|
||||
BEQ :inpyn3 ; yep
|
||||
|
||||
CMP #'N' ; did they say 'NO' ?
|
||||
SEC
|
||||
BEQ :inpyn3 ; yep
|
||||
|
||||
LDA ch
|
||||
CMP temp+1 ; are they the same?
|
||||
BEQ :inpyn2
|
||||
|
||||
JSR prbs ; backup
|
||||
JMP :inpyn2
|
||||
|
||||
:inpyn3 RTS
|
||||
|
||||
*-------------------------------
|
||||
* convert a character to uppercase
|
||||
*-------------------------------
|
||||
|
||||
conv ENT
|
||||
AND #$7F ; strip high
|
||||
CMP #'a' ; below 'a'?
|
||||
BCC :conv2 ; yep
|
||||
|
||||
CMP #'z'+1 ; above 'z'?
|
||||
BCS :conv2 ; yep
|
||||
|
||||
SBC #$1F ; use clear carry for sbc $20
|
||||
:conv2 RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
copyinp ENT
|
||||
STX temp ; point to dest
|
||||
STA temp+1
|
||||
TYA
|
||||
PHA ; save ending byte
|
||||
|
||||
LDX #0 ; start offsets
|
||||
LDY #0
|
||||
:copyin2 LDA lnbuf,X ; get byte
|
||||
INX
|
||||
CMP #cr ; we done?
|
||||
BEQ :copyin3 ; yep
|
||||
|
||||
STA (temp),Y ; copy and inc pointers
|
||||
INC temp
|
||||
BNE :copyin2
|
||||
INC temp+1
|
||||
BNE :copyin2
|
||||
|
||||
:copyin3 PLA ; get back ending byte
|
||||
BEQ :copyin4 ; opps, there wasnt one
|
||||
|
||||
STA (temp),Y ; save ending byte
|
||||
INC temp
|
||||
BNE :copyin4 ; inc pointers
|
||||
INC temp+1
|
||||
|
||||
:copyin4 LDX temp ; return pointers
|
||||
LDA temp+1
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* copy a line of input to some location uppercase
|
||||
*-------------------------------
|
||||
|
||||
ucopyinp ENT
|
||||
STX temp ; point to dest
|
||||
STA temp+1
|
||||
TYA
|
||||
PHA ; save ending byte
|
||||
|
||||
LDX #0 ; start offsets
|
||||
LDY #0
|
||||
:ucopy2 LDA lnbuf,X ; get byte
|
||||
INX
|
||||
CMP #cr ; we done?
|
||||
BEQ :ucopy3 ; yep
|
||||
|
||||
JSR conv ; convert to uppercase
|
||||
STA (temp),Y ; copy and inc pointers
|
||||
INC temp
|
||||
BNE :ucopy2
|
||||
INC temp+1
|
||||
BNE :ucopy2
|
||||
|
||||
:ucopy3 PLA ; get back ending byte
|
||||
BEQ :ucopy4 ; opps, there wasnt one
|
||||
|
||||
STA (temp),Y ; save ending byte
|
||||
INC temp
|
||||
BNE :ucopy4 ; inc pointers
|
||||
INC temp+1
|
||||
|
||||
:ucopy4 LDX temp ; return pointers
|
||||
LDA temp+1
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* print a string pointed by A & X
|
||||
* if y<128, use length = y
|
||||
* if y>127, stop at chr$(y)
|
||||
*-------------------------------
|
||||
|
||||
prstr ENT
|
||||
STX temp
|
||||
STA temp+1 ; point to data
|
||||
STY temp2
|
||||
TYA
|
||||
AND #$7F ; (was $7D ???)
|
||||
STA temp2+1 ; save possible length
|
||||
|
||||
LDY #0
|
||||
:prstr2 LDA (temp),Y ; get data
|
||||
AND #$7F ; clear high
|
||||
INY
|
||||
|
||||
BIT temp2 ; use which compare?
|
||||
BPL :prstr3 ; other one
|
||||
|
||||
CMP temp2+1 ; are we done?
|
||||
BEQ :prstr4 ; yep
|
||||
|
||||
JSR cout ; show and loop
|
||||
JMP :prstr2
|
||||
|
||||
:prstr3 CPY temp2 ; done?
|
||||
BEQ :prstr4 ; yep
|
||||
|
||||
JSR cout
|
||||
BRA :prstr2
|
||||
|
||||
:prstr4 TYA
|
||||
CLC
|
||||
ADC temp ; compute next address
|
||||
TAX
|
||||
LDA #0
|
||||
ADC temp+1
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* get names from a list
|
||||
*-------------------------------
|
||||
|
||||
getname ENT
|
||||
LDY #0
|
||||
LDA (temp4),Y ; we done?
|
||||
SEC
|
||||
BEQ :getnam3
|
||||
|
||||
:getnam2 LDA (temp4),Y ; copy name
|
||||
STA flname+1,Y
|
||||
INY
|
||||
CMP #0
|
||||
BNE :getnam2
|
||||
|
||||
DEY
|
||||
STY flname ; save length
|
||||
|
||||
TYA
|
||||
SEC
|
||||
ADC temp4 ; update length
|
||||
STA temp4
|
||||
LDA temp4+1
|
||||
ADC #0
|
||||
STA temp4+1
|
||||
CLC
|
||||
:getnam3 RTS
|
||||
|
||||
*-------------------------------
|
||||
* translate a binary to text [0-99]
|
||||
*-------------------------------
|
||||
|
||||
bindec8 ENT
|
||||
LDY #0 ; start 10's counter
|
||||
:bin8 CMP #10
|
||||
BCC :bin8a ; less than 10, were done
|
||||
|
||||
SBC #10 ; minus 10
|
||||
INY ; add 1 to the 10's counter
|
||||
BNE :bin8 ; loop
|
||||
|
||||
:bin8a ADC #'0' ; make 1's into text
|
||||
TAX ; save
|
||||
TYA
|
||||
ADC #'0' ; make 10's into text
|
||||
RTS ; were done
|
||||
|
||||
*-------------------------------
|
||||
* input a number [X-A point to text]
|
||||
*-------------------------------
|
||||
|
||||
numin ENT
|
||||
STX numptr ; point to text
|
||||
STA numptr+1
|
||||
LDA #0
|
||||
STA num ; zero totals
|
||||
STA num+1
|
||||
|
||||
:numin2 LDY #0
|
||||
LDA (numptr),Y ; get digit
|
||||
AND #$7F ; clear high
|
||||
SEC
|
||||
SBC #'0' ; make in 0-9 range
|
||||
CMP #'9'+1
|
||||
BCS :numin4 ; opps, we are done
|
||||
|
||||
INC numptr ; point to next byte
|
||||
BNE *+4
|
||||
INC numptr+1
|
||||
|
||||
STA num+2 ; save digit
|
||||
LDA #0
|
||||
STA num+3
|
||||
|
||||
LDX #10
|
||||
:numin3 CLC ; num = num + num2
|
||||
LDA num
|
||||
ADC num+2
|
||||
STA num+2
|
||||
LDA num+1
|
||||
ADC num+3
|
||||
STA num+3
|
||||
DEX
|
||||
BNE :numin3 ; num = num * 10
|
||||
|
||||
LDA num+2 ; move result
|
||||
STA num
|
||||
LDA num+3
|
||||
STA num+1
|
||||
JMP :numin2 ; loop
|
||||
|
||||
:numin4 LDX num ; return value
|
||||
LDA num+1
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* display a decimal number [0 to 65535]
|
||||
*-------------------------------
|
||||
|
||||
decmem ENT
|
||||
STX num ; save number
|
||||
STA num+1
|
||||
|
||||
LDA #0
|
||||
STA num+2
|
||||
STA num+3
|
||||
STA num+5
|
||||
STA num+6
|
||||
|
||||
SED
|
||||
LDY #16 ; use decimal mode
|
||||
:decmem2 ASL num
|
||||
ROL num+1
|
||||
LDA num+2
|
||||
ADC num+2 ; do actual 'woz' conversion
|
||||
STA num+2
|
||||
LDA num+3
|
||||
ADC num+3
|
||||
STA num+3
|
||||
ROL num+4
|
||||
DEY ; loop down
|
||||
BNE :decmem2
|
||||
|
||||
CLD ; done with decimal
|
||||
LDY #4 ; print 5 digits
|
||||
|
||||
:decmem3 LDA num+4 ; get digit
|
||||
AND #$F
|
||||
BNE :decmem4 ; is it zero?
|
||||
|
||||
BIT num+5 ; is this a leading zero?
|
||||
BPL :decmem5 ; yep
|
||||
|
||||
:decmem4 DEC num+5
|
||||
CLC
|
||||
ADC #'0' ; print digit
|
||||
LDX num+6
|
||||
STA txtnum+1,X ; save number to memory
|
||||
INC num+6
|
||||
|
||||
:decmem5 LDX #3 ; move up next digit
|
||||
:decmem6 ASL num+1
|
||||
ROL num+2
|
||||
ROL num+3
|
||||
ROL num+4
|
||||
DEX
|
||||
BPL :decmem6
|
||||
|
||||
DEY ; count down digits
|
||||
BMI :decmem7
|
||||
BNE :decmem3
|
||||
|
||||
STX num+5 ; print last zero for sure
|
||||
BPL :decmem3
|
||||
:decmem7 LDA num+6 ; save number length
|
||||
STA txtnum
|
||||
RTS
|
||||
|
||||
num DS 7
|
||||
txtnum DS 6
|
||||
|
||||
*-------------------------------
|
||||
* escape handler
|
||||
*-------------------------------
|
||||
|
||||
escape ENT
|
||||
STA escadr ; possible reset
|
||||
CMP #0 ; turn off handler?
|
||||
BEQ :esc2 ; yep
|
||||
|
||||
STX escadr+1 ; save escape address
|
||||
STA escadr+2
|
||||
TSX
|
||||
STX escadr+3 ; save stack location
|
||||
LDA #-1
|
||||
STA escadr ; turn on handler
|
||||
:esc2 RTS
|
||||
|
||||
; check for esc and handle if needed
|
||||
chk_esc BIT escadr ; is handler enabled?
|
||||
BPL :esc3 ; nope
|
||||
|
||||
PHA
|
||||
AND #$7F ; did escape occur?
|
||||
CMP #esc
|
||||
BNE :esc2 ; nope
|
||||
|
||||
LDA escadr+1 ; setup jump location
|
||||
STA temp
|
||||
LDA escadr+2
|
||||
STA temp+1
|
||||
LDX escadr+3
|
||||
TXS ; reset stack
|
||||
PLA
|
||||
PLA ; restore stack
|
||||
JMP (temp) ; change program control
|
||||
|
||||
:esc2 PLA
|
||||
:esc3 RTS
|
||||
|
||||
escadr DB 0,0,0,0
|
||||
|
||||
*-------------------------------
|
||||
* print a number
|
||||
*-------------------------------
|
||||
|
||||
prnumb ENT
|
||||
JSR decmem ; convert number
|
||||
LDX #<txtnum+1
|
||||
LDA #>txtnum+1
|
||||
LDY txtnum
|
||||
INY ; display it
|
||||
JMP prstr
|
||||
|
||||
*-------------------------------
|
||||
* wait for a return
|
||||
*-------------------------------
|
||||
|
||||
get_cr ENT
|
||||
JSR print
|
||||
DB 1,22,0
|
||||
ASC 'Press [RETURN] to continue...'00
|
||||
|
||||
wait_cr JSR rdkey
|
||||
CMP #cr
|
||||
BNE wait_cr
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* wait for a 'g'o message
|
||||
*-------------------------------
|
||||
|
||||
get_ok ENT
|
||||
JSR print
|
||||
DB 1,20,0
|
||||
ASC 'Press [RETURN] when diskette is online.'00
|
||||
|
||||
BRA wait_cr
|
||||
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
********************************
|
||||
* *
|
||||
* Config Program - Start *
|
||||
* *
|
||||
********************************
|
||||
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
m_vers = '1' ; make into ascii # (Main Version)
|
||||
s_vers = '0' ; make into ascii # (Sub Version)
|
||||
p_vers = '5' ; make into ascii # (Patch Version)
|
||||
|
||||
entrmon = $FF59
|
||||
|
||||
prn = $16 ; [4 bytes]
|
||||
|
||||
reset = $3F2
|
||||
mli = $BF00
|
||||
|
||||
DSK REL/START
|
||||
|
||||
findcon EXT
|
||||
VideoStartup EXT
|
||||
cls EXT
|
||||
print EXT
|
||||
inpyn EXT
|
||||
inpnum EXT
|
||||
ld_drvs EXT
|
||||
do_init EXT
|
||||
drv_path EXT
|
||||
refnum EXT
|
||||
escape EXT
|
||||
close EXT
|
||||
logcon EXT
|
||||
re_mdm EXT
|
||||
re_pr EXT
|
||||
re_clk EXT
|
||||
do_dflts EXT
|
||||
do_filt EXT
|
||||
TopBox EXT
|
||||
|
||||
|
||||
begin ENT
|
||||
STA $C051 ;text mode
|
||||
STA $C00E ;Turn MouseText off
|
||||
BIT $C082
|
||||
|
||||
LDA #<do_quit ;fudge reset vector
|
||||
STA reset
|
||||
LDA #>do_quit
|
||||
STA reset+1
|
||||
EOR #$A5
|
||||
STA reset+2
|
||||
|
||||
LDX #$F0 ;reset stack
|
||||
TXS
|
||||
|
||||
JSR findcon ;find the config disk, logit
|
||||
JSR VideoStartup ; Init the video driver
|
||||
|
||||
JSR do_main
|
||||
|
||||
JSR cls ; clear screen
|
||||
JSR print
|
||||
DB 1,7,0
|
||||
ASC 'When you do an initial configure, '
|
||||
ASC 'all previous data will be destroyed'0D0D
|
||||
ASC 'and replaced with the new configuration. '
|
||||
ASC 'All old data will be lost.'0D0D0D
|
||||
ASC 'Do you want to do an Initial Configure? [Y/N] '00
|
||||
|
||||
JSR inpyn ; input yes/no
|
||||
BCS :no_init
|
||||
|
||||
JSR ld_drvs ; load in drivers file
|
||||
JMP do_init ; do initial config
|
||||
|
||||
*-------------------------------
|
||||
|
||||
:no_init JSR drv_path ; get drivers file path and load it
|
||||
|
||||
start ENT
|
||||
LDA #0 ; turn off escape handler
|
||||
STA refnum
|
||||
JSR escape
|
||||
JSR close ; close all files
|
||||
JSR logcon
|
||||
|
||||
JSR do_main
|
||||
|
||||
JSR cls ; clear screen
|
||||
JSR print
|
||||
ASC 'Select an Option:'0D0D
|
||||
ASC ' 1 - Reconfigure Modem '0D
|
||||
ASC ' 2 - Reconfigure Printer '0D
|
||||
ASC ' 3 - Reconfigure Clock'0D
|
||||
ASC ' 4 - Edit System Defualts'0D
|
||||
ASC ' 5 - Edit Profanity Filter'0D
|
||||
ASC ' 6 - Quit',0D0D
|
||||
|
||||
ASC 'Which? [1-6] '00
|
||||
|
||||
LDX #7 ; get a number [1-6]
|
||||
JSR inpnum
|
||||
|
||||
PHA
|
||||
LDX #<start
|
||||
LDA #>start
|
||||
JSR escape ;esc goes back to here
|
||||
PLA
|
||||
ASL
|
||||
TAX
|
||||
|
||||
LDA jumptable,X
|
||||
STA prn
|
||||
INX ;push low
|
||||
LDA jumptable,X
|
||||
STA prn+1
|
||||
JMP (prn)
|
||||
|
||||
jumptable DA 0
|
||||
DA re_mdm ; 1
|
||||
DA re_pr ; 2
|
||||
DA re_clk ; 3
|
||||
DA do_dflts ; 4
|
||||
DA do_filt ; 5
|
||||
DA do_quit ; 6
|
||||
DA do_mtr ; 7 (hidden command)
|
||||
|
||||
*-------------------------------
|
||||
* print the top box
|
||||
|
||||
do_main ENT
|
||||
JSR TopBox
|
||||
JSR print
|
||||
DB 1,2,19
|
||||
ASC 'LLUCE - Configuration Program - Ver. '
|
||||
DB m_vers ; major version #
|
||||
ASC '.'
|
||||
DB s_vers ; sub version #
|
||||
DB p_vers ; patch version #
|
||||
DB 0
|
||||
|
||||
JSR print
|
||||
DB 1,4,20
|
||||
ASC 'Copyright 1989 - L&L Productions, Inc.'00
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
drvname ENT
|
||||
STR 'LLUCE.DRIVERS'
|
||||
|
||||
*-------------------------------
|
||||
* Quit
|
||||
*-------------------------------
|
||||
|
||||
; quit the program
|
||||
do_quit ENT
|
||||
JSR $FC58 ; clear screen
|
||||
STA $C051 ; goto text mode
|
||||
|
||||
LDA #$FF ; reset inverse flag
|
||||
STA $32
|
||||
|
||||
|
||||
JSR mli
|
||||
DB $65 ; quit
|
||||
DA p_quit
|
||||
RTS
|
||||
|
||||
|
||||
p_quit DB 4
|
||||
DB 0
|
||||
DA 0
|
||||
DB 0
|
||||
DA 0
|
||||
|
||||
do_mtr LDA #-1
|
||||
STA $32
|
||||
|
||||
JMP entrmon ; monitor
|
||||
|
||||
|
|
@ -0,0 +1,289 @@
|
|||
LST OFF
|
||||
TR
|
||||
TR ADR
|
||||
*-------------------------------
|
||||
* video driver for config
|
||||
*-------------------------------
|
||||
* Date: 3/11/88
|
||||
*-------------------------------
|
||||
|
||||
REL
|
||||
cr = $D
|
||||
lf = $A
|
||||
bs = 8
|
||||
|
||||
x_save = 9
|
||||
y_save = $A
|
||||
base = $D
|
||||
inverse = $10
|
||||
ch = $24
|
||||
cv = $25
|
||||
|
||||
page1 = $C054
|
||||
page2 = $C055
|
||||
|
||||
DSK REL/VIDEO
|
||||
|
||||
VideoStartup ENT
|
||||
STA $C00D ;set80vid
|
||||
STA $C001 ;set80col
|
||||
STA page1
|
||||
|
||||
LDA #0 ; set to page 1
|
||||
STA inverse ; set to normal mode
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
cls ENT
|
||||
LDA #6 ;clear screen
|
||||
STA cv ;line 6 on down
|
||||
|
||||
clslup2 LDA cv ;clear to end of screen
|
||||
ASL ;cv := cv * 2
|
||||
TAY
|
||||
LDA LineAddress,y
|
||||
STA base
|
||||
INY
|
||||
LDA LineAddress,y
|
||||
STA base+1
|
||||
|
||||
LDY #39
|
||||
LDA #" "
|
||||
:loop STA (base),y
|
||||
DEY
|
||||
BPL :loop
|
||||
|
||||
STA page2 ;do aux part
|
||||
LDY #39
|
||||
:loop2 STA (base),y ;do the line
|
||||
DEY
|
||||
BPL :loop2
|
||||
STA page1 ;back to page 1
|
||||
|
||||
INC cv
|
||||
LDA cv
|
||||
CMP #24
|
||||
BNE clslup2
|
||||
|
||||
LDA #0 ;0,6
|
||||
STA ch
|
||||
LDA #7
|
||||
STA cv
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
cleos ENT
|
||||
STX cv
|
||||
JMP clslup2
|
||||
|
||||
cleol ENT
|
||||
PHA
|
||||
LDA ch ; save location of cursor
|
||||
PHA
|
||||
LDA cv
|
||||
PHA
|
||||
|
||||
:cleol2 LDA #' '
|
||||
JSR cout ; put space over char
|
||||
LDA ch
|
||||
BNE :cleol2 ; go until it wraps to next line
|
||||
|
||||
PLA
|
||||
STA cv ; put cursor back
|
||||
PLA
|
||||
STA ch
|
||||
PLA
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
TopBox ENT
|
||||
PHA
|
||||
|
||||
LDA #0
|
||||
STA cv
|
||||
|
||||
JSR doILine
|
||||
INC cv
|
||||
JSR doEdge
|
||||
INC cv
|
||||
JSR doEdge
|
||||
INC cv
|
||||
JSR doEdge
|
||||
INC cv
|
||||
JSR doEdge
|
||||
INC cv
|
||||
JSR doILine
|
||||
|
||||
STA page2
|
||||
LDY #0
|
||||
LDA #' '
|
||||
STA (base),y
|
||||
STA page1
|
||||
|
||||
LDY #39
|
||||
LDA #' '
|
||||
STA (base),y
|
||||
|
||||
PLA
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
doEdge JSR makebase
|
||||
|
||||
LDY #39
|
||||
LDA #" "
|
||||
:loop STA (base),y
|
||||
DEY
|
||||
BPL :loop
|
||||
|
||||
STA page2
|
||||
LDY #39
|
||||
:loop2 STA (base),y
|
||||
DEY
|
||||
BPL :loop2
|
||||
|
||||
LDY #0
|
||||
LDA #' '
|
||||
STA (base),y
|
||||
STA page1
|
||||
|
||||
LDY #39
|
||||
LDA #' '
|
||||
STA (base),y
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* print an inverse line across the screen
|
||||
|
||||
doILine JSR makebase
|
||||
|
||||
LDY #39
|
||||
LDA #"_"
|
||||
:loop STA (base),y
|
||||
DEY
|
||||
BPL :loop
|
||||
|
||||
STA page2
|
||||
LDY #39
|
||||
:loop2 STA (base),y
|
||||
DEY
|
||||
BPL :loop2
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
makebase LDA cv
|
||||
ASL
|
||||
TAY ;setup indirect address
|
||||
LDA LineAddress,y
|
||||
STA base
|
||||
INY
|
||||
LDA LineAddress,y
|
||||
STA base+1
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
|
||||
plotchr ENT
|
||||
PHA ; save
|
||||
|
||||
JSR makebase ;setup indirect for screen address
|
||||
|
||||
LDA ch
|
||||
LSR
|
||||
TAY
|
||||
BCS :odd ;it's odd, so page 1
|
||||
STA page2
|
||||
|
||||
:odd PLA
|
||||
ORA #$80 ;set high bit
|
||||
STA (base),y ;put it onto the screen
|
||||
STA page1
|
||||
RTS
|
||||
|
||||
*-------------------------------
|
||||
* output a character
|
||||
|
||||
cout ENT
|
||||
STX x_save ; save everything
|
||||
STY y_save
|
||||
PHA
|
||||
|
||||
AND #$7F ; clear high
|
||||
CMP #cr
|
||||
BEQ :cout2
|
||||
CMP #lf
|
||||
BEQ :cout3
|
||||
CMP #bs
|
||||
BEQ :cout5
|
||||
CMP #' '
|
||||
BCC :cout4
|
||||
|
||||
JSR plotchr ; plot the sucker
|
||||
|
||||
INC ch ; move over 1 space
|
||||
LDY ch
|
||||
CPY #80 ; wrap-around?
|
||||
BNE :cout4 ; nope
|
||||
|
||||
:cout2 LDY #0 ; reset horiz
|
||||
STY ch
|
||||
|
||||
:cout3 INC cv ; go down 1 line
|
||||
LDA cv ; is it in range?
|
||||
CMP #24
|
||||
BNE :cout4 ; nope
|
||||
|
||||
DEC cv ; put it back
|
||||
|
||||
:cout4 PLA
|
||||
LDX x_save ; restore stuff
|
||||
LDY y_save
|
||||
RTS
|
||||
|
||||
:cout5 DEC ch ; backup
|
||||
BPL :cout4 ; all is well
|
||||
|
||||
LDA #79 ; move to end of line
|
||||
STA ch
|
||||
|
||||
LDA cv ; are we at the top
|
||||
CMP #0
|
||||
BEQ :cout4 ; yep
|
||||
|
||||
DEC cv
|
||||
JMP :cout4 ; ok, we are done
|
||||
|
||||
*-------------------------------
|
||||
|
||||
LineAddress DA $400
|
||||
DA $480
|
||||
DA $500
|
||||
DA $580
|
||||
DA $600 ;first 1/3 of text screen
|
||||
DA $680
|
||||
DA $700
|
||||
DA $780
|
||||
|
||||
DA $428
|
||||
DA $4A8
|
||||
DA $528
|
||||
DA $5A8
|
||||
DA $628 ;second 1/3 of text screen
|
||||
DA $6A8
|
||||
DA $728
|
||||
DA $7A8
|
||||
|
||||
DA $450
|
||||
DA $4D0
|
||||
DA $550
|
||||
DA $5D0
|
||||
DA $650 ;last 1/3 of text screen
|
||||
DA $6D0
|
||||
DA $750
|
||||
DA $7D0
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,514 @@
|
|||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
|
||||
ANSI & DEC VT100 Codes
|
||||
|
||||
^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^
|
||||
|
||||
|
||||
The following text will describe the various escape codes that allow
|
||||
computers to transmit color text over communication lines. Using ANSI
|
||||
escape codes, any computer can receive and transmit color text as long as
|
||||
the communication program can interpret the escape sequences.
|
||||
The escape sequences can be thought of the same as ones sent to a printer
|
||||
to change the appearance of the output. All ANSI codes begin with the one
|
||||
byte character ESC (decimal 27), and are followed by the left bracket "[".
|
||||
Additional parameters, which follow the bracket are seperated with a semi-
|
||||
colon. All codes are ended with a single alphabetic character which determines
|
||||
the function of the escape sequence.
|
||||
Since the characters come in one at a time, as soon as the ESC character
|
||||
is received start building the sequence until an alphabetic character is
|
||||
input. The case of the alphabetic character is very important since they
|
||||
mean different things. For example,"H" (which means set cursor position)
|
||||
is different than "h" ,(which means set the display width and type).
|
||||
|
||||
|
||||
Notes:
|
||||
1) The default value is used when no explicit
|
||||
value is given, or a value of zero, is
|
||||
specified.
|
||||
|
||||
2) The default value is 1 unless otherwise
|
||||
specified below.
|
||||
|
||||
3) # - Numeric Parameter. A decimal number
|
||||
specified with ASCII characters.
|
||||
|
||||
4) In the control sequences described below,
|
||||
ESC is the 1 byte code for ESC (decimal 27),
|
||||
and not the three characters "ESC".
|
||||
|
||||
|
||||
|
||||
CURSOR CONTROL
|
||||
|
||||
Cursor Position (CUP)
|
||||
ESC[#;#H Moves the cursor to the position
|
||||
specified by the parameter. The first
|
||||
parameter specifies the line number and
|
||||
the second parameter specifies the column
|
||||
number. If no parameter is given, the
|
||||
cursor is moved to the home position
|
||||
(Row 1, Column 1).
|
||||
Example: ESC[10;20H - moves the cursor to
|
||||
row 10, column 20.
|
||||
|
||||
Cursor Up (CUU)
|
||||
ESC[#A Moves the cursor up # lines without
|
||||
changing columns. The value of #
|
||||
determines the number of lines to move up.
|
||||
This sequence is ignored if the cursor is
|
||||
already on the top line.
|
||||
Example: ESC[5A - moves the cursor up
|
||||
5 lines without changing
|
||||
columns.
|
||||
|
||||
Cursor Down (CUD)
|
||||
ESC[#B Moves the cursor down # lines without changing
|
||||
columns. The value of # determines the number
|
||||
of lines to move down.
|
||||
This sequence is ignored if the cursor is
|
||||
already on the bottom line.
|
||||
Example: ESC[5B - moves the cursor down
|
||||
5 lines without changing
|
||||
columns.
|
||||
|
||||
Cursor Forward (CUF)
|
||||
ESC[#C Moves the cursor forward # columns without
|
||||
changing lines. The value of # determines
|
||||
the number of columns moved forward.
|
||||
This sequence is ignored if the cursor is already
|
||||
in the rightmost column.
|
||||
Example: ESC[25C - moves the cursor forward
|
||||
25 columns.
|
||||
|
||||
Cursor Backward (CUB)
|
||||
ESC[#n Moves the cursor back # columns without changing
|
||||
lines. The value # determines the number of
|
||||
columns moved backwards.
|
||||
This sequence is ignored if the cursor is already
|
||||
in the leftmost column.
|
||||
Example: ESC[1n - moves the cursor backwards
|
||||
1 column.
|
||||
|
||||
Horizontal and Vertical Position (HVP)
|
||||
ESC[#;#f This control sequence is the same as CUP.
|
||||
Example: ESC[10;20f - moves the cursor to
|
||||
row 10, column 20.
|
||||
|
||||
Device Status Report (DSR)
|
||||
ESC[6n Upon receipt of this command, the console
|
||||
driver will output a CPR sequence as described
|
||||
below.
|
||||
|
||||
Cursor Position Report (CPR)
|
||||
ESC[#;#R The CPR sequence reports the current cursor
|
||||
position through the standard input device. The
|
||||
first parameter specifies the current line and
|
||||
the second parameter specifies the current column.
|
||||
|
||||
Save Cursor Position (SCP)
|
||||
ESC[s The current cursor position is saved. This
|
||||
cursor position can be restored with the RCP
|
||||
sequence.
|
||||
|
||||
Restore Cursor Position (RCP)
|
||||
ESC[u Restores the cursor to the value it had when
|
||||
the control sequence SCP was received.
|
||||
|
||||
Erase in Display (ED)
|
||||
ESC[2J Erases all of the screen and the cursor goes
|
||||
to the home position (row 1, column 1).
|
||||
|
||||
Erase in Line (EL)
|
||||
ESC[k Erases from the cursor to the end of the line
|
||||
and includes the cursor position.
|
||||
|
||||
Set Graphics Rendition (SGR)
|
||||
ESC[#;...;#m Set the character attribute specified by then
|
||||
parameter(s). All following characters will
|
||||
have the attribute according to the parameter(s)
|
||||
until the next occurrence of SGR.
|
||||
Note: attribute means the foreground color, the
|
||||
background color, blink, high intensity,
|
||||
underscore, reverse video, and invisible.
|
||||
|
||||
Parameter Meaning
|
||||
0 All Attributes Off (white on black)
|
||||
1 Bold On (high intensity)
|
||||
4 Underscore On (Some monitors only)
|
||||
5 Blink On
|
||||
7 Reverse Video
|
||||
8 Cancelled On (invisible)
|
||||
30 Black Foreground
|
||||
31 Red Foreground
|
||||
32 Green Foreground
|
||||
33 Yellow Foreground
|
||||
34 Blue Foreground
|
||||
35 Magenta Foreground
|
||||
36 Cyan Foreground
|
||||
37 White Foreground
|
||||
40 Black Background
|
||||
41 Red Background
|
||||
42 Green Background
|
||||
43 Yellow Background
|
||||
44 Blue Background
|
||||
45 Magenta Background
|
||||
46 Cyan Background
|
||||
47 White Background
|
||||
|
||||
Example: ESC[33;40;1m - all following
|
||||
characters will have
|
||||
a Yellow foreground,
|
||||
a Black background,
|
||||
and be in high intensity
|
||||
until receipt of another
|
||||
SGR control sequence.
|
||||
|
||||
ESC[0m - all following
|
||||
characters will have
|
||||
a white foreground, on
|
||||
a black background, in
|
||||
normal intensity.
|
||||
|
||||
|
||||
Note: Several parameters can be stacked. For
|
||||
example, ESC[0;1;5;7;31;44m
|
||||
the above example will reset the
|
||||
attributes, set high intensity,
|
||||
set blink on, set reversed video,
|
||||
set foreground color to red, and
|
||||
set background color to blue.
|
||||
Note that since reverse video
|
||||
is on the foreground will
|
||||
actually be blue and the
|
||||
background will be red.
|
||||
|
||||
|
||||
|
||||
Here is the requested list of ANSI control sequences. I picked it
|
||||
up off of the Usenet a while back.
|
||||
|
||||
ANSI Standard (X3.64) Control Sequences for Video Terminals and Peripherals
|
||||
in alphabetic order by mnemonic
|
||||
|
||||
(Inspired by the article "Toward Standardized Video Terminals: ANSI
|
||||
X3.64 Device Control" by Mark L. Siegel, April 1984 BYTE, page 365)
|
||||
|
||||
Note: This describes the VT-100 standard.
|
||||
|
||||
(Ps and Pn are parameters expressed in ASCII.)
|
||||
(Numeric parameters are given in decimal radix.)
|
||||
(Abbreviations are explained in detail at end.)
|
||||
(Spaces used in this table for clarity are not
|
||||
used in the actual codes.)
|
||||
|
||||
Default Type
|
||||
Sequence Sequence Parameter or
|
||||
Mnemonic Name Sequence Value Mode
|
||||
---------------------------------------------------------------------------
|
||||
APC Applicatn Program Command Esc Fe Delim
|
||||
CBT Cursor Backward Tab Esc [ Pn Z 1 EdF
|
||||
CCH Cancel Previous Character Esc T
|
||||
CHA Cursor Horzntal Absolute Esc [ Pn G 1 EdF
|
||||
CHT Cursor Horizontal Tab Esc [ Pn I 1 EdF
|
||||
CNL Cursor Next Line Esc [ Pn E 1 EdF
|
||||
CPL Cursor Preceding Line Esc [ Pn F 1 EdF
|
||||
CPR Cursor Position Report Esc [ Pn ; Pn R 1, 1
|
||||
CSI Control Sequence Intro Esc [ Intro
|
||||
CTC Cursor Tab Control Esc [ Ps W 0 EdF
|
||||
CUB Cursor Backward Esc [ Pn D 1 EdF
|
||||
CUD Cursor Down Esc [ Pn B 1 EdF
|
||||
CUF Cursor Forward Esc [ Pn C 1 EdF
|
||||
CUP Cursor Position Esc [ Pn ; Pn H 1, 1 EdF
|
||||
CUU Cursor Up Esc [ Pn A 1 EdF
|
||||
CVT Cursor Vertical Tab Esc [ Pn Y EdF
|
||||
DA Device Attributes Esc [ Pn c 0
|
||||
DAQ Define Area Qualification Esc [ Ps o 0
|
||||
DCH Delete Character Esc [ Pn P 1 EdF
|
||||
DCS Device Control String Esc P Delim
|
||||
DL Delete Line Esc [ Pn M 1 EdF
|
||||
DMI Disable Manual Input Esc \ Fs
|
||||
DSR Device Status Report Esc [ Ps n 0
|
||||
EA Erase in Area Esc [ Ps O 0 EdF
|
||||
ECH Erase Character Esc [ Pn X 1 EdF
|
||||
ED Erase in Display Esc [ Ps J 0 EdF
|
||||
EF Erase in Field Esc [ Ps N 0 EdF
|
||||
EL Erase in Line Esc [ Ps K 0 EdF
|
||||
EMI Enable Manual Input Esc b Fs
|
||||
EPA End of Protected Area Esc W
|
||||
ESA End of Selected Area Esc G
|
||||
FNT Font Selection Esc [ Pn ; Pn Space D 0, 0 FE
|
||||
GSM Graphic Size Modify Esc [ Pn ; Pn Space B 100, 100 FE
|
||||
GSS Graphic Size Selection Esc [ Pn Space C none FE
|
||||
HPA Horz Position Absolute Esc [ Pn ` 1 FE
|
||||
HPR Horz Position Relative Esc [ Pn a 1 FE
|
||||
HTJ Horz Tab w/Justification Esc I FE
|
||||
HTS Horizontal Tab Set Esc H FE
|
||||
HVP Horz & Vertical Position Esc [ Pn ; Pn f 1, 1 FE
|
||||
ICH Insert Character Esc [ Pn @ 1 EdF
|
||||
IL Insert Line Esc [ Pn L 1 EdF
|
||||
IND Index Esc D FE
|
||||
INT Interrupt Esc a Fs
|
||||
JFY Justify Esc [ Ps ; ... ; Ps Space F 0 FE
|
||||
MC Media Copy Esc [ Ps i 0
|
||||
MW Message Waiting Esc U
|
||||
NEL Next Line Esc E FE
|
||||
NP Next Page Esc [ Pn U 1 EdF
|
||||
OSC Operating System Command Esc ] Delim
|
||||
PLD Partial Line Down Esc K FE
|
||||
PLU Partial Line Up Esc L FE
|
||||
PM Privacy Message Esc ^ Delim
|
||||
PP Preceding Page Esc [ Pn V 1 EdF
|
||||
PU1 Private Use 1 Esc Q
|
||||
PU2 Private Use 2 Esc R
|
||||
QUAD Typographic Quadding Esc [ Ps Space H 0 FE
|
||||
REP Repeat Char or Control Esc [ Pn b 1
|
||||
RI Reverse Index Esc M FE
|
||||
RIS Reset to Initial State Esc c Fs
|
||||
RM Reset Mode Esc [ Ps l none
|
||||
SD Scroll Down Esc [ Pn T 1 EdF
|
||||
SEM Select Edit Extent Mode Esc [ Ps Q 0
|
||||
SGR Select Graphic Rendition Esc [ Ps m 0 FE
|
||||
SL Scroll Left Esc [ Pn Space @ 1 EdF
|
||||
SM Select Mode Esc [ Ps h none
|
||||
SPA Start of Protected Area Esc V
|
||||
SPI Spacing Increment Esc [ Pn ; Pn Space G none FE
|
||||
SR Scroll Right Esc [ Pn Space A 1 EdF
|
||||
SS2 Single Shift 2 (G2 set) Esc N Intro
|
||||
SS3 Single Shift 3 (G3 set) Esc O Intro
|
||||
SSA Start of Selected Area Esc F
|
||||
ST String Terminator Esc \ Delim
|
||||
STS Set Transmit State Esc S
|
||||
SU Scroll Up Esc [ Pn S 1 EdF
|
||||
TBC Tab Clear Esc [ Ps g 0 FE
|
||||
TSS Thin Space Specification Esc [ Pn Space E none FE
|
||||
VPA Vert Position Absolute Esc [ Pn d 1 FE
|
||||
VPR Vert Position Relative Esc [ Pn e 1 FE
|
||||
VTS Vertical Tabulation Set Esc J FE
|
||||
|
||||
---------------------------------------------------------------------------
|
||||
|
||||
Abbreviations:
|
||||
|
||||
Intro an Introducer of some kind of defined sequence; the normal 7-bit
|
||||
X3.64 Control Sequence Introducer is the two characters "Escape ["
|
||||
|
||||
Delim a Delimiter
|
||||
|
||||
x/y identifies a character by position in the ASCII table (column/row)
|
||||
|
||||
EdF editor function (see explanation)
|
||||
|
||||
FE format effector (see explanation)
|
||||
|
||||
F is a Final character in
|
||||
an Escape sequence (F from 3/0 to 7/14 in the ASCII table)
|
||||
a control sequence (F from 4/0 to 7/14)
|
||||
|
||||
Gs is a graphic character appearing in strings (Gs ranges from
|
||||
2/0 to 7/14) in the ASCII table
|
||||
|
||||
Ce is a control represented as a single bit combination in the C1 set
|
||||
of controls in an 8-bit character set
|
||||
|
||||
C0 the familiar set of 7-bit ASCII control characters
|
||||
|
||||
C1 roughly, the set of control characters available only in 8-bit systems.
|
||||
This is too complicated to explain fully here, so read Jim Fleming's
|
||||
article in the February 1983 BYTE, especially pages 214 through 224.
|
||||
|
||||
Fe is a Final character of a 2-character Escape sequence that has an
|
||||
equivalent representation in an 8-bit environment as a Ce-type
|
||||
(Fe ranges from 4/0 to 5/15)
|
||||
|
||||
Fs is a Final character of a 2-character Escape sequence that is
|
||||
standardized internationally with identical representation in 7-bit
|
||||
and 8-bit environments and is independent of the currently
|
||||
designated C0 and C1 control sets (Fs ranges from 6/0 to 7/14)
|
||||
|
||||
I is an Intermediate character from 2/0 to 2/15 (inclusive) in the
|
||||
ASCII table
|
||||
|
||||
P is a parameter character from 3/0 to 3/15 (inclusive) in the ASCII
|
||||
table
|
||||
|
||||
Pn is a numeric parameter in a control sequence, a string of zero or
|
||||
more characters ranging from 3/0 to 3/9 in the ASCII table
|
||||
|
||||
Ps is a variable number of selective parameters in a control sequence
|
||||
with each selective parameter separated from the other by the code
|
||||
3/11 (which usually represents a semicolon); Ps ranges from
|
||||
3/0 to 3/9 and includes 3/11
|
||||
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
|
||||
Format Effectors versus Editor Functions
|
||||
|
||||
A format effector specifies how the final output is to be created.
|
||||
An editor function allows you to modify the specification.
|
||||
|
||||
For instance, a format effector that moves the "active position" (the
|
||||
cursor or equivalent) one space to the left would be useful when you want to
|
||||
create an over strike, a compound character made of two standard characters
|
||||
overlaid. Control-H, the Backspace character, is actually supposed to be a
|
||||
format effector, so you can do this. But many systems use it in a
|
||||
nonstandard fashion, as an editor function, deleting the character to the
|
||||
left of the cursor and moving the cursor left. When Control-H is assumed to
|
||||
be an editor function, you cannot predict whether its use will create an
|
||||
over strike unless you also know whether the output device is in an "insert
|
||||
mode" or an "overwrite mode". When Control-H is used as a format effector,
|
||||
its effect can always be predicted. The familiar characters carriage
|
||||
return, linefeed, formfeed, etc., are defined as format effectors.
|
||||
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^
|
||||
|
||||
ANSI X3.64 Mode-Changing Parameters for use with the
|
||||
Select Mode (SM) and Reset Mode (RM) functions
|
||||
|
||||
Parameter Mode Mode Function
|
||||
Characters Mnemonic
|
||||
column/ graphic
|
||||
row repres.
|
||||
----------------------------------------------------------------------------
|
||||
3/0 0 an error condition
|
||||
3/1 1 GATM guarded-area transfer mode
|
||||
3/2 2 KAM keyboard action mode
|
||||
3/3 3 CRM control representation mode
|
||||
3/4 4 IRM insertion/replacement mode
|
||||
3/5 5 SRTM status-reporting transfer mode
|
||||
3/6 6 ERM erasure mode
|
||||
3/7 7 VEM vertical editing mode
|
||||
3/8 8 reserved for future standardization
|
||||
3/9 9 reserved for future standardization
|
||||
3/10 : reserved separator for parameters
|
||||
3/11 ; Standard separator for parameters
|
||||
3/12 < reserved for private (experimental) use
|
||||
3/13 = reserved for private (experimental) use
|
||||
3/14 > reserved for private (experimental) use
|
||||
3/15 ? reserved for private (experimental) use
|
||||
3/1 3/0 10 HEM horizontal editing mode
|
||||
3/1 3/1 11 PUM positioning unit mode
|
||||
3/1 3/2 12 SRM send/receive mode
|
||||
3/1 3/3 13 FEAM format effector action mode
|
||||
3/1 3/4 14 FETM format effector transfer mode
|
||||
3/1 3/5 15 MATM multiple area transfer mode
|
||||
3/1 3/6 16 TTM transfer termination mode
|
||||
3/1 3/7 17 SATM selected area transfer mode
|
||||
3/1 3/8 18 TSM tabulation stop mode
|
||||
3/1 3/9 19 EBM editing boundary mode
|
||||
3/1 3/10 1: reserved separator for parameters
|
||||
3/1 3/11 1; Standard separator for parameters
|
||||
3/1 3/12 1< error condition--unspecified recovery
|
||||
3/1 3/13 1= error condition--unspecified recovery
|
||||
3/1 3/14 1> error condition--unspecified recovery
|
||||
3/1 3/15 1? error condition--unspecified recovery
|
||||
3/2 3/0 20 LNM linefeed/newline mode (not in ISO 6429)
|
||||
3/2 3/1 21
|
||||
. .
|
||||
. . reserved for future standardization
|
||||
. .
|
||||
3/9 3/9 99
|
||||
|
||||
3/12 3/0 <0
|
||||
. .
|
||||
. . reserved for private (experimental) use
|
||||
. .
|
||||
3/15 3/15 ??
|
||||
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^
|
||||
|
||||
NOTES ON THE DEC VT100 IMPLEMENTATION
|
||||
|
||||
In the case of the popular DEC VT100 video-terminal implementation,
|
||||
the only mode that may be altered is the linefeed/newline (LNM) mode.
|
||||
Other modes are considered permanently set, reset, or not applicable
|
||||
as follows:
|
||||
|
||||
Set: ERM
|
||||
Reset: CRM, EBM, FEAM, FETM, IRM, KAM, PUM, SRTM, TSM
|
||||
N/A: GATM, HEM, MATM, SATM, TTM, VEM
|
||||
|
||||
Control sequences implemented in the VT100 are as follows:
|
||||
|
||||
CPR, CUB, CUD, CUF, CUP, CUU, DA, DSR, ED, EL, HTS, HVP, IND,
|
||||
LNM, NEL, RI, RIS, RM, SGR, SM, TBC
|
||||
|
||||
plus several private DEC commands.
|
||||
|
||||
Erasing parts of the display (EL and ED) in the VT100 is performed thus:
|
||||
|
||||
Erase from cursor to end of line Esc [ 0 K or Esc [ K
|
||||
Erase from beginning of line to cursor Esc [ 1 K
|
||||
Erase line containing cursor Esc [ 2 K
|
||||
Erase from cursor to end of screen Esc [ 0 J or Esc [ J
|
||||
Erase from beginning of screen to cursor Esc [ 1 J
|
||||
Erase entire screen Esc [ 2 J
|
||||
|
||||
The VT100 responds to receiving the DA (Device Attributes) control
|
||||
|
||||
Esc [ c (or Esc [ 0 c)
|
||||
|
||||
by transmitting the sequence
|
||||
|
||||
Esc [ ? l ; Ps c
|
||||
|
||||
where Ps is a character that describes installed options.
|
||||
|
||||
The VT100's cursor location can be read with the DSR (Device Status
|
||||
Report) control
|
||||
|
||||
Esc [ 6 n
|
||||
|
||||
The VT100 reports by transmitting the CPR sequence
|
||||
|
||||
Esc [ Pl ; Pc R
|
||||
|
||||
where Pl is the line number and Pc is the column number (in decimal).
|
||||
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^
|
||||
|
||||
The complete document describing the standard, "ANSI X3.64-1979:
|
||||
Additional Controls for Use with the American National Standard
|
||||
Code for Information Interchange," can be ordered for $13.50 (plus
|
||||
$4 postage) from
|
||||
|
||||
Standards Sales Department
|
||||
American National Standards Institute
|
||||
1430 Broadway
|
||||
New York, NY 10018
|
||||
212/354-3300
|
||||
|
||||
It's best to read the full standard before using it. It also helps
|
||||
to have copies of the related standards "X3.4-1977: American
|
||||
National Standard Code for Information Interchange" (the ASCII
|
||||
standard) and "X3.41.1974: Code-Extension Techniques for Use with
|
||||
the 7-Bit Coded Character Set of American National Standard for
|
||||
Information Interchange."
|
||||
|
||||
See also the chapter "Using Extended Screens and Keyboard Control"
|
||||
in the IBM PC-DOS manuals (versions 2.0, 2.1, and 3.0), especially
|
||||
for the coding for character attributes.
|
||||
|
||||
The specification for the DEC VT100 is document EK-VT100-UG-003,
|
||||
available for $13.00 prepaid from:
|
||||
|
||||
Digital Equipment Corporation
|
||||
Accessories and Supplies Group
|
||||
POB CS-2008
|
||||
Nashua, NH 03061
|
||||
|
||||
(Copyright 1984 BYTE Publications, subsidiary of McGraw-Hill Inc.)
|
||||
(Permission granted to reproduce for noncommercial uses.)
|
||||
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^
|
||||
|
||||
For more information on programming ANSI or VT-100 Emulations into your ACOS segments, call the Orient GS @ (416) 241-4360 in Toronto Ont. 14.4K USR 24Hrs.
|
||||
Good Luck in you ANSI programming... Pat..
|
||||
|
||||
v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v
|
||||
^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^v^
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
|
@ -0,0 +1,88 @@
|
|||
; AMDSS is copyright by Morgan Davis
|
||||
; Adaptation by Matthew Montano
|
||||
;
|
||||
; This version July 27th, 1989
|
||||
; Version .91b of AMDSS
|
||||
|
||||
public out
|
||||
public connect
|
||||
on nocar goto
|
||||
|
||||
goto connect
|
||||
|
||||
out
|
||||
ou=1
|
||||
gosub send
|
||||
gosub r.file
|
||||
goto hangup
|
||||
|
||||
connect
|
||||
v1$="b":x=1:bt$="":echo=" ":kill "g:batch":create "g:batch"
|
||||
print "id:";
|
||||
input @3 i$:if
|
||||
a=instr(";",i$):no$=left$(i$,a-1):c$=mid$(i$,a+1)
|
||||
open #1,"g:net.pass"
|
||||
check.node
|
||||
input #1,b$
|
||||
b=instr(";",b$):n2$=left$(b$,b-1):c2$=mid$(b$,b+1)
|
||||
if (no$=n2$) and
|
||||
if b$="" close:r$="AMDSS - connect1:"+no$+" attempted to use "+c$+" to login":gosub
|
||||
goto check.node
|
||||
cp.1
|
||||
input #1,i$:if i$=""
|
||||
a=instr(";",i$):if left$(i$,a-1)<>no$ goto
|
||||
i=val(mid$(i$,a+1)):close
|
||||
r$="AMDSS - "+no$+" logged in @ "+date$+"-"+time$:print #3,r$:gosub amdss.log
|
||||
|
||||
r.file
|
||||
print #3,"Recieving.."
|
||||
f$=" ":use v1$+":protocol.up",250,1,"i:",f$
|
||||
if left$(f$,2)=" " and
|
||||
if left$(f$,2)=" " create
|
||||
if er>10:r$="Bad connection":gosub amdss.log:modem(1):goto
|
||||
if peek(10)>0 print
|
||||
x=x+1
|
||||
r$=" recieved "+f$+" from "+no$+" at "+time$:gosub amdss.log
|
||||
goto r.file
|
||||
|
||||
send
|
||||
b=1:lg$="i"+str$(i)+":":print "Getting a file":gosub getfnum
|
||||
f$="i"+str$(i)+":"+fx$
|
||||
if ou and
|
||||
if left$(fx$,3)=" " close:print
|
||||
if left$(fx$,3)=" ":r$="AMDSS: connection with "+no$+" ended at "+time$:gosub amdss.log:goto
|
||||
send1.1
|
||||
use v1$+":protocol.down",140,1,f$
|
||||
if peek(10)>0 print
|
||||
if er=10 print
|
||||
ready" ":kill f$:close:r$=" sent "+f$+" to "+no$+" at "+time$:gosub amdss.log
|
||||
goto send
|
||||
|
||||
getfnum
|
||||
fx$=chr$(32,15)
|
||||
print "fx$="fx$"-":print "b="b"-":print
|
||||
print "This works the first time but fails the second"
|
||||
use v1$+":xcat",b,lg$,fx$,bt$,bt$,bt$,bt$,bt$,bt$,bt$,bt$
|
||||
return
|
||||
|
||||
hang.up
|
||||
close:call edit(5),250,1:close
|
||||
r$="Connection with "+no$+" lost at "+time$:gosub amdss.log
|
||||
e$="amdss":link "a:parse"
|
||||
|
||||
amdss.log
|
||||
close
|
||||
open #1,"g:amdss.log"
|
||||
a=mark(1):if a close:create
|
||||
append #1
|
||||
print #1,r$
|
||||
close
|
||||
return
|
||||
|
||||
sort.mail
|
||||
r$="AMDSS process ended at "+time$:gosub amdss.log
|
||||
|
||||
hangup
|
||||
modem(1):echo="":e$="amdss":link "a:parse"
|
||||
|
||||
|
||||
Binary file not shown.
|
|
@ -0,0 +1,22 @@
|
|||
LLUCE requirements for Networked setup:
|
||||
|
||||
1) Obvious "link"ages into the email segment
|
||||
2) System segment commands to do a manual parsing of needed files
|
||||
3) The support of a different variable containing the systems "network" site name
|
||||
4) Status flags for a networked message base
|
||||
5) Modifications to the wait routine to allow it to link out at a specified time (code availible if you want it).
|
||||
|
||||
Message segements modifications:
|
||||
|
||||
6.1 - Networked message bases must have string (for each message base) containing a network mail address (for feeds)
|
||||
6.2 - When replying to a networked message base, the message segment must link to the mail segment to a specific label.
|
||||
|
||||
7) During the login, if the users name is a specified name, link to a specific segment
|
||||
|
||||
During the setup phase of GBBS, prompts should be added to ask for:
|
||||
a) network site name
|
||||
b) bps call out speed
|
||||
|
||||
I will write a complete network maintenance segment.
|
||||
|
||||
I have tested my amdss and mdss segments all today.. They all work great! Everything works wondeful, including aliasing etc.
|
||||
|
|
@ -0,0 +1,496 @@
|
|||
; [::::::::::::::::::::]
|
||||
; [ ProTALK v2.1 ]
|
||||
; [ Mail Segment ]
|
||||
; [ (c) 1988 Parik Rao ]
|
||||
; [::::::::::::::::::::]
|
||||
; [ Network Mods ]
|
||||
; [ By Matthew Montano ]
|
||||
; [::::::::::::::::::::]
|
||||
|
||||
public read
|
||||
public mail
|
||||
public net7
|
||||
|
||||
on nocar goto link.term
|
||||
|
||||
read
|
||||
wr=0
|
||||
on nocar goto link.term
|
||||
gosub read0:goto link.back
|
||||
|
||||
read0
|
||||
on nocar goto link.term
|
||||
open #1,"g:mail."+str$(un):a=mark(1):Close
|
||||
if a print \\"[Error]:No mail waiting!":return
|
||||
ready "g:mail."+str$(un)
|
||||
print:print
|
||||
read1
|
||||
setint(1)
|
||||
for x=1 to msg(0):input #msg(x),t,t$,t1$\t2$,t3$,t1,t4$
|
||||
print "#"right$("00"+str$(x),2)" -- From :"left$(t1$+chr$(32,20),20)" ";
|
||||
print " Subj :"left$(t$+chr$(32,20),20)
|
||||
next
|
||||
setint("")
|
||||
read2
|
||||
print \\"[Input]:Start at which message [<cr>=quit][->";:input @3 i$
|
||||
if i$="" gosub purge:return
|
||||
z=val(i$):if (z<1) or (z>msg(0)) print \\"[Error]:Does not exist!":goto read2
|
||||
z=z-1:if z<0:z=0
|
||||
read3
|
||||
z=z+1
|
||||
if z>msg(0) goto purge
|
||||
input #msg(z),t,t$,t1$\t2$,t3$,t1,t4$
|
||||
setint(1)
|
||||
print \chr$(95,79)\
|
||||
a$="Awaiting Reply"
|
||||
a=instr("!",t4$):b=instr("@",t4$):if aorb a$="Networked"
|
||||
print "[:.From....:] "t1$
|
||||
if instr("!",t4$) or instr("@",t4$) print "[:.From....:] "t4$:a$="Networked"
|
||||
print "[:.Subject.:] "t$
|
||||
print "[:.Letter..:] "z" of "msg(0)
|
||||
print "[:.Date....:] "t2$" "t3$
|
||||
print "[:.Status..:] ";
|
||||
if t1=1:a$="Certified"
|
||||
if t1=2:a$="Already Read"
|
||||
if t1=3:a$="Post Office"
|
||||
print a$
|
||||
print chr$(95,36)"Message"chr$(95,36)\\
|
||||
copy #6
|
||||
print chr$(95,79)
|
||||
setint("")
|
||||
if t1=2 goto read4
|
||||
if t1<>1 goto read3b
|
||||
if not info(5) goto read3a
|
||||
print \"[Input]:Send Certificate? ";:gosub getkey
|
||||
if i$="N" print "No!":t1=0:else print "Yes!"
|
||||
read3a
|
||||
if t1=1 gosub certify
|
||||
read3b
|
||||
input #msg(z),t,t$,t1$\t2$,t3$,t1,t4$:edit(0):copy #6,#8
|
||||
t1=2:g=msg(z)
|
||||
kill #msg(z):update
|
||||
print #msg(z),t,t$,t1$\t2$,t3$,t1,t4$:copy #8,#6:msg(z)=g:update
|
||||
read4
|
||||
if i$="+" goto read3
|
||||
print \\"[Mail Level]:Command? ";
|
||||
read5
|
||||
gosub getkey
|
||||
if i$=chr$(13) or i$="N" or i$="+" print "Next":goto read3
|
||||
if i$="D" print "Dump Mail":i$="+":goto read3
|
||||
if i$="A" print "Auto-Reply":wr=1:sb$=t$:gosub reply:goto read4
|
||||
if i$="Q" print "Quit":gosub purge:return
|
||||
if i$="K" print "Kill":gosub kill:goto read4
|
||||
if i$="F" print "Forward":gosub forward:goto read4
|
||||
if i$="R" print "Reread":z=z-1:goto read3
|
||||
if i$="?" print "Menu":f$="b:mail.mnu2":gosub show.file:goto read4
|
||||
goto read5
|
||||
|
||||
reply
|
||||
a=instr("!",t1$):b=instr("@",t1$):if a or b goto net3
|
||||
reply1
|
||||
if t=0 print \\"[Error]:Unknown User!":return
|
||||
y=un:fr$=a3$
|
||||
print \\"[:.From....:] "a3$;:if not info(5) print:goto reply2
|
||||
print chr$(8,(len(a3$)));:input @3 i$:if i$<>"":fr$=i$:y=0
|
||||
reply2
|
||||
if t$:if left$(t$,3)<>"Re:":sb$="Re:"+t$
|
||||
print "[:.Subject.:] "sb$;chr$(8,(len(sb$)));:input @3 i$
|
||||
if i$<>"":sb$=i$
|
||||
print "[:.Date....:] "date$" "time$\
|
||||
close:ready " ":f$="g:mail."+str$(t):open #1,f$:a=mark(1):close
|
||||
if a gosub msg
|
||||
st=0
|
||||
print \"[Input]:Do you wish to send via certified mail? ";:gosub getkey
|
||||
if i$<>"Y" print "No!!":else print "Yes!":st=1
|
||||
print \"[Input]:Do you wish to Xmodem your message? ";:gosub getkey
|
||||
if i$<>"Y" print "No!!":goto reply2a:else gosub up.xmdm
|
||||
goto reply3
|
||||
reply2a
|
||||
edit(0)
|
||||
reply2b
|
||||
Gosub editor
|
||||
reply3
|
||||
if not edit(2) return
|
||||
print \"[Wait]:Saving Message...";
|
||||
t4$="":ready f$
|
||||
print ".";
|
||||
c=msg(0)+1:print #msg(c),y,sb$,fr$\date$,time$,st,t4$
|
||||
copy #8,#6
|
||||
print ".";
|
||||
update:open #1,"g:mail."+str$(un):a=mark(1):close
|
||||
if not a ready "g:mail."+Str$(un)
|
||||
print ".Done!":return
|
||||
|
||||
purge
|
||||
print \\"[Input]:Delete all your mail? ";:gosub getkey
|
||||
if i$<>"Y" print "No!!":return
|
||||
print "Yes!!":ready " ":close
|
||||
f$="g:mail."+str$(un):kill f$:return
|
||||
|
||||
kill
|
||||
print \\"[Input]:Delete THIS letter? ";:gosub getkey
|
||||
if i$<>"Y" print "No!!":return
|
||||
print "Yes!!":kill #msg(z):crunch:update:print \\"[Note]:Message Deleted."
|
||||
return
|
||||
|
||||
forward
|
||||
input @3 \\"[Input]:To who (user #) :"i$
|
||||
a=val(i$):if (a<1) or (a>nu) print \\"[Error]:Invalid User!!":return
|
||||
f$="g:mail."+str$(a):open #1,f$:b=mark(1):close
|
||||
if b gosub msg
|
||||
ready "g:mail."+str$(un)
|
||||
input #msg(z),y,y$,y1$\y2$,y3$,st,t4$:edit(0):copy #6,#8
|
||||
t=a:fr$=a3$:y=un:sb$="Forwarded"
|
||||
print \"[Wait]:Saving Message...";
|
||||
ready f$
|
||||
print ".";
|
||||
c=msg(0)+1:print #msg(c),y,sb$,fr$\date$,time$,st,t4$
|
||||
print #6,"<-> A Forwarded Letter <->"
|
||||
print #6,\"[:..Originally From..:] "y1$" @"y4$
|
||||
print #6,"[:..Subject..........:] "y$
|
||||
print #6,"[:..Date & Time......:] "y2$" "y3$\\
|
||||
copy #8,#6
|
||||
print ".";
|
||||
update
|
||||
ready "g:mail."+str$(un)
|
||||
print ".done!"
|
||||
return
|
||||
|
||||
link.back
|
||||
ae=0:link "a:main.seg","fromsys"
|
||||
|
||||
link.term
|
||||
link "a:main.seg","term1"
|
||||
|
||||
msg
|
||||
kill f$:create f$:open #1,f$:ed=edit(5):fill ed,255,0:poke ed,4:poke ed+1,4
|
||||
write #1,ed,2:fill ed,255,0:for xz=1 to 4:write #1,ed,255:next:write #1,ed,10
|
||||
close #1:return
|
||||
|
||||
mail
|
||||
wr=0
|
||||
on nocar goto link.term
|
||||
print \\"[Mail Level]:Command? ";
|
||||
mail2
|
||||
gosub getkey
|
||||
if i$="?" print "Menu":f$="b:mail.mnu":gosub show.file:goto mail
|
||||
if i$="P" print "Purge Mail":gosub purge:goto mail
|
||||
if i$="R" print "Read Mail":a=0:ready " ":close:gosub read0:goto mail
|
||||
if i$="S" print "Send Mail":gosub send:goto mail
|
||||
if i$="Q" print "Quit":goto link.back
|
||||
if i$="N" print "Net Stations":gosub stats:goto mail
|
||||
if i$="B" print "Bulk Mailing":gosub bulk:close:goto mail
|
||||
if i$="E" print "Edit OutGoing Mail":gosub edit:goto mail
|
||||
if i$="L" print "List Users with mail":Gosub u.list:goto mail
|
||||
goto mail2
|
||||
|
||||
show.file
|
||||
setint(1):copy f$:setint(""):return
|
||||
|
||||
editor
|
||||
print sc$'
|
||||
____________________________________________________________________________
|
||||
| |
|
||||
| Enter Message Now .S to Save |
|
||||
|____________________________________________________________________________|'
|
||||
aa=clock(2):clock(2)=0:edit(1):clock(2)=aa:return
|
||||
|
||||
getkey
|
||||
s1=y:s2=q:y=0
|
||||
get2
|
||||
q=key(0):if (q>96) and (q<123):q=q-32
|
||||
if q<>0:i$=chr$(q):y=s1:q=s2:return
|
||||
y=y+1
|
||||
if y=1500 print chr$(7,10);:goto get2
|
||||
if y=3000 print \"Timeout. Bye...":goto link.term
|
||||
goto get2
|
||||
|
||||
u.list
|
||||
y=0:if not info(5) goto u.list1
|
||||
print \\"[Input]: Dump to printer? ";:gosub getkey
|
||||
if i$="Y" print "Yes!":y=5:else print "No!"
|
||||
u.list1
|
||||
print #y,'
|
||||
____________________________________________________
|
||||
| | | |
|
||||
| ### | Name | Last On |
|
||||
|_____|______________________|_______________________|
|
||||
| | | |'
|
||||
setint(""):setint(1)
|
||||
;MODIFY THIS________________________________________________________________
|
||||
close:open #2,"b:users":for x=1 to nu
|
||||
open #1,"g:mail."+str$(x):a=mark(1):Close #1
|
||||
if a goto u.list2
|
||||
if key(1):x=nu:goto u.list2
|
||||
position #2,512,x:input #2,d3$,d4$,d5$
|
||||
if d3$="" goto u.list2
|
||||
position #2,512,x,150:input #2,f1$,f2$,f3$\f4$,f5$,f6$\f7$,f8$,f9$
|
||||
print #y,"| "right$("000"+str$(x),3)" | "left$(d3$+chr$(32,20),20)" | ";
|
||||
print #y,f8$" "f9$" |"
|
||||
u.list2
|
||||
next:close
|
||||
setint("")
|
||||
print #y,"|_____|______________________|_______________________|"
|
||||
return
|
||||
|
||||
send
|
||||
on nocar goto link.term
|
||||
input @3 \\"[Input]:Enter User Number, Name, <N>et, or <cr> to Quit :"i$
|
||||
if i$="N" or i$="n" goto nets
|
||||
if i$="" return
|
||||
a=val(i$):if not a gosub send2
|
||||
if (a<1) or (a>nu) return
|
||||
move ram,64 to ram2
|
||||
;MODIFY THIS!____________________________________________________________
|
||||
open #1,"b:users":position #1,128,a
|
||||
input #1,d1$,d2$\d3$\d4$,d5$:position #1,128,a,70:read #1,ram,58
|
||||
if d3$="" close:move ram2,58 to ram:return
|
||||
print \\"[Input]:Send mail to "d3$" ("a") , last on _"when$"_ :";
|
||||
close:move ram2,58 to ram
|
||||
gosub getkey
|
||||
if i$<>"Y" print "No!!":return
|
||||
print "Yes!!"
|
||||
t1$="":t4$=ne$:t=a:sb$="":goto reply
|
||||
|
||||
send2
|
||||
;MODIFY THIS______________________________________________________________
|
||||
open #1,"b:users"
|
||||
setint(1):a=0
|
||||
for x=1 to nu
|
||||
if key(1):x=nu:setint(""):goto send3
|
||||
position #1,128,x:input #1,d1$,d2$\d3$\d4$,d5$
|
||||
if d3$=i$:a=x:x=nu:close:setint("")
|
||||
send3
|
||||
next
|
||||
if a>0 return
|
||||
close
|
||||
setint("")
|
||||
print \\"[Error]:User not found."\
|
||||
pop:return
|
||||
|
||||
edit
|
||||
print \\"[Input]:Enter Users Name/User # whose mail you have already sent"
|
||||
print " and wish to edit :";:input @3 i$
|
||||
if i$="" return
|
||||
a=val(i$):close:ready " ":rz=a
|
||||
open #1,"g:mail."+str$(a):z=mark(1):close
|
||||
if z print \\"[Error]:User has no mail!!":return
|
||||
ready "g:mail."+str$(a)
|
||||
for x=1 to msg(0)
|
||||
edit(0)
|
||||
input #msg(x),t,t$,t1$\t2$,t3$,t1,t4$
|
||||
if (t<>un) and (not info(5)) next:close:ready " ":return
|
||||
print \\"Subject :"t$
|
||||
print "From :"t1$
|
||||
print "Date :"t2$" "t3$\\
|
||||
print "Edit This one? ";:gosub getkey
|
||||
if i$<>"Y" print "No!":next:return
|
||||
else print "Yes!":w=a:a=x:x=msg(0):next:close
|
||||
print \\"Subject :"t$;chr$(8,(len(t$)));:input @3 i$
|
||||
if i$<>"":t$=i$
|
||||
print "From :"t1$;:if info(5) print chr$(8,(len(t1$)));
|
||||
if info(5) input @3 i$:if i$<>"":t1$=i$:else print
|
||||
print
|
||||
copy #6,#8
|
||||
t=un
|
||||
gosub editor
|
||||
if not edit(2) gosub edit2
|
||||
print \\"[Wait]:Saving Message...";
|
||||
a=rz
|
||||
kill #msg(a):update
|
||||
print ".";
|
||||
print #msg(a),t,t$,t1$\date$,time$,st,t4$
|
||||
copy #8,#6
|
||||
print ".";
|
||||
update
|
||||
print ".Done!"
|
||||
return
|
||||
|
||||
edit2
|
||||
if w=1 pop:return
|
||||
print \\"[Error]:You have aborted the process. Do you wish to DELETE"
|
||||
print " the entire message? ";:gosub getkey
|
||||
if i$<>"Y" print "No!":pop:return
|
||||
print "Yes!"\\"[Wait]:Deleting Message...";
|
||||
kill #msg(a):print ".";
|
||||
crunch:print ".";:update
|
||||
u=msg(0):if not u ready " ":close:kill "g:mail."+str$(w)
|
||||
print ".done!":pop:return
|
||||
|
||||
stats
|
||||
close
|
||||
print \\"Listing of paths file "
|
||||
print "---------------------------------------------------------"\
|
||||
z=0:open #1,"g:paths":setint(1)
|
||||
stat2
|
||||
copy #1
|
||||
stat3
|
||||
setint("")
|
||||
close
|
||||
print \\"Press a key to continue...";:input @3 i$
|
||||
return
|
||||
|
||||
up.xmdm
|
||||
print \\"Xmodem: (P)roDOS, (S)tandard, (D)os 3.3 :";:gosub getkey:z=0
|
||||
if i$="P" print "ProDOS":z=1
|
||||
if i$="D" print "Dos 3.3":z=2
|
||||
if i$="S" print "Standard":z=3
|
||||
if not z return
|
||||
z=z*(z<>3):print \"Ready to Receive..."
|
||||
f1$="h:u":use "b:x.up",z,f1$
|
||||
close:edit(0):copy f1$,#8
|
||||
if not edit(2) print \\"[Note]:Message aborted!":return
|
||||
print \\"[Wait]:Checking Message..."edit(2)" bytes...";:z=0
|
||||
up2
|
||||
open #1,f1$
|
||||
up3
|
||||
if eof(1) goto up4
|
||||
z=z+1:input #1,i$
|
||||
if left$(i$,2)=".X" edit(0):close:goto die
|
||||
if not (z mod 5) print ".";
|
||||
goto up3
|
||||
up4
|
||||
print ".done!"\\
|
||||
close
|
||||
kill f1$:edit(1)
|
||||
return
|
||||
|
||||
die
|
||||
create "b:hack":open #1,"b:hack":append #1
|
||||
print #1,\\"-Hack Attempt-"
|
||||
print #1,"Name ->"a3$" ("un")"
|
||||
print #1,"Reason -> <.X> bug-attempts..."
|
||||
close
|
||||
return
|
||||
|
||||
bulk
|
||||
if flag(37) and (not info(5)) print \"[Error]:Bulk Prohibited.":return
|
||||
f=0:f1=3
|
||||
if flag(5):f1=10
|
||||
if flag(10):f1=20
|
||||
if flag(19):f1=50
|
||||
if flag(33):f1=0
|
||||
if flag(34):f1=0
|
||||
kill "h:temp":create "h:temp":open #1,"h:temp"
|
||||
bulk1
|
||||
input @2 \"[Input]:Send Bulk Mail To (User Number/Name/<cr>=Quit) :"i$
|
||||
if (i$="") and (f=0) return
|
||||
if i$="" goto bulk3
|
||||
a=val(i$):b=len(i$):if (b<3) and (not a) goto bulk1
|
||||
if a goto bulk2
|
||||
open #2,"b:users":for x=1 to nu:position #2,128,x:input #2,d1$,d2$\d3$\d4$,d5$
|
||||
if d3$=i$:a=x:x=nu:next:close #2:goto bulk2
|
||||
next
|
||||
close #2
|
||||
goto bulk1
|
||||
bulk2
|
||||
open #2,"b:users":position #2,128,a:input #2,d1$,d2$\d3$\d4$\d5$:close #2
|
||||
print \"Send to :"d3$" ? ";:gosub getkey
|
||||
if i$<>"Y" print "No":goto bulk1
|
||||
print "Yes!"
|
||||
f=f+1
|
||||
if f1<>0:f1=f1-1:if f1=0 print \"[Error]:Bulk Mail Limit Exceeded!":flag(37)=1:return
|
||||
print #1,a
|
||||
goto bulk1
|
||||
bulk3
|
||||
close
|
||||
fr$=a3$
|
||||
print \"[:..From....:] "fr$;
|
||||
if info(5) print chr$(8,(len(fr$)));:input @3 i$:if i$<>"":fr$=i$
|
||||
if fr$=a3$:y=un:else y=0
|
||||
input @3 "[:..Subject.:] "sb$
|
||||
if sb$="":sb$="Nothing Particular"
|
||||
print "[:..Date....:] "date$" "time$
|
||||
print \"[Bulk]:Are you SURE you wish to continue? ";:gosub getkey
|
||||
if i$<>"Y" print "No!":return
|
||||
print "Yes!"\
|
||||
edit(0):gosub editor:print \\"[Wait]:Bulk Mailing...";
|
||||
kill "h:temp1":create "h:temp1":open #1,"h:temp1":copy #8,#1:close:edit(0)
|
||||
mk=0:for xz=1 to f
|
||||
open #1,"h:temp":mark(1)=mk:input #1,a:mk=mark(1):close #1
|
||||
f$="g:mail."+str$(a):open #1,f$:b=mark(1):close #1
|
||||
if b gosub msg
|
||||
open #1,"h:temp1":edit(0):copy #1,#8:close #1
|
||||
ready f$
|
||||
c=msg(0)+1:print #msg(c),y,sb$,fr$\date$,time$,0,t4$
|
||||
copy #8,#6:update:ready " "
|
||||
print ".";
|
||||
next
|
||||
close
|
||||
print ".Done!!"\\
|
||||
return
|
||||
|
||||
certify
|
||||
f$="g:mail."+str$(t):open #1,f$:rt=mark(1):close
|
||||
if rt gosub msg
|
||||
print \"[Wait]:Sending Certification...";
|
||||
st=3:sb$="Certified Mail Reciept":fr$="The Post Office":y=un:edit(0)
|
||||
print ".";
|
||||
print #8,\"Your message to "a3$" ("un"), has been recieved on "date$" "time$\
|
||||
print ".";
|
||||
ready f$
|
||||
print ".";
|
||||
c=msg(0)+1:print #msg(c),y,sb$,fr$\date$,time$,st,t4$
|
||||
copy #8,#6
|
||||
print ".";
|
||||
update
|
||||
ready "g:mail."+Str$(un)
|
||||
print ".Done!"
|
||||
return
|
||||
|
||||
nets
|
||||
net1
|
||||
net2
|
||||
net3
|
||||
net4
|
||||
input @3 \"[Input]:Enter Network Address of User :"i$
|
||||
if i$="" return
|
||||
if len(i$)<3 return
|
||||
ti$=i$:a9$=a3$:i$=a9$:gosub lcase:a9$=i$
|
||||
net4.01
|
||||
a=instr(" ",a9$)
|
||||
if a:a9$=left$(a9$,(a-1))+"."+mid$(a9$,a+1):goto net4.01
|
||||
y=un:fr$=a9$
|
||||
print \\"[:.From....:] "sn$"!"a9$;:if not info(5) print:goto net4.1
|
||||
print chr$(8,(len(sn$+"!"+a9$)));:input @3 i$:if i$<>"":fr$=i$:y=0
|
||||
fr$=fr$+" "+date$+" "+time$:ft$=a9$+"@"+sn$+" ("+a3$+")"
|
||||
net4.1
|
||||
print "[:.Subject.:] ";:input @3 sb$
|
||||
if sb$="" return
|
||||
print "[:.Date....:] "date$" "time$\
|
||||
f$="g:mail.net":open #1,f$:a=mark(1):close:if a gosub msg
|
||||
print \"[Input]:Do you wish to Xmodem your message? ";:gosub getkey
|
||||
if i$<>"Y" print "No!!":goto net5
|
||||
gosub up.xmdm
|
||||
goto net6
|
||||
net5
|
||||
edit(0)
|
||||
net6
|
||||
Gosub editor
|
||||
if not edit(2) return
|
||||
print \\"[Input]:Is everything correct? ";:gosub getkey
|
||||
if i$<>"Y" print "No!":return
|
||||
print "Yes!"
|
||||
print \"[Wait]:Saving Message...";
|
||||
ready f$
|
||||
print ".";
|
||||
dt$=date$+" "+time$:pp$="out"
|
||||
c=msg(0)+1:print #msg(c),fr$,ti$,sb$\dt$,pp$,ft$
|
||||
copy #8,#6
|
||||
print ".";
|
||||
update:close:open #1,"g:mail."+str$(un):a=mark(1):close
|
||||
if not a ready "g:mail."+Str$(un)
|
||||
print ".Done!"
|
||||
print \"[System]: Please wait, parsing.":print \"Linking..."
|
||||
e$="g:mail.net"
|
||||
link "a:parse"
|
||||
net7
|
||||
use "b:xdos","d g:mail.net"
|
||||
return
|
||||
|
||||
lcase
|
||||
a$="":for l=1 to len(i$)
|
||||
y=asc(mid$(i$,l,1)):if (y>65) and (y<90):y=y+32
|
||||
a$=a$+chr$(y):next
|
||||
i$=a$
|
||||
return
|
||||
|
|
@ -0,0 +1,110 @@
|
|||
; MDSS is copyright by Morgan Davis
|
||||
; Adaptation by Matthew Montano
|
||||
;
|
||||
; This version Febuary 2nd, 1988
|
||||
; Version .91a
|
||||
|
||||
public out
|
||||
public connect
|
||||
on nocar goto
|
||||
|
||||
goto connect
|
||||
|
||||
out
|
||||
ou=1
|
||||
gosub send
|
||||
print #4,"S"
|
||||
gosub mdss
|
||||
|
||||
connect
|
||||
v1$="b":x=1:bt$="":echo=" ":kill "g:batch":create "g:batch"
|
||||
print "id:";
|
||||
input @3 i$:if
|
||||
a=instr(";",i$):no$=left$(i$,a-1):c$=mid$(i$,a+1)
|
||||
open #1,"g:net.pass"
|
||||
check.node
|
||||
input #1,b$
|
||||
b=instr(";",b$):n2$=left$(b$,b-1):c2$=mid$(b$,b+1)
|
||||
if (no$=n2$) and
|
||||
if b$="" close:r$="MDSS - connect1:"+no$+" attempted to use "+c$+" to login":gosub
|
||||
goto check.node
|
||||
cp.1
|
||||
input #1,i$:if i$=""
|
||||
a=instr(";",i$):if left$(i$,a-1)<>no$ goto
|
||||
i=val(mid$(i$,a+1)):close
|
||||
r$="MDSS - "+no$+" logged in @ "+date$+"-"+time$:print #3,r$:gosub mdss.log
|
||||
|
||||
mdss
|
||||
on nocar goto
|
||||
gosub get.key
|
||||
if i$="H" modem(1):print
|
||||
if i$="R" goto
|
||||
if i$="S" goto
|
||||
print chr$(24,5):goto mdss
|
||||
|
||||
r.file
|
||||
f$="i:m"+str$(x)
|
||||
print #3,"Recieving file: "f$
|
||||
z=1:z=z*(z<>3):use "b:x.up",z,f$
|
||||
x=x+1:r$=" recieved "+f$+" from "+no$+" at "+time$:gosub mdss.log
|
||||
goto mdss
|
||||
|
||||
send
|
||||
b=1:lg$="i"+str$(i)+":":gosub getfnum
|
||||
f$="i"+str$(i)+":"+fx$
|
||||
gosub test.life
|
||||
print #3,"Attempting to send -"fx$"-"
|
||||
if ou and
|
||||
if left$(fx$,3)=" " close:print
|
||||
if left$(fx$,3)=" " goto
|
||||
send1.1
|
||||
if er=10 print
|
||||
print "R";
|
||||
z=1:z=z*(z<>3):use "b:x.dn",z,f$
|
||||
kill f$:r$=" sent "+f$+" to "+no$+" at "+time$:gosub mdss.log
|
||||
goto send
|
||||
|
||||
test.life
|
||||
z=key(0)
|
||||
if z=5 return
|
||||
y=y+1
|
||||
if y=5000 modem(1):pop:print
|
||||
goto test.life
|
||||
|
||||
get.key
|
||||
y=0
|
||||
get.key1
|
||||
clear key:print chr$(5);:zz=key(0)
|
||||
if (zz>96) and
|
||||
i$=chr$(zz):if i$="H" return
|
||||
if i$="R" or
|
||||
goto get.key1
|
||||
|
||||
getfnum
|
||||
fx$=chr$(32,15)
|
||||
print "fx$="fx$"-":print "b="b"-":print
|
||||
print "This works the first time but fails the second"
|
||||
use v1$+":xcat",b,lg$,fx$,bt$,bt$,bt$,bt$,bt$,bt$,bt$,bt$
|
||||
print "fx$="fx$"-":print "b="b"-":print
|
||||
return
|
||||
|
||||
hang.up
|
||||
close:call edit(5),250,1:close
|
||||
r$="Connection with "+no$+" lost at "+time$:gosub mdss.log
|
||||
e$="amdss":link "a:parse"
|
||||
|
||||
mdss.log
|
||||
close
|
||||
open #1,"g:mdss.log"
|
||||
a=mark(1):if a close:create
|
||||
append #1
|
||||
print #1,r$
|
||||
close
|
||||
return
|
||||
|
||||
sort.mail
|
||||
r$="MDSS process ended at "+time$:gosub mdss.log
|
||||
|
||||
hangup
|
||||
modem(1):echo="":e$="amdss":link "a:parse"
|
||||
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
; Network configuration Segment
|
||||
;-------------------------------
|
||||
; Written by Matthew Montano
|
||||
; July 5th, 1989
|
||||
|
||||
|
||||
on nocar goto
|
||||
|
||||
print \\" Network configuration segment"
|
||||
print " Alpha version, July 5th, 1989"
|
||||
print " -- Written by Matthew Montano"
|
||||
|
||||
print \"Do you want to delete DIR.MIN and NET.PASS and continue ->";
|
||||
input @3 i$:if
|
||||
kill "g:dir.min":kill "g:net.pass":create
|
||||
print \"Input number of systems you are connected to -> ";:input\i
|
||||
|
||||
for x=1 to
|
||||
read1
|
||||
print \"Enter system #"i"'s name ->":input @3
|
||||
print \"Enter system #"i"'s password ->":input @3
|
||||
|
||||
print \\"For system #"i":"
|
||||
print \" Name of system -> "no$
|
||||
print " Password of system -> "pa$
|
||||
print \\" Is everything ok? [Y/n] -> ";
|
||||
get i$:print i$:if
|
||||
goto read1
|
||||
|
||||
write1
|
||||
open #1,"g:dir.min":append #1:print
|
||||
open #1,"g:net.pass":append #1:print
|
||||
next
|
||||
|
||||
print \\"All complete, here is your DIR.MIN file:"
|
||||
open #1,"g:dir.min":copy #1:close
|
||||
print \\" here is your NET.PASS file:"
|
||||
open #1,"g:net.pass":copy #1:close
|
||||
|
||||
print \\"Quiting..":link "a:system.seg"
|
||||
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
ProLink (tentative) description.
|
||||
|
||||
Confidential file for Lance Taylor Warren from Matthew Montano.
|
||||
|
||||
Hopefully this file will describe what I am doing with my software, and how it may be integrated into the stock GBBS system.
|
||||
|
||||
Protocol: The software uses a modified arpa/ddn/uucp/internet style parsing with *NO* extensions but rather limitations. The bitnet identifier (%) is not currently recognized or supported in the mailer. Support for domains and parks is going to be installed since it is simpler and would make a network easier to run.
|
||||
|
||||
Naming conventions: All sites will have to name there system in a restrictive way, at least in the way that mail will work. Following UUCP guidelines, all sites must have a site name that is one word, less than 16 characters (more is more awkward), and not containing any punctuation except the "_" character (denoting space). System names like "llsupport" or "stronghold" are ideal, where as names like "L & L Systems Support" or "The Stronghold IIGS" are not usable. Lower case is desirable, but since the mailer is case insensitive it doesn't matter. User names is a LARGE problem, since most of the GBBS systems use the standard first name/last name setup. For GBBS users will have mailing addresses in one of the following forms: 1) Their first name plus their account number i.e matthew907 (on Lance's system) 2) their first name plus a "_" character and their last name. I.E. matthew_montano <- undesirable because of length. 3) Optionally there would be alias file where each user can submit their own mail address to recieve mail with. 4) Built in to the mailer are account names such as "root" "sysop" "mailer" "postmaster" as specified by UUCP guidelines.
|
||||
|
||||
Integration of mailer into a stock GBBS system: The entire mailer HAS to be rewritten, luckily I have taken Parik's mailer (with his permission) from his ProTalk and modified it to work with standard GBBS with a parser. The mailer creates a temporary message file (if an outbound message) and then passes control to the parser which looks at the message and works with it. It will sort the mail quickly and place it in the correct outbound file or bounce it back to the sender. It takes under three seconds at the current time to parse a standard message (even with creating files etc... it's FAST).
|
||||
Using an x.wait or ACOS.TIME function at the idle state, the system will link to a segment at a given time each hour (if at the wait state at the specific time). This segment will check an id.file, see if it is the correct time to dial out for that system. If it is the correct time, it runs another segment (or a part of it within that segment) which checks how much mail is queded up and if there is mail will x.quit into proterm (after renaming the correct script file to pt.startup for auto-execution) and dial out and transfer the files per the protocol defined below. Once done, it will quit back into acos, run the logon segment and find that there still is a pt.startup file (indicating it was in the middle of a scan) and check the next system in the id.file for the specific time to dial out.
|
||||
Newsfeeds are handled by the parser. If the message is addressed to an account which contains the text "feed" in it, it triggers a process. In most cases the account name will be something like "infoapplefeed". The parser will search through the bulliten boards seraching for a board name with a matching name (infoapple) in this case and once found will write the new message to the base. Modifications in the standard GBBS code will have to be of the order of a modification to the message segment that when a person wants to auto-reply or post to one of these special feed boards that it passes control to the mailer. This of course is about the only major modification required to GBBS code for operation.
|
||||
|
||||
The parser works something like this:
|
||||
|
||||
1) Reads vars and message in.
|
||||
2) Pulls out the path header and takes all the characters to the left of the first "!" character.
|
||||
3) Checks the "first node" against the entries in the dir.min file (an id file) and if found determines a number to which to write the file out under.
|
||||
4) If not found in dir.min, it is checked against the "paths" file, where if found a path is substituted for the single site and control is passed back to #2.
|
||||
5) If not found in paths, then domain parsing would occur.
|
||||
6) If not domain parsed it will bounce.
|
||||
|
||||
The transfer protocol for the system is DEAD simple.
|
||||
|
||||
The host system (system recieving the call) will upon detecting an account name of "mailer" (or whatever) will link to a special segment. This segment prints "id:" and waits for the systemname;password before continuing. It then switches into ymodem batch recieve mode and recieves until a blank file name is passed with which the system reverses roles and the host system searches out for the files for the calling system and sends them via ymodem-batch until a blank file name is passed on which the systems hangup each other and take the recieve batch list and parse individual files one by one.
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
File formats for LLUCE-NET files and descriptions
|
||||
|
||||
Basic Message File
|
||||
------------------
|
||||
|
||||
This file format is for all inter-lluce-net traffic, message files between systems and the format of messages files being passed off to parse.s for processing.
|
||||
|
||||
print #msg(x),fr$,tr$,sb$\dt$,pp$,ft$:copy #6,#8
|
||||
|
||||
Six headers:
|
||||
|
||||
fr$ = the source of the message or who it is from.
|
||||
in the form "site!user DATE and TIME".
|
||||
|
||||
tr$ = the originally typed in address of the letter
|
||||
In the form "site!user" or "user@site" with
|
||||
associated domain identifiers.
|
||||
|
||||
sb$ = subject of the letter in plain text format
|
||||
|
||||
dt$ = date the original letter was sent
|
||||
In the form "XX/XX/XX XX:XX:XX XM" or UNIX style format
|
||||
It is not necessary to have it in a specific form, whatever
|
||||
is felt neccessary
|
||||
|
||||
pp$ = path to the user. This is in PURE UNIX style bang paths with
|
||||
domain identifiers allowed. In the form "site!site1!site2!user"
|
||||
or "site!site.park.domain!user"
|
||||
|
||||
ft$ = source of the message. It is in "user@site.domain (Full User)" form.
|
||||
|
||||
The text of the message can contain extra headers at the top of the message, as seen fit by the author of the mailer. They will be neither looked at or relied on for any information. It is likely that in UUCP sourced messages there will be extra headers passed on into the LLUCE-net and therefore those messages will appear in the text of the message.
|
||||
|
||||
|
||||
Text Style Message Format
|
||||
-------------------------
|
||||
|
||||
Messages that do not fit the standard LLUCE message file format can be written in an alternative format. This format is compatible with ProLine and hence compatible with UUCP sites. The standard Apple // delimited text file will have the UUCP/ProLine standard headers. This information is availible from "sysop@pro-generic.pro" if required.
|
||||
|
||||
|
||||
Binary File Format
|
||||
------------------
|
||||
|
||||
Alternatively, if information needs to be transmitted that isn't in a text format it can be placed in a file that will be transmitted through a LLUCE-NET system. The format for this message is a file of TXT format. It has four header lines in normal text format (ProLine/UUCP style) like below:
|
||||
|
||||
From_ <- fr$ format
|
||||
To: <- tr$ format
|
||||
Date: <- dt$ format
|
||||
Subject: <- sb$ format
|
||||
|
||||
Then follows as many lines of normal text as the sending user sees fit and finally a control-j present on a line by itself. What follows is the file in Binary II format (or NuFX). I have neither written anything supporting this format or plan to. It is above my power and time constraints. But this is a possibility only restricted by your imagination. (And the users stupidity in having the power to send files across the network).
|
||||
|
||||
|
||||
Paths file
|
||||
----------
|
||||
|
||||
A file exists to control the parsing of mail. It is referenced to if the piece of mail currently being parsed is being sent to a site that is not local to the site parsing the mail. It allows mail to be sent with an address of "site!user" even if "site" is a local site, as it can be path aliased by the parser. The paths file (residing in G:) looks like this
|
||||
|
||||
sitename: path!to!dest!sitename!*
|
||||
.domain: path!to!dest!domainhandler!*
|
||||
.park.domain: path!to!sorta!domainhandler!*.park
|
||||
|
||||
|
||||
If mail was addressed to "user@system.domain" the local parser just needs to know how to get mail to the system that is in control of the ".domain" domain. In this case the parser would place "path!to!dest!domainhandler!system!user" in pp$. Once the path has been parsed, it is run through parse again to make sure the first site listed in the new address is a legit single hop site and if not is parsed again.
|
||||
|
||||
|
||||
Aliases file
|
||||
------------
|
||||
|
||||
This file allows the sysop to control the flow of mail, distribution of newsfeeds and so forth. If mail was received to an address and it was to be sent to two users instead of one this is where it is controlled from. The format of the file is in the form:
|
||||
|
||||
destaddress
|
||||
mailaddress anothermailaddress an!off!site!address
|
||||
another!offsite!address
|
||||
|
||||
If mail was recieved to the local address "destaddress" it would have copies made and sent to all the addresses listed above. As above the second line as a starting space and therefore is part of the list of addresses from the line before. Special formats exist for any of the addresses listed in the aliases file (stored in g:). If the address starts with a "#" character, a copy is sent to the mailbox number after the "#" character. I.E.:
|
||||
|
||||
sysop
|
||||
#1
|
||||
root
|
||||
#1
|
||||
systemgod
|
||||
#1
|
||||
|
||||
If the address starts with a "%" (note both the # and % characters are illegal for use as intersystem address and hence used here for local purposes because they are guaranteed to work) then the message is sent to message board number following the "%" character. For example, with newsfeeds, if a site was not only recieving the feed but passing it off to another site an entry in the aliases file would look like this:
|
||||
|
||||
infoapple: %6 infoapple@nextsite
|
||||
|
||||
This would post the message sent to infoapple on the local site on board #6 as well as send it off to the address infoapple on "nextsite".
|
||||
|
||||
IMPORTANT: Both the dir.min, aliases, and paths file MUST end with a blank carriage return, otherwise it will crash the mailer.
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
Setting up your LLUCE-NET alpha site
|
||||
------------------------------------
|
||||
|
||||
Creating directories:
|
||||
|
||||
The most important directory is I:. It must be a completely seperate from others and there must be no files within it. I1: should be created in the same mannar as Supertac directories. It should be clean as well. If you are connected to two sites, create I2: and so on. (Check end of file for multiple connections).
|
||||
|
||||
Copying files:
|
||||
|
||||
Parse.s, Amdss.s, Mdss.s and Mail.s should be installed in A:.
|
||||
|
||||
Creating files:
|
||||
|
||||
G:DIR.MIN. This file is a listing of site names versus their directories. For our one connection system, the file would look like this:
|
||||
|
||||
systemname;1
|
||||
|
||||
with a blank line at the end.
|
||||
|
||||
G:NET.PASS. This file is a listing of other sites and their passwords. It is in the form of:
|
||||
|
||||
systemname;password
|
||||
|
||||
G:PATHS and G:ALIASES. These files will be explained later.
|
||||
|
||||
Installing links:
|
||||
|
||||
Mail.s should be accessable from the main segment via a menu command. In the logon segment under login2 add the lines:
|
||||
|
||||
if (instr("AMDSS",a3$) or instr("amdss",a3$)) link "a:amdss"
|
||||
if (instr("MDSS",a3$) or instr("mdss",a3$)) link "a:mdss"
|
||||
|
||||
in that order.
|
||||
|
||||
Creating accounts:
|
||||
|
||||
Create two accounts, one with AMDSS as the name and MDSS as the other. They can be from anywhere and only need have a flag that allows them to login. Remember the password and user number for the different accounts and submit them to your neighbouring sysops.
|
||||
|
|
@ -0,0 +1,249 @@
|
|||
;Parse.s mail
|
||||
;by Matthew Montano
|
||||
;Part of the LLUCE-NET package
|
||||
;(c) 1989, Venture Tech developement
|
||||
;written March 28th,1989
|
||||
;final revision June 31st, 1989
|
||||
; another revision July 9th, 1989
|
||||
; yet another revision (tr$ parsing added) July 31st, 1989
|
||||
; minor revision and cleaned up August 5th, 1989
|
||||
; minor revision August 18th, 1989
|
||||
|
||||
;remember outlets for domains
|
||||
;remember outlets for aliases
|
||||
;fix write to local account
|
||||
;allow for outlet to proline system
|
||||
|
||||
on nocar goto
|
||||
v1$="a":bg$="!"
|
||||
|
||||
if (e$="amdss") or
|
||||
if e1$="pass" gosub
|
||||
|
||||
close:open #1,e$:input #1,i$:close
|
||||
print "First line :"i$" -"
|
||||
if left$(i$,5)="From " gosub
|
||||
close:ready e$
|
||||
if (msg(0)=0) and
|
||||
if (msg(0)=0) and
|
||||
if msg(0) goto
|
||||
ready" ":kill e$:goto outahere
|
||||
|
||||
parse
|
||||
print \"[Parse v.0951 - "msg(0)" messages]: parsing"
|
||||
if msg(0)>256 print
|
||||
for x=1 to
|
||||
gosub rd.msg
|
||||
a=instr(" ",tr$):if a gosub
|
||||
gosub parse.it
|
||||
pp$="":tr$="":fr$="":sb$="":dt$="":ft$="":a=0:b=0:fn$="":pt$="":f2$="":f1$=""
|
||||
next
|
||||
link "a:parse"
|
||||
|
||||
parse.it
|
||||
if fr$="" ready
|
||||
if pp$="out" gosub
|
||||
i$=pp$:gosub lcase:pp$=i$
|
||||
pit1.1
|
||||
a=instr(bg$,pp$):fn$=left$(pp$,a-1)
|
||||
if fn$=sn$:pp$=mid$(pp$,a+1):goto pit1.1
|
||||
if a=0 goto
|
||||
pt$=mid$(pp$,a+1)
|
||||
|
||||
parse3
|
||||
close:open #1,"g:dir.min"
|
||||
parse3.1
|
||||
input #1,i$:b=instr(";",i$):f1$=left$(i$,b-1)
|
||||
if i$="" close:goto
|
||||
if f1$=fn$:fd$=mid$(i$,b+1):close
|
||||
if (f1$=fn$) and
|
||||
if f1$=fn$:f$="i"+fd$+":ML.01":gosub wr.msg:return
|
||||
goto parse3.1
|
||||
|
||||
parse4
|
||||
close:open #1,"g:paths"
|
||||
parse4.1
|
||||
input #1,i$
|
||||
if i$="" close:goto
|
||||
a=instr(":",i$)
|
||||
i$=left$(i$,len(i$)-2)
|
||||
if left$(i$,a-1)=fn$:pp$=mid$(i$,a+2)+bg$+pt$
|
||||
if left$(i$,a-1)=fn$ close:goto
|
||||
goto parse4.1
|
||||
|
||||
domain
|
||||
a=instr(".",fn$):if a=0 close:r$="No path to site could be found":goto
|
||||
f1$=left$(fn$,a-1):f2$=mid$(fn$,a):b=1
|
||||
a=instr(bg$,pp$):f4$=mid$(pp$,a)
|
||||
close:open #1,"g:paths"
|
||||
dom1
|
||||
input #1,i$
|
||||
if i$="" close:goto
|
||||
a=instr(":",i$):f3$=left$(i$,a-1)
|
||||
if f2$=f3$:pp$=mid$(i$,a+2)+f4$
|
||||
if f2$=f3$:a=instr("*",pp$):pp$=left$(pp$,a-1)+f1$+mid$(pp$,a+1):close
|
||||
if f2$=f3$ gosub
|
||||
goto dom1
|
||||
dom2
|
||||
if not a:r$="Domain could not be parsed":goto
|
||||
f2$=mid$(f2$,2):a=instr(".",f2$):f1$=f1$+"."+left$(f2$,a-1):f2$=mid$(f2$,a)
|
||||
open #1,"g:paths":b=b+1:goto dom1
|
||||
|
||||
out
|
||||
a=instr("@",tr$):if a:pp$=mid$(tr$,a+1)+bg$+left$(tr$,a-1):return
|
||||
pp$=tr$:return
|
||||
|
||||
bounce
|
||||
tr$=fr$:a=instr(" ",tr$):tr$=left$(tr$,a-1)
|
||||
fr$=sn$+"!mailer "+date$+" "+time$:pp$=tr$
|
||||
sb$="Returned Mail"
|
||||
print #8,\"-----"
|
||||
print #8,\"The above message had this problem:"
|
||||
print #8,r$\
|
||||
print #8,\ " Please correct the problem and try resending it."
|
||||
print #8,\\"Sincerly,"
|
||||
print #8, " mailer@"sn$
|
||||
f$=e$
|
||||
print "Message:":copy #8
|
||||
close:ready e$:kill #msg(x):update:close
|
||||
close:ready f$:c=msg(0)+1:print #msg(c),fr$,tr$,sb$\dt$,pp$,ft$:copy
|
||||
return
|
||||
|
||||
local
|
||||
a=instr(bg$,pp$):if a:tl$=mid$(pp$,a+1)
|
||||
if not a:tl$=pp$
|
||||
a=instr("#",tl$):if a:b=val(mid$(tl$,2):goto feed
|
||||
; note!
|
||||
i$=tl$:gosub lcase:tl$=i$
|
||||
if tl$="root":du=1:goto local.1.1
|
||||
if tl$="mailer":du=1:goto local.1.1
|
||||
if tl$="sysop":du=1:goto local.1.1
|
||||
if tl$="amdss":du=1:goto local.1.1
|
||||
if tl$="postmaster":du=1:goto local.1.1
|
||||
a=instr("user",tl$):if a:du=val(mid$(tl$,a+4)):goto local.1.1
|
||||
ifleft$(tl$,1)="#":a=instr("#",tl$):if a:du=val(mid$(tl$,a+1)):gotolocal.1.1
|
||||
open #1,"b:users"
|
||||
z=1
|
||||
local.01
|
||||
position #1,128,z
|
||||
input #1,a$,b$\c$
|
||||
i$=c$:gosub lcase:c$=i$:print "c$="c$
|
||||
local.001
|
||||
a=instr(" ",c$):if a:c$=left$(c$,a-1)+"."+mid$(c$,a+1):goto local.001
|
||||
if a$+str$(z)=tl$:du=z:goto local.1.1
|
||||
if c$=tl$:du=z:goto local.1.1
|
||||
if z<nu:z=z+1:goto local.01
|
||||
close:goto alias
|
||||
local.1.1
|
||||
if du>nu:r$="local user account "+str(du)+" on "+sn$+" was invalid":goto bounce
|
||||
f$="g:mail."+str$(du)
|
||||
db$="":a=instr(" ",dt$):ti$=mid$(dt$,a+1):dt$=left$(dt$,a-1)
|
||||
close:open #1,f$:if mark(1)
|
||||
close:edit(0):gosub rd2.msg
|
||||
ready f$:c=msg(0)+1:print #msg(c),0,sb$,fr$\dt$,ti$,0,ft$:copy
|
||||
close:ready e$:kill #msg(x):update:close:return
|
||||
|
||||
wr.msg
|
||||
gosub rd2.msg
|
||||
; a=instr(bg$,fr$):if left$(fr$,a-1)<>sn$
|
||||
fr$=sn$+"!"+fr$
|
||||
close:open #1,f$:if mark(1)
|
||||
close:ready e$:kill #msg(x):crunch:update:close
|
||||
close:ready f$:c=msg(0)+1:print #msg(c),fr$,tr$,sb$\dt$,pp$,ft$:copy
|
||||
return
|
||||
|
||||
plinewr
|
||||
f$="i"+fd$+":m"+str$(x)+str$(random(9999))
|
||||
create f$:open #1,f$:append
|
||||
a=instr(" ",fr$):fr$=left$(fr$,(a-1)):fr$=sn$+"!"+fr$
|
||||
print #1,"From "fr$" "date$" "time$
|
||||
print #1,"Date: "dt$
|
||||
print #1,"Subject: "sb$
|
||||
print #1,"To: "tr$
|
||||
print #1,"Ppath: "pp$
|
||||
print #1,"From: "ft$\
|
||||
copy #8,#1:print #1\"* Sent from "sn$" at "time$" on "date$
|
||||
close:ready e$:kill #msg(x):update:close
|
||||
return
|
||||
|
||||
msg
|
||||
kill f$:create f$:open
|
||||
write #1,ed,2:fill ed,255,0:for
|
||||
close #1:return
|
||||
|
||||
rd.msg
|
||||
close:ready e$:input #msg(x),fr$,tr$,sb$\dt$,pp$,ft$:edit(0):copy
|
||||
return
|
||||
|
||||
rd2.msg
|
||||
close:ready e$:input #msg(x),i$,i$,i$\i$,i$,i$:edit(0):copy
|
||||
return
|
||||
|
||||
rdunix
|
||||
edit(0)
|
||||
f$="i:x"+mid$(e$,3):gosub msg
|
||||
close:open #1,e$:input #1,fr$
|
||||
fr$=mid$(fr$,6)
|
||||
rdunix2
|
||||
input#1,i$
|
||||
if left$(i$,4)="To: ":tr$=mid$(i$,5)
|
||||
if left$(i$,9)="Subject: ":sb$=mid$(i$,10)
|
||||
if left$(i$,6)="Date: ":dt$=mid$(i$,7)
|
||||
if left$(i$,7)="Ppath: ":pp$=mid$(i$,8)
|
||||
if left$(i$,6)="From: ":ft$=mid$(i$,7):
|
||||
if i$<>"" goto
|
||||
edit(0):copy #1,#8:close
|
||||
rdun2.1
|
||||
a=instr(",",dt$):if a:dt$=left$(dt$,a-1)+" "+mid$(dt$,a+1):goto rdun2.1
|
||||
ready f$:print #msg(1),fr$,tr$,sb$\dt$,pp$,ft$:copy
|
||||
kill e$
|
||||
return
|
||||
|
||||
multitr
|
||||
kill #msg(x)
|
||||
multi2
|
||||
a=instr(" ",tr$):if not a
|
||||
to$=left$(tr$,a-1):tr$=mid$(tr$,a+1)
|
||||
ready e$:print #msg(msg(0)+1),fr$,to$,sb$\dt$,pp$,ft$:copy
|
||||
update
|
||||
goto multi2
|
||||
|
||||
alias
|
||||
close:open #1,"g:aliases"
|
||||
al1
|
||||
input #1,i$
|
||||
if i$="" close:r$="Alias of "+tl$+" could not be parsed":goto
|
||||
if i$<>tl$ goto
|
||||
al10
|
||||
input #1,i$
|
||||
if left$(i$,1)<>" " ready
|
||||
pp$="out":tr$=mid$(i$,2)
|
||||
ready e$:print #msg(msg(0)+1),fr$,tr$,sb$\dt$,pp$:copy
|
||||
goto al10
|
||||
|
||||
feed
|
||||
; this code will post the message into the local message base # b
|
||||
; install at a later date.
|
||||
|
||||
outahere
|
||||
if e1$="AMDSS" or
|
||||
if e1$="pass":e1$="":link "a:system.seg"
|
||||
link "a:mail","net7"
|
||||
|
||||
fromamdss
|
||||
b=1:lg$="I:":gosub getfnum:e$=fx$:e$="i:"+e$
|
||||
if left$(fx$,3)=" " pop:goto
|
||||
return
|
||||
|
||||
lcase
|
||||
a$="":forl=1tolen(i$)
|
||||
y=asc(mid$(i$,l,1)):if (y>65) and
|
||||
a$=a$+chr$(y):next
|
||||
i$=a$
|
||||
return
|
||||
|
||||
getfnum
|
||||
fx$=" ":bt$=""
|
||||
use v1$+":xcat",b,lg$,fx$,bt$,bt$,bt$,bt$,bt$,bt$,bt$,bt$
|
||||
return
|
||||
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
CS-ID: #20237.apple/info-apple@pro-exchange, 1524 chars
|
||||
Date: Fri, 2 Mar 90 04:54:29 EST
|
||||
From: lbotez@pro-sol.cts.com (Lynda Botez)
|
||||
Subject: Re: MultiJuggle/ humm... how about multijuggle
|
||||
|
||||
In-Reply-To: message from cyliao@eng.umd.edu
|
||||
|
||||
CS-ID: #20237.apple/info-apple@pro-exchange 100 chars
|
||||
Date: Tue, 5 Jun 90 19:36:03 EDT
|
||||
From: sschneider (The RainForest BBS)
|
||||
Subject: Re: MultiJuggle/ humm... how about multijuggle
|
||||
Comment: to #20237 by lbotez@pro-sol.cts.com
|
||||
|
||||
In-Reply-To: message from lbotez@pro-sol.cts.com
|
||||
|
||||
CS-ID: #20238.apple/info-apple@pro-exchange, 1722 chars
|
||||
Date: Fri, 2 Mar 90 04:54:30 EST
|
||||
From: lbotez@pro-sol.cts.com (Lynda Botez)
|
||||
Subject: Re: Rom 04 comment
|
||||
|
||||
In-Reply-To: message from toddpw@tybalt.caltech.edu
|
||||
|
||||
CS-ID: #20536.apple/info-apple@pro-exchange, 1818 chars
|
||||
Date: Wed, 14 Mar 90 07:30:45 EST
|
||||
From: Tabakal@UB.CC.UMICH.EDU
|
||||
Subject: (none)
|
||||
|
||||
CS-ID: #20536.apple/info-apple@pro-exchange, 1818 chars
|
||||
Date: Wed, 14 Mar 90 07:30:45 EST
|
||||
From: Tabakal@UB.CC.UMICH.EDU
|
||||
Subject: (none)
|
||||
|
||||
CS-ID: #213.net.news/usenet@pro-exchange 398 chars
|
||||
Date: Fri, 30 Jun 89 09:16:09 EDT
|
||||
From: nelson@sun.soe.clarkson.edu (Russ Nelson)
|
||||
Subject: The cct.* newsgroups
|
||||
|
||||
If you read any of the cct.* newsgroups, you must reset your .newsrc in order
|
||||
to see the new articles. To do this, edit your .newsrc file, and remove the
|
||||
numbers to the right of the cct.* newsgroups. If you don't know how to do
|
||||
this, send me mail and I'll write an awk script to do it...
|
||||
--
|
||||
--russ (nelson@clutx [.bitnet | .clarkson.edu])
|
||||
Democracy needs capitalism like a fish needs a bicycle.
|
||||
|
||||
cs>read> Next
|
||||
|
||||
CS-ID: #226.net.news/usenet@pro-exchange 3958 chars
|
||||
Date: Thu, 17 Aug 89 05:20:09 EDT
|
||||
From: woods@ncar.ucar.edu (Greg Woods)
|
||||
Subject: Charter change
|
||||
|
||||
CS-ID: #240.net.news/usenet@pro-exchange 1185 chars
|
||||
Date: Tue, 10 Oct 89 09:19:03 EDT
|
||||
From: mark@Stargate.COM (Mark Horton)
|
||||
Subject: Computer Viruses set to go off on October 12 and 13.
|
||||
|
||||
CS-ID: #272.net.news/usenet@pro-exchange, 1289 chars
|
||||
Date: Sat, 13 Jan 90 07:26:55 EST
|
||||
From: chuq@Apple.COM (Chuq Von Rospach)
|
||||
Subject: FCC 'chain letter' -- please stop
|
||||
|
||||
CS-ID: #4680.net.news/telecomm@pro-exchange, 863 chars
|
||||
Date: Fri, 16 Mar 90 04:35:07 EST
|
||||
From: hkhenson@cup.portal.com
|
||||
Subject: Cuban/USA Politics and the Cable
|
||||
|
||||
CS-ID: #4879.net.news/telecomm@pro-exchange, 1047 chars
|
||||
Date: Sat, 24 Mar 90 04:21:37 EST
|
||||
From: uflorida!novavax!whitep@gatech.edu (Patricia R. White)
|
||||
Subject: Re: Billing and Answer Supervision
|
||||
Binary file not shown.
|
|
@ -0,0 +1,53 @@
|
|||
;-----------------------------------------------------------------------
|
||||
;SuperTac 5.0e - January, 1988
|
||||
;Written by Larry Hawkins
|
||||
;Copyright (c), 1987-1988 - L & L Productions
|
||||
;Auto Directory Segment
|
||||
;-----------------------------------------------------------------------
|
||||
|
||||
scan
|
||||
lo=1:hi=50
|
||||
ed=edit:v1$="l":v2$="j"
|
||||
push link.sys
|
||||
print "\nAuto-Directory 5.0"
|
||||
print "Thrashing Hard Drive..."
|
||||
i$=v1$+":directory"
|
||||
gosub message:ready i$:x=lo:gosub
|
||||
print "\nScanning Volume [";
|
||||
dir10
|
||||
in$=right$("0"+str$(x),2)
|
||||
print in$"]";
|
||||
x$=v1$+str$(x)+":":if (fv>0) &
|
||||
overlay "xcat",0,x$,fn$,ta$,th$,bu$,mo$,mt$,xd$,xt$,by$
|
||||
clear #8
|
||||
print #msg(x),date$" "time$
|
||||
dir2
|
||||
if fn$=" " copy
|
||||
si=peek(ed+22)+(peek(ed+23)<<8)
|
||||
print #6,fn$" "ta$" "bu$" "right$(" "+str$(si),5)" "xd$
|
||||
call ed+3,0,fn$,ta$,th$,bu$,mo$,mt$,xd$,xt$,by$
|
||||
goto dir2
|
||||
|
||||
nxtvol
|
||||
x=x+1:if (x>hi) close:update:print
|
||||
print "\b\b\b";:goto dir10
|
||||
|
||||
link.sys
|
||||
chain "program/logon.seg"
|
||||
|
||||
message
|
||||
ready " ":close:kill i$:create
|
||||
fill ed,255,0:poke ed,16:poke
|
||||
write #1,ed,2:fill ed,255,0:for
|
||||
write #1,ed,22:close
|
||||
return
|
||||
|
||||
makestr
|
||||
fn$=" ":ta$=" ":th$=" ":bu$=" "
|
||||
mo$=" ":mt$=" "
|
||||
xd$=" ":xt$=" "
|
||||
by$=" ":a=0
|
||||
return
|
||||
|
||||
;Janurary, 1988
|
||||
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
; **********************
|
||||
; GBBS "Pro" V:1.3
|
||||
; By L & L Productions
|
||||
; Copyright 1987
|
||||
; **********************
|
||||
|
||||
; BBS Update Seg 8/16/87
|
||||
|
||||
on nocar goto link.term
|
||||
|
||||
start
|
||||
print '
|
||||
Please take a few minutes and help
|
||||
us update the GBBS Pro BBS List
|
||||
by entering your boards information'
|
||||
|
||||
list
|
||||
input @3 "\nSystem Name: "z1$
|
||||
phone
|
||||
input @3 "Phone Number [Form ###-###-####]: "i$
|
||||
if len(i$)!=12 goto phone
|
||||
z2$=left$(i$,3)+"-"+mid$(i$,5,3)+"-"+right$(i$,4)
|
||||
|
||||
input @3 "Highest Baud: "z3$
|
||||
input @2 "Are you PCP'able (Y/N):"z4$
|
||||
z4$=left$(z4$,1)
|
||||
input "Your GBBS serial number:"z5$
|
||||
input @2 "Do you want the system listed (Y/N):"z6$
|
||||
z6$=left$(z6$,1)
|
||||
|
||||
print "\nWe have the following:"
|
||||
print "\nSystem Name: "z1$
|
||||
print "Phone Number: "z2$
|
||||
print "Baud Rate: "z3$
|
||||
print "PC Pursuitable: "z4$
|
||||
print "GBBS Serial Number: "z5$
|
||||
print "System list: "z6$
|
||||
|
||||
input @2 "\nIs this correct? "i$
|
||||
if i$<>"Y" print:goto list
|
||||
|
||||
print "\nThank you for taking the time to"
|
||||
print "answer these questions. Just a"
|
||||
print "moment while I save them."
|
||||
|
||||
create "system/gbbs.list":open #1,"system/gbbs.list"
|
||||
append #1:print #1,a3$"\n"z1$"\n"z2$"\n"z3$"\n"z4$"\n"z5$"\n"z6$
|
||||
close:flag(30)=1:chain "program/main.seg"
|
||||
|
||||
link.term
|
||||
chain "program/main.seg","termin2"
|
||||
|
|
@ -0,0 +1,169 @@
|
|||
; ********************
|
||||
; GBBS Pro v1.3
|
||||
; By L&L Productions
|
||||
; (C)opyright 1987
|
||||
; ********************
|
||||
|
||||
; Bulletin Copy Utility
|
||||
; By GS @ 04/30/85
|
||||
; Modified by Lance @ 4/20/87
|
||||
|
||||
public start
|
||||
|
||||
input "press [ret] to continue..."i$
|
||||
|
||||
flag=ram
|
||||
s1$="<\b":s2$=">\b"
|
||||
s3$="{\b":s4$="}\b"
|
||||
|
||||
start
|
||||
home
|
||||
print "Bulletin Copy Utility v1.3"
|
||||
print "\nWritten by Greg Schaefer"
|
||||
print "Modified for v1.3 by Lance"
|
||||
input "\nSource Bulletin File (ex: bulletins/B1):"f1$
|
||||
if ~exist(f1$) print
|
||||
ready f1$:print "\b";:sz=(peek(36)=79)
|
||||
fill ram,64,0:if msg(0)
|
||||
print "\nThat message file is empty."
|
||||
gosub getret:goto start
|
||||
|
||||
status
|
||||
home:z=1:b=(msg(0)/20)*5+1
|
||||
for x=1 to
|
||||
a=20:if x=b:a=msg(0) mod
|
||||
for y=5 to
|
||||
print @x,y;z;a$;:z=z+1:next:next
|
||||
|
||||
cmd
|
||||
print @1,1 "R=Restart, Q=Quit, V=View, C=Copy"
|
||||
print "K=Kill, T=Tag, U=Untag, W=Write"
|
||||
print "Enter Cmd: "chr$(0x20,28);chr$(8,28);
|
||||
get i$:if i$>"a":i$=chr$(asc(i$)-32)
|
||||
print "\b"i$;:z=1
|
||||
if i$="Q" goto
|
||||
if i$="V" goto
|
||||
if i$="C" goto
|
||||
if i$="K" goto
|
||||
if i$="T" goto
|
||||
if i$="U" goto
|
||||
if i$="R" goto
|
||||
if i$="W" goto
|
||||
goto cmd
|
||||
|
||||
quit
|
||||
input @0 "uit Y/N ?"i$:if
|
||||
home:goto doquit
|
||||
|
||||
restart
|
||||
input @0 "estart Y/N ?"i$:if
|
||||
home:goto start
|
||||
|
||||
tag
|
||||
input @2 "ag (#[,#] or ALL):"i$
|
||||
if i$="" goto
|
||||
if left$(i$,1)="A" fill
|
||||
tag2
|
||||
a=val(i$):if ~((a=0) |
|
||||
a=instr(",",i$):if a:i$=mid$(i$,a+1):goto tag2
|
||||
goto status
|
||||
|
||||
untag
|
||||
input @2 "ntag (#[,#] or ALL):"i$
|
||||
if i$="" goto
|
||||
if left$(i$,1)="A" fill
|
||||
untag2
|
||||
a=val(i$):if ~((a=0) |
|
||||
a=instr(",",i$):if a:i$=mid$(i$,a+1):goto untag2
|
||||
goto status
|
||||
|
||||
view
|
||||
input @2 "iew (ALL,TAG,#[,#]):"i$
|
||||
gosub inprng:if i$=""
|
||||
home:print "Viewing Bulletin(s):"
|
||||
view2
|
||||
d=0:gosub show:if a
|
||||
gosub getret:goto status
|
||||
|
||||
write
|
||||
input @2 "rite (ALL,TAG,#[,#]):"i$
|
||||
gosub inprng:if i$=""
|
||||
write2
|
||||
home:print "Write these bulletins:\n"
|
||||
gosub list:input @2
|
||||
if f$="" goto
|
||||
create f$:open #1,f$:append
|
||||
print "\nWait...Writing bulletin(s)"
|
||||
write3
|
||||
d=1:gosub show:if a
|
||||
close:goto status
|
||||
|
||||
kill
|
||||
input @2 "ill (ALL,TAG,#[,#]):"i$
|
||||
gosub inprng:if i$=""
|
||||
home:print "Kill these bulletins:\n":gosub list
|
||||
input @0 "\nKill: Are you sure Y/N ?"i$
|
||||
if i$<>"Y" goto
|
||||
print "Wait...Killing bulletin(s)"
|
||||
b=msg(msg(0)):for x=1 to
|
||||
if flag(x+512) kill
|
||||
next:crunch:a=msg(0):if a:msg(a)=b
|
||||
update:if a goto
|
||||
home:print "\nAll bulletins killed."
|
||||
gosub getret:goto start
|
||||
|
||||
copy
|
||||
input @2 "opy (ALL,TAG,#[,#]):"i$
|
||||
gosub inprng:if i$=""
|
||||
home:print "Copy these bulletins:\n":gosub list
|
||||
input @0 "\nCopy: Are you sure Y/N ?"i$
|
||||
if i$<>"Y" goto
|
||||
copy2
|
||||
print "\nEnter destination bulletin file"
|
||||
input @2 "\nDestin Bulletin File (ex: bulletins/B2):"f$
|
||||
if f$="" goto
|
||||
open #1,f$:a=mark(1):close:b=msg(0)
|
||||
if a print
|
||||
print "\nWait...Copying bulletin(s): ";
|
||||
open #1,"b:data":input #1,c1,c2,ct,ct$,da$
|
||||
input #1,nu,mn,wm|lu$:close:ready f$
|
||||
|
||||
for x=1 to
|
||||
print s1$;:kill "dummy":create
|
||||
print s2$;:ready f1$:copy
|
||||
print s3$;:b=msg(0)+1:copy "dummy",#msg(b):msg(b)=mn
|
||||
update:mn=mn+1:print s4$;
|
||||
copy3
|
||||
next:open #1,"b:data":print #1,c1,c2,ct,ct$,da$
|
||||
print #1,nu,mn,wm"\n"lu$:close:ready f1$:goto
|
||||
|
||||
inprng
|
||||
if left$(i$,1)="T" move
|
||||
if left$(i$,1)="A" fill
|
||||
fill ram2,64,0
|
||||
inprng2
|
||||
a=val(i$):if (a=0) |
|
||||
flag(a+512)=1:a=instr(",",i$):if ~a return
|
||||
i$=mid$(i$,a+1):goto inprng2
|
||||
|
||||
list
|
||||
a$="":for x=1 to
|
||||
if flag(x+512) print
|
||||
next:if peek(36)>0 print
|
||||
return
|
||||
|
||||
show
|
||||
if z>msg(0):a=0:return
|
||||
if flag(z+512)=0:z++:goto show
|
||||
input #msg(z),sb$|b,b$|c,c$
|
||||
print #d,"\nNumb ->"z" of "msg(0)"\n Sub ->"sb$
|
||||
print #d, " To ->"b$"\nFrom ->"c$
|
||||
copy #6,#d:a=1:z++:return
|
||||
|
||||
getret
|
||||
input @2 "\nPress [RETURN] to continue... "i$
|
||||
return
|
||||
|
||||
doquit
|
||||
end
|
||||
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
|
||||
dra$="/Q3/LLUCE/program"
|
||||
drb$="/Q3/LLUCE/SYSTEMS"
|
||||
drc$="/Q3/LLUCE"
|
||||
drd$="/Q3/LLUCE/ANSI"
|
||||
drg$="/Q3/LLUCE/MAIL"
|
||||
drh$="/RAM5"
|
||||
|
||||
; main segment rev j - 7/21/87
|
||||
|
||||
public fromsys
|
||||
public return
|
||||
public term1
|
||||
public termin2
|
||||
public autoread
|
||||
on nocar goto
|
||||
|
||||
|
||||
un=1:flag(1)=1:flag(34)=1
|
||||
|
||||
print sc$\\
|
||||
if flag(0) goto
|
||||
ready drg$+"/mail"
|
||||
if not msg(un)
|
||||
print" You have mail waiting. Read it now ([Y]/n) ? ";:gosub getkey
|
||||
if (i$<>"N") print
|
||||
autoread
|
||||
x=(clock-clock online)/60:y=clock:x$=right$("0"+str$(x),2)
|
||||
if x=0 x$="--"
|
||||
if not y
|
||||
if exec x$="::"
|
||||
if yl print
|
||||
gosub getkey
|
||||
if i$<>"N"print "New Messages":bb=1:push
|
||||
print "No, thank you."
|
||||
goto main
|
||||
fromsys
|
||||
on nocar goto
|
||||
print sc$\\
|
||||
main
|
||||
on nocar goto
|
||||
x=(clock-clock online)/60:x$=right$(" "+str$(x),3)
|
||||
if x=0 x$="---"
|
||||
if exec x$=":::"
|
||||
i$="":print\\"["x$" min] [ MAIN LEVEL ] (/=Menu) Option: ";:push main
|
||||
if exec gf$="B?CQDFTGYENHIPUMLX/S(+A*":goto
|
||||
if flag(1) gf$="B?CQDFTGYENHIPUMLX/S(A*":goto
|
||||
gf$="B?CQDFTGYNHIPUMLS/":goto get.key
|
||||
getkey
|
||||
y=0
|
||||
get.2
|
||||
z=peek(-16287)
|
||||
if (z=129) or
|
||||
z=key
|
||||
if (z=>asc("a")) z=z-32
|
||||
if z<>0 i$=chr$(z):return
|
||||
y=y+1
|
||||
if y=4000 print
|
||||
if y=7000 for
|
||||
if y=10000 print
|
||||
goto get.2
|
||||
get.key
|
||||
gosub getkey
|
||||
a=instr(i$,gf$):if a goto
|
||||
goto get.key
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,649 @@
|
|||
; *********************
|
||||
; LLUCE v1.0
|
||||
; Copyright 1991
|
||||
; L&L Productions, Inc.
|
||||
; *********************
|
||||
|
||||
; msg segment rev a - 4/5/91
|
||||
|
||||
public quickscan
|
||||
public conference
|
||||
public return
|
||||
|
||||
conference
|
||||
on nocar goto link.term
|
||||
; on error goto error
|
||||
of=flag:ob=byte /* save old locations of flag and byte */
|
||||
set aa$=ram(1),30:set ab$=ram(1)+31,30
|
||||
set ac$=ram(1)+61,20:byte=ram(1)+81
|
||||
flag=ram(2) /* allocate 4092 flags for user status (Overlaps into ram(3) */
|
||||
; edit on /* Turn on Profanity Filter */
|
||||
prefix:prefix "conferences/":rp$=prefix
|
||||
f$="conf.0":if exist(f$) goto conf1
|
||||
nc=0:f$="conf.0":create f$:open #1,f$
|
||||
print #1,nc /* Set #number of conferences to zero */
|
||||
conf.init
|
||||
close #1:gosub add.conf:if nc=0 goto link.main
|
||||
conf1
|
||||
open #1,"conf.0"
|
||||
input #1,nc:if nc=0 goto conf.init
|
||||
x=cn:gosub rd.head:close #1
|
||||
cc$=aa$:cs$=ab$:si$=ac$:gosub start
|
||||
|
||||
link.main /* reset prefix and return */
|
||||
prefix:chain "program/main.seg","otherseg"
|
||||
|
||||
terminate
|
||||
print "\nTerminate Connection"
|
||||
input @2 "\nAre you sure? ([Y]/N):"i$
|
||||
if left$(i$,1)="N" return
|
||||
link.term /* reset prefix and return */
|
||||
prefix:chain "program/main.seg","term1"
|
||||
|
||||
; Ready message file and check status
|
||||
|
||||
start
|
||||
gosub time:print "\nCurrent Conference:"cc$
|
||||
print "[("x$")] Conference Level [?=Menu] Function :";
|
||||
start1
|
||||
get i$
|
||||
start2
|
||||
push start
|
||||
if i$="?" | i$="/" print "Menu":goto start4
|
||||
if i$="L" print "List Conferences Available":goto list.conf
|
||||
if i$="J" print "Jump to a Conference":goto join.conf
|
||||
if i$="D" print "Drop Conference":goto quit.conf
|
||||
if i$="Q" print "Quit to Mail Level":pop:goto link.main
|
||||
if i$="T" print "Terminate Connection":goto terminate
|
||||
if i$="C" print "Check for New Messages":goto scan.conf
|
||||
if i$="M" print "Mail to Conference Sysop":goto mail.sysop
|
||||
if i$="X" print "Conference Transfer System":goto exfer.start
|
||||
|
||||
if ~exec goto start3 /* They are not the sysop so ignore the following */
|
||||
if i$="A" print "Add a Conference":goto add.conf
|
||||
if i$="K" print "Kill a Conference":goto kill.conf
|
||||
if i$="E" print "Edit a Conference":goto edit.conf
|
||||
if i$="M" print "Reorder Conferences":goto move.conf
|
||||
|
||||
start3
|
||||
if val(i$)<33 pop:goto start1 /* mask out possible control characters */
|
||||
a1++:print "\n\""i$"\" is not a command":if a1<3 return
|
||||
start4
|
||||
a1=0:print '\n Valid commands:
|
||||
C - Check for New Messages D - Drop Conference
|
||||
J - Jump to a Conference L - List Conferences Available
|
||||
Q - Quit to Main Level M - Send Mail to Conference Sysop
|
||||
T - Terminate Connection ? - This Menu';
|
||||
if exec print '
|
||||
-------------------------------------------------------------
|
||||
A - Add a Conference E - Edit a Conference
|
||||
K - Kill a Conference M - Reorder Conferences';
|
||||
print "\n":return
|
||||
|
||||
|
||||
mail.sysop
|
||||
quit.conf
|
||||
pick.conf
|
||||
scan.conf
|
||||
kill.conf
|
||||
edit.conf
|
||||
move.conf
|
||||
print "\nCommand structure works"
|
||||
return
|
||||
|
||||
exfer.start
|
||||
print "\nEntering Exfer...to be completed!!"
|
||||
return
|
||||
|
||||
add.conf
|
||||
print "\nWould you like to add a conference to the system? ([Y]/N):";
|
||||
get i$:if i$="N":print:return
|
||||
add1
|
||||
input @3 "\nConference Title: "ct$
|
||||
input @3 "Conference Sysop: "cs$
|
||||
input @3 "Sysop Mail ID : "sid$
|
||||
input "Access Flag : "aa:byte(1)=aa
|
||||
input "Read Flag : "aa:byte(2)=aa
|
||||
input "Write Flag : "aa:byte(3)=aa
|
||||
print "\nThis is what we have:\n"
|
||||
print "Conference Title: "ct$
|
||||
print "Conference Sysop: "cs$
|
||||
print "Sysop Mail ID : "sid$
|
||||
print "Access Flag : "byte(1)
|
||||
print "Read Flag : "byte(2)
|
||||
print "Write Flag : "byte(3)
|
||||
input "\nIs this correct? ([Y]/N):"i$
|
||||
if i$="N" goto add.conf
|
||||
|
||||
open #1,f$:input #1,nc
|
||||
nc++:position #1,96,nc
|
||||
fill ram(1),128,0
|
||||
aa$=ct$+chr$(0x20,(30-len(ct$)))
|
||||
ab$=cs$+chr$(0x20,(30-len(cs$)))
|
||||
ac$=sid$+chr$(0x20,(30-len(sid$)))
|
||||
x=nc:gosub wr.head
|
||||
mark(1)=0:print #1,nc:close
|
||||
return
|
||||
|
||||
join.conf
|
||||
print "\nWhich Conference do you wish to Jump to? (1-"nc;
|
||||
input ", L)ist, Q)uit):"i$
|
||||
if i$="L":f$="conf.0":ti$="Conference":gosub list.conf:goto join.conf
|
||||
if ~val(i$) return /* they must want to quit */
|
||||
if val(i$)>nc goto join.conf /* Value out of range */
|
||||
open #1,"conf.0":x=val(i$):gosub rd.head:close #1
|
||||
goto start.cat
|
||||
|
||||
list.conf
|
||||
flag=ram(0)+22:open #1,f$
|
||||
x$=ti$+" Name"+chr$(0x20,(32-len(ti$)))+ti$+" Sysop"+chr$(0x20,(21-len(ti$)))
|
||||
x$=x$+"Sysop ID"
|
||||
print x$"\n"chr$(0x2D,79)
|
||||
for x=1 to nc
|
||||
gosub rd.head
|
||||
if flag(aa) print aa$;chr$(0x20,(37-len(aa$)));ab$;chr$(0x20,(27-len(ab$)));ac$
|
||||
next x
|
||||
flag=ram(2):return
|
||||
|
||||
start.cat
|
||||
get i$
|
||||
return
|
||||
|
||||
ld.flags
|
||||
open #1,f$
|
||||
read #1,ram(2),512
|
||||
close #1:return
|
||||
|
||||
wr.flags
|
||||
open #1,f$
|
||||
write #1,ram(2),512
|
||||
close #1:return
|
||||
|
||||
quickscan
|
||||
print "\nThis is the quickscan routine!!"
|
||||
return
|
||||
|
||||
gosub idinf
|
||||
if bf$="" print "\nThat board is not active.":return
|
||||
if ~b1 print "\nYou do not have access to that board.":return
|
||||
if i$="Q" gosub qscan
|
||||
cmd1
|
||||
if msg(0) goto cmd2
|
||||
print "\nThe "bn$" has no messages..."
|
||||
input @2 "\nPost a message? ([Y]/N):"i$
|
||||
if left$(i$,1)="N" return
|
||||
sb$="":ti$="":gosub post:if ~b2 return
|
||||
goto cmd1
|
||||
|
||||
cmd2
|
||||
gosub time:print "\n"bn$" - #"bb
|
||||
print "["x$"]["inverse$"Board Level"normal$"][1-"msg(0)"] ";
|
||||
input "Option (?=Help):"i$
|
||||
cmd2a
|
||||
a=val(i$):push cmd2
|
||||
if left$(i$,1)="J":i$=mid$(i$,2):goto jmp3
|
||||
if left$(i$,1)="F" goto fwd
|
||||
if left$(i$,1)="R" goto rvs
|
||||
if left$(i$,1)="K" goto kill
|
||||
if left$(i$,1)="S" goto scan
|
||||
if i$="A" | i$="Q" pop:return
|
||||
if i$="M" goto mark
|
||||
if i$="N" goto new
|
||||
if i$="B" goto browse
|
||||
if i$="G" goto qscan
|
||||
if i$="H":f$="b:hlp.msg":goto show.file
|
||||
if i$="J" goto jump
|
||||
if i$="P":ti$="All":sb$="":d=0:goto post
|
||||
if i$="L":y=0:goto list
|
||||
if i$="T" goto terminate
|
||||
if i$=">" & (bb<ab):bb++:pop:goto start
|
||||
if i$="<" & (bb>1):bb--:pop:goto start
|
||||
if (a>0) & (a<=msg(0)):i$="F"+i$:goto fwd
|
||||
if i$="?" | i$="/" goto cmd.menu
|
||||
a1++:print "\nSorry, \""i$"\" is not a command. (?=Help)":if a1<3 return
|
||||
|
||||
cmd.menu
|
||||
a1=0:print "\n"bn$'\n
|
||||
Read #, OR: [N]ew [F#]orward [S#]can [B]rowse [M]arked [L]ist
|
||||
[R#]vse [G]lobal [J#]ump [P]ost [K#]ill [H]elp
|
||||
[Q]uit [>] Next board [<] Previous board\n':return
|
||||
|
||||
; terminate connection
|
||||
|
||||
terminate
|
||||
print "\nTerminate Connection"
|
||||
input @2 "\nAre you sure? ([Y]/N):"i$
|
||||
if left$(i$,1)="N" return
|
||||
prefix:chain "program/main.seg","term1"
|
||||
|
||||
; post a bulletin
|
||||
|
||||
post
|
||||
if ~b2 print "\nYou do not have access to that board.":return
|
||||
edit clear:if msg(0)=mb+128 print "\nSorry, no room on this board.":return
|
||||
if msg(0)=msg size print "\nBoard directory full.":return
|
||||
if msg free<29 print "\nBoard bit-map full.":return
|
||||
post2
|
||||
print "\nPost Bulletin\n"
|
||||
if d open #1,"b:sys.users":position #1,128,d:input #1,d1$,d2$|d3$:close
|
||||
if d ti$=d3$+" (#"+str$(d)+")":if d=1 ti$="Sysop"
|
||||
if ti$<>"" print " To ->"ti$" ([Y]/N):";:get i$
|
||||
if i$="\n":n=9:gosub backup:print:goto post2a
|
||||
if i$="N":n=len(ti$)+10:gosub backup:input @4 ti$:if ti$="" return
|
||||
if (ti$<>"") & left$(i$,1)<>"N":n=10:gosub backup:print
|
||||
if ti$="" input @4 " To ->"ti$:if ti$="" return
|
||||
post2a
|
||||
i$="":if sb$<>"" print " Sub ->"sb$" ([Y]/N):";:get i$
|
||||
if i$="\n"n=9:gosub backup:print:goto post2b
|
||||
if i$="N":n=len(sb$)+10:gosub backup:input @4 a$:if a$="" return
|
||||
if (sb$<>"" | a$<>"") & left$(i$,1)<>"N":n=10:gosub backup:print
|
||||
if sb$="" input @4 " Sub ->"a$:if a$="" return
|
||||
if a$<>"":sb$=a$
|
||||
post2b
|
||||
a$=a3$:if (un=bs) & (bs$<>""):a$=bs$
|
||||
a$=a$+" (#"+str$(un)+")"
|
||||
if ~exec goto post2c
|
||||
i$="":print "From ->"a$" ([Y]/N):";:get i$
|
||||
if i$="\n"n=9:gosub backup:print:goto post2c
|
||||
if i$="N":n=len(a$)+10:gosub backup:input @3 a$:if a$="" return
|
||||
if (a$<>"") & left$(i$,1)<>"N":n=10:gosub backup:print
|
||||
post2c
|
||||
i$="":if flag(36) print "\nAnonymous Posting (Y/[N]):";:get i$:print
|
||||
if (flag(36)) & (i$="Y"):flag(37)=1:else flag(37)=0
|
||||
input @2 "\nPost: [Y]es, N)o, P)rotocol Upload? "i$
|
||||
if i$="N" return
|
||||
if i$="P" gosub ptcl.up:else gosub editor
|
||||
if ~edit size return
|
||||
print "\n"edit size" bytes entered"
|
||||
print "Saving Message...wait..";:bp++:disk lock:a=msg(0)+1
|
||||
if flag(37) print #msg(a),"*"sb$:else print #msg(a),sb$
|
||||
print #6,tn,ti$
|
||||
if flag(37) print #6,0,a$:else print #6,un,a$
|
||||
if flag(37) print #6," Date: "date$"\n"
|
||||
if ~flag(37) print #6," Date: "date$" at "time$"\n"
|
||||
copy #8,#6:msg(a)=mn:mn++:update:tm++
|
||||
print ".saved":ti$="":a$="":disk unlock:return
|
||||
|
||||
; show new messages
|
||||
|
||||
new
|
||||
print "\nNew messages"
|
||||
if nn>msg(msg(0)) print "\nSorry, no new messages.":return
|
||||
x=msg(0):if ~lr:a=1:goto fwd2
|
||||
new1
|
||||
if nn=<msg(x):a=x:x--:if x goto new1
|
||||
goto fwd2
|
||||
|
||||
; message retrieval - Forward
|
||||
|
||||
fwd
|
||||
if len(i$)>1:a=val(mid$(i$,2)):goto fwd1
|
||||
print "\nMessage Retrieval - Forward"
|
||||
input @2 "\nStart where (#, F)irst, <CR>):"i$
|
||||
a=val(i$):if i$="F":a=1
|
||||
fwd1
|
||||
if a=0 return
|
||||
if a>msg(0):a=msg(0)
|
||||
fwd2
|
||||
print "\n"s$"\n"n$
|
||||
fwd3
|
||||
gosub show:if x return
|
||||
if a<msg(0):a++:goto fwd3
|
||||
return
|
||||
|
||||
; message retrieval - Reverse
|
||||
|
||||
rvs
|
||||
if len(i$)>1:a=val(mid$(i$,2)):goto rvs1
|
||||
print "\nMessage Retrieval - Reverse"
|
||||
input @2 "\nStart where (#, L)ast, <CR>):"i$
|
||||
a=val(i$):if i$="L":a=msg(0)
|
||||
rvs1
|
||||
if a=0 return
|
||||
if a>msg(0):a=msg(0)
|
||||
rvs2
|
||||
print "\n"s$"\n"n$
|
||||
rvs3
|
||||
gosub show:if x return
|
||||
if a>1:a--:goto rvs3
|
||||
return
|
||||
|
||||
; kill messages
|
||||
|
||||
kill
|
||||
if len(i$)>1:a=val(mid$(i$,2)):goto kill.1
|
||||
print "\nKill a message"
|
||||
input @2 "\nKill message (#,<CR>):"a
|
||||
kill.1
|
||||
if (a=0) | (un=0) return
|
||||
if a>msg(0) print "\nThat message is out of range.":return
|
||||
input #msg(a),a$|x,b$|x,c$
|
||||
if exec | (un=bs) goto kill.2
|
||||
if x!=un print "\nThats not your message!":return
|
||||
kill.2
|
||||
if flag(37) & (left$(a$,1)="*"):a$=mid$(a$,2)
|
||||
print "\n Number :"a" of "msg(0)"\nSubject :"a$
|
||||
input @2 "\nKill this message? (Y/[N]):"i$
|
||||
if left$(i$,1)!="Y" return
|
||||
kill.3
|
||||
disk lock:tm--:y=msg(msg(0)):delete #msg(a):crunch
|
||||
b=msg(0):if b:msg(b)=y:update
|
||||
print "\nBulletin #"a" killed..."
|
||||
disk unlock:return
|
||||
|
||||
; browse message titles
|
||||
|
||||
browse
|
||||
m$="":a=0:print "\nBrowse message titles"
|
||||
print "\nScan for what text? [<CR>=All]"
|
||||
input @3 ":"m$:a=1:if m$="":a=0:return
|
||||
goto scan.2
|
||||
|
||||
; scan messages
|
||||
|
||||
scan
|
||||
print "\nScan messages"
|
||||
if len(i$)>1:a=val(mid$(i$,2):goto scan.1
|
||||
input @3 "\nStart at (#,<CR>):"a
|
||||
scan.1
|
||||
m$="":if a=0 return
|
||||
if a>msg(0) print "\nThat message is out of range.":return
|
||||
scan.2
|
||||
input @2 "\nAllow message marking? (Y/[N]):"i$
|
||||
ms=0:if left$(i$,1)="Y":ms=a
|
||||
d=0:x=15:print:z=flag:flag=ram2
|
||||
scan.3
|
||||
a$=" ":if msg(a)>nn:a$="*"
|
||||
flag(a-ms)=0:input #msg(a),t$
|
||||
if m$ if ~instr(m$,t$) goto scan.4
|
||||
if left$(t$,1)="*":t$=mid$(t$,2)
|
||||
x--:d++:print a$a". "t$"\n"
|
||||
if i$<>"Y" goto scan.4
|
||||
print "Mark message? (Y/[N]/Q):";:get a$:print
|
||||
if a$="Q" goto scan.5
|
||||
flag(a-ms)=(a$="Y")
|
||||
scan.4
|
||||
if a=msg(0) goto scan.5
|
||||
a=a+1:if x goto scan.3
|
||||
input @2 "\nMore messages? ([Y]/N/C):"a$
|
||||
if left$(a$,1)="C":x=msg(0)-a-1:goto scan.3
|
||||
if left$(a$,1)!="N" print:x=15:goto scan.3
|
||||
scan.5
|
||||
me=a:flag=z:if ~d print "Sorry, no match":ms=0:return
|
||||
if left$(i$,1)!="Y" return
|
||||
|
||||
; marked message retrieval
|
||||
|
||||
mark
|
||||
print "\nRetrieve marked messages":a=ms
|
||||
if ~ms print "\nSorry, no marked messages.":return
|
||||
mark.2
|
||||
z=flag:flag=ram2:b=flag(a-ms):flag=z
|
||||
x=0:if b gosub show
|
||||
if x=0:a++:if a<me goto mark.2
|
||||
return
|
||||
|
||||
; jump to another board.
|
||||
|
||||
jump
|
||||
print "\nJump to another board"
|
||||
jmp2
|
||||
print "\nJump to (1-"ab",?,<CR>):";
|
||||
input @2 i$:if i$="" return
|
||||
jmp3
|
||||
a=val(i$)
|
||||
if (a>0) & (a<=ab) pop:bb=a:goto start
|
||||
if i$<>"?" goto jmp2
|
||||
y=1
|
||||
|
||||
; list of available boards.
|
||||
|
||||
list
|
||||
print cls"\n"s$"\n":open #1,"b:sys.data2"
|
||||
for x=1 to ab:position #1,128,x+8
|
||||
input #1,a$|b$|a:setint(1)
|
||||
if instr(left$(a$,1),"^#$%"):a$=mid$(a$,2)
|
||||
b=1:if a:b=flag(a)
|
||||
if b & (b$<>"") print right$("00"+str$(x),3)". "a$
|
||||
if key end setint(""):x=ab
|
||||
next:close:if y goto jmp2
|
||||
return
|
||||
|
||||
; global quickscan
|
||||
|
||||
qscan
|
||||
ob=bb:bb=1
|
||||
print "\nGlobal Quickscan...Spacebar Exits"
|
||||
qs1
|
||||
setint(1):print "\nChecking board: [";
|
||||
qs2
|
||||
i$="":a$=right$("0"+str$(bb),2)
|
||||
print a$"]";:gosub idinf:setint(1):if key end goto qs4
|
||||
if (~b1) | (bf$="") | (msg(0)=0) goto qs3
|
||||
if nn>msg(msg(0)) goto qs3
|
||||
print "\n\nThe "bn$"\ncontains new message(s)."
|
||||
input @2 "\n[R]ead S)kip Q)uit :"i$
|
||||
if left$(i$,1)="Q" return
|
||||
if left$(i$,1)="S" goto qs3
|
||||
gosub new:input @2 "\nPost a message? (Y/[N]):"i$
|
||||
if i$="Y":sb$="":ti$="":gosub post
|
||||
i$="Y"
|
||||
qs3
|
||||
bb=bb+1:if bb>ab goto qs4
|
||||
if i$<>"" goto qs1
|
||||
print "\b\b\b";:goto qs2
|
||||
qs4
|
||||
if i$="" | i$=" " print
|
||||
setint(""):bb=ob:goto idinf
|
||||
|
||||
; message show routine
|
||||
|
||||
show
|
||||
if nn<=msg(a):nn=msg(a)+1
|
||||
x=0:if lr<=msg(a):lr=msg(a)+1
|
||||
show1
|
||||
if flag(36) goto anony
|
||||
input #msg(a),sb$|tn,ti$|d,fr$:setint(2)
|
||||
print #x,"\n Board: "bn$"\n Number: "a" of "msg(0)"\nSubject: "sb$
|
||||
print #x," To: "ti$
|
||||
print #x," From: "fr$
|
||||
show1a
|
||||
copy #6,#x:x=0:setint("")
|
||||
if key end x=1:return
|
||||
if key next return
|
||||
show2
|
||||
if i$="+" return
|
||||
gosub time:print "\n["x$"][B"bb" #"a" of "msg(0)"] ? or Cmd [N]#";
|
||||
get i$:print
|
||||
if i$="?" print "\nM)ail [N]ext R)eread X)modem Q)uit D)ump ";
|
||||
if i$="?" & (d=un | exec) print "E)dit K)ill ";
|
||||
if i$="?" & exec print "S)wap P)rint"
|
||||
if i$="?" print
|
||||
if i$="D":i$="+"
|
||||
if (i$="N") | (i$="\n") | (i$="+") return
|
||||
if i$="Q":x=1:return
|
||||
if i$="R" goto show
|
||||
if i$="P" & exec:x=5:goto show1
|
||||
if (i$="A" | i$="M") & flag(1):a$="":goto show5
|
||||
if i$="A" | i$="M" print "\nYou must be verified to reply.":goto show2
|
||||
if i$="X" goto ptcl.dn
|
||||
if ~flag(1) goto show2
|
||||
if ~((d=un) | (exec)) goto show2
|
||||
if i$="E" & (flag(2) | exec) goto show4
|
||||
if i$="W" & exec goto wrt.msg
|
||||
if i$="S" & exec goto mov.msg
|
||||
if i$<>"K" goto show2
|
||||
input @2 "\nKill: Are you Sure? (Y/[N]):"i$
|
||||
if left$(i$,1)!="Y" goto show2
|
||||
gosub kill.3:a--:return
|
||||
show4
|
||||
input @2 "\nEdit: Are you Sure? (Y/[N]):"i$
|
||||
if left$(i$,1)!="Y" goto show2
|
||||
edit clear:input #msg(a),a$|b,b$|c,c$|d$|e$
|
||||
copy #6,#8:edit:if ~edit size goto show2
|
||||
x=msg(a):delete #msg(a):print #msg(a),a$"\n"b,b$"\n"c,c$"\n"d$"\n"e$
|
||||
copy #8,#6:msg(a)=x:update:goto show2
|
||||
show5
|
||||
input @2 "\nIs this a private letter? (Y/[N]):"i$
|
||||
if left$(i$,1)="Y" goto show6
|
||||
if (d=0 & flag(36)):ti$="Anoymous User":goto show5a
|
||||
open #1,"system/sys.users":position #1,128,d
|
||||
input #1,d1$,d2$|d3$:close:ti$=d3$
|
||||
show5a
|
||||
if left$(sb$,3)<>"Re:":sb$="Re: "+sb$
|
||||
b=a:gosub post:a=b:goto show2
|
||||
show6
|
||||
if d=0 print "\nSorry, anonymous post.":goto show2
|
||||
input @2 "\nSend this mail with a return receipt? (Y/[N]):"i$
|
||||
if i$="Y":rf=1:z=0:else rf=0:z=1
|
||||
k$="program/msg.seg"
|
||||
print "\n ":chain "program/mail.seg","msg.link"
|
||||
return
|
||||
on nocar goto link.term
|
||||
ready bf$:goto show2
|
||||
|
||||
wrt.msg
|
||||
input @2 "\nFilename (to write):"i$
|
||||
if i$="" goto show2
|
||||
disk lock:create i$:open #1,i$:append #1
|
||||
copy #msg(a),#1:close:disk unlock:goto show2
|
||||
|
||||
; message mover routine
|
||||
|
||||
mov.msg
|
||||
print "\n\nMessage Mover\n\nBoards 1-"ab
|
||||
input @2 "\nMove this message to board #" i$:zx=val(i$)
|
||||
if (zx>ab) | (zx<1) goto show2
|
||||
print "Message #"a" from this board...";
|
||||
edit clear:input #msg(a),a$|b,b$|c,c$:copy #6,#8
|
||||
x=msg(a):b5=bb:bb=zx:disk lock:gosub idinf
|
||||
if (kl>0) & (kl<=msg(0)) delete #msg(kb):crunch
|
||||
zx=msg(0)+1:print #msg(zx),a$"\n"b,b$"\n"c,c$:copy #8,#6:msg(a)=zx:update
|
||||
bb=b5:gosub idinf:msg(a)=x:gosub kill.3:a--
|
||||
print "is now on board #"i$".":disk unlock:goto show2
|
||||
|
||||
;show a message on anoymous boards.
|
||||
|
||||
anony
|
||||
input #msg(a),sb$|tn,ti$|d,fr$:setint(2)
|
||||
if left$(sb$,1)="*":sb$=mid$(sb$,2):goto anony1
|
||||
print #x,"\n Board :"bn$"\n Number :"a" of "msg(0)"\nSubject :"sb$
|
||||
print #x," To :"ti$
|
||||
print #x," From :"fr$
|
||||
goto show1a
|
||||
|
||||
anony1
|
||||
print #x,"\n Board :"bn$"\n Number :"a" of "msg(0)"\nSubject :"sb$
|
||||
print #x," To :"ti$
|
||||
if exec print #x," From :"fr$:goto show1a
|
||||
print #x," From :Anonymous Poster":goto show1a
|
||||
|
||||
; Protocol download of a message
|
||||
|
||||
ptcl.dn
|
||||
print "\nDownload message #"a;
|
||||
input @2 " via Protocol Transfer? (Y/[N]):"i$
|
||||
if left$(i$,1)<>"Y" return
|
||||
print "\nPreparing Message..."
|
||||
f$="/ram5/d"+str$(un):disk lock:create f$:ready bf$:open #1,f$
|
||||
input #msg(a),sb$|b,ti$|c,fr$:setint(2)
|
||||
y=0:if left$(sb$,1)="*":sb$=mid$(sb$,2):y=1
|
||||
print #1,"\n Board :"bn$"\n Number :"a" of "msg(0)"\nSubject :"sb$
|
||||
print #1," To :"ti$
|
||||
if y print #1," From :Anonymous Poster":else print #1," From :"fr$
|
||||
copy #6,#1:close:print "\nReady to Send...":disk unlock
|
||||
overlay "protocol.down",180,0,f$:delete f$:goto show2
|
||||
|
||||
; Protocol upload of bulletin
|
||||
|
||||
ptcl.up
|
||||
print "\nReady to Receive...":f$="/ram5/u"+str$(un)
|
||||
disk lock:overlay "protocol.up",180,0,f$:disk unlock
|
||||
close:edit clear:copy f$,#8:print \edit size" bytes received"
|
||||
delete f$:edit:return
|
||||
|
||||
idinf
|
||||
flag(36)=0:flag(37)=0
|
||||
if bb=0:bf$="":bl=0:return
|
||||
me=0:bl=bb:open #1,"system/sys.data2"
|
||||
mark(1)=1120:input #1,ab
|
||||
if bb>ab close:bf$="":bl=0:return
|
||||
position #1,128,bb+8
|
||||
input #1,bn$|bf$|b3,b4|bs,bs$|mb,kl,kb
|
||||
if left$(bn$,1)="%":flag(36)=1:bn$=mid$(bn$,2)
|
||||
if left$(bn$,1)="$":flag(36)=1:bn$=mid$(bn$,2)
|
||||
if left$(bn$,1)="#":flag(36)=0:bn$=mid$(bn$,2)
|
||||
b1=1:if b3:b1=flag(b3)
|
||||
b2=1:if b4:b2=flag(b4)
|
||||
close:if bf$="":bl=0:return
|
||||
if (b1) ready bf$:nn=nb
|
||||
return
|
||||
|
||||
; *** sub - routines ***
|
||||
|
||||
; read header file
|
||||
|
||||
rd.head
|
||||
position #1,96,x
|
||||
read #1,ram(1),96
|
||||
return
|
||||
|
||||
wr.head
|
||||
position #1,96,x
|
||||
write #1,ram(1),96
|
||||
return
|
||||
|
||||
; backspace over text
|
||||
|
||||
backup
|
||||
print chr$(8,n);chr$(0x20,n);chr$(8,n);
|
||||
return
|
||||
|
||||
; enter a message
|
||||
|
||||
editor
|
||||
print cls"[ Enter/Edit Message Now : 4k or 4096 Bytes Maximum ]"
|
||||
print "[ Legal Commands : .A = Abort .H = Help .S = Save ]"
|
||||
edit2
|
||||
cl=clock:clock=0:edit clear:edit:clock=cl:return
|
||||
|
||||
; show a disk file
|
||||
|
||||
show.file
|
||||
setint(1):print "\n"s$"\n":open #1,f$:if mark(1) close #1:return
|
||||
showfl2
|
||||
copy (20) #1
|
||||
if (eof(1) | key end) setint(""):close #1:return
|
||||
if ~flag(35) goto showfl2
|
||||
print "Press [RETURN] ";:get i$:if i$=chr$(13) print " ";
|
||||
print chr$(8,16);chr$(0x20,16);chr$(8,16);
|
||||
if i$=" " setint(""):close #1:return
|
||||
setint(1):goto showfl2
|
||||
|
||||
; calculate time remaining
|
||||
|
||||
time
|
||||
z=(clock-clock online)/60:y=clock:x$=right$("00"+str$(z),3 )
|
||||
if clock online>clock:x$="!!!":else if z=0 x$="---"
|
||||
if ~y:x$="***"
|
||||
if exec:x$=":::"
|
||||
return
|
||||
|
||||
data.read /* read current info from the data file */
|
||||
disk lock:open #1,"system/sys.data"
|
||||
input #1,c1,ct,ct$,wm$
|
||||
input #1,nu,mn,tm,nn|lu$
|
||||
close:disk unlock:return
|
||||
|
||||
data.write /* write current into to the data file */
|
||||
disk lock:open #1,"system/sys.data"
|
||||
print #1,c1,ct,ct$,wm$
|
||||
print #1,nu,mn,tm,nn"\n"lu$
|
||||
close:disk unlock:return
|
||||
|
||||
error /* print error message and handle */
|
||||
print "\nOne moment please, returning you to the Main Level."
|
||||
disk lock:close:clear gosub:create "system/sys.errors"
|
||||
open #1,"system/sys.errors":append #1
|
||||
print #1,"Error #"err" occured at "time$" on "date$" in conf.seg"
|
||||
close:disk unlock:chain "a:main.seg","fromsys"
|
||||
|
|
@ -0,0 +1,326 @@
|
|||
|
||||
; Rev 06/18/88 - 18:11 AW
|
||||
|
||||
ready " ":on nocar goto terminate
|
||||
start
|
||||
print sc$'
|
||||
1) Edit bulletin boards
|
||||
2) Print a sorted user list
|
||||
3) Purge Users
|
||||
4) Edit access information
|
||||
5) Quit':gosub showtime
|
||||
print iv$"[Config]"no$" Which? (1-6)";
|
||||
l1$=cr$+es$+"12345":gosub getone:a=val(i$):if i$=cr$ or i$=es$:a=6
|
||||
if a=5 print "Quit":l1$="a:main.seg":l2$="fromsys":goto link
|
||||
push start:if a=1 print "Edit boards":goto maintbrd
|
||||
if a=2 print "User list":goto userlist
|
||||
if a=3 print "Not finished":gosub get:return
|
||||
if a=4 print "Edit access":goto edaccess
|
||||
|
||||
maintbrd
|
||||
print sc$'1) Add a new bulletin board
|
||||
2) Delete a bulletin board
|
||||
3) Edit an existing board
|
||||
4) Swap two bulletin boards
|
||||
5) List all bulletin boards
|
||||
6) Create board storage file
|
||||
7) Return to Config menu':gosub showtime
|
||||
print iv$"[BBS edit]"no$" Which? (1-7)";:l1$=cr$+es$+"1234567":gosub getone
|
||||
a=val(i$):if i$=cr$ or i$=es$ or (a=7) return
|
||||
push maintbrd:if a=1 print "Add":goto add.brd
|
||||
if a=2 print "Delete":goto del.brd
|
||||
if a=3 print "Edit":goto edit.brd
|
||||
if a=4 print "Swap":goto sw.brd
|
||||
if a=5 print "List":goto lst.brd
|
||||
if a=6 print "Create":goto stocre
|
||||
|
||||
add.brd
|
||||
print \"Add a board?";:yn=1:es=1:gosub getyn:if i$="N" return
|
||||
nb=1:open #1,"b:data2":mark(1)=1120:input #1,ab:close
|
||||
bb=ab+1:bn$="New Board":bf$="F:B"+str$(bb)
|
||||
b3=1:b4=1:bs=0:bs$="":mb=128:kl=0:kb=0:goto ed.brd1
|
||||
|
||||
edit.brd
|
||||
open #1,"b:data2":mark(1)=1120:input #1,ab
|
||||
nb=0:print \"System has boards from 1-"ab
|
||||
ed.brd0
|
||||
print \" Edit #";:ix=2:gosub input2:if i$="" close:return
|
||||
bb=val(i$):if (bb<1) or (bb>ab) print \iv$"Invalid Board"no$:goto ed.brd0
|
||||
position #1,128,bb+8:input #1,bn$\bf$\b3,b4\bs,bs$\mb,kl,kb:close
|
||||
ed.brd1
|
||||
print \"1) Name: "bn$" [#"bb"]"
|
||||
print "2) File: "bf$
|
||||
print \"3) Access: "left$(str$(b3)+" "),2)" 4) Write: "b4
|
||||
print \"5) Aux Sysop Numb: "bs
|
||||
print "6) Aux Sysop Name: ";
|
||||
if bs$="" print "[ No Aux Sysop ]":else print bs$
|
||||
print \"7) Max # of bulletins: "mb
|
||||
print "8) Auto kill threshold: ";
|
||||
if kl print kl:else print "No auto kill"
|
||||
print "9) Bulletin # to Kill: "kb
|
||||
print \"10) Abort Without Saving"
|
||||
print "11) Save Changes And Quit"
|
||||
print \"Edit? [1-11]";:ix=2:gosub input:a=val(i$):if (i$="") or a=10 return
|
||||
if a=1 print \"Name";:ix=3:gosub input:if i$<>"":bn$=i$
|
||||
if a=2 print \"File";:ix=3:gosub input:if i$<>"":bf$=i$
|
||||
if a=3 print \"Access";:ix=3:gosub input:if i$<>"":b3=val(i$)
|
||||
if a=4 print \"Write";:ix=3:gosub input:if i$<>"":b4=val(i$)
|
||||
if a=5 print \"Aux Sysop #";:ix=4:gosub input2
|
||||
if (a=5) and (i$<>""):bs=val(i$):gosub ed.brd3
|
||||
if a=6 print \'
|
||||
Aux sysop Name -> 'bs$;chr$(8,len(bs$));:ix=4:gosub input2:if i$<>"":bs$=i$
|
||||
if a=7 print \"Max # of Bulletins";:ix=4:gosub input:if i$<>"":mb=val(i$)
|
||||
if a=8 print \"Auto kill threshold";:ix=4:gosub input:kl=val(i$)
|
||||
if a=9 print \"Bulletin # to Kill";:ix=4:gosub input:if i$<>"":kb=val(i$)
|
||||
if a=11 goto ed.brd2
|
||||
goto ed.brd1
|
||||
|
||||
ed.brd2
|
||||
print \"Updating..";:open #1,"b:data2":mark(1)=1120:input #1,ab
|
||||
i$=bn$+cr$+bf$+cr$+str$(b3)+","+str$(b4)+cr$+str$(bs)+","+bs$+cr$
|
||||
i$=i$+str$(mb)+","+str$(kl)+","+str$(kb)
|
||||
if len(i$)<127:i$=i$+cr$:if len(i$)<127:i$=i$+chr$(32,127-len(i$))
|
||||
position #1,128,bb+8:print #1,i$:if nb=1:mark(1)=1120:print #1,ab+1
|
||||
close:print ".board #"bb" updated":if nb=1 goto stocre1
|
||||
return
|
||||
|
||||
ed.brd3
|
||||
open #1,"b:users":position #1,128,bs:input #1,a$,b$\c$:close #1
|
||||
if a$<>"":bs$=c$:return
|
||||
print \iv$"That user does not exist!"no$
|
||||
if bs$="" or (bs=0):bs=0:bs$=""
|
||||
return
|
||||
|
||||
del.brd
|
||||
open #1,"b:data2":mark(1)=1120:input #1,ab
|
||||
nb=0:print \"System has boards from 1-"ab
|
||||
del.brd0
|
||||
print \"Delete #";:ix=2:gosub input2:if i$="" close:return
|
||||
bb=val(i$):if (bb<1) or (bb>ab) print \iv$"Invalid Board"no$:goto del.brd0
|
||||
position #1,128,bb+8:input #1,bn$\bf$
|
||||
print \"Delete "bn$"?";:yn=1:es=1:gosub getyn:if i$="N" close:return
|
||||
kill bf$:ab=ab-1:mark(1)=1120:print #1,ab:if bb=(ab+1) close:return
|
||||
for l=bb to ab-1:position #1,128,l+9:input #1,bn$\bf$\b3,b4\bs,bs$\mb,kl,kb
|
||||
i$=bn$+cr$+bf$+cr$+str$(b3)+","+str$(b4)+cr$+str$(bs)+","+bs$+cr$
|
||||
i$=i$+ctr$(mb)+","+str$(kl)+","+str$(kb)
|
||||
if len(i$)<127:i$=i$+cr$:if len(i$)<127:i$=i$+chr$(32,127-len(i$))
|
||||
position #1,128,l+8:print #1,i$:next:close:return
|
||||
|
||||
sw.brd
|
||||
open #1,"b:data2":mark(1)=1120:input #1,ab
|
||||
nb=0:print \"System has boards from 1-"ab
|
||||
sw.brd0
|
||||
print \"Swap #";:ix=2:gosub input2:if i$="" close:return
|
||||
b1=val(i$):if (b1<1) or (b1>ab) print \iv$"Invalid Board"no$:goto sw.brd0
|
||||
sw.brd1
|
||||
print "With #";:ix=2:gosub input2:if i$="" goto sw.brd0
|
||||
b2=val(i$):if (b2<1) or (b2>ab) print \iv$"Invalid Board"no$:goto sw.brd1
|
||||
position #1,128,b1+8:input #1,bn$:print "Swap board: "bn$
|
||||
position #1,128,b2+8:input #1,bn$:print "With board: "bn$
|
||||
print \"Correct?";:yn=1:es=1:gosub getyn:if i$="N" close:return
|
||||
position #1,128,b1+8:input #1,bn$\bf$\b3,b4\bs,bs$\mb,kl,kb
|
||||
edit clear:print #8,bn$\bf$\b3,b4\bs,bs$\mb,kl,kb
|
||||
position #1,128,b2+8:input #1,bn$\Bf$\b3,b4\bs,bs$\mb,kl,kb
|
||||
i$=bn$+cr$+bf$+cr$+str$(b3)+","+str$(b4)+cr$+str$(bs)+","+bs$+cr$
|
||||
i$=i$+ctr$(mb)+","+str$(kl)+","+str$(kb)
|
||||
if len(i$)<127:i$=i$+cr$:if len(i$)<127:i$=i$+chr$(32,127-len(i$))
|
||||
position #1,128,b1+8:print #1,i$
|
||||
input #8,bn$\bf$\b3,b4\bs,bs$\mb,kl,kb:edit clear
|
||||
i$=bn$+cr$+bf$+cr$+str$(b3)+","+str$(b4)+cr$+str$(bs)+","+bs$+cr$
|
||||
i$=i$+ctr$(mb)+","+str$(kl)+","+str$(kb)
|
||||
if len(i$)<127:i$=i$+cr$:if len(i$)<127):i$=i$+chr$(32,127-len(i$))
|
||||
position #1,128,b2+8:print #1,i$
|
||||
close:return
|
||||
|
||||
lst.brd
|
||||
print sc$:open #1,"b:data2":mark(1)=1120:input #1,ab
|
||||
for l=1 to ab:position #1,128,l+8:input #1,bn$,bf$
|
||||
print right$(" "+str$(l),2)". "left$(bn$+chr$(32,32),32)bf$
|
||||
next:close:print \"Press any key to continue";:gosub get:return
|
||||
|
||||
stocre
|
||||
print sc$:open #1,"b:data2":mark(1)=1120:input #1,ab
|
||||
stocre0
|
||||
print \"Create storage file for board #";:ix=2:gosub input2
|
||||
if i$="" close:return
|
||||
bb=val(i$):if (bb<1) or (bb>ab) print \iv$"Invalid Board"no$:goto stocre0
|
||||
position #1,128,bb+8:input #1,bn$\bf$\b3,b4\bs,bs$\mb,kl,kb:close
|
||||
stocre1
|
||||
print \"Directory Capacity [Default=128]";:ix=2:gosub input:a$=i$
|
||||
if a$="":a$="128"
|
||||
print \"Storage Capacity [Default=128k]";:ix=2:gosub input:b$=i$
|
||||
if b$="":b$="128"
|
||||
y=val(a$):z=val(b$):print sc$"Name: "bn$:print \"File: "bf$
|
||||
print \"Max Bulletins: "y:print \"Max Storage: "z
|
||||
print \"Is the above correct?";:yn=1:es=1:gosub getyn:if i$="N" return
|
||||
y=(y/128)*128:z=(z/128)*128:l=(y/32)+(z/128)
|
||||
fill ram2,64,0:poke ram2,z/128:poke ram2+1,y/32:create bf$:open #1,bf$
|
||||
write #1,ram2,8:fill ram2,64,0:for x=1 to l:write #1,ram2,64
|
||||
write #1,ram2,64:next:close:x=6:use "e:xtyp",bf$,x:return
|
||||
|
||||
userlist
|
||||
print sc$'
|
||||
1) Print list sorted by name
|
||||
2) Print list sorted by user number
|
||||
3) Print list sorted by password
|
||||
4) Print list sorted by phone number
|
||||
5) Print list sorted by last date on
|
||||
6) Print list sorted by security level
|
||||
7) Return to main menu':gosub showtime
|
||||
print iv$"[User list]"no$" Which? (1-7)";:l1$=cr$+es$+"1234567"
|
||||
gosub getone:a=val(i$):if i$=cr$ or i$=es$ or (a=7) return
|
||||
y=32:if a=1 print "Name":f$="b:srt.name"
|
||||
if a=2 print "User":f$="b:srt.num"
|
||||
if a=3 print "Pass":f$="b:srt.pw":y=64
|
||||
if a=4 print "Phone":f$="b:srt.ph":y=64
|
||||
if a=5 print "Date":f$="b:srt.date":y=64
|
||||
if a=6 print "Security":f$="b:srt.sec":y=64
|
||||
print \"Show passwords?";:yn=1:es=1:gosub getyn:pa=(i$="Y"):if es return
|
||||
i$="":print \"To printer?";:yn=1:es=1:gosub getyn:s=5:nl=58:if es return
|
||||
if i$="N":s=0:nl=15
|
||||
move ram,58 to ram2:on nocar goto pterm
|
||||
z=1:print sc$\:open #2,f$:if mark(2)=0 goto sortit
|
||||
close:print "Reading data...":open #1,"b:users":kill f$:create f$:open #2,f$
|
||||
for l=1 to nu:position #1,128,l:input #1,d1$,d2$\d3$\d4$,d5$
|
||||
position #1,128,l,70:read #1,ram,58:t$="":if d1$="" goto next
|
||||
t$=d2$+" "+d1$
|
||||
if a=2:t$=right$(" "+str$(l),4)
|
||||
if a=3:t$=mid$(" "+pa$+" ",2,8)+t$
|
||||
if a=4:i$=right$(chr$(32,12)+ph$,12)
|
||||
if a=4:t$=left$(i$,3)+"-"+mid$(i$,5,3)+"-"+right$(i$,4)+t$
|
||||
if a=5:t$=right$(when$,2)+"/"+left$(when$,5)+t$
|
||||
if a=6:i$="":for x=1 to 34:i$=i$+str$(flag(x)):next:t$=i$+t$
|
||||
position #2,y,z:print #2,t$\l:z=z+1
|
||||
next
|
||||
next
|
||||
sortit
|
||||
close:z=1:print "Sorting...";:use "e:rndsort.128",f$,y,z
|
||||
print "Printing...":z=1:open #2,f$:open #1,"b:users":ln=1:r=0
|
||||
ploop
|
||||
position #2,y,z:input #2,t$\l:if t$="" goto pend
|
||||
position #1,128,l:input #1,d1$,d2$\d3$\d4$,d5$
|
||||
position #1,128,l,70:read #1,ram,58
|
||||
setint(1):if mm=2 addint(es$)
|
||||
if ln<>1 goto skp.hdr
|
||||
if r and (s=0) print "Press any key to continue";:gosub get
|
||||
if r print #s,sc$;
|
||||
print #s,'
|
||||
** GBBS "Pro" Userlist - Version 1.3 - List Sorted By: ';
|
||||
if a=1 print #s,"User Name ";
|
||||
if a=2 print #s,"User Number ";
|
||||
if a=3 print #s,"Password ";
|
||||
if a=4 print #s,"Phone Number ";
|
||||
if a=5 print #s,"Last Date on ";
|
||||
if a=6 print #s,"Security level";
|
||||
r=1:print #s,' **
|
||||
[Name] [Phone] [User] [Pass] [Sec] [Last] [Time]
|
||||
[Alias] [Number] [Numb] [Word] [Lvl] [Call] [Limit]'
|
||||
print #s,""
|
||||
skp.hdr
|
||||
print #s,left$(d3$+chr$(32,25),25);ph$;right$(" "+str$(l),6)"-";
|
||||
if pa print #s,pa$;:else print #s,"********";
|
||||
print #s," ";:for x=1 to 8:print #s,flag(x);:next
|
||||
print #s," "when$;right$(" "+str$(nibble(5)*10),4)
|
||||
z=z+1:ln=ln+1:if ln>nl:ln=1
|
||||
if (mm=2) and (key=27):mm=0
|
||||
if key flag=0 goto ploop
|
||||
pend
|
||||
close:setint(""):if s=0 print \"Press any key to continue";:gosub get
|
||||
print #s,sc$;:move ram2,58 to ram:return
|
||||
|
||||
pterm
|
||||
move ram2,58 to ram:close:setint("")
|
||||
terminate
|
||||
l1$="a:main.seg":l2$="term1"
|
||||
link
|
||||
open #1,"b:trace":append #1:print #1,l1$,l2$:link l1$,l2$
|
||||
|
||||
edaccess
|
||||
gosub showtime:print iv$"[Access]"no$" "iv$"[Q]"no$"uit, V)iew, E)dit";
|
||||
l1$=cr$+es$+"QVE":gosub getone
|
||||
if i$="Q" or i$=cr$ or i$=es$ print "Quit":return
|
||||
push edaccess:if i$="E" print "Edit":goto accessed
|
||||
print "View"\:open #1,"b:data2":for l=0 to 16
|
||||
position #1,32,l:input #1,a$:position #1,32,l+17:input #1,b$
|
||||
print right$(sp$+str$(l),2)". "left$(a$+chr$(32,32),32)" ";
|
||||
print right$(sp$+str$(l+17),2)". "b$:next
|
||||
position #1,32,34:input #1,a$:print chr$(32,38)"34. "a$:close:return
|
||||
|
||||
accessed
|
||||
print \"Edit flag #";:ix=2:gosub input2:if i$="" return
|
||||
l=val(i$):if (l<0) or (l>34) print \iv$"Invalid flag"no$;g$:goto accessed
|
||||
open #1,"b:data2":position #1,32,l:input #1,a$
|
||||
acc.1
|
||||
print right$(" "+str$(l),2)". "a$
|
||||
print " ";:ix=3:gosub input:if len(i$)>31 print '
|
||||
Entry too long.. Try again..'\:goto acc.1
|
||||
if i$<>"" goto setflag
|
||||
print \"Zero this flag?";:yn=1:es=1:gosub getyn:if i$="N" return:else i$=""
|
||||
setflag
|
||||
if len(i$)<31:i$=i$+cr$:if len(i$)<31:i$=i$+chr$(32,31-len(i$))
|
||||
position #1,32,l:print #1,i$:close:goto accessed
|
||||
|
||||
showtime
|
||||
ty=clock online:tx=clock-ty:tx$=""
|
||||
if ty>3599:tx$=right$("0"+str$(ty/3600),2)+":":ty=(ty mod 3600)
|
||||
tx$=tx$+right$("0"+str$(ty/60),2)+":"+right$("0"+str$(ty mod 60),2)
|
||||
if exec or (clock=0) goto d.time
|
||||
tx$=tx$+"-"
|
||||
if tx>3599:tx$=tx$+right$("0"+str$(tx/3600),2)+":":tx=(tx mod 3600)
|
||||
tx$=tx$+right$("0"+str$(tx/60),2)+":"+right$("0"+str$(tx mod 60),2)
|
||||
d.time
|
||||
print:if td print "["tx$"] ";
|
||||
return
|
||||
|
||||
getyn
|
||||
print " (";:l1$="YN":if yn=2 print iv$"[Y]"no$;:l1$=l1$+cr$:else print "y";
|
||||
print "/";:if yn=1 print iv$"[N]"no$;:l1$=l1$+cr$:else print "n";
|
||||
print ")";:if es>0:l1$=l1$+es$
|
||||
gosub getone:l1$=i$:if (i$=es$) and (es>0):i$=mid$("NY",es,1)
|
||||
if (i$=cr$) and (yn>0):i$=mid$("NY",yn,1)
|
||||
es=0:yn=0:if l1$=es$:es=1:print "Esc":return
|
||||
if i$="Y" print "Yes":else print "No"
|
||||
return
|
||||
|
||||
getone
|
||||
print ": ";
|
||||
getonex
|
||||
gosub get.mac:cx=cx+1:if (mm=1) and (i$=g$) gosub savemac
|
||||
if instr(i$,l1$) goto get2
|
||||
goto getonex
|
||||
|
||||
get
|
||||
print ": ";:gosub get.mac:cx=cx+1
|
||||
get2
|
||||
if mm=1 print #10,i$;:if mark(10)>126 goto savemac
|
||||
return
|
||||
|
||||
input
|
||||
print " -> ";
|
||||
input2
|
||||
free:if mm<>2 goto input2a
|
||||
if key=27 get i$:mm=0:goto input2a
|
||||
input #10,i$:print i$:goto input3
|
||||
input2a
|
||||
if ix=-1 input i$
|
||||
if ix=0 input @0 i$
|
||||
if ix=1 input @1 i$
|
||||
if ix=2 input @2 i$
|
||||
if ix=3 input @3 i$
|
||||
if ix=4 input @4 i$
|
||||
input3
|
||||
cx=cx+len(i$)+1:ix=-1:if mm<>1 return
|
||||
if mark(10)+len(i$)<127 print #10,i$:else goto macsv
|
||||
if mark(10)<127:return
|
||||
macsv
|
||||
print g$;
|
||||
savemac
|
||||
open #2,"b:macros":position #2,128,un:write #2,-18816,128:close #2
|
||||
mm=0:print g$;:return
|
||||
|
||||
get.mac
|
||||
free:if mm<>2 get i$:return
|
||||
if key=27 get i$:mm=0:goto get.mac
|
||||
mm=peek(mark(10)-18816):if mm=0 goto get.mac
|
||||
mark(10)=mark(10)+1:i$=chr$(mm):mm=2:if mark(10)>126:mm=0
|
||||
return
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
public copy.1
|
||||
|
||||
|
||||
begin
|
||||
on nocar goto
|
||||
f$="":f2$=""
|
||||
|
||||
copy
|
||||
input @2 \"Input source file (ex. a:filename): "f$
|
||||
if f$="" print
|
||||
open #1,f$:a=mark(1):close
|
||||
if a:print \"That file doesn't exist!":goto
|
||||
input @2 \"Input target file ................: "f2$:print
|
||||
if f2$="" print
|
||||
|
||||
copy.1
|
||||
overlay "x.copy",f$,f2$
|
||||
a=peek(-25085)
|
||||
if a=71:input @2
|
||||
if a<>0:print \"Copy aborted....error #"a:print\
|
||||
|
||||
link.net
|
||||
if not exec
|
||||
link "a:network.seg"
|
||||
|
||||
link.term
|
||||
link "a:main.seg","term1"
|
||||
|
||||
|
|
@ -0,0 +1,325 @@
|
|||
; *********************
|
||||
; LLUCE v1.0
|
||||
; Copyright 1989
|
||||
; L&L Productions, Inc.
|
||||
; *********************
|
||||
|
||||
; email segment rev c - 5/12/90
|
||||
; Original code written by Andy Nicholas
|
||||
|
||||
public mailread
|
||||
public email
|
||||
|
||||
on nocar goto link.term /* setup loss of carrier vector */
|
||||
; on error goto error /* setup error vector */
|
||||
gosub browse /* show any possible mail first off */
|
||||
|
||||
email /* get a command from the user and handle it for email */
|
||||
gosub time:print "\n[("x$")] E-Mail Level [?=Help] :";
|
||||
email1
|
||||
get i$
|
||||
email2
|
||||
push email
|
||||
if i$="Q" print "Quit to Main Level":pop:goto link.main
|
||||
if i$="?" print "Menu":goto menu
|
||||
if i$="H" print "Help":ns=2:l$="HELP":goto dispatch
|
||||
if i$="D" print "Delete Mail":goto delete
|
||||
if i$="R" print "Read Mail":goto read
|
||||
if i$="S" print "Send Mail":goto send
|
||||
if i$="B" print "Browse Mail":goto browse
|
||||
if i$="T" print "Terminate":goto terminate
|
||||
if i$="D" print "Delete Mail":goto delete
|
||||
if i$="X" print "Download all Mail":a=0:goto download
|
||||
if i$="\n" | i$=" " pop:goto email1
|
||||
if ~exec goto email3
|
||||
if i$="F" print "Read Feedback":mb$="email/feedback":goto read1
|
||||
if i$="L" print "Browse Feedback":mb$="email/feedback":goto browse1
|
||||
email3
|
||||
a1++:print "\n\n"pr$"\""i$"\" is ~a valid command":if a1<3 return
|
||||
|
||||
menu /* show menu of valid commands */
|
||||
if width<79:f$="system/mnu.email40":else f$="system/mnu.email80"
|
||||
menu1
|
||||
a1=0:if ~exist(f$) goto email
|
||||
open #1,f$:input #1,z$:setint(" "):addint(z$)
|
||||
cls:copy #1:if key flag goto menukey
|
||||
a=key:close:setint(""):goto email
|
||||
|
||||
menukey /* handle a ketpress during menu display */
|
||||
close:setint(""):a=key:i$=chr$(a):upper$(i$)
|
||||
if i$=" " goto email
|
||||
print "\n["x$"][E-Mail Level] Option (?=Help):"
|
||||
goto email2
|
||||
|
||||
dispatch /* link to utility segment for help */
|
||||
y$="program/email.seg":z$="email"
|
||||
chain "program/util.seg"
|
||||
|
||||
terminate /* does the user want to terminate off the system */
|
||||
print "\nAre You Sure ["inverse$"(Yes)"normal$",No] :";
|
||||
get i$:if i$="N" print "No":return
|
||||
print "Yes"
|
||||
link.term /* link back to main segment on loss of carrier */
|
||||
chain "program/main.seg","term1"
|
||||
link.main /* link back to the main.seg */
|
||||
chain "program/main.seg","otherseg"
|
||||
|
||||
send /* send mail to a user */
|
||||
if ~flag(1) print "\n"pr$"Only validated users may send mail":return
|
||||
input @2 "\nTo whom: [Mail ID or Name] -> "i$:if i$="" return
|
||||
if (instr("!",i$) | instr("@",i$)) goto netsend
|
||||
gosub name.chk:if ~f print "\nSorry, No such user.":return
|
||||
if (a<1) | (a>nu) print "\nSorry, No such user":return
|
||||
move ram,60 to ram(1):open #1,"system/sys.users"
|
||||
position #1,192,a:input #1,a$|b$|c$
|
||||
position #1,192,a,132:read #1,ram,60
|
||||
close:rtrim$(a$)
|
||||
if a$="" move ram(1),60 to ram:print "\nSorry, No such user":return
|
||||
print "\nSend to "a$" ("b$")\nLast on - "when$;
|
||||
print "? ["inverse$"(Yes)"normal$"/No]: ";
|
||||
send4
|
||||
get i$:move ram(1),60 to ram:if i$="N" print "No":return
|
||||
print "Yes"
|
||||
input @3 "\nSubject -> "sb$:if sb$="":sb$="None"
|
||||
gosub editor:if ~edit size goto abort
|
||||
send5
|
||||
print "\nRegistered Mail? [Yes/"inverse$"(No)"normal$"]: ";
|
||||
get i$:if i$="Y" print "Yes":else print "No"
|
||||
rg=(i$="Y"):sb$=left$(sb$,25)
|
||||
if rg:st$="Registered Mail":else st$="Awaiting Reply"
|
||||
print:f$=a$:gosub chkbox:print "Sending "edit size" bytes...";
|
||||
ready mb$:if msg(0)=128 kill #msg(1):crunch
|
||||
a=msg(0)+1:a$=id$:rtrim$(a$)
|
||||
print #msg(a),date$" "time$"\n"a$" ("a1$")",un"\n"st$"\n"sb$"\n"rg
|
||||
copy #9,#7:msg(a)=a:flush:ready "":print "Message Sent"
|
||||
return
|
||||
|
||||
netsend /* parse and handle possible net-mail */
|
||||
print "\nNetwork Mail is still being implimented.":return
|
||||
|
||||
read /* read mail for the user currently logged in */
|
||||
mb$="email/"+id$:rtrim$(mb$):rs=0
|
||||
read1
|
||||
if ~exist(mb$) print "\nNo letters waiting":return
|
||||
ready mb$:x=0
|
||||
read2
|
||||
if rs gosub register
|
||||
a=0:push read2:x++:if x>msg(0) pop:ready "":goto delete
|
||||
read3
|
||||
input #msg(x),dt$|fr$,un$|st$|sb$|rs
|
||||
print #a,"\n"md$
|
||||
print #a," From: "fr$
|
||||
print #a," Date: "dt$
|
||||
print #a,"Status: "st$
|
||||
print #a," Subj: "sb$"\n"
|
||||
setint(2):copy #7,#a:setint(""):print #a,md$:if key next return
|
||||
read4
|
||||
print "\n[A]uto reply, "inverse$"[N]"normal$"ext, [R]e-read, [D]ownload, ";
|
||||
print "[K]ill, [Q]uit: ";:get i$
|
||||
if i$="Q" print "Quit":ready "":pop:return
|
||||
if i$="R" print "Re-read":a=0:goto read3
|
||||
if i$="F" print "Forward":goto forward
|
||||
if i$="A" print "Auto-Reply":goto reply
|
||||
if i$="K" print "Kill":goto kill
|
||||
if i$="X" print "Download Message":a=1:gosub download:goto read4
|
||||
if i$="P" & exec print "Print":a=6:goto read3
|
||||
print "Next":return
|
||||
|
||||
mailread /* enter from logon seg if they want to read mail right away */
|
||||
gosub browse:print "\nPress a key to continue...";:get i$
|
||||
gosub read:chain "program/main.seg"
|
||||
|
||||
reply /* reply to someone message */
|
||||
if (instr("!",fr$) | instr("@",fr$)) goto netsend
|
||||
z$=mb$:if left$(sb$,4)<>"Re: " sb$="Re: "+sb$
|
||||
f$=left$(fr$,(instr("(",fr$)-1)):rtrim$(f$)
|
||||
gosub chkbox:gosub editor:if ~edit size gosub abort:mb$=z$:goto reply1
|
||||
gosub send5:mb$=z$
|
||||
reply1
|
||||
ready mb$:return
|
||||
|
||||
forward /* forward a message to someone else */
|
||||
input @2 "\nForward to [Mail ID or Name] -> "i$:if i$="" goto read4
|
||||
if (instr("!",i$) | instr("@",i$)) goto netsend
|
||||
gosub name.chk:if ~f print "\nSorry, No such user.":goto read4
|
||||
if (a<1) | (a>nu) print "\nSorry, No such user":goto read4
|
||||
move ram,60 to ram(1):open #1,"system/sys.users"
|
||||
position #1,192,a:input #1,a$|b$|c$
|
||||
position #1,192,a,132:read #1,ram,60
|
||||
close:rtrim$(a$)
|
||||
if a$="" move ram(1),60 to ram:print "\nSorry, No such user"
|
||||
print "\nSend to "a$" ("b$")\nLast on - "when$;
|
||||
print "? ["inverse$"(Yes)"normal$"/No]: ";
|
||||
get i$:move ram(1),60 to ram:if i$="N" print "No":goto read4
|
||||
print "Yes"
|
||||
forward4
|
||||
print "\nRegistered Mail? [Yes/"inverse$"(No)"normal$"]: ";
|
||||
get i$:if i$="Y" print "Yes":else print "No"
|
||||
rg=(i$="Y"):sb$=left$(sb$,25)
|
||||
f$=a$:input #msg(x),dt$|fr$,un$|st$|sb$|rs
|
||||
edit clear:print #9," From: "fr$
|
||||
print #9," Date: "dt$
|
||||
print #9,"Status: "st$
|
||||
print #9," Subj: "sb$"\n"
|
||||
copy #7,#9:z$=mb$
|
||||
st$="Forwarded":gosub chkbox:ready mb$
|
||||
if msg(0)=128 kill #msg(1):crunch
|
||||
a=msg(0)+1:a$=id$:rtrim$(a$)
|
||||
print #msg(a),date$" "time$"\n"a$" ("a1$")",un"\n"st$"\n"sb$"\n"rg
|
||||
copy #9,#7:msg(a)=a:flush:mb$=z$:ready mb$
|
||||
print "\nMessage Forwarded"
|
||||
return
|
||||
|
||||
kill /* kill a message from someone mail file */
|
||||
if msg(0)=1 ready "":kill mb$:pop:return
|
||||
kill #msg(x):crunch:flush
|
||||
if x>msg(0) pop:ready "":return
|
||||
goto read3
|
||||
|
||||
register /* Send registered mail receipt */
|
||||
edit clear:input #msg(x),dt$|fr$,un$|st$|sb$|rs /* Update message to show */
|
||||
copy #7,#9:rs=0:st$="Receipt Sent" /* Receipt having been sent */
|
||||
z=msg(x):kill #msg(x)
|
||||
print #msg(x),dt$"\n"fr$,un$"\n"st$"\n"sb$"\n"rs
|
||||
copy #9,#7:msg(x)=z:flush
|
||||
z$=mb$:f$=left$(fr$,(instr("(",fr$)-1))
|
||||
rtrim$(f$):a$=id$:rtrim$(a$)
|
||||
gosub chkbox:ready mb$
|
||||
st$="Reciept Notice":if left$(sb$,4)<>"Re: " sb$="Re: "+sb$
|
||||
rg=0:if msg(0)=128 kill #msg(1):crunch
|
||||
edit clear:print #9,"This letter is to let you know that "a1$
|
||||
print #9,"read your letter on "date$" at "time$"
|
||||
a=msg(0)+1:a$=id$:rtrim$(a$)
|
||||
print #msg(a),date$" "time$"\n"a$" ("a1$")",un"\n"st$"\n"sb$"\n"rg
|
||||
copy #9,#7:msg(a)=a:flush:mb$=z$:ready mb$
|
||||
print "\nReciept Sent"
|
||||
regst1
|
||||
return
|
||||
|
||||
delete /* find out if the user wants to delete there mailbox */
|
||||
print "\nDelete mailbox? [Yes/"inverse$"(No)"normal$"]: ";
|
||||
get i$:if i$="Y" print "Yes":else print "No":return
|
||||
delete1
|
||||
ready "":close:kill mb$
|
||||
print "\nYour Mailbox has been deleted"
|
||||
return
|
||||
|
||||
browse /* show the user a quick summary of any waiting mail */
|
||||
mb$="email/"+id$:rtrim$(mb$)
|
||||
browse1
|
||||
if ~exist(mb$) print "\nNo letters waiting":return
|
||||
ready mb$:x=0:setint(1):print "\n"s$
|
||||
print "\nFrom Date Time R Subject"
|
||||
print chr$(0x2D,79)
|
||||
browse2
|
||||
x++:if x>msg(0) ready "":setint(""):return
|
||||
input #msg(x),dt$|fr$,un$|st$|sb$|rg
|
||||
print left$(fr$+chr$(0x20,30),30)" ";
|
||||
print left$(dt$+chr$(0x20,20),20)" ";
|
||||
if rg print "Y ";:else print "N ";
|
||||
print left$(sb$,24):if key end ready "":setint(""):return
|
||||
goto browse2
|
||||
|
||||
download /* download a message xmodem */
|
||||
if ~exist(mb$) print "\nNo letters waiting":return
|
||||
if a=0: print "\nDownload all waiting mail? [Yes/"inverse$"(No)"normal$"]: ";
|
||||
if a=1: print "\nDownload this message? [Yes/"inverse$"(No)"normal$"]: ";
|
||||
get i$:if i$="Y" print "Yes":else print "No":goto down2
|
||||
print "\nWait, Creating File...";
|
||||
i$="email/mail.temp":kill i$:create i$:open #1,i$
|
||||
if a=0 ready mb$:for x=1 to msg(0)
|
||||
down1
|
||||
input #msg(x),dt$|fr$,un$|st$|sb$|rg
|
||||
print #1," From: "fr$
|
||||
print #1," Date: "dt$
|
||||
print #1,"Status: "st$
|
||||
print #1," Subj: "sb$"\n"
|
||||
copy #7,#1:if a=0 next:ready ""
|
||||
print "done":si=size(1):close:if si=(-1):si=1
|
||||
print "\nSending "(si*2)+1" Xmodem blocks..."
|
||||
print "\nStart your Xmodem receive now..."
|
||||
; use "protocol.down",300,0,i$
|
||||
if peek(10)=255 print "\nError in transfer...":goto down2
|
||||
a=peek(10)
|
||||
if a=0:i$="Standard Xmdm"
|
||||
if a=1:i$="ProDOS Xmodem"
|
||||
if a=2:i$="CRC-16 Xmodem"
|
||||
if a=3:i$="ProDOS CRC-16"
|
||||
if a=4:i$="Standard Ymdm"
|
||||
if a=5:i$="ProDOS/Ymodem"
|
||||
print "\nSuccessful transfer via "i$"..."
|
||||
down2
|
||||
return
|
||||
|
||||
; *** Sub - Routines ***
|
||||
|
||||
name.chk /* check tree file for valid mail ID */
|
||||
a$=i$:rtrim$(a$):open #1,"system/sys.mailnames":t=nu:b=0:f=0
|
||||
name1
|
||||
l=t-((t-b)/2):position #1,16,l:input #1,i$:upper$(i$)
|
||||
rtrim$(i$):if a$=i$:f=1:input #1,a:close #1:return
|
||||
if a$<i$:t=l-1:else b=l
|
||||
if b<t goto name1
|
||||
close #1:open #1,"system/sys.fullnames":t=nu:b=0:f=0
|
||||
name2
|
||||
l=t-((t-b)/2):position #1,32,l:input #1,i$:upper$(i$)
|
||||
rtrim$(i$):if a$=i$:f=1:input #1,a:close #1:return
|
||||
if a$<i$:t=l-1:else b=l
|
||||
if b<t goto name2
|
||||
close #1:return
|
||||
|
||||
chkbox /* check mailbox status and create if not present */
|
||||
ready "":mb$="email/"+f$
|
||||
if ~exist(mb$) print "Wait, Making Mailbox...";:create mb$,msg,128
|
||||
return
|
||||
|
||||
abort /* kill off the message file if not mail was sent */
|
||||
ready mb$:if ~msg(0) ready "":kill mb$
|
||||
return
|
||||
|
||||
editor
|
||||
print cls"[ Enter/Edit Message Now : 4k or 4096 Bytes Maximum ]"
|
||||
print "[ Legal Commands : .A = Abort .H = Help .S = Save ]"
|
||||
edit2
|
||||
cl=clock:clock=0:edit clear:edit:clock=cl:return
|
||||
|
||||
time
|
||||
x=(clock-clock online)/60:y=clock /* Get minutes online & time limit */
|
||||
x$=right$("00"+str$(x),2 )
|
||||
if clock online>clock:x$="!!"
|
||||
if b=0:x$="--"
|
||||
if ~y:x$="**"
|
||||
if exec:x$="::"
|
||||
return
|
||||
|
||||
showfile
|
||||
if ~exist(f$) return
|
||||
setint(1):print "\n"s$"\n":open #1,f$
|
||||
showfl2
|
||||
copy (20) #1
|
||||
if eof(1) | key end setint(""):close #1:return
|
||||
if ~flag(35) goto showfl2
|
||||
print "Press "inverse$"[RETURN]"normal$": ";:get i$
|
||||
print chr$(8,17);chr$(0x20,17);chr$(8,17);
|
||||
if i$=" " setint(""):close #1:return
|
||||
setint(1):goto showfl2
|
||||
|
||||
data.read /* read current info from the data file */
|
||||
disk lock:open #1,"system/sys.data"
|
||||
input #1,c1,ct,ct$,wm$
|
||||
input #1,nu,mn,tm,nn|lu$
|
||||
close:disk unlock:return
|
||||
|
||||
data.write /* write current into to the data file */
|
||||
disk lock:open #1,"system/sys.data"
|
||||
print #1,c1,ct,ct$,wm$
|
||||
print #1,nu,mn,tm,nn"\n"lu$
|
||||
close:disk unlock:return
|
||||
|
||||
|
||||
error /* handle any possible errors that occur and report them */
|
||||
print "\n"pr$"One moment please, returning you to the Main Level."
|
||||
clear gosub:close:disk lock:create "system/sys.errors"
|
||||
open #1,"system/sys.errors":append #1
|
||||
print #1,"Error #"err" occured at "time$" on "fmtdate$" in mail.seg"
|
||||
close:disk unlock:chain "a:main.seg","fromsys"
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
|
||||
; Fix board files
|
||||
|
||||
; turn off carrier detect
|
||||
|
||||
on nocar:
|
||||
|
||||
; get number of boards
|
||||
|
||||
open #1,"b:data2":mark(1)=1120:input #1,ab:close:tb$="f:temp"
|
||||
|
||||
; loop for all boards
|
||||
|
||||
for bb=1 to
|
||||
|
||||
; get board name and file name
|
||||
|
||||
open #1,"b:data2":position #1,128,bb+8:input
|
||||
print "Fixing board: "bn$" Messages 1-";
|
||||
|
||||
; get board info
|
||||
|
||||
open #1,bf$:read #1,ram2,2:close:l=peek(ram2)+peek(ram2+1)
|
||||
|
||||
; make new board file
|
||||
|
||||
create tb$,6:open #1,tb$:write
|
||||
for x=1 to
|
||||
|
||||
; get number of messages on current board
|
||||
|
||||
ready bf$:mt=msg(0):print mt" - "0;:for
|
||||
print chr$(8,len(str$(a-1)))a;:edit clear
|
||||
|
||||
; read a message
|
||||
|
||||
input #msg(a),a$\b,b$\c,c$\d$\e$:copy #6,#8:x=msg(a):ready
|
||||
|
||||
; write it back out
|
||||
|
||||
print #msg(a),a$\b,b$\c,c$\d$\e$:copy #8,#6:msg(a)=x:next:print
|
||||
|
||||
; clear editor buffer, delete old file, and rename the new one
|
||||
|
||||
edit clear:ready " ":kill
|
||||
|
||||
; link back to the system
|
||||
|
||||
next:close:end
|
||||
|
||||
next:close:link "a1:system.seg"
|
||||
|
||||
Binary file not shown.
|
|
@ -0,0 +1,38 @@
|
|||
|
||||
modem ready
|
||||
|
||||
start1
|
||||
input @2 "Ready -> "i$
|
||||
|
||||
OVERLAY "SHELL","/MAIN/UTIL/PROSEL/CAT.DOCTOR","","","/RAM5/SAVE"
|
||||
|
||||
; ansi on
|
||||
; commented out because the 1st gosub encountered will give a syntax error.
|
||||
|
||||
end
|
||||
|
||||
start
|
||||
i7$="\I"
|
||||
sc$="\I\H\f"
|
||||
print sc$
|
||||
gosub header
|
||||
print "Press Return or Q to quit. \N";:get i$
|
||||
if i$="Q" end
|
||||
goto start
|
||||
|
||||
header
|
||||
print "\N";
|
||||
lf=0
|
||||
ve=up+1:ho=lf+1:print gotoxy$(ho,ve);chr$(32,80)
|
||||
ho=8:print gotoxy$(ho,ve)"Messages"
|
||||
ho=26:print gotoxy$(ho,ve)"E-Mail"
|
||||
ho=38:print gotoxy$(ho,ve)"Utilities"
|
||||
ho=54:print gotoxy$(ho,ve)"Information"
|
||||
ve=up+2
|
||||
line
|
||||
ho=1:ve=up+2
|
||||
print gotoxy$(ho,ve);i7$;chr$(223,80);
|
||||
return
|
||||
|
||||
CHAIN "PROGRAM/LOGON.SEG2"
|
||||
|
||||
|
|
@ -0,0 +1,473 @@
|
|||
; *****************
|
||||
; LLUCE v1.0
|
||||
; Copyright 1992
|
||||
; L&L Productions
|
||||
; *****************
|
||||
|
||||
; logon segment rev d - 01/31/90 - LTW
|
||||
|
||||
public start1
|
||||
|
||||
; setup node #
|
||||
|
||||
poke 2048,1
|
||||
|
||||
;on error goto error
|
||||
clear
|
||||
DEBUG
|
||||
set pa$=ram,8:set ph$=ram+8,12
|
||||
when$=ram+20:flag=ram+22
|
||||
nibble=ram+27:byte=ram+37
|
||||
|
||||
start
|
||||
close:gosub data.read
|
||||
open read #1,"system/sys.data1"
|
||||
input #1,sn$|sy$|sid$|spas$
|
||||
input #1,md$|s$|n$
|
||||
input #1,lg,fv,al:close
|
||||
|
||||
if ct$<>date$
|
||||
chain "program/maint.seg"
|
||||
|
||||
start1
|
||||
cn$=str$(c1):window=0:cls
|
||||
print @9,1 chr$(95,61)mouse$:copy
|
||||
print @22,3 "LLUCE v1.0 - The Networking Version";
|
||||
print @17,4 "(C) 1992 L&L Productions - All Rights Reserved";
|
||||
|
||||
print @ 40-(len(sn$)/2),9
|
||||
x$="Awaiting call "+cn$+" on "+fmtdate$:gosub center
|
||||
x$="This will be call "+str$(ct)+" today":gosub center
|
||||
x$="Last Caller - "+lu$:gosub center
|
||||
z$="":f$="email/feedback"
|
||||
if exist(f$)
|
||||
z$="feedback & "
|
||||
f$="email/"+sid$
|
||||
if exist(f$)
|
||||
z$=z$+"mail"
|
||||
else
|
||||
if len(z$)
|
||||
z$=left$(z$,(len(z$)-3))
|
||||
if z$=""
|
||||
z$="no mail"
|
||||
x$=sy$+" has "+z$+" waiting":gosub center
|
||||
f$="system/sys.errors"
|
||||
if exist(f$)
|
||||
{
|
||||
x$="System errors have occured"
|
||||
gosub center
|
||||
}
|
||||
x$="This is Node #"+str$(node):gosub center
|
||||
|
||||
t1$=mid$(" "+time$,2)
|
||||
modem ready
|
||||
t2$=mid$(" "+time$,2)
|
||||
li$=t2$ /* Get
|
||||
|
||||
bb=0:cls:clock clear:d=0:on nocar
|
||||
b4=val(mid$(t2$,1,2)):b5=val(mid$(t2$,4,2)):b6=val(mid$(t2$,7,2))
|
||||
a1=val(mid$(t1$,1,2)):a2=val(mid$(t1$,4,2)):a3=val(mid$(t1$,7,2))
|
||||
|
||||
if b6<a3
|
||||
{
|
||||
b3=60+(b6-a3)
|
||||
b5--
|
||||
}
|
||||
else
|
||||
b3=b6-a3
|
||||
if b5<a2
|
||||
{
|
||||
b2=60+(b5-a3)
|
||||
b4--
|
||||
}
|
||||
else
|
||||
b2=b5-a2
|
||||
b1=(b4-a1)+((b4<a1)*24)
|
||||
|
||||
cm$=date$+" "+li$:gosub data.read:i$="":if online
|
||||
print "1) Auto Logon\n"inverse$"2) Normal Logon"normal$
|
||||
print "3) System Logon\n4) Logon as a user\nWhich: ";:get i$
|
||||
if i$="1" |
|
||||
if i$="3" |
|
||||
if i$<>"4" &
|
||||
print "User Logon":input "\nUser number to log on as -> "i$:x=val(i$)
|
||||
i$="AUTO":goto autolog
|
||||
|
||||
normlog
|
||||
nc=0:print cls"Press [Return]:\a";:get i$
|
||||
if i$="\x1F":nc=1
|
||||
print cls"\n*** Welcome to "sn$" ***"
|
||||
print "\nConnected ";:if nn>1
|
||||
if online\
|
||||
print "at ["baud*300"] baud":\
|
||||
else\
|
||||
print
|
||||
setint(1):copy "system/sys.intro"
|
||||
setint(""):clear key
|
||||
|
||||
logon
|
||||
nibble(0)=width(0)-1:mode=0:width=width(nibble(0)+1)-1
|
||||
nibble(6)=3:byte(7)=0
|
||||
if ~nu goto
|
||||
print "\nEnter Mail ID (\"NEW\" if New User/\"GUEST\" for one time access)"
|
||||
un=0:input "->"i$:upper$(i$):rtrim$(i$)
|
||||
if i$="NEW" goto
|
||||
d3$=i$:gosub name.chk:if ~f
|
||||
|
||||
password
|
||||
print "\nEnter Password"
|
||||
echo="X":input "->"i$:echo=""
|
||||
print "\nVerifying your account..."
|
||||
|
||||
logon2
|
||||
i$=left$(i$+" ",8)
|
||||
autolog
|
||||
gosub rd.user:if d1$=""
|
||||
if i$=pa$ goto
|
||||
if i$="AUTO" goto
|
||||
|
||||
bad.user
|
||||
bb++
|
||||
if bb<3 print
|
||||
print "\nYou must have an account to access this system."
|
||||
print "Please call back and logon as a \"NEW\" user."
|
||||
goto start
|
||||
|
||||
; *** New User Logon ***
|
||||
|
||||
new.user
|
||||
z=0:print:copy "system/sys.newinfo1"
|
||||
new.usr1
|
||||
print "\nEnter your real full name [20 chars max]"
|
||||
input @3 "->"i$:if
|
||||
if len(i$)>20 print
|
||||
if instr(",",i$) print
|
||||
mixed$(i$):if i$="Off" goto
|
||||
d1$=i$:if z goto
|
||||
|
||||
get.aff
|
||||
print "\nEnter Company or User Group affillation [20 chars max]"
|
||||
input @3 "->"i$:if
|
||||
if len(i$)>20 print
|
||||
if instr(",",i$) print
|
||||
mixed$(i$):d2$=i$:if z goto
|
||||
|
||||
get.id
|
||||
a=instr(" ",d1$):if ~a:a=1
|
||||
print a
|
||||
x$=mid$(d1$,a):b=instr(" ",x$):if b:a=a+b
|
||||
d3$=mid$(d1$,1,1)+mid$(d1$,a)
|
||||
if len(d3$)>10:d3$=left$(d3$,10)
|
||||
get.id1
|
||||
upper$(d3$):gosub name.chk:if ~f
|
||||
a=len(d3$)
|
||||
if a>9:b=val(right$(d3$,1):d3$=left$(d3$,9)+str$(b+1):goto get.id1
|
||||
b=val(mid$(d3$,a,1):d3$=left$(d3$,a-1)+str$(b+1)
|
||||
goto get.id1
|
||||
|
||||
get.id2
|
||||
print "\nYou must select a mail ID for the system"
|
||||
get.id3
|
||||
print "\nThe system has chosen "d3$" as your ID, if you wish to"
|
||||
print "change it, please enter your new ID now. <RTN> to accept."
|
||||
input @3 "->"i$:if
|
||||
upper$(i$):i$=left$(i$+chr$(32,10),10):d3$=i$
|
||||
gosub name.chk:if (~f)
|
||||
if ~f goto
|
||||
print "\nSorry, that mail ID is in use. Try Again"
|
||||
goto get.id3
|
||||
|
||||
get.city
|
||||
print "\nCity [16 chars max]"
|
||||
input @3 "->"d4$
|
||||
if len(i$)>16 print
|
||||
mixed$(d4$)
|
||||
|
||||
get.state
|
||||
print "\nState [Form: XX]"
|
||||
input "->"d5$
|
||||
if len(d5$)<>2 print
|
||||
if z goto
|
||||
fill ram(0),60,0
|
||||
|
||||
get.phone
|
||||
print "\nPhone number [Form: ###-###-####]"
|
||||
input "->"i$
|
||||
if len(i$)<>12 goto
|
||||
ph$=left$(i$,3)+"-"+mid$(i$,5,3)+"-"+right$(i$,4)
|
||||
|
||||
chk.info
|
||||
print "\nWe have the following:\n"
|
||||
print "1) Name : "d1$
|
||||
print "2) of : "d2$
|
||||
print "3) Mail ID: "d3$
|
||||
print "4) From : "d4$", "d5$
|
||||
print "5) Phone : "ph$
|
||||
print "\nEnter # to change or \"C\" for correct :";
|
||||
get i$:if i$="Y"
|
||||
z=1:x=val(i$):if x>5:x=0
|
||||
|
||||
if x=0 goto
|
||||
if x=1 goto
|
||||
if x=2 goto
|
||||
flag(0)=0:on nocar goto
|
||||
if x=4 goto
|
||||
if x=5 goto
|
||||
|
||||
info.ok
|
||||
flag(0)=0:on nocar goto
|
||||
print "\nHold: Finding your account...";
|
||||
disk lock:gosub data.read:f$="system/sys.users"
|
||||
if (~exist(f$)) |
|
||||
y=192:z=1:overlay "findopen",d1$,f$,y,z
|
||||
if z=(-2) close:print
|
||||
if z=(-1) close:print
|
||||
if z=0:nu++:a=nu:close:goto got.user
|
||||
if z>0:a=z:close
|
||||
|
||||
got.user
|
||||
copy "system/sys.newinfo":x=0:print
|
||||
f$="system/sys.questions":if ~exist(f$) goto
|
||||
open read #1,f$
|
||||
|
||||
info
|
||||
input #1,a$:if a$="*"
|
||||
if left$(a$,1)="@" |
|
||||
print a$:goto info
|
||||
|
||||
info.1
|
||||
; input "\n-> "i$:print #9,i$
|
||||
goto info
|
||||
|
||||
info.2
|
||||
close:f$="system/temp":create f$:open write
|
||||
close:disk unlock
|
||||
print "\nWould you like to leave the Sysop a Message?";
|
||||
print " (Y/"inverse$"[N]"normal$"): ";
|
||||
get i$:if i$="Y"
|
||||
print cls"[ Enter/Edit Message Now : 4k or 4096 Bytes Maximum ]"
|
||||
print "[ Legal Commands : .A = Abort .H = Help .S = Save ]"
|
||||
edit clear:edit:if ~edit
|
||||
disk lock:open write
|
||||
|
||||
info.3
|
||||
close:edit clear:copy "system/temp",#9:kill
|
||||
info.3a
|
||||
print "\nPlease enter a password [4-8 Characters]"
|
||||
input @2 "-> "i$:if
|
||||
x=len(i$):if x<4 print
|
||||
pa$=left$(i$+chr$(32,7),8)
|
||||
print "\n\nYour Mail ID is: "d3$
|
||||
print " Password: "pa$
|
||||
print " User Number: "a /***
|
||||
print "\nPlease write them down, you will need them next time you call."
|
||||
nibble(0)=width(0):nibble(6)=3 /* video
|
||||
disk lock:when$=date$:open write
|
||||
position #1,192,a
|
||||
print #1 d3$"\n"d1$"\n"d2$"\n"d4$,d5$
|
||||
position #1,192,a,132
|
||||
write #1,ram,60:close
|
||||
|
||||
; update sys.mailnames and sys.fullnames files & sort 'em
|
||||
|
||||
f$="system/sys.mailnames":open write #1,f$
|
||||
input #1,au:au++:mark(1)=0
|
||||
print #1,au:position #1,16,au
|
||||
print #1,d3$"\n"a:close:disk unlock
|
||||
gosub data.write:sz=16:st=1
|
||||
disk lock:overlay "rndsort",f$,sz,st
|
||||
f$="system/sys.fullnames":open write #1,f$
|
||||
input #1,au:au++:mark(1)=0
|
||||
print #1,au:position #1,36,au
|
||||
print #1,d1$"\n"a:close
|
||||
sz=36:st=1:overlay "rndsort",f$,sz,st:
|
||||
|
||||
; add responses to request file
|
||||
|
||||
f$="system/request":create f$:open write
|
||||
append #1:print #1,a"\n"a$"NEW USER DATA"
|
||||
print #1,a$;d3$"\n"a$;d1$"\n"a$;d2$
|
||||
print #1,a$;d4$", "d5$"\n"a$"#"a"-"pa$
|
||||
print #1,a$;ph$"\n"a$;date$" @ "time$"\n":append #1
|
||||
copy #9,#1:append #1:print
|
||||
f$="email/"+di$:kill f$:disk unlock
|
||||
print "\nPress <return> to enter "sn$;
|
||||
|
||||
input @3 " "i$:x=a:i$=pa$:goto
|
||||
|
||||
; *** Main Logon Routine ***
|
||||
|
||||
login
|
||||
a$=date$:if lc$<>a$:nibble(5)=0:flag(36)=0:byte(7)=0
|
||||
lr=byte(5)+byte(6)*256:if lr>mn:lr=mn
|
||||
nb=lr:un=x:nulls=byte(0):b=byte(7):if flag(1):flag(0)=0
|
||||
exec=flag(34):if ~flag(1):exec=0
|
||||
if (b<(nibble(6)*10)) |
|
||||
print "\n\nDaily time limit expired. Please call back tomarrow"
|
||||
goto start
|
||||
|
||||
login1
|
||||
if exec &
|
||||
b=((nibble(6)*10)-byte(7))*60
|
||||
login1a
|
||||
clock=b:b=((clock-clock online)/60)+1
|
||||
|
||||
id$=d3$:a1$=d1$:a2$=d2$:a4$=d4$:a5$=d5$
|
||||
tc=byte(1)+nibble(1)*256:bp=byte(2)+nibble(2)*256
|
||||
dn=byte(3)+nibble(3)*256:up=byte(4)+nibble(4)*256
|
||||
ul=byte(10)*65536+byte(9)*256+byte(8)
|
||||
dl=byte(13)*65536+byte(12)*256+byte(11)
|
||||
|
||||
if (~exec) |
|
||||
|
||||
print "\nRemote Password":echo="X":input "-> "i$
|
||||
echo="":if i$<>spas$:exec=0
|
||||
|
||||
login2
|
||||
print "\nLogging you into the system\n"
|
||||
x$="Call: "+cn$+" / ID:"+a$+" / "+a1$+" of "+a4$+", "+a5$
|
||||
gosub data.write:inverse$:window=0:cls
|
||||
print #4,chr$(45,80);
|
||||
i$=chr$(32,14):a$=id$:rtrim$(a$)
|
||||
x$="Call: "+cn$+" / ID:"+a$+" / "+a1$+" of "+a4$+", "+a5$
|
||||
print #4,left$(x$+chr$(32,59),59)" Phone: "ph$;
|
||||
print #4,"TC: "left$(str$(tc)+i$,7)"#UL: "left$(str$(up)+i$,7);
|
||||
print #4,"#DL: "left$(str$(dn)+i$,7)"BU: "left$(str$(ul)+i$,7);
|
||||
print #4,"BD: "left$(str$(dl)+i$,7)"BP: "left$(str$(bp)+i$,6)"/ ";
|
||||
print #4,"Baud: "left$(str$(baud*300)+i$,5);
|
||||
print #4,"Flg: ";:for x=1
|
||||
print #4," LC:"lc$" On:"date$" "left$(time$+i$,14);
|
||||
print #4,chr$(45,80)
|
||||
window=5:normal$:cls
|
||||
|
||||
f$="system/sys.log":create f$:open write
|
||||
input #1,x:x++:if x>200:x=1
|
||||
a=clock online
|
||||
position #1,80,x:print #1,a/60,a
|
||||
position #1,80,x,10
|
||||
print #1,id$,a1$,date$" "time$,baud*300,node
|
||||
mark(1)=0:print #1,x:close
|
||||
|
||||
login3
|
||||
gosub termemul
|
||||
f$="email/"+id$:rtrim$(f$):em=exist(f$)
|
||||
print "User Name : "left$(a1$+chr$(32,20),20)" ";
|
||||
print "Last Date On : "fmtwhen$
|
||||
print "Caller Number : "left$(cn$+chr$(32,20),20)" ";
|
||||
print "Today is : "fmtdate$
|
||||
print "Caller # Today : "left$(str$(ct)+chr$(32,20),20)" ";
|
||||
print "Mail Waiting : ";:if em
|
||||
print "Terminal Emul. : "left$(i$+chr$(32,20),20)" ";
|
||||
if ~exec: print
|
||||
if ~flag(34): goto
|
||||
print "Remote Pass : ";:if exec
|
||||
if b1=0:a$=" ":
|
||||
if b1=1:a$=" "+str$(b1)+" hour ":else a$=" "+str$(b1)+" hours "
|
||||
if b2=1:b$=str$(b2)+" minute":else b$=str$(b2)+" minutes"
|
||||
c$=" and ":if b3=1:c$=c$+str$(b3)+" second":else c$=c$+str$(b3)+" seconds"
|
||||
x=len(a$+b$+c$):x$=left$(sn$+" was idle "+chr$(32,80-x),80-x):rtrim$(x$)
|
||||
x$=x$+a$+b$+c$:print "\n"chr$(32,(80-len(x$))/2);x$
|
||||
|
||||
login3x
|
||||
a$=wm$:b$=lc$:gosub ckdate
|
||||
if x=1 setint(1):print
|
||||
|
||||
a=mn-lr:if lr=0:a=tm
|
||||
bb=1:f$="bulletins/b1":if ~exist(f$) goto
|
||||
ready f$:z=msg(0):ready ""
|
||||
print "\nMain Bulletins from 1 to "z
|
||||
if a>1 print
|
||||
login3a
|
||||
if ~exec goto
|
||||
if exist("system/request") print
|
||||
|
||||
login4
|
||||
mode=nibble(0)/4:ch=1:width=width((nibble(0) % 4)+1)-1
|
||||
if exec &
|
||||
if ~em goto
|
||||
print "\nWould you like to read your mail now? ["inverse$"(Yes)"normal$",No] :";
|
||||
get i$:if i$="N"
|
||||
print "Yes":chain "program/email.seg"
|
||||
login5
|
||||
chain "program/main.seg"
|
||||
|
||||
get.guest
|
||||
d1$="Guest User":d2$="Visitor":d3$="GUEST":d4$="Unknown":d5$="XX"
|
||||
ph$="XXX-XXX-XXXX":x=0:pa$="GUEST ":flag(0)=1:lc$="NEVER "
|
||||
nibble(6)=3:goto login
|
||||
|
||||
; *** Sub - Routines ***
|
||||
|
||||
center /* Center Text
|
||||
print @ 40-(len(x$)/2)
|
||||
|
||||
rd.user /* read a
|
||||
open read #1,"system/sys.users"
|
||||
position #1,192,x
|
||||
input #1,d3$|d1$|d2$|d4$,d5$
|
||||
position #1,192,x,132
|
||||
read #1,ram,60:lc$=when$
|
||||
close #1
|
||||
return
|
||||
|
||||
termemul
|
||||
inverse$="":normal="":i$="None"
|
||||
if ~online:i$="Local":return
|
||||
y=byte(14):if (y<1) |
|
||||
if y=1:i$="Datamedia 1500":inverse$="\xF":normal$="\xE":clrscn$="\xC"
|
||||
if y=2:i$="Dec VT-52":inverse$="\x19":normal$="\x1F":clrscn$="\xC"
|
||||
if y=3:i$="IBM 3101":inverse$="\x1B19":normal$="\x1B1F":clrscn$="\x1BK"
|
||||
if y=4:i$="Hazeltine 1500":inverse$="~\x19":normal$="~\x1F":clrscn$="~\x1A"
|
||||
if y=5:i$="Heathkit H-19":inverse$="\x1Bp":normal$="\x1Bq":clrscn$="\x1B\E"
|
||||
; NOTE, \E avoids the E being counted as hex
|
||||
if y=6:i$="Soroc":inverse$="\x1B)":normal$="\x1B(":clrscn$="\x1B*"
|
||||
if y=7:i$="Adm3a":inverse$="\x19":normal$="\x1F":clrscn$="\x1A"
|
||||
if y=8:i$="Televideo 912":inverse$="\x1Bl":normal$="\x1Bm":clrscn$="\x1B1A"
|
||||
return
|
||||
|
||||
; check tree file for valid mail ID
|
||||
|
||||
name.chk
|
||||
a$=d3$:rtrim$(a$):open read #1,"system/sys.mailnames":t=nu:b=0:f=0
|
||||
name1
|
||||
l=t-((t-b)/2):position #1,16,l:input #1,i$:upper$(i$)
|
||||
rtrim$(i$):if a$=i$:f=1:input #1,x:close
|
||||
if a$<i$:t=l-1:else b=l
|
||||
if b<t goto
|
||||
close #1:open read
|
||||
name2
|
||||
l=t-((t-b)/2):position #1,36,l:input #1,i$:upper$(i$)
|
||||
rtrim$(i$):if a$=i$:f=1:input #1,x:close
|
||||
if a$<i$:t=l-1:else b=l
|
||||
if b<t goto
|
||||
close #1:return
|
||||
|
||||
; compare two dates and return x=1 if first is after second
|
||||
|
||||
ckdate
|
||||
if val(mid$(b$,7,2))<val(mid$(a$,7,2):x=1:return
|
||||
if val(mid$(b$,7,2))>val(mid$(a$,7,2):x=0:return
|
||||
if val(mid$(b$,1,2))<val(mid$(a$,1,2):x=1:return
|
||||
if val(mid$(b$,1,2))>val(mid$(a$,1,2):x=0:return
|
||||
if val(mid$(b$,4,2))>val(mid$(a$,4,2):x=0:return
|
||||
x=1:return
|
||||
|
||||
data.read /* read current
|
||||
disk lock:open read
|
||||
input #1,c1,ct,ct$,wm$
|
||||
input #1,nu,mn,tm,nn|lu$
|
||||
close:disk unlock:return
|
||||
|
||||
data.write /* write current
|
||||
disk lock:open write
|
||||
print #1,c1,ct,ct$,wm$
|
||||
print #1,nu,mn,tm,nn"\n"lu$
|
||||
close:disk unlock:return
|
||||
|
||||
error /* report error
|
||||
print "\nUnable to recover from error, call again later"
|
||||
modem nocar:disk lock:close:create
|
||||
open write #1,"system/sys.errors":append
|
||||
print #1,"Error #"err" occured at "time$" on "fmtdate$" in logon.seg"
|
||||
close:disk unlock:goto start
|
||||
|
||||
|
|
@ -0,0 +1,295 @@
|
|||
; *********************
|
||||
; LLUCE v1.0
|
||||
; Copyright 1989
|
||||
; L&L Productions, Inc.
|
||||
; *********************
|
||||
|
||||
; main segment rev a - 01/14/88
|
||||
; main segment rev b - 08/08/89
|
||||
; main segment rev c - 11/14/89 - LPT
|
||||
; main segmetn rev d - 05/01/90 - LPT
|
||||
|
||||
public otherseg
|
||||
public return
|
||||
public term1
|
||||
|
||||
; Set No Carrier and On Error Vector
|
||||
|
||||
on nocar goto
|
||||
; on error goto error
|
||||
a1=0:if flag(0) goto
|
||||
|
||||
; Check for force voting
|
||||
|
||||
if fv chain
|
||||
|
||||
otherseg
|
||||
on nocar goto
|
||||
; on error goto error
|
||||
|
||||
main
|
||||
gosub time:print "\n[("x$")] Main Level [?=Menu] Function :";
|
||||
main1
|
||||
get i$
|
||||
main2
|
||||
clear gosub:push main
|
||||
if i$="?" |
|
||||
if left$(i$,1)="B" print
|
||||
if left$(i$,1)="J" print
|
||||
if i$="E" print
|
||||
if i$="C" print
|
||||
if i$="F" print
|
||||
if i$="T" print
|
||||
if i$="N" print
|
||||
if i$="H" print
|
||||
if i$="D" print
|
||||
if i$="I" print
|
||||
if i$="S" print
|
||||
if i$="%" &
|
||||
|
||||
; If user is not validated, or the sysop is not in Executive Mode
|
||||
; check to see if command is legal and return to main
|
||||
|
||||
if (~flag(1)) &
|
||||
|
||||
; All commands below this line are for validated users
|
||||
|
||||
if i$="G" print
|
||||
if i$="Q" print
|
||||
if i$="L" print
|
||||
if i$="U" print
|
||||
if i$="X" print
|
||||
print "\nTransfer Section Still under Construction.":\
|
||||
return /*:pop:chain "program/supertac"*/
|
||||
if i$="V" print
|
||||
|
||||
main3
|
||||
if val(i$)<33 pop:goto
|
||||
a1++:print "\n\""i$"\" is not a command":if a1<3
|
||||
|
||||
; *** sub - routines ***
|
||||
|
||||
menu
|
||||
a1=0:f$="system/mnu.new":if ~flag(1) goto
|
||||
if width<79:f$="system/mnu.val.40":else f$="system/mnu.val.80"
|
||||
menu.1
|
||||
if ~exist(f$) goto
|
||||
disk lock
|
||||
open #1,f$:input #1,x$:setint(" "):addint(x$)
|
||||
cls:copy #1:if key
|
||||
a=key:close:disk unlock:setint(""):pop:goto main
|
||||
menu.key
|
||||
close:setint(""):a=key:i$=chr$(a):upper(i$)
|
||||
if i$=" " goto
|
||||
print "\n[("x$")] Main Level [?=More] Function :"
|
||||
goto main2
|
||||
|
||||
; terminate from system and recycle
|
||||
|
||||
terminate
|
||||
print "\nTerminate From "sn$
|
||||
print "\nAre You Sure ["inverse$"(Yes)"normal$",No] :";
|
||||
get i$:if i$="N"
|
||||
print "Yes"
|
||||
|
||||
term1
|
||||
on nocar:
|
||||
print "\nLog Out : "a1$" of "a4$", "a5$"."
|
||||
print "Caller #: "cn$"\n"
|
||||
print sn$ " - log out at "fmtdate$" "time$
|
||||
a=clock online:lo$=time$
|
||||
if a print
|
||||
close:modem nocar:if a1$=""
|
||||
if ~un goto
|
||||
|
||||
nibble(5)++:byte(0)=nulls:tc++
|
||||
byte(1)=tc % 256:nibble(1)=tc/256
|
||||
byte(2)=bp % 256:nibble(2)=bp/256
|
||||
byte(3)=dn % 256:nibble(3)=dn/256
|
||||
byte(4)=up % 256:nibble(4)=up/256
|
||||
byte(7)+=(clock online/60):when$="x"
|
||||
byte(10)=ul/65536:a=ul % 65536
|
||||
byte(9)=a/256:byte(8)=a % 256
|
||||
byte(13)=dl/65536:a=dl % 65536
|
||||
byte(12)=a/256:byte(11)=a % 256
|
||||
|
||||
disk lock:open #1,"system/sys.users":position
|
||||
print #1,id$"\n"a1$"\n"a2$"\n"a4$,a5$
|
||||
position #1,192,un,132
|
||||
write #1,ram,60:close
|
||||
kill "system/batch"
|
||||
|
||||
termin3
|
||||
gosub data.read:da$=date$:rtrim$(id$):lu$=a1$+ " ["+id$+"]":gosub
|
||||
f$="system/sys.log":if ~exist(f$) goto
|
||||
disk lock:open #1,f$:input
|
||||
a=clock online:print #1,a/60,a
|
||||
close:disk unlock
|
||||
|
||||
termin4
|
||||
disk unlock:chain "program/logon.seg2"
|
||||
|
||||
; chat with sysop
|
||||
|
||||
chat
|
||||
if ch>5 print
|
||||
if ch>4 print
|
||||
if ch>3 print
|
||||
print "\nPaging "sy$" : ";:tone(100,100,100)
|
||||
if flag(2) tone(125,100,100):tone(150,100,100)
|
||||
print "Please Continue...":set msg=1:ch++:return
|
||||
|
||||
; feedback to sysop
|
||||
|
||||
feedback
|
||||
print cls"Feedback To "sy$
|
||||
input @3 "\nSubject -> "sb$:if
|
||||
ready "":f$="email/feedback"
|
||||
gosub editor:if ~edit
|
||||
print "\nRegistered Mail? [Yes,"inverse$"(No)"normal$"] :";
|
||||
get i$:if i$="Y"
|
||||
rg=(i$="Y"):sb$=left$(sb$,25)
|
||||
if rg:st$="Registered Mail":else st$="Awaiting Reply"
|
||||
print "\nSending "edit size" bytes...";
|
||||
if ~exist(f$) close:create
|
||||
ready f$:if msg(0)=64
|
||||
a=msg(0)+1:a$=id$:rtrim$(a$)
|
||||
print #msg(a),date$" "time$"\n"a$" ("a1$")",un"\n"st$"\n"sb$"\n"rg
|
||||
copy #9,#7:msg(a)=a:flush:ready "":print
|
||||
return
|
||||
|
||||
feed2
|
||||
ready f$:if ~msg(0)
|
||||
ready "":return
|
||||
|
||||
; general files
|
||||
|
||||
general
|
||||
disk lock:a$="gfiles/"+a$
|
||||
if ~exist(a$) print
|
||||
open #1,a$:input #1,x:print
|
||||
general2
|
||||
print "\nGeneral Files: Which 1-"x" (?=Menu,<CR>) -> ";
|
||||
input @3 i$:if
|
||||
if i$="?" goto
|
||||
a=val(i$):if (~a) |
|
||||
f$=a$+"."+str$(a):gosub show.file:goto general2
|
||||
|
||||
; show log of calls
|
||||
|
||||
showlog
|
||||
f$="system/sys.log"
|
||||
if ~exist(f$) print
|
||||
print "\n # Mail ID Name Called Baud";
|
||||
print " Online";:if nn
|
||||
print chr$(45,79):disk lock
|
||||
open #1,f$:input #1,x:y=x:z=1
|
||||
shlog1
|
||||
position #1,80,x:if eof(1)
|
||||
input #1,f$,g$
|
||||
position #1,80,x,10
|
||||
input #1,a$,b$,c$,d$,e$
|
||||
setint(1):print right$("00"+str$(z),3)" "left$(a$+chr$(46,10),10)" ";
|
||||
print left$(b$+chr$(46,21),21)" "left$(c$+chr$(32,10),20)" ";
|
||||
if d$="0":d$="LOCAL":else d$="0"+d$
|
||||
print d$" "right$("0"+f$,2)":"right$("0"+g$,2);
|
||||
if nn print
|
||||
if key flag:x=y+1
|
||||
x--:z++:if x=0:x=200
|
||||
if x<>y goto
|
||||
shlog3
|
||||
close:setint(""):disk unlock:return
|
||||
|
||||
; conference area
|
||||
|
||||
conference
|
||||
cn=1:if len(i$)<2 goto
|
||||
a=val(mid$(i$,2)):if a:cn=a
|
||||
link.conf
|
||||
; print "cn="cn:chain "program/conf.seg","conference"
|
||||
print "cn="cn:chain "program/msg.seg","bulletins"
|
||||
|
||||
dispatch
|
||||
y$="program/main.seg" /* segment
|
||||
z$="otherseg" /* label
|
||||
chain "program/util.seg"
|
||||
|
||||
return
|
||||
on nocar goto
|
||||
; on error goto error
|
||||
return
|
||||
|
||||
; *** sub - routines ***
|
||||
|
||||
; show a disk file
|
||||
|
||||
show.file
|
||||
if ~exist(f$) return
|
||||
setint(1):print "\n"s$"\n":open #1,f$
|
||||
showfl2
|
||||
copy (20) #1
|
||||
if eof(1) |
|
||||
if ~flag(35) goto
|
||||
print "Press "inverse$"[RETURN]"normal$": ";:get i$
|
||||
print chr$(8,17);chr$(0x20,17);chr$(8,17);
|
||||
if i$=" " setint(""):close
|
||||
setint(1):goto showfl2
|
||||
|
||||
; get time remaining before logoff
|
||||
|
||||
time
|
||||
x=(clock-clock online)/60:y=clock:x$=right$("00"+str$(x),3)
|
||||
if clock online>clock:x$="!!"
|
||||
if x=0:x$="--"
|
||||
if ~y:x$="**"
|
||||
if exec:x$="::"
|
||||
return
|
||||
|
||||
; editor for feedback
|
||||
|
||||
editor
|
||||
print cls"[ Enter/Edit Message Now : 4k or 4096 Bytes Maximum ]"
|
||||
print "[ Legal Commands : .A = Abort .H = Help .S = Save ]"
|
||||
edit2
|
||||
cl=clock:clock=0:edit clear:edit:clock=cl:return
|
||||
|
||||
; check date to another date
|
||||
|
||||
check.date
|
||||
if val(mid$(d$,7,2))>val(mid$(lc$,7,2)):d=1:return
|
||||
if val(mid$(d$,7,2))<val(mid$(lc$,7,2)):d=0:return
|
||||
if val(mid$(d$,1,2))>val(mid$(lc$,1,2)):d=1:return
|
||||
if val(mid$(d$,1,2))<val(mid$(lc$,1,2)):d=0:return
|
||||
if val(mid$(d$,4,2))>=val(mid$(lc$,4,2)):d=1:return
|
||||
if val(mid$(d$,4,2))<val(mid$(lc$,4,2)):d=0:return
|
||||
d=0:return
|
||||
|
||||
chngdt
|
||||
print chr$(8,8);:input @2
|
||||
if i$="" return
|
||||
if len(i$)<>8 return
|
||||
if mid$(i$,3,1)<>"/" |
|
||||
a=val(mid$(i$,1,2)):if (a<1) |
|
||||
a=val(mid$(i$,4,2)):if (a<1) |
|
||||
a=val(mid$(i$,7,2)):if (a<1) |
|
||||
lc$=i$:return
|
||||
|
||||
data.read /* read current
|
||||
disk lock:open #1,"system/sys.data"
|
||||
input #1,c1,ct,ct$,wm$
|
||||
input #1,nu,mn,tm,nn|lu$
|
||||
close:disk unlock:return
|
||||
|
||||
data.write /* write current
|
||||
disk lock:open #1,"system/sys.data"
|
||||
print #1,c1,ct,ct$,wm$
|
||||
print #1,nu,mn,tm,nn"\n"lu$
|
||||
close:disk unlock:return
|
||||
|
||||
error /* print error
|
||||
print "One moment please, returning you to the Main Level."
|
||||
disk lock:close:clear gosub:create
|
||||
open #1,"system/sys.errors":append #1
|
||||
print #1,"Error #"err" occured at "time$" on "date$" in main.seg"
|
||||
close:disk unlock:goto main
|
||||
|
||||
|
|
@ -0,0 +1,179 @@
|
|||
; **********************
|
||||
; GBBS "Pro" V:1.4
|
||||
; By L & L Productions
|
||||
; Copyright 1987
|
||||
; **********************
|
||||
|
||||
; maintenance segment rev a - 1/14/88
|
||||
|
||||
public userlist
|
||||
|
||||
cls:kill "system/sys.maintenance"
|
||||
f$="system/idl.node"+str$(node):create f$
|
||||
z=0:for x=1 to nn:f$="system/idl.node"+str$(x)
|
||||
if ~exist(f$):z=1
|
||||
next x:if ~z goto start
|
||||
|
||||
; print node"\n"z"\n"x
|
||||
; get i$
|
||||
goto start
|
||||
|
||||
x$=inverse$+"DO NOT INTERRUPT"+normal$
|
||||
print @(40-len(x$)/2),10 x$
|
||||
x$="This node is idle until all maintenance for the night"
|
||||
print @(40-len(x$)/2),20 x$
|
||||
x$="has been completed"
|
||||
print @(40-len(x$)/2),21 x$
|
||||
|
||||
f$="system/sys.maintenance"
|
||||
wait
|
||||
if exist(f$):for x=1 to 1000*node:next x:goto finish
|
||||
for x=1 to 5000*node:next x:goto wait
|
||||
|
||||
start
|
||||
; gosub boards
|
||||
if mid$(ct$,4,2)="01" gosub purge
|
||||
create "system/sys.maintenance"
|
||||
|
||||
finish
|
||||
cls:ct=1:ct$=da$:gosub data.write
|
||||
for x=1 to nn:f$="system/idl.node"+str$(x):kill f$:next x
|
||||
; poke 2053,77
|
||||
chain "program/logon.seg2","start1"
|
||||
|
||||
filebkup
|
||||
print " Now making data file backups"
|
||||
kill "system2/sys.data.bk":kill "system2/sys.data1.bk"
|
||||
kill "system2/sys.users.bk"
|
||||
f$="system/sys.data":f2$="system2/sys.data.bk":gosub copy
|
||||
f$="system/sys.data1":f2$="system2/sys.data1.bk":gosub copy
|
||||
f$="system/sys.users":f2$="system2/sys.users.bk":gosub copy
|
||||
print "Done with file backups"
|
||||
return
|
||||
|
||||
boards
|
||||
print "\nDaily message maintenance now executing"
|
||||
open #1,"system/sys.data2":mark(1)=1120:input #1,ab
|
||||
print "Working on Board #";:for x=1 to ab:print x;
|
||||
position #1,128,x+8:input #1,bn$|bf$|b3,b4|bs,bs$|mb,kl,kb
|
||||
ready bf$
|
||||
brd.1
|
||||
if msg(0)>mb kill #msg(kb):crunch:goto brd.1
|
||||
print chr$(8,len(str$(x)));:next x
|
||||
return
|
||||
|
||||
; purge users from system...once a month
|
||||
|
||||
purge
|
||||
return
|
||||
|
||||
; print a list of systems users
|
||||
|
||||
userlist
|
||||
gosub time
|
||||
print "\n["x$"][User List] Option (?=Help): ";
|
||||
user1
|
||||
get i$
|
||||
user2
|
||||
clear gosub:push userlist
|
||||
y=32
|
||||
if i$="1" print "Name":a=1:f$="system/srt.name":goto user3
|
||||
if i$="2" print "User":a=2:f$="system/srt.num":goto user3
|
||||
if i$="3" print "Pass":a=3:f$="system/srt.pw":y=64:goto user3
|
||||
if i$="4" print "Phone":a=4:f$="system/srt.ph":y=64:goto user3
|
||||
if i$="5" print "Date":a=5:f$="system/srt.date":y=64:goto user3
|
||||
if i$="6" print "Security":a=6:f$="system/srt.sec":y=64:goto user3
|
||||
if i$="7" print "Exit":pop:chain "program/system.seg"
|
||||
if i$="?" or i$="/" print "Menu":goto usermenu
|
||||
if i$="\n" or i$=" " goto user1
|
||||
a1++:print "\n"pr$"\""i$"\" is not a command":if a1<3 return
|
||||
|
||||
usermenu
|
||||
print cls'
|
||||
1) Print list sorted by name
|
||||
2) Print list sorted by user number
|
||||
3) Print list sorted by password
|
||||
4) Print list sorted by phone number
|
||||
5) Print list sorted by last date on
|
||||
6) Print list sorted by security level
|
||||
7) Return to main menu':return
|
||||
|
||||
user3
|
||||
print "\nShow passwords? (Y/"inverse$"[N]"normal$"): ";:get i$
|
||||
if i$="Y" print "Yes":pa=1:else print "No":pa=0
|
||||
print "\nOutput to printer? (Y/"inverse$"[N]"normal$"): ";:get i$
|
||||
if i$="Y" print "Yes":s=6:nl=58:else print "No":s=0:nl=15
|
||||
move ram,58 to ram2:on nocar goto user9
|
||||
z=1:print cls"\n":open #2,f$:if mark(2)=0 goto user5
|
||||
close:print "Reading data..."
|
||||
open #1,"system/users":kill f$:create f$:open #2,f$
|
||||
for l=1 to nu:position #1,192,l:input #1,d1$|d2$|d3$,d4$
|
||||
position #1,192,l,132:read #1,ram,60:t$="":if d1$="" goto user4
|
||||
t$=d2$+" "+d1$
|
||||
if a=2:t$=right$(" "+str$(l),4)
|
||||
if a=3:t$=mid$(" "+pa$+" ",2,8)+t$
|
||||
if a=4:i$=right$(chr$(32,12)+ph$,12)
|
||||
if a=4:t$=left$(i$,3)+"-"+mid$(i$,5,3)+"-"+right$(i$,4)+t$
|
||||
if a=5:t$=right$(when$,2)+"/"+left$(when$,5)+t$
|
||||
if a=6:i$="":for x=1 to 34:i$=i$+str$(flag(x)):next x:t$=i$+t$
|
||||
position #2,y,z:print #2,t$"\n"l:z++
|
||||
user4
|
||||
next l
|
||||
user5
|
||||
close:z=1:print "Sorting...";:overlay "rndsort.128",f$,y,z
|
||||
print "Printing...":z=1:open #2,f$:open #1,"system/users":ln=1:r=0
|
||||
user6
|
||||
position #2,y,z:input #2,t$|l:if t$="" goto user8
|
||||
position #1,192,l:input #1,d1$|d2$|d3$,d4$
|
||||
position #1,128,l,132:read #1,ram,60
|
||||
setint(1):if ln<>1 goto user7
|
||||
if r & (s=0) print "Press any key to continue..:";:get i$
|
||||
if r print #s,sc$;
|
||||
print #s,"\n** LLUCE Userlist - Version 1.0 - List Sorted By: ";
|
||||
if a=1 print #s,"User Name ";
|
||||
if a=2 print #s,"User Number ";
|
||||
if a=3 print #s,"Password ";
|
||||
if a=4 print #s,"Phone Number ";
|
||||
if a=5 print #s,"Last Date on ";
|
||||
if a=6 print #s,"Security level";
|
||||
r=1:print #s,' **
|
||||
[Name] [Phone] [User] [Pass] [Sec] [Last] [Time]
|
||||
[Alias] [Number] [Numb] [Word] [Lvl] [Call] [Limit]'
|
||||
print #s,""
|
||||
user7
|
||||
print #s,left$(d3$+chr$(32,25),25);ph$;right$(" "+str$(l),6)"-";
|
||||
if pa print #s,pa$;:else print #s,"********";
|
||||
print #s," ";:for x=1 to 8:print #s,flag(x);:next x
|
||||
print #s," "when$;right$(" "+str$(nibble(5)*10),4)
|
||||
z++:ln=ln+1:if ln>nl:ln=1
|
||||
if (mm=2) & (key=0x1B):mm=0
|
||||
if key flag=0 goto user6
|
||||
user8
|
||||
close:setint("")
|
||||
if s=0 print "\n"pr$"Press any key to continue..:";:get i$
|
||||
print #s,sc$;:move ram2,58 to ram:chain "program/system.seg"
|
||||
user9
|
||||
move ram2,58 to ram:close:setint("")
|
||||
chain "program/main.seg","term1"
|
||||
|
||||
; read data file
|
||||
|
||||
data.read
|
||||
open #1,"system/sys.data"
|
||||
input #1,c1,ct,ct$,da$,wm$
|
||||
input #1,nu,mn,tm,nn|lu$
|
||||
close:return
|
||||
|
||||
; write data file
|
||||
|
||||
data.write
|
||||
open #1,"system/sys.data"
|
||||
print #1,c1,ct,ct$,da$,wm$
|
||||
print #1,nu,mn,tm,nn"\n"lu$
|
||||
close:return
|
||||
|
||||
; copy a file to another
|
||||
|
||||
copy
|
||||
time
|
||||
return
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue