0100 .OPT NOLIST 0110 COLOR4 = $02C8 0120 ICCMD = $0342 0130 ICSTA = $0343 0140 ICBAL = $0344 0150 ICBAH = $0345 0160 ICBLL = $0348 0170 ICBLH = $0349 0180 ICAX1 = $034A 0190 ICAX2 = $034B 0200 CIOV = $E456 0210 ; 0220 ;SET STARTING ADDRESS 0230 ; 0240 *= $6000 0250 ; 0260 ;NOW OPEN KEYBOARD FOR INPUT 0270 ; 0280 CLD ;BINARY MODE! 0290 LDX #$10 ;IOCB #1 0300 LDA #$03 ;SET FOR... 0310 STA ICCMD,X ;OPEN COMMAND 0320 LDA #KEYBD/256 ;POINT TO... 0330 STA ICBAH,X ;K: TEXT... 0340 LDA #KEYBD&255 ;FOR OPEN... 0350 STA ICBAL,X ;OPERATION 0360 LDA #$04 ;SET FILE... 0370 STA ICAX1,X ;FOR INPUT 0380 LDA #$00 ;AND CLEAR... 0390 STA ICAX2,X ;ICAX2! 0400 JSR CIOV ;OPEN THE KEYBD! 0410 BMI OPNERR ;BRANCH IF ERR! 0420 ; 0430 ;KEYBOARD'S OPEN, PRINT PROMPT! 0440 ; 0450 LDX #$00 ;IOCB #0 (SCREEN) 0460 LDA #$09 ;SET COMMAND... 0470 STA ICCMD,X ;FOR PUT RECORD 0480 LDA #PROMPT/256 ;POINT TO... 0490 STA ICBAH,X ;STARTING... 0500 LDA #PROMPT&255 ;PROMPT... 0510 STA ICBAL,X ;MESSAGE 0520 LDA #$FF ;SET FOR... 0530 STA ICBLL,X ;MAXIMUM TEXT... 0540 STA ICBLH,X ;LENGTH 0550 JSR CIOV ;PRINT IT! 0560 BMI PRTERR ;BRANCH IF ERROR 0570 ; 0580 ;NOW ACCEPT A STRING FROM KEYBD 0590 ; 0600 GETTXT LDX #$10 ;IOCB #1 (KEYBD) 0610 LDA #$05 ;SET UP... 0620 STA ICCMD,X ;GET RECORD CMD 0630 LDA #INBUF/256 ;POINT TO... 0640 STA ICBAH,X ;THE TEXT... 0650 LDA #INBUF&255 ;INPUT... 0660 STA ICBAL,X ;BUFFER 0670 LDA #40 ;ALLOW MAXIMUM... 0680 STA ICBLL,X ;OF 40 BYTES... 0690 LDA #0 ;ON THE... 0700 STA ICBLH,X ;INPUT OPERATION 0710 JSR CIOV ;GET TEXT! 0720 BMI GETERR ;OOPS! 0730 ; 0740 ;NOW REPEAT IT BACK TO USER! 0750 ; 0760 LDX #$00 ;IOCB #0 (SCREEN) 0770 LDA #$09 ;SET UP FOR... 0780 STA ICCMD,X ;PUT RECORD 0790 LDA #INBUF/256 ;POINT TO THE... 0800 STA ICBAH,X ;TEXT THE... 0810 LDA #INBUF&255 ;USER JUST... 0820 STA ICBAL,X ;TYPED IN 0830 LDA #40 ;WE KNOW THERE... 0840 STA ICBLL,X ;WON'T BE MORE... 0850 LDA #0 ;THAN 40 BYTES! 0860 STA ICBLH,X 0870 JSR CIOV ;REPEAT TEXT! 0880 BMI PRTERR ;ERROR! 0890 JMP GETTXT ;LOOP FOR MORE 0900 ; 0910 ;HERE ARE THE ERROR HANDLERS 0920 ;--------------------------- 0930 ; 0940 ;KEYBOARD OPEN ERROR 0950 ; 0960 OPNERR LDX #$00 ;IOCB #0 (SCREEN) 0970 LDA #$09 ;SET FOR... 0980 STA ICCMD,X ;PUT RECORD 0990 LDA #OEMSG/256 ;POINT TO... 1000 STA ICBAH,X ;KEYBOARD OPEN... 1010 LDA #OEMSG&255 ;ERROR MESSAGE 1020 STA ICBAL,X 1030 LDA #$FF ;SET LENGTH... 1040 STA ICBLL,X ;TO MAXIMUM 1050 STA ICBLH,X 1060 JSR CIOV ;PRINT MESSAGE! 1070 BMI PRTERR ;BRANCH IF ERROR 1080 BRK ;AND EXIT! 1090 ; 1100 ;TEXT PRINT ERROR 1110 ; 1120 PRTERR LDA #$34 ;PUT RED... 1130 STA COLOR4 ;IN BACKGND COLOR 1140 JMP FINISH ;AND EXIT! 1150 ; 1160 ;INPUT ERROR 1170 ; 1180 GETERR CPY #136 ;ERROR #136? 1190 BNE NOTEOF ;NO, NOT EOF. 1200 FINISH LDX #$10 ;GOT EOF... 1210 LDA #$0C ;CLOSE THE... 1220 STA ICCMD,X ;KEYBOARD... 1230 JSR CIOV 1240 BRK ;AND EXIT! 1250 NOTEOF CPY #128 ;ERROR #128? 1260 BNE NOTBRK ;NO, NOT BREAK 1270 LDX #$00 ;IOCB #0 (SCREEN) 1280 LDA #$09 ;PUT RECORD 1290 STA ICCMD,X 1300 LDA #BRKMSG/256 ;POINT TO... 1310 STA ICBAH,X ;BREAK KEY... 1320 LDA #BRKMSG&255 ;ERROR MESSAGE 1330 STA ICBAL,X 1340 LDA #$FF ;SET FOR... 1350 STA ICBLL,X ;MAXIMUM... 1360 STA ICBLH,X ;TEXT LENGTH 1370 JSR CIOV ;PRINT IT, 1380 JMP GETTXT ;GO GET TEXT. 1390 NOTBRK CPY #137 ;TRUNCATED? 1400 BNE NOTTRN ;NO, NOT BREAK 1410 LDX #$00 ;IOCB #0 (SCREEN) 1420 LDA #$09 ;PUT RECORD 1430 STA ICCMD,X 1440 LDA #TRNMSG/256 ;POINT TO... 1450 STA ICBAH,X ;TRUNCATION... 1460 LDA #TRNMSG&255 ;ERROR MESSAGE 1470 STA ICBAL,X 1480 LDA #$FF ;SET FOR... 1490 STA ICBLL,X ;MAXIMUM... 1500 STA ICBLH,X ;TEXT LENGTH 1510 JSR CIOV ;PRINT IT, 1520 JMP GETTXT ;GO GET TEXT. 1530 NOTTRN LDX #$00 ;IT'S ANOTHER... 1540 LDA #$09 ;ERROR, SO... 1550 STA ICCMD,X ;LET'S PRINT... 1560 LDA #OTHER/256 ;A MESSAGE... 1570 STA ICBAH,X ;INFORMING... 1580 LDA #OTHER&255 ;THE USER. 1590 STA ICBAL,X 1600 LDA #$FF 1610 STA ICBLL,X 1620 STA ICBLH,X 1630 JSR CIOV ;PRINT MESSAGE 1640 JMP GETTXT ;GET MORE TEXT! 1650 ; 1660 ;HERE ARE THE TEXT MESSAGES 1670 ; 1680 PROMPT .BYTE "ENTER TEXT, CTRL-3 TO EXIT",$9B 1690 OEMSG .BYTE "*** KEYBOARD OPEN ERROR ***",$9B 1700 BRKMSG .BYTE "*** DON'T PRESS THE BREAK KEY! ***",$9B 1710 TRNMSG .BYTE "*** TEXT TOO LONG! ***",$9B 1720 OTHER .BYTE "*** UNKNOWN ERROR!!! ***",$9B 1730 ; 1740 ;MISCELLANEOUS DATA 1750 ; 1760 KEYBD .BYTE "K:",$9B 1770 INBUF *=*+40 1780 .END