8bitfiles.net/archives/archives.tar/archives/genie-commodore-file-library/Information/ML-SOURCE

Commodore BASIC | 2019-04-13 | 4.6 KB | 192 lines

50 SYS700
75 .OPT P,OO
80 ;****************
81 ;*              *
82 ;*  LYLE GIESE  *
83 ;*  VERSION 1.0 *
84 ;*   06/21/86   *
85 ;*              *
86 ;****************
120 READST = $FFB7
130 SETLFS = $FFBA
140 SETNAM = $FFBD
150 OPEN   = $FFC0
160 CLOSE  = $FFC3
170 CHKIN  = $FFC6
180 CHKOUT = $FFC9
190 CLRCHN = $FFCC
200 CHRIN  = $FFCF
210 CHROUT = $FFD2
220 GETIN  = $FFE4
230 CLALL  = $FFE7
300 INDEX  = $FB
310 FNAM   = $033C;USING CASSETTE BUFFER TO STORE FILENAMES
320 FLEN   = $FD;FOR LENGTH OF FILENAME
330 OUTFILE = $FE
340 RTEMP  = $03FF
350 ATEMP  = $03FE
360 PDEV   = $03FD
370 SHFLAG = $028D
380 HIGH   = $03FC
390 LOW    = $03FB
490 *= $C000
500 ;SET UP SCREEN
510 START LDA #$00;MAKE BORDER AND BACKGROUND BLACK
520 STA $D020
530 STA $D021
540 LDA #$07;MAKE THE CHARACTERS YELLOW
550 STA $0286
555 ;SEND FIRST MESSAGE TO SCREEN
560 LDA #<AMESS
570 STA INDEX
580 LDA #>AMESS
590 STA INDEX+1
600 JSR MESSOUT;SEND MESSAGE TO SCREEN
610 ;GET FILENAME FOR DISK READ
620 LDA #<FNAM;LOAD INDEX WITH LOCATION FOR FILENAME
630 STA INDEX
640 LDA #>FNAM
650 STA INDEX+1
660 LDA #$00
670 STA FLEN
680 JSR CLRCHN;MAKE SURE SCREEN AND KEYBOARD IS ACTIVE
690 NOKEY JSR GETIN;GET A CHAR FROM THE KEYBUF
700 BEQ NOKEY;IF NOTHING IS IN KEYBUF A REG WILL HOLD A ZERO
710 CMP #$14;CK FOR DELETE KEY
720 BNE CKRT
730 LDA FLEN;BEFORE DELETING MAKE SURE THAT THERE
740 BEQ NOKEY;IS A CHAR IN FNAM
750 LDA #$14;DELETE CHAR ON SCREEN
760 JSR CHROUT
770 DEC FLEN
780 JMP NOKEY
790 CKRT CMP #$0D;CK FOR RETURN TO EITHER EXIT PROGRAM
800 BNE VALKEY;OR OPEN DISK FILE
810 LDA FLEN;CK NUMBER OF CHAR IN KEYBUF
820 BNE DOPEN;IF ANY CHARS THEN OPEN DISK FILE
830 RTS;IF RETURN PRESSED WITH NO CHAR IN KEYBUF THEN EXIT ROUTINE
840 VALKEY LDY FLEN;LOAD Y REG WITH FLEN
850 CPY #$12;CK FOR MAX CHAR ALLOWABLE
860 BEQ NOKEY
870 STA (INDEX),Y;STORE IN FNAM BUFFER
880 JSR CHROUT;AND ECHO CHAR TO SCREEN
890 INC FLEN;INC FLEN POINTER
900 JMP NOKEY
910 DOPEN LDY FLEN;ADD ,S TO FNAM
920 LDA #","
930 STA (INDEX),Y
940 INY
950 LDA #"S"
960 STA (INDEX),Y
970 INY
980 STY FLEN
1000 ;OPEN CHANNELS TO DISK DRIVE
1010 LDA #$00;FIRST COMMAND CHANNEL
1020 JSR SETNAM;NO FILE NAME NEEDED HERE
1030 LDA #$0F;OPEN15,8,15
1040 LDX #$08
1050 LDY #$0F
1060 JSR SETLFS;OPEN LOGICAL FILE
1070 JSR OPEN;COMMAND CHANNEL OPENED
1080 BCC ROPEN;CK IF OPEN WAS OK
1090 JMP DERROR;COULD NOT OPEN CHANNEL
1100 ROPEN LDA FLEN;GET LENGTH OF FILENAME
1110 LDX #<FNAM
1120 LDY #>FNAM
1130 JSR SETNAM
1140 LDA #$08
1150 LDX #$08
1160 LDY #$00
1170 JSR SETLFS
1180 JSR OPEN;OPEN8,8,8,"FNAM,S"
1190 BCC CKERROR
1200 JMP DERROR;COULD NOT OPEN READ FILE
1210 CKERROR JSR RERROR;CK ERROR CHAN ON DISK DRIVE
3000 DERROR JSR CLRCHN;MAKE SURE I/O INITIALIZED
3010 JSR CLALL;MAKE SURE ALL OPEN CHANNELS ARE CLOSED
3020 LDA #<CMESS;UNABLE TO OPEN ERROR CHAN
3030 STA INDEX
3040 LDA #>CMESS
3050 STA INDEX
3060 JSR MESSOUT
3070 RTS;THIS ERROR IS FATAL AND WE DON'T WANT TO TRY AGAIN
4000 RERROR LDX #$0F;READ AND CK DISK ERROR CHAN
4010 JSR CHKIN
4020 NULL JSR GETIN
4030 BEQ NULL
4040 STA HIGH
4050 JSR GETIN
4060 STA LOW
4070 CMP #$30;IF FIRST TWO CHARS ARE
4080 BNE CK;ASCII ZERO AND ZERO
4090 LDA HIGH;THEN NO ERROR OCCURED
4100 CMP #$30;
4110 BEQ EMPTY;REMOVE THE ENTIRE ERROR MESSAGE
4120 CK LDA #$0D;IF NOT THEN PRINT ERROR
4130 JSR CHROUT;ERROR MESSAGE
4140 LDA HIGH
4150 JSR CHROUT
4160 LDA LOW
4170 REPEAT JSR CHROUT
4180 JSR GETIN
4190 CMP #$0D
4200 BNE REPEAT
4210 PLA:PLA;REMOVE RETURN ADDRESS FROM STACK
4220 JSR CLRCHN
4230 LDA #$08:JSR CLOSE
4240 LDA #$0F:JSR CLOSE;CLOSE DISK CHAN
4250 LDA #<EMESS
4260 STA INDEX
4270 LDA #>EMESS
4280 STA INDEX+1
4290 JSR MESSOUT
4300 NCR JSR GETIN
4310 CMP #$0D
4320 BNE NCR
4330 JMP START
4340 EMPTY JSR GETIN;NO DISK ERROR BUT
4350 CMP #$0D;SHOULD STILL READ THE ENTIRE
4360 BNE EMPTY;MESSAGE OUT OF ERROR CHAN
4370 JSR CLRCHN
4380 RTS
5000 MESSOUT LDY #$00;SEND MESSAGE TO SCREEN
5010 LPY LDA (INDEX),Y;INDEX POINTS TO START OF MESSAGE
5020 BEQ END;AND IT MUST END WITH A ZERO BYTE
5030 JSR CHROUT
5040 INY
5050 BNE LPY;HAS Y LOOPED AROUND TO ZERO
5060 INC INDEX+1;IF IT HAS WE MUST INC
5070 JMP LPY;THE HI BYTE OF OUR INDEX ADDRESS
5080 END RTS
7000 AMESS =*;OPENING MESSAGE
7010 .BYTE $93;CLEAR/HOME
7020 .BYTE $0D,$0D,$0D,$0E
7030 .ASC "         [211][197][209][213][197][206][212][201][193][204] [198][201][204][197] [210][197][193][196][197][210]"
7040 .BYTE $0D,$0D
7050 .ASC "             [194]Y [204]YLE [199]IESE"
7060 .BYTE $0D,$0D
7070 .ASC " [213]SE THE [211]HIFT AND [211]HIFT [204]OCK TO PAUSE
7080 .BYTE $0D
7090 .[198] " LISTING. (null)RESS THE LENTRL AND (null)HIFT TO"
7100 .BYTE $0D
7110 .[198] " EXIT CURRENT FILE. (null)O EXIT JUST"
7120 .BYTE $0D
7130 .[198] " HIT RETURNWAIT AT THE ASCILENAME > PROMPT."
7140 .BYTE $0D,$0D
7150 .[198] " ASCILENAME > "
7160 .BYTE $00
7300 CMESS [178][172];UNABLE [164] [159] ERR[176] CHANNEL [164] DISK DRIVE
7310 .BYTE $0D
7320 .[198] " (null)NABLE TO OPEN ERROR CHANNEL TO DISK
7330 .BYTE $0D
7340 .ASC " DRIVE. [212]RY AGAIN LATER!"
7350 .BYTE $0D,$00
7400 DMESS =*;DISK ERROR TRYING TO OPEN READ CHANNEL
7410 .BYTE $0D
7420 .ASC "  [196][201][211][203] [197][210][210][207][210] [146]"
7430 .BYTE $0D,$00
7500 EMESS =*;END OF FILE
7510 .BYTE $0D
7520 .ASC "  [208]RESS RETURN TO CONTINUE [146] "
7530 .BYTE $0D,$00