home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c64cross / c64slk.m65 < prev    next >
Text File  |  2020-01-01  |  471KB  |  17,340 lines
  1. .TITLE  KERMIT-65    KL10 Error-free Reciprocal Micro-interface Transfer
  2.  
  3. ;
  4. ;    $Id: c64ker.m65,v 1.73 89/02/23 22:50:00 ray Exp $
  5. ;
  6.  
  7. ;    6502 version - Antonino N. J. Mione
  8. ;    Commodore 64 version converted from Apple version 1.1
  9. ;    By Dave Dermott  March, 1984
  10. ;    Additional improvements by Eric Lavitsky/Frank Prindle/
  11. ;    Michael Marchiondo
  12.  
  13. ;    Ray Moody
  14.  
  15. ;    Version 2.2
  16.  
  17. ;    Based on the KERMIT Protocol.
  18.  
  19. .SBTTL    Revision History
  20.  
  21. ;
  22. ; Edit #    Description
  23. ; ------    -----------
  24. ;   01        By: David Dermott           On: Mar 1984
  25. ;        Start converting to C-64
  26. ;               Edits 15,18,25,27 from APPLEK included
  27. ;
  28. ;   02        By: David Dermott           On: Jul 1984
  29. ;        Add SET RS232 REGISTERS to change baud rate
  30. ;
  31. ;   03        By: David Dermott           On: Jul 1984
  32. ;        Add ASCII,PETASCI and SCRIPT file formats
  33. ;
  34. ;   04        By: David Dermott
  35. ;        Add code to terminal emulate for lower case
  36. ;
  37. ;   05        By: David Dermott           On: Oct 1984
  38. ;        Include macros movadr,ldadr,movw,ldxy,stxy,
  39. ;        pusw,pulw,pusb,pulb
  40. ;
  41. ;   06        By: David Dermott           On: Oct 1984
  42. ;        Change indexed jump with JMPIND
  43. ;
  44. ;   07        By: David Dermott           On: Nov 1984
  45. ;         Add code to RPAK to set PTYPE to "false" if
  46. ;           checksum fails.
  47. ;
  48. ;   08        By: David Dermott           On: Nov 1984
  49. ;        Add DOS command for local file management
  50. ;
  51. ;
  52. ;   09        By: Eric Lavitsky        On: 28-Nov-1984
  53. ;        Reformatted Dave Dermotts' code to look more like
  54. ;        the current Apple version (2.1).
  55. ;
  56. ;
  57. ;   10        By: Eric Lavitsky        On: 29-Nov-1984
  58. ;        Added or completed Apple revisions 11,13,14,20,
  59. ;        21,23,26. This includes fixes to the parser and
  60. ;        new server commands.
  61. ;
  62. ;
  63. ;   11        By: Eric Lavitsky        On: 01-Dec-1984
  64. ;        Replaced prrstr with prstr since C64 can display 
  65. ;        lower case.
  66. ;
  67. ;
  68. ;   12        By: Eric Lavitsky        On: 03-Dec-1984
  69. ;        Make Kermit switch to upper/lower case mode at start
  70. ;        and close all open channels. Also did more reformating 
  71. ;        of code.
  72. ;
  73. ;
  74. ;   13        By: Eric Lavitsky        On: 05-Dec-1984
  75. ;        Remove macros pulw,pusw,pulb,pusb,ldadr,movadr,movw
  76. ;        to be more consistent with Apple code.
  77. ;
  78. ;
  79. ;   14        By: Eric Lavitsky        On: 06-Dec-1984
  80. ;        Fixed cursor routines, added blink, nblink. Added
  81. ;        new bell procedure which turns off at next cursor blink. 
  82. ;        Added new definitions for C64 video and sound routines.
  83. ;        Added a confirm before going into DOS. Cleaned keyword 
  84. ;        table organization to coincide with Apple definitions.
  85. ;
  86. ;
  87. ;   15        By: Eric Lavitsky        On: 08-Dec-1984
  88. ;        Make the version 1.0 for the first release. Remove
  89. ;        all Apple edit histories. Leave only [DD] for Dave
  90. ;        Dermotts' remaining edits and [EL] for those that I
  91. ;        have done. Future edits will include an edit number
  92. ;        in the source.
  93. ;
  94.  
  95. ;     VERSION 1.1 Starts Here
  96.  
  97. ;
  98. ;   16        By: Eric Lavitsky        On: 15-Dec-1984
  99. ;        Add calls to RESTOI and IOINIT at the start of Kermit
  100. ;        so we can use all those nifty new super loaders that 
  101. ;        mess around with the I/O vectors.
  102. ;
  103. ;
  104. ;   17        By: Eric Lavitsky        On: 26-Dec-1984
  105. ;        Added Set Baud option. Also made Set Parity really
  106. ;        set the parity and Set Ibm set the correct parity.
  107. ;        Added Set Word-Size option and make IBM mode set 
  108. ;        seven bit word size. Also flip out BASIC ROM at start
  109. ;        and flip it back in on Exit since Kermit doesn't need it.
  110. ;
  111. ;
  112. ;   18        By: Frank Prindle        On: 26-Dec-1984
  113. ;        Fixed 'ldy ksavey' 7 instructions into stccr: 
  114. ;        to 'lda ksavey'
  115. ;
  116.  
  117. ;      VERSION 1.2 Starts Here
  118.  
  119. ;
  120. ;   19        By: Eric Lavitsky        On: 30-Dec-1984
  121. ;        Added full ASCII character set, new definitions    for
  122. ;        video and I/O. Added new key translations for telnet,
  123. ;        including a table for function key translation. 
  124. ;
  125. ;
  126. ;   20        By: Eric Lavitsky        On: 3-Jan-1985
  127. ;        Fixed code in openf: that was ignoring the first two
  128. ;        bytes of PRG files and writing/sending $00 $20
  129. ;
  130. ;
  131. ;   21        By: Eric Lavitsky        On: 10-Jan-1985
  132. ;        Added a jmp past tlcnc4 after getting a function key
  133. ;        value to prevent corrupting the value sent. Also added
  134. ;        fixes at buffchk: and fgetc: which were not handling
  135. ;        the eof condition correctly.
  136. ;
  137. ;
  138. ;   22        By: Eric Lavitsky        On: 11-Jan-1985
  139. ;        Moved RS232 open from Telnet: to Kstart:
  140. ;
  141.  
  142. ;      VERSION 1.3 Starts Here
  143.  
  144. ;
  145. ;
  146. ;   23        By: Eric Lavitsky        On: 11-Jan-1985
  147. ;        Added modified code from Applek for file-warning
  148. ;        support- Lookup:, Alterf:, Altstv:. New routines-
  149. ;        Locent:, Bldprm:
  150. ;
  151. ;
  152. ;   24        By: Eric Lavitsky        On: 11-Jan-1985
  153. ;        Added new support for RS-232. Much of this code comes
  154. ;        from Term.Plus from Frank Prindle & Eric Lavitsky.
  155. ;        Code to allocate rs232 buffers properly, do flow control,
  156. ;        and delay before sending a character. Add set 
  157. ;        flow-control option and show flow-control option.
  158. ;        Routines include: Optimu:, Alocrs:, Sxon:, Sxoff:
  159. ;        
  160. ;
  161. ;   25        By: Dave Dermott        On: 12-Jan-1985
  162. ;        Make send init flush the input buffer before sending
  163. ;        an INIT packet. Routine Flshin: called at Sini1d:
  164. ;
  165. ;
  166. ;   26        By: Eric Lavitsky        On: 21-Jan-1985
  167. ;        Add support for printing tabs and linefeeds correctly.
  168. ;        Also make some changes to screen output routines
  169. ;        Ploth and Prttab come from Term.Plus
  170. ;
  171. ;
  172. ;   27        By: Eric Lavitsky        On: 09-Feb-1985
  173. ;        Close and reopen the RS232 channel in telnet:, logo:,
  174. ;        finish:, getfrs:, receve:, and send: to insure that
  175. ;        the most recent parameters are being used for
  176. ;        communication 
  177. ;
  178. ;
  179. ;   28        By: Eric Lavitsky        On: 10-Feb-1985
  180. ;        Close the file on an abort interrupt ('Q').
  181. ;        Make sbreak delay for 250 ms instead of 200 ms.
  182. ;
  183. ;
  184. ;   29        By: Michael Marchiondo        On: 14-Feb-1985
  185. ;        Make kerbf1 point to pdbuf in logo so spak sees the
  186. ;        logout packet.
  187. ;
  188.  
  189. ;       VERSION 1.4 Starts Here
  190.  
  191. ;
  192. ;   30        By: Michael Marchiondo        On: 21-Feb-1985
  193. ;        Fix Eight-Bit-Quoting code in Send & Spar
  194. ;
  195. ;
  196. ;   31        By: Eric Lavitsky        On: 26-Feb-85
  197. ;        Remove old ASCII/PETSCII translation routine. Add 
  198. ;        two table pairs to handle conversion. One for Telnet
  199. ;        and one for file transfer
  200. ;
  201. ;
  202. ;   32        By: Frank Prindle        On: 27-Feb-85
  203. ;        Change stx to sta in Sxoff: so that the xoff flag
  204. ;        is really set. Fix the compare in vtdca1: so we can
  205. ;        address line 25
  206. ;
  207.  
  208. ;    VERSION 1.5 Starts Here
  209.  
  210. ;
  211. ;   33        By: Eric Lavitsky        On: 29-Feb-85
  212. ;        Add error checking to RS232 routines.
  213. ;
  214. ;
  215. ;   34        By: Eric Lavitsky        On: 29-Feb-85
  216. ;        Replace openm call for RS232 open at program start
  217. ;        with call to subroutine Openrs
  218. ;
  219. ;
  220. ;   36        By: Eric Lavitsky        On: 01-Mar-85
  221. ;        Restructure Exit: so it's easy to call the restor
  222. ;        routine from other places.
  223. ;
  224. ;
  225. ;   37        By: Eric Lavitsky        On: 31-Mar-85
  226. ;        Add 80 column support!
  227. ;
  228. ;
  229. ;   38        By: Eric Lavitsky        On: 31-Mar-85
  230. ;        Make IBM mode turn off flow-control
  231. ;
  232. ;
  233. ;
  234. ;   39        By: Eric Lavitsky        On: 31-Mar-85
  235. ;        Restructure Telnet and Intchr
  236. ;
  237. ;
  238. ;
  239. ;   40        By: Eric Lavitsky        On: 08-Apr-85
  240. ;        Remove DOS parser. Add new commands: DIRECTORY and
  241. ;        DISK
  242. ;
  243. ;
  244. ;   41        By: Frank Prindle        On: 09-Apr-85
  245. ;        Change pnth as it was interfering with serial disk
  246. ;        routines 
  247. ;
  248. ;
  249. ;   42        By: Eric Lavitsky        On: 09-Apr-85
  250. ;        Add new definitions for kernel routines
  251. ;
  252. ;
  253. ;   43        By: Eric Lavitsky        On: 09-Apr-85
  254. ;        Change abort from 'Q' to '^X' add code to send EOF
  255. ;        packet as well.
  256. ;
  257. ;
  258. ;   44        By: Eric Lavitsky        On: 09-Apr-85
  259. ;        Add delay before printing in prstr a la Apple
  260. ;        version.
  261. ;
  262.  
  263. ;    VERSION 1.6 Starts Here
  264.  
  265. ;
  266. ;   45        By: Eric Lavitsky        On: 11-Apr-85
  267. ;        Restructure status routine so we can return properly
  268. ;        in intchr
  269. ;
  270. ;
  271. ;   46        By: Eric Lavitsky        On: 18-Apr-85
  272. ;        Make parser use telnet (ASCII) key translations.
  273. ;        Make tab work in the parser.
  274. ;
  275. ;
  276. ;   47        By: Eric Lavitsky        On: 19-Apr-85
  277. ;        Add commands SAVE and RESTORE to save Kermit 
  278. ;        parameters in an init file and restore them from
  279. ;        that file.
  280. ;
  281. ;   48        By: Eric Lavitsky        On: 22-Apr-85
  282. ;        Add switch indicating whether or not we are in
  283. ;        connect mode.
  284. ;
  285. ;   49        By: Eric Lavitsky        On: 09-May-85
  286. ;        Add code to handle timeouts. Timset to set the
  287. ;        timeout for send and receive. Timout to check if
  288. ;        we have passed the timeout limit.
  289. ;
  290.  
  291. ;    VERSION 1.7 Starts Here
  292.  
  293. ;
  294. ;   50        By: Frank Prindle        On: 06-Aug-1985
  295. ;        Fix disk parser so all commands work.
  296. ;
  297. ;   51        By: Frank Prindle        On: 06-Aug-1985
  298. ;        Add patch to optimu: to delay proper time for 1200
  299. ;        baud transmission.
  300. ;
  301. ;   52        By: Frank Prindle        On: 06-Aug-1985
  302. ;        Fix translation table as2pt: to do proper conversions.
  303. ;
  304.  
  305. ;    VERSION 2.0 Starts Here
  306.  
  307. ;
  308. ;   53        By: Ray Moody            On: 09-Dec-1986
  309. ;        Changed source code so it assembles on a more conventional
  310. ;        assembler.  Removed .end directive, expanded macro, fixed
  311. ;        problem with upper case labels, changed .ascii and .asciz
  312. ;        to .byte, added a .byte 0 line after .asciz lines, commented
  313. ;        out extra definitions, changed string delimiter to ".
  314. ;
  315. ;
  316. ;   54        By: Ray Moody            On: 10-Dec-1986
  317. ;        Changed directory routine to print file sizes in decimal
  318. ;        Added routine prntad to do the dirty work.
  319. ;
  320. ;
  321. ;   55        By: Ray Moody            On: 18-Mar-1987
  322. ;        Put in a new screen driver with all the features needed
  323. ;        for VT100 emulation.  Prepared the way for C128 support.
  324. ;
  325. ;
  326. ;   56        By: Ray Moody            On: 21-Mar-1987
  327. ;        Fixed a bug in cminbf.  (It was ignoring ctrlw)
  328. ;        Fixed a bug in telnet.  (It was local-echoing garbage chars)
  329. ;        Improved underlining.
  330. ;        Also added VT100 emulation.
  331. ;
  332. ;
  333. ;   57        By: Ray Moody            On: 24-Mar-1987
  334. ;        Added Commodore 128 support.
  335. ;        Fixed assorted bugs (telnet was blowing the stack away!)
  336. ;        Prepared for release!!!
  337. ;
  338.  
  339. ;    VERSION 2.1 Starts Here
  340.  
  341. ;
  342. ;   58        By: Ray Moody            On: 09-Apr-1987
  343. ;        Optimized everything.
  344. ;        fixed a bug in vt100ta.  (was ignoring ^[[<int>;<int>;<int>m).
  345. ;        fixed a bug in c40el2. (was erasing too much color ram).
  346. ;        fixed a bug in telnet.  (it was echoing strange control chars)
  347. ;        fixed alot of cruddy commenting.
  348. ;        Generally improved code.
  349. ;
  350. ;
  351. ;   59        By: Ray Moody            On: 01-Mar-1987
  352. ;        Added new keyscanner that can detect the alternate keypad
  353. ;        on the Commodore-128 and rebound all the keys.
  354. ;
  355. ;
  356. ;   60        By: Ray Moody            On: 05-May-1987
  357. ;        Fixed bug in keytbl2. ^] was bound to ^^.
  358. ;
  359. ;
  360. ;   61        By: Ray Moody            On: 05-May-1987
  361. ;        Added support for the Batteries Included 80-column card.
  362. ;
  363. ;
  364. ;   62        By: Kent Sullivan        On: 05-May-1987
  365. ;        Fixed capitalization errors.
  366. ;
  367. ;
  368. ;   63        By: Ray Moody            On: 06-May-1987
  369. ;        Changed mapping of characters for the Batteries Included card.
  370. ;
  371. ;
  372. ;   64        By: Kent Sullivan        On: 06-May-1987
  373. ;        Fixed more capitalization errors and (gasp) a spelling error.
  374. ;
  375. ;
  376. ;   65        By: Ray Moody            On: 11-Jun-1987
  377. ;        Un-kludged terminal type selection.
  378. ;        Bound ^@ to null.
  379. ;        Added the following features: key repeat, new line mode,
  380. ;        graphics characters
  381. ;        terminal reports (both modes), origin mode, bright background,
  382. ;        next line, settable tabs, terminal reset, fill screen with Es.
  383. ;        Kermit now saves the border color upon entry and restores it
  384. ;        upon exit.
  385. ;
  386. ;   66        By: Ray Moody            On: 16-Jun-1987
  387. ;        Fixed keybinding of run-stop.
  388. ;        Changed the terminal ID report to reflect the fact that we
  389. ;        have AVO.
  390. ;
  391. ;
  392. ;  67        By: Ray Moody            On: 11-Apr-1988
  393. ;        moved around cmbuf, almbuf, plnbuf.
  394. ;        dtime now 10 seconds (was 15).
  395. ;        put color commands in.
  396. ;        new version message.
  397. ;        prints "push '?' for help" in bold.
  398. ;        added tektronix graphics mode.
  399. ;        set up ins/del and clr/home.
  400. ;        vt102 insert/replace mode escape sequence.
  401. ;        vt102 delete chars escape sequence.
  402. ;        fixed status command.
  403. ;        kludged for use with ckermit.
  404. ;        run/stop abort directory listings.
  405. ;        support for c-power.
  406. ;        support c128 caps-lock key.
  407. ;        temporarly put stuff back on f1 ... f8.
  408. ;        renamed "petasci" to "petscii".
  409. ;        renamed "batteries-included" to "bi-80".
  410. ;        created m80 screen driver.
  411. ;        fixed c128 cursor.
  412. ;
  413. ;
  414. ;  68        By: Ray Moody            On: 14-Apr-1988
  415. ;        Changed "vt100" and "vt52" to "vt-100" and "vt-52" for Kent.
  416. ;        Fixed suspend.  We want to clear it when we break a connection.
  417. ;
  418. ;
  419. ;  68a        By: Ray Moody            On: 21-Apr-1988
  420. ;        ``Testing can only prove the presence of bugs, never
  421. ;        the absence thereof.''
  422. ;        Tried to release it, and prindle@nadc.arpa found a bug.
  423. ;        Optimu was only sending characters at about 300 baud no
  424. ;        matter what the baud rate was set to.  Also took the
  425. ;        opportunity to fix up scrrst/scrset problem.
  426. ;
  427.  
  428. ;    VERSION 2.2 Starts Here
  429.  
  430. ;
  431. ;   69        By: Ray Moody            On: 27-Nov-1988
  432. ;        Added support for C128 fast mode and 2400 baud.
  433. ;        Added <esc> "," for visual bell.
  434. ;        Fixed speedscript bug.
  435. ;        Redid optimu from scratch.
  436. ;        Fixed keyscanner bug.
  437. ;
  438.  
  439. ;
  440. ;   70        By: Ray Moody            On: 27-Nov-1988
  441. ;        Updated version number and prepared for release.
  442. ;
  443.  
  444. ;
  445. ;   71        By: Ray Moody            On: 23-Feb-1989
  446. ;        Added Fred Bowen's (fred@cbmvax.UUCP) fix for the parser.
  447. ;
  448.  
  449. ;
  450. ;  72        By: Ray Moody            On: 23-Feb-1988
  451. ;        Fixed the 1200 baud problem that C64s (not C128s) experienced.
  452. ;
  453.  
  454. ;
  455. ;  73        By: Ray Moody            On: 23-Feb-1989
  456. ;        Changed the version number.  Now this is *really*
  457. ;        version 2.2 (73).
  458. ;
  459.  
  460. ;
  461. ; 74        By: Ray Moody            On: 06-Sep-1991
  462. ;        Added basic Swiftlink support. "Set" and "show" commands
  463. ;        still not fully implemented.
  464. ;
  465.  
  466. ;
  467. ; 75        By: Matthew Sorrels     On: 08-Feb-1992
  468. ;       Fixed basic Swiftlink support so it really works.
  469. ;       Added set/show port-address and working-drive
  470. ;        Fixed start up sequence to not need INI file
  471. ;       Swiftlink version using different INI file (SLKERMIT.INI)
  472. ;
  473. ; 76        By: Matthew Sorrels     On: 23-May-1992
  474. ;       Finished up Swiftlink version.  Removed beta strings. Changed version
  475. ;       to 2.2 (76)
  476. ;
  477.  
  478. ;    VERSION 3.0 Starts Here
  479.  
  480. ;
  481. ;  nnn        By: xxxxxxxx xxxxxxxx        On: nn-XXX-19nn
  482. ;        xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  483. ;        xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  484. ;        xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  485. ;
  486. ;+
  487.  
  488. .SBTTL    Define start address for assembly
  489.  
  490.            .=    $801        ; Start assembly at hex 801
  491.  
  492. .SBTTL    BASIC start sequence   10 SYS(2064)
  493.  
  494. basic:    .byte    $0D,$08,$0A,$00        ; Line 10 in BASIC
  495.     .byte    $9E            ; SYS
  496.     .byte    "(2064)"        ;
  497.     .byte    $00,$00,$00        ; end of line
  498.  
  499.     .byte    $00
  500.  
  501.         .=    $810
  502.  
  503. .SBTTL    Jump to start of code
  504.  
  505. kst:    jmp    kstart        ; Go past the data to the beginning of the code
  506.  
  507. .SBTTL    Macro definitions
  508.  
  509. ; Macro to open a file
  510. ; [53] as6502 will not handle macros.  Macros have been expanded.
  511. ; .macro    openm,p1,p2,p3,p4,p5     ;lun,dv,sa,fnm,len
  512. ;     lda     p1    
  513. ;     ldx     p2
  514. ;     ldy     p3
  515. ;     jsr    setlfs
  516. ;     ldx    #p4\
  517. ;     ldy    #p4^
  518. ;     lda    p5
  519. ;     jsr    setnam
  520. ;     jsr    open
  521. ; .endm
  522.  
  523. .SBTTL    C64 kernel entry points
  524.  
  525. acptr    =    $ffa5        ;[42] Get byte from serial bus
  526. chkin    =    $ffc6        ; change kernel input channel
  527. chkout    =    $ffc9        ; change kernel output channel
  528. chrin    =    $ffcf        ; input a character
  529. chrout    =    $ffd2        ; output a character
  530. cint    =    $ff81        ;[EL] initialize screen editor
  531. ciout    =    $ffa8        ;[42] Output byte to serial port
  532. clall    =    $ffe7        ; close all channels and files
  533. close    =    $ffc3        ; close a channel
  534. clrchn    =    $ffcc        ; close input and output channel
  535. getin    =    $ffe4        ; input a character
  536. ioinit    =    $ff84        ;[EL] initialize I/O devices
  537. load    =    $ffd5        ;[42] Load RAM from a device
  538. open    =    $ffc0        ; open a channel
  539. plot    =    $fff0        ; fetch/set cursor position (40 col)
  540. ramtas    =    $ff87        ;[EL] init RAM, tape buffer, screen memory
  541. readst    =    $ffb7        ; read I/O status
  542. restoi    =    $ff8a        ;[EL] restore default I/O vectors
  543. rdtim    =    $ffde        ; read the builtin timer
  544. save    =    $ffd8        ;[42] Save RAM to device
  545. setlfs    =    $ffba        ;[EL] set open parameters
  546. setnam    =    $ffbd        ;[EL] set filename
  547. stop    =    $ffe1        ; Check if STOP key is pressed
  548. talk    =    $ffb4        ;[42] Send serial bus talk
  549. tksa    =    $ff96        ;[42] Send secondary address after talk
  550. untalk    =    $ffab        ;[42] Send serial bus untalk
  551.  
  552. dos    =    $a002        ; BASIC NMI vector
  553.  
  554. .SBTTL    Character and string definitions
  555.  
  556. nul    =    $00        ; <null>
  557. soh    =    $01        ; <soh>
  558. bs    =    $08        ; <bs>
  559. tab    =    $09        ; <tab> (ctrl/I)
  560. lf    =    $0a        ; <lf>
  561. ffd    =    $0c        ; Form feed
  562. cr    =    $0d        ; <cr>
  563. ctrlu    =    $15        ; <ctrl/U>
  564. ctrlx    =    $18        ; <ctrl/X>
  565. ctrly    =    $19        ; <ctrl/Y>
  566. esc    =    $1b        ; <esc>
  567. sp    =    $20        ; <space>
  568. space    =    $20        ; """"
  569. del    =    $7f        ; <del>
  570. cdel    =    $14        ; commodore del
  571. quest    =    $3F        ; <?>
  572. ctrlw    =    $17        ; <ctrl/W>
  573. dquot    =    $22        ; '"'        ?
  574. quot    =    $27        ; "'"        ?
  575. slash    =    $2f        ; '/'        ?
  576. apos    =    quot        ; "'"        ?
  577. rabr    =    $3e        ; '>'        ?
  578. colon    =    $3a        ; ':'        ?
  579.  
  580. .SBTTL    Commodore I/O addresses
  581.  
  582. vicbank =    $8000        ; vic bank select (remember -- rom present)
  583. victext =    $a000        ; 40 column and 80 column bit map area
  584. vicclr1    =    $8c00        ; primary color area
  585. vicclr2    =    $8800        ; secondary color area
  586. ; To move vicclr1 and vicclr2 you need to compute vicdat1 and vicdat2
  587. ; where the top 4 bits are the screen memory location of vicclr1 and vicclr2
  588. ; then you need to adjust the vicswap value.  It must be possible to xor
  589. ; vicdat1 with vicswap and get vicdat2 and the reverse must be true
  590. ; Note no space in the $9000-$a000 block is usable because of the char ROMs
  591. vicmsk    =    %00000111    ; info to set up vic chip to use this memory
  592. vicdat1    =    %00111000    ;        ""
  593. ; this isn't needed as it is computed by XOR'ing vicdat1 and vicswap
  594. ; It is just here as a reference
  595. vicdat2    =    %00101000    ;        ""
  596. vicswap    =    %00010000
  597. vicnorm    =    %00010000    ;        ""
  598.  
  599. freqhi    =    $d401        ;[EL] sid frequency (high byte)
  600. attdec    =    $d405        ;[EL] sid attack/decay
  601. susrel    =    $d406        ;[EL] sid sustain/release
  602. vol        =    $d418        ;[EL] sid volume
  603. wave    =    $d404        ;[EL] sid waveform select
  604.  
  605. .SBTTL    Commodore-128 8563 addresses
  606.  
  607. chr8563    =    $2000
  608. txt8563    =    $0000
  609. alt8563    =    $0800
  610. pad8563    =    $1000
  611.  
  612. .SBTTL    Batteries Included 80-column screen addresses
  613.  
  614. b80text    =    $9800
  615.  
  616. ch    =    $d3        ;Cursor Horizontal position (col)
  617. cv    =    $d6        ;Cursor Vertical position (row)
  618. basl    =    $d1        ;L.O. byte of base address of current line
  619. bash    =    $d2        ;H.O. byte of base address of current line
  620. bas2l    =    $50        ;Base address work area
  621. bas2h    =    $51        ;Base address work area
  622. source    =    $fb        ;[19] indirect address to be read
  623. dest    =    $fd        ;[19] indirect address to be stored
  624. pnth    =    $71        ;[19][41] hires screen pntr (^cassette buffer)
  625. ndx    =    $c6        ;[EL] number of keyboard bytes pending
  626. r6510    =    $01        ;[EL] Memory control register for 6510 
  627. ribuf    =    $f7        ;[19] rs-232 input buffer pointer (2-byte)
  628. robuf    =    $f9        ;[19] rs-232 ouput buffer pointer (2-byte)
  629. bitci    =    $a8        ;[19] rs-232 input bit count
  630. enabl    =    $2a0        ; rs-232 operations in progress
  631. clock    =    $a0        ;[EL] Jiffy clock (3-byte)
  632. ldtb1    =    $d9        ;[19] Editor line link table (40 col)
  633. qtsw    =    $d4        ;[EL] quote-mode switch (40 col)
  634.  
  635. ridbe    =    $29b        ;[EL] RS-232 index to end of input buffer
  636. ridbs    =    $29c        ;[EL] RS-232 index to start of input buffer
  637. shflag    =    $28d        ;[EL] shift key flags (commodore key = bit 1)
  638. hibase    =    $288        ;[EL] video matrix page number (40 col)
  639. color    =    $286        ;[EL] 40 column foreground color
  640.  
  641. nmiv    =    $0318
  642.  
  643. ; Just before the secondary color map don't move it into the $8800-$9000 block
  644. rdbuf     =    $8700
  645.  
  646. char:    .byte    $00        ;[26] Character just read
  647. stat:    .byte    $00        ;[33] RS232 status byte
  648. lpcnt:    .byte    $00        ;[EL] cursor blink counter
  649. lineh:    .byte    $00        ;[19] hires cursor line number
  650. colh:    .byte    $00        ;[19] hires cursor column number
  651. hilo:    .byte    $f0        ;[19] hires nibble mask
  652. rvmask:    .byte    $00        ;[19] reverse video mask ($f=rev, $0=normal)
  653. cflag:    .byte    $ff        ;[19] 0 if char under cursor has been reversed
  654. cstate:    .byte    $00        ;[19] top nibble of char und. cursor if cflag=0
  655. flag79:    .byte    $00        ;[19] non-0 if previous char printed in col 79
  656. fla79:    .byte    $00        ;[19] one shot copy of previous flag79
  657. suspend:.byte    $00        ;[24] RS-232 reads suspended if non-zero
  658. fxoff:    .byte    $00        ;[24] Xoff has been sent if non-zero
  659. commflg:.byte    $00        ;[24] non-zero if commodore key is depressed
  660. orignmiv: .byte $00     ; Jump vector for NMI routine
  661.           .byte $00        
  662.  
  663. .SBTTL    Translation and Font Tables
  664.  
  665. ;     ASCII/PETSCII Translation Tables
  666.  
  667. ;    Pt2as - PETSCII to ASCII
  668.  
  669. pt2as:    .byte    $00    ;[31] ^@ NUL
  670.     .byte    $01    ;[31] ^A SOH
  671.     .byte    $02    ;[31] ^B 
  672.     .byte    $03    ;[31] ^C 
  673.     .byte    $04    ;[31] ^D 
  674.     .byte    $05    ;[31] ^E 
  675.     .byte    $06    ;[31] ^F 
  676.     .byte    $07    ;[31] ^G BEL
  677.     .byte    $08    ;[31] ^H BS
  678.     .byte    $09    ;[31] ^I TAB
  679.     .byte    $0a    ;[31] ^J LF
  680.     .byte    $0b    ;[31] ^K 
  681.     .byte    $0c    ;[31] ^L FF
  682.     .byte    $0d    ;[31] ^M CR
  683.     .byte    $0e    ;[31] ^N 
  684.     .byte    $0f    ;[31] ^O 
  685.     .byte    $10    ;[31] ^P 
  686.     .byte    $11    ;[31] ^Q 
  687.     .byte    $12    ;[31] ^R 
  688.     .byte    $13    ;[31] ^S 
  689.     .byte    $14    ;[31] ^T
  690.     .byte    $15    ;[31] ^U 
  691.     .byte    $16    ;[31] ^V 
  692.     .byte    $17    ;[31] ^W 
  693.     .byte    $18    ;[31] ^X 
  694.     .byte    $19    ;[31] ^Y 
  695.     .byte    $1a    ;[31] ^Z 
  696.     .byte    $1b    ;[31] ^[ 
  697.     .byte    $1c    ;[31] ^\ 
  698.     .byte    $1d    ;[31] ^] 
  699.     .byte    $1e    ;[31] ^^ 
  700.     .byte    $1f    ;[31] ^_ 
  701.     .byte    $20    ;[31] SPACE
  702.     .byte    '!    ;[31] ! 
  703.     .byte    '"    ;[31] " 
  704.     .byte    '#    ;[31] # 
  705.     .byte    '$    ;[31] $ 
  706.     .byte    '%    ;[31] % 
  707.     .byte    '&    ;[31] & 
  708.     .byte    ''    ;[31] ' 
  709.     .byte    '(    ;[31] ( 
  710.     .byte    ')    ;[31] ) 
  711.     .byte    '*    ;[31] * 
  712.     .byte    '+    ;[31] + 
  713.     .byte    ',    ;[31] , 
  714.     .byte    '-    ;[31] - 
  715.     .byte    '.    ;[31] . 
  716.     .byte    '/    ;[31] / 
  717.     .byte    '0    ;[31] 0 
  718.     .byte    '1    ;[31] 1 
  719.     .byte    '2    ;[31] 2 
  720.     .byte    '3    ;[31] 3 
  721.     .byte    '4    ;[31] 4 
  722.     .byte    '5    ;[31] 5 
  723.     .byte    '6    ;[31] 6 
  724.     .byte    '7    ;[31] 7 
  725.     .byte    '8    ;[31] 8 
  726.     .byte    '9    ;[31] 9 
  727.     .byte    ':    ;[31] : 
  728.     .byte    ';    ;[31] ; 
  729.     .byte    '<    ;[31] < 
  730.     .byte    '=    ;[31] = 
  731.     .byte    '>    ;[31] > 
  732.     .byte    '?    ;[31] ? 
  733.     .byte    '@    ;[31] @ 
  734.     .byte    'a    ;[31] a 
  735.     .byte    'b    ;[31] b 
  736.     .byte    'c    ;[31] c 
  737.     .byte    'd    ;[31] d 
  738.     .byte    'e    ;[31] e 
  739.     .byte    'f    ;[31] f 
  740.     .byte    'g    ;[31] g 
  741.     .byte    'h    ;[31] h 
  742.     .byte    'i    ;[31] i 
  743.     .byte    'j    ;[31] j 
  744.     .byte    'k    ;[31] k 
  745.     .byte    'l    ;[31] l 
  746.     .byte    'm    ;[31] m 
  747.     .byte    'n    ;[31] n 
  748.     .byte    'o    ;[31] o 
  749.     .byte    'p    ;[31] p 
  750.     .byte    'q    ;[31] q 
  751.     .byte    'r    ;[31] r 
  752.     .byte    's    ;[31] s 
  753.     .byte    't    ;[31] t 
  754.     .byte    'u    ;[31] u 
  755.     .byte    'v    ;[31] v 
  756.     .byte    'w    ;[31] w 
  757.     .byte    'x    ;[31] x 
  758.     .byte    'y    ;[31] y 
  759.     .byte    'z    ;[31] z 
  760.     .byte    '[    ;[31] [ 
  761.     .byte    '\    ;[31] \ 
  762.     .byte    ']    ;[31] ] 
  763.     .byte    '^    ;[31] ^ 
  764.     .byte    '_    ;[31] _
  765.     .byte    $60    ;[31] 
  766.     .byte    'A    ;[31] A
  767.     .byte    'B    ;[31] B
  768.     .byte    'C    ;[31] C
  769.     .byte    'D    ;[31] D 
  770.     .byte    'E    ;[31] E 
  771.     .byte    'F    ;[31] F 
  772.     .byte    'G    ;[31] G 
  773.     .byte    'H    ;[31] H 
  774.     .byte    'I    ;[31] I 
  775.     .byte    'J    ;[31] J 
  776.     .byte    'K    ;[31] K 
  777.     .byte    'L    ;[31] L 
  778.     .byte    'M    ;[31] M 
  779.     .byte    'N    ;[31] N 
  780.     .byte    'O    ;[31] O 
  781.     .byte    'P    ;[31] P 
  782.     .byte    'Q    ;[31] Q 
  783.     .byte    'R    ;[31] R 
  784.     .byte    'S    ;[31] S 
  785.     .byte    'T    ;[31] T 
  786.     .byte    'U    ;[31] U 
  787.     .byte    'V    ;[31] V 
  788.     .byte    'W    ;[31] W 
  789.     .byte    'X    ;[31] X 
  790.     .byte    'Y    ;[31] Y 
  791.     .byte    'Z    ;[31] Z 
  792.     .byte    '{    ;[31] { 
  793.     .byte    '|    ;[31] | 
  794.     .byte    '}    ;[31] } 
  795.     .byte    '~    ;[31] ~ 
  796.     .byte    $7f    ;[31] DEL
  797.     .byte    '?    ;[31] illegal
  798.     .byte    '?    ;[31]
  799.     .byte    '?    ;[31]
  800.     .byte    '?    ;[31]
  801.     .byte    '?    ;[31]
  802.     .byte    '?    ;[31]
  803.     .byte    '?    ;[31]
  804.     .byte    '?    ;[31]
  805.     .byte    '?    ;[31]
  806.     .byte    '?    ;[31]
  807.     .byte    '?    ;[31]
  808.     .byte    '?    ;[31]
  809.     .byte    '?    ;[31]
  810.     .byte    '?    ;[31]
  811.     .byte    '?    ;[31] illegal
  812.     .byte    '?    ;[31] illegal
  813.     .byte    '?    ;[31] illegal
  814.     .byte    '?    ;[31] illegal
  815.     .byte    '?    ;[31] illegal
  816.     .byte    '?    ;[31] illegal
  817.     .byte    '?    ;[31] illegal
  818.     .byte    '?    ;[31] illegal
  819.     .byte    '?    ;[31] illegal
  820.     .byte    '?    ;[31] illegal
  821.     .byte    '?    ;[31] illegal
  822.     .byte    '?    ;[31] illegal
  823.     .byte    '?    ;[31] illegal
  824.     .byte    '?    ;[31] illegal
  825.     .byte    '?    ;[31] illegal
  826.     .byte    '?    ;[31] illegal
  827.     .byte    '?    ;[31] illegal
  828.     .byte    '?    ;[31] illegal
  829.     .byte    '?    ;[31] illegal
  830.     .byte    '?    ;[31] illegal
  831.     .byte    '?    ;[31] illegal
  832.     .byte    '?    ;[31] illegal
  833.     .byte    '?    ;[31] illegal
  834.     .byte    '?    ;[31] illegal
  835.     .byte    '?    ;[31] illegal
  836.     .byte    '?    ;[31] illegal
  837.     .byte    '?    ;[31] illegal
  838.     .byte    '?    ;[31] illegal
  839.     .byte    '?    ;[31] illegal
  840.     .byte    '?    ;[31] illegal
  841.     .byte    '?    ;[31] illegal
  842.     .byte    '?    ;[31] illegal
  843.     .byte    '?    ;[31] illegal
  844.     .byte    '?    ;[31] illegal
  845.     .byte    '?    ;[31] illegal
  846.     .byte    '?    ;[31] illegal
  847.     .byte    '?    ;[31] illegal
  848.     .byte    '?    ;[31] illegal
  849.     .byte    '?    ;[31] illegal
  850.     .byte    '?    ;[31] illegal
  851.     .byte    '?    ;[31] illegal
  852.     .byte    '?    ;[31] illegal
  853.     .byte    '?    ;[31] illegal
  854.     .byte    '?    ;[31] illegal
  855.     .byte    '?    ;[31] illegal
  856.     .byte    '?    ;[31] illegal
  857.     .byte    '?    ;[31] illegal
  858.     .byte    '?    ;[31] illegal
  859.     .byte    '?    ;[31] illegal
  860.     .byte    '?    ;[31] illegal
  861.     .byte    '?    ;[31] illegal
  862.     .byte    'A    ;[31] A from A key (dup)
  863.     .byte    'B    ;[31] B from B key (dup)
  864.     .byte    'C    ;[31] C from C key (dup)
  865.     .byte    'D    ;[31] D from D key (dup)
  866.     .byte    'E    ;[31] E from E key (dup)
  867.     .byte    'F    ;[31] F from F key (dup)
  868.     .byte    'G    ;[31] G from G key (dup)
  869.     .byte    'H    ;[31] H from H key (dup)
  870.     .byte    'I    ;[31] I from I key (dup)
  871.     .byte    'J    ;[31] J from J key (dup)
  872.     .byte    'K    ;[31] K from K key (dup)
  873.     .byte    'L    ;[31] L from L key (dup)
  874.     .byte    'M    ;[31] M from M key (dup)
  875.     .byte    'N    ;[31] N from N key (dup)
  876.     .byte    'O    ;[31] O from O key (dup)
  877.     .byte    'P    ;[31] P from P key (dup)
  878.     .byte    'Q    ;[31] Q from Q key (dup)
  879.     .byte    'R    ;[31] R from R key (dup)
  880.     .byte    'S    ;[31] S from S key (dup)
  881.     .byte    'T    ;[31] T from T key (dup)
  882.     .byte    'U    ;[31] U from U key (dup)
  883.     .byte    'V    ;[31] V from V key (dup)
  884.     .byte    'W    ;[31] W from W key (dup)
  885.     .byte    'X    ;[31] X from X key (dup)
  886.     .byte    'Y    ;[31] Y from Y key (dup)
  887.     .byte    'Z    ;[31] Z from Z key (dup)
  888.     .byte    '{    ;[31] { from SHIFT/+ key (dup)
  889.     .byte    '|    ;[31] | from ????? (dup)
  890.     .byte    '}    ;[31] } from SHIFT/- key (dup)
  891.     .byte    '~    ;[31] ~ from SHIFT/^ key (dup)
  892.     .byte    $7f    ;[31] DEL from ?????
  893.     .byte    $20    ;[31] SPACE from SHIFT/SPACE key (dup)
  894.     .byte    '?    ;[31] illegal
  895.     .byte    '?    ;[31] illegal
  896.     .byte    '?    ;[31] illegal
  897.     .byte    '?    ;[31] illegal
  898.     .byte    '?    ;[31] illegal
  899.     .byte    '?    ;[31] illegal
  900.     .byte    '?    ;[31] illegal
  901.     .byte    '?    ;[31] illegal
  902.     .byte    '?    ;[31] illegal
  903.     .byte    '?    ;[31] illegal
  904.     .byte    '?    ;[31] illegal
  905.     .byte    '?    ;[31] illegal
  906.     .byte    '?    ;[31] illegal
  907.     .byte    '?    ;[31] illegal
  908.     .byte    '?    ;[31] illegal
  909.     .byte    '?    ;[31] illegal
  910.     .byte    '?    ;[31] illegal
  911.     .byte    '?    ;[31] illegal
  912.     .byte    '?    ;[31] illegal
  913.     .byte    '?    ;[31] illegal
  914.     .byte    '?    ;[31] illegal
  915.     .byte    '?    ;[31] illegal
  916.     .byte    '?    ;[31] illegal
  917.     .byte    '?    ;[31] illegal
  918.     .byte    '?    ;[31] illegal
  919.     .byte    '?    ;[31] illegal
  920.     .byte    '?    ;[31] illegal
  921.     .byte    '?    ;[31] illegal
  922.     .byte    '?    ;[31] illegal
  923.     .byte    '?    ;[31] illegal
  924.     .byte    '?    ;[31] illegal
  925.  
  926. ;    As2pt - ASCII to PETSCII
  927.  
  928. as2pt:    .byte    $00    ;[31] NUL
  929.     .byte    $01    ;[31] ^A 
  930.     .byte    $02    ;[31] ^B 
  931.     .byte    $03    ;[31] ^C 
  932.     .byte    $04    ;[31] ^D 
  933.     .byte    $05    ;[31] ^E 
  934.     .byte    $06    ;[31] ^F 
  935.     .byte    $07    ;[31] BEL
  936.     .byte    $08    ;[31] BS
  937.     .byte    $09    ;[31] TAB
  938.     .byte    $0a    ;[31] NL
  939.     .byte    $0b    ;[31] ^K 
  940.     .byte    $0c    ;[31] ^L 
  941.     .byte    $0d    ;[31] CR 
  942.     .byte    $0e    ;[31] ^N 
  943.     .byte    $0f    ;[31] ^O 
  944.     .byte    $10    ;[31] ^P 
  945.     .byte    $11    ;[31] ^Q 
  946.     .byte    $12    ;[31] ^R 
  947.     .byte    $13    ;[31] ^S 
  948.     .byte    $14    ;[31] ^T 
  949.     .byte    $15    ;[31] ^U 
  950.     .byte    $16    ;[31] ^V 
  951.     .byte    $17    ;[31] ^W 
  952.     .byte    $18    ;[31] ^X 
  953.     .byte    $19    ;[31] ^Y 
  954.     .byte    $1a    ;[31] ^Z 
  955.     .byte    $1b    ;[31] ^[ 
  956.     .byte    $1c    ;[31] ^\ 
  957.     .byte    $1d    ;[31] ^] 
  958.     .byte    $1e    ;[31] ^^ 
  959.     .byte    $1f    ;[31] ^_ 
  960.     .byte    $20    ;[31] SPACE
  961.     .byte    $21    ;[31] ! 
  962.     .byte    $22    ;[31] " 
  963.     .byte    $23    ;[31] # 
  964.     .byte    $24    ;[31] $ 
  965.     .byte    $25    ;[31] % 
  966.     .byte    $26    ;[31] & 
  967.     .byte    $27    ;[31] ' 
  968.     .byte    $28    ;[31] ( 
  969.     .byte    $29    ;[31] ) 
  970.     .byte    $2a    ;[31] * 
  971.     .byte    $2b    ;[31] + 
  972.     .byte    $2c    ;[31] , 
  973.     .byte    $2d    ;[31] - 
  974.     .byte    $2e    ;[31] . 
  975.     .byte    $2f    ;[31] / 
  976.     .byte    $30    ;[31] 0 
  977.     .byte    $31    ;[31] 1 
  978.     .byte    $32    ;[31] 2 
  979.     .byte    $33    ;[31] 3 
  980.     .byte    $34    ;[31] 4 
  981.     .byte    $35    ;[31] 5 
  982.     .byte    $36    ;[31] 6 
  983.     .byte    $37    ;[31] 7 
  984.     .byte    $38    ;[31] 8 
  985.     .byte    $39    ;[31] 9 
  986.     .byte    $3a    ;[31] : 
  987.     .byte    $3b    ;[31] ; 
  988.     .byte    $3c    ;[31] < 
  989.     .byte    $3d    ;[31] = 
  990.     .byte    $3e    ;[31] > 
  991.     .byte    $3f    ;[31] ? 
  992.     .byte    $40    ;[31] @ 
  993.     .byte    $c1    ;[31][52] A 
  994.     .byte    $c2    ;[31][52] B 
  995.     .byte    $c3    ;[31][52] C 
  996.     .byte    $c4    ;[31][52] D 
  997.     .byte    $c5    ;[31][52] E 
  998.     .byte    $c6    ;[31][52] F 
  999.     .byte    $c7    ;[31][52] G 
  1000.     .byte    $c8    ;[31][52] H 
  1001.     .byte    $c9    ;[31][52] I 
  1002.     .byte    $ca    ;[31][52] J 
  1003.     .byte    $cb    ;[31][52] K 
  1004.     .byte    $cc    ;[31][52] L 
  1005.     .byte    $cd    ;[31][52] M 
  1006.     .byte    $ce    ;[31][52] N 
  1007.     .byte    $cf    ;[31][52] O 
  1008.     .byte    $d0    ;[31][52] P 
  1009.     .byte    $d1    ;[31][52] Q 
  1010.     .byte    $d2    ;[31][52] R 
  1011.     .byte    $d3    ;[31][52] S 
  1012.     .byte    $d4    ;[31][52] T 
  1013.     .byte    $d5    ;[31][52] U 
  1014.     .byte    $d6    ;[31][52] V 
  1015.     .byte    $d7    ;[31][52] W 
  1016.     .byte    $d8    ;[31][52] X 
  1017.     .byte    $d9    ;[31][52] Y 
  1018.     .byte    $da    ;[31][52] Z 
  1019.     .byte    $5b    ;[31] [ 
  1020.     .byte    $5c    ;[31] \ 
  1021.     .byte    $5d    ;[31] ] 
  1022.     .byte    $5e    ;[31] ^ 
  1023.     .byte    $5f    ;[31] _ 
  1024.     .byte    $c0    ;[31][52]
  1025.     .byte    $41    ;[31] a 
  1026.     .byte    $42    ;[31] b 
  1027.     .byte    $43    ;[31] c 
  1028.     .byte    $44    ;[31] d 
  1029.     .byte    $45    ;[31] e 
  1030.     .byte    $46    ;[31] f 
  1031.     .byte    $47    ;[31] g 
  1032.     .byte    $48    ;[31] h 
  1033.     .byte    $49    ;[31] i 
  1034.     .byte    $4a    ;[31] j 
  1035.     .byte    $4b    ;[31] k 
  1036.     .byte    $4c    ;[31] l 
  1037.     .byte    $4d    ;[31] m 
  1038.     .byte    $4e    ;[31] n 
  1039.     .byte    $4f    ;[31] o 
  1040.     .byte    $50    ;[31] p 
  1041.     .byte    $51    ;[31] q 
  1042.     .byte    $52    ;[31] r 
  1043.     .byte    $53    ;[31] s 
  1044.     .byte    $54    ;[31] t 
  1045.     .byte    $55    ;[31] u 
  1046.     .byte    $56    ;[31] v 
  1047.     .byte    $57    ;[31] w 
  1048.     .byte    $58    ;[31] x 
  1049.     .byte    $59    ;[31] y 
  1050.     .byte    $5a    ;[31] z 
  1051.     .byte    $db    ;[31][52] { 
  1052.     .byte    $dc    ;[31][52] | 
  1053.     .byte    $dd    ;[31][52] } 
  1054.     .byte    $de    ;[31][52] ~ 
  1055.     .byte    $7f    ;[31] DEL
  1056.  
  1057. .SBTTL    Flag definitions
  1058.  
  1059. ;    The following are flags passed in the Y register
  1060.  
  1061. cmfehf    =    1        ;[EL] Extra help available
  1062. cmfdff    =    2        ;[EL] Default value present
  1063.  
  1064. .SBTTL    Parse types
  1065.  
  1066. ;    The following are different items to parse for
  1067.  
  1068. cmini    =    0        ; Token to indicate parser init
  1069. cmkey    =    1        ; Token to parse for keyword
  1070. cmifi    =    2        ; Token to parse for input file
  1071. cmofi    =    3        ; Token to parse for output file
  1072. cmcfm    =    4        ; Token to parse for confirm
  1073. cmnum    =    5        ; Token to parse for a number
  1074. cmswi    =    6        ; Token to parse for a switch
  1075. cmfls    =    7        ; Token to parse for a floating-point number
  1076. cmtxt    =    8        ; Token to parse for an unquoted string
  1077. cmtok    =    9        ; Token to parse for a single char token
  1078.  
  1079. .SBTTL    Parser support
  1080.  
  1081. ;  Define storage for pointers into command buffer. They must be
  1082. ;  on zero-page to take advantage of pre- and post-indexed indirect
  1083. ;  and also the simulated indirect addressing mode.
  1084.  
  1085. saddr    =    $20        ; Saved string address - must be on page zero
  1086. cm.rty  =    $22        ; Byte pointer to CTRL/R Text
  1087. cm.bfp  =    $04        ; Byte pointer to start of text buffer
  1088. cm.ptr  =    $06        ; Byte pointer to Next Input to be parsed
  1089. cm.inc  =    $08        ; Number of characters left in buffer
  1090. cm.cnt  =    $09        ; Space left in buffer
  1091. cminf1  =    $0a        ; Information passed to comnd routines
  1092. cminf2  =    $0c        ;        ...
  1093. cmdptr    =    cminf2        ; Pointer to default for parse
  1094. cmkptr  =    $0e        ; Pointer for Cmkeyw routine
  1095. cmsptr  =    $10        ; Saved character pointer
  1096. cmspt2  =    $12        ; Saved keyword table pointer
  1097. cmspt3  =    $14        ; Saved buffer pointer
  1098. cmhptr  =    $24        ; Ptr. to current help text
  1099. cmptab  =    $26        ; Ptr. to beginning of current keyword table
  1100. cmfcb    =    $1a        ; Pointer to FCB
  1101. cmehpt    =    $1c        ; Pointer to help commands
  1102.  
  1103. .SBTTL    COMND package entry points
  1104.  
  1105. ;
  1106. ;    The following addresses are locations in a jump table which
  1107. ;    dispatch to appropriate routines in the Comnd package.
  1108. ;
  1109.  
  1110. mul16    =    comnd+3        ; 16-bit multiply routine
  1111. prcrlf    =    mul16+3        ; Routine to print a crelf
  1112. prstr    =    prcrlf+3    ; Routine to print an ASCIZ string
  1113. rskp    =    prstr+3        ; Routine to skip 3 bytes on return
  1114. setbrk    =    rskp+3        ; Routine to set a break char in brkwrd
  1115. rstbrk    =    setbrk+3    ; Routine to reset break char in brkwrd
  1116.  
  1117. .SBTTL    COMND JSYS routines
  1118.  
  1119. ;
  1120. ;    The following set of routines provides a user oriented way of parsing
  1121. ;    commands. It is similar to that of the COMND JSYS in TOPS-20. For
  1122. ;    convenience, a dispatch table is used.
  1123. ;
  1124.  
  1125. comnd:  jmp    comand        ;  Dispatch to main command routine
  1126.     jmp    ml16        ;  Dispatch to 16-bit multiply routine
  1127.     jmp    prcl.0        ;  Dispatch to Prcrlf
  1128.     jmp    prst.0        ;  Dispatch to Prstr
  1129.     jmp    rskp.0        ;  Dispatch to Rskp
  1130.     jmp    sbrk.0        ;  Dispatch to Setbrk
  1131.     jmp    rbrk.0        ;  Dispatch to Rstbrk
  1132.  
  1133. .SBTTL      Storage Declarations
  1134.  
  1135. ;
  1136. ;    Following is the storage decalarations for the Comnd routines
  1137. ;
  1138.  
  1139. ;
  1140. ;    cmbuf and atmbuf have been moved to the end so that the text
  1141. ;    segment does not fall below $8000.  The BI-80 card puts its own
  1142. ;    rom at $8000
  1143. ;cmbuf: .blkb    $100        ; Input command buffer
  1144. ;atmbuf:.blkb    $100        ; Atombuffer, (for cmtxt and cmifil)
  1145. lenabf:    .byte            ; Length of atom in Atombuffer
  1146. brkwrd:    .blkb    $16        ; Break mask
  1147. savea:  .byte            ;
  1148. savex:  .byte            ;
  1149. savey:  .byte            ;
  1150. cmbase: .byte            ; Base of integer to be parsed
  1151. cmmres: .blkb    4        ; Return value from cmmult call
  1152. cmintg: .blkb    4        ; Return value for cminum call
  1153. cmfltp: .blkb    6        ; Return value for cmflot call
  1154. cmflen: .byte            ; Field length
  1155. cmcdrv: .byte            ; Current drive
  1156. cmostp: .word            ; Save area for stack pointer
  1157. cmrprs: .word            ; Reparse address
  1158. cmaflg: .byte            ; Non-zero when an action char has been found
  1159. cmcffl:    .byte    0        ; Non-Zero when previous command failed
  1160. cmfrcf:    .byte    0        ; Non-Zero when signif char has been seen
  1161. cmccnt: .byte            ; Non-zero if a significant char is found
  1162. cmocnt:    .byte            ; Saved length of command buffer
  1163. cmoptr:    .word            ; Saved ptr to command buffer for <ctrl/H>
  1164. cmsflg: .byte            ; Non-zero when the last char was a space
  1165. cmstat: .byte            ; Save area for parse type
  1166. cmprmx:    .byte            ; Hold area for Comnd parameters
  1167. cmprmy:    .byte            ; Hold area for Comnd flags
  1168. cmkyln: .byte            ; Keyword length
  1169. cmtlen: .byte            ; Test length (for ?-prompting)
  1170. cmscrs: .byte            ; Screen output switch
  1171. cmentr: .byte            ; Number of remaining entries in table
  1172. cmehix:    .byte            ; Index to extra help command buffer
  1173. keylen: .byte            ; Keyword length
  1174. cmwrk1: .byte            ; Command processing scratch area
  1175. cmwrk2: .byte            ;
  1176. cmwrk3: .byte            ;
  1177. cmwrk4: .byte            ;
  1178.  
  1179. .SBTTL    Symbol definitions
  1180.  
  1181. ; [53] commented out following section.  Caused extra definition errors in as65
  1182. ; true    =    $01        ; Symbol for true return code
  1183. ; false    =    $00        ; Symbol for false return code
  1184. ; on    =    $01        ; Symbol for value of 'on' keyword
  1185. ; off    =    $00        ; Symbol for value of 'off' keyword
  1186. ; yes    =    $01        ; Symbol for value of 'yes' keyword
  1187. ; no    =    $00        ; Symbol for value of 'no' keyword
  1188.  
  1189. .SBTTL    Prompt subroutine
  1190.  
  1191. ;
  1192. ;    This routine prints the prompt for the program and specifies the
  1193. ;    reparse address.
  1194. ;
  1195. ;        Inputs:        X - L.O. byte address of prompt
  1196. ;                Y - H.O. byte address of prompt
  1197. ;
  1198. ;        Outputs:
  1199. ;
  1200. ;        Registers destroyed:    A,X,Y
  1201. ;
  1202.  
  1203. prompt: pla            ; Get Low order byte of return address
  1204.     sta    cmrprs        ; Save that half of reparse address
  1205.     pla            ; Get High order byte
  1206.     sta    cmrprs+1    ; Save the half
  1207.     pha            ; Restore the return
  1208.     lda    cmrprs        ;  address to
  1209.     pha            ;    the stack
  1210.     clc            ; Clear the carry
  1211.     adc    #$01        ; Increment this address since it is one
  1212.     sta    cmrprs        ;    short of the desired target.
  1213.     lda    cmrprs+1    ; Account for the carry, if any
  1214.     adc    #$00        ;        ...
  1215.     sta    cmrprs+1    ;        ...
  1216.     stx    cm.rty        ; Save the address of the prompt in
  1217.     sty    cm.rty+1    ; pointer to the ctrl/r text
  1218.     tsx            ; Get the stack pointer
  1219.     stx    cmostp        ; Save it for later restoral
  1220.     lda    #cmbuf\        ; Get low order byte of buffer address
  1221.     sta    cm.bfp        ; Init start of text buffer
  1222.     sta    cm.ptr        ; Init next input to be parsed
  1223.     lda    #cmbuf^        ; Get high order byte of buffer address
  1224.     sta    cm.bfp+1    ; H.O. byte of text buffer pointer
  1225.     sta    cm.ptr+1    ; H.O. byte of next input pointer
  1226.     lda    #$00        ; Clear AC
  1227.     sta    cmaflg        ; Clear the flags
  1228.     sta    cmccnt        ;
  1229.     sta    cmsflg        ;
  1230.     jsr    prcrlf        ; Print crlf
  1231.     ldx    cm.rty        ; Get L.O. byte of prompt address to be passed
  1232.     ldy    cm.rty+1    ; Get H.O. byte of prompt address
  1233.     jsr    prstr        ; Print the prompt
  1234.     rts            ; Return
  1235.  
  1236. .SBTTL    Repars routine
  1237.  
  1238. ;
  1239. ;    This routine sets stuff up to reparse the current command
  1240. ;    buffer.
  1241. ;
  1242. ;        Input:
  1243. ;
  1244. ;        Output:        Reinitialize comnd pointers and flags
  1245. ;
  1246. ;        Registers destroyed:    A,X
  1247. ;
  1248.  
  1249. repars: ldx    cmostp        ; Fetch old Stack pointer
  1250.     txs            ; Make it the current one
  1251.     lda    #cmbuf\        ; Get L.O. byte address of cmbuf
  1252.     sta    cm.ptr        ; Stuff it
  1253.     lda    #cmbuf^        ; Get H.O. byte address of cmbuf
  1254.     sta    cm.ptr+1    ; The buffer pointer is now reset
  1255.     lda    #$00        ; Clear AC
  1256.     sta    cmsflg        ; Clear the space flag
  1257.     jmp    (cmrprs)    ; Jump at the reparse address
  1258.  
  1259. .SBTTL    Prserr routine
  1260.  
  1261. ;
  1262. ;    This routine is used when a parsing error occurs. It resets ALL
  1263. ;    of the pointers and flags and then goes to the reparse address.
  1264. ;
  1265. ;        Input:
  1266. ;
  1267. ;        Output:
  1268. ;
  1269. ;        Registers destroyed:
  1270. ;
  1271.  
  1272. prserr:    lda    cm.ptr        ; Store old command line pointer
  1273.     sta    cmoptr        ;        ...
  1274.     lda    cm.ptr+1    ;         ...
  1275.     sta    cmoptr+1    ;         ...
  1276.     lda    cmccnt        ; Store old character count
  1277.     sta    cmocnt        ;        ...
  1278.     lda    #$ff        ; Set the failure flag
  1279.     sta    cmcffl        ;        ...
  1280.     ldx    cmostp        ; Fetch the saved SP
  1281.     txs            ; Make it the current one
  1282.     lda    #cmbuf\        ; Set up the command buffer
  1283.     sta    cm.bfp        ;     address in both the
  1284.     sta    cm.ptr        ;     buffer pointer and the 
  1285.     lda    #cmbuf^        ;    next input pointer.
  1286.     sta    cm.bfp+1    ;        ...
  1287.     sta    cm.ptr+1    ;        ...
  1288.     lda    #$00        ; Clear AC
  1289.     sta    cmaflg        ; Zero the action flag
  1290.     sta    cmccnt        ;    the character count
  1291.     sta    cmsflg        ;    and the space flag
  1292.     jsr    prcrlf        ; Print a crelf
  1293.     ldx    cm.rty        ;  Get the address of the prompt
  1294.     ldy    cm.rty+1    ;        ...
  1295.     jsr    prstr        ; Reprint the prompt
  1296.     jmp    (cmrprs)    ; Jump at the reparse address
  1297.  
  1298. .SBTTL    COMND - Entry point for command Jsys stuff
  1299.  
  1300. ;
  1301. ;    COMND routine - This routine checks the code in the AC for
  1302. ;    what parse type is wanted and then dispatches to an appropriate
  1303. ;    routine to look for it. Additional information is located in
  1304. ;    CMINF1 and CMINF2 on page zero.
  1305. ;
  1306. ;        Input:        A - parse type
  1307. ;                X,Y - optional parameters
  1308. ;
  1309. ;        Output:        A - +1 = success
  1310. ;                    +4 = failure (assumes JMP after call)
  1311. ;
  1312. ;        Registers destroyed:    A
  1313. ;
  1314.  
  1315. comand: sta    cmstat        ; Save what we are parsing
  1316.     stx    cmprmx        ; Save these parameters also
  1317.     sty    cmprmy        ;        ...
  1318.     cmp    #cmini        ; Initialize the world?
  1319.     bne    comn0        ; No, handle like a normal parse type
  1320.     jmp    prompt        ; Do the prompt routine to set things up
  1321. comn0:  jsr    cminbf        ; Get characters until action or erase
  1322.     cmp    #cmcfm        ; Parse a confirm?
  1323.     bne    comn1        ; Nope
  1324.     jmp    cmcfrm        ; Yes, try for the confirm
  1325. comn1:  cmp    #cmkey        ; Parse a keyword perhaps?
  1326.     bne    comn2        ; No, next item
  1327.     jmp    cmkeyw        ; Get the keyword
  1328. comn2:  cmp    #cmifi        ; Parse an input file?
  1329.     bne    comn3        ; No, try next one
  1330.     jmp    cmifil        ; Get the input file
  1331. comn3:  cmp    #cmofi        ; Parse an output file?
  1332.     bne    comn4        ; No, try next
  1333.     jmp    cmofil        ; Get the output file
  1334. comn4:  cmp    #cmswi        ; Parse a switch?
  1335.     bne    comn5        ; No, try next again
  1336.     jmp    cmswit        ; Yes, do a switch
  1337. comn5:  cmp    #cmnum        ; Parse an integer?
  1338.     bne    comn6        ; No, try next type
  1339.     jmp    cminum        ; Do the parse integer routine
  1340. comn6:  cmp    #cmfls        ; Parse a floating point?????
  1341.     bne    comn7        ; Nope, thats it for types
  1342.     jmp    cmflot        ; Yes, go get a floating point number
  1343. comn7:    cmp    #cmtxt        ;  Parse for an unquoted string?
  1344.     bne    comn8        ;  Nope, go try last type
  1345.     jmp    cmunqs        ;  Go parse the string
  1346. comn8:    cmp    #cmtok        ;  Parse for a single character?
  1347.     bne    comn9        ;  Nope, no more parse types
  1348.     jmp    cmtokn        ;  Go parse for char
  1349. comn9:  ldx    #cmer00\    ; Error 0 - Bad parse type
  1350.     ldy    #cmer00^
  1351.     jsr    prstr        ; Print the error text
  1352.     lda    #$04        ; Fail
  1353.     rts            ; Return to caller
  1354.  
  1355. .SBTTL    Cmcfrm routine - get a confirm
  1356.  
  1357. ;
  1358. ;    This routine tries to get a confirm from the command input
  1359. ;    buffer.
  1360. ;
  1361. ;        Input:  Cm.ptr  - Beginning of next field to be parsed
  1362. ;
  1363. ;        Output: On success, routine skip returns
  1364. ;
  1365. ;        Registers destroyed:    A,X,Y
  1366. ;
  1367.  
  1368. cmcfrm: lda    cm.ptr        ; Save the current comand line pointer
  1369.     pha            ;    on the stack in case the user
  1370.     lda    cm.ptr+1    ;    wants to parse for an alternate item
  1371.     pha            ;
  1372. cmcfr0: jsr    cmgtch        ; Get a character
  1373.     cmp    #$00        ; Is it negative?
  1374.     bpl    cmcfrr        ; No, fail
  1375.     and    #$7f        ; Yes, zero the sign bit
  1376.     cmp    #esc        ; An escape?
  1377.     bne    cmcfr2        ; No, continue
  1378.     jsr    bell        ; Sound bell, er
  1379.     lda    #$00        ; Clear AC
  1380.     sta    cmaflg        ; Clear the action flag
  1381.     sec            ; Set carry for subtraction
  1382.     lda    cm.bfp        ; Get L.O. byte
  1383.     sbc    #$01        ; Decrement it once
  1384.     sta    cm.bfp        ; Store it back
  1385.     sta    cm.ptr        ; Make this pointer look like the other one
  1386.     bcs    cmcfr1        ; If set, we don't have to do H.O. byte
  1387.     dec    cm.bfp+1    ; Adjust H.O. byte
  1388. cmcfr1: lda    cm.bfp+1    ; Move this to H.O. byte of the other pointer
  1389.     sta    cm.ptr+1
  1390.     dec    cmccnt        ; Decrement the character count
  1391.     jmp    cmcfr0        ; Try again.
  1392. cmcfr2: cmp    #'?        ; User need help??
  1393.     bne    cmcfr3        ; Nope
  1394.     jsr    cout        ; Print the '?'
  1395.     ldx    #cmin00\    ; Get address of some help info
  1396.     ldy    #cmin00^    ;
  1397.     jsr    prstr        ; Print it.
  1398.     jsr    prcrlf        ; Print the crelf
  1399.     ldx    cm.rty        ;  Get address of prompt
  1400.     ldy    cm.rty+1    ;
  1401.     jsr    prstr        ; Reprint the prompt
  1402.     lda    #$00        ; Clear AC
  1403.     ldy    #$00        ; Clear Y
  1404.     sta    (cm.ptr),y    ; Drop null at end of command buffer
  1405.     sec            ; Set carry for subtraction
  1406.     lda    cm.bfp        ; Get L.O. byte
  1407.     sbc    #$01        ; Decrement it
  1408.     sta    cm.bfp        ; Store it back
  1409.     lda    cm.bfp+1    ; Now do H.O. byte
  1410.     sbc    #$00        ;
  1411.     sta    cm.bfp+1    ;
  1412.     ldx    #cmbuf\        ; Get address of the command buffer
  1413.     ldy    #cmbuf^        ;
  1414.     jsr    prstr        ; Reprint the command line
  1415.     lda    #$00        ; Clear AC
  1416.     sta    cmaflg        ; Action flag off
  1417.     jmp    repars        ; Go reparse the line
  1418. cmcfr3: cmp    #ffd        ; Is it a form feed?
  1419.     bne    cmcfr4        ; Nope
  1420.     jsr    scrclr        ; Yes, blank the screen
  1421. cmcfr4: pla            ; Since this succeeded, we can flush the
  1422.     pla            ;    old command line pointer
  1423.     lda    #$00        ;  Reset the failure flag
  1424.     sta    cmcffl        ; 
  1425.     jmp    rskp        ; Do a return skip
  1426.  
  1427. cmcfrr: pla            ;  Restore the old comand line pointer
  1428.     sta    cm.ptr+1    ; 
  1429.     sta    cmoptr+1    ; 
  1430.     pla            ; 
  1431.     sta    cm.ptr        ; 
  1432.     sta    cmoptr        ; 
  1433.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  1434.     sta    cmocnt        ; 
  1435.     lda    #$ff        ;  Set failure
  1436.     sta    cmcffl        ; 
  1437.     rts            ; Return
  1438.  
  1439. .SBTTL    Cmkeyw - Try to parse a keyword next
  1440.  
  1441. ;
  1442. ;    This routine tries to parse a keyword from the table
  1443. ;    pointed to by cminf1. The keywords must be in alphabetical
  1444. ;    order. The routine returns the two bytes of data associated
  1445. ;    with the keyword. The format of the table is as follows:
  1446. ;
  1447. ;    addr:    .byte    n    ; Where n is the # of entries in the table.
  1448. ;        .byte    m    ; m is the size of the next keyword
  1449. ;        .asciz  /string/; keyword ending in a null
  1450. ;        .byte    a,b    ; 16 bits of data related to keyword
  1451. ;
  1452. ;        Input:  Cminf1- Pointer to keyword table
  1453. ;
  1454. ;        Output: X-    byte a
  1455. ;            Y-    byte b
  1456. ;
  1457. ;        Registers destroyed:    A,X,Y
  1458. ;
  1459.  
  1460. cmkeyw: lda    cm.ptr        ; Save the old comand line pointer
  1461.     pha            ;
  1462.     lda    cm.ptr+1
  1463.     pha            ;
  1464.     lda    #$00        ;  Clear the 'real character' flag
  1465.     sta    cmfrcf        ; 
  1466.     lda    cminf1        ; Copy to address of
  1467.     sta    cmptab        ;    the keyword table
  1468.     clc            ; Clear the carry
  1469.     adc    #$01        ; Add one to the addr. (pass the table length)
  1470.     sta    cmkptr        ; Save the keyword pointer (L.O. byte)
  1471.     lda    cminf1+1    ; Get H.O. byte
  1472.     sta    cmptab+1    ; Save a copy of that
  1473.     bcc    cmkey1        ; Carry?
  1474.     adc    #$00        ; Add in the carry for cmkptr
  1475. cmkey1: sta    cmkptr+1    ; Save it
  1476.     ldy    #$00        ; Clear Y
  1477.     lda    (cmptab),y    ; Get the table length
  1478.     sta    cmentr        ; Save number of entries in the table
  1479. cmky10:    jsr    cmgtch        ; Get first character
  1480.     cmp    #$00        ; Was the first character a terminator?
  1481.     bmi    cmky11        ; Yup, the saved pointer does not get decr.
  1482.     sec            ; Make sure saved buffer pointer is correct
  1483.     lda    cm.ptr        ; Now, reset it back one character for later
  1484.     sbc    #$01        ;
  1485.     sta    cm.ptr        ;
  1486.     sta    cmsptr        ;
  1487.     lda    cm.ptr+1    ;
  1488.     sbc    #$00        ;
  1489.     sta    cm.ptr+1    ;
  1490.     sta    cmsptr+1    ;
  1491.     jmp    cmkey2        ; Continue
  1492. cmky11: ldy    cm.ptr        ; Just move the pointer to the save area
  1493.     sty    cmsptr        ;
  1494.     ldy    cm.ptr+1    ;
  1495.     sty    cmsptr+1    ;
  1496.     and    #$7f        ;[EL] ????
  1497.     cmp    #esc        ;  Was the first terminator an escape?
  1498.     beq    cmky12        ;  Yes, handle this
  1499.     jmp    cmkey2        ;  No, continue
  1500. cmky12:    lda    #cmfdff        ;  Is there a default?
  1501.     bit    cmprmy        ;         ...
  1502.     bne    cmky13        ;  Yes, go copy it
  1503.     lda    #$00        ;  Shut the action flag
  1504.     sta    cmaflg        ;         ...
  1505.     jsr    bell        ;  Yes, start by feeping terminal
  1506.     sec            ;  Set the carry bit for subtraction
  1507.     lda    cm.bfp        ;  Take L.O. byte of buffer pointer
  1508.     sbc    #$01        ;  Decrement it (back up before escape)
  1509.     sta    cm.bfp        ;  Store it
  1510.     sta    cm.ptr        ;  And stuff it in next input char pointer
  1511.     bcs    cmkync        ;  If carry is clear, we are done
  1512.     dec    cm.bfp+1    ;  Do the carry on H.O. byte
  1513. cmkync:    lda    cm.bfp+1    ;  Copy this to next char to parse pointer
  1514.     sta    cm.ptr+1    ;         ...
  1515.     jmp    cmky10        ;  Continue by fetching a character again
  1516. cmky13:    lda    #$00        ;  Zero the action flag
  1517.     sta    cmaflg        ;         ...
  1518.     jmp    cmcpdf        ;   Do the copy    
  1519. cmkey2: lda    cmentr        ; Get number of entries left
  1520.     cmp    #$00        ; 0 entries left?
  1521.     bne    cmky21        ; No, go try next entry
  1522.     pla            ; Fetch back to previous comand line pointer
  1523.     sta    cm.ptr+1    ;        ...
  1524.     sta    cmoptr+1    ;        ...
  1525.     pla            ;        ...
  1526.     sta    cm.ptr        ;        ...
  1527.     sta    cmoptr        ;        ...
  1528.     lda    cmccnt        ; Save count in case of <ctrl/H>
  1529.     sta    cmocnt        ;        ...
  1530.     lda    #$ff        ; Set the command-failure flag
  1531.     sta    cmcffl        ;        ...
  1532.     rts
  1533. cmky21: ldy    #$00        ; Clear Y
  1534.     lda    (cmkptr),y    ; Get length of keyword
  1535.     sta    keylen        ; Store it
  1536.     lda    cmkptr        ; Get the new table pointer
  1537.     sta    cmspt2        ;    and save it for later
  1538.     lda    cmkptr+1    ;        ...
  1539.     sta    cmspt2+1    ;        ...
  1540.     inc    cmkptr        ; Increment the L.O. byte once
  1541.     bne    cmkey3        ; If it didn't wrap, there is no carry
  1542.     inc    cmkptr+1    ; There was a carry, add it in.
  1543. cmkey3: dec    keylen        ; Decrement the number of chars. left
  1544.     lda    keylen        ; Get the remaining length
  1545.     cmp    #$ff        ; Have we passed the end
  1546.     bpl    cmk3a        ; No
  1547.     jmp    cmkey5        ; Yes
  1548. cmk3a:  jsr    cmgtch        ; Get a character
  1549.     cmp    #$00        ; Is it a terminator?
  1550.     bmi    cmk3b        ; Yup, it is negative
  1551.     jmp    cmkey4        ; Nope, it's positive
  1552. cmk3b:  and    #$7f        ; Shut off the minus bit
  1553.     cmp    #'?        ; Need any help?
  1554.     bne    cmky31        ; Nope
  1555.     jsr    cout        ; And print the question mark
  1556.     lda    #$00        ; Clear AC
  1557.     sta    cmaflg        ; Clear the action flag
  1558.     lda    cmstat        ; Get saved parse type
  1559.     cmp    #cmswi        ; Are we really doing a switch?
  1560.     beq    cmk3b1        ; Yes, give that message instead
  1561.     ldx    #cmin01\    ; L.O. byte addr of informational message
  1562.     ldy    #cmin01^    ; H.O. byte of addr
  1563.     jmp    cmk3b2        ; Go print the message
  1564. cmk3b1: ldx    #cmin02\    ; Load address of switch message
  1565.     ldy    #cmin02^    ;        ...
  1566. cmk3b2: jsr    prstr        ; Print the message
  1567.     jsr    prcrlf        ; Print a crelf
  1568.     jsr    cmktp        ;    and the valid entries in keyword table
  1569.     jsr    prcrlf        ; Print another crlf
  1570.     lda    #cmfehf        ;  Load extra help flag
  1571.     bit    cmprmy        ;  Test bit
  1572.     beq    cmk3b3        ;  No extra help
  1573.     jsr    cmehlp        ;  Go give extra help
  1574. cmk3b3:    ldx    cm.rty        ; Get  address of prompt
  1575.     ldy    cm.rty+1    ; 
  1576.     jsr    prstr        ; Reprint the prompt
  1577.     lda    #$00        ; Clear AC
  1578.     ldy    #$00        ; Clear Y
  1579.     sta    (cm.ptr),y    ; Stuff a null in the buffer at that point
  1580.     sec            ; Set the carry
  1581.     lda    cm.bfp        ; Get ready to decrement buffer pointer
  1582.     sbc    #$01        ; Subtract it
  1583.     sta    cm.bfp        ; Store it
  1584.     bcs    cmky3a        ; Do we have to account for carry
  1585.     dec    cm.bfp+1    ; Decrement the H.O. byte
  1586. cmky3a: ldx    #cmbuf\        ; Get  address of buffer
  1587.     ldy    #cmbuf^        ;
  1588.     jsr    prstr        ; Reprint the command line
  1589.     jmp    repars        ; Go reparse all of it
  1590. cmky31: cmp    #esc        ; escape character?
  1591.     beq    cmk3c        ; Yup, process it
  1592.     jmp    cmky35        ; Nope.
  1593. cmk3c:  lda    #$00        ; Clear AC
  1594.     sta    cmaflg        ; Clear action flag
  1595.     lda    keylen        ; Save on the stack, the
  1596.     pha            ;    keylength
  1597.     lda    cmentr        ;    number of entries left
  1598.     pha            ;        ...
  1599.     lda    cmkptr        ;    L.O. byte of keyword table pointer
  1600.     pha            ;        ...
  1601.     lda    cmkptr+1    ;    H.O. byte of keyword table pointer
  1602.     pha            ;        ...
  1603.     jsr    cmambg        ; Is it ambiguous?
  1604.      jmp    cmky32        ; Nope
  1605.     lda    #cmfdff        ;  Load the default-present flag
  1606.     bit    cmprmy        ;  Check against flags
  1607.     beq    cmk3d        ;  No, complain to user
  1608.     lda    cmfrcf        ;  Have we seen a real character yet?
  1609.     bne    cmk3d        ;  No, tell user
  1610.     jmp    cmcpdf        ;  Yes, go copy the default
  1611. cmk3d:    jsr    bell        ; Yes, start by feeping terminal
  1612.     sec            ; Set the carry bit for subtraction
  1613.     lda    cm.bfp        ; Take L.O. byte of buffer pointer
  1614.     sbc    #$01        ; Decrement it (back up before escape)
  1615.     sta    cm.bfp        ; Store it
  1616.     sta    cm.ptr        ; And stuff it in next input char pointer
  1617.     bcs    cmky3b        ; If carry is clear, we are done
  1618.     dec    cm.bfp+1    ; Do the carry on H.O. byte
  1619. cmky3b: lda    cm.bfp+1    ; Copy this to the next char to parse pointer
  1620.     sta    cm.ptr+1    ;        ...
  1621.     dec    cmccnt        ; Decrement the character count
  1622.     pla            ;        ...
  1623.     sta    cmkptr+1    ; Restore the keyword table pointer
  1624.     pla            ;        ...
  1625.     sta    cmkptr        ;
  1626.     pla            ;
  1627.     sta    cmentr        ;    Number of entries left in table
  1628.     pla            ;        ...
  1629.     sta    keylen        ;    And the remaining keylength
  1630.     inc    keylen        ; Adjust the keylength to make it correct
  1631.     jmp    cmkey3        ; And go back to try again
  1632. cmky32: ldy    #$00        ; Clear Y
  1633.     sec            ; Set the carry flag
  1634.     lda    cm.bfp        ; Move buffer pointer behind the escape
  1635.     sbc    #$01        ;        ...
  1636.     sta    cm.bfp        ;        ...
  1637.     sta    cm.ptr        ;        ...
  1638.     bcs    cmk32c        ;        ...
  1639.     dec    cm.bfp+1    ; Have to adjust the H.O. byte
  1640. cmk32c: lda    cm.bfp+1    ;        ...
  1641.     sta    cm.ptr+1    ;        ...
  1642.     pla            ; Fetch the old keytable pointer
  1643.     sta    cmkptr+1    ;        ...
  1644.     pla            ;        ...
  1645.     sta    cmkptr        ;        ...
  1646.     pha            ; Now push it back on the stack
  1647.     lda    cmkptr+1    ;        ...
  1648.     pha            ;        ...
  1649. cmky33: lda    (cmkptr),y    ; Get next character
  1650.     cmp    #$00        ; Done?
  1651.     beq    cmky34        ; Yes
  1652.     tax            ; No, hold on to the byte
  1653.     clc            ; Clear the carry flag
  1654.     lda    cmkptr        ; Adjust the keyword pointer up one place
  1655.     adc    #$01        ; Do L.O. byte
  1656.     sta    cmkptr        ; Store it
  1657.     bcc    cmky3c        ; Carry?
  1658.     inc    cmkptr+1    ; Yes, increment H.O. byte
  1659. cmky3c: txa            ; Get the data
  1660.     sta    (cm.ptr),y    ; Stuff it in the buffer
  1661.     clc            ; Clear the carry flag again
  1662.     lda    cm.ptr        ; Get L.O byte of buffer pointer
  1663.     adc    #$01        ; Increment it
  1664.     sta    cm.ptr        ; Store it
  1665.     bcc    cmky3d        ; Carry?
  1666.     inc    cm.ptr+1    ; Increment H.O. byte
  1667. cmky3d: inc    cmccnt        ; Increment character count
  1668.     jmp    cmky33        ; Get next character from table
  1669. cmky34: inc    cmccnt        ; Incrment the character count
  1670.     lda    #$20        ; Clear AC (this is a terminator!)
  1671.     sta    (cm.ptr),y    ; Stuff a null in the buffer
  1672.     ldx    cm.bfp        ; Get L.O. byte of buffer pointer
  1673.     ldy    cm.bfp+1    ;    and H.O byte - save these for later
  1674.     clc            ; Clear carry
  1675.     lda    cm.ptr        ; Increment next char of input pointer
  1676.     adc    #$01        ;        ...
  1677.     sta    cm.ptr        ;        ...
  1678.     sta    cm.bfp        ;        ...
  1679.     bcc    cmky3e        ; Carry?
  1680.     inc    cm.ptr+1    ; Do H.O. byte
  1681. cmky3e: lda    cm.ptr+1    ; Make buffer pointer match next char pointer
  1682.     sta    cm.bfp+1    ;        ...
  1683.     sty    savey        ; Hold y for a bit
  1684.     lda    #$00        ; Put a null in the buffer to terminate string
  1685.     ldy    #$00        ;        ...
  1686.     sta    (cm.ptr),y    ;        ...
  1687.     ldy    savey        ; Get Y value back
  1688.     jsr    prstr        ; Print remainder of keyword
  1689.     pla            ; Restore the
  1690.     sta    cmkptr+1    ;    H.O. byte of keyword table pointer
  1691.     pla            ;        ...
  1692.     sta    cmkptr        ;     L.O. byte of keyword table pointer
  1693.     pla            ;        ...
  1694.     sta    cmentr        ;    Number of entries left in table
  1695.     pla            ;        ...
  1696.     sta    keylen        ;    And the remaining keylength
  1697.     jmp    cmky37        ; Go get some data to return
  1698. cmky35: lda    cmkptr        ; Save on the stack the  keyword table pointer
  1699.     pha            ;
  1700.     lda    cmkptr+1    ;
  1701.     pha            ;        ...
  1702.     lda    keylen        ;    The keylength
  1703.     pha            ;        ...
  1704.     jsr    cmambg        ; Check for ambiguity
  1705.      jmp    cmky36        ; Not ambiguous
  1706.     ldx    #cmer01\    ; Get addr of ambiguous error
  1707.     ldy    #cmer01^    ;        ...
  1708.     jsr    prstr        ; Print the error message
  1709.     jmp    prserr        ; Go do parsing error stuff
  1710. cmky36: pla            ; Fetch off of the stack 
  1711.     sta    keylen        ;    remaining keylength
  1712.     pla            ;        ...
  1713.     sta    cmkptr+1    ;    H.O. byte of keyword table address
  1714.     pla            ;        ...
  1715.     sta    cmkptr        ;     L.O. byte of keyword table address
  1716. cmky37: inc    keylen        ; Adjust the remaining keylength
  1717.     inc    keylen        ;        ...
  1718.     clc            ; Clear the carry flag
  1719.     lda    cmkptr        ; Get the keyword table pointer
  1720.     adc    keylen        ; Add in remaining keylength
  1721.     sta    cmkptr        ; Store it
  1722.     bcc    cmky3f        ; Carry?
  1723.     inc    cmkptr+1    ; Yes, adjust H.O. byte
  1724. cmky3f: ldy    #$00        ; Make sure Y is clear
  1725.     lda    (cmkptr),y    ; Get first data byte
  1726.     tax            ; Put it in X
  1727.     iny            ; Up the index once
  1728.     lda    (cmkptr),y    ; Get the second data byte
  1729.     tay            ; Put that in Y
  1730.     pla            ; Flush the old comand line pointer
  1731.     pla            ;        ...
  1732.     lda    #$00        ; Reset the failure flag
  1733.     sta    cmcffl        ; 
  1734.     jmp    rskp        ; Return skip means it succeeds!
  1735. cmkey4: cmp    #$41        ; Check range for upper case
  1736.     bmi    cmky41        ;        ...
  1737.     cmp    #$5b        ;        ...
  1738.     bpl    cmky41        ;        ...
  1739.     ora    #$20        ; Cutesy way to convert to lower case
  1740. cmky41: sta    cmwrk3        ; Save the character
  1741.     lda    #$ff        ;  Set the 'real character' flag
  1742.     sta    cmfrcf        ; 
  1743.     ldy    #$00        ; Clear Y again
  1744.     lda    (cmkptr),y    ; Get next keyword byte
  1745.     sta    cmwrk4        ; Hold that for now
  1746.     clc            ; Clear the carry flag
  1747.     lda    cmkptr        ; Get L.O. byte of keyword pointer
  1748.     adc    #$01        ; Add one
  1749.     sta    cmkptr        ; Store it
  1750.     bcc    cmky4a        ; Need to do carry?
  1751.     inc    cmkptr+1    ; Yes, do H.O. byte
  1752. cmky4a: lda    cmwrk3        ; Get input character
  1753.     cmp    cmwrk4        ; Does it match keyword character?
  1754.     bne    cmkey5        ; No, advance to next keyword in table
  1755.     jmp    cmkey3        ; Yup, try next input byte
  1756. cmkey5: inc    keylen        ; Adjust keylength so that it is correct
  1757.     inc    keylen        ;        ...
  1758.     inc    keylen        ;        ...
  1759.     clc            ; Clear carry
  1760.     lda    cmkptr        ; Ok, get keyword pointer and
  1761.     adc    keylen        ; Add the remaining keylength
  1762.     sta    cmkptr        ; Store it
  1763.     bcc    cmky5a        ; See if we have to do carry
  1764.     inc    cmkptr+1    ; Yes, increment H.O. byte
  1765. cmky5a: dec    cmentr        ; Decrement the number of entries left
  1766.     lda    cmsptr        ; Get the saved buffer pointer and
  1767.     sta    cm.ptr        ;    restore it
  1768.     lda    cmsptr+1    ;        ...
  1769.     sta    cm.ptr+1    ;        ...
  1770.     jmp    cmkey2        ; Try to parse this keyword now
  1771.  
  1772. .SBTTL    Cmambg - check if keyword prefix is ambiguous
  1773.  
  1774. ;
  1775. ;    This routine looks at the next keyword in the table and
  1776. ;    determines if the prefix entered in the buffer is ambiguous
  1777. ;    or not. If it is ambiguous, it skip returns, otherwise it
  1778. ;    returns normally.
  1779. ;
  1780. ;        Input:  Cmentr- number of entries left in table
  1781. ;            Cmkptr- current keyword table pointer
  1782. ;            Keylen- remaining keyword length
  1783. ;
  1784. ;        Output: If ambiguous, does a skip return
  1785. ;
  1786. ;        Registers destroyed:    A,X,Y
  1787. ;
  1788.  
  1789. cmambg: dec    cmentr        ; Start by decrementing remaining entries
  1790.     bpl    cma1        ; We still have stuff left
  1791.     rts            ; Nothing left, it can't be ambiguous
  1792. cma1:    inc    keylen        ; Adjust this up by one
  1793.     lda    keylen        ; Save character count
  1794.     sta    cmwrk3        ;        ...
  1795.     clc            ; Clear the carry
  1796.     adc    #$03        ; Adjust the keylength to include terminator
  1797.     sta    keylen        ;    and data bytes
  1798.     clc            ; Clear carry
  1799.     lda    cmkptr        ; Up the keyword table pointer
  1800.     adc    keylen        ;    by remaining keylength
  1801.     sta    cmkptr        ; Save it
  1802.     bcc    cma2        ; Need to adjust H.O byte?
  1803.     inc    cmkptr+1    ; Yes, do it
  1804. cma2:    ldy    #$00        ; Clear Y
  1805.     lda    (cmkptr),y    ; Get keyword length
  1806.     sta    cmwrk4        ; Hold that byte
  1807.     clc            ; Clear carry
  1808.     lda    cmkptr        ; Advance keyword table pointer
  1809.     adc    #$01        ;        ...
  1810.     sta    cmkptr        ;        ...
  1811.     bcc    cma3        ;        ...
  1812.     inc    cmkptr+1    ;        ...
  1813. cma3:    lda    (cmspt2),y    ; Get previous keyword length
  1814.     sec            ; Set carry
  1815.     sbc    cmwrk3        ; Subtract number of characters left
  1816.     beq    cmambs        ;  If test len is 0, don't bother trying
  1817.     sta    cmtlen        ; This is the testing length
  1818.     cmp    cmwrk4        ; Check this against length of new keyword
  1819.     bmi    cmamb0        ; This may be ambiguous
  1820.     rts            ; Test length is longer, cannot be ambiguous
  1821. cmamb0: ldy    #$00        ; Clear Y
  1822. cmamb1: dec    cmtlen        ; Decrement the length to test
  1823.     bpl    cma4        ; Still characters left to check
  1824. cmambs:    jmp    rskp        ;  The whole thing matched, it is ambiguous
  1825. cma4:    lda    (cmkptr),y    ; Get next character of keyword
  1826.     sta    cmwrk3        ; Hold that for now
  1827.     lda    (cmsptr),y    ; Get next parsed character
  1828.     iny            ; Up the pointer once
  1829.     cmp    #$61        ; Check the range for lower case
  1830.     bmi    cmamb2        ;        ...
  1831.     cmp    #$7b        ;        ...
  1832.     bpl    cmamb2        ;        ...
  1833.     and    #$5F        ; Capitalize it
  1834. cmamb2:    and    #$7f        ; Reset the H.O. bit
  1835.     cmp    cmwrk3        ; Same as keyword table character
  1836.     beq    cmamb1        ; Yup, check next character
  1837.     rts            ; Nope, prefix is not ambiguous
  1838.  
  1839.  
  1840. .SBTTL    Cmktp - print entries in keyword table matching prefix
  1841.  
  1842. ;
  1843. ;    This routine steps through the keyword table passed to cmkeyw
  1844. ;    and prints all the keywords with the prefix currently in the
  1845. ;    command buffer. If there is no prefix, it issues an error.
  1846. ;
  1847. ;        Input:  Cmptab- ptr to beginning of table
  1848. ;            Cmsptr- saved buffer pointer
  1849. ;            Cm.ptr- current buffer pointer
  1850. ;
  1851. ;        Output: List of possible keywords to screen
  1852. ;
  1853. ;        Registers destroyed:    A,X,Y
  1854. ;
  1855.  
  1856. cmktp:  lda    cmptab        ; Get a copy of the pointer
  1857.     sta    cminf2        ;    to the beginning of
  1858.     lda    cmptab+1    ;    the current keyword table
  1859.     sta    cminf2+1    ;        ...
  1860.     ldy    #$00        ; Clear Y
  1861.     sty    cmscrs        ; Clear the 'which half of screen' switch
  1862.     sty    cmwrk3        ; Clear the 'print any keywords?' switch
  1863.     lda    (cminf2),y    ; Get the table length
  1864.     sta    cmwrk1        ;    and save it in a safe place
  1865.     sec            ; Prepare for some subtracting
  1866.     lda    cm.ptr        ; Get difference between the current pointer
  1867.     sbc    cmsptr        ;    and pointer to beginning of keyword
  1868.     sta    cmtlen        ; That is how much we must test
  1869.     clc            ; Clear carry
  1870.     lda    cminf2        ; Increment the pointer to the table
  1871.     adc    #$01        ;        ...
  1872.     sta    cminf2        ;        ...
  1873.     bcc    cmktp1        ; Need to increment H.O. byte?
  1874.     inc    cminf2+1    ; Yup
  1875. cmktp1: dec    cmwrk1        ; 1 less keyword to do
  1876.     lda    cmwrk1        ; Now...
  1877.     bmi    cmkdon        ; No keywords left, we are done
  1878.     lda    (cminf2),y    ; Get the keyword length
  1879.     sta    cmkyln        ;    and stuff it
  1880.     clc            ; Clear carry
  1881.     lda    cminf2        ; Increment pointer to table again
  1882.     adc    #$01        ;        ...
  1883.     sta    cminf2        ;        ...
  1884.     bcc    cmktp2        ; Need to up the H.O. byte?
  1885.     inc    cminf2+1    ; Yup
  1886. cmktp2: lda    cmtlen        ; Get test length
  1887.     beq    cmktp3        ; If test length is zero, just print keyword
  1888. cmkp21: lda    (cminf2),y    ; Get character from table
  1889.     cmp    (cmsptr),y    ; Compare it to the buffer character
  1890.     bne    cmadk        ; Nope, advance to next keyword
  1891.     iny            ; Up the index
  1892.     cpy    cmtlen        ; Compare with the test length
  1893.     bmi    cmkp21        ; Not yet, do next character
  1894. cmktp3: jsr    cmprk        ; Print the keyword
  1895.  
  1896. cmadk:  inc    cmkyln        ; Adjust cmkyln to include terminator and data
  1897.     inc    cmkyln        ;        ...
  1898.     inc    cmkyln        ;        ...
  1899.     clc            ; Clear the carry
  1900.     lda    cminf2        ; Get the L.O. byte
  1901.     adc    cmkyln        ; Add in the keyword length
  1902.     sta    cminf2        ; Store it away
  1903.     bcc    cmadk2        ; Need to do the H.O. byte?
  1904.     inc    cminf2+1    ; Yup
  1905. cmadk2: ldy    #$00        ; Zero the index
  1906.     jmp    cmktp1        ; Go back to the top of the loop
  1907.  
  1908. cmkdon: lda    cmwrk3        ; See if we printed anything
  1909.     bne    cmkdn2        ; Yup, go exit
  1910.     lda    cmstat        ; Are we parsing switches or keywords?
  1911.     cmp    #cmswi        ;        ...
  1912.     beq    cmkdse        ; The error should be for switches
  1913.     ldx    #cmer03\    ; Nope, get address of error message
  1914.     ldy    #cmer03^    ;        ...
  1915.     jmp    cmkdn1        ; Go print the message now
  1916. cmkdse: ldx    #cmer04\    ; Get address of switch error message
  1917.     ldy    #cmer04^    ;        ...
  1918. cmkdn1: jsr    prstr        ; Print error
  1919.     jsr    prcrlf        ; Print a crelf
  1920. cmkdn2: lda    cmscrs        ; Where did we end up?
  1921.     beq    cmkdn3        ; Beginning of line, good
  1922.     jsr    prcrlf        ; Print a crelf
  1923. cmkdn3: rts            ; Return
  1924.  
  1925. ;
  1926. ;    Cmprk - prints one keyword from the table. Consults the
  1927. ;        cmscrs switch to see which half of the line it
  1928. ;        is going to and acts accordingly.
  1929. ;
  1930. ;        Input:  Cmscrs- Which half of screen
  1931. ;            Cminf2- Pointer to string to print
  1932. ;
  1933. ;        Output: print keyword on screen
  1934. ;
  1935. ;        Registers destroyed:    A,X,Y
  1936. ;
  1937.  
  1938. cmprk:  lda    #on        ; Make sure to tell them we printed something
  1939.     sta    cmwrk3        ; Put it back
  1940.     lda    cmstat        ; Get saved parse type
  1941.     cmp    #cmswi        ; Is it a switch we are looking for?
  1942.     bne    cmpr2        ;
  1943.     lda    #'/        ; Yes, do not forget slash prefix
  1944.     jsr    cout        ; Print slash
  1945. cmpr2:  ldx    cminf2        ; L.O. byte of string pointer
  1946.     ldy    cminf2+1    ; H.O. byte of string pointer
  1947.     jsr    prstr        ; Print the keyword
  1948.     lda    cmscrs        ; Where were we?
  1949.     bne    cmprms        ; Mid screen
  1950.     jsr    screl0        ; Clear to end of line
  1951.     sec            ;[37] Get cursor coordinates
  1952.     jsr    ploth        ;[37]        ...
  1953.     ldy    #$14        ; Advance cursor to middle of screen
  1954.     clc            ;[DD]        ...
  1955.     jsr    ploth        ;[DD][26]    ...
  1956.     jmp    cmprdn        ; We are done
  1957. cmprms: jsr    prcrlf        ; Print a crelf
  1958. cmprdn: lda    cmscrs        ; Flip the switch now
  1959.     eor    #$01
  1960.     sta    cmscrs        ; Stuff it back
  1961.     rts            ; Return
  1962.  
  1963. .SBTTL    Cmswit - try to parse a switch next
  1964.  
  1965. ;
  1966. ;    This routine tries to parse a switch from the command buffer. It
  1967. ;    first looks for the / and then calls cmkeyw to handle the keyword
  1968. ;    lookup.
  1969. ;
  1970. ;        Input:  Cminf1- Address of keyword table
  1971. ;
  1972. ;        Output: X-    byte a
  1973. ;            Y-    byte b
  1974. ;
  1975. ;        Registers destroyed:    A,X,Y
  1976. ;
  1977.  
  1978. cmswit: lda    cm.ptr        ; Save the old comand line pointer
  1979.     pha            ;    user wants to try another item
  1980.     lda    cm.ptr+1    ;        ...
  1981.     pha            ;        ...
  1982. cmswi0: jsr    cmgtch        ; Go get a character
  1983.     cmp    #$00        ; Action?
  1984.     bmi    cmswi1        ; Yes, process it
  1985.     jmp    cmswi3        ; No, it is a real character
  1986. cmswi1: and    #$7f        ; Turn off the minus
  1987.     cmp    #'?        ; Does the user need help?
  1988.     bne    cmsw12        ; No
  1989.     jsr    cout        ; And print the question mark
  1990.     lda    #$00        ; Clear AC
  1991.     sta    cmaflg        ; Clear Action flag
  1992.     ldx    #cmin02\    ; Low order byte addr of info message
  1993.     ldy    #cmin02^    ; High order byte addr of info message
  1994.     jsr    prstr        ; Print the message
  1995.     jsr    prcrlf        ; Print a crelf
  1996.     jsr    cmktp        ; Any valid entries from keyword table
  1997.     jsr    prcrlf        ; And another crelf
  1998.     lda    #cmfehf        ;  Load extra help flag
  1999.     bit    cmprmy        ;  Test bit
  2000.     beq    cmsw10        ;  No extra help
  2001.     jsr    cmehlp        ;  Go give extra help
  2002. cmsw10:    ldx    cm.rty        ; Load the address of the prompt
  2003.     ldy    cm.rty+1    ;
  2004.     jsr    prstr        ; Reprint it
  2005.     lda    #$00        ; Clear AC
  2006.     ldy    #$00        ; Clear Y
  2007.     sta    (cm.ptr),y    ; Stuff a null at the end of the buffer
  2008.     sec            ; Set the carry flag
  2009.     lda    cm.bfp        ; Increment buffer pointer
  2010.     sbc    #$01        ;        ...
  2011.     sta    cm.bfp        ;        ...
  2012.     bcs    cmsw1a        ; Borrow?
  2013.     dec    cm.bfp+1    ; Yup
  2014. cmsw1a: ldx    #cmbuf\        ; L.O. addr of command buffer
  2015.     ldy    #cmbuf^        ; H.O. byte
  2016.     jsr    prstr        ; Reprint the command line
  2017.     jmp    repars        ; Go reparse everything
  2018. cmsw12: cmp    #esc        ; Lazy??
  2019.     beq    cmsw2a        ; Yes, try to help
  2020.     jmp    cmswi2        ; No, this is something else
  2021. cmsw2a: lda    #$00        ; Clear AC
  2022.     sta    cmaflg        ; Clear action flag
  2023.     lda    #cmfdff        ;  See if there is a default
  2024.     bit    cmprmy        ; 
  2025.     beq    cmswnd        ;  No help, tell user
  2026.     jmp    cmcpdf        ;  Go copy the default
  2027. cmswnd:    jsr    bell        ; Yes, it is ambiguous - ring bell
  2028.     sec            ; Set carry
  2029.     lda    cm.bfp        ; Decrement buffer pointer
  2030.     sbc    #$01        ;        ...
  2031.     sta    cm.bfp        ;        ...
  2032.     sta    cm.ptr        ; Make this pointer point there too
  2033.     bcs    cmsw2b        ; No carry to handle
  2034.     dec    cm.bfp+1    ; Do H.O. byte
  2035. cmsw2b: lda    cm.bfp+1    ; Now make H.O. byte match
  2036.     sta    cm.ptr+1    ;        ...
  2037.     dec    cmccnt        ; Decrement the character count
  2038.     jmp    cmswi0        ; Try again
  2039. cmsw2c: lda    #'/        ; Load a slash
  2040.     jsr    cout        ; Print slash
  2041.     clc            ; Clear carry
  2042.     lda    cminf1        ; Set the keyword table pointer
  2043.     adc    #$02        ;    to point at the beginning
  2044.     sta    cmkptr        ;    of the keyword and move it
  2045.     lda    cminf1+1    ;    to cmkptr
  2046.     bcc    cmsw2d        ;        ...
  2047.     adc    #$00        ;        ...
  2048. cmsw2d: sta    cmkptr+1    ;        ...
  2049.     ldy    #$00        ; Clear Y
  2050.     sec            ; Set carry
  2051.     lda    cm.bfp        ; Increment the buffer pointer
  2052.     sbc    #$01        ;        ...
  2053.     sta    cm.bfp        ;        ...
  2054.     bcs    cmsw2e        ;        ...
  2055.     dec    cm.bfp+1    ;        ...
  2056. cmsw2e: lda    (cmkptr),y    ; Get next character
  2057.     cmp    #$00        ; Done?
  2058.     beq    cmsw13        ; Yes
  2059.     tax            ; No, hold on to the byte
  2060.     clc            ;    while we increment the pointer
  2061.     lda    cmkptr        ; Do L.O. byte
  2062.     adc    #$01        ;        ...
  2063.     sta    cmkptr        ;        ...
  2064.     bcc    cmsw2f        ; And, if neccesary
  2065.     inc    cmkptr+1    ;    the H.O. byte as well
  2066. cmsw2f: txa            ; Get the data
  2067.     sta    (cm.ptr),y    ; Stuff it in the buffer
  2068.     clc            ; Clear carry
  2069.     lda    cm.ptr        ; Increment the next character pointer
  2070.     adc    #$01        ;        ...
  2071.     sta    cm.ptr        ;        ...
  2072.     bcc    cmsw2g        ;        ...
  2073.     inc    cm.ptr+1    ;        ...
  2074. cmsw2g: inc    cmccnt        ; Increment the character count
  2075.     jmp    cmsw2e        ; Get next character from table
  2076. cmsw13: inc    cmccnt        ; Increment the character count
  2077.     lda    #$00        ; Clear AC
  2078.     sta    (cm.ptr),y    ; Stuff a null in the buffer
  2079.     ldx    cm.bfp        ; Hold on to this pointer
  2080.     ldy    cm.bfp+1    ;    for later printing of switch
  2081.     clc            ; Clear carry
  2082.     lda    cm.ptr        ; Now make both pointers look like
  2083.     adc    #$01        ;    (cm.ptr)+1
  2084.     sta    cm.ptr        ;        ...
  2085.     sta    cm.bfp        ;        ...
  2086.     bcc    cmsw3a        ;        ...
  2087.     inc    cm.ptr+1    ;        ...
  2088. cmsw3a: lda    cm.ptr+1    ; Copy H.O. byte
  2089.     sta    cm.bfp+1    ;        ...
  2090.     jsr    prstr        ; Now print string with pointer saved earlier
  2091.     ldx    #$01        ; Set up argument
  2092.     jsr    prbl2        ; Print one blank
  2093. cmsw14: clc            ; Clear carry
  2094.     lda    cmkptr        ; Increment keyword pointer
  2095.     adc    #$01        ; Past null terminator
  2096.     sta    cmkptr        ;        ...
  2097.     bcc    cmsw4a        ;        ...
  2098.     inc    cmkptr+1    ;        ...
  2099. cmsw4a: ldy    #$00        ; Clear Y
  2100.     lda    (cmkptr),y    ; Get first data byte
  2101.     tax            ; Put it here
  2102.     iny            ; Up the index
  2103.     lda    (cmkptr),y    ; Get second data byte
  2104.     tay            ; Put that in Y
  2105.     pla            ; Flush the old comand line pointer
  2106.     pla            ;        ...
  2107.     lda    #$00        ;  Clear the failure flag
  2108.     sta    cmcffl        ;         ...
  2109.     jmp    rskp        ; And give a skip return
  2110. cmswi2: ldy    #$00        ; Clear Y
  2111.     lda    (cminf1),y    ; Get length of table
  2112.     cmp    #$02        ; Greater than 1
  2113.     bmi    cmsw21        ; No, go fetch data
  2114.     ldx    #cmer01\    ; Yes, fetch pointer to error message
  2115.     ldy    #cmer01^    ;        ...
  2116.     jsr    prstr        ; Print the error
  2117.     jmp    prserr        ; And go handle the parser error
  2118. cmsw21: iny            ; Add one to the index
  2119.     lda    (cminf1),y    ; Get the length of the keyword
  2120.     sta    keylen        ; Save that
  2121.     lda    cminf1+1    ; Copy pointer to table
  2122.     sta    cmkptr+1    ;        ...
  2123.     clc            ; Get set to increment an address
  2124.     lda    cminf1        ; Do L.O. byte last for efficiency
  2125.     adc    keylen        ; Add in the keyword length
  2126.     adc    #$02        ; Now account for table length and terminator
  2127.     sta    cmkptr        ; Save the new pointer
  2128.     bcc    cmsw22        ; If no carry, continue
  2129.     inc    cmkptr+1    ; Adjust H.O. byte
  2130. cmsw22: jmp    cmsw4a        ; Go to load data and skip return
  2131. cmswi3: cmp    #'/        ; Is the real character a slash?
  2132.     beq    cmswi4        ; Yes, go do the rest
  2133.     tax            ; Move the data byte
  2134.     lda    #$00        ; Clear AC
  2135.     pla            ; Fetch back the old comand line pointer
  2136.     sta    cm.ptr+1    ;        ...
  2137.     sta    cmoptr+1    ;         ...
  2138.     pla            ;        ...
  2139.     sta    cm.ptr        ;        ...
  2140.     sta    cmoptr        ;        ...
  2141.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2142.     sta    cmocnt        ;  
  2143.     lda    #$ff        ;  Set failure  flag
  2144.     sta    cmcffl        ;         ...
  2145.     rts            ; Fail - non-skip return
  2146. cmswi4: jsr    cmkeyw        ; Let Keyw do the work for us
  2147.      jmp    cmswi5        ; We had problems, restore comand ptr and ret.
  2148.     pla            ; Flush the old comand pointer
  2149.     pla
  2150.     lda    #$00        ;  Reset the failre flag
  2151.     sta    cmcffl        ; 
  2152.     jmp    rskp        ; Success - skip return!
  2153. cmswi5: pla            ; Fetch back the old comand line pointer
  2154.     sta    cm.ptr+1    ;        ...
  2155.     sta    cmoptr+1    ;         ...
  2156.     pla            ;        ...
  2157.     sta    cm.ptr        ;        ...
  2158.     sta    cmoptr        ;         ...
  2159.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2160.     sta    cmocnt        ; 
  2161.     lda    #$ff        ;  Set failure flag
  2162.     sta    cmcffl        ; 
  2163.     rts            ; Now return
  2164.  
  2165. .SBTTL    Cmifil - try to parse an input file spec next
  2166.  
  2167. ;
  2168. ;    This routine attempts to parse an input file spec.
  2169. ;
  2170. ;        Input:  X - Max filename length
  2171. ;
  2172. ;        Output: Filename parsed is in buffer pointed to by X,Y
  2173. ;
  2174. ;        Registers destroyed:    A,X,Y
  2175. ;
  2176.  
  2177. cmifil: inx            ;  Increment max file length for tests
  2178.     stx    cmprmx        ;  Maximum filename length
  2179.     lda    cm.ptr        ; Save the old comand line pointer in case
  2180.     pha            ;
  2181.     lda    cm.ptr+1    ;
  2182.     pha            ;
  2183.     lda    #$00        ; Zero the
  2184.     sta    lenabf        ;  length of the atom buffer
  2185. cmifl0: ldy    #$00        ; Zero Y
  2186.     lda    #'          ; Blank the AC 
  2187. ;    ora    #$80        ; Make it look like a terminator
  2188. cmifi0: sta    atmbuf,y    ; Now zero the buffer
  2189.     iny            ;        ...
  2190.     cpy    cmprmx      ;  Done?
  2191.     bpl    cmifi1        ; Yes, start parsing
  2192.     jmp    cmifi0        ; No, continue blanking
  2193. cmifi1: jsr    cmgtch        ; Get a character from command buffer
  2194.     cmp #$a0        ; we are special caseing the space stuff
  2195.     bne cmif22        ; so it is not an action char
  2196.     lda #sp
  2197. cmif22:
  2198.     cmp    #$00        ; Is it an action character?
  2199.     bmi    cmif10        ;  Yes, check it out
  2200.     jmp    cmifi2        ;  No , process it as a normal character
  2201. cmif10:    and    #$7f        ;  Yes, turn off the minus bit
  2202.     cmp    #'?        ; Does the user need help?
  2203.     bne    cmif12        ; Nope
  2204.     jsr    cout        ; And print the question mark
  2205.     ldy    #$00        ; Yes
  2206.     sty    cmaflg        ; Clear the action flag
  2207.     ldx    #cmin03\    ; Now get set to give the 'file spec' message
  2208.     ldy    #cmin03^    ;        ...
  2209.     jsr    prstr        ; Print it
  2210.     jsr    prcrlf        ; Print a crelf
  2211.     lda    #cmfehf        ;  Load extra help flag
  2212.     bit    cmprmy        ;  Test bit
  2213.     beq    cmifnh        ;  No extra help
  2214.     jsr    cmehlp        ;  Go give extra help
  2215. cmifnh:    ldx    cm.rty        ;  Set up to reprint the prompt
  2216.     ldy    cm.rty+1    ;        ...
  2217.     jsr    prstr        ; Do it
  2218.     sec            ; Set the carry flag for subtraction
  2219.     lda    cm.bfp        ; Get the buffer pointer
  2220.     sbc    #$01        ; Decrement it once
  2221.     sta    cm.bfp        ;        ...
  2222.     bcs    cmif11        ; If it's set, we need not do H.O. byte
  2223.     dec    cm.bfp+1    ; Adjust the H.O. byte
  2224. cmif11: dec    cmccnt        ; Decrement the character count
  2225.     ldy    #$00        ; Clear Y
  2226.     lda    #$00        ; Clear AC
  2227.     sta    (cm.bfp),y    ; Stuff a null at the end of the command buffer
  2228.     ldx    #cmbuf\        ; Now get the address of the command buffer
  2229.     ldy    #cmbuf^        ;        ...
  2230.     jsr    prstr        ; Reprint the command line
  2231.     jmp    cmifi1        ; Go back and continue
  2232. cmif12: cmp    #esc        ; Got an escape?
  2233.     bne    cmif13        ; No
  2234.     lda    #$00        ; Yup, clear the action flag
  2235.     sta    cmaflg        ;        ...
  2236.     lda    #cmfdff        ;  Load default-present flag
  2237.     bit    cmprmy        ;  Test bit
  2238.     beq    cmifnd        ;  No default
  2239.     lda    lenabf        ;  Now check if user typed anything
  2240.     bne    cmifnd        ;  Yup, can't use default
  2241.     jmp    cmcpdf        ;  Go copy the default
  2242. cmifnd:    jsr    bell        ; Escape does not work here, ring the bell
  2243.     sec            ; Set carry for subtraction
  2244.     lda    cm.bfp        ; Decrement the buffer pointer
  2245.     sbc    #$01        ;    once
  2246.     sta    cm.bfp        ;        ...
  2247.     sta    cm.ptr        ; Make both pointers look at the same spot
  2248.     lda    cm.bfp+1    ;        ...
  2249.     sbc    #$00        ; H.O. byte adjustment
  2250.     sta    cm.bfp+1    ;        ...
  2251.     sta    cm.ptr+1    ;        ...
  2252.     dec    cmccnt        ; Decrement the character count
  2253.     jmp    repars        ;    and go reparse everything
  2254. cmif13: lda    lenabf        ;  Get the length of the buffer
  2255.     cmp    #$00        ; Is it zero?
  2256.     bne    cmif14        ; No, continue
  2257.     jmp    cmifi9        ; Yes, this is not good
  2258. cmif14: cmp    cmprmx      ;  Are we over the maximum file length?
  2259.     bmi    cmif15        ; Not quite yet
  2260.     jmp    cmifi9        ; Yes, blow up
  2261. cmif15: ldy    lenabf        ;  Get the filename length
  2262.     lda    #nul        ;    and stuff a null at that point
  2263.     sta    atmbuf,y    ; 
  2264.     pla            ; Flush the old comand line pointer
  2265.     pla            ;        ...
  2266.     ldx    #atmbuf\    ;  Set up the atombuffer address
  2267.     ldy    #atmbuf^    ;        ...
  2268.     lda    #$00        ;  Reset the failure flag
  2269.     sta    cmcffl        ; 
  2270.     lda    lenabf        ;  Load length into AC to be passed back
  2271.     jmp    rskp        ; No, we are successful
  2272. cmifi2: 
  2273.     cmp    #$61        ; Lower case alphabetic?
  2274.     bmi    cmifi8        ; Don't capitalize if it's not alphabetic
  2275.     cmp    #$7b        ;        ...
  2276.     bpl    cmifi8        ;        ...
  2277.     and    #$5f        ; Capitalize
  2278. cmifi8: ldy    lenabf        ;  Set up length of buffer in Y
  2279.     sta    atmbuf,y    ;  Stuff character in FCB
  2280.     inc    lenabf        ;  Increment the length of the name
  2281.     jmp    cmifi1        ; Go back for the next character
  2282. cmifi9: pla            ; Restore the old comand line pointer
  2283.     sta    cm.ptr+1    ;  in case the user wants to parse
  2284.     sta    cmoptr+1    ;         ...
  2285.     pla            ;    for something else
  2286.     sta    cm.ptr        ;        ...
  2287.     sta    cmoptr        ;         ...
  2288.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2289.     sta    cmocnt        ;         ...
  2290.     lda    #$ff        ;  Set failure flag
  2291.     sta    cmcffl        ; 
  2292.     rts
  2293.  
  2294. .SBTTL    Cmofil - try to parse an output file spec
  2295.  
  2296. ;
  2297. ;    This routine attempts to parse an output file spec from the
  2298. ;    command buffer.
  2299. ;
  2300. ;        Input:  cminf1- Pointer to FCB
  2301. ;
  2302. ;        Output:
  2303. ;
  2304. ;        Registers destroyed:
  2305. ;
  2306.  
  2307. cmofil: jmp    cmifil        ; Same as parsing input file spec for now
  2308.  
  2309. .SBTTL    Cminum - Try to parse an integer number
  2310.  
  2311. ;
  2312. ;    This routine tries to parse an integer number in the base
  2313. ;    specified. It will return a 16-bit number in cmintg.
  2314. ;    Cmintg is formatted H.O. byte first!
  2315. ;
  2316. ;        Input:  X-    Base of integer (2<=x<=16)
  2317. ;
  2318. ;        Output: Cmintg- 16-bit integer
  2319. ;
  2320. ;        Registers destroyed:    A,X,Y
  2321. ;
  2322.  
  2323. cminum: lda    cm.ptr        ; Save the old comand line pointer
  2324.     pha            ;        ...
  2325.     lda    cm.ptr+1    ;        ...
  2326.     pha            ;        ...
  2327.     cpx    #$11        ; Are we within the proper range?
  2328.     bmi    cmin1        ; If so, check high range
  2329.     jmp    cmine1        ; No, tell them about it
  2330. cmin1:  cpx    #$02        ; Too small of a base??
  2331.     bpl    cmin2        ; No, continue
  2332.     jmp    cmine1        ; Base too small, tell them about it
  2333. cmin2:  stx    cmbase        ; The base requested is good, store it
  2334.     lda    #$00        ; Clear AC
  2335.     sta    cmmres        ;    and initialize these areas
  2336.     sta    cmmres+1    ;        ...
  2337.     sta    cmmres+2    ;        ...
  2338.     sta    cmmres+3    ;        ...
  2339.     sta    cmintg        ;        ...
  2340.     sta    cmintg+1    ;        ...
  2341.     sta    cmintg+2    ;        ...
  2342.     sta    cmintg+3    ;        ...
  2343. cminm1: jsr    cmgtch        ; Get next character from command buffer
  2344.     cmp    #$00        ; Is this an action character
  2345.     bmi    cmin1a        ; Yes, handle it
  2346.     jmp    cminm4        ; No, look for a digit
  2347. cmin1a: and    #$7f        ; It is, turn off the H.O. bit
  2348.     cmp    #esc        ; Is it an escape?
  2349.     bne    cminm2        ; No, try something else
  2350.     lda    #cmfdff        ;  Load default-present flag
  2351.     bit    cmprmy        ;  Test bit
  2352.     beq    cminnd        ;  No, default
  2353.     lda    cmmres        ;  Check if user typed anything significant
  2354.     ora    cmmres+1    ;         ...
  2355.     bne    cminnd        ;  Yup, can't use default
  2356.     jmp    cmcpdf        ;  Go copy the default
  2357. cminnd:    jsr    bell        ; Yes, but escape is not allowed, ring bell
  2358.     lda    #$00        ; Zero
  2359.     sta    cmaflg        ;    the action flag
  2360.     sec            ; Set the carry flag for subtraction
  2361.     lda    cm.bfp        ; Get the command buffer pointer
  2362.     sbc    #$01        ; Decrement it once
  2363.     sta    cm.bfp        ; Store it away
  2364.     sta    cm.ptr        ; Make this pointer look like it also
  2365.     bcs    cmin11        ; If carry set don't adjust H.O. byte
  2366.     dec    cm.bfp+1    ; Adjust the H.O. byte
  2367. cmin11: lda    cm.bfp+1    ; Move a copy of this H.O. byte
  2368.     sta    cm.ptr+1    ;    to this pointer
  2369.     dec    cmccnt        ; Decrement the character count
  2370.     jmp    cminm1        ; Go try for another character
  2371. cminm2: cmp    #'?        ; Does the user need help?
  2372.     bne    cminm3        ; If not, back up the pointer and accept
  2373.     jsr    cout        ; And print the question mark
  2374.     ldx    #cmin05\    ; Set up the pointer to info message to be
  2375.     ldy    #cmin05^    ;    printed
  2376.     jsr    prstr        ; Print the text of the message
  2377.     lda    cmbase        ; Get the base of the integer number
  2378.     cmp    #$0a        ; Is it greater than decimal 10?
  2379.     bmi    cmin21        ; No, just print the L.O. digit
  2380.     clc            ; Clear the carry
  2381.     lda    #$01        ; Print the H.O. digit as a 1
  2382.     adc    #$30        ; Make it printable
  2383.     jsr    cout        ; Print the '1'
  2384.     lda    cmbase        ; Get the base back
  2385.     sec            ; Set the carry flag for subtraction
  2386.     sbc    #$0a        ; Subtract off decimal 10
  2387. cmin21: clc            ; Clear carry for addition
  2388.     adc    #$30        ; Make it printable
  2389.     jsr    cout        ; Print the digit
  2390.     jsr    prcrlf        ; Print a crelf
  2391.     lda    #cmfehf        ;  Load extra help flag
  2392.     bit    cmprmy        ;  Test bit
  2393.     beq    cminnh        ;  No extra help
  2394.     jsr    cmehlp        ;  Go give extra help
  2395. cminnh:    ldx    cm.rty        ; Set up the pointer so we can print the prompt
  2396.     ldy    cm.rty+1    ;        ...
  2397.     jsr    prstr        ; Reprint the prompt
  2398.     lda    #$00        ; Clear AC
  2399.     ldy    #$00        ; Clear Y
  2400.     sta    (cm.ptr),y    ; Drop a null at the end of the command buffer
  2401.     sec            ; Set the carry flag for subtraction
  2402.     lda    cm.bfp        ; Get the L.O. byte of the address
  2403.     sbc    #$01        ; Decrement it once
  2404.     sta    cm.bfp        ; Store it back
  2405.     bcs    cmin22        ; If carry set, don't adjust H.O. byte
  2406.     dec    cm.bfp+1    ; Adjust H.O. byte
  2407. cmin22: ldx    #cmbuf\        ; Get the address of the command buffer
  2408.     ldy    #cmbuf^        ;        ...
  2409.     jsr    prstr        ; Reprint the command buffer
  2410.     lda    #$00        ; Clear the
  2411.     sta    cmaflg        ;    action flag
  2412.     jmp    repars        ; Reparse everything
  2413. cminm3: ldx    cmmres        ;  Move L.O. byte
  2414.     ldy    cmmres+1    ;  Move H.O. byte
  2415.     pla            ; Flush the old comand line pointer
  2416.     pla            ;        ...
  2417.     lda    #$00        ;  Reset the failure flag
  2418.     sta    cmcffl        ; 
  2419.     jmp    rskp        ;
  2420. cminm4: cmp    #$60        ; Is this a letter?
  2421.     bmi    cmin41        ; Nope, skip this stuff
  2422.     sec            ; It is, bring it into the proper range
  2423.     sbc    #$27        ;        ...
  2424. cmin41: sec            ; Set carry for subtraction
  2425.     sbc    #$30        ; Make the number unprintable
  2426.     cmp    #$00        ; Is the number in the proper range?
  2427.     bmi    cminm5        ; No, give an error
  2428.     cmp    cmbase        ;        ...
  2429.     bmi    cminm6        ; This number is good
  2430. cminm5: pla            ; Restore the old comand line pointer
  2431.     sta    cm.ptr+1    ;        ...
  2432.     sta    cmoptr        ;         ...
  2433.     pla            ;        ...
  2434.     sta    cm.ptr        ;        ...
  2435.     sta    cmoptr        ;         ...
  2436.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2437.     sta    cmocnt        ;         ...
  2438.     lda    #$ff        ;  Set failure flag
  2439.     sta    cmcffl        ;         ...
  2440.     rts            ; Then return
  2441. cminm6: pha            ; Save the number to add in
  2442.     lda    cmmres+1    ; Move the number to multiply
  2443.     pha            ;     onto the stack for 
  2444.     lda    cmmres        ;    call to mul16
  2445.     pha            ;        ...
  2446.     lda    #$00        ; Move base onto the stack (H.O. byte first)
  2447.     pha            ;        ...
  2448.     lda    cmbase        ;        ...
  2449.     pha            ;        ...
  2450.     jsr    mul16        ; Multiply this out
  2451.     pla            ; Get L.O. byte of product
  2452.     sta    cmmres        ; Store it for now
  2453.     pla            ; Get H.O. byte of product
  2454.     sta    cmmres+1    ; Store that too
  2455.     pla            ; Get the digit to add in
  2456.     clc            ; Clear the carry for the add
  2457.     adc    cmmres        ; Add in L.O. byte of result
  2458.     sta    cmmres        ; Store it back
  2459.     lda    cmmres+1    ; Get the H.O. byte
  2460.     adc    #$00        ; Add in the carry
  2461.     sta    cmmres+1    ; Save the H.O. byte
  2462.     bcs    cmine2        ; Wrong, we overflowed
  2463.     jmp    cminm1        ; Try for the next digit
  2464. cmine1: ldx    #cmer06\    ; Get the address of the error message
  2465.     ldy    #cmer06^    ;        ...
  2466.     jsr    prstr        ; Print the error
  2467.     jmp    prserr        ; Handle the parse error
  2468. cmine2: ldx    #cmer07\    ; Get the address of the error message
  2469.     ldy    #cmer07^    ;        ...
  2470.     jsr    prstr        ; Print the error message
  2471.     jmp    prserr        ; Handle the error
  2472.  
  2473. .SBTTL    Cmflot - Try to parse a floating point number
  2474.  
  2475. ;
  2476. ;    This routine tries to parse a floating point number in the
  2477. ;    format:
  2478. ;        sd-d.d-dEsddd
  2479. ;
  2480. ;        s is an optional sign bit
  2481. ;        d is a decimal digit
  2482. ;        E is the letter 'E'
  2483. ;        . is a decimal point
  2484. ;
  2485. ;        Input:
  2486. ;
  2487. ;        Output: Cmfltp- 6 byte floating point number
  2488. ;                4.5 byte signed mantissa
  2489. ;                1.5 byte signed exponent
  2490. ;
  2491. ;
  2492. ;        bit    0 1      35 36 37    47
  2493. ;
  2494. ;        Registers destroyed:    A,X,Y
  2495. ;
  2496.  
  2497. cmflot: rts
  2498.  
  2499. .SBTTL    Cmunqs - Try to parse an unquoted string
  2500.  
  2501. ;
  2502. ;    This routine tries to parse an unquoted string terminating
  2503. ;    with one of the break characters in brkwrd.
  2504. ;
  2505. ;        Input:    
  2506. ;
  2507. ;        Output:    X - L.O. byte address of ASCII string
  2508. ;            Y - H.O. byte address of ASCII string
  2509. ;            A - Length of string parsed
  2510. ;
  2511. ;        Registers destroyed:    A,X,Y
  2512. ;
  2513.  
  2514. cmunqs:    lda    cm.ptr        ; Save the command buffer pointer
  2515.     pha            ;        ...
  2516.     lda    cm.ptr+1    ;        ...
  2517.     pha            ;        ...
  2518.     lda    #$00        ; Zero length of Atom buffer
  2519.     sta    lenabf        ;        ...
  2520. cmunq1:    jsr    cmgtch        ; Get a character
  2521.     jsr    chkbrk        ; Is it one of the break characters?
  2522.      jmp    cmunq3        ; Yes, handle that condition
  2523.     cmp    #$00        ; No, is it an action character?
  2524.     bpl    cmunq2        ; No, handle it as normal text
  2525.     and    #$7f        ; We don't need the H.O. bit
  2526.     cmp    #'?        ; Does the user need help?
  2527.     bne    cmun13        ; Nope, try next possibility
  2528.     jsr    cout        ; Print '?'
  2529.     ldy    #$00        ; Zero the action flag
  2530.     sty    cmaflg        ;        ...
  2531.     ldx    #cmin06\    ; Get the help message
  2532.     ldy    #cmin06^    ;        ...
  2533.     jsr    prstr        ;    and print it.
  2534.     jsr    prcrlf        ; Print a crelf after it
  2535.     lda    #cmfehf        ; Check for extra help.
  2536.     bit    cmprmy        ;        ...
  2537.     beq    cmun11        ; If no help, continue
  2538.     jsr    cmehlp        ; Process extra help
  2539. cmun11:    ldx    cm.rty        ; Go reprint prompt
  2540.     ldy    cm.rty+1    ;        ...
  2541.     jsr    prstr        ;        ...
  2542.     sec            ; Adjust buffer pointer
  2543.     lda    cm.bfp        ;        ...
  2544.     sbc    #$01        ;        ...
  2545.     sta    cm.bfp        ;        ...
  2546.     bcs    cmun12        ;        ...
  2547.     dec    cm.bfp+1    ; Adjust H.O. byte
  2548. cmun12:    dec    cmccnt        ; Correct character count
  2549.     ldy    #$00        ; Stuff a null at end of usable buffer
  2550.     lda    #$00        ;        ...
  2551.     sta    (cm.bfp),y    ;        ...
  2552.     ldx    #cmbuf\        ; Reprint command line
  2553.     ldy    #cmbuf^        ;        ...
  2554.     jsr    prstr        ;        ...
  2555.     jmp    cmunq1        ; Go back for more characters
  2556. cmun13:    cmp    #esc        ; Did the user type <esc>?
  2557.     bne    cmunq2        ; No, just stuff the character and cont.
  2558.     lda    #$00        ; Clear the action flag
  2559.     sta    cmaflg        ;        ...
  2560.     lda    #cmfdff        ; Check if there is a default value
  2561.     bit    cmprmy        ;        ...
  2562.     beq    cmun14        ; If not, the <esc> loses
  2563.     lda    lenabf        ; Ok, there is a default, but if
  2564.     bne    cmun14        ;    something has been typed, <esc> loses
  2565.     jmp    cmcpdf        ; Go copy default and reparse
  2566. cmun14:    jsr    bell        ; Feep at user
  2567.     sec            ;    and reset the buffer pointer
  2568.     lda    cm.bfp        ;        ...
  2569.     sbc    #$01        ;        ...
  2570.     sta    cm.bfp        ;        ...
  2571.     sta    cm.ptr        ;        ...
  2572.     lda    cm.bfp+1    ;        ...
  2573.     sbc    #$00        ;        ...
  2574.     sta    cm.bfp+1    ;        ...
  2575.     sta    cm.ptr+1    ;        ...
  2576.     dec    cmccnt        ; Adjust the character count
  2577.     jmp    repars        ;    and reparse the command line
  2578. cmunq2:    ldy    lenabf        ; Fetch where we are in atmbuf
  2579.     sta    atmbuf,y    ;    and store our character there
  2580.     inc    lenabf        ; Reflect increased length
  2581.     jmp    cmunq1        ; Go back for more characters
  2582. cmunq3:    lda    lenabf        ; Get the length
  2583.     beq    cmunqf        ; If we parsed a null string, fail
  2584.     pla            ; Flush old command line pointer
  2585.     pla            ;        ...
  2586.     ldx    #atmbuf\    ; Now, set up the return parameter
  2587.     ldy    #atmbuf^    ;        ...
  2588.     lda    #$00        ; Reset the failure flag
  2589.     sta    cmcffl        ;        ...
  2590.     lda    lenabf        ; Set up atom length
  2591.     jmp    rskp        ; Return
  2592. cmunqf:    pla            ; Restore old command line pointer
  2593.     sta    cm.ptr+1    ;        ...
  2594.     sta    cmoptr+1    ;        ...
  2595.     pla            ;        ...
  2596.     sta    cm.ptr        ;        ...
  2597.     sta    cmoptr        ;        ...
  2598.     lda    cmccnt        ; Save count in case of <ctrl/H>
  2599.     sta    cmocnt        ;        ...
  2600.     lda    #$ff        ; Set failure flag
  2601.     sta    cmcffl        ;        ...
  2602.     rts            ; Return
  2603.  
  2604. .SBTTL    Cmtokn - Try to parse for a single character token
  2605.  
  2606. ;
  2607. ;    This routine tries to parse for the character in the X-register.
  2608. ;
  2609. ;        Input:    X - Character to be parsed    
  2610. ;
  2611. ;        Output: +1 - failed to find character
  2612. ;            +4 - success, found character
  2613. ;
  2614. ;        Registers destroyed:    A,X,Y
  2615. ;
  2616.  
  2617. cmtokn:    lda    cm.ptr        ; First, save the old command pointer
  2618.     pha            ;    on the stack
  2619.     lda    cm.ptr+1    ;        ...
  2620.     pha            ;        ...
  2621. cmtk0:    jsr    cmgtch        ; Fetch the next character
  2622.     bpl    cmtk3        ; Not an action character
  2623.     and    #$7f        ; It's an action character
  2624.     cmp    #esc        ; User trying to be lazy?
  2625.     bne    cmtk2        ; Nope, try next option
  2626.     jsr    bell        ; Yes, well, he's not allowed to be lazy
  2627.     lda    #$00        ; Clear the action flag
  2628.     sta    cmaflg        ;        ...
  2629.     sec            ; Adjust the buffer pointer back once
  2630.     lda    cm.bfp        ;        ...
  2631.     sbc    #$01        ;        ...
  2632.     sta    cm.bfp        ;        ...
  2633.     sta    cm.ptr        ; Copy it into command pointer
  2634.     bcs    cmtk1        ; Need to adjust H.O. byte?
  2635.     dec    cm.bfp+1    ; Yes, do it
  2636. cmtk1:    lda    cm.bfp+1    ; Copy it to command pointer
  2637.     sta    cm.ptr+1    ;        ...
  2638.     dec    cmccnt        ; Adjust the character count
  2639.     jmp    cmtk0        ;    and try again
  2640. cmtk2:    cmp    #'?        ; User need help?
  2641.     bne    cmtk4        ; No, go fail
  2642.     jsr    cout        ; Print it
  2643.     ldx    #cmin07\    ; Point to the information message
  2644.     ldy    #cmin07^    ;        ...
  2645.     jsr    prstr        ;    and print it
  2646.     lda    #dquot        ; Print the character we are looking for
  2647.     jsr    cout        ;    in between double quotes
  2648.     lda    cmprmx        ;        ...
  2649.     jsr    cout        ;        ...
  2650.     lda    #dquot        ;        ...
  2651.     jsr    cout        ;        ...
  2652.     jsr    prcrlf        ; End it with a crelf
  2653.     lda    #cmfehf        ; Load extra help flag
  2654.     bit    cmprmy        ; Test bit
  2655.     beq    cmtknh        ; No extra help
  2656.     jsr    cmehlp        ; Go give extra help
  2657. cmtknh:    ldx    cm.rty        ; Point to prompt
  2658.     ldy    cm.rty+1    ;        ...
  2659.     jsr    prstr        ;    and print it
  2660.     sec            ; Adjust the buffer pointer back one
  2661.     lda    cm.bfp        ;        ...
  2662.     sbc    #$01        ;        ...
  2663.     sta    cm.bfp        ;        ...
  2664.     lda    cm.bfp+1    ;        ...
  2665.     sbc    #$00        ;        ...
  2666.     sta    cm.bfp+1    ;        ...
  2667.     lda    #$00        ; Stuff a null at the end of the buffer
  2668.     ldy    #$00        ;        ...
  2669.     sta    (cm.ptr),y    ;        ...
  2670.     ldx    #cmbuf\        ; Point to command buffer
  2671.     ldy    #cmbuf^        ;        ...
  2672.     jsr    prstr        ;    and reprint it
  2673.     lda    #$00        ; Clear action flag
  2674.     sta    cmaflg        ;        ...
  2675.     jmp    repars        ;    and go reparse
  2676. cmtk3:    cmp    cmprmx        ; Ok, this either is or is not the
  2677.     bne    cmtk4        ;    char we want. If not, go fail.
  2678.     pla            ; It is, flush the old address
  2679.     pla            ;        ...
  2680.     lda    #$00        ; Reset the failure flag
  2681.     sta    cmcffl        ;        ...
  2682.     jmp    rskp        ;    and skip return
  2683. cmtk4:    pla            ; Restore old pointer
  2684.     sta    cm.ptr+1    ;        ...
  2685.     sta    cmoptr+1    ;        ...
  2686.     pla            ;        ...
  2687.     sta    cm.ptr        ;        ...
  2688.     sta    cmoptr        ;        ...
  2689.     lda    cmccnt        ; Save the count for <ctrl/H>
  2690.     sta    cmocnt        ;        ...
  2691.     lda    #$ff        ; Set failure flag
  2692.     sta    cmcffl        ;        ...
  2693.     rts            ; Return
  2694.  
  2695. .SBTTL    Cminbf - read characters from keyboard
  2696.  
  2697. ;
  2698. ;    This routine reads characters from the keyboard until
  2699. ;    an action or editing character comes up.
  2700. ;
  2701. ;        Input:
  2702. ;
  2703. ;        Output:        Cmbuf- characters from keyboard
  2704. ;
  2705. ;        Registers destroyed:
  2706. ;
  2707.  
  2708. cminbf: pha            ; Save the AC
  2709.     txa            ;    and X
  2710.     pha            ;        ...
  2711.     tya            ;    and Y
  2712.     pha            ;        ...
  2713.     php            ; Save the processor status
  2714.     ldy    #$00        ; Clear Y
  2715.     lda    cmaflg        ; Fetch the action flag
  2716.     cmp    #$00        ; Set??
  2717.     beq    cminb1        ; Nope
  2718.     jmp    cminb9        ; Yes, so leave
  2719. cminb1: inc    cmccnt        ; Up the character count once
  2720.     bne    cminb0        ;  If we are overflowing the command buffer
  2721.     jsr    bell        ;    Feep at the user and do Prserr
  2722.     dec    cmccnt        ;  Make sure this doesn't happen again
  2723.     jmp    prserr        ;    for same string
  2724. cminb0:    jsr    rdkey        ; Get next character from keyboard
  2725.     lda    char        ;[31]
  2726.     cmp    #$90
  2727.     bcs    cminb10
  2728.     cmp    #$80        ; check if numeric keypad
  2729.     bcc    cminb10
  2730.     sbc    #$80-'0        ; convert to a digit.  Carry already set
  2731. cminb10:cmp    #$c0        ; check if special key
  2732.     bcc    cminb11
  2733.     cmp    #$c4
  2734.     bcs    cminb11
  2735.     tax
  2736.     lda    out4a1-$c0,x    ; convert spcial key
  2737. cminb11:cmp    #esc        ; esc is a legal non-printing character
  2738.     beq    cminb8
  2739.     cmp    #cr        ; cr is a legal non-printing character
  2740.     beq    cminb8
  2741.     cmp    #lf        ; lf is a legal non-printing character
  2742.     beq    cminb8
  2743.     cmp    #tab        ; tab is a legal non-printing character
  2744.     beq    cminb8
  2745.     cmp    #ctrlu        ; ctrlu is a legal non-printing character
  2746.     beq    cminb8
  2747.     cmp    #ctrlw        ; ctrlw is a legal non-printing character
  2748.     beq    cminb8
  2749.     cmp    #ffd        ; form feed is a legal non-printing character
  2750.     beq    cminb8
  2751.     cmp    #del        ; del is a legal non-printing character
  2752.     beq    cminb8
  2753.     cmp    #bs        ; bs is a legal non-printing character
  2754.     beq    cminb8
  2755.     cmp    #$20        ; ignore non-printing characters
  2756.     bcc    cminb0
  2757.     cmp    #$20+95        ; ignore non-printing characters
  2758.     bcs    cminb0
  2759. cminb8:    cmp    #$7f        ;[46]
  2760.     beq    cmind        ;  Yes
  2761.     cmp    #bs        ;  Also a retry
  2762.     bne    cmnbnh        ;  No, go on
  2763. cmind:    ldx    cmccnt        ;  Check character count
  2764.     cpx    #$01        ;  Is this the first character?
  2765.     bne    cmnbnh        ;  Nope, can't help him
  2766.     ldx    cmcffl        ;  Did the previous command fail?
  2767.     bpl    cmnbnh        ;  No, we can't reparse a good command
  2768.     lda    cmoptr        ;  Ok, get the old pointer and set up
  2769.     sta    cm.ptr        ;     the old command line again
  2770.     sta    cm.bfp        ;         ...
  2771.     lda    cmoptr+1    ;         ...
  2772.     sta    cm.ptr+1    ;         ...
  2773.     sta    cm.bfp+1    ;         ...
  2774.     lda    cmocnt        ;  Restore the character count
  2775.     sta    cmccnt        ;         ...
  2776.     lda    #$00        ;  Zero this so we can safely use the
  2777.     sta    cmwrk2        ;     code that reprints a line after ^W
  2778.     jmp    cmnbna        ;  Go reprint the line
  2779. cmnbnh:    ldy    #$00        ;        ...
  2780.     sta    (cm.bfp),y    ; Stuff it in buffer
  2781.     tax            ; Hold it here for a while
  2782.     clc            ; Clear the carry
  2783.     lda    cm.bfp        ; Increment the buffer pointer
  2784.     adc    #$01        ;        ...
  2785.     sta    cm.bfp        ;        ...
  2786.     bcc    cmnb11        ; Carry?
  2787.     inc    cm.bfp+1    ; Yup, do H.O. byte
  2788. cmnb11: txa            ; Get the data back
  2789.     cmp    #ctrlu        ; Is it a ^U
  2790.     bne    cminb2        ; Nope
  2791. cmnb12: jsr    screl2        ; Yes, clear the whole line
  2792.     sec            ;[37] Get the cursor coordinates
  2793.     jsr    ploth        ;[37]        ...
  2794.     ldy    #$00        ;[DD] Reset cursor position to beg. of line
  2795.     clc            ;[DD]        ...
  2796.     jsr    ploth        ;[DD][26]    ...
  2797.     ldx    cm.rty        ;  Get L.O. byte addr of prompt
  2798.     ldy    cm.rty+1    ;     and H.O. byte
  2799.     jsr    prstr        ; Reprint the prompt
  2800.     jsr    screl0        ; Get rid of garbage on that line
  2801.     lda    #cmbuf\        ; Now reset the buffer pointer
  2802.     sta    cm.bfp        ;     to the beginning of the buffer
  2803.     lda    #cmbuf^        ;        ...
  2804.     sta    cm.bfp+1    ;        ...
  2805.     lda    #$00        ; Clear AC
  2806.     sta    cmccnt        ; Clear the character count
  2807.     jmp    repars        ; Reparse new line from beginning
  2808. cminb2: cmp    #bs        ; Is it a <bs>?
  2809.     beq    cminb3        ; Yes
  2810. ;    cmp    #cdel        ; A <del>?
  2811.     cmp    #$7f        ;[46]
  2812.     bne    cminb4        ; No
  2813. cminb3: jsr    scrl        ; move the cursor left
  2814.     jsr    screl0        ; Now clear from there to end of line
  2815.     dec    cmccnt        ; Decrement the character count
  2816.     dec    cmccnt        ;    twice.
  2817.     lda    cmccnt        ; Now fetch it
  2818.     cmp    #$00        ; Did we back up too far??
  2819.     bpl    cmnb32        ; No, go on
  2820.     jsr    bell        ; Yes, ring the bell and
  2821.     jmp    cmnb12        ;    go reprint prompt and reparse line
  2822. cmnb32: sec            ; Set the carry
  2823.     lda    cm.bfp        ; Now decrement the buffer pointer
  2824.     sbc    #$02        ;    twice.
  2825.     sta    cm.bfp        ; Store it
  2826.     bcs    cmnb33
  2827.     dec    cm.bfp+1    ; Decrement to account for the borrow
  2828. cmnb33: jmp    repars        ; Time to reparse everything
  2829. cminb4:    cmp    #ctrlw        ;  Delete a word?
  2830.     beq    cmnb41        ;  Yes, go take care of that
  2831.     jmp    cmib40        ;  Nope, continue
  2832. cmnb41:    lda    #$03        ;  Set up negative offset count
  2833.     sta    cmwrk2        ;         ...
  2834.     sec            ;  Set up to adjust buffer pointer
  2835.     lda    cm.bfp        ;  Get the L.O. byte
  2836.     sbc    #$03        ;  Adjust pointer down by 3
  2837.     sta    cm.bfp        ;  Store it back
  2838.     bcs    cmnb42        ;  Don't worry about H.O. byte
  2839.     dec    cm.bfp+1    ;  Adjust H.O. byte also
  2840. cmnb42:    lda    cmwrk2        ;  First, check the count
  2841.     cmp    cmccnt        ;  Cmwrk2 > cmccnt?
  2842.     bmi    cmints        ;  No, go test characters
  2843.     jmp    cmnb12        ;  Yes, go clear the whole line
  2844. cmints:    ldy    #$00        ;  Zero Y
  2845.     lda    (cm.bfp),y    ;  Get previous character
  2846.     cmp    #lf        ;  Start to test ranges...
  2847.     bpl    cmits1        ;     Between <lf> and <cr>?
  2848.     jmp    cminac        ;  No, not in range at all
  2849. cmits1:    cmp    #cr+1        ;         ...
  2850.     bmi    cmnb43        ;  Yes, handle it
  2851.     cmp    #space        ;  Between <sp> and '"'?
  2852.     bpl    cmits2        ;  Possible, continue
  2853.     jmp    cminac        ;  No, advance to previous character
  2854. cmits2:    cmp    #dquot+1    ;         ...
  2855.     bmi    cmnb43        ;  Yes, delete back to there
  2856.     cmp    #apos        ;  Between Apostrophy and '/'?
  2857.     bpl    cmits3        ;  Could be, continue
  2858.     jmp    cminac        ;  Nope, advance character
  2859. cmits3:    cmp    #slash+1    ;         ...
  2860.     bmi    cmnb43        ;  Yup, found a delimiter
  2861.     cmp    #colon        ;  Between ':' and '>' perhaps?
  2862.     bpl    cmits4        ;  Maybe
  2863.     jmp    cminac        ;  Nope, advance to previous character    
  2864. cmits4:    cmp    #rabr+1     ;         ...
  2865.     bmi    cmnb43        ;  It is, go delete back to there
  2866.     cmp    #quot        ;  Is it a "'"?
  2867.     bne    cminac        ;  No, advance
  2868. cmnb43:    dec    cmwrk2        ;  Adjust this count
  2869.     clc            ;     and the buffer pointer
  2870.     lda    cm.bfp        ;         ...
  2871.     adc    #$01        ;         ...
  2872.     sta    cm.bfp        ;         ...
  2873.     bcc    cmnb44        ;         ...
  2874.     inc    cm.bfp+1    ;         ...
  2875. cmnb44:    lda    cmccnt        ;  Get the command buffer length
  2876. cmnbcc:    sec            ;[37] Get the cursor coordinates
  2877.     jsr    ploth        ;[37]        ...
  2878.     sty    savey        ;[37] Save cursor position
  2879.     cmp    savey        ;[37]  Check against horizontal cursor position
  2880.     bmi    cmnbna        ;  It's smaller, skip vert. cursor adjust
  2881.     dex            ;[37]  Adjust cursor vertical position
  2882.     pha            ; Save the AC across this call
  2883.     clc            ;[37] Set the cursor to the new position
  2884.     jsr    ploth        ;[26]        ...
  2885.     pla            ; Restore the AC
  2886.     sec            ;  Reflect this in number of characters
  2887.     sbc    #$28        ;     we skipped back over
  2888.     jmp    cmnbcc        ;  Go check again
  2889. cmnbna:    lda    #$00        ;  Put a null at the end of the buffer
  2890.     ldy    #$00        ;         ...
  2891.     sta    (cm.bfp),y    ;         ...
  2892.     jsr    screl2        ;  Clear current line
  2893.     sec            ;[37] Get the cursor position
  2894.     jsr    ploth        ;[37]        ...
  2895.     ldy    #$00        ;[EL] Zero the column number
  2896.     clc            ;[37]        ...
  2897.     jsr    ploth        ;[26]        ...
  2898.     ldx    cm.rty        ;  Reprint prompt
  2899.     ldy    cm.rty+1    ;         ...
  2900.     jsr    prstr        ;         ...
  2901.     ldx    #cmbuf\        ;  Reprint command buffer
  2902.     ldy    #cmbuf^        ;         ...
  2903.     jsr    prstr        ;         ...
  2904.     sec            ;  Now adjust the command character count
  2905.     lda    cmccnt        ;         ...
  2906.     sbc    cmwrk2        ;     by what we have accumulated
  2907.     sta    cmccnt        ;         ...
  2908.     jsr    screl0        ;  Clear to the end of this line
  2909.     jmp    repars        ;  Go reparse the command
  2910. cminac:    inc    cmwrk2        ;  Increment count of chars to back up
  2911.     sec            ;  Adjust the buffer pointer down again
  2912.     lda    cm.bfp        ;         ...
  2913.     sbc    #$01        ;         ...
  2914.     sta    cm.bfp        ;         ...
  2915.     bcs    cmnb45        ;  If carry set, skip H.O. byte adjustment
  2916.     dec    cm.bfp+1    ;  Adjust this
  2917. cmnb45:    jmp    cmnb42        ;  Go around once again
  2918.  
  2919. cmib40:    cmp    #quest        ; Need help?
  2920.     beq    cminb6        ;        ...
  2921.     cmp    #esc        ; Is he lazy?
  2922.     beq    cminb6        ;        ...
  2923.     cmp    #cr        ; Are we at end of line?
  2924.     beq    cminb5        ;        ...
  2925.     cmp    #lf        ; End of line?
  2926.     beq    cminb5        ;        ...
  2927.     cmp    #ffd        ; Is it a form feed?
  2928.     bne    cminb7        ; None of the above
  2929.     jsr    scrclr        ; clear the screen and home the cursor
  2930. cminb5: lda    cmccnt        ; Fetch character count
  2931.     cmp    #$01        ; Any characters yet?
  2932.     bne    cminb6        ; Yes
  2933.     jmp    prserr        ; No, parser error
  2934. cminb6: lda    #$ff        ; Go
  2935.     sta    cmaflg        ;    and set the action flag
  2936.     jmp    cminb9        ; Leave
  2937. cminb7:    cmp    #space        ; Is the character a space ?
  2938.     bne    cmnb71        ; No
  2939.     jsr    cout        ; Output the character
  2940.     jmp    cminb1        ; Yes, get another character
  2941. cmnb71:    cmp    #tab        ; Is it a <tab>?
  2942.     bne    cmnb72        ; No
  2943. ;    jsr    cout        ; Output the character
  2944.     jsr    prttab        ;[46]
  2945.     jmp    cminb1        ; Yes, get more characters 
  2946. cmnb72:    jsr    cout        ; Print the character on the screen
  2947.     jmp    cminb1        ; Get more characters
  2948. cminb9: dec    cmccnt        ; Decrement the count once
  2949.     plp            ; Restore the processor status
  2950.     pla            ;    the Y register
  2951.     tay            ;        ...
  2952.     pla            ;    the X register
  2953.     tax            ;        ...
  2954.     pla            ;    and the AC
  2955.     rts            ;    and return!
  2956.  
  2957.  
  2958. .SBTTL    Cmgtch - get a character from the command buffer
  2959.  
  2960. ;
  2961. ;    This routine takes the next character out of the command
  2962. ;    buffer, does some checking (action character, space, etc.)
  2963. ;    and then returns it to the calling program in the AC
  2964. ;
  2965. ;        Input:  NONE
  2966. ;
  2967. ;        Output: A-    Next character from command buffer
  2968. ;
  2969. ;        Registers destroyed:    A,X,Y
  2970. ;
  2971.  
  2972. cmgtch: ldy    #$00        ; Y should always be zero here to index buffer
  2973.     lda    cmaflg        ; Fetch the action flag
  2974.     cmp    #$00        ; Set??
  2975.     bne    cmgt1        ; Yes
  2976.     jsr    cminbf        ; No, go fetch some more input
  2977. cmgt1:  lda    (cm.ptr),y    ; Get the next character
  2978.     tax            ; Hold on to it here for a moment
  2979.     clc            ; Clear the carry flag
  2980.     lda    cm.ptr        ; Increment
  2981.     adc    #$01        ;    the next character pointer
  2982.     sta    cm.ptr        ;        ...
  2983.     bcc    cmgt2        ;        ...
  2984.     inc    cm.ptr+1    ; Have carry, increment H.O. byte
  2985. cmgt2:  txa            ; Now, get the data
  2986.     cmp    #space        ; Space?
  2987.     beq    cmgtc2        ; Yes
  2988.     cmp    #tab        ; <tab>?
  2989.     bne    cmgtc3        ; Neither space nor <tab>
  2990. cmgtc2:    pha            ; Hold the character here till we need it
  2991.     lda    #cmtxt        ; Are we parsing a string?
  2992.     cmp    cmstat        ;         ...
  2993.     beq    cmgtis        ; Yes, ignore space flag test
  2994.     lda    #cmifi        ; Are we parsing a file name?
  2995.     cmp    cmstat        ;        ...
  2996.     beq    cmgtis        ; Yes, ignore the space flag test
  2997.     lda    cmsflg        ; Get the space flag
  2998.     cmp    #$00        ; Was the last character a space?
  2999.     beq    cmgtis        ;  No, go set space flag
  3000.     pla            ;  Pop the character off
  3001.     jmp    cmgtch        ;  But ignore it and get another
  3002. cmgtis:    lda    #$ff        ; Set
  3003.     sta    cmsflg        ;    the space flag
  3004.     pla            ;  Restore the space or <tab>
  3005.     jmp    cmgtc5        ; Go return
  3006. cmgtc3: php            ; Save the processor status
  3007.     pha            ; Save this so it doesn't get clobbered
  3008.     lda    #$00        ; Clear AC
  3009.     sta    cmsflg        ; Clear space flag
  3010.     pla            ; Restore old AC
  3011.     plp            ; Restore the processor status
  3012.     cmp    #esc        ; Escape?
  3013.     beq    cmgtc5        ;
  3014.     cmp    #quest        ; Need help?
  3015.     beq    cmgtc4        ;
  3016.     cmp    #cr        ; <cr>?
  3017.     beq    cmgtc4        ;
  3018.     cmp    #lf        ; <lf>?
  3019.     beq    cmgtc4        ;
  3020.     cmp    #ffd        ; <ff>?
  3021.     beq    cmgtc4        ;
  3022.     and    #$7f        ; Make sure the character is positive
  3023.     rts            ; Not an action character, just return
  3024. cmgtc4: tax            ; Hold the data
  3025.     sec            ; Set the carry flag
  3026.     lda    cm.ptr        ; Get the next character pointer
  3027.     sbc    #$01        ;    and decrement it
  3028.     sta    cm.ptr        ;
  3029.     bcs    cmgtc5        ;
  3030.     dec    cm.ptr+1    ;
  3031. cmgtc5: txa            ; Now, fetch the data
  3032.     ora    #$80        ; Make it look like a terminator
  3033.     rts            ; Go back
  3034.  
  3035. .SBTTL    Prcrlf subroutine - print a crelf
  3036.  
  3037. ;
  3038. ;    This routine sets up a call to prstr pointing to the crlf
  3039. ;    string.
  3040. ;
  3041. ;        Registers destroyed:    A
  3042. ;
  3043.  
  3044. prcl.0: lda    #cr        ; Get a cr in the AC
  3045.     jsr    cout        ;    and print it out
  3046.     rts            ; Return
  3047.  
  3048. .SBTTL    Prstr subroutine
  3049.  
  3050. ;
  3051. ;    This routine prints a string ending in a null.
  3052. ;
  3053. ;        Input:  X-    Low order byte address of string
  3054. ;            Y-    High order byte address of string
  3055. ;
  3056. ;        Output:        Prints string on screen
  3057. ;
  3058. ;        Registers destroyed:    A,X,Y
  3059. ;
  3060.  
  3061. prst.0: stx    saddr        ; Save Low order byte
  3062.     sty    saddr+1        ; Save High order byte
  3063.     ldx    #3        ;[DD] Open chan 3 for output
  3064.     jsr    chkout        ;[DD]        ...
  3065.     ldy    #$00        ; Clear Y reg
  3066.  
  3067. prst1:
  3068. prst3:    lda    (saddr),y    ; Get the next byte of the string
  3069.     beq    prsdon        ; If it is null, we are done
  3070.     and    #$7f        ;[DD] mask 7 bits
  3071.     jsr    cout        ;[DD] output to screen
  3072.     jsr    dely        ;[44] Delay
  3073.     iny            ; Up the index
  3074.     bne    prst2        ; If it is zero, the string is <256, continue
  3075.     inc    saddr+1        ; Increment page number
  3076. prst2:  jmp    prst1        ; Go back to print next byte
  3077.  
  3078. prsdon: rts            ; Return
  3079.  
  3080. dely:    tya            ;[44] Save Y
  3081.     pha            ;[44]        ...
  3082.     ldy    #2        ;[44] Delay 2 ms.
  3083. del1:    ldx    #250        ;[44] Inner loop 1 ms.
  3084. del2:    dex            ;[44] Delay 1 ms.
  3085.     bne    del2        ;[44]        ...
  3086.     dey            ;[44]  2 times.
  3087.     bne    del1        ;[44]        ...
  3088.     pla            ;[44] Restore Y
  3089.     tay            ;[44]        ...
  3090.     rts            ;[44] Return
  3091.  
  3092.  
  3093. .SBTTL    Mul16 - 16-bit multiply routine
  3094.  
  3095. ;
  3096. ;    This and the following four routines is math support for the
  3097. ;    Comnd package. These routines come from '6502 Assembly Language
  3098. ;    Subroutines' by Lance A. Leventhal. Refer to that source for
  3099. ;    more complete documentation.
  3100. ;
  3101.  
  3102. ml16:    pla            ; Save the return address
  3103.     sta    rtaddr        ;        ...
  3104.     pla            ;        ...
  3105.     sta    rtaddr+1    ;        ...
  3106.     pla            ; Get multiplier
  3107.     sta    mlier        ;        ...
  3108.     pla            ;        ...
  3109.     sta    mlier+1        ;        ...
  3110.     pla            ; Get multiplicand
  3111.     sta    mcand        ;        ...
  3112.     pla            ;        ...
  3113.     sta    mcand+1        ;        ...
  3114.     lda    #$00        ; Zero
  3115.     sta    hiprod        ;    high word of product
  3116.     sta    hiprod+1    ;        ...
  3117.     ldx    #17        ; Number of bits in multiplier plus 1, the
  3118.                 ;    extra loop is to move the last carry
  3119.                 ;    into the product.
  3120.     clc            ; Clear carry for first time through the loop
  3121. mullp:  ror    hiprod+1    ; Shift the whole thing down
  3122.     ror    hiprod        ;        ...
  3123.     ror    mlier+1        ;        ...
  3124.     ror    mlier        ;        ...
  3125.     bcc    deccnt        ; Branch if next bit of multiplier is 0
  3126.     clc            ; next bit is 1 so add multiplicand to product
  3127.     lda    mcand        ;        ...
  3128.     adc    hiprod        ;        ...
  3129.     sta    hiprod        ;        ...
  3130.     lda    mcand+1        ;        ...
  3131.     adc    hiprod+1    ;        ...
  3132.     sta    hiprod+1    ; Carry = overflow from add
  3133. deccnt: dex            ;        ...
  3134.     bne    mullp        ; Continue until done
  3135.     lda    mlier+1        ; Get low word of product and push it
  3136.     pha            ;    onto the stack
  3137.     lda    mlier        ;        ...
  3138.     pha            ;        ...
  3139.     lda    rtaddr+1    ; Restore the return address
  3140.     pha            ;        ...
  3141.     lda    rtaddr        ;        ...
  3142.     pha            ;        ...
  3143.     rts            ; Return
  3144.  
  3145. mcand:  .blkb    2        ; Multiplicand
  3146. mlier:  .blkb    2        ; Multiplier and low word of product
  3147. hiprod: .blkb    2        ; High word of product
  3148. rtaddr: .blkb    2        ; Save area for return address
  3149.  
  3150. .SBTTL    Rskp - Do a skip return
  3151.  
  3152. ;
  3153. ;    This routine returns, skipping the instruction following the
  3154. ;    original call. It is assumed that the instruction following the
  3155. ;    call is a JMP.
  3156. ;
  3157. ;        Input:
  3158. ;
  3159. ;        Output:
  3160. ;
  3161. ;        Registers destroyed:    None
  3162. ;
  3163.  
  3164. rskp.0:    sta    savea        ; Save the registers
  3165.     stx    savex        ;
  3166.     sty    savey        ;
  3167.     pla            ; Get Low order byte of return address
  3168.     tax            ; Hold it
  3169.     pla            ; Get High order byte
  3170.     tay            ; Hold that
  3171.     txa            ; Get Low order byte
  3172.     clc            ; Clear the carry flag
  3173.     adc    #$04        ; Add 4 to the address
  3174.     bcc    rskp2        ; No carry
  3175.     iny            ; Increment the high order byte
  3176. rskp2:  sta    saddr        ; Store L.O. byte
  3177.     sty    saddr+1        ; Store H.O. byte
  3178.     lda    savea        ;
  3179.     ldx    savex        ;
  3180.     ldy    savey        ;
  3181.     jmp    (saddr)        ; Jump at the new address
  3182.  
  3183. .SBTTL    Setbrk and Rstbrk
  3184.  
  3185. ;
  3186. ;    These routines are called from the user program to set or reset
  3187. ;    break characters to be used by Cmunqs. The byte to set or reset
  3188. ;    is located in the Accumulator. Rstbrk has the option to reset
  3189. ;    the entire break-word. This occurs if the H.O. bit of AC is on.
  3190. ;
  3191.  
  3192. sbrk.0:    and    #$7f        ; We don't want the H.O. bit
  3193.     ldy    #$00        ; Set up Y to index the byte we want
  3194. sbrkts:    cmp    #$08        ; Is the offset > 8
  3195.     bmi    sbrkfw        ; No, we are at the right byte now
  3196.     sec            ; Yes, adjust it down again
  3197.     sbc    #$08        ;        ...
  3198.     iny            ; Advance index
  3199.     jmp    sbrkts        ;    and try again
  3200. sbrkfw:    tax            ; This is the remaining offset
  3201.     lda    #$80        ; Start with H.O. bit on
  3202. sbrklp:    cpx    #$00        ; Is it necessary to shift down?
  3203.     beq    sbrkfb        ; No, we are done
  3204.     dex            ; Yes, adjust offset
  3205.     lsr    a        ; Shift bit down once
  3206.     jmp    sbrklp        ; Go back and try again
  3207. sbrkfb:    ora    brkwrd,y    ; We found the bit, use the byte offset
  3208.     sta    brkwrd,y    ;    from above, set the bit and resave
  3209.     rts            ; Return
  3210.  
  3211. rbrk.0:    asl    a        ; Check H.O. bit
  3212.     bcs    rbrkal        ; If that was on, Zero entire brkwrd
  3213.     lsr    a        ; Else shift back (H.O. bit is zeroed)
  3214. rbrkts:    cmp    #$08        ; Are we in the right word?
  3215.     bmi    rbrkfw        ; Yes, go figure the rest of the offset
  3216.     sec            ; No, Adjust the offset down
  3217.     sbc    #$08        ;        ...
  3218.     iny            ;    and the index up
  3219.     jmp    rbrkts        ; Try again
  3220. rbrkfw:    tax            ; Stuff the remaining offset in X
  3221.     lda    #$7f        ; Start with H.O. bit off
  3222. rbrklp:    cpx    #$00        ; Do we need to offset some more?
  3223.     beq    rbrkfb        ; No, we have the correct bit
  3224.     dex            ; Yes, decrement the offset
  3225.     sec            ; Make sure carry is on
  3226.     ror    a        ;    and rotate a 1 bit into mask
  3227.     jmp    rbrklp        ; Go back and try again
  3228. rbrkfb:    and    brkwrd,y    ; We found the bit, now shut it off
  3229.     sta    brkwrd,y    ;        ...
  3230.     rts            ;    and return
  3231. rbrkal:    lda    #$00        ; Go stuff zeros in the entire word
  3232.     ldy    #$00        ;        ...
  3233. rbrksz:    sta    brkwrd,y    ; Stuff the zero
  3234.     iny            ; Up the index once
  3235.     cpy    #$10        ; Are we done?
  3236.     bmi    rbrksz        ; Not yet
  3237.     rts            ; Yes, return
  3238.  
  3239. .SBTTL    Chkbrk
  3240.  
  3241. ;
  3242. ;    Chkbrk - This routine looks for the flag in the break word
  3243. ;    which represents the character passed to it. If this bit is
  3244. ;    on, it is a break character and the routine will simply
  3245. ;    return. If it is not a break character, the routine skips..
  3246. ;
  3247.  
  3248. chkbrk:    sta    savea        ; Save byte to be checked
  3249.     and    #$7f        ; Shut H.O. bit
  3250.     ldy    #$00        ; Zero this index
  3251. cbrkts:    cmp    #$08        ; Are we at the right word?
  3252.     bmi    cbrkfw        ; Yes, go calculate bit position
  3253.     sec            ; No, adjust offset down
  3254.     sbc    #$08        ;        ...
  3255.     iny            ; Increment the index
  3256.     jmp    cbrkts        ; Go back and test again
  3257. cbrkfw:    tax            ; Stuff the remaining offset in X
  3258.     lda    #$80        ; Set H.O. bit on for testing
  3259. cbrklp:    cpx    #$00        ; Are we in position yet?
  3260.     beq    cbrkfb        ; Yes, go test the bit
  3261.     dex            ; No, decrement the offset
  3262.     lsr    a        ;    and adjust the bit position
  3263.     jmp    cbrklp        ; Go and try again
  3264. cbrkfb:    and    brkwrd,y    ; See if the bit is on
  3265.     bne    cbrkbc        ; It is a break character
  3266.     lda    savea        ; Restore the character
  3267.     jmp    rskp        ; Not a break character, skip return
  3268. cbrkbc:    lda    savea        ; Restore the character
  3269.     rts            ; Return
  3270.  
  3271. .SBTTL    Cmehlp - Do extra help on Question-mark prompting
  3272.  
  3273. ;
  3274. ;    Cmehlp - This routine uses a string of commands passed to it
  3275. ;    in order to display alternate valid parse types to the user.
  3276. ;
  3277. ;        Input:    Cmehpt-    Pointer to valid parse types (end in 00)
  3278. ;
  3279. ;        Output:    Display on screen, alternate parse types
  3280. ;
  3281. ;        Registers destroyed:    A,X,Y
  3282. ;
  3283.  
  3284. cmehlp:    lda    cmstat        ; We are going to need this so
  3285.     pha            ;    save it across the call
  3286.     ldy    #$00        ; Zero out the help index
  3287.     sty    cmehix        ;        ...
  3288. cmehl1:    ldy    cmehix        ; Load the extra help index
  3289.     lda    (cmehpt),y    ; Fetch next type
  3290.     sta    cmstat        ; Store it here
  3291.     inc    cmehix        ; Increase the index by one
  3292.     cmp    #$00        ; Is the type null?
  3293.     bne    cmeh0        ; No, continue
  3294.     jmp    cmehrt        ; Yes, terminate
  3295. cmeh0:    cmp    #cmtok+1    ; If the type is out of range, leave
  3296.     bmi    cmeh1        ;        ...
  3297.     jmp    cmehrt        ;        ...
  3298. cmeh1:    pha            ; Save the type across the call
  3299.     ldx    #cmors\        ; Set up address of 'OR ' string
  3300.     ldy    #cmors^        ;        ...
  3301.     jsr    prstr        ;    and print it
  3302.     pla            ; Restore AC
  3303.     cmp    #cmkey        ; Compare with keyword
  3304.     bne    cmeh2        ; No, try next type
  3305. cmeh10:    tax            ; Hold type in X register
  3306.     lda    cmsptr        ; Save these parms so they can be restored
  3307.     pha            ;        ...
  3308.     lda    cmsptr+1    ;        ...
  3309.     pha            ;        ...
  3310.     lda    cm.ptr        ; Copy the pointer to the saved pointer
  3311.     sta    cmsptr        ;    so the keyword print routine prints
  3312.     pha            ;    the entire table. Also, save it on
  3313.     lda    cm.ptr+1    ;    the stack so it can be restored later
  3314.     sta    cmsptr+1    ;        ...
  3315.     pha            ;        ...
  3316.     lda    cmptab        ; Save the table address also
  3317.     pha            ;        ...
  3318.     lda    cmptab+1    ;        ...
  3319.     pha            ;        ...
  3320.     txa            ; Restore type
  3321.     cmp    #cmkey        ; Keyword?
  3322.     bne    cmeh11        ; No, it must be a switch table
  3323.     ldx    #cmin01\    ; Set up address of message
  3324.     ldy    #cmin01^    ;        ...
  3325.     jmp    cmeh12        ; Go print the string
  3326. cmeh11:    ldx    #cmin02\    ; Set up address of 'switch' string
  3327.     ldy    #cmin02^    ;        ...
  3328. cmeh12:    jsr    prstr        ; Print the message
  3329.     ldy    cmehix        ; Get the index into help string
  3330.     lda    (cmehpt),y    ; Fetch L.O. byte of table address
  3331.     sta    cmptab        ; Set that up for Cmktp
  3332.     iny            ; Increment the index
  3333.     lda    (cmehpt),y    ; Get H.O. byte
  3334.     sta    cmptab+1    ; Set it up for Cmktp
  3335.     iny            ; Advance the index
  3336.     sty    cmehix        ;    and store it
  3337.     jsr    cmktp        ; Print the keyword table
  3338.     pla            ; Now restore all the stuff we saved before
  3339.     sta    cmptab+1    ;        ...
  3340.     pla            ;        ...
  3341.     sta    cmptab        ;        ...
  3342.     pla            ;        ...
  3343.     sta    cm.ptr+1    ;        ...
  3344.     pla            ;        ...
  3345.     sta    cm.ptr        ;        ...
  3346.     pla            ;        ...
  3347.     sta    cmsptr+1    ;        ...
  3348.     pla            ;        ...
  3349.     sta    cmsptr        ;        ...
  3350.     jmp    cmehl1        ; See if there is more to do
  3351. cmeh2:    cmp    #cmswi        ; Type is switch?
  3352.     bne    cmeh3        ; No, continue
  3353.     jmp    cmeh10        ; We can treat this just like a keyword
  3354. cmeh3:    cmp    #cmifi        ; Input file?
  3355.     bne    cmeh4        ; No, go on
  3356.     ldx    #cmin03\    ; Set up the message address
  3357.     ldy    #cmin03^    ;        ...
  3358.     jmp    cmehps        ; Go print it
  3359. cmeh4:    cmp    #cmofi        ; Output file?
  3360.     bne    cmeh5        ; Nope, try again
  3361.     ldx    #cmin04\    ; Set up message address
  3362.     ldy    #cmin04^    ;        ...
  3363.     jmp    cmehps        ; Go print the string
  3364. cmeh5:    cmp    #cmcfm        ; Confirm?
  3365.     bne    cmeh6        ; No
  3366.     ldx    #cmin00\    ; Set up address
  3367.     ldy    #cmin00^    ;        ...
  3368.     jmp    cmehps        ; Print the string
  3369. cmeh6:    cmp    #cmtxt        ; Unquoted string?
  3370.     bne    cmeh7        ; No, try next one
  3371.     ldx    #cmin06\    ; Set up address
  3372.     ldy    #cmin06^    ;        ...
  3373.     jmp    cmehps        ; Print
  3374. cmeh7:    cmp    #cmnum        ; Integer?
  3375.     bne    cmeh8        ; Try again
  3376.     ldx    #cmin05\    ; Set up message
  3377.     ldy    #cmin05^    ;        ...
  3378.     jsr    prstr        ; Print it
  3379.     ldy    cmehix        ; Get index
  3380.     inc    cmehix        ; Advance index
  3381.     lda    (cmehpt),y    ; Get base of integer
  3382.     cmp    #$0a        ; Is it greater than decimal 10?
  3383.     bmi    cmeh71        ; No, just print the L.O. digit
  3384.     lda    #$31        ; Print the H.O. digit as a 1
  3385.     jsr    cout        ; Print the '1'
  3386.     ldy    cmehix        ; Load index
  3387.     dey            ; Point back to last byte
  3388.     lda    (cmehpt),y    ; Get the base back
  3389.     sec            ; Set the carry flag for subtraction
  3390.     sbc    #$0a        ; Subtract off decimal 10
  3391. cmeh71:    clc            ; Clear carry for addition
  3392.     adc    #$30        ; Make it printable
  3393.     jsr    cout        ; Print the digit
  3394.     jsr    prcrlf        ; Print a crelf
  3395.     jsr    prbyte        ; Print the byte
  3396.     jmp    cmehl1        ; Go back for more
  3397. cmeh8:    ldx    #cmin07\    ; Assume it's a token
  3398.     ldy    #cmin07^    ;        ...
  3399. cmehps:    jsr    prstr        ; Print string
  3400.     jsr    prcrlf        ; Print a crelf
  3401.     jmp    cmehl1        ; Go back
  3402. cmehrt:    pla            ; Restore
  3403.     sta    cmstat        ;    current parse type
  3404.     rts
  3405.  
  3406. .SBTTL    Cmcpdf - Copy a default string into the command buffer
  3407.  
  3408. ;
  3409. ;    Cmcpdf - This routine copies a default for a field
  3410. ;    into the command buffer andreparses the string.
  3411. ;
  3412. ;        Input:    Cmdptr-    Pointer to default field value (asciz)
  3413. ;
  3414. ;        Output:
  3415. ;
  3416. ;        Registers destroyed:    A,X,Y
  3417. ;
  3418.  
  3419. cmcpdf:    sec            ; Reset the buffer pointer
  3420.     lda    cm.bfp        ;        ...
  3421.     sbc    #$01        ;        ...
  3422.     sta    cm.bfp        ;        ...
  3423.     bcs    cmcpst        ; If carry set, don't adjust H.O. byte
  3424.     dec    cm.bfp+1    ;        ...
  3425. cmcpst:    dec    cmccnt        ; Adjust the character count
  3426.     ldy    #$00        ; Zero the index
  3427. cmcplp:    lda    (cmdptr),y    ; Get byte
  3428.     beq    cmcpdn        ; Copy finished, leave
  3429.     ldx    cmccnt        ; Check character count
  3430.     inx            ; If it is just short of wrapping
  3431.     bne    cmcpl1        ;    then we are overflowing buffer
  3432.     jsr    bell        ; If that is the case, tell the user
  3433.     dec    cmccnt        ; Make sure it doesn't happen again
  3434.     jmp    prserr        ;    for same string.
  3435. cmcpl1:    
  3436. ;    ora    #$80        ; Be consistent, make sure H.O. bit is on
  3437.     sta    (cm.bfp),y    ; Stuff it in the buffer
  3438.     inc    cmccnt        ; Adjust character count
  3439.     iny            ; Up the buffer index
  3440.     jmp    cmcplp        ; Go to top of loop
  3441. cmcpdn:    lda    #space        ; Get a space
  3442.     sta    (cm.bfp),y    ;    and place it in buffer after keyword
  3443.     iny            ; Increment the buffer index
  3444.     lda    #nul        ; Get a null
  3445.     sta    (cm.bfp),y    ;    and stuff that at the end of buffer
  3446.     clc            ; Now recompute the end of usable buffer
  3447.     tya            ; Get the number of chars added
  3448.     adc    cm.bfp        ; Add that to the buffer pointer
  3449.     sta    cm.bfp        ;        ...
  3450.     lda    #$00        ;        ...
  3451.     adc    cm.bfp+1    ;        ...
  3452.     sta    cm.bfp+1    ;        ...
  3453.     lda    #$00        ; Reset the action flag
  3454.     sta    cmaflg        ;        ...
  3455.     sec            ; Now adjust the command pointer to the
  3456.     lda    cm.ptr        ;    beginning of the copied field
  3457.     sbc    #$01        ;        ...
  3458.     tax            ; Set it up in X and Y so we can call Prstr
  3459.     lda    cm.ptr+1    ;        ...
  3460.     sbc    #$00        ;        ...
  3461.     tay            ;        ...
  3462.     jsr    prstr        ; Print the added field
  3463.     jmp    repars        ; Now go reparse the whole command
  3464.  
  3465. .SBTTL    Comnd Jsys messages and table storage
  3466.  
  3467. cmer00: .byte    cr
  3468.     .byte    "? Program error:  invalid comnd call"
  3469.     .byte    0        ; [53]
  3470.  
  3471. cmer01: .byte    cr
  3472.     .byte    "? Ambiguous"
  3473.     .byte    0        ; [53]
  3474.  
  3475. cmer02: .byte    cr
  3476.     .byte    "? Illegal input file spec"
  3477.     .byte    0        ; [53]
  3478.  
  3479. cmer03: .byte    cr
  3480.     .byte    "? No keywords match this prefix"
  3481.     .byte    0        ; [53]
  3482.  
  3483. cmer04: .byte    cr
  3484.     .byte    "? No switches match this prefix"
  3485.     .byte    0        ; [53]
  3486.  
  3487. cmer05: .byte    cr
  3488.     .byte    "? Bad character in integer number"
  3489.     .byte    0        ; [53]
  3490.  
  3491. cmer06: .byte    cr
  3492.     .byte    "? Base of integer out of range"
  3493.     .byte    0        ; [53]
  3494.  
  3495. cmer07: .byte    cr
  3496.     .byte    "? Overflow while reading integer number"
  3497.     .byte    0        ; [53]
  3498.  
  3499. cmin00: .byte    " Confirm with carriage return"
  3500.     .byte    0        ; [53]
  3501.  
  3502. cmin01: .byte    " Keyword, one of the following:"
  3503.     .byte    0        ; [53]
  3504.  
  3505. cmin02: .byte    " Switch, one of the following:"
  3506.     .byte    0        ; [53]
  3507.  
  3508. cmin03: .byte    " Input file spec"
  3509.     .byte    0        ; [53]
  3510.  
  3511. cmin04: .byte    " Output file spec"
  3512.     .byte    0        ; [53]
  3513.  
  3514. cmin05: .byte    " Integer number in base "
  3515.     .byte    0        ; [53]
  3516.  
  3517. cmin06:    .byte    " Unquoted text string "
  3518.     .byte    0        ; [53]
  3519.  
  3520. cmin07:    .byte    " Single character token "
  3521.     .byte    0        ; [53]
  3522.  
  3523.  
  3524. cmors:    .byte    " or "
  3525.     .byte    0        ; [53]
  3526.  
  3527.  
  3528. .SBTTL    Kermit defaults for operational parameters
  3529.  
  3530. ;
  3531. ;    The following are the defaults which this Kermit uses for
  3532. ;    the protocol.
  3533. ;
  3534.  
  3535. dquote  =    '#        ; The quote character
  3536. dpakln  =    $5d        ; The packet length
  3537. dpadch  =    nul        ; The padding character
  3538. dpadln  =    0        ; The padding length
  3539. dmaxtr  =    $14        ; The maximum number of tries
  3540. debq    =    '&        ; The eight-bit-quote character
  3541. dtime    =    10        ; The default time-out amount
  3542. deol    =    cr        ; The end-of-line character
  3543.  
  3544. .SBTTL    Kermit data
  3545.  
  3546. ;
  3547. ;    The following is data storage used by Kermit
  3548. ;
  3549.  
  3550. mxpack  =    dpakln        ; Maximum packet size
  3551. mxfnl    =    $1e        ; Maximum file-name length
  3552. eof    =    $01        ; This is the value for End-of-file
  3553. buflen  =    $ff        ; Buffer length for received data
  3554. kerbf1  =    $1a        ; This always points to packet buffer
  3555. kerbf2    =    $1c        ; This always points to data buffer
  3556. true    =    $01        ; Symbol for true return code
  3557. false    =    $00        ; Symbol for false return code
  3558. on    =    $01        ; Symbol for value of 'on' keyword
  3559. off    =    $00        ; Symbol for value of 'off' keyword
  3560. yes    =    $01        ; Symbol for value of 'yes' keyword
  3561. no    =    $00        ; Symbol for value of 'no' keyword
  3562. terse    =    $01        ; Symbol for terse debug mode
  3563. verbose    =    $02        ; Symbol for verbose debug mode
  3564. xon    =    $11        ; Xon for Ibm-mode
  3565. fbsbit  =    $01        ; Value for SEVEN-BIT FILE-BYTE-SIZE
  3566. fbebit  =    $00        ; Value for EIGHT-BIT FILE-BYTE-SIZE
  3567. nparit    =    $00        ; Value for PARITY NONE
  3568. sparit    =    $01        ; Value for PARITY SPACE
  3569. mparit    =    $02        ; Value for PARITY MARK
  3570. oparit    =    $03        ; Value for PARITY ODD
  3571. eparit    =    $04        ; Value for PARITY EVEN
  3572. eprflg    =    $40        ;    'Error packet received' flag
  3573. errcri  =    $01        ; Error code - cannot receive init
  3574. errcrf  =    $02        ; Error code - cannot receive file-header
  3575. errcrd  =    $03        ; Error code - cannot receive data
  3576. errmrc  =    $04        ; Error code - maximum retry count exceeded
  3577. errbch  =    $05        ; Error code - bad checksum
  3578. errfae  =    $0a        ; Error code - file already exists
  3579. emesln  =    $19        ; Standard error message length
  3580. kerrns  =    $1f        ; Routine name and action string length
  3581. kerdel  =    $15        ; Disk error length
  3582. kerems  =    $19        ; Error message size
  3583. kerfts    =    $0b        ; Size of file-type strings (incl. term. nul)
  3584. kerdsz    =    $09        ; Length of debug mode strings
  3585. kerpsl    =    $06        ; Size of parity strings
  3586. kerbsl    =    $05        ;[17] Size of baud strings
  3587. keremu    =    $07        ; size of terminal emulation strings
  3588. kerfrm    =    cminf1        ; 'From string' pointer for Kercpy routine
  3589. kerto    =    cminf2        ; 'To string' pointer for Kercpy routine
  3590.  
  3591. pdbuf:  .blkb    mxpack-2    ; Packet buffer
  3592. pdlen:  .byte            ; Common area to place data length
  3593. ptype:  .byte            ; Common area to place current packet type
  3594. pnum:    .byte            ; Common area to put packet number received
  3595. ;    plnbuf moved to the end.  Make sure text segment does not extend
  3596. ;    past $8000.  BI-80 rom lives at $8000, and interferes.
  3597. ;plnbuf: .blkb    $100        ;[DD] Port line buffer
  3598. pdtend: .byte            ; End of plnbuf pointer
  3599. pdtind: .byte            ; Index for plnbuf
  3600. rstat:  .byte            ; Return status
  3601. kerrta: .word            ; Save area for return address
  3602. prmt:    .byte    "Kermit-65>"    ; Prompting text
  3603.     .byte    0        ; [53]
  3604.  
  3605. lprmt    =    .-prmt        ; Length of prompting text
  3606. connec:    .byte    $00        ;[48] non-zero if in terminal mode
  3607. datind: .byte            ; Data index into packet buffer
  3608. chebo:  .byte            ; Switch to tell if 8th-bit was on
  3609. escflg: .byte            ; Flag indicating we have seen and escape ($1b)
  3610. addlf:  .byte            ; Add a <lf> flag
  3611. dellf:  .byte            ; Flush a <lf> flag
  3612. jtaddr: .word            ; Jump table address hold area
  3613. hch:    .byte            ; Hold area for ch
  3614. hcv:    .byte            ; Hold area for cv
  3615. kwrk01: .byte            ; Work area for Kermit
  3616. kwrk02: .byte            ; Work area for Kermit
  3617. kertpc:    .byte            ; Hold area for parity check
  3618. ksavea:    .byte            ; Save area for accumulator
  3619. ksavex:    .byte            ; Save area for X reg
  3620. ksavey:    .byte            ; Save area for Y reg
  3621. kerchr: .byte            ; Current character read off port
  3622. kermbs: .word            ; Base address of message table
  3623. debchk: .byte            ; Checksum for debug routine
  3624. debinx: .byte            ; Debug routine action index
  3625. fld:    .byte            ; State of receive in rpak routine
  3626. retadr: .word            ; Hold area for return address
  3627. n:    .byte            ; Message #
  3628. numtry: .byte            ; Number of tries for this packet
  3629. oldtry: .byte            ; Number of tries for previous packet
  3630. maxtry: .byte    dmaxtr        ; Maximum tries allowed for a packet
  3631. state:  .byte            ; Current state of system
  3632. local:    .byte            ; Local/Remote switch
  3633. size:    .byte            ; Size of present data
  3634. chksum: .byte            ; Checksum for packet
  3635. rtot:    .word            ; Total number of characters received
  3636. stot:    .word            ; Total number of characters sent
  3637. rchr:    .word            ; Number characters received, current file
  3638. schr:    .word            ; Number of characters sent, current file
  3639. rovr:    .word            ; Number of overhead characters on receive
  3640. sovr:    .word            ; Number of overhead characters on send
  3641. tpak:    .word            ; Number of packets for this transfer
  3642. eofinp: .byte            ; End-of-file (no characters left to send)
  3643. eodind: .byte            ; End-of-data reached on disk
  3644. errcod: .byte            ; Error indicator
  3645. errrkm:    .blkb    mxpack-2    ; Error message from remote Kermit
  3646. kerosp: .byte            ; Save area for stack pointer
  3647. escp:    .byte    $19        ; Character for escape from connection
  3648. fbsize: .byte    fbebit        ; File-byte-size
  3649. filmod: .byte    $01        ; Current file type
  3650. usehdr: .byte    on        ; Switch - where to get filename (on=file-head)
  3651. lecho:  .byte    off        ; Local-echo switch
  3652. ibmmod: .byte    off        ; Ibm-mode switch
  3653. vtmod:  .byte    $02        ; Term Emulation mode switch (Vt100 default)
  3654. parity: .byte    nparit        ; Parity setting
  3655. baud:    .byte    $02        ;[17] Baud setting (default = 2400)
  3656. wrdsiz:    .byte    fbebit        ;[17] Word length setting
  3657. flowmo:    .byte    on        ;[24] Flow-Control switch
  3658. delay:  .byte    $00        ; Amount of delay before first send
  3659. filwar: .byte    on        ; File-warning switch
  3660. debug:  .byte    $01        ; Debug switch
  3661. ebqmod: .byte    on        ; Eight-bit-quoting mode
  3662. scrtype:.byte    $01        ; Default screen is 80-columns
  3663.  
  3664. ;
  3665. ;    These fields are set parameters and should be kept in this
  3666. ;    order to insure integrity when setting and showing values
  3667. ;
  3668.  
  3669. srind:  .byte    $01            ; Switch to indicate which parm to print
  3670. ebq:    .byte    debq        ; Eight-bit quote character (rec. and send)
  3671.         .byte    debq        ;        ...
  3672. pad:    .byte    dpadln        ; Number of padding characters (rec. and send)
  3673.         .byte    dpadln        ;        ...
  3674. padch:  .byte    dpadch        ; Padding character (receive and send)
  3675.         .byte    dpadch
  3676. eol:    .byte    deol        ; End-of-line character (recevie and send)
  3677.         .byte    deol
  3678. psiz:    .byte    dpakln        ; Packet size (receive and send)
  3679.         .byte    dpakln
  3680. time:    .byte    dtime        ; Time-out interval (receive and send)
  3681.         .byte    dtime        ;
  3682. quote:  .byte    dquote        ; Quote character (receive and send)
  3683.         .byte    dquote        ;        ...
  3684. backclr:.byte    12        ; background color
  3685. britclr:.byte    15        ; light background color (selected with decrev)
  3686. foreclr:.byte    0        ; foreground color
  3687. altclr:    .byte    1        ; alternate color
  3688. bordclr:.byte    6        ; border color
  3689. portadd:    .byte   $01     ; Swift-link port address
  3690. workdri: .byte  8
  3691.  
  3692. ; ttime:    .word    $0000        ;[49] Time out interval (receive and send)
  3693.  
  3694. ttime:  .byte $00,$00,$00
  3695.  
  3696. ;
  3697. ;    Some definitions to make life easier when referencing the above
  3698. ;    fields.
  3699. ;
  3700.  
  3701. rebq    =    ebq        ; Receive eight-bit-quote char
  3702. sebq    =    ebq+1        ; Send eight-bit-quote char
  3703. rpad    =    pad        ; Receive padding amount
  3704. spad    =    pad+1        ; Send padding amount
  3705. rpadch    =    padch        ; Receive padding character
  3706. spadch    =    padch+1        ; Send padding character
  3707. reol    =    eol        ; Receive end-of-line character
  3708. seol    =    eol+1        ; Send end-of-line character
  3709. rpsiz    =    psiz        ; Receive packet length
  3710. spsiz    =    psiz+1        ; Send packet length
  3711. rtime    =    time        ; Receive time out interval
  3712. stime    =    time+1        ; Send time out interval
  3713. rquote    =    quote        ; Receive quote character
  3714. squote    =    quote+1        ; Send quote character
  3715.  
  3716. .SBTTL    Kermit - CBM DOS support
  3717.  
  3718. ;
  3719. ;    The following definitions and storage will be used when setting
  3720. ;    up and executing calls to the DOS.
  3721. ;
  3722.  
  3723. fncrea  =    'R        ; Read function code
  3724. fncwrt  =    'W        ; Write function code
  3725. drdoll    =    '$        ;[40] Directory string
  3726. drcolo    =    ':        ;[40]
  3727. drstar    =    '*        ;[40]
  3728. kerfcb    =    $1e        ; Pointer to FCB
  3729. buff    =    $200        ; Temp disk char read
  3730.  
  3731. fmrcod: .byte    0        ; Disk status return code
  3732. primfn: .blkb    $23        ; File name
  3733. decnum:    .word            ; [54] Number being converted to decimal
  3734. dskers: .blkb    51        ; Storage for disk error messages
  3735. dosffm:    .byte    $00        ; 'First file modification done' switch
  3736. dosfni:    .byte    $00        ; Filename index
  3737. dosfvn:    .byte    $00        ; File version number for the alter routine
  3738. drivno:    .byte    $00        ;[40] Current drive device number
  3739. drunit:    .byte    '0        ;[40] Current drive Unit number
  3740. fcb1:    .blkb    mxfnl        ; Fcb for file being transmitted
  3741. flsrw:  .byte    0        ; Switch for r(ead) or w(rite)
  3742. flssp:  .byte    0        ; Switch for file type s or p
  3743. len:    .byte    0        ; Length for Dos open
  3744. fcmd:    .byte    "I0"        ; String to send 'Init BAM' command
  3745. cntrl .byte $00
  3746.  
  3747.  
  3748. .SBTTL    Kermit initialization
  3749.  
  3750. ;
  3751. ;    The following code sets up Kermit-65 for normal operation.
  3752. ;
  3753.  
  3754. kstart:    
  3755.     lda nmiv
  3756.     sta orignmiv
  3757.     lda nmiv+1
  3758.     sta orignmiv+1
  3759.     jsr    clall        ;[] First close all open channels
  3760.  
  3761. ; The auto-boot routine in C-128 mode requires you restore I/O vectors
  3762. ; otherwise we don't want to do this because it would mess with RAMDOS
  3763.     lda $cf00
  3764.     cmp #$20
  3765.     bne noboot
  3766.     lda $cf01
  3767.     cmp #$84
  3768.     bne noboot
  3769.     lda $cf02
  3770.     cmp #$ff
  3771.     bne noboot
  3772.     jsr    ioinit        ;[16] Initialize I/O devices
  3773.     jsr    restoi        ; restore vectors
  3774. noboot:
  3775. ; Sometimes the current working drive is just wrong...so if the device
  3776. ; is less than 8 we are making it 8
  3777. ; This should be more comprehensive (ie greater than 15 should also be 8)
  3778. ; but thats life
  3779.     lda $BA
  3780.     cmp #$08
  3781.     bpl serialdr
  3782.     lda #$08
  3783. serialdr:
  3784.     sta workdri
  3785.     jsr    scrini        ; initilize the screen packages
  3786.     jsr scrent        ; Init the 80 col screen
  3787.     jsr    restin        ; restore parameters from kermit.ini
  3788.  
  3789. init:    jsr    openrs        ;[34] Open the RS-232 port
  3790. ;     openm    #1,#0,#$ff,cntrl,#0    ;[DD] Open the keyboard
  3791.     lda    #1        ; [53]
  3792.     ldx    #0
  3793.     ldy    #$ff
  3794.     jsr    setlfs
  3795.     ldx    #cntrl\
  3796.     ldy    #cntrl^
  3797.     lda    #0
  3798.     jsr    setnam
  3799.     jsr    open
  3800.  
  3801. ;     openm    #3,#3,#$ff,cntrl,#0    ;[DD] Open the screen
  3802.     lda    #3        ; [53]
  3803.     ldx    #3
  3804.     ldy    #$ff
  3805.     jsr    setlfs
  3806.     ldx    #cntrl\
  3807.     ldy    #cntrl^
  3808.     lda    #0
  3809.     jsr    setnam
  3810.     jsr    open
  3811.  
  3812.     jsr    dopari        ;[]
  3813.     jsr    dobad         ;[]
  3814.     jsr    dowrd        ;[]
  3815.     ldx    #versio1\    ;Get address of version message
  3816.     ldy    #versio1^    ;        ...
  3817.     jsr    prstr        ;Print the version
  3818.     lda    #$01        ; use bold for "type ? for help"
  3819.     sta    alternt
  3820.     ldx    #versio2\
  3821.     ldy    #versio2^
  3822.     jsr    prstr
  3823.     lda    #$00
  3824.     sta    alternt
  3825.     jsr    kermit        ;Go execute kermit
  3826.     jmp    exit1        ;[17] and reenter BASIC
  3827.  
  3828. .SBTTL    Kermit - main routine
  3829.  
  3830. ;
  3831. ;    This routine is the main KERMIT loop. It prompts for commands
  3832. ;    and then it dispatches to the appropriate routine.
  3833. ;
  3834.  
  3835. kermit: tsx            ; Get the stack pointer
  3836.     stx    kerosp        ;    and save it in case of a fatal error
  3837.     ldx    #prmt\        ;  Fetch the address of the prompt
  3838.     ldy    #prmt^        ;        ...
  3839.     lda    #cmini        ; Argument for comnd call
  3840.     jsr    comnd        ; Set up the parser and print the prompt
  3841.     lda    #kercmd\    ; addr of command table
  3842.     sta    cminf1        ;        ...
  3843.     lda    #kercmd^    ;        ...
  3844.     sta    cminf1+1    ;        ...
  3845.     lda    #kerhlp\    ; Store address of help text
  3846.     sta    cmhptr        ;  in help pointer
  3847.     lda    #kerhlp^    ;        ...
  3848.     sta    cmhptr+1    ;        ...
  3849.     ldy    #$00        ;  No special flags needed
  3850.     lda    #cmkey        ; Set up for keyword parse
  3851.     jsr    comnd        ; Try to parse it
  3852.      jmp    kermt2        ; Failed
  3853.     lda    #kermtb\    ; Get address of jump table
  3854.     sta    jtaddr        ;        ...
  3855.     lda    #kermtb^    ;        ...
  3856.     sta    jtaddr+1    ;        ...
  3857.     txa            ; Offset to AC
  3858. jmpind: clc            ;[DD] Jump indexed
  3859.     adc    jtaddr        ; Add offset to low byte
  3860.     sta    jtaddr        ;        ...
  3861.     bcc    jmpin1        ;        ...
  3862.     inc    jtaddr+1    ; If carry inc high byte
  3863. jmpin1: jmp    (jtaddr)    ; Jump to address
  3864.  
  3865. kermtb: jmp    telnet        ; Connect command
  3866.     jmp    exit        ; Exit command
  3867.     jmp    help        ; Help command
  3868.     jmp    log        ; Log command
  3869.     jmp    exit        ; Quit command
  3870.     jmp    receve        ; Receive command
  3871.     jmp    send        ; Send command
  3872.     jmp    setcom        ; Set command
  3873.     jmp    show        ; Show command
  3874.     jmp    status        ; Status command
  3875.     jmp    bye        ;[EL] Shut and logout remote server command
  3876.     jmp    finish        ;[EL] Shut remote server
  3877.     jmp    getfrs        ;[EL] Get file from remote server
  3878.     jmp    doscmd        ;[40] Send disk command
  3879.     jmp    dirst        ;[40] Get directory
  3880.     jmp    savst        ;[47] Save parameters
  3881.     jmp    restst        ;[47] Restore parameters
  3882. kermt2: ldx    #ermes1\    ; L.O. byte of error message
  3883.     ldy    #ermes1^    ; H.O. byte of error message
  3884.     jsr    prstr        ; Print the error
  3885.     jmp    kermit        ; Go back
  3886. kermt3: ldx    #ermes3\    ; L.O. byte of error
  3887.     ldy    #ermes3^    ; H.O. byte of error
  3888.     jsr    prstr        ; Print it
  3889.     jmp    kermit        ; Try again
  3890. kermt4: ldx    #ermes4\    ; L.O. byte of error
  3891.     ldy    #ermes4^    ; H.O. byte of error
  3892.     jsr    prstr        ; Print the text
  3893.     jmp    kermit        ; Try again
  3894. kermt5: ldx    #ermes6\    ; L.O. byte of error
  3895.     ldy    #ermes6^    ; H.O. byte of error
  3896.     jsr    prstr        ; Print error text ('keyword')
  3897.     jmp    kermit        ; Start at the beginning again
  3898. kermt6: ldx    #ermes7\    ; L.O. byte of error
  3899.     ldy    #ermes7^    ; H.O. byte of error
  3900.     jsr    prstr        ; Print the error message ('file spec')
  3901.     jmp    kermit        ;    and try again
  3902. kermt7: ldx    #ermes8\    ; L.O. byte of error message text
  3903.     ldy    #ermes8^    ; H.O. byte of error
  3904.     jsr    prstr        ; Print it ('integer')
  3905.     jmp    kermit        ; Try for another command line
  3906. kermt8: ldx    #ermes9\    ; L.O. byte of error
  3907.     ldy    #ermes9^    ; H.O. byte of error
  3908.     jsr    prstr        ; Print the message ('switch')
  3909.     jmp    kermit        ; Try for another command line
  3910. kermt9: ldx    #ermesa\    ; L.O. byte of error message
  3911.     ldy    #ermesa^    ; H.O. byte of error message
  3912.     jsr    prstr        ; Print the message ('')
  3913.     jmp    kermit        ; Try for another command line
  3914. kermta:    ldx    #ermesb\    ; L.O. byte of error message
  3915.     ldy    #ermesb^    ; H.O. byte of error message
  3916.     jsr    prstr        ; Print the message ('text')
  3917.     jmp    kermit        ; Go back to top of loop
  3918.  
  3919. .SBTTL    Telnet routine
  3920.  
  3921. ;
  3922. ;    This routine handles the connect command. After connecting
  3923. ;    to a host system, this routine alternates calling routines
  3924. ;    which will pass input from the port to the screen and pass
  3925. ;    output from the keyboard to the port. This kermit will
  3926. ;    ignore all characters until it sees and assigned escape
  3927. ;    character.
  3928. ;
  3929. ;        Input:  RS232 REGISTERS IN CNTRL,CMMND
  3930. ;
  3931. ;        Output: NONE
  3932. ;
  3933. ;        Registers destroyed:    A,X,Y
  3934. ;
  3935.  
  3936. telnet: jsr    prcfm        ; Parse and print a confirm
  3937.     lda    #true        ;[48]
  3938.     sta    connec        ;[48]
  3939.     ldx    #inf01a\    ; Get address of first half of message
  3940.     ldy    #inf01a^    ;        ...
  3941.     jsr    prstr        ; Print it out
  3942.     lda    escp        ; Get the 'break connection' character
  3943.     jsr    prchr        ; Print that as a special character
  3944.     ldx    #inf01b\    ; Get address of second half of message
  3945.     ldy    #inf01b^    ;        ...
  3946.     jsr    prstr        ; Print that
  3947.     jsr    prcrlf        ;    and a crelf
  3948.     lda    fast        ; put us in fast mode, if possible
  3949.     sta    $d030
  3950.     lda    #$00        ; turn off graphics mode
  3951.     sta    tekmode
  3952.     sta stat        ; clear the error count
  3953.  
  3954. chrlup:    jsr    scrbel        ; stop the nasty bell tone after 6 jiffys
  3955.     ldx    tekmode        ; do not flash anything in graphics mod
  3956.     bne    chrlup1
  3957.     jsr    scrfls        ; flash the cursor and screen if time to do so
  3958. chrlup1:jsr    keyscn
  3959.     bne    telcnc
  3960. telprc:    jsr    getrs        ; Check for a port character
  3961.     beq    chrlup        ; None available, check keyboard
  3962.     lda    char        ;[31] Get the character read
  3963.     and    #$7f        ;[31] Shut off the high order bit
  3964.     sta    char        ;[26][31] Store the character back
  3965.     ldx    tekmode        ; in tektronics mode
  3966.     beq    telprc1
  3967.     jsr    tek        ; if so, handle this character special
  3968.     jmp    chrlup        ; and then get the next character
  3969. telprc1:ldx    escflg        ; Was previous character an escape?
  3970.     cpx    #on        ;        ...
  3971.     bne    telp2a        ; If not, skip vt52 emulation stuff
  3972.     ldy    vtmod        ; get type of terminal to emulate
  3973.     jsr    case
  3974.     .word    telp2a        ; glass tty. skip vt52 emulation
  3975.     .word    dovt52        ; call vt52 and jmp to telprr
  3976.     .word    dovt100        ; call vt100 and jmp to telprr
  3977.  
  3978. dovt52:    jsr    vt52        ; process the character after the esc
  3979.     jmp    telprr
  3980.  
  3981. dovt100:jsr    vt100        ; process a character in an esc sequence
  3982.     jmp    telprr
  3983.  
  3984. telp2a:    cmp    #$20        ; if less than $20, not printable character
  3985.     bcc    telp3a
  3986.     cmp    #$20+95        ; one of the 95 printable characters?
  3987.     bcs    telp3a        ; nope
  3988.     jsr    cout        ; print the normal character
  3989.     clc            ; repeat forever
  3990.     bcc    chrlup
  3991. telp3a:    jsr    telpr3        ; process it
  3992. telprr:    clc            ;[39] Repeat Main terminal loop
  3993.     bcc    chrlup        ;[39]        ...
  3994.  
  3995. telcnc:    cmp    #$80
  3996.     bcs    out        ; handle special character sequences on output
  3997. tlcnc5:    cmp    escp        ; Is it the connect-escape character?
  3998.     bne    telp6a
  3999.     jmp    intchr        ; If so, go handle the interupt character
  4000. telp6a:    cmp    #cr        ; is this a cr
  4001.     bne    telp6b        ; no.
  4002.     ldx    lmn        ; is this a cr with new line mode set
  4003.     beq    telp6b        ; no
  4004.     jsr    putrs        ; if so, send the cr
  4005.     lda    #lf        ; and a line feed
  4006. telp6b:    jsr    putrs        ;[39] Output the port character
  4007.     ldx    lecho        ; Is local-echo turned on?
  4008.     cpx    #on        ;        ...
  4009.     bne    telcrs        ; If not, we are done
  4010.     cmp    #bs        ; backspace is a real funny character
  4011.     beq    telp5a
  4012.     cmp    #cr        ; cr is a printable character
  4013.     beq    telp4a
  4014.     cmp    #$20        ; is this a printable character?
  4015.     bcc    telcrs        ; no, so dont echo it
  4016.     cmp    #$20+95        ; is this a printable character?
  4017.     bcs    telcrs        ; no, so dont echo it
  4018. telp4a:    jsr    cout        ; Output a copy to the screen
  4019. telcrs: jmp    chrlup        ;[39]        ...
  4020. telp5a:    jsr    scrl        ; handle the backspace in local-echo mode
  4021.     jmp    chrlup
  4022.  
  4023. ;
  4024. ;    out - output a special character sequence
  4025. ;
  4026. ;    Input:    A-reg holds a number indicating which sequence is to be output
  4027. ;
  4028. ;    Output:    putrs called to output character(s)
  4029. ;
  4030. ;    This routine handles special key sequences like cursor up, pf1,
  4031. ;    and the likes.
  4032. ;
  4033.  
  4034. out:    jsr    outit
  4035.     jmp    chrlup
  4036.  
  4037. outit:    pha            ; save the identifier
  4038.     lsr    a        ; get the family
  4039.     lsr    a
  4040.     lsr    a
  4041.     lsr    a
  4042.     and    #$07
  4043.     tay            ; case selector is family
  4044.     pla            ; remember the identifier
  4045.     and    #$0f        ; extract the family member to pass
  4046.     jsr    case
  4047.     .word    out0        ; numeric key pad
  4048.     .word    out1        ; pf key
  4049.     .word    out2        ; cursor key
  4050.     .word    out3        ; programmable function key
  4051.     .word    out4        ; miscellaneous keys
  4052.     .word    out5        ; null
  4053.  
  4054. out0:    ldx    #deckpam-vt100sw; check if keyboard is numeric or alternate
  4055.     jsr    outsub
  4056.     jsr    case
  4057.     .word    out0a        ; keypad does not exist if not emulating vtXX
  4058.     .word    out0a        ; keypad in vt52 numeric mode
  4059.     .word    out0a        ; keypad in vt100 numeric mode
  4060.     .word    out0b        ; keypad in vt52 alternate mode
  4061.     .word    out0c        ; keypad in vt100 alternate mode
  4062.  
  4063. out0a:    ora    #'0        ; convert to digit
  4064.     jsr    putrs        ; send it
  4065.     rts            ; all done
  4066.  
  4067. out0b:    pha            ; save the key
  4068.     lda    #esc        ; send an escape
  4069.     jsr    putrs
  4070.     lda    #'?        ; send a '?'
  4071.     jsr    putrs
  4072.     pla
  4073.     clc
  4074.     adc    #'p        ; send 'p' plus whatever
  4075.     jsr    putrs
  4076.     rts            ; all done
  4077.  
  4078. out0c:    pha            ; save the key
  4079.     lda    #esc        ; send an escape
  4080.     jsr    putrs
  4081.     lda    #'O        ; send a 'O'
  4082.     jsr    putrs
  4083.     pla
  4084.     clc
  4085.     adc    #'p        ; send 'p' plus whatever
  4086.     jsr    putrs
  4087.     rts            ; all done
  4088.  
  4089. out1:    ldy    vtmod        ; get terminal emulation
  4090.     jsr    case
  4091.     .word    anyrts        ; if not emulating anything, no pf keys
  4092.     .word    out1a        ; pfkeys in vt52 mode
  4093.     .word    out1b        ; pfkeys in vt100 mode
  4094.  
  4095. out1a:    pha            ; save the key
  4096.     lda    #esc        ; send an escape
  4097.     jsr    putrs
  4098.     pla            ; send 'P' plus whatever
  4099.     clc
  4100.     adc    #'P
  4101.     jsr    putrs
  4102.     rts
  4103.  
  4104. out1b:    pha            ; save the key
  4105.     lda    #esc        ; send an escape
  4106.     jsr    putrs
  4107.     lda    #'O        ; send 'O'
  4108.     jsr    putrs
  4109.     pla
  4110.     clc
  4111.     adc    #'P        ; send 'P' plus whatever
  4112.     jsr    putrs
  4113.     rts
  4114.  
  4115. out2:    ldx    #decckm-vt100sw    ; check the setting of the cursor keys
  4116.     jsr    outsub
  4117.     jsr    case
  4118.     .word    anyrts        ; cursor keys do not exist if not emulating vt
  4119.     .word    out2a        ; vt52
  4120.     .word    out2b        ; vt100 in cursor mode
  4121.     .word    out2a        ; cursor mode does not matter if emulating vt52
  4122.     .word    out2c        ; vt100 in application mode
  4123.  
  4124. out2a:    pha            ; save the key to send
  4125.     lda    #esc        ; send esc
  4126.     jsr    putrs
  4127.     pla
  4128.     clc
  4129.     adc    #'A        ; send 'A' plus whatever
  4130.     jsr    putrs
  4131.     rts            ; all done
  4132.  
  4133. out2b:    pha            ; save the key to send
  4134.     lda    #esc        ; send an escape
  4135.     jsr    putrs
  4136.     lda    #'[        ; send an '['
  4137.     jsr    putrs
  4138.     pla
  4139.     clc
  4140.     adc    #'A        ; send 'A' plus whatever
  4141.     jsr    putrs
  4142.     rts            ; all done
  4143.  
  4144. out2c:    pha            ; save the key to send
  4145.     lda    #esc        ; send an escape
  4146.     jsr    putrs
  4147.     lda    #'O        ; send 'O'
  4148.     jsr    putrs
  4149.     pla
  4150.     clc
  4151.     adc    #'A        ; send 'A' plus whatever
  4152.     jsr    putrs
  4153.     rts
  4154.  
  4155. out3:    rts            ; not handled yet
  4156.  
  4157. out4:    ldx    #deckpam-vt100sw    ; check the setting of the keypad
  4158.     jsr    outsub
  4159.     jsr    case
  4160.     .word    out4a        ; if no terminal emulation
  4161.     .word    out4a        ; emulating vt52 in numeric keypad mode
  4162.     .word    out4a        ; emulating vt100 in numeric keypad mode
  4163.     .word    out4b        ; emulating vt52 in alternate keypad mode
  4164.     .word    out4c        ; emulating a vt100 in alternate keypad mode
  4165.  
  4166. out4a:    tax            ; look it up in out4a1
  4167.     lda    out4a1,x
  4168.     jsr    putrs        ; send it
  4169.     rts
  4170.  
  4171. out4b:    pha            ; save it
  4172.     lda    #esc        ; send an escape
  4173.     jsr    putrs
  4174.     lda    #'?        ; send a '?'
  4175.     jsr    putrs
  4176.     pla            ; remember character to send
  4177.     tax            ; look it up in out4b1
  4178.     lda    out4b1,x
  4179.     jsr    putrs        ; send it
  4180.     rts
  4181.  
  4182. out4c:    pha            ; save it
  4183.     lda    #esc        ; send an escape
  4184.     jsr    putrs
  4185.     lda    #'O        ; send a 'O'
  4186.     jsr    putrs
  4187.     pla            ; remember character to send
  4188.     tax            ; look it up in out4b1
  4189.     lda    out4b1,x
  4190.     jsr    putrs        ; send it
  4191.     rts
  4192.     
  4193. out5:    tay            ; get the function to perfrom
  4194.     jsr    case
  4195.     .word    out5a        ; send a null
  4196.     .word    sbreak        ; send a break
  4197.  
  4198. out5a:    lda    #$00        ; send a nulll
  4199.     jsr    putrs
  4200.     rts            ; all done
  4201.  
  4202. ;
  4203. ;    outsub - handy routine to determine which subroutine to call
  4204. ;
  4205. ;    Input:    X-reg index into vt100sw
  4206. ;
  4207. ;    Output:    Y-reg contains an index
  4208. ;
  4209. ;    This routine returns 0 if no terminal is being emulated,
  4210. ;    1 if a vt52 is being emulated,
  4211. ;    2 if a vt100 is being emulated,
  4212. ;    3 if a vt52 is being emulated and vt100sw,x is set
  4213. ;    4 if a vt100 is being emulated and vt100sw,x is set
  4214. ;
  4215.  
  4216. outsub:    ldy    vt100sw,x    ; check the switch
  4217.     bne    outsub1        ; switch is set
  4218.     ldy    vtmod
  4219.     rts
  4220. outsub1:ldy    vtmod        ; get terminal emulation
  4221.     cpy    #$00
  4222.     beq    outsub2        ; if zero, don't adjust for the switch
  4223.     iny            ; add two to adjust for the switch being set
  4224.     iny
  4225. outsub2:rts
  4226.  
  4227. ;    Handle special input characters
  4228.  
  4229. telpr3:    cmp    #$07        ; Is it a ^G (bell)
  4230.     bne    tlpr3a        ; No
  4231.     jsr    bell        ; Ring bell
  4232.     rts            ;[39]
  4233. tlpr3a: cmp    #$0d        ; Is it a ^M (cr) ?
  4234.     bne    tlpr3b        ; No
  4235.     jsr    scrcr        ; Go do a <cr>
  4236.     rts            ;[39]
  4237. tlpr3b:    cmp    #$09        ;[26] Is it a ^I (tab) ?
  4238.     bne    tlpr3c        ;[26] No
  4239.     jsr    prttab        ;[26] Print to the next tab stop
  4240.     rts            ;[39]
  4241. tlpr3c:    cmp    #$1b        ; Was it an 'escape'?
  4242.     bne    tlpr3d        ; No
  4243.     lda    #on        ; Set the escape flag on
  4244.     sta    escflg        ;        ...
  4245.     lda    #$00        ; zero pointers for vt100 emulation
  4246.     sta    vt100st        ; state is zero
  4247.     sta    vt100pt        ; parameter pointer is zero
  4248.     rts            ; Return
  4249. tlpr3d:    cmp    #$0a        ; was it a line feed
  4250.     bne    tlpr3e
  4251.     jsr    scrlf        ; perform the line feed
  4252.     ldx    lmn        ; is new line mode set
  4253.     beq    tlpr3d1        ; if not, do nothing special
  4254.     jsr    scrcr        ; if it is set, lf implys cr
  4255. tlpr3d1:rts 
  4256. tlpr3e:    cmp    #$08        ; was it a backspace?
  4257.     bne    tlpr3f
  4258.     jsr    scrl        ; move the cursor left
  4259. tlpr3f:    cmp    #$0e        ; Was it a 'shift out'
  4260.     bne    tlpr3g        ; No
  4261.     lda    #$01        ; select the g1 character set
  4262.     sta    gx
  4263.     rts
  4264. tlpr3g:    cmp    #$0f        ; Was it a 'shift in'
  4265.     bne    tlpr3h        ; No
  4266.     lda    #$00        ; select g0 character set
  4267.     sta    gx
  4268. tlpr3h:    rts
  4269.  
  4270. ;
  4271. ;    out4a1 - table of characters to send when keypad is in numeric mode
  4272. ;
  4273. ;    This is a table of characters to send when '-', '+', '.', or enter
  4274. ;    is pushed on the numeric keypad.
  4275.  
  4276. out4a1:    .byte    "-+."
  4277.     .byte    cr
  4278.  
  4279. ;
  4280. ;    out4b1 - table of characters to send when keypad is in alternate mode
  4281. ;
  4282. ;    This is a table of characters to send when '-', '+', '.', or enter
  4283. ;    is pushed on the numeric keypad
  4284.  
  4285. out4b1:    .byte    "mlnM"
  4286. ;
  4287. ;    Intchr - processes the character which frollows the interupt
  4288. ;    character and performs functions based on what that character
  4289. ;    is.
  4290. ;
  4291.  
  4292. intchr:    lda    tekmode        ; if we are in tek mode, we have to get out
  4293.     beq    intch5
  4294.     lda    #$00
  4295.     sta    tekmode
  4296.     jsr    scrtxt
  4297.     lda    line25        ; clear the entire text screen including line25
  4298.     pha
  4299.     lda    #$01
  4300.     sta    line25
  4301.     jsr    scrclr
  4302.     pla
  4303.     sta    line25
  4304. intch5:    jsr    rdkey        ; Get the next character
  4305.     lda    char        ;[31]
  4306.     sta    kerchr        ; Save a copy of it
  4307.     and    #$5f        ; Capitalize it
  4308.     cmp    #'C        ; Does user want the connection closed?
  4309.     bne    intch0        ; If not, try next option
  4310.     lda    #$fc        ; if we are in fast mode, we have to get out
  4311.     sta    $d030
  4312.     pla            ;[39] Fix the stack
  4313.     pla            ;[39]
  4314.     lda    #false        ;[48]
  4315.     sta    connec        ;[48]
  4316.     lda    #$00        ; make sure output is turned on when we resume
  4317.     sta    suspend
  4318.     jsr    scrrst        ; reset the screen to normal characterstics
  4319.     jmp    kermit        ;[39]
  4320. intch0: cmp    #'S        ; Does the user want status?
  4321.     bne    intch1        ; Nope
  4322.     jsr    stat01        ;[EL] Give it to him
  4323.     jmp    telcrs        ;[39]
  4324. intch1: cmp    #'B        ;[DD] Send break?
  4325.     bne    intc1a        ; No
  4326.     jsr    sbreak        ; Yes, go send one
  4327.     jmp    telcrs        ;[39]
  4328. intc1a: lda    kerchr        ; Fetch back the original character
  4329.     and    #$7f        ; Get rid of the H.O. bit
  4330.     cmp    #'?        ; Does user need help?
  4331.     bne    intch2        ; If not, continue
  4332.     ldx    #inthlp\    ; Get the address of the proper help string
  4333.     ldy    #inthlp^    ;        ...
  4334.     jsr    prstr        ; Print the help stuff
  4335.     jmp    intchr        ; Get another option character
  4336. intch2: cmp    escp        ; Is it another connect-escape?
  4337.     bne    intch4        ;[39]
  4338.     jsr    putrs        ; Stuff the character at the port
  4339.     jmp    telcrs        ;[39]
  4340. intch4: cmp    #'0        ;[39]
  4341.     bne    intch3        ;[39] Nope, this is an error
  4342.     lda    #$00        ;[39]
  4343.     jsr    putrs        ;[39]
  4344.     jmp    telcrs        ;[39]
  4345. intch3: jsr    bell         ; Sound bell at the user
  4346.     jmp    telcrs        ;[39]
  4347.  
  4348. ;
  4349. ;    Vt52 - will carry out the equivalent of most of the vt52 functions
  4350. ;    available.
  4351. ;
  4352.  
  4353. vt52:    lda    #off        ; First, turn off the escape flag
  4354.     sta    escflg        ;        ...
  4355.     lda    char        ;[26] Get the character to check
  4356.     and    #$7f        ; Turn off the H.O. bit
  4357. vt52z:    sec            ;[26] Get the cursor position
  4358.     jsr    ploth        ;[26] in X,Y
  4359.     sty    hch        ;[39]
  4360.     stx    hcv        ;[39]
  4361.     cmp    #'A        ; It is, is it an 'A'?
  4362.     bne    vt52a        ; No, try next character
  4363.     jsr    scru        ; Go up one line
  4364.     rts            ; Return
  4365. vt52a:  cmp    #'B        ; Is it a 'B'?
  4366.     bne    vt52b        ; Next char
  4367.     jsr    scrd        ; Yes, go down one line
  4368.     rts            ;    and go back
  4369. vt52b:  cmp    #'C        ; 'C'?
  4370.     bne    vt52c        ; Nope
  4371.     jsr    scrr        ; Yes, go forward one space
  4372.     rts            ;    and return
  4373. vt52c:  cmp    #'D        ; 'D'?
  4374.     bne    vt52d        ; No
  4375.     jsr    scrl        ; Yes, do a back-space
  4376.     rts            ; Return
  4377. vt52d:  cmp    #'H        ; 'H'?
  4378.     bne    vt52e        ; No, try next character
  4379.     jsr    scrhom        ; Home cursor (no clear screen)
  4380.     rts            ;    then return
  4381. vt52e:  cmp    #'I        ; 'I'?
  4382.     bne    vt52f        ; Nope
  4383.     jsr    scrrlf        ;[39] Do a reverse line feed
  4384.     rts            ;  and return
  4385. vt52f:  cmp    #'J        ; 'J'?
  4386.     bne    vt52g        ; No
  4387.     jsr    scred0        ; Clear from where we are to end-of-page
  4388.     rts            ;    then return
  4389. vt52g:  cmp    #'K        ; 'K'?
  4390.     bne    vt52h        ; Try last option
  4391.     jsr    screl0        ; Clear to end-of-line
  4392.     rts            ; Return
  4393. vt52h:  cmp    #'Y        ; 'Y'
  4394.     bne    vt52i        ;[19]
  4395.     jsr    vtdca        ; Do direct cursor addressing
  4396.     rts            ;    then return
  4397. vt52i:    cmp    #'o        ;[19] 'o'
  4398.     bne    vt52j        ;[19]
  4399.     lda    #$01
  4400.     sta    reverse        ; turn reverse on
  4401.     rts            ;[19] Return
  4402. vt52j:    cmp    #'n        ;[19] 'n'
  4403.     bne    vt52k
  4404.     lda    #$00
  4405.     sta    reverse        ; turn reverse off
  4406.     rts            ;[19]
  4407. vt52k:    cmp    #'>        ; '>'
  4408.     bne    vt52l
  4409.     lda    #$00        ; put keypad in numeric mode
  4410.     sta    deckpam
  4411.     rts
  4412. vt52l:    cmp    #'=        ; '='
  4413.     bne    vt52m
  4414.     lda    #$01        ; put keypad in alternate mode
  4415.     sta    deckpam
  4416.     rts
  4417. vt52m:    cmp    #'<        ; '>'
  4418.     bne    vt52n
  4419.     lda    #$02        ; set terminal emulation to vt100
  4420.     sta    vtmod
  4421.     rts
  4422. vt52n:    cmp    #'Z        ; 'Z'
  4423.     bne    vt52o
  4424.     lda    #esc        ; identify terminal type
  4425.     jsr    putrs
  4426.     lda    #'/
  4427.     jsr    putrs
  4428.     lda    #'Z
  4429.     jsr    putrs
  4430.     rts
  4431. vt52o:    cmp    #'F        ; set graphics mode
  4432.     bne    vt52p
  4433.     lda    #$01
  4434.     sta    g0
  4435.     sta    g1
  4436.     rts
  4437. vt52p:    cmp    #'G        ; clear graphics mode
  4438.     bne    vt52q
  4439.     lda    #$00
  4440.     sta    g0
  4441.     sta    g1
  4442.     rts
  4443. vt52q:    cmp    #$0c        ; put in tek mode
  4444.     bne    vtig
  4445.     jsr    scrtek
  4446.     jsr    screra        ; erase the graphics screen
  4447.     lda    #$01
  4448.     sta    tekmode        ; and enter grahics mode
  4449.     lda    #747\
  4450.     sta    tekcylo
  4451.     lda    #747^
  4452.     sta    tekcyhi
  4453.     lda    #$00
  4454.     sta    tekcxlo
  4455.     sta    tekcxhi
  4456.     rts
  4457. vtig:    pha            ; Save a copy
  4458.     lda    #esc        ; Get an escape
  4459.     jsr    prchr        ; Print the special character
  4460.     pla            ; Fetch the other character back
  4461.     cmp    #esc        ; Is it a second escape?
  4462.     bne    vtig1        ; Nope, print it
  4463.     lda    #on        ; Set escflg on again for next time around
  4464.     sta    escflg        ;        ...
  4465.     rts            ;    and return
  4466. vtig1:  jsr    prchr        ; Print the character
  4467.     rts            ;    and return
  4468.  
  4469. vtdca:    jsr    getrs        ; Check for a character from the port
  4470.     beq    vtdca        ; Try again
  4471.     lda    char        ;[31]
  4472.     and    #$7f        ; Make sure H.O. bit is off
  4473.     sec            ; Subtract hex 30 (make it num from 0 to 23)
  4474.     sbc    #$20        ;        ...
  4475. vtdca2: pha            ; save it
  4476. vtdca3:    jsr    getrs        ; Check port for character
  4477.     beq    vtdca3        ;    go back and try again
  4478.     lda    char        ;[31]
  4479.     and    #$7f        ; Make sure h.o. bit is off
  4480.     sec            ; Subtract hex 20 (make it num from 0 to 23)
  4481.     sbc    #$20        ;        ...
  4482. vtdca5: tax            ; this is the horizontal position
  4483.     pla            ; remember the vertical position
  4484.     tay
  4485.     jsr    scrplt        ; move the cursor here
  4486.     rts            ;    and return
  4487.  
  4488.  
  4489. .SBTTL    VT100 Emulation Routines
  4490.  
  4491. ;
  4492. ;    vt100 - parse a character in a vt100 command sequence
  4493. ;
  4494. ;    Input - A character in the A-reg
  4495. ;
  4496. ;    This routine processes characters after an esc in VT100 mode.
  4497. ;    It parses the command and calls a routine to perform the requested
  4498. ;    function when the last character in the sequence has been received.
  4499. ;
  4500.  
  4501. vt100:    ldx    vt100st        ; state of the command parser
  4502. vt100d:    ldy    vt100ta,x    ; check the parser table
  4503.     beq    vt100b        ; escape sequence is illegal
  4504.     bpl    vt100a        ; is parameter expected?
  4505.     cmp    #1+'9        ; yes.  Was a digit received?
  4506.     bcs    vt100a        ; no, it is not a digit
  4507.     cmp    #'0
  4508.     bcc    vt100a        ; not a digit (carry set for next line)
  4509.     sbc    #'0        ; convert the digit to a value (0..9)
  4510.     pha            ; save it
  4511.     ldy    vt100pt        ; pointer into parameter list
  4512.     lda    freemem,y        ; get the current value
  4513.     asl    a        ; multiplied by 2
  4514.     pha            ; save that too
  4515.     asl    a        ; multiplied by 4
  4516.     asl    a        ; multiplied by 8
  4517.     sta    freemem,y
  4518.     pla
  4519.     clc
  4520.     adc    freemem,y    ; multiplied by 10
  4521.     sta    freemem,y
  4522.     pla
  4523.     clc
  4524.     adc    freemem,y    ; add in the digit
  4525.     sta    freemem,y    ; save the new value of the parameter
  4526.     rts            ; all done (for now. escflg still set)
  4527.  
  4528. vt100a:    cmp    vt100ta,x    ; found character in table?
  4529.     beq    vt100c        ; yes. go change state
  4530.     inx            ; skip to the next entry
  4531.     inx
  4532.     inx
  4533.     jmp    vt100d        ; check this character
  4534.  
  4535. vt100c:    lda    vt100ta+2,x    ; high order byte of routine to call
  4536.     beq    vt100e        ; $00 = state change
  4537.     sta    dest+1
  4538.     lda    vt100ta+1,x    ; low order byte of routine to call
  4539.     sta    dest
  4540.     lda    #$00
  4541.     sta    escflg        ; this command is complete
  4542.     jmp    (dest)        ; perform requested function
  4543.  
  4544. vt100e:    ldy    vt100ta+1,x    ; state to change to
  4545.     sty    vt100st        ; change to it
  4546.     lda    vt100ta,y    ; is a parameter expected?
  4547.     bpl    vt100f        ; no.
  4548.     inc    vt100pt        ; make pointer point to next parameter
  4549.     ldy    vt100pt        ; and zero the parameter
  4550.     cpy    #freesiz    ; still freespace available?
  4551.     bcs    vt100b        ; no.
  4552.     lda    #$00
  4553.     sta    freemem,y
  4554. vt100f:    rts            ; all done (for now. escflg still set)
  4555.  
  4556. vt100b:    lda    #$00        ; an error has occured.  abort processing
  4557.     sta    escflg
  4558.     rts            ; all done
  4559.  
  4560. ;
  4561. ;    vt100b1 - process the <esc> '['  integer 'J' vt100 sequence
  4562. ;
  4563. ;    This routine calls scred0, scred1, or scred2 depending on the
  4564. ;    value of the integer.
  4565. ;
  4566.  
  4567. vt100b1:ldy    freemem+1    ; what is the integer
  4568.     cpy    #$03        ; check for strange vt100 sequences
  4569.     bcs    vt100er        ; this is a strange sequence
  4570.     jsr    case        ; call the proper routine
  4571.     .word    scred0        ; call scred0 if the integer is 0
  4572.     .word    scred1        ; call scred1 if the integer is 1
  4573.     .word    scred2        ; call scred2 if the integer is 2
  4574.  
  4575. ;
  4576. ;    vt100c1 - process the <esc> '[' integer 'K'
  4577. ;
  4578. ;    This routine calls screl0, screl1, or screl2 depending on the
  4579. ;    value of the integer.
  4580.  
  4581. vt100c1:ldy    freemem+1    ; what is the integer
  4582.     cpy    #$03        ; check for strange vt100 sequences
  4583.     bcs    vt100er        ; this is a strange sequence
  4584.     jsr    case        ; call the proper routine
  4585.     .word    screl0        ; call screl0 if the integer is 0
  4586.     .word    screl1        ; call screl1 if the integer is 1
  4587.     .word    screl2        ; call screl2 if the integer is 2
  4588.  
  4589. ;
  4590. ;    vt100d1 - process the <esc> '[' integer ';' integer 'f' and
  4591. ;                 <esc> '[' integer ';' integer 'H' vt100 commands
  4592. ;
  4593. ;    This routine calls scrplt to put the cursor at the position indicated
  4594. ;    by the two integers.
  4595.  
  4596. vt100d1:ldx    #$00        ; get the first integer
  4597.     ldy    #$01        ; default value is 1
  4598.     jsr    vt100pa
  4599.     ldx    decom        ; is origin mode absolute
  4600.     beq    vt100d4        ; if absolute, do not add in top
  4601.     clc
  4602.     adc    top        ; if relative, add in top
  4603. vt100d4:tay
  4604.     dey            ; solve the off-by-one problem
  4605.     cpy    #25        ; check it for reasonability
  4606.     bcc    vt100d2
  4607.     ldy    #24        ; if unreasonable, move cursor to bottom line
  4608. vt100d2:sty    dest        ; save y position
  4609.     ldx    #$01        ; get the second integer
  4610.     ldy    #$01        ; default value is 1
  4611.     jsr    vt100pa
  4612.     tax
  4613.     dex            ; solve the off-by-one problem
  4614.     jsr    scrrgh        ; check it for reasconablilty
  4615.     bcc    vt100d3
  4616.     tax            ; if unreasonable, move cursor to far right
  4617. vt100d3:ldy    dest        ; get y position
  4618.     jsr    scrplt        ; finally move the cursor
  4619.     rts            ; all done
  4620.  
  4621. ;
  4622. ;    vt100e1 - process the <esc> integer ';' integer 'r' sequence
  4623. ;
  4624. ;    This routine sets the top and bottom of the scrolling area.
  4625. ;
  4626.  
  4627. vt100e1:ldx    #$00        ; get the first parameter
  4628.     ldy    #$01        ; default value is one
  4629.     jsr    vt100pa
  4630.     sta    dest        ; save it in a safe place
  4631.     dec    dest        ; solve the off-by-one problem
  4632.     jsr    scrbot        ; get default for second parameter
  4633.     tay
  4634.     iny            ; solve the off-by-one problem
  4635.     ldx    #$01        ; get the second parameter
  4636.     jsr    vt100pa
  4637.     tay
  4638.     dey            ; solve the off-by-one problem
  4639.     jsr    scrbot        ; check it for reasonablilty
  4640.     bcs    vt100e2
  4641.     cpy    dest        ; second must be greater than first
  4642.     bcc    vt100e2        ; unreasonable
  4643.     sty    bot        ; set the bottom margin
  4644.     ldy    dest        ; set the top margin
  4645.     sty    top
  4646.     lda    decom        ; check origin mode
  4647.     bne    vt100e3        ; if origin mode off, move to top of area
  4648.     ldy    #$00        ; if origin mode on, move to top of screen
  4649. vt100e3:ldx    #$00        ; in any case, move cursor to far left
  4650.     jsr    scrplt
  4651. vt100e2:rts
  4652.  
  4653. vt100er:rts
  4654.     
  4655. ;
  4656. ;    vt100f1 - process the <esc> '[' integer 'A' sequence
  4657. ;
  4658. ;    This routine moves the cursor up <integer> lines
  4659. ;
  4660.  
  4661. vt100f1:ldx    #$00        ; get the parameter
  4662.     ldy    #$01        ; default value is one
  4663.     jsr    vt100pa
  4664.     sec            ; cutsy way to subtract it form cursor pos
  4665.     eor    #$ff
  4666.     adc    cy
  4667.     tay
  4668.     bcc    vt100f3        ; gone past top of screen
  4669.     cpy    top        ; outside scrolling area
  4670.     bcs    vt100f2        ; no
  4671. vt100f3:ldy    top        ; move cursor to top
  4672. vt100f2:ldx    cx
  4673.     jsr    scrplt        ; plot the cursor here
  4674.     rts
  4675.  
  4676. ;
  4677. ;    vt100g1 - process the <esc> '[' integer 'B' sequence
  4678. ;
  4679. ;    This routine moves the cursor down <integer> lines
  4680. ;
  4681.  
  4682. vt100g1:ldx    #$00        ; get the parameter
  4683.     ldy    #$01        ; the default is one
  4684.     jsr    vt100pa
  4685.     clc            ; add the parameter to cy
  4686.     adc    cy
  4687.     tay
  4688.     cpy    bot        ; see if still in scrolling area
  4689.     bcc    vt100g2
  4690.     ldy    bot        ; nope. move the cursor to the bottom
  4691. vt100g2:ldx    cx
  4692.     jsr    scrplt        ; plot the cursor here
  4693.     rts            ; all done
  4694.  
  4695. ;
  4696. ;    vt100h1 - process the <esc> '[' integer 'C' sequence
  4697. ;
  4698. ;    This routine moves the cursor right <integer> characters
  4699. ;
  4700.  
  4701. vt100h1:ldx    #$00        ; get the parameter
  4702.     ldy    #$01        ; default value is one
  4703.     jsr    vt100pa
  4704.     clc            ; add it into the current cursor position
  4705.     adc    cx
  4706.     tax
  4707.     jsr    scrrgh        ; check it for reasonability
  4708.     bcc    vt100h2        ; it is reasonable
  4709.     tax            ; if unreasonable, move cursor to far right
  4710. vt100h2:ldy    cy        ; plot the cursor here
  4711.     jsr    scrplt
  4712.     rts
  4713.  
  4714. ;
  4715. ;    vt100i1 - process the <esc>  '[' integer 'D' sequence
  4716. ;
  4717. ;    This routine moves the cursor left <integer> characters
  4718. ;
  4719.  
  4720. vt100i1:ldx    #$00        ; get the parameter
  4721.     ldy    #$01        ; default value is one
  4722.     jsr    vt100pa
  4723.     sec            ; cutsy way to subtract from cx
  4724.     eor    #$ff
  4725.     adc    cx
  4726.     bcs    vt100i2        ; check if gone past left margin
  4727.     lda    #$00        ; if so, move to far left
  4728. vt100i2:tax
  4729.     ldy    cy        ; plot the cursor here
  4730.     jsr    scrplt
  4731.     rts
  4732.  
  4733. ;
  4734. ;    vt100j1 - process the <esc> '[' [  integer ';' ...] 'm' sequence
  4735. ;
  4736. ;    This routine sets the graphic rendition (reverse, alternate colors,
  4737. ;    underline and flashing) parameters.  Note that it may be passed
  4738. ;    0 or more parameters
  4739. ;
  4740.  
  4741. vt100j1:ldx    #$00        ; start with the first parameter
  4742. vt100j5:ldy    #$00        ; default value is zero
  4743.     jsr    vt100pa
  4744.     beq    vt100j3        ; if zero, clear everything
  4745.     tay
  4746.     cpy    #vt100gs
  4747.     bcs    vt100j4        ; unreasonable parameter!
  4748.     lda    #$01        ; set the proper parameter
  4749.     sta    vt100gr,y
  4750.     bne    vt100j4        ; always taken
  4751. vt100j3:jsr    vt100j2        ; clear everything
  4752. vt100j4:inx            ; get the next parameter
  4753.     cpx    vt100pt        ; all done?
  4754.     bcc    vt100j5        ; nope.  Do some more
  4755.     rts            ; all done.
  4756.  
  4757. vt100j2:lda    #$00        ; clear everything
  4758.     sta    alternt        ; alternate color (highlighting)
  4759.     sta    flash        ; flashing off
  4760.     sta    underln        ; dont underline
  4761.     sta    reverse        ; dont reverse
  4762.     rts            ; everything cleared.
  4763.  
  4764. ;
  4765. ;    vt100k - process the <esc> '[' '?' integer 'h' sequence
  4766. ;
  4767. ;    This routine sets a vt100 switch
  4768. ;
  4769.  
  4770. vt100k:    ldx    #$00        ; start with the first parameter
  4771. vt100k1:ldy    #$00        ; default value is zero
  4772.     jsr    vt100pa        ; get the value of the parameter
  4773.     cmp    #vt100ss    ; is this a legal switch?
  4774.     bcs    vt100k2        ; nope.  Better not try to set it
  4775.     tay
  4776.     lda    #$01
  4777.     sta    vt100sw,y    ; set this switch
  4778.     cpy    #decrev-vt100sw    ; reverse entire screen?
  4779.     bne    vt100k2
  4780.     txa            ; save x register
  4781.     pha
  4782.     jsr    scrset        ; call screen driver
  4783.     pla
  4784.     tax            ; restore x register
  4785. vt100k2:inx
  4786.     cpx    vt100pt        ; done yet?
  4787.     bcc    vt100k1
  4788.     rts            ; all done
  4789.     
  4790. ;
  4791. ;    vt100l - process the <esc> '[' '?' integer 'l' sequence
  4792. ;
  4793. ;    This routine clears a vt100 switch
  4794. ;
  4795.  
  4796. vt100l:    ldx    #$00        ; start with the first parameter
  4797. vt100l1:ldy    #$00        ; default value is zero
  4798.     jsr    vt100pa        ; get the value of the parameter
  4799.     cmp    #vt100ss    ; is this a legal switch?
  4800.     bcs    vt100l2        ; nope.  Better not try to clear it
  4801.     cmp    #decanm-vt100sw    ; enter vt52 emulation?
  4802.     bne    vt100l3
  4803.     jsr    scrrst        ; reset the terminal
  4804.     ldy    #$01        ; put terminal in vt52 mode
  4805.     sty    vtmod
  4806.     rts
  4807. vt100l3:tay
  4808.     lda    #$00
  4809.     sta    vt100sw,y    ; clear this switch
  4810.     cpy    #decrev-vt100sw    ; reverse entire screen?
  4811.     bne    vt100l2
  4812.     txa            ; save x register
  4813.     pha
  4814.     jsr    scrset        ; call screen driver
  4815.     pla
  4816.     tax            ; restore x register
  4817. vt100l2:inx
  4818.     cpx    vt100pt        ; done yet?
  4819.     bcc    vt100l1
  4820.     rts            ; all done
  4821.  
  4822. ;
  4823. ;    vt100m - put the keypad in numeric mode
  4824. ;
  4825. ;    This routine puts the keypad into numeric mode
  4826. ;
  4827.  
  4828. vt100m:    lda    #$00
  4829.     sta    deckpam
  4830.     rts
  4831.  
  4832. ;
  4833. ;    vt100n - put the keypad into alternate mode
  4834. ;
  4835. ;    This routine puts the keypad into alternate mode
  4836. ;
  4837.  
  4838. vt100n:    lda    #$01
  4839.     sta    deckpam
  4840.     rts
  4841.  
  4842. ;
  4843. ;    vt100o - perform the next line function
  4844. ;
  4845. ;    This routine moves the cursor down one line and to the leftmost column
  4846. ;
  4847.  
  4848. vt100o:    jsr    scrlf        ; move the cursor down one line
  4849.     jsr    scrcr        ; move the cursor to the leftmost column
  4850.     rts            ; all done
  4851.  
  4852. ;
  4853. ;    vt100p - set a tab stop
  4854. ;
  4855. ;    This routine sets a tab stop at the current cursor position
  4856. ;
  4857.  
  4858. vt100p:    ldx    cx        ; get the current cursor position
  4859.     lda    #$00        ; zero means tab stop here
  4860.     sta    tabs,x        ; set the tab
  4861.     rts            ; all done
  4862.  
  4863. ;
  4864. ;    vt100q - clear tab stop(s)
  4865. ;
  4866. ;    This routine processes the <esc> '[' integer 'g' sequence
  4867. ;
  4868. ;    If 'integer' is zero, a tab stop is cleared.  If 'integer' is three
  4869. ;    all the tab stops are cleared.   Otherwise, nothing happens.
  4870. ;
  4871.  
  4872. vt100q:    ldx    #$00        ; get the first parameter
  4873.     ldy    #$00        ; default value is zero
  4874.     jsr    vt100pa        ; get the parameter
  4875.     beq    vt100q1        ; if zero, clear a tab stop
  4876.     cmp    #3        ; if not zero or three, ignore
  4877.     bne    vt100q3        ; if non-zero (usually 3), clear all tabs
  4878.     ldx    #79        ; clear 80 tab stops
  4879.     lda    #$01        ; non-zero entry in tabs means tab cleared
  4880. vt100q2:sta    tabs,x        ; cleared one
  4881.     dex
  4882.     bpl    vt100q2        ; repeat till done
  4883.     rts            ; all done
  4884. vt100q1:lda    #$01        ; non-zero entry in tabs means tab cleared
  4885.     ldx    cx        ; get tabstop to clear
  4886.     sta    tabs,x        ; cleared
  4887. vt100q3:rts            ; all done
  4888.  
  4889. ;
  4890. ;    vt100r - make a terminal report
  4891. ;
  4892. ;    This routine processes the <esc> '[' integer 'n' sequence
  4893. ;
  4894. ;    If 'integer' is 5, the 'terminal OK' reply is generated.  Otherwise
  4895. ;    the cursor position reply is generated.
  4896. ;
  4897.  
  4898. vt100r:    ldx    #$00        ; get the first parameter
  4899.     ldy    #$00        ; default is 0
  4900.     jsr    vt100pa        ; get the parameter
  4901.     cmp    #5        ; want the 'terminal OK' report?
  4902.     beq    vt100r1        ; vt100r1 sends the 'terminal OK' reply
  4903.     cmp    #6        ; if neither report desired, ignore
  4904.     bne    vt100r3
  4905.     lda    #esc        ; send <esc> '[' <line> ';' <column> 'R'
  4906.     jsr    putrs
  4907.     lda    #'[
  4908.     jsr    putrs
  4909.     lda    cy        ; send the line
  4910.     ldy    decom        ; if in origin mode, subtract top
  4911.     beq    vt100r2
  4912.     sec
  4913.     sbc    top
  4914. vt100r2:clc
  4915.     adc    #$01        ; solve the off by one problem
  4916.     jsr    outad        ; print a decimal number to the modem
  4917.     lda    #';        ; send ';'
  4918.     jsr    putrs
  4919.     lda    cx        ; send the cursor column
  4920.     clc
  4921.     adc    #$01        ; solve the off by one problem
  4922.     jsr    outad        ; print a decimal number to the modem
  4923.     lda    #'R
  4924.     jsr    putrs
  4925.     rts            ; all done
  4926. vt100r1:lda    #esc        ; send <esc> '[0n'  (Terminal OK reply code)
  4927.     jsr    putrs
  4928.     lda    #'[
  4929.     jsr    putrs
  4930.     lda    #'0
  4931.     jsr    putrs
  4932.     lda    #'n
  4933.     jsr    putrs
  4934. vt100r3:rts            ; done
  4935.  
  4936. ;
  4937. ;    vt100s - report device attributes
  4938. ;
  4939. ;    This routine processes the <esc> 'Z' and <esc> '[' 'c' sequences
  4940. ;
  4941. ;    The device attributes are sent to the modem.
  4942. ;
  4943.  
  4944. vt100s:    lda    #esc        ; send <esc> '[?1;1c' (Device attribute string)
  4945.     jsr    putrs
  4946.     lda    #'[
  4947.     jsr    putrs
  4948.     lda    #'?
  4949.     jsr    putrs
  4950.     lda    #'1
  4951.     jsr    putrs
  4952.     lda    #';
  4953.     jsr    putrs
  4954.     lda    #'2        ; we have AVO (Advanced video option)
  4955.     jsr    putrs
  4956.     lda    #'c
  4957.     jsr    putrs
  4958.     rts            ; all done
  4959.  
  4960. ;
  4961. ;    vt100t - reset terminal
  4962. ;
  4963. ;    This routine processes the <esc> 'c' sequence
  4964. ;
  4965. ;    The terminal is reset
  4966. ;
  4967.  
  4968. vt100t:    jsr    scrrst        ; reset the terminal
  4969.     jsr    scrhom        ; home the cursor
  4970.     lda    line25        ; save the status of the 25th line
  4971.     pha
  4972.     lda    #$01        ; allow the 25th line to be cleared
  4973.     sta    line25
  4974.     jsr    scred2        ; clear entire screen
  4975.     pla            ; restore the status of the 25th line
  4976.     sta    line25
  4977.     rts            ; all done
  4978.  
  4979. ;
  4980. ;    vt100v - set/reset new line mode
  4981. ;
  4982. ;    These routines processes <esc> '[' integer h and <esc> '[' integer 'l'
  4983. ;
  4984. ;        vt100v1 - set new line mode if 'integer' is 20
  4985. ;            - set insert replace mode if 'integer' is 4
  4986. ;        vt100v2 - clear new line mode if 'integer' is 20
  4987. ;            - clear insert replace mde if 'integer' is 4
  4988. ;
  4989.  
  4990. vt100v1:ldx    #$00        ; get the first parameter
  4991.     ldy    #$00        ; default is 0
  4992.     jsr    vt100pa        ; get the parameter
  4993.     cmp    #20        ; is it 20
  4994.     bne    vt100v3        ; if not, ignore it
  4995.     lda    #$01        ; set new line mode
  4996.     sta    lmn
  4997.     rts            ; all done
  4998. vt100v3:cmp    #4        ; is it 4
  4999.     bne    vt100v0        ; if not, ignore it
  5000.     lda    #$01
  5001.     sta    irm
  5002.     rts
  5003. vt100v2:ldx    #$00        ; get the first parameter
  5004.     ldy    #$00        ; default is 0
  5005.     jsr    vt100pa        ; get the parameter
  5006.     cmp    #20        ; is it 20
  5007.     bne    vt100v4        ; if not, ignore it
  5008.     lda    #$00        ; set new line mode
  5009.     sta    lmn
  5010.     rts
  5011. vt100v4:cmp    #4        ; is it 4
  5012.     bne    vt100v0        ; if not, ignre it
  5013.     lda    #$00
  5014.     sta    irm
  5015. vt100v0:rts            ; all done
  5016.  
  5017. ;
  5018. ;    vt100w - mount a character set
  5019. ;
  5020. ;        vt100w1 - mount U.S. ascii character set on g0
  5021. ;        vt100w2 - mount graphics character set on g0
  5022. ;        vt100w3 - mount U.S. ascii character set on g1
  5023. ;        vt100w4 - mount graphics character set on g1
  5024. ;
  5025.  
  5026. vt100w1:lda    #$00        ; mount U.S. ascii character set on g0
  5027.     sta    g0
  5028.     rts
  5029. vt100w2:lda    #$01        ; mount graphics character set on g0
  5030.     sta    g0
  5031.     rts
  5032. vt100w3:lda    #$00        ; mount U.S. ascii character set on g1
  5033.     sta    g1
  5034.     rts
  5035. vt100w4:lda    #$01        ; mount graphics character set on g1
  5036.     sta    g1
  5037.     rts
  5038.  
  5039. ;
  5040. ;    vt100x1 - enter graphics mode
  5041.  
  5042.  
  5043. vt100x1:jsr    scrtek        ; turn on the graphics screen
  5044.     jsr    screra        ; erase the graphics screen
  5045.     lda    #$01
  5046.     sta    tekmode        ; and enter grahics mode
  5047.     lda    #747\
  5048.     sta    tekcylo
  5049.     lda    #747^
  5050.     sta    tekcyhi
  5051.     lda    #$00
  5052.     sta    tekcxlo
  5053.     sta    tekcxhi
  5054.     rts
  5055.  
  5056. ;
  5057. ;    vt100y1 - process the <esc> '[' integer 'P' vt102 commands
  5058. ;
  5059. ;    This routine calls scrdch to delete some characters
  5060. ;
  5061.  
  5062. vt100y1:ldx    #$00        ; get the first integer
  5063.     ldy    #$01        ; default value is 1
  5064.     jsr    vt100pa        ; how many characters to delete
  5065.     jsr    scrdch        ; go delete them
  5066.     rts            ; all done
  5067.  
  5068. ;
  5069. ;    vt100z1 - process the <es> '[' integer 'L' vt102 comand
  5070. ;
  5071. ;    This routine calls scral to add some lines
  5072. ;
  5073.  
  5074. vt100z1:ldx    #$00        ; get the first integer
  5075.     ldy    #$01        ; default value is 1
  5076.     jsr    vt100pa        ; how many lines to insert
  5077.     jsr    scral        ; go insert them
  5078.     rts            ; all done
  5079.  
  5080. ;
  5081. ;    vt100z2 - process the <esc> '[' integer 'M' vt102 comand
  5082. ;
  5083. ;    This routine calls scrdl to delete some lines
  5084. ;
  5085.  
  5086. vt100z2:ldx    #$00        ; get the first integer
  5087.     ldy    #$01        ; default value is 1
  5088.     jsr    vt100pa        ; how many lines to delete
  5089.     jsr    scrdl        ; go insert them
  5090.     rts            ; all done
  5091.  
  5092. ;
  5093. ;    vt100z3 - process the <esc> <comma> sequence
  5094. ;
  5095. ;    This routine delays processing for a 4 sixtieths of a second.  The
  5096. ;    delay is intended to be used in a visual-bell escape sequence, so we
  5097. ;    synchronize ourself with the VIC raster scan.  (Too bad we
  5098. ;    can't synchronize with the 8563 raster scan.)
  5099. ;
  5100.  
  5101. vt100z3:ldx    #4
  5102. vt100z4:bit    $d011
  5103.     bmi    vt100z4
  5104. vt100z5:bit    $d011
  5105.     bpl    vt100z5
  5106.     dex
  5107.     bne    vt100z4
  5108.     rts
  5109.  
  5110. ;
  5111. ;    outad - send a decimal number to modem.
  5112. ;
  5113. ;    Input: A - Number to be printed
  5114. ;
  5115. ;    Registers Destroyed:    A,X,Y
  5116. ;
  5117. ;    Note the similarity between this routine and printad.
  5118. ;
  5119. ;    This routine sends to the modem instead of the screen, and
  5120. ;    this routine only accepts numbers less than 255.
  5121. ;
  5122.  
  5123. outad:    ldx    #2        ; up to 3 digits (0..2)
  5124. outad1:    cmp    tens1,x        ; drop any leading zeros
  5125.     bcs    outad2
  5126.     dex
  5127.     bpl    outad1
  5128. outad2:    ldy    #'0        ; y is the ascii value to print
  5129. outad3:    cmp    tens1,x        ; compare with 10^x
  5130.     bcc    outad4        ; result would be negative.
  5131.     sbc    tens1,x        ; carry is already set
  5132.     iny            ; keep track of the value of this digit
  5133.     bne    outad3        ; always taken
  5134. outad4:    pha            ; save the number we are printing
  5135.     txa            ; save X
  5136.     pha
  5137.     tya            ; print the character in Y
  5138.     jsr    putrs
  5139.     pla            ; restore X
  5140.     tax
  5141.     pla            ; remember the number we are printing
  5142.     dex            ; print the next digit.
  5143.     bpl    outad2
  5144.     rts
  5145.  
  5146. ;
  5147. ;    vt100pa - get a parameter for vt100 emulation
  5148. ;
  5149. ;    Input:    X-reg - which parameter is desired (0..n)
  5150. ;        Y-reg - default value of this parameter
  5151. ;
  5152. ;    Output:    A-reg - value of this parameter
  5153. ;
  5154. ;    This routine returns the value of the requested parameter.  If
  5155. ;    the parameter is zero or undefined, it returns the default value.
  5156. ;
  5157.  
  5158. vt100pa:cpx    vt100pt        ; was the necessary number of params given
  5159.     bcs    vt100pb        ; no, use the default
  5160.     lda    freemem+1,x    ; get this parameter
  5161.     beq    vt100pb        ; if zero, use the default
  5162.     rts
  5163. vt100pb:tya            ; return the default
  5164.     rts
  5165.  
  5166. ;
  5167. ;    vt100ta - parser table for vt100 commands
  5168. ;
  5169. ;    the first byte of each entry is a character to expect.  If the
  5170. ;    character to expect is negative, it means to parse a parameter
  5171. ;    and remain in the current state.  If it is zero, that is the end
  5172. ;    of the entry.  If it is the character received,    the next word is looked
  5173. ;    at.  If it is less than $100, the parser changes into that state.  If
  5174. ;    it is greater or equal to $100, the routine at that address is called.
  5175. ;
  5176.  
  5177. vt100ta:.byte    '[        ; many different sequences begin with <ESC>[
  5178.     .word    vt100a1-vt100ta
  5179.     .byte    '#        ; many different sequences begin with <ESC>#
  5180.     .word    vt100a5-vt100ta
  5181.     .byte    'M        ; <esc> 'M'
  5182.     .word    scrrlf        ;        is reverse index
  5183.     .byte    'E        ; <esc> 'E'
  5184.     .word    vt100o        ;        is next line
  5185.     .byte    'D        ; <esc> 'D'
  5186.     .word    scrlf        ;        is index
  5187.     .byte    '7        ; <esc> '7'
  5188.     .word    scrsav        ;        means save cursor position
  5189.     .byte    '8        ; <esc> '8'
  5190.     .word    scrlod        ;        means load cursor position
  5191.     .byte    'H        ; <esc> 'H'
  5192.     .word    vt100p        ;        means set a tab stop
  5193.     .byte    '=        ; <esc> '>'
  5194.     .word    vt100n        ;    puts keypad in alternate mode    
  5195.     .byte    '>        ; <esc> '='
  5196.     .word    vt100m        ;    puts keypad in numeric mode
  5197.     .byte    'Z        ; <esc> 'Z'
  5198.     .word    vt100s        ;        sends the terminal identity
  5199.     .byte    'c        ; <esc> 'c'
  5200.     .word    vt100t        ;        resets the terminal
  5201.     .byte    '(        ; <esc> '('
  5202.     .word    vt100a6-vt100ta    ;        means mount a character set
  5203.     .byte    ')        ; <esc> ')'
  5204.     .word    vt100a7-vt100ta    ;        means mount a character set
  5205.     .byte    $0c        ; <esc> form-feed 
  5206.     .word    vt100x1        ;        means enter graphics mode
  5207.     .byte    ',        ; <esc> ','
  5208.     .word    vt100z3        ;        means delay for 250 ms
  5209.     .byte    $00
  5210.  
  5211. vt100a1:.byte    $ff
  5212.     .word    0
  5213.     .byte    'J        ; <esc> '[' integer 'J'
  5214.     .word    vt100b1
  5215.     .byte    'K        ; <esc> '[' integer 'K'
  5216.     .word    vt100c1
  5217.     .byte    'A        ; <esc> '[' integer 'A'
  5218.     .word    vt100f1
  5219.     .byte    'B        ; <esc> '[' integer 'B'
  5220.     .word    vt100g1
  5221.     .byte    'C        ; <esc> '[' integer 'C'
  5222.     .word    vt100h1
  5223.     .byte    'D        ; <esc> '[' integer 'D'
  5224.     .word    vt100i1
  5225.     .byte    'm        ; <esc> '[' integer ';']... 'm'
  5226.     .word    vt100j1
  5227.     .byte    ';
  5228.     .word    vt100a2-vt100ta
  5229.     .byte    'f        ; <esc> '[' 'f'
  5230.     .word    vt100d1
  5231.     .byte    'H        ; <esc> '[' 'H'
  5232.     .word    vt100d1
  5233.     .byte    'r        ; <esc> '[' 'r'
  5234.     .word    vt100e1
  5235.     .byte    '?        ; <esc> '[' '?'
  5236.     .word    vt100a3-vt100ta
  5237.     .byte    'g        ; <esc> '[' integer 'g'
  5238.     .word    vt100q        ;        means clear tab stop(s)
  5239.     .byte    'n        ; <esc> '[' integer 'n'
  5240.     .word    vt100r        ;         means create a reply message
  5241.     .byte    'c        ; <esc> '[' integer 'c'
  5242.     .word    vt100s        ;         sends terminal identification
  5243.     .byte    'h        ; <esc> '[' integer 'h'
  5244.     .word    vt100v1        ;        means set new line mode
  5245.     .byte    'l        ; <esc> '[' integer 'l'
  5246.     .word    vt100v2        ;        means clear new line mode
  5247.     .byte    'P        ; <esc> '[' integer 'P'
  5248.     .word    vt100y1        ;        means delete some characters
  5249.     .byte    'L        ; <esc> '[' integer 'L'
  5250.     .word    vt100z1        ;        means insert some lines
  5251.     .byte    'M        ; <esc> '[' integer 'M'
  5252.     .word    vt100z2        ;        means delete some lines
  5253.     .byte    $00
  5254.  
  5255. vt100a2:.byte    $ff
  5256.     .word    0
  5257.     .byte    'H
  5258.     .word    vt100d1        ; <esc> '[' integer ';' integer 'H'
  5259.     .byte    'f
  5260.     .word    vt100d1        ; <esc> '[' integer ';' integer 'f'
  5261.     .byte    'r
  5262.     .word    vt100e1        ; <esc> '[' integer ';' integer 'r'
  5263.     .byte    'm
  5264.     .word    vt100j1        ; <esc> '[' integer ';' integer 'm'
  5265.     .byte    ';
  5266.     .word    vt100a4-vt100ta    ; <esc> '[' integer ';' integer ';' ... 'm'
  5267.     .byte    0
  5268.  
  5269. vt100a3:.byte    $ff
  5270.     .word    0
  5271.     .byte    'h        ; <esc> '[' '?' integer 'h'
  5272.     .word    vt100k        ;         means set switchs
  5273.     .byte    'l        ; <esc> '[' '?' integer 'l'
  5274.     .word    vt100l        ;        means reset switchs
  5275.     .byte    ';
  5276.     .word    vt100a3-vt100ta
  5277.     .byte    0
  5278.  
  5279. vt100a4:.byte    $ff
  5280.     .word    0
  5281.     .byte    ';
  5282.     .word    vt100a4-vt100ta    ; <esc> '[' integer ';' integer ';' integer..
  5283.     .byte    'm
  5284.     .word    vt100j1        ; <esc> '[' [ingeger ';'] ... 'm'
  5285.     .byte    0
  5286.  
  5287. vt100a5:.byte    '8        ; <ESC>#8 fills the screen with 'E's
  5288.     .word    screee
  5289.     .byte    0
  5290.  
  5291. vt100a6:.byte    'A        ; <esc> '(' 'A' means mount U.S. chars on g0
  5292.     .word    vt100w1
  5293.     .byte    'B        ; <esc> '(' 'B' means mount U.S. chars on g0
  5294.     .word    vt100w1
  5295.     .byte    '1        ; <esc> '(' '1' means mount U.S. chars on g0
  5296.     .word    vt100w1
  5297.     .byte    '2        ; <esc> '(' '2' means mount U.S. chars on g0
  5298.     .word    vt100w1
  5299.     .byte    '0        ; <esc> '(' '0' means mount graphic chars on g0
  5300.     .word    vt100w2
  5301.     .byte    $00
  5302.  
  5303. vt100a7:.byte    'A        ; <esc> ')' 'A' means mount U.S. chars on g1
  5304.     .word    vt100w3
  5305.     .byte    'B        ; <esc> ')' 'B' means mount U.S. chars on g1
  5306.     .word    vt100w3
  5307.     .byte    '1        ; <esc> ')' '1' means mount U.S. chars on g1
  5308.     .word    vt100w3
  5309.     .byte    '2        ; <esc> ')' '2' means mount U.S. chars on g1
  5310.     .word    vt100w3
  5311.     .byte    '0        ; <esc> ')' '0' means mount graphic chars on g1
  5312.     .word    vt100w4
  5313.     .byte    $00
  5314.  
  5315.     .byte    *-vt100ta    ; abort assembly if table length > $100
  5316.  
  5317. .SBTTL    Tektronix
  5318.  
  5319. ;
  5320. ;    These routines interpret Tektronix PLOT10 commands and draw lines
  5321. ;
  5322.  
  5323. ;
  5324. ;    tek - process tek4014 commands
  5325. ;
  5326. ;    Input -    character to process in A-reg
  5327. ;
  5328. ;    This routine processes characters when tekmode != 0.  It is called
  5329. ;    by telnet.
  5330. ;
  5331.  
  5332. tek:    ldx    escflg        ; was the last character an escape?
  5333.     beq    tek2
  5334.     ldx    #$00        ; clear the escape flag
  5335.     stx    escflg
  5336.     cmp    #$0c        ; got a <esc> ff?
  5337.     bne    tek1a
  5338.     jsr    screra        ; clear the screen
  5339.     lda    #$00        ; home the cursor
  5340.     sta    tekcxlo
  5341.     sta    tekcxhi
  5342.     lda    #747\
  5343.     sta    tekcylo
  5344.     lda    #747^
  5345.     sta    tekcyhi
  5346.     lda    #$01        ; and prepare to receive text.
  5347.     sta    tekmode
  5348. tekrts:    rts
  5349. tek1a:    cmp    #'?        ; got <esc> '?' ??
  5350.     bne    tek1b
  5351.     lda    #$7f        ; simulate a DEL
  5352.     jmp    tek2
  5353. tek1b:    cmp    #'[        ; got a '[' or an upper case letter = exit tek
  5354.     beq    tek1c
  5355.     cmp    #'A
  5356.     bcc    tekrts        ; otherwise, ignore
  5357.     cmp    #'Z+1
  5358.     bcs    tekrts        ; otherwise, ignore
  5359. tek1c:    pha            ; save character to re-scan in vt100/vt52 mode
  5360.     jsr    scrtxt        ; exit tektronix mode
  5361.     lda    line25        ; clear the entire text screen including line25
  5362.     pha
  5363.     lda    #$01
  5364.     sta    line25
  5365.     jsr    scrclr
  5366.     pla
  5367.     sta    line25
  5368.     ldx    #$00
  5369.     stx    tekmode
  5370.     ldx    #on        ; Set the escape flag on
  5371.     stx    escflg        ;        ...
  5372.     ldx    #$00        ; zero pointers for vt100 emulation
  5373.     stx    vt100st        ; state is zero
  5374.     stx    vt100pt        ; parameter pointer is zero
  5375.     pla            ; restore character to re-scan
  5376.     jmp    telprc1        ; attempt to process the escape sequence
  5377. tek2:    cmp    #$1e        ; start incremental plotting mode?
  5378.     bne    tek3
  5379.     lda    #$06
  5380.     sta    tekmode
  5381.     rts
  5382. tek3:    cmp    #$1f        ; got a record seporator?
  5383.     bne    tek4
  5384.     lda    #$01        ; if so, prepare to receive text.
  5385.     sta    tekmode
  5386.     rts
  5387. tek4:    cmp    #$1d        ; got a group separator?
  5388.     bne    tek5
  5389.     lda    #$02        ; if so, prepare to receive graphics statements
  5390.     sta    tekmode
  5391.     lda    #$00        ; and lift the pen up
  5392.     sta    tekpen
  5393.     rts
  5394. tek5:    cmp    #$18        ; got a can?
  5395.     bne    tek7
  5396.     jsr    scrtxt        ; exit tek mode
  5397.     lda    line25        ; clear the entire text screen including line25
  5398.     pha
  5399.     lda    #$01
  5400.     sta    line25
  5401.     jsr    scrclr
  5402.     pla
  5403.     sta    line25
  5404.     lda    #$00
  5405.     sta    tekmode
  5406.     rts
  5407. tek7:    cmp    #$0d        ; got a carriage return?
  5408.     bne    tek8
  5409.     lda    #$01        ; prepare to receive text
  5410.     sta    tekmode
  5411.     lda    #$00        ; move cursor to far left
  5412.     sta    tekcxlo
  5413.     sta    tekcxhi
  5414.     rts
  5415. tek8:    cmp    #$0a        ; got a line feed?
  5416.     bne    tek9
  5417.     lda    #$01        ; prepare to receive text
  5418.     sta    tekmode
  5419.     sec            ; move cursor down 
  5420.     lda    tekcylo
  5421.     sbc    #32
  5422.     sta    tekcylo
  5423.     lda    tekcyhi
  5424.     sbc    #0
  5425.     sta    tekcyhi
  5426.     bpl    tek8a        ; wrap up to the top
  5427.     lda    #747\
  5428.     sta    tekcylo
  5429.     lda    #747^
  5430.     sta    tekcyhi
  5431. tek8a:    rts
  5432. tek9:    cmp    #$1b        ; got an escape?
  5433.     bne    tek6
  5434.     lda    #$01        ; if so, set the escape flag
  5435.     sta    escflg
  5436.     rts
  5437. tek6:    ldy    tekmode        ; what type of command is expected?
  5438.     jsr    case        ; go process the command.
  5439.     .word    anybrk        ; can't happen.  only called when tekmode != 0
  5440.     .word    tekm1
  5441.     .word    tekm2
  5442.     .word    tekm3
  5443.     .word    tekm4
  5444.     .word    tekm5
  5445.     .word    tekm6
  5446. tekm1:    cmp    #$7f        ; cant print a del
  5447.     beq    tekm1a
  5448.     sec            ; convert to funny ascii
  5449.     sbc    #$20
  5450.     bcc    tekm1a        ; if non-ascii character, ignore
  5451.     pha
  5452.     jsr    scrint        ; convert coordinate to internal format
  5453.     pla
  5454.     jsr    scrdrw        ; draw the letter (returns size of letter)
  5455.     clc
  5456.     adc    tekcxlo
  5457.     sta    tekcxlo
  5458.     bcc    tekm1a
  5459.     inc    tekcxhi
  5460. tekm1a:    rts
  5461. tekm2:    and    #$60        ; what type of command did we get?
  5462.     cmp    #$20        ; is this the command we expected
  5463.     bne    tekm3
  5464.     lda    char        ; get the character
  5465.     and    #$1f        ; extract the low 5 bits
  5466.     sta    tekryhi
  5467.     lda    #$02        ; save this state
  5468.     sta    tekmode
  5469.     rts
  5470. tekm3:    and    #$60        ; what type of command did we get?
  5471.     cmp    #$60        ; is this the command we expected
  5472.     bne    tekm4
  5473.     lda    char        ; get the character
  5474.     and    #$1f        ; extract the low 5 bits
  5475.     sta    tekrylo        ; and set the low y coordinate
  5476.     lda    #$03        ; save this state
  5477.     sta    tekmode
  5478.     rts
  5479. tekm4:    and    #$60        ; what type of command did we get?
  5480.     cmp    #$20        ; is this the command we expected
  5481.     bne    tekm5
  5482.     lda    char        ; get the character
  5483.     and    #$1f        ; extract the low 5 bits.
  5484.     sta    tekrxhi        ; and set the high y coordinate
  5485.     lda    #$04        ; save this state
  5486.     sta    tekmode
  5487.     rts
  5488. tekm5:    and    #$60        ; what type of command did we get?
  5489.     cmp    #$40        ; is this the command we expected
  5490.     bne    tekm5b        ; no.  this is not a legial escape sequence
  5491.     lda    char        ; get the character
  5492.     and    #$1f        ; extract the low 5 bits
  5493.     sta    tekrxlo        ; and set the low x coordinate
  5494.     jsr    teksave        ; save up the current point as the destination
  5495.     lda    tekrxlo        ; now compute tekcxlo and tekcxhi
  5496.     sta    tekcxlo
  5497.     lda    tekrxhi
  5498.     asl    a
  5499.     asl    a
  5500.     asl    a
  5501.     asl    a
  5502.     asl    a
  5503.     ora    tekcxlo
  5504.     sta    tekcxlo
  5505.     lda    tekrxhi
  5506.     lsr    a
  5507.     lsr    a
  5508.     lsr    a
  5509.     sta    tekcxhi
  5510.     lda    tekrylo        ; now compute tekcylo and tekcyhi
  5511.     sta    tekcylo
  5512.     lda    tekryhi
  5513.     asl    a
  5514.     asl    a
  5515.     asl    a
  5516.     asl    a
  5517.     asl    a
  5518.     ora    tekcylo
  5519.     sta    tekcylo
  5520.     lda    tekryhi
  5521.     lsr    a
  5522.     lsr    a
  5523.     lsr    a
  5524.     sta    tekcyhi
  5525.     jsr    scrint        ; convert coordinates to internal format
  5526.     lda    tekpen        ; is the pen down
  5527.     beq    tekm5c        ; no, dont draw any line.
  5528.     jsr    scrlin        ; draw the line
  5529.     lda    #$02        ; prepare to draw another line
  5530.     sta    tekmode
  5531.     rts
  5532. tekm5c:    lda    #$01        ; put the pen down
  5533.     sta    tekpen
  5534.     lda    #$02        ; prepare to draw another line
  5535.     sta    tekmode
  5536. tekm5b:    rts
  5537. tekm6:    cmp    #$20        ; pick pen up?
  5538.     bne    tekm6e
  5539.     lda    #$00
  5540.     sta    tekpen
  5541.     rts
  5542. tekm6e:    cmp    #$50        ; put pen down?
  5543.     bne    tekm6f
  5544.     lda    #$01
  5545.     sta    tekpen
  5546.     rts
  5547. tekm6f:    pha            ; remember character to process
  5548.     jsr    teksave        ; save the starting coordinate of the line
  5549.     pla            ; restore coordinate
  5550.     lsr    a        ; incremental plotting mode
  5551.     bcc    tekm6a
  5552.     inc    tekcxlo        ; go to the east
  5553.     bne    tekm6a
  5554.     inc    tekcxhi
  5555. tekm6a:    lsr    a
  5556.     bcc    tekm6b
  5557.     ldx    tekcxlo        ; go to the west
  5558.     bne    tekm6a1
  5559.     dec    tekcxhi
  5560. tekm6a1:dec    tekcxlo
  5561. tekm6b:    lsr    a
  5562.     bcc    tekm6c
  5563.     inc    tekcylo        ; go to the north
  5564.     bne    tekm6c
  5565.     inc    tekcyhi
  5566. tekm6c:    lsr    a
  5567.     bcc    tekm6d
  5568.     ldx    tekcylo        ; go to the south
  5569.     bne    tekm6c1
  5570.     dec    tekcyhi
  5571. tekm6c1:dec    tekcylo
  5572. tekm6d:    lda    tekpen        ; see if pen down
  5573.     beq    tekm6d1
  5574.     jsr    scrint
  5575.     jsr    scrlin        ; draw the line
  5576. tekm6d1:rts
  5577.  
  5578. ;
  5579. ;    teksave - convert the current position to internal form and save it
  5580. ;
  5581. ;    This routine sets up the 'from' point for line drawing
  5582. ;
  5583.  
  5584. teksave:jsr    scrint
  5585.     lda    tektxlo
  5586.     sta    tekfxlo
  5587.     lda    tektxhi
  5588.     sta    tekfxhi
  5589.     lda    tektylo
  5590.     sta    tekfylo
  5591.     lda    tektyhi
  5592.     sta    tekfyhi
  5593.     rts
  5594.  
  5595. .SBTTL    Exit routine
  5596.  
  5597. ;
  5598. ;    This routine exits properly from Kermit-65 and reenters
  5599. ;    BASIC.
  5600. ;
  5601. ;        Input:  NONE
  5602. ;
  5603. ;        Output: NONE
  5604. ;
  5605. ;        Registers destroyed:    A,X
  5606. ;
  5607.  
  5608. exit:    lda    #cmcfm        ; Try to get a confirm
  5609.     jsr    comnd        ; Do it
  5610.      jmp    kermt3        ; Give '?not confirmed' message
  5611. exit1:    jsr    restor        ;[36] Restore everything to its' default state
  5612.     lda    r6510        ;[17] Prepare to terminate
  5613.     ora    #1        ;[17]  by paging BASIC ROM in
  5614.     sta    r6510        ;[17]         ...
  5615.     lda orignmiv
  5616.     sta nmiv
  5617.     lda orignmiv+1
  5618.     sta nmiv+1
  5619. exit2:  jmp    (dos)        ; Now restart BASIC
  5620.  
  5621. restor:    jsr    clall        ;[19][36] Close all channels
  5622.     jsr    scrext        ; restore screen hardward to its initial state
  5623.     lda    #00
  5624.     sta    ndx        ; empty the key queue.
  5625.     rts            ;[36] Return
  5626.  
  5627. .SBTTL    Help routine
  5628.  
  5629. ;
  5630. ;    This routine prints help from the current help text
  5631. ;    area.
  5632. ;
  5633. ;        Input:  Cmhptr  - Pointer to the desired text to be printed
  5634. ;
  5635. ;        Output: ASCIZ string at Cmhptr is printed on screen
  5636. ;
  5637. ;        Registers destroyed:    A,X,Y
  5638. ;
  5639.  
  5640. help:    lda    #cmcfm        ; Try to get a confirm
  5641.     jsr    comnd        ; Go get it
  5642.      jmp    kermt3        ; Didn't find one? Give 'not confirmed' message
  5643. help2:  ldx    cmhptr        ; L.O. byte of current help text address
  5644.     ldy    cmhptr+1    ; H.O. byte of address
  5645.     jsr    prstr        ; Print it
  5646.     jmp    kermit        ; Return to main routine
  5647.  
  5648. .SBTTL    Log routine
  5649.  
  5650. ;
  5651. ;    This routine logs a session to a disk file.
  5652. ;
  5653. ;        Input:  NONE
  5654. ;
  5655. ;        Output: NONE
  5656. ;
  5657. ;        Registers destroyed:    NONE
  5658. ;
  5659.  
  5660. log:    jmp    kermit
  5661.  
  5662. .SBTTL    Bye routine
  5663.  
  5664. ;
  5665. ;    This routine terminates the remote server, logs out and terminates
  5666. ;    the local Kermit.
  5667. ;
  5668.  
  5669. bye:    jsr    prcfm        ; Go parse and print the confirm
  5670.     jsr    logo        ; Tell other Kermit to log out
  5671.      jmp    kermit        ; Don't exit if there was an error
  5672.     jmp    exit1        ; Leave
  5673.  
  5674. ;
  5675. ;    Logo - This routine does the actual work to send the logout
  5676. ;    packet to the remote server
  5677. ;
  5678.  
  5679. logo:    
  5680.     lda    #$00        ; Zero the number of tries
  5681.     sta    numtry        ;        ...
  5682.     sta    tpak        ;    and the total packet number
  5683.     sta    tpak+1        ;        ...
  5684.     lda    #pdbuf\        ;[29] Get the address of the packet buffer
  5685.     sta    kerbf1        ;[29]   and save it for Spak
  5686.     lda    #pdbuf^        ;[29]        ...
  5687.     sta    kerbf1+1    ;[29]        ...
  5688. logo1:    lda    numtry        ; Fetch the number of tries
  5689.     cmp    maxtry        ; Have we exceeded Maxtry?
  5690.     bmi    logo3        ; Not yet, go send the packet
  5691. logo2:    ldx    #ermesc\    ; Yes, give an error message
  5692.     ldy    #ermesc^    ;        ...
  5693.     jsr    prstr        ;        ...
  5694.     jsr    prcrlf        ;        ...
  5695.     rts            ;    and return
  5696. logo3:    inc    numtry        ; Increment the number of tries for packet
  5697.     lda    #$00        ; Make it packet number 0
  5698.     sta    pnum        ;        ...
  5699.     lda    #$01        ; Data length is only 1
  5700.     sta    pdlen        ;        ...
  5701.     lda    #'L        ; The 'Logout' command
  5702.     sta    pdbuf        ; Put that in first character of buffer
  5703.     lda    #'G        ; Generic command packet type
  5704.     sta    ptype        ;        ...
  5705.     jsr    flshin        ;[25] Flush the RS232 buffer
  5706.     jsr    spak        ; Send the packet
  5707.     jsr    rpak        ; Try to fetch an ACK
  5708.     cmp    #true        ; Did we receive successfully?
  5709.     bne    logo1        ; No, try to send the packet again
  5710.     lda    ptype        ; Get the type
  5711.     cmp    #'Y        ; An ACK?
  5712.     bne    logoce        ; No, go check for error
  5713.     jmp    rskp        ; Yes, skip return
  5714. logoce:    cmp    #'E        ; Error packet?
  5715.     bne    logo1        ; Nope, resend packet
  5716.     jsr    prcerp        ; Go display the error
  5717.     rts            ;    and return
  5718.  
  5719. .SBTTL    Finish routine
  5720.  
  5721. ;
  5722. ;    This routine terminates the remote server but does not log
  5723. ;    it out. It also keeps the local Kermit running.
  5724. ;
  5725.  
  5726. finish:    jsr    prcfm        ; Go parse and print the confirm
  5727.     lda    #$00        ; Zero the number of tries
  5728.     sta    numtry        ;        ...
  5729.     sta    tpak        ;    and the total packet number
  5730.     sta    tpak+1        ;        ...
  5731.     lda    #pdbuf\        ;[29] Get the address of the packet buffer
  5732.     sta    kerbf1        ;[29]   and save it for Spak
  5733.     lda    #pdbuf^        ;[29]        ...
  5734.     sta    kerbf1+1    ;[29]        ...
  5735. finsh1:    lda    numtry        ; Fetch the number of tries
  5736.     cmp    maxtry        ; Have we exceeded Maxtry?
  5737.     bmi    finsh3        ; Not yet, go send the packet
  5738. finsh2:    ldx    #ermesd\    ; Yes, give an error message
  5739.     ldy    #ermesd^    ;        ...
  5740.     jsr    prstr        ;        ...
  5741.     jsr    prcrlf        ;        ...
  5742.     jmp    kermit        ;    and go back for more commands
  5743. finsh3:    inc    numtry        ; Increment the number of tries for packet
  5744.     lda    #$00        ; Make it packet number 0
  5745.     sta    pnum        ;        ...
  5746.     lda    #$01        ; Data length is only 1
  5747.     sta    pdlen        ;        ...
  5748.     lda    #'F        ; The 'Finish' command
  5749.     sta    pdbuf        ; Put that in first character of buffer
  5750.     lda    #'G        ; Generic command packet type
  5751.     sta    ptype        ;        ...
  5752.     jsr    flshin        ;[25] Flush the RS232 buffer
  5753.     jsr    spak        ; Send the packet
  5754.     jsr    rpak        ; Try to fetch an ACK
  5755.     cmp    #true        ; Did we receive successfully?
  5756.     bne    finsh1        ; No, try to send the packet again
  5757.     lda    ptype        ; Get the type
  5758.     cmp    #'Y        ; An ACK?
  5759.     bne    fince        ; No, go check for error
  5760.     jmp    kermit        ; Yes, go back for more commands
  5761. fince:    cmp    #'E        ; Error packet?
  5762.     bne    finsh1        ; Nope, resend packet
  5763.     jsr    prcerp        ;; Go display the error
  5764.     jmp    kermit        ; Go back for more 
  5765.  
  5766. .SBTTL    Get routine
  5767.  
  5768. ;
  5769. ;    This routine accepts an unquoted string terminated by 
  5770. ;    <cr>,<lf>,<ff>, or <esc> and tries to fetch the file
  5771. ;    represented by that string from a remote server Kermit.
  5772. ;
  5773.  
  5774. getfrs:    
  5775.     lda    #yes        ; Make KERMIT use file headers
  5776.     sta    usehdr        ;    for file names
  5777.     lda    #mxfnl+1    ; The buffer size is one more than max
  5778.     sta    kwrk01        ;    file name length
  5779.     lda    #fcb1\        ; Point to the buffer
  5780.     sta    kerto        ;        ...
  5781.     lda    #fcb1^        ;        ...
  5782.     sta    kerto+1        ;        ...
  5783.     jsr    kerflm        ; Clear the buffer
  5784.     lda    #$80        ; Reset all break characters
  5785.     jsr    rstbrk        ;        ...
  5786.     lda    #cr        ;        ...
  5787.     jsr    setbrk        ;        ...
  5788.     lda    #lf        ;        ...
  5789.     jsr    setbrk        ;        ...
  5790.     lda    #ffd        ;        ...
  5791.     jsr    setbrk        ;        ...
  5792.     lda    #esc        ;        ...
  5793.     jsr    setbrk        ;        ...
  5794.     ldy    #$00        ;        ...
  5795.     lda    #cmtxt        ; Parse for text
  5796.     jsr    comnd        ; Do it
  5797.      jmp    kermta        ; Found null string
  5798.     cmp    spsiz        ; Larger than the set packet size?
  5799.     bmi    getf1        ; No, continue
  5800.     lda    spsiz        ; Yes, it will have to be truncated
  5801. getf1:    sta    kwrk01        ; Store packet size for Kercpy
  5802.     sta    pdlen        ;    and Spak
  5803.     lda    #pdbuf\        ; Point to the data buffer as destination
  5804.     sta    kerto        ;        ...
  5805.     sta    kerbf1        ; Store L.O.B. here for Spak routine
  5806.     lda    #pdbuf^        ;        ...
  5807.     sta    kerto+1        ;        ...
  5808.     sta    kerbf1+1    ; Store H.O.B. here for Spak routine
  5809.     stx    kerfrm        ; Point to the atom buffer from Comnd
  5810.     sty    kerfrm+1    ;    as the source address
  5811.     txa            ; Save the 'from buffer' pointers for later
  5812.     pha            ;        ...
  5813.     tya            ;        ...
  5814.     pha            ;        ...
  5815.     jsr    kercpy        ; Copy the string
  5816.     pla            ; Restore these for the next move
  5817.     sta    kerfrm+1    ;        ...
  5818.     pla            ;        ...
  5819.     sta    kerfrm        ;        ...
  5820.     lda    #fcb1\        ; Set up the address of the target
  5821.     sta    kerto        ;        ...
  5822.     lda    #fcb1^        ;        ...
  5823.     sta    kerto+1        ;        ...
  5824.     jsr    clrfcb        ; Clear the fcb first
  5825.     jsr    kercpy        ; Go move the string
  5826.     jsr    prcfm        ; Go parse and print the confirm
  5827.     lda    #'R        ; Packet type is 'Receive-init'
  5828.     sta    ptype        ;        ...
  5829.     lda    #$00        ; Packet number should be zero
  5830.     sta    pnum        ;        ...
  5831.     jsr    spak        ; Packet length was set above, 
  5832.     jsr    rswt        ;    so just call spak and try to receive
  5833.     jmp    kermit        ; Go back for more commands
  5834.  
  5835.  
  5836. .SBTTL    Receve routine
  5837.  
  5838. ;
  5839. ;    This routine receives a file from the remote kermit and
  5840. ;    writes it to a disk file.
  5841. ;
  5842. ;        Input:  Filename returned from comnd, if any
  5843. ;
  5844. ;        Output: If file transfer is good, file is output to disk
  5845. ;
  5846. ;        Registers destroyed:    A,X,Y
  5847. ;
  5848.  
  5849. receve:    
  5850.     lda    #on        ; Set use file-header switch on in case we
  5851.     sta    usehdr        ;    don't parse a filename
  5852.     lda    #kerehr\    ; Point to extra help commands
  5853.     sta    cmehpt        ;        ...
  5854.     lda    #kerehr^    ;        ...
  5855.     sta    cmehpt+1    ;        ...
  5856.     ldx    #mxfnl        ; Longest length a filename may be
  5857.     ldy    #cmfehf        ; Tell Comnd about extra help
  5858.     lda    #cmifi        ; Load opcode for parsing input files
  5859.     jsr    comnd        ; Call comnd routine
  5860.      jmp    recev1        ; Continue, don't turn file-header switch off
  5861.     sta    kwrk01        ; Store length of file parsed
  5862.     stx    kerfrm        ; Save the from address (addr[atmbuf])
  5863.     sty    kerfrm+1    ;        ...
  5864.     lda    #fcb1\        ; Save the to address (Fcb1)
  5865.     sta    kerto        ;        ...
  5866.     lda    #fcb1^        ;        ...
  5867.     sta    kerto+1        ;        ...
  5868.     jsr    clrfcb        ; Clear the fcb
  5869.     jsr    kercpy        ; Copy the string
  5870.     lda    #off        ; We parsed a filename so we don't need the
  5871.     sta    usehdr        ;    info from the file-header
  5872. recev1: ;lda    #cmcfm        ; Get token for confirm
  5873.     ;jsr    comnd        ;    and try to parse that
  5874.     ; jmp    kermt3        ; Failed - give the error
  5875.     jsr    prcfm        ;[] Parse and print a confirm
  5876.     jsr    rswt        ; Perform send-switch routine
  5877.     jmp    kermit        ; Go back to main routine
  5878. rswt:    lda    #'R        ; The state is receive-init
  5879.     sta    state        ; Set that up
  5880.     lda    #$00        ; Zero the packet sequence number
  5881.     sta    n        ;        ...
  5882.     sta    numtry        ;    Number of tries
  5883.     sta    oldtry        ;    Old number of tries
  5884.     sta    eofinp        ;    End of input flag
  5885.     sta    errcod        ;    Error indicator
  5886.     sta    rtot        ;    Total received characters
  5887.     sta    rtot+1        ;        ...
  5888.     sta    stot        ;    Total Sent characters
  5889.     sta    stot+1        ;        ...
  5890.     sta    rchr        ;    Received characters, current file
  5891.     sta    rchr+1        ;        ...
  5892.     sta    schr        ;    and Sent characters, current file
  5893.     sta    schr+1        ;        ...
  5894.     sta    tpak        ;    and the total packet number
  5895.     sta    tpak+1        ;        ...
  5896. rswt1:  lda    state        ; Fetch the current system state
  5897.     cmp    #'D        ; Are we trying to receive data?
  5898.     bne    rswt2        ; If not, try the next one
  5899.     jsr    rdat        ; Go try for the data packet
  5900.     jmp    rswt1        ; Go back to the top of the loop
  5901. rswt2:  cmp    #'F        ; Do we need a file header packet?
  5902.     bne    rswt3        ; If not, continue checking
  5903.     jsr    rfil        ; Go get the file-header
  5904.     jmp    rswt1        ; Return to top of loop
  5905. rswt3:  cmp    #'R        ; Do we need the init?
  5906.     bne    rswt4        ; No, try next state
  5907.     jsr    rini        ; Yes, go get it
  5908.     jmp    rswt1        ; Go back to top
  5909. rswt4:  cmp    #'C        ; Have we completed the transfer?
  5910.     bne    rswt5        ; No, we are out of states, fail
  5911.     lda    #true        ; Load AC for true return
  5912.     rts            ; Return
  5913. rswt5:  lda    #false        ; Set up AC for false return
  5914.     rts            ; Return
  5915.  
  5916. rini:    lda    #pdbuf\        ; Point kerbf1 at the packet data buffer
  5917.     sta    kerbf1        ;        ...
  5918.     lda    #pdbuf^        ;        ...
  5919.     sta    kerbf1+1    ;        ...
  5920.     lda    numtry        ; Get current number of tries
  5921.     inc    numtry        ; Increment it for next time
  5922.     cmp    maxtry        ; Have we tried this one enougth times
  5923.     beq    rini1        ; Not yet, go on
  5924.     bcs    rini1a        ; Yup, go abort this transfer
  5925. rini1:  jmp    rini2        ; Continue
  5926. rini1a: lda    #'A        ; Change state to 'abort'
  5927.     sta    state        ;        ...
  5928.     lda    #errcri        ; Fetch the error index
  5929.     sta    errcod        ;    and store it as the error code
  5930.     lda    #false        ; Load AC with false status
  5931.     rts            ;    and return
  5932. rini2:  jsr    rpak        ; Go try to receive a packet
  5933.     sta    rstat        ; Store the return status for later
  5934.     lda    ptype        ; Fetch the packet type we got
  5935.     cmp    #'S        ; Was it an 'Init'?
  5936.     bne    rini2a        ; No, check the return status
  5937.     jmp    rinici        ; Go handle the init case
  5938. rini2a: lda    rstat        ; Fetch the saved return status
  5939.     cmp    #false        ; Is it false?
  5940.     beq    rini2b        ; Yes, just return with same state
  5941.     lda    #errcri        ; No, fetch the error index
  5942.     sta    errcod        ;    and store it as the error code
  5943.     jsr    prcerp        ; Check for error packet and process it
  5944.     lda    #'A        ; Abort this transfer
  5945.     sta    state        ; State is now 'abort'
  5946.     lda    #false        ; Set return status to 'false'
  5947.     rts            ; Return
  5948. rini2b: lda    n        ; Get packet sequence number expected
  5949.     sta    pnum        ; Stuff that parameter at the Nakit routine
  5950.     jsr    nakit        ; Go send the Nak
  5951.     lda    #false        ; Set up failure return status
  5952.     rts            ;    and go back
  5953.  
  5954. rinici: lda    pnum        ; Get the packet number we received
  5955.     sta    n        ; Synchronize our packet numbers with this
  5956.     jsr    rpar        ; Load in the init stuff from packet buffer
  5957.     jsr    spar        ; Stuff our init info into the packet buffer
  5958.     lda    #'Y        ; Store the 'Ack' code into the packet type
  5959.     sta    ptype        ;        ...
  5960.     lda    n        ; Get sequence number
  5961.     sta    pnum        ; Stuff that parameter
  5962.     lda    sebq        ; See what we got for an 8-bit quoting
  5963.     cmp    #$21        ; First check the character range
  5964.     bmi    rinicn        ; Not in range
  5965.     cmp    #$3f        ;        ...
  5966.     bmi    rinicy        ; Inrange
  5967.     cmp    #$60        ;        ...
  5968.     bmi    rinicn        ; Not in range
  5969.     cmp    #$7f        ;        ...
  5970.     bmi    rinicy        ; Inrange
  5971. rinicn: lda    #off        ; No, punt 8-bit quoting
  5972.     sta    ebqmod        ;        ...
  5973.     lda    #$06        ; BTW, the data length is now only 6
  5974.     jmp    rinic1        ; Continue
  5975. rinicy: lda    #on        ; Make sure everything is on
  5976.     sta    ebqmod        ;        ...
  5977.     lda    #$07        ; Data length for ack-init is 7
  5978. rinic1: sta    pdlen        ; Store packet data length
  5979.     jsr    spak        ; Send that packet
  5980.     lda    numtry        ; Move the number of tries for this packet
  5981.     sta    oldtry        ;    to prev packet try count
  5982.     lda    #$00        ; Zero
  5983.     sta    numtry        ;    the number of tries for current packet
  5984.     jsr    incn        ; Increment the packet number once
  5985.     lda    #'F        ; Advance to 'File-header' state
  5986.     sta    state        ;        ...
  5987.     lda    #true        ; Set up return code
  5988.     rts            ; Return
  5989.  
  5990. rfil:    lda    numtry        ; Get number of tries for this packet
  5991.     inc    numtry        ; Increment it for next time around
  5992.     cmp    maxtry        ; Have we tried too many times?
  5993.     beq    rfil1        ; Not yet
  5994.     bcs    rfil1a        ; Yes, go abort the transfer
  5995. rfil1:  jmp    rfil2        ; Continue transfer
  5996. rfil1a: lda    #'A        ; Set state of system to 'abort'
  5997.     sta    state        ;        ...
  5998.     lda    #false        ; Return code should be 'false'
  5999.     rts            ; Return
  6000. rfil2:  jsr    rpak        ; Try to receive a packet
  6001.     sta    rstat        ; Save the return status
  6002.     lda    ptype        ; Get the packet type we found
  6003.     cmp    #'S        ; Was it an 'init' packet?
  6004.     bne    rfil2a        ; Nope, try next one
  6005.     jmp    rfilci        ; Handle the init case
  6006. rfil2a: cmp    #'Z        ; Is it an 'eof' packet??
  6007.     bne    rfil2b        ; No, try again
  6008.     jmp    rfilce        ; Yes, handle that case
  6009. rfil2b: cmp    #'F        ; Is it a 'file-header' packet???
  6010.     bne    rfil2c        ; Nope
  6011.     jmp    rfilcf        ; Handle file-header case
  6012. rfil2c: cmp    #'B        ; Break packet????
  6013.     bne    rfil2d        ; Wrong, go get the return status
  6014.     jmp    rfilcb        ; Handle a break packet
  6015. rfil2d: lda    rstat        ; Fetch the return status from Rpak
  6016.     cmp    #false        ; Was it a false return?
  6017.     beq    rfil2e        ; Yes, Nak it and return
  6018.     lda    #errcrf        ; No, fetch the error index
  6019.     sta    errcod        ;    and store it as the error code
  6020.     jsr    prcerp        ; Check for error packet and process it
  6021.     lda    #'A        ; Abort this transfer
  6022.     sta    state        ;        ...
  6023.     lda    #false        ; Set up failure return code
  6024.     rts            ;    and return
  6025. rfil2e: lda    n        ; Move the expected packet number
  6026.     sta    pnum        ;    into the spot for the parameter
  6027.     jsr    nakit        ; Nak the packet
  6028.     lda    #false        ; Do a false return but don't change state
  6029.     rts            ; Return
  6030. rfilci: lda    oldtry        ; Get number of tries for prev packet
  6031.     inc    oldtry        ; Increment it
  6032.     cmp    maxtry        ; Have we tried this one too much?
  6033.     beq    rfili1        ; Not quite yet
  6034.     bcs    rfili2        ; Yes, go abort this transfer
  6035. rfili1: jmp    rfili3        ; Continue
  6036. rfili2:
  6037. rfili5: lda    #'A        ; Move abort code
  6038.     sta    state        ;    to system state
  6039.     lda    #errcrf        ; Fetch the error index
  6040.     sta    errcod        ;    and store it as the error code
  6041.     lda    #false        ; Prepare failure return
  6042.     rts            ;    and go back
  6043. rfili3: lda    pnum        ; See if pnum=n-1
  6044.     clc            ;        ...
  6045.     adc    #$01        ;        ...
  6046.     cmp    n        ;        ...
  6047.     beq    rfili4        ; If it does, than we are ok
  6048.     jmp    rfili5        ; Otherwise, abort
  6049. rfili4: jsr    spar        ; Set up the init parms in the packet buffer
  6050.     lda    #'Y        ; Set up the code for Ack
  6051.     sta    ptype        ; Stuff that parm
  6052.     lda    #$06        ; Packet length for init
  6053.     sta    pdlen        ; Stuff that also
  6054.     jsr    spak        ; Send the ack
  6055.     lda    #$00        ; Clear out
  6056.     sta    numtry        ;    the number of tries for current packet
  6057.     lda    #true        ; This is ok, return true with current state
  6058.     rts            ; Return
  6059. rfilce: lda    oldtry        ; Get number of tries for previous packet
  6060.     inc    oldtry        ; Up it for next time we have to do this
  6061.     cmp    maxtry        ; Too many times for this packet?
  6062.     beq    rfile1        ; Not yet, continue
  6063.     bcs    rfile2        ; Yes, go abort it
  6064. rfile1: jmp    rfile3        ;        ...
  6065. rfile2:
  6066. rfile5:    lda    #'A        ; Load abort code
  6067.     sta    state        ;    into current system state
  6068.     lda    #errcrf        ; Fetch the error index
  6069.     sta    errcod        ;    and store it as the error code
  6070.     lda    #false        ; Prepare failure return
  6071.     rts            ;    and return
  6072. rfile3:    lda    pnum        ; First, see if pnum=n-1
  6073.     clc            ;        ...
  6074.     adc    #$01        ;        ...
  6075.     cmp    n        ;        ...
  6076.     beq    rfile4        ; If so, continue
  6077.     jmp    rfile5        ; Else, abort it
  6078. rfile4: lda    #'Y        ; Load 'ack' code
  6079.     sta    ptype        ; Stuff that in the packet type
  6080.     lda    #$00        ; This packet will have a packet data length
  6081.     sta    pdlen        ;    of zero
  6082.     jsr    spak        ; Send the packet out
  6083.     lda    #$00        ; Zero number of tries for current packet
  6084.     sta    numtry        ;        ...
  6085.     lda    #true        ; Set up successful return code
  6086.     rts            ;    and return
  6087. rfilcf: lda    pnum        ; Does pnum=n?
  6088.     cmp    n        ;        ...
  6089.     bne    rfilf1        ; If not, abort
  6090.     jmp    rfilf2        ; Else, we can continue
  6091. rfilf1:    lda    #'A        ; Load the abort code
  6092.     sta    state        ;    and stuff it as current system state
  6093.     lda    #errcrf        ; Fetch the error index
  6094.     sta    errcod        ;    and store it as the error code
  6095.     lda    #false        ; Prepare failure return
  6096.     rts            ;    and go back
  6097. rfilf2: jsr    getfil        ; Get the filename we are to use
  6098.     lda    #fncwrt        ; Tell the open routine we want to write
  6099.     jsr    openf        ; Open up the file
  6100.     lda    #'Y        ; Stuff code for 'ack'
  6101.     sta    ptype        ; Into packet type parm
  6102.     lda    #$00        ; Stuff a zero in as the packet data length
  6103.     sta    pdlen        ;        ...
  6104.     jsr    spak        ; Ack the packet
  6105.     lda    numtry        ; Move current tries to previous tries
  6106.     sta    oldtry        ;        ...
  6107.     lda    #$00        ; Clear the
  6108.     sta    numtry        ; Number of tries for current packet
  6109.     jsr    incn        ; Increment the packet sequence number once
  6110.     lda    #'D        ; Advance the system state to 'receive-data'
  6111.     sta    state        ;        ...
  6112.     lda    #true        ; Set up success return
  6113.     rts            ;    and go back
  6114. rfilcb: lda    pnum        ; Does pnum=n?
  6115.     cmp    n        ;        ...
  6116.     bne    rfilb1        ; If not, abort the transfer process
  6117.     jmp    rfilb2        ; Otherwise, we can continue
  6118. rfilb1:    lda    #'A        ; Code for abort
  6119.     sta    state        ; Stuff that into system state
  6120.     lda    #errcrf        ; Fetch the error index
  6121.     sta    errcod        ;    and store it as the error code
  6122.     lda    #false        ; Load failure return status
  6123.     rts            ;    and return
  6124. rfilb2: lda    #'Y        ; Set up 'ack' packet type
  6125.     sta    ptype        ;        ...
  6126.     lda    #$00        ; Zero out
  6127.     sta    pdlen        ;    the packet data length
  6128.     jsr    spak        ; Send out this packet
  6129.     lda    #'C        ; Advance state to 'complete'
  6130.     sta    state        ;    since we are now done with the transfer
  6131.     lda    #true        ; Return a true
  6132.     rts            ;        ...
  6133.  
  6134. rdat:    lda    numtry        ; Get number of tries for current packet
  6135.     inc    numtry        ; Increment it for next time around
  6136.     cmp    maxtry        ; Have we gone beyond number of tries allowed?
  6137.     beq    rdat1        ; Not yet, so continue
  6138.     bcs    rdat1a        ; Yes, we have, so abort
  6139. rdat1:  jmp    rdat2        ;        ...
  6140. rdat1a: lda    #'A        ; Code for 'abort' state
  6141.     sta    state        ; Stuff that in system state
  6142.     lda    #errcrd        ; Fetch the error index
  6143.     sta    errcod        ;    and store it as the error code
  6144.     lda    #false        ; Set up failure return code
  6145.     rts            ;    and go back
  6146. rdat2:  jsr    rpak        ; Go try to receive a packet
  6147.     sta    rstat        ; Save the return status for later
  6148.     lda    ptype        ; Get the type of packet we just picked up
  6149.     cmp    #'D        ; Was it a data packet?
  6150.     bne    rdat2a        ; If not, try next type
  6151.     jmp    rdatcd        ; Handle a data packet
  6152. rdat2a: cmp    #'F        ; Is it a file-header packet?
  6153.     bne    rdat2b        ; Nope, try again
  6154.     jmp    rdatcf        ; Go handle a file-header packet
  6155. rdat2b: cmp    #'Z        ; Is it an eof packet???
  6156.     bne    rdat2c        ; If not, go check the return status from rpak
  6157.     jmp    rdatce        ; It is, go handle eof processing
  6158. rdat2c: lda    rstat        ; Fetch the return status
  6159.     cmp    #false        ; Was it a failure return?
  6160.     beq    rdat2d        ; If it was, Nak it
  6161.     lda    #errcrd        ; Fetch the error index
  6162.     sta    errcod        ;    and store it as the error code
  6163.     jsr    prcerp        ; Check for error packet and process it
  6164.     lda    #'A        ; Give up the whole transfer
  6165.     sta    state        ; Set system state to 'false'
  6166.     lda    #false        ; Set up a failure return
  6167.     rts            ;    and go back
  6168. rdat2d: lda    n        ; Get the expected packet number
  6169.     sta    pnum        ; Stuff that parameter for Nak routine
  6170.     jsr    nakit        ; Send a Nak packet
  6171.     lda    #false        ; Give failure return
  6172.     rts            ; Go back
  6173.  
  6174. rdatcd: lda    pnum        ; Is pnum the right sequence number?
  6175.     cmp    n        ;        ...
  6176.     bne    rdatd1        ; If not, try another approach
  6177.     jmp    rdatd7        ; Otherwise, everything is fine
  6178. rdatd1: lda    oldtry        ; Get number of tries for previous packet
  6179.     inc    oldtry        ; Increment it for next time we need it
  6180.     cmp    maxtry        ; Have we exceeded that limit?
  6181.     beq    rdatd2        ; Not just yet, continue
  6182.     bcs    rdatd3        ; Yes, go abort the whole thing
  6183. rdatd2: jmp    rdatd4        ; Just continue working on the thing
  6184. rdatd3:
  6185. rdatd6:    lda    #'A        ; Load 'abort' code into the
  6186.     sta    state        ;    current system state
  6187.     lda    #errcrd        ; Fetch the error index
  6188.     sta    errcod        ;    and store it as the error code
  6189.     lda    #false        ; Make this a failure return
  6190.     rts            ; Return
  6191. rdatd4: lda    pnum        ; Is pnum=n-1... Is the received packet
  6192.     clc            ;    the one previous to the currently
  6193.     adc    #$01        ;    expected packet?
  6194.     cmp    n        ;        ...
  6195.     beq    rdatd5        ; Yes, continue transfer
  6196.     jmp    rdatd6        ; Nope, abort the whole thing
  6197. rdatd5:    lda    #'Y        ; Make it look like an ack to a send-init
  6198.     sta    ptype        ;        ...
  6199.     jsr    spak        ; Go send the ack
  6200.     lda    #$00        ; Clear the
  6201.     sta    numtry        ;    number of tries for current packet
  6202.     lda    #true        ;        ...
  6203.     rts            ; Return (successful!)
  6204. rdatd7: jsr    bufemp        ; Go empty the packet buffer
  6205.     lda    #'Y        ; Set up an ack packet
  6206.     sta    ptype        ;        ...
  6207.     lda    n        ;        ...
  6208.     sta    pnum        ;        ...
  6209.     lda    #$00        ; Don't forget, there is no data
  6210.     sta    pdlen        ;        ...
  6211.     jsr    spak        ; Send it!
  6212.     lda    numtry        ; Move tries for current packet count to
  6213.     sta    oldtry        ;    tries for previous packet count
  6214.     lda    #$00        ; Zero the
  6215.     sta    numtry        ;    number of tries for current packet
  6216.     jsr    incn        ; Increment the packet sequence number once
  6217.     lda    #'D        ; Advance the system state to 'receive-data'
  6218.     sta    state        ;        ...
  6219.     lda    #true        ;        ...
  6220.     rts            ; Return (successful)
  6221.  
  6222. rdatcf: lda    oldtry        ; Fetch number of tries for previous packet
  6223.     inc    oldtry        ; Increment it for when we need it again
  6224.     cmp    maxtry        ; Have we exceeded maximum tries allowed?
  6225.     beq    rdatf1        ; Not yet, go on
  6226.     bcs    rdatf2        ; Yup, we have to abort this thing
  6227. rdatf1: jmp    rdatf3        ; Just continue the transfer
  6228. rdatf2:
  6229. rdatf5:    lda    #'A        ; Move 'abort' code to current system state
  6230.     sta    state        ;        ...
  6231.     lda    #errcrd        ; Fetch the error index
  6232.     sta    errcod        ;    and store it as the error code
  6233.     lda    #false        ;        ...
  6234.     rts            ;    and return false
  6235. rdatf3: lda    pnum        ; Is this packet the one before the expected
  6236.     clc            ;    one?
  6237.     adc    #$01        ;        ...
  6238.     cmp    n        ;        ...
  6239.     beq    rdatf4        ; If so, we can still ack it
  6240.     jmp    rdatf5        ; Otherwise, we should abort the transfer
  6241. rdatf4: lda    #'Y        ; Load 'ack' code
  6242.     sta    ptype        ; Stuff that parameter
  6243.     lda    #$00        ; Use zero as the packet data length
  6244.     sta    pdlen        ;        ...
  6245.     jsr    spak        ; Send it!
  6246.     lda    #$00        ; Zero the number of tries for current packet
  6247.     sta    numtry        ;        ...
  6248.     lda    #true        ;        ...
  6249.     rts            ; Return (successful)
  6250.  
  6251. rdatce: lda    pnum        ; Is this the packet we are expecting?
  6252.     cmp    n        ;        ...
  6253.     bne    rdate1        ; No, we should go abort
  6254.     jmp    rdate2        ; Yup, go handle it
  6255. rdate1:    lda    #'A        ; Load 'abort' code into
  6256.     sta    state        ;    current system state
  6257.     lda    #errcrd        ; Fetch the error index
  6258.     sta    errcod        ;    and store it as the error code
  6259.     lda    #false        ;        ...
  6260.     rts            ; Return (failure)
  6261. rdate2:;lda    #fcb1\        ; Get the pointer to the fcb
  6262. ;    sta    kerfcb        ;    and store it where the close routine
  6263. ;    lda    #fcb1^        ;    can find it
  6264. ;    sta    kerfcb        ;        ...
  6265. ;    lda    #$00        ; Make CLOSEF see there are no errors
  6266.     jsr    closef        ; We are done with this file, so close it
  6267.     jsr    incn        ; Increment the packet number
  6268.     lda    #'Y        ; Get set up for the ack
  6269.     sta    ptype        ; Stuff the packet type
  6270.     lda    n        ;    packet number
  6271.     sta    pnum        ;        ...
  6272.     lda    #$00        ;    and packet data length
  6273.     sta    pdlen        ;    parameters
  6274.     jsr    spak        ; Go send it!
  6275.     lda    #'F        ; Advance system state to 'file-header'
  6276.     sta    state        ;    incase more files are coming
  6277.     lda    #true        ;        ...
  6278.     rts            ; Return (successful)
  6279.  
  6280. .SBTTL    Send routine
  6281.  
  6282. ;
  6283. ;    This routine reads a file from disk and sends packets
  6284. ;    of data to the remote kermit.
  6285. ;
  6286. ;        Input:  Filename returned from Comnd routines
  6287. ;
  6288. ;        Output: File is sent over port
  6289. ;
  6290. ;        Registers destroyed:    A,X,Y
  6291. ;
  6292.  
  6293. send:    
  6294.     ldx    #mxfnl        ; Longest length a filename may be
  6295.     ldy    #$00        ; No special flags needed
  6296.     lda    #cmifi        ; Load opcode for parsing input files
  6297.     jsr    comnd        ; Call comnd routine
  6298.      jmp    kermt6        ; Give the 'missing filespec' error
  6299.     sta    kwrk01        ; Store length of file parsed
  6300.     stx    kerfrm        ; Save the from address (addr[atmbuf])
  6301.     sty    kerfrm+1    ;        ...
  6302.     lda    #fcb1\        ; Save the to address (Fcb1)
  6303.     sta    kerto        ;        ...
  6304.     lda    #fcb1^        ;        ...
  6305.     sta    kerto+1        ;        ...
  6306.     jsr    clrfcb        ; Clear the fcb
  6307.     jsr    kercpy        ; Copy the string
  6308.     ldy    kwrk01        ; Get filename length
  6309.     lda    #nul        ; Fetch a null character
  6310.     sta    (kerto),y    ; Stuff a null at end-of-buffer
  6311.     jsr    prcfm        ; Parse and print a confirm
  6312.     jsr    sswt        ; Perform send-switch routine
  6313.     jmp    kermit        ; Go back to main routine
  6314.  
  6315. sswt:    lda    #'S        ; Set up state variable as
  6316.     sta    state        ;    Send-init
  6317.     lda    #$00        ; Clear
  6318.     sta    eodind        ;    The End-of-Data indicator
  6319.     sta    n        ;    Packet number
  6320.     sta    numtry        ;    Number of tries
  6321.     sta    oldtry        ;    Old number of tries
  6322.     sta    eofinp        ;    End of input flag
  6323.     sta    errcod        ;    Error indicator
  6324.     sta    rtot        ;    Total received characters
  6325.     sta    rtot+1        ;        ...
  6326.     sta    stot        ;    Total Sent characters
  6327.     sta    stot+1        ;        ...
  6328.     sta    rchr        ;    Received characters, current file
  6329.     sta    rchr+1        ;        ...
  6330.     sta    schr        ;    and Sent characters, current file
  6331.     sta    schr+1        ;        ...
  6332.     sta    tpak        ;    and the total packet number
  6333.     sta    tpak+1        ;        ...
  6334.     lda    #pdbuf\        ; Set up the address of the packet buffer
  6335.     sta    saddr        ;    so that we can clear it out
  6336.     lda    #pdbuf^        ;        ...
  6337.     sta    saddr+1        ;        ...
  6338.     lda    #$00        ; Clear AC
  6339.     ldy    #$00        ; Clear Y
  6340. clpbuf: sta    (saddr),y    ; Step through buffer, clearing it out
  6341.     iny            ; Up the index
  6342.     cpy    #mxpack-4    ; Done?
  6343.     bmi    clpbuf        ; No, continue
  6344. sswt1:  lda    state        ; Fetch state of the system
  6345.     cmp    #'D        ; Do Send-data?
  6346.     bne    sswt2        ; No, try next one
  6347.     jsr    sdat        ; Yes, send a data packet
  6348.     jmp    sswt1        ; Go to the top of the loop
  6349. sswt2:  cmp    #'F        ; Do we want to send-file-header?
  6350.     bne    sswt3        ; No, continue
  6351.     jsr    sfil        ; Yes, send a file header packet
  6352.     jmp    sswt1        ; Return to top of loop
  6353. sswt3:  cmp    #'Z        ; Are we due for an Eof packet?
  6354.     bne    sswt4        ; Nope, try next state
  6355.     jsr    seof        ; Yes, do it
  6356.     jmp    sswt1        ; Return to top of loop
  6357. sswt4:  cmp    #'S        ; Must we send an init packet
  6358.     bne    sswt5        ; No, continue
  6359.     jsr    sini        ; Yes, go do it
  6360.     jmp    sswt1        ; And continue
  6361. sswt5:  cmp    #'B        ; Time to break the connection?
  6362.     bne    sswt6        ; No, try next state
  6363.     jsr    sbrk        ; Yes, go send a break packet
  6364.     jmp    sswt1        ; Continue from top of loop
  6365. sswt6:  cmp    #'C        ; Is the entire transfer complete?
  6366.     bne    sswt7        ; No, something is wrong, go abort
  6367.     lda    #true        ; Return true
  6368.     rts            ;        ...
  6369. sswt7:  lda    #false        ; Return false
  6370.     rts            ;        ...
  6371.  
  6372. sdat:    lda    numtry        ; Fetch the number for tries for current packet
  6373.     inc    numtry        ; Add one to it
  6374.     cmp    maxtry        ; Is it more than the maximum allowed?
  6375.     beq    sdat1        ; No, not yet
  6376.     bcs    sdat1a        ; If it is, go abort
  6377. sdat1:  jmp    sdat1b        ; Continue
  6378. sdat1a: lda    #'A        ; Load the 'abort' code
  6379.     sta    state        ; Stuff that in as current state
  6380.     lda    #false        ; Enter false return code
  6381.     rts            ;    and return
  6382. sdat1b: lda    #'D        ; Packet type will be 'Send-data'
  6383.     sta    ptype        ;        ...
  6384.     lda    n        ; Get packet sequence number
  6385.     sta    pnum        ; Store that parameter to Spak
  6386.     lda    size        ; This is the size of the data in the packet
  6387.     sta    pdlen        ; Store that where it belongs
  6388.     jsr    spak        ; Go send the packet
  6389. sdat2:  jsr    rpak        ; Try to get an ack
  6390.     sta    rstat        ; First, save the return status
  6391.     lda    ptype        ; Now get the packet type received
  6392.     cmp    #'N        ; Was it a NAK?
  6393.     bne    sdat2a        ; No, try for an ACK
  6394.     jmp    sdatcn        ; Go handle the nak case
  6395. sdat2a: cmp    #'Y        ; Did we get an ACK?
  6396.     bne    sdat2b        ; No, try checking the return status
  6397.     jmp    sdatca        ; Yes, handle the ack
  6398. sdat2b: lda    rstat        ; Fetch the return status
  6399.     cmp    #false        ; Failure return?
  6400.     beq    sdat2c        ; Yes, just return with current state
  6401.     jsr    prcerp        ; Check for error packet and process it
  6402.     lda    #'A        ; Stuff the abort code
  6403.     sta    state        ;    as the current system state
  6404.     lda    #false        ; Load failure return code
  6405. sdat2c: rts            ; Go back
  6406. sdatcn: dec    pnum        ; Decrement the packet sequence number
  6407.     lda    n        ; Get the expected packet sequence number
  6408.     cmp    pnum        ; If n=pnum-1 then this is like an ack
  6409.     bne    sdatn1        ; No, continue handling the nak
  6410.     jmp    sdata2        ; Jump to ack bypassing sequence check
  6411. sdata1:
  6412. sdatn1: lda    #false        ; Failure return
  6413.     rts            ;        ...
  6414. sdatca: lda    n        ; First check packet number
  6415.     cmp    pnum        ; Did he ack the correct packet?
  6416.     bne    sdata1        ; No, go give failure return
  6417. sdata2: lda    #$00        ; Zero out number of tries for current packet
  6418.     sta    numtry        ;        ...
  6419.     jsr    incn        ; Increment the packet sequence number
  6420.     jsr    bufill        ; Go fill the packet buffer with data
  6421.     sta    size        ; Save the data size returned
  6422.     lda    eofinp        ; Load end-of-file indicator
  6423.     cmp    #true        ; Was this set by Bufill?
  6424.     beq    sdatrz        ; If so, return state 'Z' ('Send-eof')
  6425.     jmp    sdatrd        ; Otherwise, return state 'D' ('Send-data')
  6426. sdatrz:    lda    #$00        ; Clear
  6427.     sta    eofinp        ;    End of input flag
  6428.     lda    #fcb1\        ; Get the pointer to the fcb
  6429.     sta    kerfcb        ;    and store it where the close routine
  6430.     lda    #fcb1^        ;    can find it
  6431.     sta    kerfcb        ;        ...
  6432.     lda    #$00        ; Make CLOSEF see there are no errors
  6433.     jsr    closef        ; We are done with this file, so close it
  6434.     lda    #'Z        ; Load the Eof code
  6435.     sta    state        ;    and make it the current system state
  6436.     lda    #true        ; We did succeed, so give a true return
  6437.     rts            ; Go back
  6438. sdatrd: lda    #'D        ; Load the Data code
  6439.     sta    state        ; Set current system state to that
  6440.     lda    #true        ; Set up successful return
  6441.     rts            ;    and go back
  6442.  
  6443. sfil:
  6444. sfil0:    lda    numtry        ; Fetch the current number of tries
  6445.     inc    numtry        ; Up it by one
  6446.     cmp    maxtry        ; See if we went up to too many
  6447.     beq    sfil1        ; Not yet
  6448.     bcs    sfil1a        ; Yes, go abort
  6449. sfil1:    jmp    sfil1b        ; If we are still ok, take this jump
  6450. sfil1a:    lda    #'A        ; Load code for abort
  6451.     sta    state        ;    and drop that in as the current state
  6452.     lda    #false        ; Load false for a return code
  6453.     rts            ;    and return
  6454. sfil1b:    ldy    #$00        ; Clear Y
  6455. sfil1c:    lda    fcb1,y        ; Get a byte from the filename
  6456.     cmp    #$00        ; Is it a null?
  6457.     beq    sfil1d        ; No, continue
  6458.     cmp    #$20        ; <sp>?
  6459.     beq    sfil1d        ;[DD]
  6460.     sta    pdbuf,y        ; Move the byte to this buffer
  6461.     iny            ; Up the index once
  6462.     jmp    sfil1c        ; Loop and do it again
  6463. sfil1d:    sty    pdlen        ; This is the length of the filename
  6464.     lda    #'F        ; Load type ('Send-file')
  6465.     sta    ptype        ; Stuff that in as the packet type
  6466.     lda    n        ; Get packet number
  6467.     sta    pnum        ; Store that in its common area
  6468.     jsr    spak        ; Go send the packet
  6469. sfil2:    jsr    rpak        ; Go try to receive an ack
  6470.     sta    rstat        ; Save the return status
  6471.     lda    ptype        ; Get the returned packet type
  6472.     cmp    #'N        ; Is it a NAK?
  6473.     bne    sfil2a        ; No, try the next packet type
  6474.     jmp    sfilcn        ; Handle the case of a nak
  6475. sfil2a:    cmp    #'Y        ; Is it, perhaps, an ACK?
  6476.     bne    sfil2b        ; If not, go to next test
  6477.     jmp    sfilca        ; Go and handle the ack case
  6478. sfil2b:    lda    rstat        ; Get the return status
  6479.     cmp    #false        ; Is it a failure return?
  6480.     bne    sfil2c        ; No, just go abort the send
  6481.     rts            ; Return failure with current state
  6482. sfil2c:    jsr    prcerp        ; Check for error packet and process it
  6483.     lda    #'A        ; Set state to 'abort'
  6484.     sta    state        ; Stuff it in its place
  6485.     lda    #false        ; Set up a failure return code
  6486.     rts            ;    and go back
  6487. sfilcn:    dec    pnum        ; Decrement the receive packet number once
  6488.     lda    pnum        ; Load it into the AC
  6489.     cmp    n        ; Compare that with what we are looking for
  6490.     bne    sfiln1        ; If n=pnum-1 then this is like an ack, do it
  6491.     jmp    sfila2        ; This is like an ack
  6492. sfila1:    
  6493. sfiln1:    lda    #false        ; Load failure return code
  6494.     rts            ;    and return
  6495. sfilca:    lda    n        ; Get the packet number
  6496.     cmp    pnum        ; Is that the one that was acked?
  6497.     bne    sfila1        ; They are not equal
  6498. sfila2:    lda    #$00        ; Clear AC
  6499.     sta    numtry        ; Zero the number of tries for current packet
  6500.     jsr    incn        ; Up the packet sequence number
  6501.     lda    #fcb1\        ; Load the fcb address into the pointer
  6502.     sta    kerfcb        ;    for the DOS open routine
  6503.     lda    #fcb1^        ;        ...
  6504.     sta    kerfcb+1    ;        ...
  6505.     lda    #fncrea        ; Open for input
  6506.     jsr    openf        ; Open the file
  6507.     jsr    bufill        ; Go get characters from the file
  6508.     sta    size        ; Save the returned buffer size
  6509.     lda    #'D        ; Set state to 'Send-data'
  6510.     sta    state        ;        ...
  6511.     lda    #true        ; Set up true return code
  6512.     rts            ;    and return
  6513.  
  6514. seof:    lda    numtry        ; Get the number of attempts for this packet
  6515.     inc    numtry        ; Now up it once for next time around
  6516.     cmp    maxtry        ; Are we over the allowed max?
  6517.     beq    seof1        ; Not quite yet
  6518.     bcs    seof1a        ; Yes, go abort
  6519. seof1:  jmp    seof1b        ; Continue sending packet
  6520. seof1a: lda    #'A        ; Load 'abort' code
  6521.     sta    state        ; Make that the state of the system
  6522.     lda    #errmrc        ; Fetch the error index
  6523.     sta    errcod        ;    and store it as the error code
  6524.     lda    #false        ; Return false
  6525.     rts            ;        ...
  6526. seof1b: lda    #'Z        ; Load the packet type 'Z' ('Send-eof')
  6527.     sta    ptype        ; Save that as a parm to Spak
  6528.     lda    n        ; Get the packet sequence number
  6529.     sta    pnum        ; Copy in that parm
  6530.     lda    #$00        ; This is our packet data length (0 for EOF)
  6531.     sta    pdlen        ; Copy it
  6532.     jsr    spak        ; Go send out the Eof
  6533. seof2:  jsr    rpak        ; Try to receive an ack for it
  6534.     sta    rstat        ; Save the return status
  6535.     lda    ptype        ; Get the received packet type
  6536.     cmp    #'N        ; Was it a nak?
  6537.     bne    seof2a        ; If not, try the next packet type
  6538.     jmp    seofcn        ; Go take care of case nak
  6539. seof2a: cmp    #'Y        ; Was it an ack
  6540.     bne    seof2b        ; If it wasn't that, try return status
  6541.     jmp    seofca        ; Take care of the ack
  6542. seof2b: lda    rstat        ; Fetch the return status
  6543.     cmp    #false        ; Was it a failure?
  6544.     beq    seof2c        ; Yes, just fail return with current state
  6545.     jsr    prcerp        ; Check for error packet and process it
  6546.     lda    #'A        ; No, abort the whole thing
  6547.     sta    state        ; Set the state to that
  6548.     lda    #false        ; Get false return status
  6549. seof2c: rts            ; Return
  6550. seofcn: dec    pnum        ; Decrement the received packet sequence number
  6551.     lda    n        ; Get the expected sequence number
  6552.     cmp    pnum        ; If it's the same as pnum-1, it is like an ack
  6553.     bne    seofn1        ; It isn't, continue handling the nak
  6554.     jmp    seofa2        ; Switch to an ack but bypass sequence check
  6555. seofa1:
  6556. seofn1: lda    #false        ; Load failure return status
  6557.     rts            ;    and return
  6558. seofca: lda    n        ; Check sequence number expected against
  6559.     cmp    pnum        ;    the number we got.
  6560.     bne    seofa1        ; If not identical, fail and return curr. state
  6561. seofa2: lda    #$00        ; Clear the number of tries for current packet
  6562.     sta    numtry        ;        ...
  6563.     jsr    incn        ; Up the packet sequence number
  6564.     jsr    getnfl        ; Call the routine to get the next file
  6565.     cmp    #eof        ; If it didn't find any more
  6566.     beq    seofrb        ;    then return state 'B' ('Send-Eot')
  6567.     jmp    seofrf        ; Otherwise, return 'F' ('Send-file')
  6568. seofrb: lda    #'B        ; Load Eot state code
  6569.     sta    state        ; Store that as the current state
  6570.     lda    #true        ; Give a success on the return
  6571.     rts            ;        ...
  6572. seofrf: lda    #'F        ; Load File-header state code
  6573.     sta    state        ; Make that the current system state
  6574.     lda    #true        ; Make success the return status
  6575.     rts            ;    and return
  6576.  
  6577. sini:    lda    #pdbuf\        ; Load the pointer to the
  6578.     sta    kerbf1        ;    packet buffer into its
  6579.     lda    #pdbuf^        ;    place on page zero
  6580.     sta    kerbf1+1    ;        ...
  6581.     jsr    spar        ; Go fill in the send init parms
  6582.     lda    numtry        ; If numtry > maxtry
  6583.     cmp    maxtry        ;        ...
  6584.     beq    sini1        ;        ...
  6585.     bcs    sini1a        ;    then we are in bad shape, go fail
  6586. sini1:  jmp    sini1b        ; Otherwise, we just continue
  6587. sini1a:    lda    #'A        ; Set state to 'abort'
  6588.     sta    state        ;        ...
  6589.     lda    #errmrc        ; Fetch the error index
  6590.     sta    errcod        ;    and store it as the error code
  6591.     lda    #$00        ; Set return status (AC) to fail
  6592.     rts            ; Return
  6593. sini1b: inc    numtry        ; Increment the number of tries for this packet
  6594.     lda    #'S        ; Packet type is 'Send-init'
  6595.     sta    ptype        ; Store that
  6596. ;    lda    ebqmod        ; Do we want 8-bit quoting?
  6597. ;    cmp    #on        ;        ...
  6598. ;    beq    sini1c        ; If so, data length is 7
  6599. ;    lda    #$06        ; Else it is 6
  6600. ;    jmp    sini1d        ;        ...
  6601. sini1c: lda    #$07        ; The length of data in a send-init is always 7
  6602. sini1d: sta    pdlen        ; Store that parameter
  6603.     lda    n        ; Get the packet number
  6604.     sta    pnum        ; Store that in its common area
  6605.     jsr    flshin        ;[25] Flush input buffer
  6606.     jsr    spak        ; Call the routine to ship the packet out
  6607.     jsr    rpak        ; Now go try to receive a packet
  6608.     sta    rstat        ; Hold the return status from that last routine
  6609. sinics: lda    ptype        ; Case statement, get the packet type
  6610.     cmp    #'Y        ; Was it an ACK?
  6611.     bne    sinic1        ; If not, try next type
  6612.     jmp    sinicy        ; Go handle the ack
  6613. sinic1: cmp    #'N        ; Was it a NAK?
  6614.     bne    sinic2        ; If not, try next condition
  6615.     jmp    sinicn        ; Handle a nak
  6616. sinic2: lda    rstat        ; Fetch the return status
  6617.     cmp    #false        ; Was this, perhaps false?
  6618.     bne    sinic3        ; Nope, do the 'otherwise' stuff
  6619.     jmp    sinicf        ; Just go and return
  6620. sinic3:    jsr    prcerp        ; Check for error packet and process it
  6621.     lda    #'A        ; Set state to 'abort'
  6622.     sta    state        ;        ...
  6623. sinicn:
  6624. sinicf: rts            ; Return
  6625.  
  6626. sinicy: ldy    #$00        ; Clear Y
  6627.     lda    n        ; Get packet number
  6628.     cmp    pnum        ; Was the ack for that packet number?
  6629.     beq    siniy1        ; Yes, continue
  6630.     lda    #false        ; No, set false return status
  6631.     rts            ;    and go back
  6632. siniy1: jsr    rpar        ; Get parms from the ack packet
  6633.     lda    sebq        ; Check if other Kermit agrees to 8-bit quoting
  6634. ;    cmp    #'Y        ;        ...
  6635. ;    beq    siniy2        ; Yes!
  6636. ;    lda    #off        ; Shut it off
  6637. ;    sta    ebqmod        ;        ...
  6638.     cmp    #'N        ;[30]
  6639.     bne    siniy3        ;[30] Yes! Leave it alone
  6640.     lda    #off        ;[30] No .. Shut it off
  6641.     sta    ebqmod        ;[30]        ...
  6642. siniy2:
  6643. siniy3: lda    #'F        ; Load code for 'Send-file' into AC
  6644.     sta    state        ; Make that the new state
  6645.     lda    #$00        ; Clear AC
  6646.     sta    numtry        ; Reset numtry to 0 for next send
  6647.     jsr    incn        ; Up the packet sequence number
  6648.     lda    #true        ; Return true
  6649.     rts
  6650.  
  6651. sbrk:    lda    numtry        ; Get the number of tries for this packet
  6652.     inc    numtry        ; Incrment it for next time
  6653.     cmp    maxtry        ; Have we exceeded the maximum
  6654.     beq    sbrk1        ; Not yet
  6655.     bcs    sbrk1a        ; Yes, go abort the whole thing
  6656. sbrk1:  jmp    sbrk1b        ; Continue send
  6657. sbrk1a:    lda    #'A        ; Load 'abort' code
  6658.     sta    state        ; Make that the system state
  6659.     lda    #errmrc        ; Fetch the error index
  6660.     sta    errcod        ;    and store it as the error code
  6661.     lda    #false        ; Load the failure return status
  6662.     rts            ;    and return
  6663. sbrk1b: lda    #'B        ; We are sending an Eot packet
  6664.     sta    ptype        ; Store that as the packet type
  6665.     lda    n        ; Get the current sequence number
  6666.     sta    pnum        ; Copy in that parameter
  6667.     lda    #$00        ; The packet data length will be 0
  6668.     sta    pdlen        ; Copy that in
  6669.     jsr    spak        ; Go send the packet
  6670. sbrk2:  jsr    rpak        ; Try to get an ack
  6671.     sta    rstat        ; First, save the return status
  6672.     lda    ptype        ; Get the packet type received
  6673.     cmp    #'N        ; Was it a NAK?
  6674.     bne    sbrk2a        ; If not, try for the ack
  6675.     jmp    sbrkcn        ; Go handle the nak case
  6676. sbrk2a: cmp    #'Y        ; An ACK?
  6677.     bne    sbrk2b        ; If not, look at the return status
  6678.     jmp    sbrkca        ; Go handle the case of an ack
  6679. sbrk2b: lda    rstat        ; Fetch the return status from Rpak
  6680.     cmp    #false        ; Was it a failure?
  6681.     beq    sbrk2c        ; Yes, just return with current state
  6682.     jsr    prcerp        ; Check for error packet and process it
  6683.     lda    #'A        ; No, set up the 'abort' code
  6684.     sta    state        ;    as the system state
  6685.     lda    #false        ;    load the false return status
  6686. sbrk2c: rts            ;    and return
  6687. sbrkcn: dec    pnum        ; Decrement the received packet number once
  6688.     lda    n        ; Get the expected sequence number
  6689.     cmp    pnum        ; If =pnum-1 then this nak is like an ack
  6690.     bne    sbrkn1        ; No, this was no the case
  6691.     jmp    sbrka2        ; Yes! Go do the ack, but skip sequence check
  6692. sbrka1:
  6693. sbrkn1: lda    #false        ; Load failure return code
  6694.     rts            ;    and go back
  6695. sbrkca: lda    n        ; Get the expected packet sequence number
  6696.     cmp    pnum        ; Did we get what we expected?
  6697.     bne    sbrka1        ; No, return failure with current state
  6698. sbrka2: lda    #$00        ; Yes, clear number of tries for this packet
  6699.     sta    numtry        ;        ...
  6700.     jsr    incn        ; Up the packet sequence number
  6701.     lda    #'C        ; The transfer is now complete, reflect this
  6702.     sta    state        ;    in the system state
  6703.     lda    #true        ; Return success!
  6704.     rts
  6705.  
  6706. .SBTTL    Setcom routine
  6707.  
  6708. ;
  6709. ;    This routine sets Kermit-65 parameters.
  6710. ;
  6711. ;        Input:  Parameters from command line
  6712. ;
  6713. ;        Output: NONE
  6714. ;
  6715. ;        Registers destroyed:    A,X,Y
  6716. ;
  6717.  
  6718. setcom: lda    #setcmd\    ; Load the address of the keyword table
  6719.     sta    cminf1        ;
  6720.     lda    #setcmd^    ;
  6721.     sta    cminf1+1    ;
  6722.     ldy    #$00        ; No special flags needed
  6723.     lda    #cmkey        ; Comnd code for parse keyword
  6724.     jsr    comnd        ; Go get it
  6725.      jmp    kermt2        ; Give an error
  6726.     lda    #setcmb\    ; Get the address of jump table
  6727.     sta    jtaddr        ;
  6728.     lda    #setcmb^    ;
  6729.     sta    jtaddr+1    ;
  6730.     txa            ; Offset to AC
  6731.     jmp    jmpind        ;[DD] Jump
  6732. setcmb: jmp    stesc        ; Set escape character
  6733.     jmp    stibm        ; Set ibm-mode switch
  6734.     jmp    stle        ; Set local-echo switch
  6735.     jmp    strc        ; Set receive parameters
  6736.     jmp    stsn        ; Set send parameters
  6737.     jmp    stvt        ; Set vt52-emulation switch
  6738.     jmp    stfw        ; Set file-warning switch
  6739.     jmp    steb        ; Set Eight-bit quoting character
  6740.     jmp    stdb        ; Set debugging switch
  6741.     jmp    stmod        ; Set file-type mode
  6742.     jmp    stfbs        ; Set the file-byte-size for transfer
  6743.     jmp    stccr        ;[DD] Set rs232 registers 
  6744.     jmp    stpari        ; Set the parity for communication
  6745.     jmp    stbaud        ;[17] Set the baud rate for communication
  6746.     jmp    stwrd        ;[17] Set the word length for communication
  6747.     jmp    stflow        ;[24] Set flow control for communication
  6748.     jmp    stscre        ;[37] Set the screen size
  6749.     jmp    stc1        ; set background color
  6750.     jmp    stc2        ; set bright color
  6751.     jmp    stc3        ; set foreground color
  6752.     jmp    stc4        ; set alternate color
  6753.     jmp    stc5        ; set border color
  6754.     jmp stport        ; set port address
  6755.     jmp stworkdisk    ; set working disk number
  6756.  
  6757. stesc:  ldx    #$10        ; Base should be hex
  6758.     ldy    #$00        ; No special flags needed
  6759.     lda    #cmnum        ; Parse for integer
  6760.     jsr    comnd        ; Go!
  6761.      jmp    kermt4        ; Number is bad
  6762.     stx    ksavex        ; Hold the number across the next call
  6763.     sty    ksavey        ;        ...
  6764.     lda    #cmcfm        ; Parse for confirm
  6765.     jsr    comnd        ; Do it
  6766.      jmp    kermt3        ; Not confirmed
  6767.     lda    ksavey        ; If this isn't zero
  6768.     cmp    #$00        ;    it's not an ASCII character
  6769.     beq    stesc1        ; It is, continue
  6770.     jmp    kermt4        ; Bad number, tell them
  6771. stesc1:    lda    ksavex        ; Get L.O. byte
  6772.     cmp    #$7f        ; It shouldn't be bigger than this
  6773.     bmi    stesc2        ; If it's less, it is ok
  6774.     jmp    kermt4        ; Tell the user it is bad
  6775. stesc2: sta    escp        ; Stuff it
  6776.     jmp    kermit
  6777.  
  6778. stibm:  jsr    prson        ; Try parsing an 'on' or 'off'
  6779.      jmp    kermt2        ; Bad keyword
  6780.     stx    ibmmod        ; Store value in the mode switch location
  6781.     stx    lecho        ; Also set local echo accordingly
  6782.     ldy    #nparit        ; Get ready to set the parity parameter
  6783.     lda    #fbebit        ;[17] Get ready to set the word-size parameter
  6784.     cpx    #on        ; Setting ibm mode on?
  6785.     bne    stibm1        ; Nope so set parity none/word-size eight-bit
  6786.     ldy    #mparit        ; Set mark parity
  6787.     lda    #fbsbit        ;[17] Set up for seven bit word size
  6788.     ldx    #off        ;[38] Turn off flow-control
  6789.     stx    flowmo        ;[38]        ...
  6790. stibm1:    sty    parity        ; Store the value
  6791.     sta    wrdsiz        ;[17]        ...
  6792.     lda    #cmcfm        ;[17] Parse for confirm
  6793.     jsr    comnd        ;[17] Do it
  6794.      jmp    kermt3        ;[17] Not confirmed, tell the user that
  6795.     jsr    dopari        ;[17] Really set the parity
  6796.     jsr    dowrd        ;[17] Really set the word size
  6797.     jmp    kermit        ;
  6798.  
  6799. stle:    jsr    prson        ; Try parsing an 'on' or 'off'
  6800.      jmp    kermt2        ; Bad keyword
  6801.     stx    lecho        ; Store value in the mode switch location
  6802.     lda    #cmcfm        ; Parse for confirm
  6803.     jsr    comnd        ; Do it
  6804.      jmp    kermt3        ; Not confirmed, tell the user that
  6805.     jmp    kermit
  6806.  
  6807. strc:    lda    #$00        ; Set srind for receive parms
  6808.     sta    srind        ;        ...
  6809.     lda    #stscmd\    ; Load the address of the keyword table
  6810.     sta    cminf1        ; Save it for the keyword routine
  6811.     lda    #stscmd^    ;
  6812.     sta    cminf1+1    ;
  6813.     ldy    #$00        ; No special flags needed
  6814.     lda    #cmkey        ; Comnd code for parse keyword
  6815.     jsr    comnd        ; Go get it
  6816.      jmp    kermt2        ; Give an error
  6817.     lda    #stcct\        ; Get addr. of jump table
  6818.     sta    jtaddr        ;
  6819.     lda    #stcct^        ;        ...
  6820.     sta    jtaddr+1    ;        ...
  6821.     txa            ; Offset to AC
  6822.     jmp    jmpind      ;[DD] Jump
  6823.  
  6824. stsn:    lda    #$01        ; Set srind for send parms
  6825.     sta    srind        ;        ...
  6826.     lda    #stscmd\    ; Load the address of the keyword table
  6827.     sta    cminf1        ; Save it for the keyword routine
  6828.     lda    #stscmd^    ;        ...
  6829.     sta    cminf1+1    ;        ...
  6830.     ldy    #$00        ; No special flags needed
  6831.     lda    #cmkey        ; Comnd code for parse keyword
  6832.     jsr    comnd        ; Go get it
  6833.      jmp    kermt2        ; Give an error
  6834.     lda    #stcct\        ; Get addr. of jump table
  6835.     sta    jtaddr        ;
  6836.     lda    #stcct^        ;
  6837.     sta    jtaddr+1    ;
  6838.     txa            ; offset to AC
  6839.     jmp    jmpind        ;[DD] Jump
  6840.  
  6841. stcct:  jmp    stpdc        ; Set send/rec padding character
  6842.     jmp    stpad        ; Set amount of padding on send/rec
  6843.     jmp    stebq        ; Set send/rec eight-bit-quoting character
  6844.     jmp    steol        ; Set send/rec end-of-line
  6845.     jmp    stpl        ; Set send/rec packet length
  6846.     jmp    stqc        ; Set send/rec quote character
  6847.     jmp    sttim        ; Set send/rec timeout
  6848.  
  6849. stvt:    lda    #termemu\    ; parse for terminal emulation type
  6850.     sta    cminf1
  6851.     lda    #termemu^
  6852.     sta    cminf1+1
  6853.     ldy    #$00        ; no special flags needed
  6854.     lda    #cmkey        ; parse for a keyword
  6855.     jsr    comnd        ; do it
  6856.      jmp    kermt2        ; go tell the user about the error
  6857.     stx    vtmod        ; Store value in the mode switch location
  6858.     lda    #cmcfm        ; Parse for confirm
  6859.     jsr    comnd        ; Do it
  6860.      jmp    kermt3        ; Not confirmed, tell the user that
  6861.     jmp    kermit
  6862.  
  6863. stfw:    jsr    prson        ; Try parsing an 'on' or 'off'
  6864.      jmp    kermt2        ; Bad keyword
  6865.     stx    filwar        ; Store value in the mode switch location
  6866.     lda    #cmcfm        ; Parse for confirm
  6867.     jsr    comnd        ; Do it
  6868.      jmp    kermt3        ; Not confirmed, tell the user that
  6869.     jmp    kermit
  6870.  
  6871. steb:    jsr    prson        ; Try parsing an 'on' or 'off'
  6872.      jmp    kermt2        ; Bad keyword
  6873.     stx    ebqmod        ; Store value in the mode switch location
  6874.     lda    #cmcfm        ; Parse for confirm
  6875.     jsr    comnd        ; Do it
  6876.      jmp    kermt3        ; Not confirmed, tell the user that
  6877.     jmp    kermit
  6878.  
  6879. stdb:    ldx    #debkey\    ;  Load the address of the keyword table
  6880.     ldy    #debkey^
  6881.     stx    cminf1        ;  Save it for the keyword routine
  6882.     sty    cminf1+1
  6883.     ldy    #$00        ; No special flags needed
  6884.     lda    #cmkey        ; Comnd code for parse keyword
  6885.     jsr    comnd        ; Go get it
  6886.      jmp    kermt2        ; Give an error
  6887.     stx    debug        ; Stuff returned value into debug switch
  6888.     lda    #cmcfm        ; Parse for a confirm
  6889.     jsr    comnd        ; Do it
  6890.      jmp    kermt3        ; Not confirmed, tell the user that
  6891.     jmp    kermit
  6892.  
  6893.  
  6894. stebq:  ldx    #$10        ; Base for ASCII value
  6895.     ldy    #$00        ; No special flags needed
  6896.     lda    #cmnum        ; Code for integer number
  6897.     jsr    comnd        ; Go do it
  6898.      jmp    kermt4        ; The number was bad
  6899.     tya            ; If this isn't zero
  6900.     cmp    #$00        ;    it's not an ASCII character
  6901.     beq    steb1        ; It is, continue
  6902.     jmp    kermt4        ; Bad number, tell them
  6903. steb1:    txa            ; Get L.O. byte
  6904.     cmp    #$7f        ; It shouldn't be bigger than this
  6905.     bmi    steb2        ; If it's less, it is ok
  6906.     jmp    kermt4        ; Tell the user it is bad
  6907. steb2:  cmp    #$21        ; First check the character range
  6908.     bmi    steb4        ; Not in range
  6909.     cmp    #$3f        ;        ...
  6910.     bmi    steb3        ; Inrange
  6911.     cmp    #$60        ;        ...
  6912.     bmi    steb4        ; Not in range
  6913. steb3:  ldx    srind        ; Get index for receive or send parms
  6914.     sta    ebq,x        ; Stuff it
  6915.     lda    #cmcfm        ; Parse for confirm
  6916.     jsr    comnd        ; Do it
  6917.      jmp    kermt3        ; Not confirmed, tell the user that
  6918.     jmp    kermit        ;
  6919. steb4:  ldx    #ermes5\    ; Get error message
  6920.     ldy    #ermes5^    ;        ...
  6921.     jsr    prstr        ; Print the error
  6922.     jsr    prcfm        ; Go parse and print a confirm
  6923.     jmp    kermit        ; Go back
  6924.  
  6925. steol:  ldx    #$10        ; Base for ASCII value
  6926.     ldy    #$00        ; No special flags needed
  6927.     lda    #cmnum        ; Code for integer number
  6928.     jsr    comnd        ; Go do it
  6929.      jmp    kermt4        ; The number was bad
  6930.     tya            ; If this isn't zero
  6931.     cmp    #$00        ;    it's not an ASCII character
  6932.     beq    steo1        ; It is, continue
  6933.     jmp    kermt4        ; Bad number, tell them
  6934. steo1:    txa            ; Get L.O. byte
  6935.     cmp    #$7f        ; It shouldn't be bigger than this
  6936.     bmi    steo2        ; If it's less, it is ok
  6937.     jmp    kermt4        ; Tell the user it is bad
  6938. steo2:  ldx    srind        ; Fetch index for receive or send parms
  6939.     sta    eol,x        ; Stuff it
  6940.     jsr    prcfm        ; Go parse and print a confirm
  6941.     jmp    kermit        ; Go back
  6942.  
  6943. stpad:  ldx    #$10        ; Base for ASCII value
  6944.     ldy    #$00        ; No special flags needed
  6945.     lda    #cmnum        ; Code for integer number
  6946.     jsr    comnd        ; Go do it
  6947.      jmp    kermt4        ; The number was bad
  6948.     tya            ; If this isn't zero
  6949.     cmp    #$00        ;    it's not an ASCII character
  6950.     beq    stpd1        ; It is, continue
  6951.     jmp    kermt4        ; Bad number, tell them
  6952. stpd1:    txa            ; Get L.O. byte
  6953.     cmp    #$7f        ; It shouldn't be bigger than this
  6954.     bmi    stpd2        ; If it's less, it is ok
  6955.     jmp    kermt4        ; Tell the user it is bad
  6956. stpd2:  ldx    srind        ; Get index (receive or send)
  6957.     sta    pad,x        ; Stuff it
  6958.     jsr    prcfm        ; Go parse and print a confirm
  6959.     jmp    kermit        ; Go back
  6960.  
  6961. stpdc:  ldx    #$10        ; Base for ASCII value
  6962.     ldy    #$00        ; No special flags needed
  6963.     lda    #cmnum        ; Code for integer number
  6964.     jsr    comnd        ; Go do it
  6965.      jmp    kermt4        ; The number was bad
  6966.     tya            ; If this isn't zero
  6967.     cmp    #$00        ;    it's not an ASCII character
  6968.     beq    stpc1        ; It is, continue
  6969.     jmp    kermt4        ; Bad number, tell them
  6970. stpc1:    txa            ; Get L.O. byte
  6971.     cmp    #$7f        ; It shouldn't be bigger than this
  6972.     bmi    stpc2        ; If it's less, it is ok
  6973.     jmp    kermt4        ; Tell the user it is bad
  6974. stpc2:  ldx    srind        ; Get index for parms
  6975.     sta    padch,x        ; Stuff it
  6976.     jsr    prcfm        ; Go parse and print a confirm
  6977.     jmp    kermit        ; Go back
  6978.  
  6979. stpl:    ldx    #$10        ; Base for ASCII value
  6980.     ldy    #$00        ; No special flags needed
  6981.     lda    #cmnum        ; Code for integer number
  6982.     jsr    comnd        ; Go do it
  6983.      jmp    kermt4        ; The number was bad
  6984.     tya            ; If this isn't zero
  6985.     cmp    #$00        ;    it's not an ASCII character
  6986.     beq    stpl1        ; It is, continue
  6987.     jmp    kermt4        ; Bad number, tell them
  6988. stpl1:    txa            ; Get L.O. byte
  6989.     cmp    #mxpack        ; It shouldn't be bigger than this
  6990.     bmi    stpl2        ; If it's less, it is ok
  6991.     jmp    kermt4        ; Tell the user it is bad
  6992. stpl2:  ldx    srind        ; Get index
  6993.     sta    psiz,x        ; Stuff it
  6994.     jsr    prcfm        ; Go parse and print a confirm
  6995.     jmp    kermit        ; Go back
  6996.  
  6997. stqc:    ldx    #$10        ; Base for ASCII value
  6998.     ldy    #$00        ; No special flags needed
  6999.     lda    #cmnum        ; Code for integer number
  7000.     jsr    comnd        ; Go do it
  7001.      jmp    kermt4        ; The number was bad
  7002.     tya            ; If this isn't zero
  7003.     cmp    #$00        ;    it's not an ASCII character
  7004.     beq    stqc1        ; It is, continue
  7005.     jmp    kermt4        ; Bad number, tell them
  7006. stqc1:    txa            ; Get L.O. byte
  7007.     cmp    #$7f        ; It shouldn't be bigger than this
  7008.     bmi    stqc2        ; If it's less, it is ok
  7009.     jmp    kermt4        ; Tell the user it is bad
  7010. stqc2:  ldx    srind        ; Fetch index for receive or send parms
  7011.     sta    quote,x        ; Stuff it
  7012.     jsr    prcfm        ; Go parse and print a confirm
  7013.     jmp    kermit        ; Go back
  7014.  
  7015. sttim:  ldx    #$10        ; Base for ASCII value
  7016.     ldy    #$00        ; No special flags needed
  7017.     lda    #cmnum        ; Code for integer number
  7018.     jsr    comnd        ; Go do it
  7019.      jmp    kermt4        ; The number was bad
  7020.     tya            ; If this isn't zero
  7021.     cmp    #$00        ;    it's not an ASCII character
  7022.     beq    sttm1        ; It is, continue
  7023.     jmp    kermt4        ; Bad number, tell them
  7024. sttm1:    txa            ; Get L.O. byte
  7025.     cmp    #$7f        ; It shouldn't be bigger than this
  7026.     bmi    sttm2        ; If it's less, it is ok
  7027.     jmp    kermt4        ; Tell the user it is bad
  7028. sttm2:  ldx    srind        ; Fetch index for receive or send parms
  7029.     sta    time,x        ; Stuff it
  7030.     jsr    prcfm        ; Go parse and print a confirm
  7031.     jmp    kermit        ; Go back
  7032.  
  7033. stmod:    lda    #ftcmd\        ; Load the address of the keyword table
  7034.     sta    cminf1        ;
  7035.     lda    #ftcmd^        ;
  7036.     sta    cminf1+1    ;
  7037.     lda    #ftcdef\    ; Load default address
  7038.     sta    cmdptr        ;        ...
  7039.     lda    #ftcdef^    ;        ...
  7040.     sta    cmdptr+1    ;        ...
  7041.     ldy    #cmfdff        ; Tell Comnd there is a default
  7042.     lda    #cmkey        ; Comnd code for parse keyword
  7043.     jsr    comnd        ; Go get it
  7044.      jmp    kermt2        ; Give an error
  7045.     stx    filmod        ; Save the file-type mode
  7046.     lda    #cmcfm        ; Parse for a confirm
  7047.     jsr    comnd        ; Do it
  7048.      jmp    kermt3        ; Not confirmed, tell the user that
  7049.     jmp    kermit
  7050.  
  7051. stfbs:    lda    #fbskey\    ; Load the address of the keyword table
  7052.     sta    cminf1        ;
  7053.     lda    #fbskey^    ;
  7054.     sta    cminf1+1    ;
  7055.     ldy    #$00        ; No special flags needed
  7056.     lda    #cmkey        ; Comnd code for parse keyword
  7057.     jsr    comnd        ; Go get it
  7058.      jmp    kermt2        ; Give an error
  7059.     stx    fbsize        ; Stuff the returned value into file-byte-size
  7060.     lda    #cmcfm        ; Parse for a confirm
  7061.     jsr    comnd        ; Do it
  7062.      jmp    kermt3        ; Not confirmed, tell the user that
  7063.     jmp    kermit
  7064.  
  7065.  
  7066. stccr:  ldx    #$10        ;[DD] Base should be hex
  7067.     ldy    #$00        ; No special flags needed
  7068.     lda    #cmnum        ;[DD] Parse for integer
  7069.     jsr    comnd        ;[DD] Go do it
  7070.      jmp    kermt4        ;[DD] The number was bad
  7071. stccr1:    stx    ksavex        ; Store it while we confirm
  7072.     sty    ksavey        ;        ...
  7073.     lda    #cmcfm        ; Set up to parse confirm
  7074.     jsr    comnd        ; Do it
  7075.      jmp    kermt3        ; Wasn't properly confirmed
  7076.     lda    ksavex        ; Fetch back L.O. byte
  7077. mm1:    sta    $de02        ; fetch control register
  7078.     lda    ksavey        ;[18] Fetch back H.O. byte
  7079. mm2:    sta    $de03        ; fetch command register
  7080.     jmp    kermit        ;[DD] 
  7081.  
  7082. stpari:    lda    #parkey\    ; Load the address of the keyword table
  7083.     sta    cminf1        ; Save it for the keyword routine
  7084.     lda    #parkey^    ;        ...
  7085.     sta    cminf1+1    ;        ...
  7086.     ldy    #$00        ; No special flags needed
  7087.     lda    #cmkey        ; Comnd code for parse keyword
  7088.     jsr    comnd        ; Go get it
  7089.      jmp    kermt2        ; Give an error
  7090.     stx    parity        ; Stuff returned value into parity
  7091.     lda    #cmcfm        ; Parse for a confirm
  7092.     jsr    comnd        ; Do it
  7093.      jmp    kermt3        ; Not confirmed, tell the user that
  7094.     jsr    dopari        ;[17] Now really set the parity
  7095.     jmp    kermit        ;
  7096.  
  7097. dopari:    lda    $de02        ;[17] Get the command register
  7098.     and    #%00011111    ; mask parity bits
  7099.     ldx    parity        ;[17] Get the index
  7100.     ora    parval,x    ;[17]    and the parity value from the table
  7101. mm3:    sta    $de02        ; put back the command register
  7102.     rts            ;[17] Return
  7103.  
  7104. stbaud:    lda    #bdkey\        ;[17] Load the address of the keyword table
  7105.     sta    cminf1        ;[17] Save it for the keyword routine
  7106.     lda    #bdkey^        ;[17]        ...
  7107.     sta    cminf1+1    ;[17]        ...
  7108.     ldy    #$00        ;[17] No special flags needed
  7109.     lda    #cmkey        ;[17] Parse for a keyword
  7110.     jsr    comnd        ;[17] Do it
  7111.      jmp    kermt2        ;[17] Give an error
  7112.     stx    baud        ;[17] Stuff the returned value
  7113.     lda    #cmcfm        ;[17] Set up for a confirm
  7114.     jsr    comnd        ;[17] Do it
  7115.      jmp    kermt3        ;[17] Not confirmed
  7116.     jsr    dobad        ;[17] Really set the baud rate
  7117.     jmp    kermit        ;[17] 
  7118.  
  7119. dobad:    ldx    baud        ; get desired baud rate
  7120. mm4:    lda    $de03        ; get control register
  7121.     and    #%11110000    ; mask off baud bits
  7122.     ora    bdval,x        ; or in new baud bits
  7123. mm5:    sta    $de03        ; put back control register
  7124.     rts
  7125.  
  7126. stwrd:    lda    #fbskey\    ;[17] Load the address of the keyword table
  7127.     sta    cminf1        ;[17] Save it for the keyword routine
  7128.     lda    #fbskey^    ;[17]        ...
  7129.     sta    cminf1+1    ;[17]        ...
  7130.     ldy    #$00        ;[17] No special flags needed
  7131.     lda    #cmkey        ;[17] Comnd code for parse keyword
  7132.     jsr    comnd        ;[17] Go get it
  7133.      jmp    kermt2        ;[17] Give an error
  7134.     stx    wrdsiz        ;[17] Stuff the returned value into wrd len
  7135.     lda    #cmcfm        ;[17] Parse for a confirm
  7136.     jsr    comnd        ;[17] Do it
  7137.      jmp    kermt3        ;[17] Not confirmed, tell the user that
  7138.     jsr    dowrd        ;[17] Really set the word size
  7139.     jmp    kermit        ;[17]        ...
  7140.  
  7141. dowrd:    lda    $de03        ;[17] Get the control register
  7142.     and    #%10011111    ; mask word length bits
  7143.     ldx    wrdsiz        ;[17] Get the word size
  7144.     cpx    #fbsbit        ;[17] Is it seven-bit ?
  7145.     bne    dowrd1        ;[17] No, we have the value for eight-bit
  7146.     ora    #%00100000    ; set for seven bits (eight bit value is zero)
  7147. dowrd1:    sta    $de03        ; put back control register
  7148.     rts            ;[17] Return
  7149.  
  7150. stflow: jsr    prson        ;[24] Try parsing an 'on' or 'off'
  7151.      jmp    kermt2        ;[24] Bad keyword
  7152.     stx    flowmo        ;[24] Store it
  7153.     lda    #cmcfm        ;[24] Parse for confirm
  7154.     jsr    comnd        ;[24] Do it
  7155.      jmp    kermt3        ;[24] Not confirmed, tell the user that
  7156.     jmp    kermit        ;[24]
  7157.  
  7158. stscre:    lda    #scrkey\    ;[37] Get the address of the screen mode table
  7159.     sta    cminf1        ;[37]        ...
  7160.     lda    #scrkey^    ;[37]        ...
  7161.     sta    cminf1+1    ;[37]        ...
  7162.     ldy    #$00        ;[37] No special flags needed
  7163.     lda    #cmkey        ;[37] Comnd code for parse keyword
  7164.     jsr    comnd        ;[37] Go get it
  7165.      jmp    kermt2        ;[37] Give an error
  7166.     stx    kwrk01        ;[37] Stuff the returned value into kwrk01
  7167.     lda    #cmcfm        ;[37] Parse for a confirm
  7168.     jsr    comnd        ;[37] Do it
  7169.      jmp    kermt3        ;[37] Not confirmed, tell the user that
  7170.     lda    kwrk01        ;[37] Are we switching to 80 columns?
  7171.  
  7172. get:    pha            ; save the id of the screen driver we want
  7173.     jsr    scrext        ; exit the old screen driver
  7174.     pla
  7175.     pha            ; keep the id of the screen driver on the stack
  7176.     jsr    scrtst        ; does this screen driver exist?
  7177.     pla            ; restore desired screen type
  7178.     bcc    get1
  7179.     lda    #$01        ; if it does not exist, use 80-columns instead
  7180. get1:    sta    scrtype
  7181.     jsr    scrent        ; enter the screen driver
  7182.     jsr    dobad        ; reset baud kludge value based on fast mode
  7183.     jmp    kermit        ; all done
  7184.  
  7185. stc1:    lda    #colors\    ; parse for color type
  7186.     sta    cminf1
  7187.     lda    #colors^
  7188.     sta    cminf1+1
  7189.     ldy    #$00        ; no special flags needed
  7190.     lda    #cmkey        ; parse for a keyword
  7191.     jsr    comnd        ; do it
  7192.      jmp    kermt2        ; go tell the user about the error
  7193.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7194.     lda    #cmcfm        ; Parse for a confirm
  7195.     jsr    comnd        ; Do it
  7196.      jmp    kermt3        ; Not confirmed, tell the user that
  7197.     lda    kwrk01        ; What color are we switching to?
  7198.     sta    backclr        ; set the background color
  7199.     jsr    scrset
  7200.     jmp    kermit
  7201.  
  7202. stc2:    lda    #colors\    ; parse for color type
  7203.     sta    cminf1
  7204.     lda    #colors^
  7205.     sta    cminf1+1
  7206.     ldy    #$00        ; no special flags needed
  7207.     lda    #cmkey        ; parse for a keyword
  7208.     jsr    comnd        ; do it
  7209.      jmp    kermt2        ; go tell the user about the error
  7210.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7211.     lda    #cmcfm        ; Parse for a confirm
  7212.     jsr    comnd        ; Do it
  7213.      jmp    kermt3        ; Not confirmed, tell the user that
  7214.     lda    kwrk01        ; What color are we switching to?
  7215.     sta    britclr        ; set the highlighting color
  7216.     jsr    scrset
  7217.     jmp    kermit
  7218.  
  7219. stc3:    lda    #colors\    ; parse for color type
  7220.     sta    cminf1
  7221.     lda    #colors^
  7222.     sta    cminf1+1
  7223.     ldy    #$00        ; no special flags needed
  7224.     lda    #cmkey        ; parse for a keyword
  7225.     jsr    comnd        ; do it
  7226.      jmp    kermt2        ; go tell the user about the error
  7227.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7228.     lda    #cmcfm        ; Parse for a confirm
  7229.     jsr    comnd        ; Do it
  7230.      jmp    kermt3        ; Not confirmed, tell the user that
  7231.     lda    kwrk01        ; What color are we switching to?
  7232.     sta    foreclr        ; set the foreground color
  7233.     jsr    scrset
  7234.     jmp    kermit
  7235.  
  7236. stc4:    lda    #colors\    ; parse for color type
  7237.     sta    cminf1
  7238.     lda    #colors^
  7239.     sta    cminf1+1
  7240.     ldy    #$00        ; no special flags needed
  7241.     lda    #cmkey        ; parse for a keyword
  7242.     jsr    comnd        ; do it
  7243.      jmp    kermt2        ; go tell the user about the error
  7244.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7245.     lda    #cmcfm        ; Parse for a confirm
  7246.     jsr    comnd        ; Do it
  7247.      jmp    kermt3        ; Not confirmed, tell the user that
  7248.     lda    kwrk01        ; What color are we switching to?
  7249.     sta    altclr        ; set the alternate color
  7250.     jsr    scrset
  7251.     jmp    kermit
  7252.  
  7253. stc5:    lda    #colors\    ; parse for color type
  7254.     sta    cminf1
  7255.     lda    #colors^
  7256.     sta    cminf1+1
  7257.     ldy    #$00        ; no special flags needed
  7258.     lda    #cmkey        ; parse for a keyword
  7259.     jsr    comnd        ; do it
  7260.      jmp    kermt2        ; go tell the user about the error
  7261.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7262.     lda    #cmcfm        ; Parse for a confirm
  7263.     jsr    comnd        ; Do it
  7264.      jmp    kermt3        ; Not confirmed, tell the user that
  7265.     lda    kwrk01        ; What color are we switching to?
  7266.     sta    bordclr        ; set the border color
  7267.     jsr    scrset
  7268.     jmp    kermit
  7269.  
  7270. stport:    lda    #pokey\        ;[17] Load the address of the keyword table
  7271.     sta    cminf1        ;[17] Save it for the keyword routine
  7272.     lda    #pokey^        ;[17]        ...
  7273.     sta    cminf1+1    ;[17]        ...
  7274.     ldy    #$00        ;[17] No special flags needed
  7275.     lda    #cmkey        ;[17] Parse for a keyword
  7276.     jsr    comnd        ;[17] Do it
  7277.      jmp    kermt2        ;[17] Give an error
  7278.     stx    portadd        ;[17] Stuff the returned value
  7279.     lda    #cmcfm        ;[17] Set up for a confirm
  7280.     jsr    comnd        ;[17] Do it
  7281.      jmp    kermt3        ;[17] Not confirmed
  7282.     jsr    changport        ;[17] Really set the port
  7283.     jmp    kermit        ;[17] 
  7284.  
  7285. stworkdisk:  ldx    #$0A        ;[DD] Base should be Dec
  7286.     ldy    #$00        ; No special flags needed
  7287.     lda    #cmnum        ;[DD] Parse for integer
  7288.     jsr    comnd        ;[DD] Go do it
  7289.     jmp    kermt4        ;[DD] The number was bad
  7290.     stx    ksavex        ; Store it while we confirm
  7291.     sty    ksavey        ;        ...
  7292.     lda    #cmcfm        ; Set up to parse confirm
  7293.     jsr    comnd        ; Do it
  7294.      jmp    kermt3        ; Wasn't properly confirmed
  7295.     lda    ksavex        ; Fetch back L.O. byte
  7296.     pha
  7297.     jsr    chkdriv
  7298.     bne nodrive
  7299.     pla
  7300.     sta workdri
  7301.     jmp    kermit        ;[DD] 
  7302. nodrive:
  7303.     pla
  7304.     ldx #ermesf\
  7305.     ldy #ermesf^
  7306.     jsr prstr
  7307.     jmp kermit
  7308.  
  7309.  
  7310. .SBTTL    Show routine
  7311.  
  7312. ;
  7313. ;    This routine shows any of the operational parameters that
  7314. ;    can be altered with the set command.
  7315. ;
  7316. ;        Input:  Parameters from command line
  7317. ;
  7318. ;        Output: Display parameter values on screen
  7319. ;
  7320. ;        Registers destroyed:    A,X,Y
  7321. ;
  7322.  
  7323. show:    lda    #shocmd\    ; Load address of keyword table
  7324.     sta    cminf1        ;
  7325.     lda    #shocmd^    ;
  7326.     sta    cminf1+1    ;
  7327.     lda    #shodef\    ; Fetch default address
  7328.     sta    cmdptr        ;        ...
  7329.     lda    #shodef^    ;        ...
  7330.     sta    cmdptr+1    ;        ...
  7331.     ldy    #cmfdff        ; Indicate that there is a default
  7332.     lda    #cmkey        ; Comnd code to parse keyword
  7333.     jsr    comnd        ; Go parse the keyword
  7334.      jmp    kermt2        ; Bad keyword, go give an error
  7335.     lda    #shocmb\     ; Get addr. of jump table
  7336.     sta    jtaddr        ;
  7337.     lda    #shocmb^    ;
  7338.     sta    jtaddr+1    ;
  7339.     txa            ; Offset to AC
  7340.     jmp    jmpind        ;[DD] Jump
  7341.  
  7342. shocmb: jsr    prcfm        ; Parse for confirm
  7343.     jsr    shall        ; Show all setable parameters
  7344.     jmp    kermit        ; Go to top of main loop
  7345.     jsr    prcfm        ; Parse for confirm
  7346.     jsr    shesc        ; Show escape character
  7347.     jmp    kermit        ; Go to top of main loop
  7348.     jsr    prcfm        ; Parse for confirm
  7349.     jsr    shibm        ; Show ibm-mode switch
  7350.     jmp    kermit        ; Go to top of main loop
  7351.     jsr    prcfm        ; Parse for confirm
  7352.     jsr    shle        ; Show local-echo switch
  7353.     jmp    kermit        ; Go to top of main loop
  7354.     nop            ; We should not parse for confirm
  7355.     nop            ;    since this routine parses for
  7356.     nop            ;    a keyword next
  7357.     jsr    shrc        ; Show receive parameters
  7358.     jmp    kermit        ; Go to top of main loop
  7359.     nop            ; We should not parse for confirm
  7360.     nop            ;    since this routine parses for
  7361.     nop            ;    a keyword next
  7362.     jsr    shsn        ; Show send parameters
  7363.     jmp    kermit        ; Go to top of main loop
  7364.     jsr    prcfm        ; Parse for confirm
  7365.     jsr    shvt        ; Show vt52-emulation mode switch
  7366.     jmp    kermit        ; Go to top of main loop
  7367.     jsr    prcfm        ; Parse for confirm
  7368.     jsr    shfw        ; Show file-warning switch
  7369.     jmp    kermit        ; Go to top of main loop
  7370.     jsr    prcfm        ; Parse for confirm
  7371.     jsr    sheb        ; Show eight-bit-quoting switch
  7372.     jmp    kermit        ; Go to top of main loop
  7373.     jsr    prcfm        ; Parse for confirm
  7374.     jsr    shdb        ; Show debugging mode switch
  7375.     jmp    kermit        ; Go to top of main loop
  7376.     jsr    prcfm        ; Parse for confirm
  7377.     jsr    shmod        ; Show File mode
  7378.     jmp    kermit        ; Go to top of main loop
  7379.     jsr    prcfm        ; Parse for confirm
  7380.     jsr    shfbs        ; Show the file-byte-size
  7381.     jmp    kermit        ; Go to top of main loop
  7382.     jsr    prcfm        ;[DD] Parse for confirm 
  7383.     jsr    shccr        ;[DD] Show rs232 regs.
  7384.     jmp    kermit        ;[DD] Go to top of main loop
  7385.     jsr    prcfm        ; Parse for confirm
  7386.     jsr    shpari        ; Show Parity
  7387.     jmp    kermit        ; Go to top of main loop
  7388.     jsr    prcfm        ;[17] Parse for a confirm
  7389.     jsr    shbad        ;[17] Show baud
  7390.     jmp    kermit        ;[17] Go to top of main loop
  7391.     jsr    prcfm        ;[17] Parse for a confirm
  7392.     jsr    shwrd        ;[17] Show word size
  7393.     jmp    kermit        ;[17] Go to top of main loop
  7394.     jsr    prcfm        ;[24] Parse for a confirm
  7395.     jsr    shflow        ;[24] Show flow-control
  7396.     jmp    kermit        ;[24] Go to top of main loop
  7397.     jsr prcfm
  7398.     jsr shport        ; Show port address
  7399.     jmp kermit
  7400.     jsr prcfm
  7401.     jsr shworkdr    ; show working drive
  7402.     jmp kermit
  7403.  
  7404. shall:  jsr    shdb        ; Show debugging mode switch
  7405.     jsr    shvt        ; Show vt52-emulation mode switch
  7406.     jsr    shibm        ; Show ibm-mode switch
  7407.     jsr    shle        ; Show local-echo switch
  7408.     jsr    shbad        ;[17] Show baud rate
  7409.     jsr    shpari        ; Show parity setting
  7410.     jsr    shwrd        ;[17] Show word length
  7411.     jsr    shflow        ;[24] Show flow-control
  7412.     jsr    sheb        ; Show eight-bit-quoting switch
  7413.     jsr    shfw        ; Show file-warning switch
  7414.     jsr    shesc        ; Show the current escape character
  7415.     jsr    shmod        ; Show the file-type mode
  7416.     jsr    shfbs        ; Show the file-byte-size
  7417.     jsr    shccr        ;[DD] Show rs232 regs.
  7418.     jsr shport        ; Show current SL port
  7419.     jsr shworkdr    ; Show working drive
  7420.     jsr    shrcal        ; Show receive parameters
  7421.     jsr    shsnal        ; Show send parameters
  7422.     rts            ; Return
  7423.  
  7424. shdb:    ldx    #shin00\    ; Get address of message for this item
  7425.     ldy    #shin00^
  7426.     jsr    prstr        ; Print that message
  7427.     lda    debug        ; Get the switch value
  7428.     cmp    #$03        ; Is it >= 3?
  7429.     bmi    shdb1        ; If not just get the string and print it
  7430.     lda    #$00        ; This is index for debug mode we want
  7431. shdb1:    tax            ; Hold this index
  7432.     lda    #kerdms\    ; Get the address of the device strings
  7433.     sta    kermbs        ; And stuff it here for genmad
  7434.     lda    #kerdms^    ;        ...
  7435.     sta    kermbs+1    ;        ...
  7436.     lda    #kerdsz        ; Get the string length
  7437.     pha            ; Push that
  7438.     txa            ; Fetch the index back
  7439.     pha            ; Push that parm then
  7440.     jsr    genmad        ;    call genmad
  7441.     jsr    prstr        ; Print the the string at that address
  7442.     jsr    prcrlf        ; Print a crelf after it
  7443.     rts
  7444.  
  7445. shvt:    ldx    #shin01\    ; Get address of message for this item
  7446.     ldy    #shin01^
  7447.     jsr    prstr        ; Print that message
  7448.     lda    #kertms\    ; get address of messages for this item
  7449.     sta    kermbs
  7450.     lda    #kertms^
  7451.     sta    kermbs+1
  7452.     lda    #keremu        ; length of the messages
  7453.     pha
  7454.     lda    vtmod        ; which message
  7455.     pha
  7456.     jsr    genmad        ; calculate address of selected message
  7457.     jsr    prstr        ; print selected message
  7458.     jsr    prcrlf        ; and a carriage return / line feed
  7459.     rts            ; all done
  7460.  
  7461. shibm:  ldx    #shin02\    ; Get address of message for this item
  7462.     ldy    #shin02^
  7463.     jsr    prstr        ; Print that message
  7464.     lda    ibmmod        ; Get the switch value
  7465.     jmp    pron        ; Go print the 'on' or 'off' string
  7466.  
  7467. shle:    ldx    #shin03\    ; Get address of message for this item
  7468.     ldy    #shin03^
  7469.     jsr    prstr        ; Print that message
  7470.     lda    lecho        ; Get the switch value
  7471.     jmp    pron        ; Go print the 'on' or 'off' string
  7472.  
  7473. sheb:    ldx    #shin04\    ; Get address of message for this item
  7474.     ldy    #shin04^
  7475.     jsr    prstr        ; Print that message
  7476.     lda    ebqmod        ; Get the switch value
  7477.     jmp    pron        ; Go print the 'on' or 'off' string
  7478.  
  7479. shfw:    ldx    #shin05\    ; Get address of message for this item
  7480.     ldy    #shin05^
  7481.     jsr    prstr        ; Print that message
  7482.     lda    filwar        ; Get the switch value
  7483.     jmp    pron        ; Go print the 'on' or 'off' string
  7484.  
  7485. shesc:  ldx    #shin06\    ; Get address of message
  7486.     ldy    #shin06^
  7487.     jsr    prstr        ; Print message
  7488.     lda    escp        ; Get the escape character
  7489.     jsr    prchr        ; Print the special character
  7490.     jsr    prcrlf        ; Print a crelf
  7491.     rts            ;    and return
  7492.  
  7493. shccr:  ldx    #shin18\    ;[DD][EL] Print rs232 registers cntrl,cmmnd 
  7494.     ldy    #shin18^    ;[DD]
  7495.     jsr    prstr        ;[DD]
  7496. mm6:    lda    $de03        ;[DD] control register
  7497.     jsr    prbyte        ;[DD]
  7498. mm7:    lda    $de02        ;[DD] command register
  7499.     jsr    prbyte        ;[DD]
  7500.     jsr    prcrlf        ;[DD]    and a crlf
  7501.     rts            ;[DD]
  7502.  
  7503. shport:  ldx #shin24\   ;  Print SwiftLink Port
  7504.          ldy #shin24^
  7505.          jsr prstr
  7506.          ldx portadd    
  7507.          lda portlist,x
  7508.          jsr prbyte
  7509.          ldx #shin25\
  7510.          ldy #shin25^
  7511.          jsr prstr
  7512.          jsr prcrlf
  7513.          rts
  7514.  
  7515. shworkdr:      ldx #shin23\  ; print working-drive
  7516.               ldy #shin23^
  7517.               jsr prstr
  7518.               ldx workdri
  7519.               lda #$00
  7520.               jsr prntad
  7521.               jsr prcrlf
  7522.               rts
  7523.  
  7524. shsn:    lda    #$01        ; Set up index to be used later
  7525.     sta    srind
  7526.     lda    #stscmd\    ; Get the set option table address
  7527.     sta    cminf1        ;
  7528.     lda    #stscmd^    ;
  7529.     sta    cminf1+1    ;
  7530.     ldy    #$00        ; No special flags needed
  7531.     lda    #cmkey        ; Code for keyword parse
  7532.     jsr    comnd        ; Try to parse it
  7533.      jmp    kermt2        ; Invalid keyword
  7534.     stx    kwrk01        ; Hold offset into jump table
  7535.     jsr    prcfm        ; Parse and print a confirm
  7536.     lda    #shcmb\      ; Get addr. of jump table
  7537.     sta    jtaddr        ;
  7538.     lda    #shcmb^        ;
  7539.     sta    jtaddr+1    ;
  7540.     lda    kwrk01        ; Get offset  back
  7541.     asl    a        ; Double it
  7542.     jmp    jmpind      ;[DD] Jump
  7543. ;
  7544. shrc:    lda    #$00        ; Set up index to be used later
  7545.     sta    srind
  7546.     lda    #stscmd\    ; Get the set option table address
  7547.     sta    cminf1        ;
  7548.     lda    #stscmd^    ;
  7549.     sta    cminf1+1    ;
  7550.     ldy    #$00        ; No special flags needed
  7551.     lda    #cmkey        ; Code for keyword parse
  7552.     jsr    comnd        ; Try to parse it
  7553.      jmp    kermt2        ; Invalid keyword
  7554.     stx    kwrk01        ; Hold offset into jump table
  7555.     jsr    prcfm        ; Parse and print a confirm
  7556.     lda    #shcmb\        ; Get addr. ofl jump table
  7557.     sta    jtaddr        ;
  7558.     lda    #shcmb^        ;
  7559.     sta    jtaddr+1    ;
  7560.     lda    kwrk01        ; Get offset  back
  7561.     asl    a        ; Double it
  7562.     jmp    jmpind        ;[DD] Jump
  7563.  
  7564. shcmb:  jsr    shpdc        ; Show send/rec padding character
  7565.     jmp    kermit        ; Go back
  7566.     jsr    shpad        ; Show amount of padding for send/rec
  7567.     jmp    kermit        ; Go back
  7568.     jsr    shebq        ; Show send/rec eight-bit-quoting character
  7569.     jmp    kermit        ; Go back
  7570.     jsr    sheol        ; Show send/rec end-of-line character
  7571.     jmp    kermit        ; Go back
  7572.     jsr    shpl        ; Show send/rec packet length
  7573.     jmp    kermit        ; Go back
  7574.     jsr    shqc        ; Show send/rec quote character
  7575.     jmp    kermit        ; Go back
  7576.     jsr    shtim        ; Show send/rec timeout
  7577.     jmp    kermit        ; Go back
  7578.  
  7579. shpdc:  ldx    #shin11\    ; Get address of 'pad char' string
  7580.     ldy    #shin11^
  7581.     jsr    prstr        ; Print that
  7582.     ldx    srind        ; Load index so we print correct parm
  7583.     lda    padch,x        ; If index is 1, this gets spadch
  7584.     jsr    prchr        ; Print the special character
  7585.     jsr    prcrlf        ; Print a crelf after it
  7586.     rts
  7587. shpad:  ldx    #shin12\    ; Get address of 'padding amount' string
  7588.     ldy    #shin12^
  7589.     jsr    prstr        ; Print that
  7590.     ldx    srind        ; Load index so we print correct parm
  7591.     lda    pad,x        ; If index is 1, this gets spad
  7592.     jsr    prbyte        ; Print the amount of padding
  7593.     jsr    prcrlf        ; Print a crelf after it
  7594.     rts
  7595. shebq:  ldx    #shin08\    ; Get address of 'eight-bit-quote' string
  7596.     ldy    #shin08^
  7597.     jsr    prstr        ; Print that
  7598.     ldx    srind        ; Load index so we print correct parm
  7599.     lda    ebq,x        ; If index is 1, this gets sebq
  7600.     jsr    prchr        ; Print the special character
  7601.     jsr    prcrlf        ; Print a crelf after it
  7602.     rts
  7603. sheol:  ldx    #shin09\    ; Get address of 'end-of-line' string
  7604.     ldy    #shin09^
  7605.     jsr    prstr        ; Print that
  7606.     ldx    srind        ; Load index so we print correct parm
  7607.     lda    eol,x        ; If index is 1, this gets seol
  7608.     jsr    prchr        ; Print the special character
  7609.     jsr    prcrlf        ; Print a crelf after it
  7610.     rts
  7611. shpl:    ldx    #shin10\    ; Get address of 'packet length' string
  7612.     ldy    #shin10^
  7613.     jsr    prstr        ; Print that
  7614.     ldx    srind        ; Load index so we print correct parm
  7615.     lda    psiz,x        ; If index is 1, this gets spsiz
  7616.     jsr    prbyte        ; Print the packet length
  7617.     jsr    prcrlf        ; Print a crelf after it
  7618.     rts            ;    and return
  7619. shqc:    ldx    #shin13\    ; Get address of 'quote-char' string
  7620.     ldy    #shin13^
  7621.     jsr    prstr        ; Print that
  7622.     ldx    srind        ; Load index so we print correct parm
  7623.     lda    quote,x        ; If index is 1, this gets squote
  7624.     jsr    prchr        ; Print the special character
  7625.     jsr    prcrlf        ; Print a crelf after it
  7626.     rts
  7627. shtim:  ldx    #shin14\    ; Get address of 'timeout' string
  7628.     ldy    #shin14^
  7629.     jsr    prstr        ; Print that
  7630.     ldx    srind        ; Load index so we print correct parm
  7631.     lda    time,x        ; If index is 1, this gets stime
  7632.     jsr    prbyte        ; Print the hex value
  7633.     jsr    prcrlf        ; Print a crelf after it
  7634.     rts
  7635.  
  7636. shsnal: lda    #$01        ; Set up index for show parms
  7637.     sta    srind        ;    and stuff it here
  7638.     ldx    #shin07\    ; Get address of 'send' string
  7639.     ldy    #shin07^    ;
  7640.     jsr    prstr        ; Print it
  7641.     jsr    prcrlf        ; Print a crelf
  7642.     jsr    shpdc        ; Show the padding character
  7643.     jsr    shpad        ; Show amount of padding
  7644.     jsr    shebq        ; Show eight-bit-quote character
  7645.     jsr    sheol        ; Show end-of-line character
  7646.     jsr    shpl        ; Show packet-length
  7647.     jsr    shqc        ; Show quote character
  7648.     jsr    shtim        ; Show timeout length
  7649.     rts
  7650.  
  7651. shrcal: lda    #$00        ; Set up index for show parms
  7652.     sta    srind        ;    and stuff it here
  7653.     ldx    #shin15\    ; Get address of 'receive' string
  7654.     ldy    #shin15^
  7655.     jsr    prstr        ; Print it
  7656.     jsr    prcrlf        ; Print a crelf
  7657.     jsr    shpdc        ; Show the padding character
  7658.     jsr    shpad        ; Show amount of padding
  7659.     jsr    shebq        ; Show eight-bit-quote character
  7660.     jsr    sheol        ; Show end-of-line character
  7661.     jsr    shpl        ; Show packet-length
  7662.     jsr    shqc        ; Show quote character
  7663.     jsr    shtim        ; Show timeout length
  7664.     rts
  7665.  
  7666. shmod:  ldx    #shin16\    ; Get address of 'timeout' string
  7667.     ldy    #shin16^
  7668.     jsr    prstr        ; Print that
  7669.     lda    filmod        ; Get the file-type mode
  7670.     cmp    #$05        ; Is it >= 4?
  7671.     bmi    shmod1        ; If not just get the string and print it
  7672.     lda    #$03        ; This is the index to the file-type we want
  7673. shmod1: tax            ; Hold this index
  7674.     lda    #kerftp\    ; Get the address if the file type strings
  7675.     sta    kermbs        ;
  7676.     lda    #kerftp^    ;
  7677.     sta    kermbs+1    ;
  7678.     lda    #kerfts        ; Get the string length
  7679.     pha            ; Push that
  7680.     txa            ; Fetch the index back
  7681.     pha            ; Push that parm then
  7682.     jsr    genmad        ;    call genmad
  7683.     jsr    prstr        ; Print the the string at that address
  7684.     jsr    prcrlf        ; Print a crelf after it
  7685.     rts
  7686.  
  7687. shfbs:  ldx    #shin17\    ; Get address of 'file-byte-size' string
  7688.     ldy    #shin17^
  7689.     jsr    prstr        ; Print that
  7690.     lda    fbsize        ; Get the file-type mode
  7691.     beq    shfbse        ; It is in eight-bit mode
  7692.     ldx    #shsbit\    ; Get address of 'SEVEN-BIT' string
  7693.     ldy    #shsbit^    ;
  7694.     jsr    prstr        ; Print that
  7695.     jsr    prcrlf        ;    then a crelf
  7696.     rts            ;    and return
  7697. shfbse: ldx    #shebit\    ; Get the address of 'EIGHT-BIT' string
  7698.     ldy    #shebit^    ;
  7699.     jsr    prstr        ; Print the the string at that address
  7700.     jsr    prcrlf        ; Print a crelf after it
  7701.     rts
  7702.  
  7703. shpari:    ldx    #shin20\    ; Get address of 'parity' string
  7704.     ldy    #shin20^    ;        ...
  7705.     jsr    prstr        ; Print that
  7706.     lda    parity        ; Get the parity index
  7707.     cmp    #$05        ; Is it >= 5?
  7708.     bmi    shpar1        ; If not just get the string and print it
  7709.     lda    #$00        ; This is the index to the parity we want
  7710. shpar1:    tax            ; Hold this index
  7711.     lda    #kerprs\    ; Get address of the parity strings
  7712.     sta    kermbs        ; And stuff it here for genmad
  7713.     lda    #kerprs^    ;        ...
  7714.     sta    kermbs+1    ;        ...
  7715.     lda    #kerpsl        ; Get the string length
  7716.     pha            ; Push that
  7717.     txa            ; Fetch the index back
  7718.     pha            ; Push that parm then
  7719.     jsr    genmad        ;    call genmad
  7720.     jsr    prstr        ; Print the the string at that address
  7721.     jsr    prcrlf        ; Print a crelf after it
  7722.     rts
  7723.  
  7724. shbad:    ldx    #shin19\    ;[17] Get the address of the 'baud' string
  7725.     ldy    #shin19^    ;[17]         ...
  7726.     jsr    prstr        ;[17] Print it
  7727.     lda    baud        ;[17] Get the baud rate
  7728.     cmp    #$08        ;[17] Is it >= 8 ?
  7729.     bmi    shbad1        ;[17] No, just print the string
  7730.     lda    #$04        ;[17] Use 300 baud as default
  7731. shbad1:    tax            ;[17] Hold the index here
  7732.     lda    #kerbds\    ;[17] Get the address of
  7733.     sta    kermbs        ;[17]    the baud rate strings
  7734.     lda    #kerbds^    ;[17]        ...
  7735.     sta    kermbs+1    ;[17]        ...
  7736.     lda    #kerbsl        ;[17] Get the length of the baud rate strings
  7737.     pha            ;[17] Push that
  7738.     txa            ;[17]
  7739.     pha            ;[17]
  7740.     jsr    genmad        ;[17]
  7741.     jsr    prstr        ;[17]
  7742.     jsr    prcrlf        ;[17]
  7743.     rts            ;[17]
  7744.  
  7745. shwrd:    ldx    #shin21\    ;[17] Get the address of the 'wrod-size'
  7746.     ldy    #shin21^    ;[17]    message
  7747.     jsr    prstr        ;[17] Print that
  7748.     lda    wrdsiz        ;[17] Get the word-size
  7749.     beq    shwrde        ;[17] 
  7750.     ldx    #shsbit\    ;[17] Get address of 'SEVEN-BIT' string
  7751.     ldy    #shsbit^    ;[17]        ...
  7752.     jsr    prstr        ;[17] Print that
  7753.     jsr    prcrlf        ;[17]    then a crelf
  7754.     rts            ;[17]    and return
  7755. shwrde:    ldx    #shebit\    ;[17] Get address of 'EIGHT-BIT' string
  7756.     ldy    #shebit^    ;[17]        ...
  7757.     jsr    prstr        ;[17] Print that
  7758.     jsr    prcrlf        ;[17]    and a crelf
  7759.     rts            ;[17]    and return
  7760.  
  7761. shflow:    ldx    #shin22\    ;[24]
  7762.     ldy    #shin22^    ;[24]
  7763.     jsr    prstr        ;[24]
  7764.     lda    flowmo        ;[24]
  7765.     jmp    pron        ;[24]
  7766.  
  7767.  
  7768. .SBTTL    Status routine
  7769.  
  7770. ;
  7771. ;    This routine shows the status of the most recent transmission
  7772. ;    session.
  7773. ;
  7774. ;        Input:  NONE
  7775. ;
  7776. ;        Output: Status of last transmission is sent to screen
  7777. ;
  7778. ;        Registers destroyed:    A,X,Y
  7779. ;
  7780.  
  7781. status: jsr    prcfm        ; Parse and print a confirm
  7782.     jsr    stat01        ;[45] Go Give the status
  7783.     jmp    kermit        ;[45]   and parse for more commands
  7784.  
  7785. stat01: ldx    #stin00\    ; Get address of first line of text
  7786.     ldy    #stin00^    ;        ...
  7787.     jsr    prstr        ; Print that
  7788.     lda    schr        ; Get low order byte of character count
  7789.     tax            ; Put that in x
  7790.     lda    schr+1        ; Get high order byte
  7791.     jsr    prntax        ; Print that pair in hex
  7792.     jsr    prcrlf        ; Add a crelf at the end
  7793.     ldx    #stin01\    ; Get address of second line
  7794.     ldy    #stin01^    ;        ....
  7795.     jsr    prstr        ; Print it
  7796.     lda    rchr        ; Get L.O. byte of char count
  7797.     tax            ; Stuff it here for the call
  7798.     lda    rchr+1        ; Get H.O. byte
  7799.     jsr    prntax        ; Print that count
  7800.     jsr    prcrlf        ; Add a crelf at the end
  7801.     ldx    #stin02\    ; Get L.O. address of message
  7802.     ldy    #stin02^    ;
  7803.     jsr    prstr        ; Print message
  7804.     lda    stot        ; Get L.O. byte of count
  7805.     tax            ; Save it
  7806.     lda    stot+1        ; Get H.O. byte
  7807.     jsr    prntax        ; Print the count
  7808.     jsr    prcrlf        ; Add a crelf at the end
  7809.     ldx    #stin03\    ; Get address of next status item message
  7810.     ldy    #stin03^
  7811.     jsr    prstr        ; Print it
  7812.     lda    rtot        ; Get the proper count (L.O. byte)
  7813.     tax            ; Hold it here for the call
  7814.     lda    rtot+1        ; Get H.O. byte
  7815.     jsr    prntax        ; Print the 16-bit count
  7816.     jsr    prcrlf        ; Add a crelf at the end
  7817.     jsr    prcrlf        ; Add a crelf at the end
  7818.     ldx    #stin04\    ; Get address of overhead message
  7819.     ldy    #stin04^    ;
  7820.     jsr    prstr        ; Print that message
  7821.     sec            ; Get ready to calculate overhead amount
  7822.     lda    stot        ; Get total character count and
  7823.     sbc    schr        ;    subtract off data character count
  7824.     tax            ; Stuff that here for printing
  7825.     lda    stot+1
  7826.     sbc    schr+1
  7827.     jsr    prntax        ; Print it
  7828.     jsr    prcrlf        ; Add a crelf at the end
  7829.     ldx    #stin05\    ; Get address of next overhead message
  7830.     ldy    #stin05^    ;        ...
  7831.     jsr    prstr        ; Print that
  7832.     sec            ; Get ready to calculate overhead amount
  7833.     lda    rtot        ; Get total character count and
  7834.     sbc    rchr        ;    subtract off data character count
  7835.     tax            ; Stuff that here for printing
  7836.     lda    rtot+1        ;        ...
  7837.     sbc    rchr+1        ;        ...
  7838.     jsr    prntax        ; Print the count
  7839.     jsr    prcrlf        ; Add a crelf at the end
  7840.     jsr    prcrlf        ; Add a crelf at the end
  7841.     lda    errcod        ; check and see if there even is an error
  7842.     beq    stat04
  7843.     ldx    #stin06\      ; Get message for 'last error'
  7844.     ldy    #stin06^    ;        ...
  7845.     jsr    prstr        ; Print the message
  7846.     jsr    prcrlf        ; Print a crelf before the error message
  7847.     bit    errcod        ; Test for 'Error packet received' bit
  7848.     bpl    stat02
  7849.     bvs    statpe        ; Go process an error packet
  7850.     bpl    stat02
  7851.     ldx    #erms0a\    ; this is a dos error.
  7852.     ldy    #erms0a^
  7853.     jsr    prstr
  7854.     ldx    #dskers\
  7855.     ldy    #dskers^
  7856.     jsr    prstr
  7857.     jsr    prcrlf
  7858.     rts
  7859. stat02:    lda    #kerems        ; Get the error message size
  7860.     pha            ; Push it
  7861.     lda    errcod        ; Get the error message offset in table
  7862.     pha            ; Push that parameter
  7863.     lda    #erms0a\    ; Use 'dskers' as the base address
  7864.     sta    kermbs        ;        ...
  7865.     lda    #erms0a^    ;        ...
  7866.     sta    kermbs+1    ;        ...
  7867. statle:    jsr    genmad        ; Translate code to address of message
  7868.     jsr    prstr        ; Print the text of error message
  7869.     jsr    prcrlf        ; Add a crelf at the end
  7870. ;    jmp    kermit        ; Start at the top
  7871.     rts            ;[45] Return to the caller
  7872. statpe:    ldx    #errrkm\    ; L.O. byte address of remote kermit error
  7873.     ldy    #errrkm^    ; H.O. byte address...
  7874.     jsr    prstr        ; Print the text from the error packet
  7875.     jsr    prcrlf        ; Print an extra crelf
  7876. ;    jmp    kermit        ; Start at the top again
  7877. stat04:    rts            ;[45] Return to the caller
  7878.  
  7879. .SBTTL    Packet routines - SPAK - send packet
  7880.  
  7881. ;
  7882. ;    This routine forms and sends out a complete packet in the
  7883. ;    following format:
  7884. ;
  7885. ;    <SOH><char(pdlen)><char(pnum)><ptype><data><char(chksum)><eol>
  7886. ;
  7887. ;        Input:  kerbf1- Pointer to packet buffer
  7888. ;            pdlen-  Length of data
  7889. ;            pnum-    Packet number
  7890. ;            ptype-  Packet type
  7891. ;
  7892. ;        Output: A-    True or False return code
  7893. ;
  7894.  
  7895. spak:    lda    fast        ; do this in fast mode if we can
  7896.     sta    $d030
  7897.     jsr    scrclr        ; clear the screen
  7898.     ldx    #snin01\    ; Give the user info on what we are doing
  7899.     ldy    #snin01^    ;        ...
  7900.     jsr    prstr        ; Print the information
  7901.     ldx    #false        ;[49]
  7902.     jsr    timset        ;[49]
  7903.     lda    tpak+1        ; Get the total packets count
  7904.     jsr    prbyte        ;    and print that
  7905.     lda    tpak        ;        ...
  7906.     jsr    prbyte        ;        ...
  7907.     jsr    prcrlf        ; Output a crelf
  7908.     lda    #$00        ; Clear packet data index
  7909.     sta    pdtind        ;        ...
  7910. spaknd: lda    spadch        ; Get the padding character
  7911.     ldx    #$00        ; Init counter
  7912. spakpd: cpx    spad        ; Are we done padding?
  7913.     bcs    spakst        ;  Yes, start sending packet
  7914.     inx            ; No, up the index and count by one
  7915.     jsr    putplc        ; Output a padding character
  7916.     jmp    spakpd        ; Go around again
  7917. spakst: lda    #soh        ; Get the start-of-header char into AC
  7918.     jsr    putplc        ; Send it
  7919.     lda    pdlen        ; Get the data length
  7920.     clc            ; Clear the carry
  7921.     adc    #$03        ; Adjust it
  7922.     pha            ; Save this to be added into stot
  7923.     clc            ; Clear carry again
  7924.     adc    #sp        ; Make the thing a character
  7925.     sta    chksum        ; First item,  start off chksum with it
  7926.     jsr    putplc        ; Send the character
  7927.     pla            ; Fetch the pdlen and add it into the
  7928.     clc            ;    'total characters sent' counter
  7929.     adc    stot        ;        ...
  7930.     sta    stot        ;        ...
  7931.     lda    stot+1        ;        ...
  7932.     adc    #$00        ;        ...
  7933.     sta    stot+1        ;        ...
  7934.     lda    pnum        ; Get the packet number
  7935.     clc            ;        ...
  7936.     adc    #sp        ; Char it
  7937.     pha            ; Save it in this condition
  7938.     clc            ; Clear carry
  7939.     adc    chksum        ; Add this to the checksum
  7940.     sta    chksum        ;        ...
  7941.     pla            ; Restore character
  7942.     jsr    putplc        ; Send it
  7943.     lda    ptype        ; Fetch the packet type
  7944.     and    #$7f        ; Make sure H.O. bit is off for chksum
  7945.     pha            ; Save it on stack
  7946.     clc            ; Add to chksum
  7947.     adc    chksum        ;        ...
  7948.     sta    chksum        ;        ...
  7949.     pla            ; Get the original character off stack
  7950.     jsr    putplc        ; Send packet type
  7951.     ldy    #$00        ; Initialize data count
  7952.     sty    datind        ; Hold it here
  7953. spaklp: ldy    datind        ; Get the current index into the data
  7954.     cpy    pdlen        ; Check against packet data length, done?
  7955.     bmi    spakdc        ; Not yet, process another character
  7956.     jmp    spakch        ; Go do chksum calculations
  7957. spakdc: lda    (kerbf1),y    ; Fetch data from packet buffer
  7958.     clc            ; Add the character into the chksum
  7959.     adc    chksum        ;        ...
  7960.     sta    chksum        ;        ...
  7961.     lda    (kerbf1),y    ; Refetch data from packet buffer
  7962.     jsr    putplc        ; Send it
  7963.     inc    datind        ; Up the counter and index
  7964.     jmp    spaklp        ; Loop to do next character
  7965. spakch: lda    chksum        ; Now, adjust the chksum to fit in 6 bits
  7966.     and    #$c0        ; First, take bits 6 and 7
  7967.     lsr    a        ;    and shift them to the extreme right
  7968.     lsr    a        ;    side of the AC
  7969.     lsr    a        ;        ...
  7970.     lsr    a        ;        ...
  7971.     lsr    a        ;        ...
  7972.     lsr    a        ;        ...
  7973.     clc            ; Now add in the original chksum byte
  7974.     adc    chksum        ;        ...
  7975.     and    #$3f        ; All this should be mod decimal 64
  7976.     clc            ;        ...
  7977.     adc    #sp        ; Put it in printable range
  7978.     jsr    putplc        ;    and send it
  7979.     lda    seol        ; Fetch the eol character
  7980.     jsr    putplc        ; Send that as the last byte of the packet
  7981.     lda    pdtind        ; Set the end of buffer pointer
  7982.     sta    pdtend        ;        ...
  7983.     lda    #$00        ; Set index to zero
  7984.     sta    pdtind        ;        ...
  7985.     lda    debug        ; Is the debug option turned on?
  7986.     cmp    #off        ;        ...
  7987.     beq    spaksp        ; Nope, go stuff packet at other kermit
  7988.     lda    #$00        ; Option 0
  7989.     jsr    debg        ; Do it
  7990. spaksp: lda    #$00        ; Zero the index
  7991.     sta    pdtind        ;        ...
  7992. spakdl: ldx    pdtind        ; Are we done?
  7993.     cpx    pdtend        ;        ...
  7994.     bpl    spakcd        ; Yes, go call debug again
  7995.     lda    plnbuf,x    ; Get the byte to send
  7996.     jsr    putrs        ; Ship it out
  7997.     inc    pdtind        ; Increment the index once
  7998.     jmp    spakdl        ; Go to top of data send loop
  7999. spakcd: lda    debug        ; Get debug switch
  8000.     cmp    #off        ; Do we have to do it?
  8001.     beq    spakcr        ; Nope, return
  8002.     lda    #$01        ; Option 1
  8003.     jsr    debg        ; Do the debug stuff
  8004. spakcr:    lda    #$fc        ; leave fast mode
  8005.     sta    $d030
  8006.     rts            ;    and return
  8007.  
  8008. .SBTTL    Packet routines - RPAK - receive a packet
  8009.  
  8010. ;
  8011. ;    This routine receives a standard Kermit packet and then breaks
  8012. ;    it apart returning the individuals components in their respective
  8013. ;    memory locations.
  8014. ;
  8015. ;        Input:
  8016. ;
  8017. ;        Output: kerbf1- Pointer to data from packet
  8018. ;            pdlen-  Length of data
  8019. ;            pnum-    Packet number
  8020. ;            ptype-  Packet type
  8021. ;
  8022.  
  8023. rpak:    lda    fast        ; put us in fast mode, if possible
  8024.     sta    $d030
  8025.     ldx #true
  8026.     jsr timset
  8027.     jsr    gobble        ; Gobble a line up from the port
  8028.     jmp    rpkfls        ; Must have gotten a keyboard interupt, fail
  8029.     lda    ibmmod        ; Is ibm-mode on?
  8030.     cmp    #on        ;        ...
  8031.     bne    rpakst        ; If not, start working on the packet
  8032. rpakc0:    jsr    getc        ; Any characters yet?
  8033.     jmp    rpakst        ; Got one from the keyboard
  8034.     lda    char        ;[31]
  8035.     cmp    #xon        ; Is it an XON?
  8036.     bne    rpakc0        ; Nope, try again
  8037. rpakst:    jsr    scrclr        ; clear the screen
  8038.     ldx    #rcin01\     ; Give the user info on what we are doing
  8039.     ldy    #rcin01^    ;        ...
  8040.     jsr    prstr        ; Print the information
  8041.     ldx    #true        ;[49]
  8042.     jsr    timset        ;[49] Set the timeout length
  8043.     lda    tpak+1        ; Get the total packets count
  8044.     jsr    prbyte        ;    and print that
  8045.     lda    tpak        ;        ...
  8046.     jsr    prbyte        ;        ...
  8047.     jsr    prcrlf        ; Output a crelf
  8048.     lda    debug        ; Is debugging on?
  8049.     cmp    #off        ;        ...
  8050.     beq    rpaknd        ;  Nope, no debugging, continue
  8051.     lda    #$02        ; Option 2 <reflect the fact we are in rpak>
  8052.     jsr    debg        ; Do debug stuff
  8053. rpaknd: lda    #$00        ; Clear the
  8054.     sta    chksum        ;    chksum
  8055.     sta    datind        ;    index into packet buffer
  8056.     sta    kerchr        ;    and the current character input
  8057. rpakfs: jsr    getplc        ; Get a char, find SOH
  8058.      jmp    rpkfls        ; Got a keyboard interupt instead
  8059.     sta    kerchr        ; Save it
  8060.     and    #$7f        ; Shut off H.O. bit
  8061.     cmp    #soh        ; Is it an SOH character?
  8062.     bne    rpakfs        ; Nope, try again
  8063.     lda    #$01        ; Set up the switch for receive packet
  8064.     sta    fld        ;        ...
  8065. rpklp1: lda    fld        ; Get switch
  8066.     cmp    #$06        ; Compare for <= 5
  8067.     bmi    rpklp2        ; If it still is, continue
  8068.     jmp    rpkchk        ; Otherwise, do the chksum calcs
  8069. rpklp2: cmp    #$05        ; Check fld
  8070.     bne    rpkif1        ; If it is not 5, go check for SOH
  8071.     lda    datind        ; Fetch the data index
  8072.     cmp    #$00        ; If the data index is not null
  8073.     bne    rpkif1        ;    do the same thing
  8074.     jmp    rpkif2        ; Go process the character
  8075. rpkif1: jsr    getplc        ; Get a char, find SOH
  8076.      jmp    rpkfls        ; Got a keyboard interupt instead
  8077.     sta    kerchr        ; Save that here
  8078.     and    #$7f        ; Make sure H.O. bit is off
  8079.     cmp    #soh        ; Was it another SOH?
  8080.     bne    rpkif2        ; If not, we don't have to resynch
  8081.     lda    #$00        ; Yes, resynch
  8082.     sta    fld        ; Reset the switch
  8083. rpkif2: lda    fld        ; Get the field switch
  8084.     cmp    #$04        ; Is it < = 3?
  8085.     bpl    rpkswt        ; No, go check the different cases now
  8086.     lda    kerchr        ; Yes, it was, get the character
  8087.     clc            ;    and add it into the chksum
  8088.     adc    chksum        ;        ...
  8089.     sta    chksum        ;        ...
  8090. rpkswt: lda    fld        ; Now check the different cases of fld
  8091.     cmp    #$00        ; Case 0?
  8092.     bne    rpkc1        ; Nope, try next one
  8093.     lda    #$00        ; Yes, zero the chksum
  8094.     sta    chksum        ;        ...
  8095.     jmp    rpkef        ;    and restart the loop
  8096. rpkc1:  cmp    #$01        ; Is it case 1?
  8097.     bne    rpkc2        ; No, continue checking
  8098.     lda    kerchr        ; Yes, get the length of packet
  8099.     sec            ;        ...
  8100.     sbc    #sp        ; Unchar it
  8101.     sec            ;        ...
  8102.     sbc    #$03        ; Adjust it down to data length
  8103.     sta    pdlen        ; That is the packet data length, put it there
  8104.     jmp    rpkef        ; Continue on to next item
  8105. rpkc2:  cmp    #$02        ; Case 2 (packet number)?
  8106.     bne    rpkc3        ; If not, try case 3
  8107.     lda    kerchr        ; Fetch the character
  8108.     sec            ;        ...
  8109.     sbc    #sp        ; Take it down to what it really is
  8110.     sta    pnum        ; That is the packet number, save it
  8111.     jmp    rpkef        ; On to the next packet item
  8112. rpkc3:  cmp    #$03        ; Is it case 3 (packet type)?
  8113.     bne    rpkc4        ; If not, try next one
  8114.     lda    kerchr        ; Get the character and
  8115.     sta    ptype        ;    stuff it as is into the packet type
  8116.     jmp    rpkef        ; Go on to next item
  8117. rpkc4:  cmp    #$04        ; Is it case 4???
  8118.     bne    rpkc5        ; No, try last case
  8119.     ldy    #$00        ; Set up the data index
  8120.     sty    datind        ;        ...
  8121. rpkchl: ldy    datind        ; Make sure datind is in Y
  8122.     cpy    pdlen        ; Compare to the packet data length, done?
  8123.     bmi    rpkif3        ; Not yet, process the character as data
  8124.     jmp    rpkef        ; Yes, go on to last field (chksum)
  8125. rpkif3: cpy    #$00        ; Is this the first time through the data loop?
  8126.     beq    rpkacc        ; If so, SOH has been checked, skip it
  8127.     jsr    getplc        ; Get a char, find SOH
  8128.      jmp    rpkfls        ; Got a keyboard interupt instead
  8129.     sta    kerchr        ; Store it here
  8130.     and    #$7f        ; Shut H.O. bit
  8131.     cmp    #soh        ; Is it an SOH again?
  8132.     bne    rpkacc        ; No, go accumulate chksum
  8133.     lda    #$ff        ; Yup, SOH, go resynch packet input once again
  8134.     sta    fld        ;        ...
  8135.     jmp    rpkef        ;        ...
  8136. rpkacc: lda    kerchr        ; Get the character
  8137.     clc            ;        ...
  8138.     adc    chksum        ; Add it to the chksum
  8139.     sta    chksum        ;    and save new chksum
  8140.     lda    ptype        ; GROSS AND UGLY KLUDGE FOR CKERMIT
  8141.     and    #$7f        ;     ignore any data in an ack packet.
  8142.     cmp    #'Y        ;     Ckermit puts funny things in an F ack.
  8143.     bne    ckrmt1        ;     These bytes overwrite our next packet.
  8144.     lda    state        ;     ... but not while expecting an init
  8145.     cmp    #'R        ;     .... while receiving a file
  8146.     bne    ckrmt2
  8147. ckrmt1:    lda    kerchr        ; Get the character again
  8148.     ldy    datind        ; Get our current data index
  8149.     sta    (kerbf1),y    ; Stuff the current character into the buffer
  8150. ckrmt2:    inc    datind        ; Up the index once
  8151.     jmp    rpkchl        ; Go back and check if we have to do this again
  8152. rpkc5:  cmp    #$05        ; Last chance, is it case 5?
  8153.     beq    rpkc51        ; Ok, continue
  8154.     jmp    rpkpe        ; Warn user about program error
  8155. rpkc51: lda    chksum        ; Do chksum calculations
  8156.     and    #$c0        ; Grab bits 6 and 7
  8157.     lsr    a        ; Shift them to the right (6 times)
  8158.     lsr    a        ;        ...
  8159.     lsr    a        ;        ...
  8160.     lsr    a        ;        ...
  8161.     lsr    a        ;        ...
  8162.     lsr    a        ;        ...
  8163.     clc            ; Clear carry for addition
  8164.     adc    chksum        ; Add this into original chksum
  8165.     and    #$3f        ; Make all of this mod decimal 64
  8166.     sta    chksum        ;    and resave it
  8167. rpkef:  inc    fld        ; Now increment the field switch
  8168.     jmp    rpklp1        ; And go check the next item
  8169. rpkchk: lda    kerchr        ; Get chksum from packet
  8170.     sec            ; Set carry for subtraction
  8171.     sbc    #sp        ; Unchar it
  8172.     cmp    chksum        ; Compare it to the one this Kermit generated
  8173.     beq    rpkret        ; We were successful, tell the caller that
  8174.     lda    #$06        ; Store the error code
  8175.     sta    errcod        ;        ...
  8176.     ldx    #erms15\    ; Create pointer to error text
  8177.     ldy    #erms15^    ;
  8178.     jsr    prstr        ; Print the chksum error
  8179.     lda    kerchr        ; Print chksum from packet
  8180.     jsr    prbyte        ;        ...
  8181.     lda    #sp        ; Space things out a bit
  8182.     jsr    cout        ;        ...
  8183.     lda    chksum        ; Now get what we calculated
  8184.     jsr    prbyte        ;    and print that
  8185. rpkfls:    lda    #$00        ; Zero the index for debug mode
  8186.     sta    pdtind        ;        ...
  8187.     lda    debug        ; Is debug switch on?
  8188.     cmp    #off        ;        ...
  8189.     beq    rpkfnd        ;  Return doing no debug stuff
  8190.     lda    #$03        ; Option 3 <we are in rpkfls>
  8191.     jsr    debg        ; Output debug information
  8192. rpkfnd: lda    pdlen        ; Get the packet data length
  8193.     clc            ;    and add it into the
  8194.     adc    rtot        ;    'total characters received' counter
  8195.     sta    rtot        ;        ...
  8196.     lda    rtot+1        ;        ...
  8197.     adc    #$00        ;        ...
  8198.     sta    rtot+1        ;        ...
  8199.     lda    #$fc        ; exit fast mode
  8200.     sta    $d030
  8201.     lda    #false        ; Set up failure return
  8202.     sta    ptype        ;[DD] Set packet type false
  8203.     rts            ;    and go back
  8204. rpkret:    lda    #$00        ; Zero the index for debug mode
  8205.     sta    pdtind        ;        ...
  8206.     lda    debug        ; Check debug switch
  8207.     cmp    #off        ; Is it on?
  8208.     beq    rpkrnd        ; No, return with no debug
  8209.     lda    #$04        ; Yes, use option 4 <we received a packet>
  8210.     jsr    debg        ; Print out the debug info
  8211. rpkrnd: lda    pdlen        ; Get the packet data length
  8212.     clc            ;    and add it into the
  8213.     adc    rtot        ;    'total characters received' counter
  8214.     sta    rtot        ;        ...
  8215.     lda    rtot+1        ;        ...
  8216.     adc    #$00        ;        ...
  8217.     sta    rtot+1        ;        ...
  8218.     lda    #$fc        ; turn off fast mode
  8219.     sta    $d030
  8220.     lda    #true        ; Show a successful return
  8221.     rts            ;    and return
  8222. rpkpe:  ldx    #erms16\    ; Set up pointer to error text
  8223.     ldy    #erms16^    ;        ...
  8224.     jsr    prstr        ; Print the error
  8225.     lda    #$07        ; Load error code and store in errcod
  8226.     sta    errcod        ;        ...
  8227.     jmp    rpkfls        ; Go give a false return
  8228.  
  8229. .SBTTL    Timset and Timout
  8230.  
  8231. ;
  8232. ;    Routines to set and check for Kermit timeouts
  8233. ;
  8234.  
  8235. ;
  8236. ;    Timset - Set the timeout for receive or send
  8237. ;
  8238. ;    Input:    X - True for receive, false for send
  8239. ;
  8240. ;    Registers Detsroyed: A
  8241. ;
  8242. timset: txa
  8243.         pha
  8244.         tya
  8245.         pha
  8246.         lda #$00
  8247.         pha
  8248.         cpx #true        ; If X is true we are doing recieve timeout
  8249.         bne timsst        ; Else we are doing send timeout
  8250.         lda rtime         
  8251.         jmp timfig
  8252. timsst:
  8253.         lda stime
  8254. timfig:
  8255.         clc                ;    Multiple timeout by 60
  8256.         pha             ;    Multiple routine you push two values to multiply
  8257.         lda #$00
  8258.         pha
  8259.         lda #$3c        ;   The stack will hold high-byte/low-byte after
  8260.                         ;   Multiply is over
  8261.         pha
  8262.         jsr ml16
  8263.         clc                ;   Add the computed number of jiffies (seconds
  8264.                         ;   times 60) to the current clock to compute
  8265.                         ;   When the timeout is up
  8266.         sei                ;   Don't bother us we are BUSY
  8267.         pla                ;   Low byte of time out
  8268.         clc
  8269.         adc clock+2
  8270.         sta ttime+2
  8271.         lda clock+1
  8272.         adc #$00
  8273.         sta ttime+1
  8274.         lda clock
  8275.         adc #$00
  8276.         sta ttime
  8277.         clc
  8278.         pla        ; get high byte
  8279.         clc
  8280.         adc ttime+1
  8281.         sta ttime+1
  8282.         lda ttime
  8283.         adc #$00
  8284.         sta ttime
  8285.         cli                
  8286.         pla
  8287.         tay
  8288.         pla
  8289.         tax
  8290.         rts        
  8291.  
  8292. ;
  8293. ;    Timout - Check to see if we have exceeded the timeout limit.
  8294. ;
  8295. ;    Input:  Ttim - time to timeout at
  8296. ;        Clock+1 - current time
  8297. ;
  8298. ;    Registers Destroyed: A
  8299. ;
  8300.  
  8301. timout:    sei            ; Cause commodore does it.
  8302.     lda    clock        ; Get the high jiffy
  8303.     cmp    ttime        ; Compare it to the new high jiffy
  8304.     bmi    timskp        ; Still less
  8305.     lda    clock+1        ; Get the middle jiffy
  8306.     cmp    ttime+1        ; Compare it to the new middle jiffy
  8307.     bmi    timskp        ; Still less 
  8308.     lda clock+2        ; Get the low jiffy
  8309.     cmp ttime+2        ; Compate it to the new low jiffy
  8310.     bmi timskp        ; Still less
  8311. timret:    cli
  8312.         rts            ; We have timed out, return
  8313. timskp:    cli
  8314.         jmp    rskp    ; No timeout, return with a skip
  8315.  
  8316. .SBTTL    DEBG - debugging output routines
  8317.  
  8318. ;
  8319. ;    When the debugging option is turned on, these routines periodically
  8320. ;    display information about what data is being sent or received.
  8321. ;
  8322. ;        Input:  A-    Action type
  8323. ;            Ptype-  Packet type sent or received
  8324. ;            Pnum-    Packet number sent or received
  8325. ;            Pdlen-  Packet data length
  8326. ;
  8327. ;        Output: Display info on current packet status
  8328. ;
  8329. ;        Registers destroyed:    A,X,Y
  8330. ;
  8331.  
  8332. debg:    tax            ; Hold the action code here
  8333.     sta    debinx        ; Save it here
  8334.     lda    debug        ; Get the debug switch
  8335.     cmp    #terse        ; Is it terse
  8336.     bne    debgvr        ; Nope, must be Verbose mode
  8337.     jmp    debgtr        ; Yes, to terse debug output
  8338. debgvr:    lda    state        ; Check the current state
  8339.     cmp    #$00        ; If we just started this thing
  8340.     beq    debgrf        ;    then we don't need debug output yet
  8341.     cmp    #'C        ; If the transmission state is 'complete'
  8342.     beq    debgrf        ;    we don't need debug output either
  8343.     lda    #kerrts\    ; Get base address of the routine name and
  8344.     sta    kermbs        ;    action table so that we can calculate
  8345.     lda    #kerrts^    ;        ...
  8346.     sta    kermbs+1    ;        ...
  8347.     lda    #kerrns        ; Load the routine name size
  8348.     pha            ; Push that
  8349.     txa            ; Fetch the offset for the one we want
  8350.     pha            ; And push that parameter
  8351.     jsr    genmad        ; Go generate the message address
  8352.     jsr    prstr        ; Now, go print the string
  8353.     lda    ptype        ; Get the current packet type
  8354.     pha            ; Save this accross the routine calls
  8355.     jsr    cout        ; Write that out
  8356.     jsr    prcrlf        ; Now write a crelf
  8357.     pla            ; Get back the packet type
  8358.     sta    debchk        ;    and start the checksum with that
  8359.     lda    debinx        ; Get the debug action index
  8360.     bne    debg1        ; If not 'sending', continue
  8361.     jsr    debprd        ; Yes, go do some extra output
  8362. debg1:  cmp    #$04        ; Have we just received a packet?
  8363.     bne    debgrt        ; No, just return
  8364.     jsr    debprd        ; Print the packet info
  8365. debgrt: lda    #true        ; Load true return code into AC
  8366.     rts            ;    and return
  8367. debgrf: lda    #false        ; Set up failure return
  8368.     rts            ;    and go back
  8369.  
  8370. ;
  8371. ;    Debprd - does special information output including packet number,
  8372. ;    packet data length, the entire packet buffer, and the checksum
  8373. ;    of the packet as calculted by this routine.
  8374. ;
  8375.  
  8376. debprd: jsr    prcrlf        ; Start by giving us a new line
  8377.     ldx    #debms1\    ; Get the first info message address
  8378.     ldy    #debms1^    ;        ...
  8379.     jsr    prstr        ;    and print it
  8380.     jsr    prcrlf        ; New line
  8381.     ldx    #debms3\    ; Get address of message text
  8382.     ldy    #debms3^    ;        ...
  8383.     jsr    prstr        ; Print it
  8384.     inc    pdtind        ; Pass the SOH
  8385.     ldx    pdtind        ; Get the index
  8386.     lda    plnbuf,x    ; Get the data length
  8387.     sec            ; Uncharacter this value
  8388.     sbc    #$20        ;        ...
  8389.     jsr    prbyte        ; Print the hex value
  8390.     jsr    prcrlf        ; New line
  8391.     ldx    #debms2\    ; Get address of message text
  8392.     ldy    #debms2^    ;        ...
  8393.     jsr    prstr        ; Print it
  8394.     inc    pdtind        ; Next character is packet number
  8395.     ldx    pdtind        ;        ...
  8396.     lda    plnbuf,x    ; Load it
  8397.     sec            ; Uncharacter this value
  8398.     sbc    #$20        ;        ...
  8399.     jsr    prbyte        ; Print the hex value
  8400.     jsr    prcrlf        ; New line
  8401.     inc    pdtind        ; Bypass the packet type
  8402.     ldy    #$ff        ; Start counter at -1
  8403.     sty    kwrk02        ; Store it here
  8404. debprc:    inc    kwrk02        ; Increment the counter
  8405.     ldy    kwrk02        ; Get counter
  8406.     cpy    pdlen        ; Are we done printing the packet data?
  8407.     bpl    debdon        ; If so, go finish up
  8408.     inc    pdtind        ; Point to next character
  8409.     ldx    pdtind        ; Fetch the index
  8410.     lda    plnbuf,x    ; Get next byte from packet
  8411.     jsr    prchr        ; Go output special character
  8412.     lda    #space        ; Now print 1 space
  8413.     jsr    cout        ;        ...
  8414.     jmp    debprc        ; Go check next character
  8415. debdon:    jsr    prcrlf        ; Next line
  8416.     ldx    #debms4\    ; Get the address to the 'checksum' message
  8417.     ldy    #debms4^    ;        ...
  8418.     jsr    prstr        ; Print that message
  8419.     inc    pdtind        ; Get next byte, this is the checksum
  8420.     ldx    pdtind        ;        ...
  8421.     lda    plnbuf,x    ;        ...
  8422.     sec            ; Uncharacter this value
  8423.     sbc    #$20        ;        ...
  8424.     jsr    prbyte        ; Print the hex value of the checksum
  8425.     jsr    prcrlf        ; Print two(2) crelfs
  8426.     jsr    prcrlf        ;        ...
  8427.     rts            ;    and return
  8428.  
  8429. .SBTTL    Terse debug output
  8430.  
  8431. ;
  8432. ;    This routine does brief debug output. It prints only the contents
  8433. ;    of the packet with no identifying text.
  8434. ;
  8435.  
  8436. debgtr:    txa            ; Look at Option
  8437.     cmp    #$00        ; Sending?
  8438.     beq    debgsn        ; Yes, output 'SENDING: '
  8439.     cmp    #$03        ; Failed receive?
  8440.     beq    debgrc        ; Yes, output 'RECEIVED: '
  8441.     cmp    #$04        ; Receive?
  8442.     beq    debgrc        ; Yes, output 'RECEIVED: '
  8443.     rts            ; Neither, just return
  8444. debgsn:    ldx    #sstrng\    ; Get ready to print the string
  8445.     ldy    #sstrng^    ;        ...
  8446.     jsr    prstr        ; Do it!
  8447.     jsr    prcrlf        ; Print a crelf
  8448.     jmp    debgdp        ; Go dump the packet
  8449. debgrc:    ldx    #rstrng\    ; Get ready to print the string
  8450.     ldy    #rstrng^    ;        ...
  8451.     jsr    prstr        ; Do it!
  8452.     jsr    prcrlf        ; Print a crelf
  8453. debgdp:    ldx    pdtind        ; Get index
  8454.     cpx    pdtend        ; Are we done?
  8455.     bpl    debgfn        ; Yes, return
  8456.     lda    plnbuf,x    ; Get the character
  8457.     jsr    prchr        ; Print it
  8458.     lda    #space        ; Print a space
  8459.     jsr    cout        ;        ...
  8460.     inc    pdtind        ; Advance the index
  8461.     jmp    debgdp        ; Do next character
  8462. debgfn:    jsr    prcrlf        ; Print a crelf then...
  8463.     rts            ;    Return
  8464.  
  8465. .SBTTL    Dos routines
  8466.  
  8467. ;
  8468. ;    These routines handle files and calls to the DOS
  8469. ;
  8470.  
  8471. ;
  8472. ;    This routine opens a file for either input or output. If it
  8473. ;    opens it for output, and the file exists, and file-warning is
  8474. ;    on, the routine will issue a warning and attempt to modify
  8475. ;    the filename so that it is unique.
  8476. ;
  8477. ;        Input:    A- Fncrea - open for read
  8478. ;               Fncwrt - open for write
  8479. ;
  8480. ;        Output:    File is opened or error is issued
  8481. ;
  8482.  
  8483. openf:  sta    flsrw          ;[DD] Save mode  w or r
  8484. ;     openm    #15,#8,#15,fcmd,#2    ;[DD] Open error channel
  8485.     lda    #15        ; [53]
  8486.     ldx    workdri
  8487.     ldy    #15
  8488.     jsr    setlfs
  8489.     ldx    #fcmd\
  8490.     ldy    #fcmd^
  8491.     lda    #2
  8492.     jsr    setnam
  8493.     jsr    open
  8494.  
  8495.     jsr readst
  8496.     and #$80
  8497.     beq opnok
  8498.     jmp opfail
  8499.  
  8500. opnok
  8501.     lda    flsrw        ;[23] Get the file mode
  8502.     cmp    #fncwrt        ;[23] Are we opening for output?
  8503.     bne    opnnlu        ;[23] No, no lookup needed
  8504.     lda    #on        ;[23] Yes, set the 'first mod' switch
  8505.     sta    dosffm        ;[23]    in case we have to alter the filename
  8506.     lda    filwar        ;[23] Get the file warning switch
  8507.     cmp    #on        ;[23] Is it on?
  8508.     bne    opnnlu        ;[23] If not, don't do the lookup
  8509. opnlu:    jsr    lookup        ;[23] Do the lookup
  8510.      jmp    opnnlu        ;[23] Suceeded, open the file
  8511.     lda    dosffm        ;[23] Is this the first time through?
  8512.     cmp    #on        ;[23]        ...
  8513.     bne    opnalt        ;[23] If not, continue
  8514.     ldx    #erms1a\    ;[23] Otherwise, print an error message since
  8515.     ldy    #erms1a^    ;[23]    the file already exists
  8516.     jsr    prstr        ;[23]        ...
  8517. opnalt:    jsr    alterf        ;[23] No good, go alter the filename
  8518.     jmp    opnlu        ;[23] Try the lookup again
  8519. opnnlu:    jsr    bldprm        ;[23] Build the filename again
  8520. ;     openm    #8,#8,#8,primfn,len    ;[DD] Open file without lookup
  8521.     lda    #8        ; [53]
  8522.     ldx    workdri
  8523.     ldy    #8
  8524.     jsr    setlfs
  8525.     ldx    #primfn\
  8526.     ldy    #primfn^
  8527.     lda    len
  8528.     jsr    setnam
  8529.     jsr    open
  8530.  
  8531. opnfi1:    jsr    rddsk          ;[DD] Get disk status
  8532.     cmp    #00        ;[DD] Is it 0?
  8533.     bne      opfail         ;[DD] If not, error
  8534.     sta    eodind        ;[DD] Clear end of dat flag
  8535. opnex:  lda    #true        ;[DD] The open worked, return true
  8536.     rts            ;[DD]        ...
  8537. opfail: jmp    fatal        ;[DD] Failed, go handle that
  8538. ;    rts            ;[DD]        ...
  8539.  
  8540.  
  8541. ;
  8542. ;    Lookup - searches for a filename in a directory. It is used to
  8543. ;    support file warning during the opening of a file.
  8544. ;
  8545.  
  8546. lookup:    lda    #fncrea        ;[23] Get an 'R
  8547.     sta    flsrw        ;[23] Store it in the file mode switch
  8548.     jsr    locent        ;[23] Go try to locate that file
  8549.      jmp    locfnf        ;[23] File not found? We are in good shape
  8550.     lda    #errfae        ;[23] Store the error code
  8551.     sta    errcod        ;[23]        ...
  8552.     jmp    rskp        ;[23] Return with skip, have to alter filename
  8553. locfnf:    lda    #fncwrt        ;[23] Get a 'W
  8554.     sta    flsrw        ;[23] Store that
  8555.     rts            ;[23] Return without a skip
  8556.  
  8557. ;
  8558. ;    Alterf - changes a filename in the filename buffer to make it unique.
  8559. ;    It accomplishes this in the following manner.
  8560. ;
  8561. ;        1) First time through, it finds the last significant character
  8562. ;            in the filename and appends a '.0' to it.
  8563. ;
  8564. ;        2) Each succeeding time, it will increment the trailing integer
  8565. ;            that it inserted the first time through.
  8566. ;
  8567.  
  8568. alterf:    lda    dosffm        ;[23] Get the 'first mod' flag
  8569.     cmp    #on        ;[23] Is it on?
  8570.     beq    altfm        ;[23] If it is, do an initial modification
  8571.     jmp    altsm        ;[23] Otherwise, just increment the version
  8572. altfm:    lda    #off        ;[23] Shut the 'first mod' flag off
  8573.     sta    dosffm        ;[23]        ...
  8574.     ldy    #mxfnl-1    ;[23] Stuff the maximum filename length in y
  8575. altgnc:    lda    fcb1,y        ;[23] Get the character from the buffer
  8576.     cmp    #space        ;[23] Is it a space?
  8577.     bne    altco        ;[23] If it is, try the character before it
  8578.     dey            ;[23] Down the index once
  8579.     tya
  8580.     cmp    #$00
  8581.     bpl    altgnc        ;[23] Get the next character
  8582.     ldy    #$00        ;[23] No filename, so user 0 as the index
  8583. altco:    sty    dosfni        ;[23] Save the filename index
  8584.     iny            ;[23] Increment it twice
  8585.     iny            ;[23]        ...
  8586.     cpy    #mxfnl        ;[23] Does this exceed the filename length?
  8587.     bpl    altng        ;[23] Cannot do the alterations
  8588.     lda    #$2e        ;[23] Get the dot
  8589.     ldy    dosfni        ;[23] Get the original index back
  8590.     iny            ;[23] Up it once
  8591.     sta    fcb1,y        ;[23] Store the dot
  8592.     lda    #$00        ;[23] Zero the version count
  8593.     sta    dosfvn        ;[23]        ...
  8594.     iny            ;[23] Up the index again
  8595.     sty    dosfni        ;[23] This will be saved for future alterations
  8596.     jsr    altstv        ;[23] Go store the version in the filename
  8597.     rts            ;[23]    and return
  8598. altsm:    ldx    dosfvn        ;[23] Get the file version number
  8599.     inx            ;[23] Increment it
  8600.     stx    dosfvn        ;[23] Save the new version number
  8601.     txa            ;[23] Get the version number in the AC
  8602.     cmp    #0        ;[23] Is it 0 ?
  8603.     beq    altng        ;[23] Yes, cannot alter name
  8604.     jsr    altstv        ;[23] Go store the version
  8605.     rts            ;[23] And return
  8606. altng:    lda    #$09        ;[23] Store the error code
  8607.     sta    errcod        ;[23]        ...
  8608.     ldx    kerosp        ;[23] Get the old stack pointer
  8609.     txs            ;[23]    and restore it
  8610.     jmp    kermit        ;[23] Go back to top of loop
  8611.  
  8612. ;
  8613. ;    Altstv - stores the version number passed to it into the filename
  8614. ;    buffer at whatever position dosfni is pointing to.
  8615. ;
  8616.  
  8617. altstv:    ldy    dosfni        ;[23] Get the filename index
  8618.     pha            ;[23] Save the value
  8619.     lsr    a        ;[23] Shift out the low order nibble
  8620.     lsr    a        ;[23]        ...
  8621.     lsr    a        ;[23]        ...
  8622.     lsr    a        ;[23]        ...
  8623.     jsr    altstf        ;[23] Stuff the character
  8624.     pla            ;[23] Grab back the original value
  8625.     and    #$0f        ;[23] Take the low order nibble
  8626.     iny            ;[23] Increment the filename index
  8627.     jsr    altstf        ;[23] Stuff the next character
  8628.     rts            ;[23]    and return
  8629.  
  8630. altstf:    ora    #$30        ;[23] Make the character printable
  8631.     cmp    #$3a        ;[23] If it is less than '9'
  8632.     bcc    altdep        ;[23]    then go depisit the character
  8633.     adc    #$06        ;[23] Put the character in the proper range
  8634. altdep:    sta    fcb1,y        ;[23] Stuff the character
  8635.     rts            ;[23]    and return
  8636.  
  8637. ;
  8638. ;    Locent -  Try to find a file 
  8639. ;
  8640.  
  8641. locent:    jsr    bldprm        ;[23]
  8642. ;     openm    #8,#8,#8,primfn,len    ;[23] Open file
  8643.     lda    #8        ; [53]
  8644.     ldx    workdri
  8645.     ldy    #8
  8646.     jsr    setlfs
  8647.     ldx    #primfn\
  8648.     ldy    #primfn^
  8649.     lda    len
  8650.     jsr    setnam
  8651.     jsr    open
  8652.  
  8653.     jsr    rddsk          ;[23] Get disk status
  8654.     cmp    #00        ;[23] Is it 0?
  8655.     bne      locok         ;[23] No, file doesn't exist
  8656.     lda    #8        ;[23] Fle exists, close the file
  8657.     jsr    close        ;[23]        ...
  8658.     jmp    rskp        ;[23] Return with a skip!
  8659. locok:    lda    #8        ;[23] File doesn't exist, close the file
  8660.     jsr    close        ;[23]        ...
  8661.     rts            ;[23] Return
  8662.  
  8663. ;
  8664. ;    Bldprm - Build the primary filename
  8665. ;
  8666.  
  8667. bldprm:    ldx    #'P        ;[DD]        ...
  8668.     lda    filmod        ;[DD] Get the file-type mode
  8669.     and    #$02        ;[DD] If 0 or 1
  8670.     bne    bldpr1        ;[DD] If > 1 P (PRG file)
  8671.     ldx    #'S        ;[DD] S for 0 or 1 (SEQ file)
  8672. bldpr1:    stx    flssp        ;[DD] Store it
  8673.     ldy      #0        ;[DD] Start index
  8674. bldpr2:    lda    fcb1,y         ;[DD] Get char from file name
  8675.     beq      bldfln      ;[DD] End at null
  8676.     cmp      #$20        ;[DD]   or space
  8677.     beq      bldfln        ;[DD]        ...
  8678.     sta      primfn,y     ;[DD] Save in filename
  8679.     iny            ;[DD] Increment index
  8680.     bne    bldpr2         ;[DD] Get more
  8681. bldfln: lda    #',          ;[DD] Add comma
  8682.     sta    primfn,y    ;[DD] Save in filename
  8683.     lda    flssp          ;[DD] Add S or P
  8684.     iny            ;[DD] Increment index
  8685.     sta    primfn,y    ;[DD] Save in filename
  8686.     iny            ;[DD] Increment index
  8687.     lda     #',          ;[DD] Add comma
  8688.     sta    primfn,y    ;[DD] Save in filename
  8689.     iny            ;[DD] Increment index
  8690.     lda    flsrw        ;[DD] Get mode W or R
  8691.     sta    primfn,y    ;[DD] Save in filename
  8692.     iny            ;[DD] Increment index
  8693. bldfl3: sty    len          ;[DD] Len of file name
  8694.     rts            ;[23] Return
  8695.  
  8696. ;
  8697. ;    Closef - closes the file which was open for transfer. 
  8698. ;
  8699.  
  8700. closef:
  8701.     lda #$fc
  8702.     sta $d030
  8703.     lda     #8        ;[DD] Close disk file
  8704.     jsr     close        ;[DD]        ...
  8705.     lda    #15        ;[DD] Close error channel    
  8706.     jsr    close          ;[DD]        ...
  8707.     lda    #true        ; the close worked, return true
  8708.     rts            ;        ...
  8709.  
  8710. ;
  8711. ;    Dirst - Get a disk directory
  8712. ;
  8713.  
  8714. dirst:    jsr    clrbuf        ;[40] Clear the dos command buffer
  8715.     lda    #drdoll        ;[40] Get a '$'
  8716.     sta    buff        ;[40]
  8717.     lda    drunit        ;[40] Get the current drive unit no.
  8718.     sta    buff+1        ;[40]
  8719.     lda    #drcolo        ;[40] Get a ':'
  8720.     sta    buff+2        ;[40]
  8721.     lda    #drstar        ;[40] Get a '*'
  8722.     sta    buff+3        ;[40]
  8723. dirprm:    jsr    dosprs        ;[40] Parse for the command
  8724.     ldx    len        ;[50]
  8725.     bne    drnone        ;[50]
  8726.     inc    len        ;[50]
  8727. drnone:    inc    len        ;[40]
  8728.     inc    len        ;[40]
  8729.     inc    len        ;[40]
  8730. dirsfo:    ; openm    #8,#8,#0,buff,len    ;[40] Get directory
  8731.     lda     #8        ; [53]
  8732. ; use current working drive
  8733.     ldx     workdri
  8734.     ldy     #0
  8735.     jsr    setlfs
  8736.     ldx    #buff\
  8737.     ldy    #buff^
  8738.     lda    len
  8739.     jsr    setnam
  8740.     jsr    open
  8741.     bcs    drclos        ;[DD] Close if error
  8742.     ldx    #$08        ;[DD] Open for input
  8743.     jsr    chkin        ;[DD] Get 3 bytes
  8744.     jsr    chrin        ;[DD]
  8745.     jsr    chrin        ;[DD]
  8746. drst1:  jsr    chrin        ;[DD] Get  byte
  8747.     jsr    readst        ;[DD] If eof close
  8748.     bne    drclos        ;[DD]
  8749.     jsr    chrin        ;[DD] Get 2nd byte
  8750.     beq    drclos        ;[DD]
  8751.     jsr    clrchn        ;[DD] Set input to keybd
  8752.     jsr    getin        ;[DD] Check for space or run/stop
  8753.     cmp    #$03        ; if run/stop
  8754.     beq    drclos        ;     then end directory listing
  8755.     cmp    #$20        ;[DD]
  8756.     bne    drskp        ;[DD] If not space skip
  8757. drloop: jsr    getin        ;[DD] Loop until
  8758.     beq    drloop        ;[DD] Any key pressed
  8759. drskp:  ldx    #$08        ;[DD] Set input to disk
  8760.     jsr    chkin        ;[DD]
  8761.     jsr    chrin        ;[DD] Get a byte
  8762.     pha            ;[DD]
  8763.     jsr    chrin        ;[DD] Get a byte
  8764.     tay            ;[DD]
  8765.     pla            ;[DD]
  8766.     tax            ;[DD]
  8767.     tya            ;[DD]
  8768.     jsr    prntad        ;[DD] [54] Print block count in Decimal
  8769.     lda    #$20        ;[DD]
  8770.     jsr    scrput        ;[DD] Print  a space
  8771. drprnt: jsr    chrin        ;[DD] Get byte
  8772.     beq    dreol        ;[DD] If null end of line
  8773.     cmp    #18        ; reverse on?
  8774.     bne    drpr1
  8775.     lda    #$01
  8776.     sta    reverse
  8777.     jmp    drprnt        ; do the next character
  8778. drpr1:    jsr    scrput        ;[DD] Print byte
  8779.     clc            ;[37]
  8780.     bcc    drprnt        ;[37]
  8781. dreol:  jsr    scrcr        ; print a cr
  8782.     jsr    scrlf        ; print a linefeed
  8783.     lda    #$00
  8784.     sta    reverse        ; turn off reverse
  8785.     lda    #$00        ;[37]
  8786.     sta    rvmask        ;[37]
  8787.     beq    drst1        ;[DD] Go back for more
  8788. drclos: jsr    clrchn        ;[DD] Close channels
  8789.     lda    #$08        ;[DD] Close 8
  8790.     jsr    close        ;[DD]
  8791.     jmp    kermit        ;[40]
  8792.  
  8793. ;
  8794. ;    Doscmd - Send a string to the disk command channel
  8795. ;
  8796.  
  8797. doscmd:    lda    #15        ;[DD] Close command channel
  8798.     jsr    close        ;[DD]        ...
  8799.     jsr    clrbuf        ;[40] Clear the dos command buffer
  8800. dosprm:    jsr    dosprs        ;[40] Parse for the command
  8801. ;     openm    #15,#8,#15,buff+3,len    ;[DD] Send command out
  8802.     lda    #15        ; [53]
  8803.     ldx    workdri
  8804.     ldy    #15
  8805.     jsr    setlfs
  8806.     ldx    #buff+3\
  8807.     ldy    #buff+3^
  8808.     lda    len
  8809.     jsr    setnam
  8810.     jsr    open
  8811.     bcs dosprmok
  8812.     jsr    rddsk        ;[DD]   Get disk status
  8813. dosprmok:
  8814.     lda    #15        ; in any case, close #15
  8815.     jsr    close
  8816.     jmp    kermit        ;[40] Go back for more commands
  8817.  
  8818.  
  8819. ;   Chkdriv
  8820. ; 
  8821. ;   Checks to see if a drive exits by opening up the error channel on it
  8822. ;   and the closing the file.  Readst then returns the error status
  8823. ;   
  8824. ;   ARG: A  (drive number to check)
  8825. ;   Returns: A zero == drive OK
  8826. ;            A not zero == Drive not there
  8827. chkdriv:  pha
  8828.           lda #$0f
  8829.           jsr close
  8830.           pla
  8831.           tax
  8832.           lda    #$0f        ; [53]
  8833.           ldy    #$0f
  8834.           jsr    setlfs
  8835.           ldx    #buff+3\
  8836.           ldy    #buff+3^
  8837.           lda    #$00
  8838.           jsr    setnam
  8839.           jsr    open
  8840.           bcs dosprmok
  8841.           lda #$0f
  8842.           jsr close
  8843.           jsr readst
  8844.           and #$80
  8845.           rts
  8846.  
  8847. ;
  8848. ;    Dosprs - parses a string to be passed to the
  8849. ;    disk drive command channel.
  8850. ;
  8851. ;    Registeres Destroyed:
  8852. ;
  8853.  
  8854. dosprs:    jsr    clrchn        ;[40] Set default I/O channels
  8855.     lda    #kerehr\    ;[40] Point to the extra help commands
  8856.     sta    cmehpt        ;[40]        ...
  8857.     lda    #kerehr^    ;[40]        ...
  8858.     sta    cmehpt+1    ;[40]        ..
  8859.     ldx    #$2f        ;[40] Longest length a disk string may be
  8860.     ldy    #cmfehf        ;[40] Tell Comnd about extra help
  8861.     lda    #cmifi        ;[40] Load opcode for parsing file
  8862.     jsr    comnd        ;[40] Call Comnd routine
  8863.      jmp    dos1        ;[40] Continue, no string parsed
  8864.     stx    kerfrm        ;[40] Save the from address (addr[atmbuf])
  8865.     sty    kerfrm+1    ;[40]        ...
  8866.     sta    kwrk01        ;[40] Save length of string parsed
  8867.     lda    #03        ;[40] Get the address of the buffer
  8868.     sta    kerto        ;[40]        ...
  8869.     lda    #02        ;[40]        ...
  8870.     sta    kerto+1        ;[40]        ...
  8871.     jsr    kercpy        ;[40] Copy the string
  8872.     ldy    kwrk01        ;[40] Get the length back
  8873. ;    iny            ;[40] Increment it by one
  8874.     lda    #0        ;[40] Stuff a null at the end
  8875.     sta    buff+3,y    ;[40]        ...
  8876. ;    iny            ;[40]
  8877.     sty    len        ;[40]
  8878.     clc            ;[40]
  8879.     bcc    dos2        ;[40]
  8880. dos1:    lda    #0        ;[40]
  8881.     sta    len        ;[40]
  8882. dos2:    jsr    prcfm        ;[40]
  8883.     rts            ;[40]
  8884.  
  8885. ;
  8886. ;    Bufill - takes characters from the file, does any neccesary quoting,
  8887. ;    and then puts them in the packet data buffer. It returns the size
  8888. ;    of the data in the AC. If the size is zero and it hit end-of-file,
  8889. ;    it turns on eofinp.
  8890. ;
  8891.  
  8892. bufill:    lda    #$00        ; Zero
  8893.     sta    datind        ;    the buffer index
  8894. bufil1:    lda    addlf        ; Get the 'add a lf' flag
  8895.     cmp    #on        ; Is it on?
  8896.     bne    bufil3        ; No, continue with normal processing
  8897.     lda    #off        ; Zero the flag first
  8898.     sta    addlf        ;        ...
  8899.     lda    #lf        ; Get a <lf>
  8900.     bne    bufcv2a        ; always skip over character translation
  8901. bufil3:    jsr    fgetc        ; Get a character from the file
  8902.      jmp    bffchk        ; Go check for actual end-of-file
  8903.     sta    kerchr        ; Got a character, save it
  8904.     tax            ;[31] and a copy to X
  8905.     lda    filmod        ;[DD] Check if conversion necessary
  8906.     cmp    #1        ;[DD] Is it PETASCI?
  8907.     bne    bufcv1        ;[DD] No
  8908.     lda    pt2as,x        ;[31] Get ASCII equivalent
  8909.     sta    kerchr        ;
  8910.     jmp    bufceb        ;[DD] 
  8911. bufcv1: cmp    #2        ;[DD] Is it Speedscript?
  8912.     bne    bufcv2        ;[DD] No
  8913.     jsr    cvs2a        ;[DD] Conv. Speedscript to ASCII
  8914.     jmp    bufceb
  8915. bufcv2:    cmp    #4        ; is it c-power
  8916.     bne    bufceb
  8917.     lda    #'_
  8918.     cpx    #$a4        ; $a4 is an underbar
  8919.     beq    bufcv2a
  8920.     lda    #'~
  8921.     cpx    #$af        ; $af is a tilde
  8922.     beq    bufcv2a
  8923.     lda    #'|
  8924.     cpx    #$df        ; $df is a pipe
  8925.     beq    bufcv2a
  8926.     lda    pt2as,x        ; if all else fails, use pt2as table
  8927. bufcv2a:sta    kerchr
  8928. bufceb: lda    ebqmod        ; Check if 8-bit quoting is on
  8929.     cmp    #on        ;        ...
  8930.     beq    bufil2        ; If it is, see if we have to use it
  8931.     jmp    bffqc        ; Otherwise, check normal quoting only
  8932. bufil2: lda    kerchr        ; Get the character
  8933.     and    #$80        ; Mask everything off but H.O. bit
  8934.     beq    bffqc        ; H.O. bit was not on, so continue
  8935.     lda    sebq        ; H.O. bit was on, get 8-bit quote
  8936.     ldy    datind        ; Set up the data index
  8937.     sta    (kerbf1),y    ; Stuff the quote character in buffer
  8938.     iny            ; Up the data index
  8939.     sty    datind        ; And save it
  8940.     lda    kerchr        ; Get the original character saved
  8941.     and    #$7f        ; Shut H.O. bit, we don't need it
  8942.     sta    kerchr        ;        ...
  8943. bffqc:  lda    kerchr        ; Fetch the character
  8944.     and    #$7f        ; When checking for quoting, use only 7 bits
  8945. bffqc0: cmp    #sp        ; Is the character less than a space?
  8946.     bpl    bffqc1        ; If not, try next possibility
  8947.     ldx    filmod        ; Get the file-type
  8948.     cpx    #3        ;[DD] IF = 3
  8949.     beq    bffctl        ; If it is not text, ignore <cr> problem
  8950.     cmp    #cr        ; Do we have a <cr> here?
  8951.     bne    bffctl        ; Nope, continue processing
  8952.     ldx    #on        ; Set flag to add a <lf> next time through
  8953.     stx    addlf        ;        ...
  8954.     jmp    bffctl        ; This has to be controlified
  8955. bffqc1: cmp    #del        ; Is the character a del?
  8956.     bne    bffqc2        ; If not, try something else
  8957.     jmp    bffctl        ; Controlify it
  8958. bffqc2: cmp    squote        ; Is it the quote character?
  8959.     bne    bffqc3        ; If not, continue trying
  8960.     jmp    bffstq        ; It was, go stuff a quote in buffer
  8961. bffqc3: lda    ebqmod        ; Is 8-bit quoting turned on?
  8962.     cmp    #on        ;        ...
  8963.     bne    bffstf        ; If not, skip this junk
  8964.     lda    kerchr        ;    otherwise, check for 8-bit quote char.
  8965.     cmp    sebq        ; Is it an 8-bit quote?
  8966.     bne    bffstf        ; Nope, just stuff the character itself
  8967.     jmp    bffstq        ; Go stuff a quote in the buffer
  8968. bffctl: lda    kerchr        ; Get original character back
  8969.     eor    #$40        ; Ctl(AC)
  8970.     sta    kerchr        ; Save the character again
  8971. bffstq: lda    squote        ; Get the quote character
  8972.     ldy    datind        ;    and the index into the buffer
  8973.     sta    (kerbf1),y    ; Store it in the next location
  8974.     iny            ; Up the data index once
  8975.     sty    datind        ; Save the index again
  8976. bffstf: inc    schr        ; Increment the data character count
  8977.     bne    bffsdc        ;        ...
  8978.     inc    schr+1        ;        ...
  8979. bffsdc: lda    kerchr        ; Get the saved character
  8980.     ldy    datind        ;    and the data index
  8981.     sta    (kerbf1),y    ; This is the actual char we must store
  8982.     iny            ; Increment the index
  8983.     sty    datind        ; And resave it
  8984.     tya            ; Take this index, put it in AC
  8985.     clc            ; Clear carry for addition
  8986.     adc    #$06        ; Adjust it so we can see if it
  8987.     cmp    spsiz        ;    is >= spsiz-6
  8988.     bpl    bffret        ; If it is, go return
  8989.     jmp    bufil1        ; Otherwise, go get more characters
  8990. bffret: lda    datind        ; Get the index, that will be the size
  8991.     rts            ; Return with the buffer size in AC
  8992. bffchk:    lda    datind        ;[21] Get the data index
  8993.     cmp    #$00        ;[21] Is it zero?
  8994.     bne    bffne        ;[21] Nope, just return
  8995.     tay            ;[21] Yes, this means the entire file has
  8996.     lda    #true        ;     been transmitted so turn on
  8997.     sta    eofinp        ;    the eofinp flag
  8998.     tya            ;[21] Get back the size of zero
  8999. bffne:  rts            ; Return
  9000.  
  9001. ;
  9002. ;    Bufemp - takes a full data buffer, handles all quoting transforms
  9003. ;    and writes the reconstructed data out to the file using calls to
  9004. ;    FPUTC.
  9005. ;
  9006.  
  9007. bufemp: lda    #$00        ; Zero
  9008.     sta    datind        ;    the data index
  9009. bfetol: lda    datind        ; Get the data index
  9010.     cmp    pdlen        ; Is it >= the packet data length?
  9011.     bmi    bfemor        ; No, there is more to come
  9012.     rts            ; Yes, we emptied the buffer, return
  9013. bfemor: lda    #false        ; Reset the H.O.-bit-on flag to false
  9014.     sta    chebo        ;        ...
  9015.     ldy    datind        ; Get the current buffer index
  9016.     lda    (kerbf1),y    ; Fetch the character in that position
  9017.     sta    kerchr        ; Save it for the moment
  9018.     cmp    rebq        ; Is it the 8-bit quote?
  9019.     bne    bfeqc        ; No, go check for normal quoting
  9020.     lda    ebqmod        ; Is 8-bit quoting on?
  9021.     cmp    #on        ;        ...
  9022.     bne    bfeout        ; No quoting at all, place char in file
  9023.     lda    #true        ; Set H.O.-bit-on flag to true
  9024.     sta    chebo        ;        ...
  9025.     inc    datind        ; Increment the data index
  9026.     ldy    datind        ; Fetch it into Y
  9027.     lda    (kerbf1),y    ; Get the next character from buffer
  9028.     sta    kerchr        ; Save it
  9029. bfeqc:  cmp    rquote        ; Is it the normal quote character
  9030.     bne    bfeceb        ; No, pass this stuff up
  9031.     inc    datind        ; Increment the data index
  9032.     ldy    datind        ;    and fetch it in the Y-reg
  9033.     lda    (kerbf1),y    ; Get the next character from buffer
  9034.     sta    kerchr        ; Save it
  9035.     and    #$7f        ; Check only 7 bits for quote
  9036.     cmp    rquote        ; Were we quoting a quote?
  9037.     beq    bfeceb        ; Yes, nothing has to be done
  9038.     cmp    rebq        ; Check for eight-bit quote char as well
  9039.     beq    bfeceb        ; Skip the character adjustment
  9040.     lda    kerchr        ; Fetch back the original character
  9041.     eor    #$40        ; No, so controlify this again
  9042.     sta    kerchr        ; Resave it
  9043. bfeceb: lda    chebo        ; Is the H.O.-bit-on flag lit?
  9044.     cmp    #true        ;        ...
  9045.     bne    bfeout        ; Just output the character to the file
  9046.     lda    kerchr        ; Fetch the character
  9047.     ora    #$80        ; Light up the H.O. bit
  9048.     sta    kerchr        ; Resave it
  9049. bfeout: lda    filmod        ; Check if this is a text file
  9050.     cmp    #3        ;[DD] Filmod = 3 ?
  9051.     beq    bfefpc        ; If not, continue normal processing
  9052.     lda    kerchr        ; Get a copy of the character
  9053.     and    #$7f        ; Make sure we test L.O. 7-bits only
  9054.     tax            ;[31] Put a copy in X
  9055.     cmp    #cr        ; Do we have a <cr>?
  9056.     bne    bfeclf        ; No, then check for <lf>
  9057.     lda    #on        ; Yes, set the 'Delete <lf>' flag
  9058.     sta    dellf        ;        ...
  9059.     jmp    bfefpc        ; And then continue
  9060. bfeclf: cmp    #lf        ; Do we have a <lf>?
  9061.     bne    bfenlf        ; Nope, We must go shut the Dellf flag.
  9062.     lda    dellf        ; We have a <lf>, is the flag on?
  9063.     cmp    #on        ;        ...
  9064.     bne    bfefpc        ; If not, continue normally
  9065.     lda    #off        ; Flag is on, <lf> follows <cr>, ignore it
  9066.     sta    dellf        ; Start by zeroing flag
  9067.     jmp    bfeou1        ; Now go to end of loop
  9068. bfenlf: lda    #off        ; Zero Dellf
  9069.     sta    dellf        ;        ...
  9070. bfefpc: lda    filmod        ;[DD] Get file type 
  9071.     cmp    #1        ;[DD] Check PETASCI
  9072.     bne    bfefp2        ;[DD]
  9073.     lda    as2pt,x        ;[31] Get ASCII equivalent
  9074.     sta    kerchr        ;[31]
  9075.     jmp    bfefp4        ;[DD]
  9076. bfefp2: cmp    #2        ;[DD] Check Speedscript
  9077.     bne    bfefp3        ;[DD]
  9078.     jsr    cva2s        ;[DD] Convert ASCII to Speedscript
  9079.     jmp    bfefp4
  9080. bfefp3:    cmp    #4        ; check for c-power
  9081.     bne    bfefp4
  9082.     lda    #$a4        ; $a4 is an underbar
  9083.     cpx    #'_
  9084.     beq    bfefp3a
  9085.     lda    #$af        ; $af is a tilde
  9086.     cpx    #'~
  9087.     beq    bfefp3a
  9088.     lda    #$df        ; $df is a pipe
  9089.     cpx    #'|
  9090.     beq    bfefp3a
  9091.     lda    as2pt,x        ; when all else fails, use as2pt table
  9092. bfefp3a:sta    kerchr
  9093. bfefp4: lda    kerchr        ; Get the character once more
  9094.     jsr    fputc        ; Go write it to the file
  9095.      jmp    bfeerr        ; Check out the error
  9096.     inc    rchr        ; Increment the 'data characters receive' count
  9097.     bne    bfeou1        ;        ...
  9098.     inc    rchr+1        ;        ...
  9099. bfeou1: inc    datind        ; Up the buffer index once
  9100.     jmp    bfetol        ; Return to the top of the loop
  9101.  
  9102. bfeerr: sta    errcod        ; Store the error code where it belongs
  9103.     and    #$7f        ; Shut off H.O. bit
  9104.     lda    #false        ; Indicate failure
  9105.     rts            ;    and return
  9106.  
  9107. ;
  9108. ;    Getnfl - returns the next filename to be transferred. Currently
  9109. ;    it always return Eof to indicate there are no other files to
  9110. ;    process.
  9111. ;
  9112.  
  9113. getnfl: lda    #eof        ; No more files (return eof)
  9114.     rts
  9115.  
  9116. ;
  9117. ;    Getfil - gets the filename from the receive command if one was
  9118. ;    parsed. Otherwise, it returns the name in the file header packet.
  9119. ;
  9120.  
  9121. getfil: lda    usehdr        ; Get the use-header switch
  9122.     cmp    #on        ; Is it on
  9123.     bne    getfl1        ; If not, keep what we have in the fcb
  9124.     jsr    clrfcb        ;        ...
  9125.     ldy    #$00        ; Initialize the y reg
  9126. ;    lda    pdlen        ; Copy the packet data length
  9127. ;    sec            ; Now subtract off the overhead
  9128. ;    sbc    #$03        ;        ...
  9129. ;    sta    kwrk02        ;    into a work area
  9130. getfl0: lda    (kerbf1),y    ; Get a character from the packet buffer
  9131.     sta    fcb1,y        ; Stuff it in the fcb
  9132.     iny            ; Up the index once
  9133.     cpy    pdlen        ; Are we finished?
  9134.     bmi    getfl0        ; Nope, go do next byte
  9135. ;    lda    #0        ;
  9136. ;    sta    fcb1,y        ; Nul at end
  9137. getfl1: rts
  9138.  
  9139.  
  9140. ;
  9141. ;    Fgetc - returns the next character from the file in the AC. It
  9142. ;    handles all of the low level disk I/O. Whenever it successfully
  9143. ;    gets a character, it skips on return. If it does not get a
  9144. ;    character, it doesn't skip.
  9145. ;
  9146.  
  9147. fgetc:    lda    eodind        ;[DD] Check end-of-data flag
  9148.     cmp    #off        ;[21] Is it on?
  9149.     beq    fgtc2a        ;[DD][21] No, get next character
  9150.     jmp    fgteof        ;[21] Yes, no data to read
  9151. fgtc2a:    ldx    #8        ;[DD] No, change input channel
  9152.     jsr    chkin        ;[DD]    to disk
  9153.     jsr    getin          ;[DD] Get a char
  9154.     pha            ;[DD] Save it
  9155.     jsr    readst         ;[DD] Get status
  9156.     sta    eodind         ;[DD] Save eof stat for next time
  9157.     cmp    #$00          ;[DD] If 0 then ok
  9158.     beq    fgtgnc        ; Return
  9159.     jsr    closef        ;[DD] Eof so close but return
  9160. fgtgnc:    pla            ; Get back character
  9161. fgtgn1:    ldx    fbsize        ; Get the file-byte-size
  9162.     cpx    #fbsbit        ; Is it seven-bit?
  9163.     bne    fgtexi        ; If not, leave with character intact
  9164.     and    #$7f        ; Shut off the H.O. byte
  9165. fgtexi:    jmp    rskp          ; Return skip
  9166. fgteof:    lda    #$00        ; Return null
  9167.     rts            ;        ... 
  9168. fgtcan: jmp    fatal         ; Just go give an error
  9169.  
  9170. ;
  9171. ;
  9172. ;    Fputc - takes a character passed to it in the AC and writes it
  9173. ;    to the file being transferred in.
  9174. ;
  9175.  
  9176. fputc:    pha             ;[DD] Save it
  9177.     ldx    #8        ;[DD] Change output channel
  9178.     jsr    chkout        ;[DD]    to disk
  9179.     pla              ;[DD] Get it back
  9180.     jsr    chrout        ;[DD] Write it to disk
  9181.     jsr    readst        ;[DD] Check for errors
  9182.     cmp    #00        ;[DD] Do we really need this?
  9183.     beq    fputex        ;[DD] No error
  9184.     sta    errcod      ;[DD] If error
  9185.     ldx    #erms0a\    ;[DD] Get the address of the error message
  9186.     ldy    #erms0a^    ;[DD]        ...
  9187.     jsr    prstr       ;[DD] Print message
  9188.     lda    errcod        ;[DD]     and status
  9189.     jsr    prbyte      ;[DD]        ...
  9190.     jmp    fatal        ;[DD] Blow up
  9191. fputex: lda    #00        ; Return null
  9192.     jmp    rskp          ;     with a skip!
  9193.  
  9194. ; Check disk status
  9195.  
  9196. rddsk:    ldx    #15        ;[DD] Change Kernel input channel
  9197.     jsr    chkin        ;[DD]  to disk error channel
  9198.     ldy    #0        ;[DD]
  9199. rdds1:    jsr    getin        ;[DD] Get a character
  9200.     cmp    #cr        ;[DD] Is it a <cr> ?
  9201.     beq    rdds2        ;[DD] Yes, we are done
  9202.     sta    dskers,y    ;[DD] Store it
  9203.     iny            ;[DD] Increment the index
  9204.     cpy #50
  9205.     bne rdds1
  9206. rdds2:    lda    #0        ;[DD] Stuff a null at the end
  9207.     sta    dskers,y    ;[DD]        ...
  9208.     lda     dskers         ;[DD] Get 1st digit
  9209.     sec            ;[DD] Convert to bcd
  9210.     sbc    #$30         ;[DD]        ...
  9211.     sta    fmrcod        ;[DD]
  9212.     asl    a         ;[DD] *2
  9213.     asl    a         ;[DD] *4
  9214.     asl     a        ;[DD] *8
  9215.     asl    a          ;[DD] *16
  9216.     sta    fmrcod        ;[DD]
  9217.     beq    rddex        ;[DD] If first digit is zero exit
  9218.     lda    dskers+1     ;[DD] Get 2n digit
  9219.     sec            ;[DD] Convert to binary
  9220.     sbc    #$30        ;[DD]        ...
  9221.     clc            ;[DD]        ...
  9222.     adc    fmrcod        ;[DD]
  9223.     sta    fmrcod        ;[DD]
  9224.     beq    rddex        ;[DD] If error = 0 exit
  9225.     ldx    #dskers\    ;[DD] Get the address of the disk
  9226.     ldy    #dskers^    ;[DD]   error message
  9227.     jsr    prstr        ;[DD] Print it
  9228.     lda    fmrcod        ;[DD] 
  9229.     ora    #$80        ;[DD] Set high hbit
  9230. rddex:    sta     errcod        ;[DD]
  9231.     jsr    clrchn        ; turn off disk drive
  9232.     lda    errcod
  9233.     rts            ;[DD] Return
  9234.  
  9235.  
  9236. .SBTTL    Save and Restore Parameters
  9237.  
  9238. ;    The following routines will save and restore kermit 
  9239. ;    parameters in a file named 'SLKERMIT.INI'. Eventually 
  9240. ;    will add ability to specify file for save/restore.
  9241. ;
  9242.  
  9243. ;
  9244. ;    Savst - Save parameters
  9245. ;
  9246. ;    Registers Destroyed: A,X,Y
  9247. ;
  9248.  
  9249. savst:    jsr    prcfm        ;[47] Parse and print a confirm
  9250.     lda    #fncwrt        ;[47]
  9251.     ldy    #$0f        ;[47]
  9252.     sta    inifil,y    ;[47]
  9253.     iny            ;[47]
  9254.     sty    len        ;[47]
  9255. ;     openm    #8,#8,#8,inifil,len    ;[47]
  9256.     lda    #8        ; [53]
  9257.     ldx    workdri
  9258.     ldy    #8
  9259.     jsr    setlfs
  9260.     ldx    #inifil\
  9261.     ldy    #inifil^
  9262.     lda    len
  9263.     jsr    setnam
  9264.     jsr    open
  9265.     jsr readst
  9266.     and #$80
  9267.     bne saverr
  9268.     ldx    #8        ;[47]
  9269.     jsr    chkout        ;[47]
  9270.     ldy    #0        ;[47] Start with the escape character
  9271. savlop:    lda    escp,y        ;[47]        ...
  9272.     jsr    chrout        ;[47] Write it to disk
  9273.     iny            ;[47]
  9274.     cpy    #portadd+1-escp    ;[47] Are we at the end?
  9275.     bne    savlop        ;[47] No, do the next parameter
  9276.     jsr    readst        ;[47] Get the drive status
  9277.     bne    saverr        ;[47] We got an error
  9278.     lda    #8        ;[47] OK, close the file when done
  9279.     jsr    close        ;[47]        ...
  9280.     jmp    kermit        ;[47]    and parse for more commands
  9281. saverr:    lda    #8        ;[47] OK, close the file when done
  9282.     jsr    close        ;[47]        ...
  9283.     jmp    kermit        ;[47]    and parse for more commands
  9284.  
  9285. ;
  9286. ;    Restst - Restore parameters
  9287. ;
  9288.  
  9289. restst:    jsr    prcfm        ;[47] Parse and print a confirm
  9290.     jsr    restin        ;[47] Go restore the parameters
  9291.     jmp    kermit        ;[47] Failed, restart kermit
  9292.  
  9293. restin: jsr scrext
  9294.     lda    #fncrea        ;[47] Get switch for read
  9295.     ldy    #$0f        ;[47] Get index into init filename
  9296.     sta    inifil,y    ;[47] Store the switch there
  9297.     iny            ;[47] Increment the index
  9298.     sty    len        ;[47] Store it 
  9299. ;     openm    #8,#8,#8,inifil,len    ;[47] Open the init file
  9300.     lda    #8        ; [53]
  9301. ;    ldx    #8
  9302. ;   Now we want to load the INI file from the device that loaded the exe
  9303.     ldx workdri
  9304.     ldy    #8
  9305.     jsr    setlfs
  9306.     ldx    #inifil\
  9307.     ldy    #inifil^
  9308.     lda    len
  9309.     jsr    setnam
  9310.     jsr    open
  9311.  
  9312.     ldx    #8        ;[47] Change kernel input channel
  9313.     jsr    chkin        ;[47]    to disk
  9314.     ldy    #0        ;[47] Start index at escp
  9315. rstlop:    sty    savey        ;[47] Save the current index
  9316.     jsr    chrin        ;[47] Get a byte from the disk
  9317.     pha
  9318.     jsr    readst        ;[47] 
  9319.     and #$02
  9320.     bne    rstlop2        ;[47] No, failed - don't restore parameters
  9321.     pla
  9322.     ldy    savey        ;[47] Restore the index
  9323.     sta    escp,y        ;[47] Store the character away
  9324.     iny            ;[47] Increment the index
  9325.     cpy    #portadd+1-escp    ;[47] Are we at the end of the parameter list?
  9326.     bne    rstlop        ;[47] No, get next parameter
  9327.     lda    scrtype        ; check if the new screen driver exists
  9328.     jsr    scrtst
  9329.     bcc    rstlop1        ; no it doesnt
  9330. rsterr:    lda    #$01        ; default to 80-columns
  9331.     sta    scrtype
  9332.     jmp rstlop1
  9333. rstlop2: pla
  9334. rstlop1:
  9335.     lda    #8        ;[47] Close the init file
  9336.     jsr    close        ;[47]        ...
  9337.     jsr    scrent        ; initilize the new screen package
  9338.     jsr    dobad
  9339.     jsr changport
  9340.     rts            ; all done
  9341.  
  9342. inifil:    .byte    "SLKERMIT.INI,S,W";[47] Name of the init file
  9343.     .byte    nul
  9344.  
  9345. .SBTTL    Utility routines
  9346.  
  9347. ;
  9348. ;    The following routines are short low-level routines which help
  9349. ;    shorten the code and make it more readable
  9350. ;
  9351. ;
  9352. ;    Incn - increment the packet sequence number expected by this
  9353. ;    Kermit. Then take that number Mod $3f.
  9354. ;
  9355.  
  9356. incn:    pha            ; Save AC
  9357.     lda    n        ; Get the packet number
  9358.     clc            ; Clear the carry flag for the add
  9359.     adc    #$01        ; Up the number by one
  9360.     and    #$3f        ; Do this Mod $3f!
  9361.     sta    n        ; Stuff the number where it belongs
  9362.     clc            ; Clear carry again
  9363.     lda    tpak        ; Increment lo byte
  9364.     adc    #$01        ;    total packet count
  9365.     sta    tpak        ;        ...
  9366.     lda    tpak+1        ; Do H.O. byte
  9367.     adc    #$00        ;        ...
  9368.     sta    tpak+1        ;        ...
  9369.     pla            ; Restore the AC
  9370.     rts            ;    and return
  9371.  
  9372. ;
  9373. ;    Prcerp - Process error packet. Moves the Remote Kermit error
  9374. ;    text into a save area, notes that there was an error received
  9375. ;    from the remote Kermit in Errcod (set H.O. bit), and displays
  9376. ;    the text on the screen.
  9377. ;
  9378.  
  9379. prcerp:    lda    ptype        ; Reload the packet type
  9380.     cmp    #'E        ; Is it an error packet?
  9381.     beq    prcer1        ; Yes, continue processing
  9382.     rts            ; No, return
  9383. prcer1:    lda    #pdbuf\        ; Set up from-address
  9384.     sta    kerfrm        ;        ...
  9385.     lda    #pdbuf^        ;        ...
  9386.     sta    kerfrm+1    ;        ...
  9387.     lda    #errrkm\    ; Set up the to-address
  9388.     sta    kerto        ;        ...
  9389.     lda    #errrkm^    ;        ...
  9390.     sta    kerto+1        ;        ...
  9391.     ldy    pdlen        ; Get packet data length
  9392.     sty    kwrk01        ; Store for the copy routine
  9393.     lda    #$00        ; Start by storing a null at the end
  9394.     sta    (kerto),y    ;        ...
  9395.     jsr    kercpy        ; Copy the error text
  9396.     lda    errcod        ; Set the bit in the error code
  9397.     ora    #eprflg        ;    saying that the remote Kermit sent us
  9398.     sta    errcod        ;    an error packet.
  9399.     ldx    #errrkm\    ; Finally, display the error packet
  9400.     ldy    #errrkm^    ;        ...
  9401.     jsr    prstr        ; Print string
  9402.     jsr    prcrlf        ; Make it look neat, add a crlf
  9403.     rts            ; Return to caller
  9404.  
  9405. ;
  9406. ;    Gobble - snarfs a line of characters from the port up to
  9407. ;    the receive end-of-line character. If it sees a keyboard
  9408. ;    interupt, it punts and does not skip.
  9409. ;
  9410.  
  9411. gobble:    lda    #$00        ; Zero the index pointing to end of line buffer
  9412.     sta    pdtend        ;        ...
  9413.     sta    ndx        ; Make sure no unwarranted keyboard intrpt
  9414. gobb:    jsr    getc        ; Get a character
  9415.      jmp    gobb2        ; Got a keyboard interupt
  9416.     lda    char        ;[31]
  9417.     cmp    #soh        ; Is it a start-of-header?
  9418.     bne    gobb        ; No, flush until first SOH
  9419.     jmp    gobbst        ; Ok, now we can start
  9420. gobb0:    jsr    getc        ; Get a character
  9421.      jmp    gobb2        ; Got a keyboard interupt
  9422.     lda    char        ;[31]
  9423.     cmp    #soh        ; If this not an SOH
  9424.     bne    gobb1        ;    continue here
  9425.     tax            ; Hold the character here
  9426.     lda    #$00        ; Rezero the index pointing to end of buf
  9427.     sta    pdtend        ;        ...
  9428.     txa            ; Get the SOH back
  9429.     jmp    gobbdb        ; Go stuff the character in the buffer
  9430. gobb1:    cmp    reol        ; Is it the end-of-line character?
  9431.     beq    gobb3        ; Yes, finish up
  9432. gobbst:    ldx    pdtend        ; Get the index we need
  9433. gobbdb:    sta    plnbuf,x    ; Stuff the character at the buffer
  9434.     inc    pdtend        ; Increment the index once
  9435.     jmp    gobb0        ; Loop for another character
  9436. gobb2:    rts            ; Just return, no skip
  9437. gobb3:    ldx    pdtend        ; Get end pointer again
  9438.     sta    plnbuf,x    ; Store the End-of-line before we leave
  9439.     lda    #$00        ; Zero the index, leave eob ptr where it is
  9440.     sta    pdtind        ;        ...
  9441.     jmp    rskp        ; Return with a skip!
  9442.  
  9443. ;
  9444. ;    Getplc - gets a character from the port line buffer and
  9445. ;    returns it. If the buffer is empty, it returns without
  9446. ;    skipping.
  9447. ;
  9448.  
  9449. getplc: ldx    pdtind        ; Get the current index
  9450.     cpx    pdtend        ; Less than the end buffer pointer?
  9451.     bmi    getpl1        ; If so, go return the next character
  9452.     rts            ; Return without a skip
  9453. getpl1: lda    plnbuf,x    ; Get the next character from the buffer
  9454.     inc    pdtind        ; Up the index once
  9455.     jmp    rskp        ; Return with a skip!
  9456.  
  9457. ;
  9458. ;
  9459. ;    Putplc - puts a character to the port line buffer.
  9460. ;
  9461.  
  9462. putplc: ldx    pdtind        ; Get the current index
  9463.     inx            ; Check if we are at end of buffer
  9464.     bne    putpl1        ; No, continue
  9465.     rts            ; Return without a skip
  9466. putpl1: dex            ; Set index back to what it was
  9467.     sta    plnbuf,x    ; Get the next character from the buffer
  9468.     inc    pdtind        ; Up the index once
  9469.     rts            ; Return
  9470.  
  9471. ;
  9472. ;    Getc - skip returns with a character from the port or does
  9473. ;    a normal return if a key from the keyboard is received first.
  9474. ;    If it skips, the character from the port is returned in the
  9475. ;    AC.
  9476. ;
  9477.  
  9478. getc:    jsr    keyscn        ; Try and get a keyboard character
  9479.     bne    getcy        ;[] Got one
  9480.     jmp    getc1        ;[] None available, try port
  9481. getcy:    cmp    #ctrlx        ;[43] Was it an 'abort current file' interrupt?
  9482.     beq    getc3        ; Yes
  9483. getc2:    cmp    #ctrly        ;[43] Was it 'abort file group' interrupt ?
  9484.     bne    getc0        ;[43] Nope, continue
  9485. getc3:    lda    #$08        ; Error code for 'file trans abort'
  9486.     sta    errcod        ; Stuff it here
  9487.     jsr    closef        ;[28] Close the current file
  9488. abo0:    lda    #$00        ;[43] Send a 'Z' packet with a 'D' field
  9489.     sta    numtry        ;[43]
  9490.     sta    tpak        ;[43]
  9491.     sta    tpak+1        ;[43]
  9492.     lda    #pdbuf\        ;[43] Get the address of the packet buffer
  9493.     sta    kerbf1        ;[43]   and save it for Spak
  9494.     lda    #pdbuf^        ;[43]        ...
  9495.     sta    kerbf1+1    ;[43]        ...
  9496. abo1:    lda    numtry        ;[43] Fetch the number of tries
  9497.     cmp    maxtry        ;[43] Have we exceeded Maxtry?
  9498.     bmi    abo3        ;[43] Not yet, go send the packet
  9499. abo2:    ldx    #ermesc\    ;[43] Yes, give an error message
  9500.     ldy    #ermesc^    ;[43]        ...
  9501.     jsr    prstr        ;[43]        ...
  9502.     jsr    prcrlf        ;[43]        ...
  9503.     jmp    abo4        ;[43]    and restart kermit
  9504. abo3:    inc    numtry        ;[43] Increment the number of tries for packet
  9505.     lda    #$00        ;[43] Make it packet number 0
  9506.     sta    pnum        ;[43]        ...
  9507.     lda    #$01        ;[43] Data length is only 1
  9508.     sta    pdlen        ;[43]        ...
  9509.     lda    #'D        ;[43] The 'Discard' command
  9510.     sta    pdbuf        ;[43] Put that in first character of buffer
  9511.     lda    #'Z        ;[43] EOF command packet type
  9512.     sta    ptype        ;[43]        ...
  9513.     jsr    flshin        ;[43] Flush the RS232 buffer
  9514.     jsr    spak        ;[43] Send the packet
  9515.     ;jsr    rpak        ;[43] Try to fetch an ACK
  9516.     ;cmp    #true        ;[43] Did we receive successfully?
  9517.     ;bne    abo1        ;[43] No, try to send the packet again
  9518.     ;lda    ptype        ;[43] Get the type
  9519.     ;cmp    #'Y        ;[43] An ACK?
  9520.     ;bne    aboce        ;[43] No, go check for error
  9521.     jmp    abo4        ;[43] Yes, restart Kermit
  9522. aboce:    ;cmp    #'E        ;[43] Error packet?
  9523.     ;bne    abo1        ;[43] Nope, resend packet
  9524.     ;jsr    prcerp        ;[43] Go display the error
  9525.  
  9526. abo4:    ldx    kerosp        ; Get the old stack pointer back
  9527.     txs            ; Restore it
  9528.     jmp    kermit        ; Warmstart kermit
  9529.  
  9530. getc0:  lda    #$00        ;[EL] And reset the strobe
  9531.     sta    ndx        ;[EL]        ...
  9532.     rts            ; Keyboard interupt, return
  9533. getc1:    jsr    scrbel        ; time to stop the beep?  (after parity err)
  9534.     jsr    timout        ;[49] Have we timed out?
  9535.      jmp    getc0        ;[49] Yes return
  9536.     jsr    getrs        ; No, Check the port
  9537.     bne    getcn        ;[] Got a character
  9538.     jmp    getc        ;[] No char, go back to top of loop
  9539. getcn:    lda    char        ;[31] Get the character read
  9540.     jmp    rskp        ;    and return skip!
  9541.  
  9542. ;
  9543. ;    Prson - parses an 'on' or an 'off' keyword and passes
  9544. ;    the result back to the calling routine in the x-index
  9545. ;    register. If there is an error, it pops the return
  9546. ;    address off the stack and transfers control to kermt2
  9547. ;    to issue the error message.
  9548. ;
  9549.  
  9550. prson:  lda    #oncmd\        ; Command table address
  9551.     sta    cminf1        ;        ...
  9552.     lda    #oncmd^        ;        ...
  9553.     sta    cminf1+1    ;        ...
  9554.     lda    #shon\        ; Set up default string for parse
  9555.     sta    cmdptr        ;        ...
  9556.     lda    #shon^        ;        ...
  9557.     sta    cmdptr+1    ;        ...
  9558.     ldy    #cmfdff        ; Show there is a default
  9559.     lda    #cmkey        ; Code for keyword
  9560.     jsr    comnd        ; Go do it
  9561.      rts            ; The command was not recognized
  9562.      nop
  9563.      nop
  9564.     jmp    rskp        ; Good, skip return
  9565.  
  9566. ;
  9567. ;    prcfm - parses for a confirm, then transfers control directly
  9568. ;    to the top of the main loop
  9569. ;
  9570.  
  9571. prcfm:  lda    #cmcfm        ; Load token for confirm
  9572.     jsr    comnd        ; Parse a confirm
  9573.      jmp    kermt3        ; No confirm, give an error
  9574.     lda    #cr        ; Print a crlf
  9575.     jsr    cout        ;        ...
  9576.     rts            ; Return
  9577.  
  9578. ;
  9579. ;    Pron - checks the value in the AC and prints either 'ON' or
  9580. ;    'OFF'. (on=1, off=0).
  9581. ;
  9582.  
  9583. pron:    cmp    #on        ; Should we print 'on'?
  9584.     bne    pron1        ; No, go print 'off'
  9585.     ldx    #shon\        ; Point to the 'on' string
  9586.     ldy    #shon^        ;        ...
  9587. pron0:  jsr    prstr        ; Print it
  9588.     jsr    prcrlf        ; Add a crelf at the end
  9589.     rts            ; And return
  9590. pron1:  ldx    #shoff\        ; Point to the 'off' string
  9591.     ldy    #shoff^        ;        ...
  9592.     jmp    pron0        ; Go print it
  9593.  
  9594. ;
  9595. ;    Nonftl - handles non-fatal DOS errors. When Kermit does its
  9596. ;    initialization it points the error vector and the basic
  9597. ;    warmstart vector here.
  9598. ;
  9599.  
  9600. nonftl: lda    fmrcod        ; Get the DOS return code
  9601.     ora    #$80        ;        ...
  9602.     sta    errcod        ; Save that here
  9603.     ldx    kerosp        ; Get the old stack pointer back
  9604.     txs            ; Restore it
  9605.     jmp    kermit        ; Warmstart kermit
  9606.  
  9607. ;
  9608. ;    Fatal - closes and deletes a file on which a bad error
  9609. ;    has occured (most likely a 'disk full' error). It then
  9610. ;    restores the old stack pointer and warmstarts Kermit.
  9611. ;
  9612.  
  9613. fatal:    lda    fmrcod        ; Get the DOS return code
  9614.     ora    #$80        ; Set H.O. bit to indicate DOS error
  9615.     sta    errcod        ; Store the error code
  9616.     jsr    closef        ; Close the file
  9617. ;    jsr    dosdel        ; Now, delete the useless file
  9618.     ldx    kerosp        ; Get the old stack pointer
  9619.     txs            ; Restore it
  9620.     jmp    kermit        ; Warmstart kermit
  9621.  
  9622. ;
  9623. ;    Clrfcb - clears the area FCB1 so the filename placed there
  9624. ;    will not be corrupted.
  9625. ;
  9626.  
  9627. clrfcb:    ldx    #mxfnl        ; Load max filename length
  9628.     lda    #space        ; We will be filling with spaces
  9629. clrfc1:    sta    fcb1,x        ; Stuff the space
  9630.     dex            ; Decrement our pointer
  9631.     bpl    clrfc1        ; Not done, go back
  9632.     rts            ; Return
  9633.  
  9634. ;
  9635. ;    Clrbuf - clears the area BUFF so the disk string placed there
  9636. ;    will not be corrupted
  9637. ;
  9638.  
  9639. clrbuf:    ldx    #$2e        ;[40]
  9640.     lda    #space        ;[40]
  9641. clrbf1:    sta    buff,x        ;[40]
  9642.     dex            ;[40]
  9643.     bpl    clrbf1        ;[40]
  9644.     rts            ;[40]
  9645.  
  9646. ;
  9647. ;    Kercpy - copies the string pointed to by Kerfrm to the
  9648. ;    block of memory pointed to by Kerto for Kwrk01 characters.
  9649. ;
  9650.  
  9651. kercpy:    ldy    kwrk01        ; Get the length of the string
  9652. kerclp:    dey            ; One character less
  9653.     bmi    kercrt        ; If this went negative, we're done
  9654.     lda    (kerfrm),y    ; Get the next character
  9655.     sta    (kerto),y    ; And put it where it belongs
  9656.     jmp    kerclp        ; Go back for next char
  9657. kercrt:    rts            ; Job is done, return
  9658.  
  9659. ;
  9660. ;    Kerflm - fills the buffer pointed to by Kerto with the
  9661. ;    character in kwrk02 for Kwrk01 characters.
  9662. ;
  9663.  
  9664. kerflm:    ldy    kwrk01        ; Get the length of the string
  9665. kerflp:    dey            ; One character less
  9666.     bmi    kerflr        ; If this went negative, we're done
  9667.     lda    kwrk02        ; Get the fill character
  9668.     sta    (kerto),y    ; And put it in the next position
  9669.     jmp    kerflp        ; Go back to do next char
  9670. kerflr:    rts            ; Job is done, return
  9671.  
  9672. ;
  9673. ;    Prchr - takes a character from the AC and prints it. It
  9674. ;    echos control characters as '^<chr>' and escape as '$'.
  9675. ;
  9676.  
  9677. prchr:  and    #$7f        ; Make sure it's in range
  9678.     cmp    #$20        ; Less than escape??
  9679.     bpl    prchr1        ; If not, continue
  9680.     pha            ; Hold the character
  9681.     lda    #'^        ; Load the up-arrow for cntrl characters
  9682.     jsr    cout        ; Print the character
  9683.     pla            ; Get the character back
  9684.     clc            ; Clear carry for add
  9685.     adc    #$40        ; Put this in the alphabetic range
  9686. prchr1: jsr    cout        ;    and print it
  9687.     rts            ; Done, go back
  9688.  
  9689. ;
  9690. ;    Genmad - takes a message base, offset and size and calculates
  9691. ;    the address of the message leaving it in the X and Y registers
  9692. ;    ready for a call to PRSTR. The size and offset are taken from
  9693. ;    the stack and the base address is found in kermbs.
  9694. ;
  9695.  
  9696. genmad: pla            ; Get return address
  9697.     sta    kerrta        ;    and save it till later
  9698.     pla            ;
  9699.     sta    kerrta+1    ;
  9700.     pla            ; Get message offset
  9701.     tax            ; Hold it here for a while
  9702.     pla            ; Get the message length
  9703.     tay            ;    and put it here
  9704.     lda    #$00        ; H.O. byte of message offset for mul16
  9705.     pha            ;
  9706.     txa            ; L.O. byte of message offset
  9707.     pha            ;
  9708.     lda    #$00        ; H.O. byte of message size for mul16
  9709.     pha            ;
  9710.     tya            ; L.O. byte of message size
  9711.     pha            ;
  9712.     jsr    mul16        ; Calculate the actual offset in table
  9713.     pla            ; Get L.O. byte of result
  9714.     clc            ; Clear the carry for addition
  9715.     adc    kermbs        ; Add the L.O. byte of the base address
  9716.     tax            ; Put it in X for the return
  9717.     pla            ; Get the H.O. byte
  9718.     adc    kermbs+1    ; Add the H.O. byte of the base address w/carry
  9719.     tay            ; Stuff it here for the return
  9720.     lda    kerrta+1    ; Replace the return address on the stack
  9721.     pha            ;        ...
  9722.     lda    kerrta        ;        ...
  9723.     pha            ;        ...
  9724.     rts            ; Return
  9725.  
  9726.  
  9727. .SBTTL     Video Support Routines
  9728.  
  9729. ;
  9730. ;    Prttab - Go to next tab stop
  9731. ;
  9732.  
  9733. prttab:    ldx    cx        ; get the cursor x position
  9734. prttab1:inx            ; move cursor let
  9735.     jsr    scrrgh        ; do not allow the cursor past the right margin
  9736.     bcs    prttab2        ; if past right margin, goto next line
  9737.     lda    tabs,x        ; see if tab stop here
  9738.     bne    prttab1        ; if zero, there is a tabstop here
  9739.     ldy    cy        ; get the cursor y position
  9740.     jsr    scrplt        ; plot the new cursor position
  9741.     rts            ; all done
  9742. prttab2:jsr    scrlf        ; goto the next line if past right margin
  9743.     jsr    scrcr        ; goto the leftmost column
  9744.     rts            ; all done
  9745.  
  9746. ;
  9747. ;    Ploth - Plot the cursor position
  9748. ;
  9749. ;    Input: Carry set to read cursor position
  9750. ;           X-reg cursor y position            (if carry is set)
  9751. ;           Y-reg curosr x position            (if carry is set)
  9752. ;
  9753. ;    Output:X-reg is cursor y position        (if carry is clear)
  9754. ;           Y-reg is cursor x position        (if carry is clear)
  9755. ;
  9756. ;    Registers Destroyed:  None            (if carry is set)
  9757. ;
  9758.  
  9759. ploth:    bcc    ploth1
  9760.     ldx    cy
  9761.     ldy    cx
  9762.     rts
  9763.  
  9764. ploth1:    tya            ; swap a-reg and x-reg
  9765.     pha
  9766.     txa
  9767.     tay
  9768.     pla
  9769.     tax
  9770.     jsr    scrplt
  9771.     rts
  9772.  
  9773. ;    Print (X) spaces
  9774.  
  9775. prbl2:  stx    savex        ;[DD] Save X
  9776.     lda    #sp        ;[DD] Get a space
  9777.     jsr    cout        ;[DD] Print it
  9778.     ldx    savex        ;[DD] Get back X
  9779.     dex            ;[DD] Decrement it
  9780.     bne    prbl2        ;[DD] If not 0, do more
  9781.     rts            ;[DD] Return
  9782.  
  9783. ; Print a reg as 2 hex nibbles
  9784.  
  9785. prbyte:             ;[DD] Output byte in hex
  9786. by2hx:  pha            ;[DD] Save byte
  9787.     lsr    a        ;[DD]
  9788.     lsr    a        ;[DD]
  9789.     lsr    a        ;[DD]
  9790.     lsr    a        ;[DD]
  9791.     jsr    ny2hx             ;[DD] High nyble
  9792.     tax                 ;[DD] to x
  9793.     pla                 ;[DD] Get back
  9794.     and    #$0f             ;[DD] Low nyble
  9795.     jsr    ny2hx        ;[DD] Translate to Hex
  9796.     pha            ;[DD] Save low nyble
  9797.     txa            ;[DD] Get high nyble
  9798.     jsr    cout        ;[DD] Print it
  9799.     pla            ;[DD] Get back low nyble
  9800.     jmp    cout        ;[DD] Print and return
  9801.  
  9802. ; Translate nyble to hex
  9803.  
  9804. ny2hx:    clc            ;[DD]
  9805.     adc    #$f6        ;[DD]
  9806.     bcc    ny2h2        ;[DD]
  9807.     adc    #$06        ;[DD]
  9808. ny2h2:  adc    #$3a        ;[DD]
  9809.     rts            ;[DD]
  9810.  
  9811. ; Print hex of A,X
  9812.  
  9813. prntax: stx    savex        ;[DD] Save X
  9814.     jsr    prbyte        ;[DD] Print A first
  9815.     lda    savex        ;[DD] Get X into A
  9816.     jsr    prbyte        ;[DD] Print that next
  9817.     rts            ;[DD] Return
  9818.  
  9819. ;    Prntad - Print a number in base 10.  Leading zeros are skipped.
  9820. ;
  9821. ;    Input: A,X - Number to be printed
  9822. ;
  9823. ;    Registers Destroyed:    A,X,Y
  9824. ;
  9825. ;    This routine works by repeated subtraction.  10^X is subtracted
  9826. ;    until the result would be negative.  After each subtraction, Y
  9827. ;    is incremented. Y starts out at '0.  Thus, Y is the ascii value
  9828. ;    of the next digit.
  9829.  
  9830. prntad:    stx    decnum        ; [54] Save the number to print
  9831.     sta    decnum+1    ; [54]
  9832.  
  9833.     ldx    #4        ; [54] Up to 5 digits (0..4)
  9834. prntad1:lda    decnum        ; [54] Compare with 10^x
  9835.     cmp    tens1,x        ; [54]
  9836.     lda    decnum+1    ; [54]
  9837.     sbc    tens2,x        ; [54]
  9838.     bcs    prntad2        ; [54] If greater, found first nonzero digit
  9839.     dex            ; [54] Skip the leading zero
  9840.     bne    prntad1        ; [54] Go test the next digit, unless last
  9841.  
  9842. prntad2:ldy    #'0        ; [54] Y is the ascii value to print
  9843. prntad3:lda    decnum        ; [54] Compare with 10^x
  9844.     cmp    tens1,x        ; [54]
  9845.     lda    decnum+1    ; [54]
  9846.     sbc    tens2,x        ; [54]
  9847.     bcc    prntad4        ; [54] Result would be negative.
  9848.  
  9849.     lda    decnum        ; [54] Now subtract 10^x
  9850.     sbc    tens1,x        ; [54] carry is already set
  9851.     sta    decnum        ; [54]
  9852.     lda    decnum+1    ; [54]
  9853.     sbc    tens2,x        ; [54]
  9854.     sta    decnum+1    ; [54]
  9855.     iny            ; [54] Keep track of the value of this digit
  9856.     bne    prntad3        ; [54] Always taken
  9857.  
  9858. prntad4:txa            ; [54] Save X
  9859.     pha            ; [54]
  9860.     tya            ; [54] Print the character in Y
  9861.     jsr    cout        ; [54]
  9862.     pla            ; [54] Restore X
  9863.     tax            ; [54]
  9864.     dex            ; [54] Print the next digit.
  9865.     bpl    prntad2        ; [54]
  9866.     rts
  9867. tens1    .byte    1\,10\,100\,1000\,10000\ ; [54] Powers of ten for prntad
  9868. tens2    .byte    1^,10^,100^,1000^,10000^
  9869.  
  9870. ;
  9871. ;    Cout - Print byte to screen
  9872. ;
  9873. ;    Input:    A - character to be printed
  9874. ;
  9875. ;    Output:
  9876. ;
  9877. ;    Registers Destroyed:    A,X,Y
  9878. ;
  9879.  
  9880. cout:    sta    source        ; Save A-reg
  9881.     pha            ; save A-reg again
  9882.     txa
  9883.     pha            ; save X-reg
  9884.     tya
  9885.     pha            ; save Y-reg
  9886.     lda    source
  9887.     jsr    scrput        ; print the character
  9888.     pla            ; restore Y-reg
  9889.     tay
  9890.     pla            ; restore X-reg
  9891.     tax
  9892.     pla            ; restore A-reg
  9893.     rts
  9894.  
  9895. ;    Rdkey - Read keyboard until a byte appears
  9896. ;
  9897. ;    Input:
  9898. ;
  9899. ;    Output:
  9900. ;
  9901. ;    Registers Destroyed:
  9902. ;
  9903.  
  9904. rdkey:    jsr    keyscn        ;[DD] Try and get a keyboard byte
  9905.     sta    char
  9906.     bne    rdret        ;[DD] None, try again
  9907.     jsr    scrfls        ; flash the cursor
  9908.     jsr    scrbel        ; stop the nasty bell tone after 6 jiffys
  9909.     jmp    rdkey        ;[]
  9910. rdret:    rts            ;[DD]        ...
  9911.  
  9912. ;    Bell - Initiate sounds - will be terminated next cursor blink
  9913. ;
  9914. ;    Input:    None
  9915. ;
  9916. ;    Output: None
  9917. ;
  9918. ;    Registers Destroyed: None
  9919. ;
  9920.  
  9921. bell:    pha            ;[EL] Save the AC
  9922. beephi:    lda    #$50        ;[EL] Select high frequency
  9923.     bne    beep        ;[33]        ...
  9924. beeplo:    pha            ;[33] Save the AC
  9925.     lda    #$14        ;[33] Select low frequency
  9926.  
  9927. beep:    sta    freqhi        ;[EL]        ...
  9928.     lda    #$0f        ;[EL] Select fast attack, slow decay
  9929.     sta    attdec        ;[EL]        ...
  9930.     lda    #$12        ;[EL] Select sustain ...
  9931.     sta    susrel        ;[EL]        ...
  9932.     lda    #6        ;[EL] Select not-too-loud volume
  9933.     sta    vol        ;[EL]        ...
  9934.     lda    #$21        ;[EL] Select sawtooth wave
  9935.     sta    wave        ;[EL]        ...
  9936.     jsr    rdtim        ; remember when the sound started
  9937.     sta    lpcnt        ;[EL]        ...
  9938.     pla            ;[EL] Restore the AC
  9939.     rts            ;[EL] Return
  9940.  
  9941. ;
  9942. ;    keyscn - scan the keyboard
  9943. ;
  9944. ;    Input:    None
  9945. ;
  9946. ;    Output:    zero flag and A reg
  9947. ;
  9948. ;    This routine checks the keyboard.  If a new key is pressed, or if
  9949. ;    it is time for the current key to be repeated, it returns the
  9950. ;    the ascii (not petascii) value of the key, and clears the zero flag.
  9951. ;    If no key is pressed, or if it is not time to repeat the current
  9952. ;    key, it returns zero and sets the zero flag.
  9953. ;
  9954. ;    This routine also returns the row/column of the key pressed in the
  9955. ;    X-reg.  This is used to determine if a new key was pushed.
  9956. ;
  9957.  
  9958. keyscn:    jsr    rdtim        ; only scan once per jiffy (avoid keybounce)
  9959.     cmp    keytime
  9960.     beq    keyscn1        ; not time yet. return
  9961.     sta    keytime
  9962.     jsr    keyscn2        ; scan the keyboard
  9963.     beq    keyscn3        ; if no key pressed, reset repeat counter
  9964.     cpx    keylast
  9965.     bne    keyscn3        ; if new key pressed, reset repeat counter
  9966.     ldy    decarm        ; if keyboard not in automatic repeat mode...
  9967.     beq    keyscn1        ; ... then no key pushed.
  9968.     dec    keyrept        ; if same key pressed, decrement repeat counter
  9969.     bne    keyscn1        ; if not time to repeat yet, return $00
  9970.     ldy    #7        ; repeat every 7 jiffys (after the first rept)
  9971.     .byte    $2c        ; skip the ldy #30
  9972. keyscn3:ldy    #30        ; set the repeat counter to 30 jiffys
  9973.     sty    keyrept
  9974.     stx    keylast        ; remember row/column of last keypress
  9975.     ldx    $d600        ; is this a commodore-128?
  9976.     beq    keyscn0        ; if not, then there is no caps lock key
  9977.     cmp    #'a        ; is this a lower case letter?
  9978.     bcc    keyscn0        ; if not, then caps lock has no effect
  9979.     cmp    #'z+1        ; is this a lower case letter?
  9980.     bcs    keyscn0        ; if not, then caps lock has no effect
  9981.     pha            ; save the letter
  9982.     lda    $01
  9983.     and    #$40
  9984.     cmp    #$40        ; carry clear if and only if caps lock down
  9985.     pla            ; remember the letter
  9986.     bcs    keyscn0
  9987.     adc    #'A-'a        ; make the letter capital (note: carry clear)
  9988. keyscn0:cmp    #$00        ; set zero flag if new key, otherwise clear
  9989.     rts    
  9990. keyscn1:lda    #$00        ; not time to scan keyboard yet. 
  9991.     rts
  9992.  
  9993. keyscn2:
  9994.     sei            ; only one key scanner at once, please
  9995.     ldx    #$ff        ; no keypress detected (yet)
  9996.     lda    #$00        ; check if any key is pressed
  9997.     sta    $dc00
  9998.     sta    $d02f        ; the extra keys on the C128 live here
  9999.     lda    $dc01
  10000.     cmp    #$ff
  10001.     beq    keyscn4        ; no key pressed. Skip excess junk.
  10002.     lda    #$fe        ; start scanning with the first column
  10003.     sta    keycol
  10004.     sta    $dc00
  10005.     lda    #$ff
  10006.     sta    keycol1
  10007.     sta    $d02f
  10008.     ldx    #$00
  10009. keyscn6:lda    $dc01
  10010.     ora    keynon,x    ; cancel out non-characters (shift, control)
  10011.     cmp    #$ff        ; any key pressed in this column?
  10012.     bne    keyscn5        ; nope.  Skip this junk
  10013.     sec            ; check the next column
  10014.     rol    keycol
  10015.     rol    keycol1
  10016.     lda    keycol
  10017.     sta    $dc00
  10018.     lda    keycol1
  10019.     sta    $d02f
  10020.     inx
  10021.     cpx    #11        ; check for 11 different columns
  10022.     bcc    keyscn6
  10023.     ldx    #$ff        ; so '$' works.  (last = 11 if only shift)
  10024.     lda    #$00        ; the key press has gone away during the scan
  10025.     cli            ; re-allow interupts
  10026.     rts
  10027. keyscn5:pha            ; save the row data
  10028.     txa            ; multiply X-reg by 8 (8 rows/column)
  10029.     asl    a
  10030.     asl    a
  10031.     asl    a
  10032.     tax
  10033.     pla            ; remember row data
  10034.     sec            ; make sure carry is always set in keyscn7 loop
  10035.     dex            ; compensate for next inx
  10036. keyscn7:inx            ; inx till grounded row found
  10037.     ror    a
  10038.     bcs    keyscn7
  10039.     lda    #$ff
  10040.     sta    $d02f
  10041.     lda    #%01111111    ; check the ctrl key
  10042.     sta    $dc00
  10043.     lda    $dc01
  10044.     and    #%00000100
  10045.     beq    keyscn8        ; control pushed
  10046.     lda    #%11111101    ; next check the left shift key
  10047.     sta    $dc00
  10048.     lda    $dc01
  10049.     and    #%10000000
  10050.     beq    keyscn9        ; left shift pushed
  10051.     lda    #%10111111    ; next check the right shift key
  10052.     sta    $dc00
  10053.     lda    $dc01
  10054.     and    #%00010000
  10055.     beq    keyscn9        ; right shift pushed
  10056.     lda    keytbl1,x    ; look up ascii value for given row/column
  10057.     cli            ; re-allow interupts
  10058.     rts            ; all done
  10059. keyscn8:lda    keytbl2,x    ; look up ascii value for control + row/column
  10060.     cli            ; re-allow interupts
  10061.     rts            ; all done
  10062. keyscn9:lda    keytbl3,x    ; look up ascii value for shift + row/column
  10063.     cli            ; re-allow interupts
  10064.     rts            ; all done
  10065. keyscn4:lda    #$ff        ; fix things so that the keypad doesn't
  10066.     sta    $d02f        ; interfere with the suspend flag
  10067.     lda    #$00        ; no key pushed anywhere
  10068.     cli            ; re-allow interupts
  10069.     rts
  10070.  
  10071. ;
  10072. ;    keynon - position of non-character keys.
  10073. ;
  10074. ;    This table defines the position of non-character keys.  A
  10075. ;    non-character key is any key that does not return a character.
  10076. ;    Example: Shift, Control, C=.
  10077. ;
  10078.  
  10079. keynon:    .byte    %00000000
  10080.     .byte    %10000000    ; left-shift
  10081.     .byte    %00000000
  10082.     .byte    %00000000
  10083.     .byte    %00000000
  10084.     .byte    %00000000
  10085.     .byte    %00010000    ; right-shift
  10086.     .byte    %00100100    ; unused, control
  10087.     .byte    %00000000    ; <commodore-128 keys start here>
  10088.     .byte    %00000000
  10089.     .byte    %10000001    ; no_scroll, alt
  10090.  
  10091. ;
  10092. ;    keytbl1 - ascii values of characters at given row/column
  10093. ;
  10094. ;    This table is used to translage row/column positions to ascii
  10095. ;    values.  This table is only used if neither the shift or control
  10096. ;    keys is pushed.
  10097. ;
  10098. ;    The following special non-ascii values exist:
  10099. ;
  10100. ;    $80 .. $89        - numeric keypad
  10101. ;    $90 .. $93        - pf keys
  10102. ;    $a0 .. $a3        - cursor keys
  10103. ;    $b0 .. $b7        - programmable function keys
  10104. ;    $c0            - '-' (on the numeric keypad)
  10105. ;    $c1            - '+' (on the numeric keypad)
  10106. ;    $c2            - '.' (on the numeric keypad)
  10107. ;    $c3            - enter (on the numeric keypad)
  10108. ;    $d0            - null (ctrl-@) and (ctrl-space)
  10109. ;    $d1            - break (shift DEL)
  10110. ;
  10111.  
  10112. keytbl1:.byte    $7f        ; row 0, column 0
  10113.     .byte    $0d        ; row 1, column 0
  10114.     .byte    $a2        ; row 2, column 0
  10115.     .byte    $08        ; row 3, column 0    (should be $b6)
  10116.     .byte    '_        ; row 4, column 0    (should be $b0)
  10117.     .byte    '`        ; row 5, column 0    (should be $b2)
  10118.     .byte    '{        ; row 6, column 0    (should be $b4)
  10119.     .byte    $a1        ; row 7, column 0
  10120.     .byte    '3        ; row 0, column 1
  10121.     .byte    'w        ; row 1, column 1
  10122.     .byte    'a        ; row 2, column 1
  10123.     .byte    '4        ; row 3, column 1
  10124.     .byte    'z        ; row 4, column 1
  10125.     .byte    's        ; row 5, column 1
  10126.     .byte    'e        ; row 6, column 1
  10127.     .byte    $00        ; row 7, column 1
  10128.     .byte    '5        ; row 0, column 2
  10129.     .byte    'r        ; row 1, column 2
  10130.     .byte    'd        ; row 2, column 2
  10131.     .byte    '6        ; row 3, column 2
  10132.     .byte    'c        ; row 4, column 2
  10133.     .byte    'f        ; row 5, column 2
  10134.     .byte    't        ; row 6, column 2
  10135.     .byte    'x        ; row 7, column 2
  10136.     .byte    '7        ; row 0, column 3
  10137.     .byte    'y        ; row 1, column 3
  10138.     .byte    'g        ; row 2, column 3
  10139.     .byte    '8        ; row 3, column 3
  10140.     .byte    'b        ; row 4, column 3
  10141.     .byte    'h        ; row 5, column 3
  10142.     .byte    'u        ; row 6, column 3
  10143.     .byte    'v        ; row 7, column 3
  10144.     .byte    '9        ; row 0, column 4
  10145.     .byte    'i        ; row 1, column 4
  10146.     .byte    'j        ; row 2, column 4
  10147.     .byte    '0        ; row 3, column 4
  10148.     .byte    'm        ; row 4, column 4
  10149.     .byte    'k        ; row 5, column 4
  10150.     .byte    'o        ; row 6, column 4
  10151.     .byte    'n        ; row 7, column 4
  10152.     .byte    '+        ; row 0, column 5
  10153.     .byte    'p        ; row 1, column 5
  10154.     .byte    'l        ; row 2, column 5
  10155.     .byte    '-        ; row 3, column 5
  10156.     .byte    '.        ; row 4, column 5
  10157.     .byte    ':        ; row 5, column 5
  10158.     .byte    '@        ; row 6, column 5
  10159.     .byte    ',        ; row 7, column 5
  10160.     .byte    '\        ; row 0, column 6
  10161.     .byte    '*        ; row 1, column 6
  10162.     .byte    ';        ; row 2, column 6
  10163.     .byte    $08        ; row 3, column 6
  10164.     .byte    $00        ; row 4, column 6
  10165.     .byte    '=        ; row 5, column 6
  10166.     .byte    '^        ; row 6, column 6
  10167.     .byte    '/        ; row 7, column 6
  10168.     .byte    '1        ; row 0, column 7
  10169.     .byte    $1b        ; row 1, column 7
  10170.     .byte    $00        ; row 2, column 7
  10171.     .byte    '2        ; row 3, column 7
  10172.     .byte    $20        ; row 4, column 7
  10173.     .byte    $00        ; row 5, column 7
  10174.     .byte    'q        ; row 6, column 7
  10175.     .byte    $03        ; row 7, column 7
  10176.     .byte    '?        ; row 0, column 8
  10177.     .byte    $88        ; row 1, column 8
  10178.     .byte    $85        ; row 2, column 8
  10179.     .byte    $09        ; row 3, column 8
  10180.     .byte    $82        ; row 4, column 8
  10181.     .byte    $84        ; row 5, column 8
  10182.     .byte    $87        ; row 6, column 8
  10183.     .byte    $81        ; row 7, column 8
  10184.     .byte    $1b        ; row 0, column 9
  10185.     .byte    $c1        ; row 1, column 9
  10186.     .byte    $c0        ; row 2, column 9
  10187.     .byte    $0a        ; row 3, column 9
  10188.     .byte    $c3        ; row 4, column 9
  10189.     .byte    $86        ; row 5, column 9
  10190.     .byte    $89        ; row 6, column 9
  10191.     .byte    $83        ; row 7, column 9
  10192.     .byte    $00        ; row 0, column 10
  10193.     .byte    $80        ; row 1, column 10
  10194.     .byte    $c2        ; row 2, column 10
  10195.     .byte    $a0        ; row 3, column 10
  10196.     .byte    $a1        ; row 4, column 10
  10197.     .byte    $a3        ; row 5, column 10
  10198.     .byte    $a2        ; row 6, column 10
  10199.     .byte    $00        ; row 7, column 10
  10200.  
  10201. ;
  10202. ;    keytbl2 - ascii values of characters at given row/column
  10203. ;
  10204. ;    This table is used to translage row/column positions to ascii
  10205. ;    values.  This table is only used if control is pushed
  10206. ;
  10207. ;    The following special non-ascii values exist:
  10208. ;
  10209. ;    $80 .. $89        - numeric keypad
  10210. ;    $90 .. $93        - pf keys
  10211. ;    $a0 .. $a3        - cursor keys
  10212. ;    $b0 .. $b7        - programmable function keys
  10213. ;    $c0            - '-' (on the numeric keypad)
  10214. ;    $c1            - '+' (on the numeric keypad)
  10215. ;    $c2            - '.' (on the numeric keypad)
  10216. ;    $c3            - enter (on the numeric keypad)
  10217. ;    $d0            - null (ctrl-@) and (ctrl-space)
  10218. ;    $d1            - break (shift DEL)
  10219. ;
  10220.  
  10221. keytbl2:.byte    $7f        ; row 0, column 0
  10222.     .byte    $c3        ; row 1, column 0
  10223.     .byte    $a2        ; row 2, column 0
  10224.     .byte    $93        ; row 3, column 0
  10225.     .byte    $90        ; row 4, column 0
  10226.     .byte    $91        ; row 5, column 0
  10227.     .byte    $92        ; row 6, column 0
  10228.     .byte    $a0        ; row 7, column 0
  10229.     .byte    $83        ; row 0, column 1
  10230.     .byte    $17        ; row 1, column 1
  10231.     .byte    $01        ; row 2, column 1
  10232.     .byte    $84        ; row 3, column 1
  10233.     .byte    $1a        ; row 4, column 1
  10234.     .byte    $13        ; row 5, column 1
  10235.     .byte    $05        ; row 6, column 1
  10236.     .byte    $00        ; row 7, column 1
  10237.     .byte    $85        ; row 0, column 2
  10238.     .byte    $12        ; row 1, column 2
  10239.     .byte    $04        ; row 2, column 2
  10240.     .byte    $86        ; row 3, column 2
  10241.     .byte    $03        ; row 4, column 2
  10242.     .byte    $06        ; row 5, column 2
  10243.     .byte    $14        ; row 6, column 2
  10244.     .byte    $18        ; row 7, column 2
  10245.     .byte    $87        ; row 0, column 3
  10246.     .byte    $19        ; row 1, column 3
  10247.     .byte    $07        ; row 2, column 3
  10248.     .byte    $88        ; row 3, column 3
  10249.     .byte    $02        ; row 4, column 3
  10250.     .byte    $08        ; row 5, column 3
  10251.     .byte    $15        ; row 6, column 3
  10252.     .byte    $16        ; row 7, column 3
  10253.     .byte    $89        ; row 0, column 4
  10254.     .byte    $09        ; row 1, column 4
  10255.     .byte    $0a        ; row 2, column 4
  10256.     .byte    $80        ; row 3, column 4
  10257.     .byte    $0d        ; row 4, column 4
  10258.     .byte    $0b        ; row 5, column 4
  10259.     .byte    $0f        ; row 6, column 4
  10260.     .byte    $0e        ; row 7, column 4
  10261.     .byte    $c1        ; row 0, column 5
  10262.     .byte    $10        ; row 1, column 5
  10263.     .byte    $0c        ; row 2, column 5
  10264.     .byte    $c0        ; row 3, column 5
  10265.     .byte    $c2        ; row 4, column 5
  10266.     .byte    $1b        ; row 5, column 5
  10267.     .byte    $d0        ; row 6, column 5
  10268.     .byte    ',        ; row 7, column 5
  10269.     .byte    $1c        ; row 0, column 6
  10270.     .byte    '*        ; row 1, column 6
  10271.     .byte    $1d        ; row 2, column 6
  10272.     .byte    $08        ; row 3, column 6
  10273.     .byte    $00        ; row 4, column 6
  10274.     .byte    $1f        ; row 5, column 6
  10275.     .byte    $1e        ; row 6, column 6
  10276.     .byte    '/        ; row 7, column 6
  10277.     .byte    $81        ; row 0, column 7
  10278.     .byte    $1b        ; row 1, column 7
  10279.     .byte    $00        ; row 2, column 7
  10280.     .byte    $82        ; row 3, column 7
  10281.     .byte    $d0        ; row 4, column 7
  10282.     .byte    $00        ; row 5, column 7
  10283.     .byte    $11        ; row 6, column 7
  10284.     .byte    $03        ; row 7, column 7
  10285.     .byte    '?        ; row 0, column 8
  10286.     .byte    $88        ; row 1, column 8
  10287.     .byte    $85        ; row 2, column 8
  10288.     .byte    $09        ; row 3, column 8
  10289.     .byte    $82        ; row 4, column 8
  10290.     .byte    $84        ; row 5, column 8
  10291.     .byte    $87        ; row 6, column 8
  10292.     .byte    $81        ; row 7, column 8
  10293.     .byte    $1b        ; row 0, column 9
  10294.     .byte    $c1        ; row 1, column 9
  10295.     .byte    $c0        ; row 2, column 9
  10296.     .byte    $0a        ; row 3, column 9
  10297.     .byte    $c3        ; row 4, column 9
  10298.     .byte    $86        ; row 5, column 9
  10299.     .byte    $89        ; row 6, column 9
  10300.     .byte    $83        ; row 7, column 9
  10301.     .byte    $00        ; row 0, column 10
  10302.     .byte    $80        ; row 1, column 10
  10303.     .byte    $c2        ; row 2, column 10
  10304.     .byte    $a0        ; row 3, column 10
  10305.     .byte    $a1        ; row 4, column 10
  10306.     .byte    $a3        ; row 5, column 10
  10307.     .byte    $a2        ; row 6, column 10
  10308.     .byte    $00        ; row 7, column 10
  10309.  
  10310. ;
  10311. ;    keytbl3 - ascii values of characters at given row/column
  10312. ;
  10313. ;    This table is used to translage row/column positions to ascii
  10314. ;    values.  This table is used only if shift, but not control, is pushed
  10315. ;
  10316. ;    The following special non-ascii values exist:
  10317. ;
  10318. ;    $80 .. $89        - numeric keypad
  10319. ;    $90 .. $93        - pf keys
  10320. ;    $a0 .. $a3        - cursor keys
  10321. ;    $b0 .. $b7        - programmable function keys
  10322. ;    $c0            - '-' (on the numeric keypad)
  10323. ;    $c1            - '+' (on the numeric keypad)
  10324. ;    $c2            - '.' (on the numeric keypad)
  10325. ;    $c3            - enter (on the numeric keypad)
  10326. ;    $d0            - null (ctrl-@) and (ctrl-space)
  10327. ;    $d1            - break (shift DEL)
  10328. ;
  10329.  
  10330. keytbl3:.byte    $d1        ; row 0, column 0
  10331.     .byte    $0d        ; row 1, column 0
  10332.     .byte    $a3        ; row 2, column 0
  10333.     .byte    $00        ; row 3, column 0    (should be $b7)
  10334.     .byte    '|        ; row 4, column 0    (should be $b1)
  10335.     .byte    '~        ; row 5, column 0    (should be $b3)
  10336.     .byte    '}        ; row 6, column 0    (should be $b5)
  10337.     .byte    $a0        ; row 7, column 0
  10338.     .byte    '#        ; row 0, column 1
  10339.     .byte    'W        ; row 1, column 1
  10340.     .byte    'A        ; row 2, column 1
  10341.     .byte    '$        ; row 3, column 1
  10342.     .byte    'Z        ; row 4, column 1
  10343.     .byte    'S        ; row 5, column 1
  10344.     .byte    'E        ; row 6, column 1
  10345.     .byte    $00        ; row 7, column 1
  10346.     .byte    '%        ; row 0, column 2
  10347.     .byte    'R        ; row 1, column 2
  10348.     .byte    'D        ; row 2, column 2
  10349.     .byte    '&        ; row 3, column 2
  10350.     .byte    'C        ; row 4, column 2
  10351.     .byte    'F        ; row 5, column 2
  10352.     .byte    'T        ; row 6, column 2
  10353.     .byte    'X        ; row 7, column 2
  10354.     .byte    ''        ; row 0, column 3
  10355.     .byte    'Y        ; row 1, column 3
  10356.     .byte    'G        ; row 2, column 3
  10357.     .byte    '(        ; row 3, column 3
  10358.     .byte    'B        ; row 4, column 3
  10359.     .byte    'H        ; row 5, column 3
  10360.     .byte    'U        ; row 6, column 3
  10361.     .byte    'V        ; row 7, column 3
  10362.     .byte    ')        ; row 0, column 4
  10363.     .byte    'I        ; row 1, column 4
  10364.     .byte    'J        ; row 2, column 4
  10365.     .byte    '0        ; row 3, column 4
  10366.     .byte    'M        ; row 4, column 4
  10367.     .byte    'K        ; row 5, column 4
  10368.     .byte    'O        ; row 6, column 4
  10369.     .byte    'N        ; row 7, column 4
  10370.     .byte    '{        ; row 0, column 5
  10371.     .byte    'P        ; row 1, column 5
  10372.     .byte    'L        ; row 2, column 5
  10373.     .byte    '}        ; row 3, column 5
  10374.     .byte    '>        ; row 4, column 5
  10375.     .byte    '[        ; row 5, column 5
  10376.     .byte    '`        ; row 6, column 5
  10377.     .byte    '<        ; row 7, column 5
  10378.     .byte    '|        ; row 0, column 6
  10379.     .byte    '*        ; row 1, column 6
  10380.     .byte    ']        ; row 2, column 6
  10381.     .byte    $0c        ; row 3, column 6
  10382.     .byte    $00        ; row 4, column 6
  10383.     .byte    '_        ; row 5, column 6
  10384.     .byte    '~        ; row 6, column 6
  10385.     .byte    '?        ; row 7, column 6
  10386.     .byte    '!        ; row 0, column 7
  10387.     .byte    $1b        ; row 1, column 7
  10388.     .byte    $00        ; row 2, column 7
  10389.     .byte    '"        ; row 3, column 7
  10390.     .byte    $20        ; row 4, column 7
  10391.     .byte    $00        ; row 5, column 7
  10392.     .byte    'Q        ; row 6, column 7
  10393.     .byte    $03        ; row 7, column 7
  10394.     .byte    '?        ; row 0, column 8
  10395.     .byte    $88        ; row 1, column 8
  10396.     .byte    $85        ; row 2, column 8
  10397.     .byte    $09        ; row 3, column 8
  10398.     .byte    $82        ; row 4, column 8
  10399.     .byte    $84        ; row 5, column 8
  10400.     .byte    $87        ; row 6, column 8
  10401.     .byte    $81        ; row 7, column 8
  10402.     .byte    $1b        ; row 0, column 9
  10403.     .byte    $c1        ; row 1, column 9
  10404.     .byte    $c0        ; row 2, column 9
  10405.     .byte    $0a        ; row 3, column 9
  10406.     .byte    $c3        ; row 4, column 9
  10407.     .byte    $86        ; row 5, column 9
  10408.     .byte    $89        ; row 6, column 9
  10409.     .byte    $83        ; row 7, column 9
  10410.     .byte    $00        ; row 0, column 10
  10411.     .byte    $80        ; row 1, column 10
  10412.     .byte    $c2        ; row 2, column 10
  10413.     .byte    $a0        ; row 3, column 10
  10414.     .byte    $a1        ; row 4, column 10
  10415.     .byte    $a3        ; row 5, column 10
  10416.     .byte    $a2        ; row 6, column 10
  10417.     .byte    $00        ; row 7, column 10
  10418.  
  10419. .SBTTL    RS232 Support Routines
  10420.  
  10421. ;
  10422. ;    Openrs - Open the RS-232 Channel
  10423. ;
  10424. ;    Input:    RS232 Parameters in CNTRL,CMMD
  10425. ;
  10426. ;    Ouput:
  10427. ;
  10428. ;    Registers Destroyed: A
  10429. ;
  10430.  
  10431. openrs:    jsr    sftini
  10432.     rts
  10433.  
  10434. ;
  10435. ;    Getrs - Get byte from rs232 port
  10436. ;
  10437. ;    Input:    
  10438. ;
  10439. ;    Output:    Character read in CHAR
  10440. ;
  10441. ;
  10442. ;
  10443. ;    Registers Destroyed: A,X
  10444. ;
  10445.  
  10446. getrs:    jsr    flowco        ;[24] Do flow control if necessary
  10447.     lda    suspend        ;[24] Is RS-232 reading suspended?
  10448.     bne    getrs3        ; Yes, 
  10449.     jsr    sftrd        ; read data
  10450.     sta    char        ; save character
  10451.     jsr rserrs        ;
  10452.     cmp    #$00        ; set Z flag based on if we got data or not
  10453.     rts
  10454. getrs3    lda    #$00
  10455.     rts
  10456.  
  10457. ;
  10458. ;    Rserrs - Check for RS232 errors
  10459. ;
  10460. ;    Input:    Status in STAT
  10461. ;
  10462. ;    Output:
  10463. ;
  10464. ;    Registers Destroyed: A
  10465.  
  10466. rserrs:    pha
  10467.     lda    stat        ; get status
  10468.     beq    erret        ; no error
  10469.     jsr    beeplo
  10470.     lda #$00
  10471.     sta stat
  10472. erret    pla
  10473.         rts
  10474.  
  10475. ;
  10476. ;    Flowco - perform RS-232 flow control
  10477. ;
  10478. ;    Input:
  10479. ;
  10480. ;    Output:
  10481. ;
  10482. ;    Registers Destroyed: A,X
  10483. ;
  10484.  
  10485. flowco:    lda    flowmo        ;[24] Get the flow control mode switch
  10486.     cmp    #on        ;[24] Is it on?
  10487.     bne    flowre        ;[24] No
  10488.     lda    shflag        ;[24] Check commodore key
  10489.     and    #$02        ;[24] Is it depressed?
  10490.     beq    nocomm        ;[24] No
  10491.     lda    commflg        ;[24] Was it depressed before
  10492.     bne    flowch        ;[24] Yes, ignore it
  10493.     inc    commflg        ;[24] Set commodore key flag
  10494.     lda    suspend        ;[24] Currently suspended?
  10495.     beq    notsus        ;[24] No
  10496.     lda    #0            ;[24] Clear suspend flag
  10497.     sta    suspend        ;[24]        ...
  10498.     beq    flowch        ;[24]
  10499. notsus:    inc    suspend        ;[24] Set suspend flag
  10500.     bne    flowch            ;[24]
  10501. nocomm:    sta    commflg        ;[24] Clear commodore key flag
  10502.  
  10503. flowch:    lda    rdhead    ;[24] Compute number of chars
  10504.     sec                ;[24]    in RS-232 buffer
  10505.     sbc    rdtail        ;[24]        ...
  10506.     lsr    a            ;[24] Divide count by 2 for accurate check
  10507.     ldx    fxoff        ;[24] Has an xoff already been sent
  10508.     bne    itsoff        ;[24] Yes
  10509.     cmp    #70         ;[24] Number chars in buffer reached 200?
  10510.     bmi    flowre        ;[24] No - no flow control necessary yet
  10511.     jsr    sxoff        ;[24] Send an xoff
  10512.     rts            ;[24] Return
  10513. itsoff:    cmp    #10        ;[24] Has backlog dropped to 20 or less?
  10514.     bpl    flowre        ;[24] No - leave input suspended
  10515.     jsr    sxon        ;[24] Send an xon
  10516. flowre:    rts            ;[24] Return
  10517.  
  10518. ;
  10519. ;    Flshin - Flush the RS232 input buffer
  10520. ;
  10521. ;    Input:
  10522. ;
  10523. ;    Output:
  10524. ;
  10525. ;    Registers Destroyed: A
  10526.  
  10527. flshin:    jsr    getrs        ;[25] Get from RS-232 buffer
  10528.     cmp    #$00
  10529.     bne    flshin        ;[33] No, get more
  10530.     rts            ;[25] Yes, finish
  10531.  
  10532. ;
  10533. ;    Putrs - Send byte to RS232
  10534. ;
  10535. ;    Input:
  10536. ;
  10537. ;    Output:
  10538. ;
  10539. ;    Registers Destroyed:
  10540. ;
  10541.  
  10542. putrs:    stx    sftklu
  10543.     jsr    sfttr
  10544.     ldx    sftklu
  10545.     rts
  10546.  
  10547. ;
  10548. ;    Sbreak - Send a break signal
  10549. ;
  10550.  
  10551. sbreak: lda    $de02        ; get command register
  10552.     pha
  10553.     ora    #%00001110    ; set "transmit BRK" condition
  10554. mm8:    sta    $de02        ; put back command register
  10555.     ldy    #$00
  10556.     jsr    sbdl2        ; get a timing value depending on fast mode
  10557. sbdl0:    pha            ; 10240 * 3 = 30720
  10558.     pla            ; 10240 * 4 = 40960
  10559.     pha            ; 10240 * 3 = 30720
  10560.     pla            ; 10240 * 4 = 40960
  10561.     nop            ; 10240 * 2 = 20480
  10562.     nop            ; 10240 * 2 = 20480
  10563.     dey            ; 10240 * 2 = 20480
  10564.     bne    sbdl0        ; 10200 * 3 + 40 * 2 = 30680
  10565.     ldy    #51        ; 40 * 2 = 80
  10566. sbdl1:    nop            ; 2040 * 2 = 4080
  10567.     dey            ; 2040 * 2 = 4080
  10568.     bne    sbdl1        ; 2000 * 3 + 40 * 2 = 6080
  10569.     dex            ; 40 * 2 = 80
  10570.     bne    sbdl0        ; 39 * 3 + 1 * 2 = 119
  10571.     pla
  10572. mm9:    sta    $de02
  10573.     rts
  10574. sbdl2:    ldx    #40        ; loop 40 times for slow mode
  10575.     lda    fast
  10576.     lsr    a
  10577.     bcc    sbdl3
  10578.     ldx    #80        ; loop 80 times for fast mode
  10579. sbdl3:    rts
  10580.  
  10581. ;
  10582. ;    Subroutine - send out ^Q (xon) to remote host
  10583. ;
  10584.  
  10585. sxon:    lda    #0        ;[24] Clear xoff flag
  10586.     sta    fxoff        ;[24]        ...
  10587.     lda    #$11        ;[24] Transmit ^Q
  10588.     bne    xcom        ;[24]        ...
  10589.  
  10590. ;
  10591. ;    Subroutine - send out ^S (xoff) to remote host
  10592. ;
  10593.  
  10594. sxoff:    lda    #5        ;[24] Set xoff flag
  10595.     sta    fxoff        ;[24][32]    ...
  10596.     lda    #$13        ;[24]    then, transmit ^S
  10597. xcom:    jsr    putrs        ;[24]        ...
  10598.     rts            ;[24] Return
  10599.  
  10600.  
  10601. ;  sftini   Setup SwiftLink Interupts and buffers
  10602.  
  10603. sftini    
  10604.     sei                ; Turn off interupts
  10605.     lda    #sftint\    ; Set NMI vector to sftint
  10606.     ldy    #sftint^
  10607.     sta    nmiv
  10608.     sty    nmiv+1
  10609.     lda    #$00        ; Clear buffers
  10610.     sta    trtail
  10611.     sta    trhead
  10612.     sta    rdtail
  10613.     sta    rdhead
  10614. mma:    sta    $de01        ; Reset SL-232 
  10615.     lda    #%00001001    ; enable Recieve Interupts and transmitter
  10616. mmb:    sta    $de02
  10617.     lda    #%00011000    ; enable baud rate generator (2400 baud)
  10618. mmc:    sta    $de03
  10619.     cli
  10620.     rts
  10621.  
  10622.  
  10623. ;  sftrd     Read data from SL-232 buffer
  10624. ;
  10625. sftrd    sei
  10626.     ldx    rdtail
  10627.     cpx    rdhead     ; Is there a char to read
  10628.     beq    sftrd1     ; no
  10629.     lda    rdbuf,x    ; Get it into A
  10630.     inc    rdtail     ; advance buffer
  10631.         cli
  10632.         rts        
  10633. sftrd1    lda    #$00   ; No char, A = 0 
  10634.     cli
  10635.     rts 
  10636.  
  10637. ; Just send the byte
  10638. sfttr sei
  10639.       pha
  10640. sfttr1  lda $de01
  10641.       bit c07
  10642.       beq sfttr2
  10643.       pha
  10644.       txa 
  10645.       pha
  10646. mmd:      lda $de00
  10647.       ldx rdhead
  10648.       inx
  10649.       cpx rdtail
  10650.       beq sfttr7
  10651.       dex
  10652.       sta rdbuf,x
  10653.       inc rdhead
  10654.       jmp sfttr3
  10655. sfttr7:
  10656.       lda #01
  10657.       sta stat      
  10658. sfttr3:
  10659.       pla
  10660.       tax
  10661.       pla
  10662. sfttr2:
  10663.       bit c10    
  10664.       beq sfttr1
  10665.       pla
  10666. mme:      sta $de00
  10667.       cli
  10668.       rts
  10669.  
  10670.  
  10671. ; sftinit     SL-232 Intrupt handler
  10672. ;
  10673. sftint sei    
  10674.     pha 
  10675. mmh:    lda $de01
  10676.     bit c0f
  10677.     beq sftint3
  10678.     sta tmpsl232
  10679.     txa
  10680.     pha
  10681. mmf:    lda $de02
  10682.     and #%11110000
  10683.     ora #%00000011
  10684. mmg:    sta $de02
  10685.     lda tmpsl232
  10686.     bit c07
  10687.     beq sftint4
  10688.     ldx #$01
  10689.     stx stat
  10690. sftint4    bit    c08
  10691.     beq    sftint9        ; Not a receive interrupt.  Exit
  10692. mmi:    lda    $de00        ; Get received data
  10693.     ldx    rdhead
  10694.     inx    
  10695.     cpx    rdtail
  10696.     beq    sftint7        ; Receive buffer overrun
  10697.     dex    
  10698.     sta    rdbuf,x        ; Store received data
  10699.     inc    rdhead
  10700.     jmp    sftint8
  10701. sftint7    lda    #$01
  10702.     sta    stat        ; receive buffer overrun; set stat nonzero
  10703. sftint8:
  10704.     pla
  10705.     tax
  10706. mmj:    lda $de02
  10707.     and #%11110000
  10708.     ora #%00001001
  10709. mmk:    sta $de02
  10710.     pla             ; Retrieve A register
  10711.     rti
  10712. sftint9:
  10713.     pla
  10714.     tax
  10715. mml:    lda $de02
  10716.     and #%11110000
  10717.     ora #%00001001
  10718. mmm:    sta $de02
  10719. sftint3:    pla             ; Retrieve A register
  10720.     jmp (orignmiv)
  10721.  
  10722.  
  10723. tmpsl232:  .byte 00
  10724.  
  10725.  
  10726.  
  10727. ;   Change port.  Set the port for use with the Swift Link Cart
  10728. ;   Loads the port High Address from portadd and stores modifies
  10729. ;   the code to use the new address
  10730. ;
  10731. changport:     sei
  10732.         ldx portadd
  10733.         lda portlist,x
  10734.         sta chprest+2
  10735. chprest: sta $de01        ; This gets modified reset the port (xx01)
  10736. ; Ok now we need to modify all the bloody code
  10737.         sta mm1+2
  10738.         sta mm2+2
  10739.         sta dopari+2
  10740.         sta mm3+2
  10741.         sta mm4+2
  10742.         sta mm5+2
  10743.         sta dowrd+2
  10744.         sta dowrd1+2
  10745.         sta mm6+2
  10746.         sta mm7+2
  10747.         sta sbreak+2
  10748.         sta mm8+2
  10749.         sta mm9+2
  10750.         sta mma+2
  10751.         sta mmb+2
  10752.         sta mmc+2
  10753.         sta sfttr1+2
  10754.         sta mmd+2
  10755.         sta mme+2
  10756.         sta mmf+2
  10757.         sta mmg+2
  10758.         sta mmh+2
  10759.         sta mmi+2
  10760.         sta mmj+2
  10761.         sta mmk+2
  10762.         sta mml+2
  10763.         sta mmm+2
  10764.         sta chprest+2
  10765.         cli
  10766.         jsr sftini
  10767.         jsr dobad
  10768.         jsr dopari
  10769.         jsr dowrd
  10770.         rts
  10771.  
  10772.  
  10773.  
  10774.  
  10775. rts
  10776.  
  10777. ;
  10778. ;
  10779. ;   Cva2s - Convert ASCII to Speedscript (word processor)
  10780. ;
  10781. ;    Input:    Character in KERCHR
  10782. ;
  10783. ;    Output:    Converted character in KERCHR
  10784. ;
  10785. ;    Registers Destroyed: A
  10786. ;
  10787.  
  10788. cva2s:  lda    kerchr        ;[DD]
  10789.     and    #$7f        ;[DD]
  10790.     cmp    #cr        ;[DD]
  10791.     bne    cva2s1      ;[DD] Check cr
  10792.     lda    #$1f        ;[DD]
  10793. cva2s1: cmp    #$61        ;[DD]
  10794.     bcc    cva2s2        ;[DD]
  10795.     cmp    #$7b        ;[DD]
  10796.     bcs    cva2s2        ;[DD]
  10797.     and    #$1f        ;[DD] Convert lower case
  10798. cva2s2: cmp    #$5b        ;[DD]
  10799.     bcc    cva2s3        ;[DD]
  10800.     cmp    #$5f        ;[DD]
  10801.     bcs    cva2s3        ;[DD]
  10802.     and    #$1f        ;[DD]
  10803. cva2s3: sta    kerchr        ;[DD]
  10804.     rts            ;[DD]
  10805.  
  10806. ;  Convert Seedscript (word processor) to ASCII
  10807.  
  10808. cvs2a:  lda    kerchr        ;[DD]
  10809.     and    #$7f        ;[DD]
  10810. cvs2a1: cmp    #$1b        ;[DD]
  10811.     bcs    cvs2a2      ;[DD] If <$1b
  10812.     ora    #$60        ;[DD] Convert to lc
  10813. cvs2a2: cmp    #$1f        ;[DD]
  10814.     bcs    cvs2a3        ;[DD]
  10815.     ora    #$40        ;[DD]
  10816. cvs2a3: bne    cvs2a4         ;[DD] If =$1f
  10817.     lda    #cr        ;[DD] cr
  10818. cvs2a4:    sta    kerchr        ;[DD]
  10819.     rts            ;[DD]
  10820.  
  10821. .SBTTL    Spar and Rpar routines
  10822.  
  10823. ;
  10824. ;    Spar - This routine loads the data buffer with the init parameters
  10825. ;    requested for this Kermit.
  10826. ;
  10827. ;        Input:  NONE
  10828. ;
  10829. ;        Output: @Kerbf1 - Operational parameters
  10830. ;
  10831. ;        Registers destroyed:    A,Y
  10832. ;
  10833.  
  10834. spar:    ldy    #$00        ; Clear Y
  10835.     sty    datind        ; Clear datind
  10836.     lda    rpsiz        ; Fetch receive packet size
  10837.     clc            ; Clear the carry flag
  10838.     adc    #$20        ; Characterize it
  10839.     sta    (kerbf1),y    ; Stuff it in the packet buffer
  10840.     iny            ; Increment the buffer index
  10841.     lda    rtime        ; Get the timeout interval
  10842.     clc            ;        ...
  10843.     adc    #$20        ; Make that a printable character
  10844.     sta    (kerbf1),y    ;    and stuff it in the buffer
  10845.     iny            ; Advance the index
  10846.     lda    rpad        ; Get the amount of padding required
  10847.     clc            ;        ...
  10848.     adc    #$20        ; Make that printable
  10849.     sta    (kerbf1),y    ; Put it in the buffer
  10850.     iny            ; Advance index
  10851.     lda    rpadch        ; Get the padding character expected
  10852.     eor    #$40        ; Controlify it
  10853.     sta    (kerbf1),y    ; And stuff it
  10854.     iny            ; Up the packet buffer index
  10855.     lda    reol        ; Get the end-of-line expected
  10856.     clc            ;        ...
  10857.     adc    #$20        ; Characterize it
  10858.     sta    (kerbf1),y    ; Place that next in the buffer
  10859.     iny            ; Advance the index
  10860.     lda    rquote        ; Get the quote character expected
  10861.     sta    (kerbf1),y    ; Store it as-is last in the buffer
  10862.     iny            ; Advance index
  10863. ;    lda    #'Y        ;  Send 'Y' - I will support 8-bit quoting
  10864. ;    sta    (kerbf1),y    ; Stuff it into the data area
  10865.     lda    ebqmod        ;[30] Get eight-bit quoting
  10866.     cmp    #off        ;[30] Is it off?
  10867.     beq    spar1        ;[30] Yes...say we will do it if HE wants to
  10868.     lda    sebq        ;[30] Get eight-bit quote character
  10869.     sta    (kerbf1),y    ;[30] So other Kermit knows we are
  10870.     rts            ;[30]    requesting it
  10871. spar1:    lda    #'Y        ; Send 'Y' - I will support 8-bit quoting
  10872.     sta    (kerbf1),y    ; Stuff it into the data area
  10873.     rts            ;        ...
  10874.  
  10875. ;
  10876. ;
  10877. ;    Rpar - This routine sets operational parameters for the other kermit
  10878. ;    from the init packet data buffer.
  10879. ;
  10880. ;        Input:  @Kerbf1 - Operational parameters
  10881. ;
  10882. ;        Output: Operational parameters set
  10883. ;
  10884. ;        Registers destroyed:    A,Y
  10885. ;
  10886.  
  10887. rpar:    ldy    #$00        ; Start the data index at 0!
  10888.     lda    (kerbf1),y    ; Start grabbing data from packet buffer
  10889.     sec            ; Uncharacterize it
  10890.     sbc    #$20        ;        ...
  10891.     sta    spsiz        ; That must be the packet size of other Kermit
  10892.     iny            ; Increment the buffer index
  10893.     lda    (kerbf1),y    ; Get the next item
  10894.     sec            ;        ...
  10895.     sbc    #$20        ; Uncharacterize that
  10896.     sta    stime        ; Other Kermit's timeout interval
  10897.     iny            ; Up the index once again
  10898.     lda    (kerbf1),y    ; Get next char
  10899.     sec            ;        ...
  10900.     sbc    #$20        ; Restore to original value
  10901.     sta    spad        ; This is the amount of padding he wants
  10902.     iny            ; Advnace index
  10903.     lda    (kerbf1),y    ; Next item
  10904.     eor    #$40        ; Uncontrolify this one
  10905.     sta    spadch        ; That is padding character for other Kermit
  10906.     iny            ; Advance index
  10907.     lda    (kerbf1),y    ; Get next item of data
  10908.     cmp    #$00        ; If it is equal to zero
  10909.     beq    rpar2        ; Use <cr> as a default
  10910.     jmp    rpar3        ;        ...
  10911. rpar2:  lda    #cr        ; Get value of <cr>
  10912.     sta    seol        ; That will be the eol character
  10913.     jmp    rpar4        ; Continue
  10914. rpar3:  sec            ;        ...
  10915.     sbc    #$20        ; unchar the character
  10916.     sta    seol        ; That is the eol character other Kermit wants
  10917. rpar4:  iny            ; Advance the buffer index
  10918.     lda    (kerbf1),y    ; Get quoting character
  10919.     cmp    #$00        ; If that is zero
  10920.     beq    rpar5        ; Use # sign as the quote character
  10921.     jmp    rpar6        ; Otherwise, give him what he wants
  10922. rpar5:  lda    #'#        ; Load # sign
  10923. rpar6:  sta    squote        ; Make that the other Kermit's quote character
  10924.     iny            ; Advance the index
  10925.     lda    pdlen        ; Check the data length to see
  10926.     cmp    #$09        ;    if the 8-bit quote is there
  10927.     bmi    rparrt        ; If not, return
  10928.     lda    (kerbf1),y    ; Fetch the 8-bit quote
  10929.     cmp    #'N        ; Is it 'N'
  10930.     beq    rpar8        ; Yes, leave.(he doesn't support 8-bit)
  10931.     cmp    #'Y        ; Does he support 8-bit quoting?
  10932.     beq    rpar8        ; If so, leave. (we don't need it.)
  10933.     cmp    #'!        ; Now, it should be a real character
  10934.     bmi    rparrt        ;    Check if it is in range.
  10935.     cmp    #'?        ;    If so, we set the 8-bit quote char
  10936.     bmi    rpar7        ;    and set 8-bit quoting on.
  10937.     cmp    #$60        ;    If not, just leave.
  10938.     bmi    rparrt        ;        ...
  10939.     cmp    #del        ;        ...
  10940.     bpl    rparrt        ;        ...
  10941. rpar7:    sta    sebq        ; Stuff the character here
  10942.     lda    #on        ; Set 8-bit quoting on
  10943.     sta    ebqmod        ;        ...
  10944.     rts            ; Return
  10945. rpar8:    sta    sebq        ; Make sure this parm is stored
  10946.     lda    #off        ;    AND that 8-bit quoting is off.
  10947.     sta    ebqmod        ;        ...
  10948. rparrt:    rts            ; Return
  10949.  
  10950. ;
  10951. ;
  10952. ;    Nakit - sends a standard NAK packet out to the other Kermit.
  10953. ;
  10954. ;        Input:  NONE
  10955. ;
  10956. ;        Output: NONE
  10957. ;
  10958.  
  10959. nakit:  lda    #$00        ; Zero the packet data length
  10960.     sta    pdlen        ;        ...
  10961.     lda    #'N        ; Set up a nak packet type
  10962.     sta    ptype        ;        ...
  10963.     jsr    spak        ; Now, send it
  10964.     rts            ; Return
  10965.  
  10966.  
  10967. .SBTTL    Message text
  10968.  
  10969. versio1:.byte    "Commodore 64/128 Kermit version 2.2 (76)"
  10970.     .byte    cr
  10971.     .byte   "for SwiftLink-232 interface ONLY"
  10972.     .byte   cr
  10973.     .byte    0
  10974. versio2:.byte    "Type '?' for help"
  10975.     .byte    cr
  10976.     .byte    0        ; [53]
  10977.  
  10978.  
  10979. .SBTTL    Command tables and help text
  10980.  
  10981. kercmd: .byte    $10        ;[DD][EL][40][] Table length 
  10982.  
  10983.     .byte    $03        ; 
  10984.     .byte    "bye"        ; 
  10985.     .byte    0        ; [53]
  10986.  
  10987.     .byte    $1E,$1E        ; 
  10988.  
  10989.     .byte    $07        ; Keyword length
  10990.     .byte    "connect"    ; Keyword terminated with a null
  10991.     .byte    0        ; [53]
  10992.  
  10993.     .byte    $00,$00        ; Two bytes of data
  10994.  
  10995.     .byte    $09        ;
  10996.     .byte    "directory"    ;
  10997.     .byte    0        ; [53]
  10998.  
  10999.     .byte    $2a,$2a        ;
  11000.  
  11001.     .byte    $04        ;
  11002.     .byte    "disk"        ;
  11003.     .byte    0        ; [53]
  11004.  
  11005.     .byte    $27,$27        ;
  11006.  
  11007.     .byte    $04        ;
  11008.     .byte    "exit"        ;
  11009.     .byte    0        ; [53]
  11010.  
  11011.     .byte    $03,$03        ;
  11012.  
  11013.     .byte    $06        ; 
  11014.     .byte    "finish"    ; 
  11015.     .byte    0        ; [53]
  11016.  
  11017.     .byte    $21,$21        ; 
  11018.  
  11019.     .byte    $03        ; 
  11020.     .byte    "get"        ; 
  11021.     .byte    0        ; [53]
  11022.  
  11023.     .byte    $24,$24        ; 
  11024.  
  11025.     .byte    $04
  11026.     .byte    "help"
  11027.     .byte    0        ; [53]
  11028.  
  11029.     .byte    $06,$06
  11030.  
  11031.  
  11032.     .byte    $04
  11033.     .byte    "quit"
  11034.     .byte    0        ; [53]
  11035.  
  11036.     .byte    $0C,$0C
  11037.  
  11038.     .byte    $07
  11039.     .byte    "receive"
  11040.     .byte    0        ; [53]
  11041.  
  11042.     .byte    $0F,$0F
  11043.  
  11044.  
  11045.     .byte    $07        ;[47]
  11046.     .byte    "restore"    ;[47]
  11047.     .byte    0        ; [53]
  11048.  
  11049.     .byte    $30,$30        ;[47]
  11050.  
  11051.     .byte    $04        ;[47]
  11052.     .byte    "save"        ;[47]
  11053.     .byte    0        ; [53]
  11054.  
  11055.     .byte    $2d,$2d        ;[47]
  11056.  
  11057.     .byte    $04
  11058.     .byte    "send"
  11059.     .byte    0        ; [53]
  11060.  
  11061.     .byte    $12,$12
  11062.  
  11063.     .byte    $03
  11064.     .byte    "set"
  11065.     .byte    0        ; [53]
  11066.  
  11067.     .byte    $15,$15
  11068.  
  11069.     .byte    $04
  11070.     .byte    "show"
  11071.     .byte    0        ; [53]
  11072.  
  11073.     .byte    $18,$18
  11074.  
  11075.     .byte    $06
  11076.     .byte    "status"
  11077.     .byte    0        ; [53]
  11078.  
  11079.     .byte    $1B,$1B
  11080.  
  11081. setcmd: .byte    $18        ;[DD][EL][17][37]
  11082.  
  11083.     .byte    $04        ;[17]
  11084.     .byte    "baud"        ;[17]
  11085.     .byte    0        ; [53]
  11086.  
  11087.     .byte    $27,$27        ;[17]
  11088.  
  11089.     .byte    $04
  11090.     .byte    "bold"
  11091.     .byte    $00
  11092.     .byte    $3c,$3c
  11093.  
  11094.     .byte    $06
  11095.     .byte    "border"
  11096.     .byte    $00
  11097.     .byte    $3f,$3f
  11098.  
  11099.     .byte    $09
  11100.     .byte    "character"
  11101.     .byte    $00
  11102.     .byte    $39,$39
  11103.  
  11104.     .byte    $0f
  11105.     .byte    "dark-background"
  11106.     .byte    $00
  11107.     .byte    $33,$33
  11108.  
  11109.     .byte    $09
  11110.     .byte    "debugging"
  11111.     .byte    0        ; [53]
  11112.  
  11113.     .byte    $18,$18
  11114.  
  11115.     .byte    $11
  11116.     .byte    "eight-bit-quoting"
  11117.     .byte    0        ; [53]
  11118.  
  11119.     .byte    $15,$15
  11120.  
  11121.     .byte    $06
  11122.     .byte    "escape"
  11123.     .byte    0        ; [53]
  11124.  
  11125.     .byte    $00,$00
  11126.  
  11127.     .byte    $0E
  11128.     .byte    "file-byte-size"
  11129.     .byte    0        ; [53]
  11130.  
  11131.     .byte    $1E,$1E
  11132.  
  11133.     .byte    $09
  11134.     .byte    "file-type"
  11135.     .byte    0        ; [53]
  11136.  
  11137.     .byte    $1B,$1B
  11138.  
  11139.     .byte    $0C
  11140.     .byte    "file-warning"
  11141.     .byte    0        ; [53]
  11142.  
  11143.     .byte    $12,$12
  11144.  
  11145.     .byte    $0C        ;[24]
  11146.     .byte    "flow-control"    ;[24]
  11147.     .byte    0        ; [53]
  11148.  
  11149.     .byte    $2d,$2d        ;[24]
  11150.  
  11151.     .byte    $03        ; 
  11152.     .byte    "ibm"        ; 
  11153.     .byte    0        ; [53]
  11154.  
  11155.     .byte    $03,$03        ; 
  11156.  
  11157.     .byte    $10
  11158.     .byte    "light-background"
  11159.     .byte    $00
  11160.     .byte    $36,$36
  11161.  
  11162.     .byte    $0A
  11163.     .byte    "local-echo"
  11164.     .byte    0        ; [53]
  11165.  
  11166.     .byte    $06,$06
  11167.  
  11168.     .byte    $06        ; 
  11169.     .byte    "parity"    ; 
  11170.     .byte    0        ; [53]
  11171.  
  11172.     .byte    $24,$24        ; 
  11173.  
  11174.     .byte   $0c
  11175.     .byte   "port-address"
  11176.     .byte   0
  11177.     .byte   $42, $42
  11178.  
  11179.  
  11180.     .byte    $07
  11181.     .byte    "receive"
  11182.     .byte    0        ; [53]
  11183.  
  11184.     .byte    $09,$09
  11185.  
  11186.     .byte    $0F        ;[DD]
  11187.     .byte    "rs232-registers"    ;[DD]
  11188.     .byte    0        ; [53]
  11189.  
  11190.     .byte    $21,$21        ;[DD]
  11191.  
  11192.     .byte    $04
  11193.     .byte    "send"
  11194.     .byte    0        ; [53]
  11195.  
  11196.     .byte    $0C,$0C
  11197.  
  11198.     .byte    $0d        ;[37]
  11199.     .byte    "screen-driver"    ;[37]
  11200.     .byte    0        ; [53]
  11201.  
  11202.     .byte    $30,$30        ;[37]
  11203.  
  11204.     .byte    $12
  11205.     .byte    "terminal-emulation"
  11206.     .byte    0        ; [53]
  11207.  
  11208.     .byte    $0F,$0F
  11209.  
  11210.     .byte    $09            ;[17]
  11211.     .byte    "word-size"        ;[17]
  11212.     .byte    0        ; [53]
  11213.  
  11214.     .byte    $2a,$2a
  11215.  
  11216.     .byte   $0d
  11217.     .byte   "working-drive"
  11218.     .byte   0
  11219.     .byte  $45, $45
  11220.  
  11221.  
  11222. shocmd: .byte    $13        ;[DD][17]
  11223.  
  11224.     .byte    $03
  11225. shodef:    .byte    "all"
  11226.     .byte    0        ; [53]
  11227.  
  11228.     .byte    $00,$00
  11229.  
  11230.     .byte    $04        ;[17]
  11231.     .byte    "baud"        ;[17]
  11232.     .byte    0        ; [53]
  11233.  
  11234.     .byte    $7e,$7e        ;[17]
  11235.  
  11236.     .byte    $09
  11237.     .byte    "debugging"
  11238.     .byte    0        ; [53]
  11239.  
  11240.     .byte    $51,$51
  11241.  
  11242.     .byte    $11
  11243.     .byte    "eight-bit-quoting"
  11244.     .byte    0        ; [53]
  11245.  
  11246.     .byte    $48,$48
  11247.  
  11248.     .byte    $06
  11249.     .byte    "escape"
  11250.     .byte    0        ; [53]
  11251.  
  11252.     .byte    $09,$09
  11253.  
  11254.     .byte    $0E
  11255.     .byte    "file-byte-size"
  11256.     .byte    0        ; [53]
  11257.  
  11258.     .byte    $63,$63
  11259.  
  11260.     .byte    $09
  11261.     .byte    "file-type"
  11262.     .byte    0        ; [53]
  11263.  
  11264.     .byte    $5A,$5A
  11265.  
  11266.     .byte    $0C
  11267.     .byte    "file-warning"
  11268.     .byte    0        ; [53]
  11269.  
  11270.     .byte    $3F,$3F
  11271.  
  11272.     .byte    $0C        ;[24]
  11273.     .byte    "flow-control"    ;[24]
  11274.     .byte    0        ; [53]
  11275.  
  11276.     .byte    $90,$90        ;[24]
  11277.  
  11278.     .byte    $03        ; 
  11279.     .byte    "ibm"
  11280.     .byte    0        ; [53]
  11281.  
  11282.     .byte    $12,$12
  11283.  
  11284.     .byte    $0A
  11285.     .byte    "local-echo"
  11286.     .byte    0        ; [53]
  11287.  
  11288.     .byte    $1B,$1B
  11289.  
  11290.     .byte    $06
  11291.     .byte    "parity"
  11292.     .byte    0        ; [53]
  11293.  
  11294.     .byte    $75,$75
  11295.  
  11296.     .byte  $0c
  11297.     .byte   "port-address"
  11298.     .byte  0
  11299.     .byte  $99, $99
  11300.  
  11301.  
  11302.     .byte    $07
  11303.     .byte    "receive"
  11304.     .byte    0        ; [53]
  11305.  
  11306.     .byte    $24,$24
  11307.  
  11308.     .byte    $0F            ;[DD]
  11309.     .byte    "rs232-registers"    ;[DD]
  11310.     .byte    0        ; [53]
  11311.  
  11312.     .byte    $6C,$6C            ;[DD]
  11313.  
  11314.     .byte    $04
  11315.     .byte    "send"
  11316.     .byte    0        ; [53]
  11317.  
  11318.     .byte    $2D,$2D
  11319.  
  11320.     .byte    $12
  11321.     .byte    "terminal-emulation"
  11322.     .byte    0        ; [53]
  11323.  
  11324.     .byte    $36,$36
  11325.  
  11326.     .byte    $09            ;[17]
  11327.     .byte    "word-size"        ;[17]
  11328.     .byte    0        ; [53]
  11329.  
  11330.     .byte    $87,$87            ;[17]
  11331.  
  11332.     .byte  $0d
  11333.     .byte   "working-drive"
  11334.     .byte   0
  11335.     .byte  $a2, $a2
  11336.  
  11337. stscmd: .byte    $07
  11338.  
  11339.     .byte    $14
  11340.     .byte    "eight-bit-quote-char"
  11341.     .byte    0        ; [53]
  11342.  
  11343.     .byte    $06,$06
  11344.  
  11345.     .byte    $0B
  11346.     .byte    "end-of-line"
  11347.     .byte    0        ; [53]
  11348.  
  11349.     .byte    $09,$09
  11350.  
  11351.     .byte    $0D
  11352.     .byte    "packet-length"
  11353.     .byte    0        ; [53]
  11354.  
  11355.     .byte    $0C,$0C
  11356.  
  11357.     .byte    $08
  11358.     .byte    "pad-char"
  11359.     .byte    0        ; [53]
  11360.  
  11361.     .byte    $00,$00
  11362.  
  11363.     .byte    $07
  11364.     .byte    "padding"
  11365.     .byte    0        ; [53]
  11366.  
  11367.     .byte    $03,$03
  11368.  
  11369.     .byte    $0A
  11370.     .byte    "quote-char"
  11371.     .byte    0        ; [53]
  11372.  
  11373.     .byte    $0F,$0F
  11374.  
  11375.     .byte    $07
  11376.     .byte    "timeout"
  11377.     .byte    0        ; [53]
  11378.  
  11379.     .byte    $12,$12
  11380.  
  11381.  
  11382. ftcmd:  .byte    $05
  11383.  
  11384.     .byte    $05
  11385. ftcdef:    .byte    "ascii"
  11386.     .byte    0        ; [53]
  11387.  
  11388.     .byte    $00,$00
  11389.  
  11390.     .byte    $06
  11391.     .byte    "binary"
  11392.     .byte    0        ; [53]
  11393.  
  11394.     .byte    $03,$03
  11395.  
  11396.     .byte    $07
  11397.     .byte    "c-power"
  11398.     .byte    0
  11399.     .byte    $04,$04
  11400.  
  11401.     .byte    $07
  11402.     .byte    "petscii"
  11403.     .byte    0        ; [53]
  11404.  
  11405.     .byte    $01,$01
  11406.  
  11407.     .byte    $06
  11408.     .byte    "script"
  11409.     .byte    0        ; [53]
  11410.  
  11411.     .byte    $02,$02
  11412.  
  11413. parkey:    .byte    $05        ; LENGTH OF THIS TABLE IS 5
  11414.  
  11415.     .byte    $04        ;
  11416.     .byte    "even"        ;
  11417.     .byte    0        ; [53]
  11418.  
  11419.     .byte    $04,$04        ;
  11420.  
  11421.     .byte    $04        ;
  11422.     .byte    "mark"        ;
  11423.     .byte    0        ; [53]
  11424.  
  11425.     .byte    $02,$02        ;
  11426.  
  11427.     .byte    $04        ;
  11428.     .byte    "none"        ;
  11429.     .byte    0        ; [53]
  11430.  
  11431.     .byte    $00,$00        ;
  11432.  
  11433.     .byte    $03        ;
  11434.     .byte    "odd"        ;
  11435.     .byte    0        ; [53]
  11436.  
  11437.     .byte    $03,$03        ;
  11438.  
  11439.     .byte    $05        ;
  11440.     .byte    "space"        ;
  11441.     .byte    0        ; [53]
  11442.  
  11443.     .byte    $01,$01        ;
  11444.  
  11445. bdkey:    .byte    $05            ; LENGTH OF THIS TABLE IS 5
  11446.  
  11447.     .byte    $03
  11448.     .byte    "300"
  11449.     .byte    0
  11450.     .byte    $00,$00
  11451.  
  11452.     .byte    $04
  11453.     .byte    "1200"
  11454.     .byte    0
  11455.     .byte    $01,$01
  11456.  
  11457.     .byte    $04
  11458.     .byte    "2400"
  11459.     .byte    0        ; [53]
  11460.     .byte    $02,$02
  11461.  
  11462.     .byte    $04
  11463.     .byte    "4800"
  11464.     .byte    0        ;
  11465.     .byte    $03,$03
  11466.  
  11467.     .byte    $04
  11468.     .byte    "9600"
  11469.     .byte    0        ;
  11470.     .byte    $04,$04
  11471.  
  11472.  
  11473. pokey:    .byte    $03            ; LENGTH OF THIS TABLE IS 3
  11474.  
  11475.     .byte    $05
  11476.     .byte    "$d700"
  11477.     .byte    0        ; [53]
  11478.     .byte    $00,$00
  11479.  
  11480.     .byte    $05
  11481.     .byte    "$de00"
  11482.     .byte    0
  11483.     .byte    $01,$01
  11484.  
  11485.     .byte    $05
  11486.     .byte    "$df00"
  11487.     .byte    0
  11488.     .byte    $02,$02
  11489.  
  11490. portlist:    .byte $d7,$de,$df
  11491.  
  11492.  
  11493. debkey:    .byte    $03        ; LENGTH OF THIS TABLE IS 3
  11494.  
  11495.     .byte    $03        ;
  11496.     .byte    "off"        ;
  11497.     .byte    0        ; [53]
  11498.  
  11499.     .byte    $00,$00        ;
  11500.  
  11501.     .byte    $05        ;
  11502.     .byte    "terse"        ;
  11503.     .byte    0        ; [53]
  11504.  
  11505.     .byte    $01,$01        ;
  11506.  
  11507.     .byte    $07        ;
  11508.     .byte    "verbose"    ;
  11509.     .byte    0        ; [53]
  11510.  
  11511.     .byte    $02,$02        ;
  11512.  
  11513. fbskey: .byte    $02
  11514.  
  11515.     .byte    $09
  11516.     .byte    "eight-bit"
  11517.     .byte    0        ; [53]
  11518.  
  11519.     .byte    $00,$00
  11520.  
  11521.     .byte    $09
  11522.     .byte    "seven-bit"
  11523.     .byte    0        ; [53]
  11524.  
  11525.     .byte    $01,$01
  11526.  
  11527. oncmd:  .byte    $02
  11528.  
  11529.     .byte    $02
  11530.     .byte    "on"
  11531.     .byte    0        ; [53]
  11532.  
  11533.     .byte    $01,$01
  11534.  
  11535.     .byte    $03
  11536.     .byte    "off"
  11537.     .byte    0        ; [53]
  11538.  
  11539.     .byte    $00,$00
  11540.  
  11541. yescmd: .byte    $02
  11542.  
  11543.     .byte    $02
  11544.     .byte    "no"
  11545.     .byte    0        ; [53]
  11546.  
  11547.     .byte    $00,$00
  11548.  
  11549.     .byte    $03
  11550.     .byte    "yes"
  11551.     .byte    0        ; [53]
  11552.  
  11553.     .byte    $01,$01
  11554.  
  11555. scrkey:    .byte    $05        ;[37]
  11556.  
  11557.     .byte    $0a        ;[37]
  11558.     .byte    "40-columns"    ;[37]
  11559.     .byte    0        ; [53]
  11560.  
  11561.     .byte    $00,$00        ;[37]
  11562.  
  11563.     .byte    $0a        ;[37]
  11564.     .byte    "80-columns"    ;[37]
  11565.     .byte    0        ; [53]
  11566.  
  11567.     .byte    $01,$01        ;[37]
  11568.  
  11569.     .byte    5
  11570.     .byte    "bi-80"
  11571.     .byte    0
  11572.  
  11573.     .byte    $03,$03
  11574.  
  11575.     .byte    $0d
  11576.     .byte    "commodore-128"
  11577.     .byte    0
  11578.  
  11579.     .byte    $02,$02
  11580.  
  11581.     .byte    $0c
  11582.     .byte    "custom-bi-80"
  11583.     .byte    0
  11584.  
  11585.     .byte    $04,$04
  11586.  
  11587. termemu:.byte    $03        ;terminal emulation may be none, vt52 or vt100
  11588.  
  11589.     .byte    $04
  11590.     .byte    "none"
  11591.     .byte    0
  11592.  
  11593.     .byte    $00,$00
  11594.  
  11595.     .byte    $06
  11596.     .byte    "vt-100"
  11597.     .byte    0
  11598.  
  11599.     .byte    $02,$02
  11600.  
  11601.     .byte    $05
  11602.     .byte    "vt-52"
  11603.     .byte    0
  11604.  
  11605.     .byte    $01,$01
  11606.  
  11607. colors:    .byte    $10        ; color names
  11608.  
  11609.     .byte    $05
  11610.     .byte    "black"
  11611.     .byte    $00
  11612.     .byte    $00,$00
  11613.  
  11614.     .byte    $04
  11615.     .byte    "blue"
  11616.     .byte    $00
  11617.     .byte    $06,$06
  11618.  
  11619.     .byte    $05
  11620.     .byte    "brown"
  11621.     .byte    $00
  11622.     .byte    $09,$09
  11623.  
  11624.     .byte    $04
  11625.     .byte    "cyan"
  11626.     .byte    $00
  11627.     .byte    $03,$03
  11628.  
  11629.     .byte    $09
  11630.     .byte    "dark-grey"
  11631.     .byte    $00
  11632.     .byte    $0b,$0b
  11633.  
  11634.     .byte    $05
  11635.     .byte    "green"
  11636.     .byte    $00
  11637.     .byte    $05,$05
  11638.  
  11639.     .byte    $0a
  11640.     .byte    "light-blue"
  11641.     .byte    $00
  11642.     .byte    $0e,$0e
  11643.  
  11644.     .byte    $0b
  11645.     .byte    "light-green"
  11646.     .byte    $00
  11647.     .byte    $0d,$0d
  11648.  
  11649.     .byte    $0a
  11650.     .byte    "light-grey"
  11651.     .byte    $00
  11652.     .byte    $0f,$0f
  11653.  
  11654.     .byte    $09
  11655.     .byte    "light-red"
  11656.     .byte    $00
  11657.     .byte    $0a,$0a
  11658.  
  11659.     .byte    $0b
  11660.     .byte    "medium-grey"
  11661.     .byte    $00
  11662.     .byte    $0c,$0c
  11663.  
  11664.     .byte    $06
  11665.     .byte    "orange"
  11666.     .byte    $00
  11667.     .byte    $08,$08
  11668.  
  11669.     .byte    $06
  11670.     .byte    "purple"
  11671.     .byte    $00
  11672.     .byte    $04,$04
  11673.  
  11674.     .byte    $03
  11675.     .byte    "red"
  11676.     .byte    $00
  11677.     .byte    $02,$02
  11678.  
  11679.     .byte    $05
  11680.     .byte    "white"
  11681.     .byte    $00
  11682.     .byte    $01,$01
  11683.  
  11684.     .byte    $06
  11685.     .byte    "yellow"
  11686.     .byte    $00
  11687.     .byte    $07,$07
  11688.  
  11689. ;ddskey:    .byte    $01
  11690.  
  11691. ;    .byte    $05
  11692. ;    .asciz    /DRIVE/
  11693. ;    .byte    $00,$00
  11694.  
  11695. kerehr:    .byte    cmcfm        ; tell them they can also confirm
  11696.     .byte    nul        ; end help command string
  11697.  
  11698. kereht:    .byte    cmtxt        ;[]
  11699.     .byte    nul
  11700.  
  11701. kerhlp: .byte    cr
  11702.     .byte    "Kermit commands for this version are:"
  11703.     .byte    cr
  11704.     .byte    cr
  11705.     .byte    "Bye       Shut  down  and  log  out  a"    ; new command
  11706.     .byte    cr                        ;
  11707.     .byte    "          remote  Kermit server,  then"    ;
  11708.     .byte    cr                        ;
  11709.     .byte    "          exit."                ;
  11710.     .byte    cr
  11711.     .byte    cr
  11712.     .byte    "Connect   Allow user to talk to remote"
  11713.     .byte    cr
  11714.     .byte    "          Kermit directly."
  11715.     .byte    cr
  11716.     .byte    cr
  11717. ;    .ascii  /dos       send dos command to disk/    ;[DD]
  11718.     .byte    "Directory List disk directory."        ;[]
  11719.     .byte    cr
  11720.     .byte    cr
  11721.     .byte    "Disk      Send command string to disk."    ;[]
  11722.     .byte    cr
  11723.     .byte    cr
  11724.     .byte    "Exit      Exit  from  Kermit  back  to"
  11725.     .byte    cr
  11726.     .byte    "          the  host operating  system."
  11727.     .byte    cr
  11728.     .byte    cr
  11729.     .byte    "Finish    Shut   down  remote   Kermit"  ; new command
  11730.     .byte    cr                      ;
  11731.     .byte    "          server  but  do not  log out"  ;
  11732.     .byte    cr                      ;
  11733.     .byte    "          remote job. Do not exit from"  ;
  11734.     .byte    cr                        ;
  11735.     .byte    "          local Kermit."            ;
  11736.     .byte    cr
  11737.     .byte    cr
  11738.     .byte    "Get       Fetch  a file from a  remote"  ; new command
  11739.     .byte    cr                        ;
  11740.     .byte    "          server Kermit.  The filename"  ;
  11741.     .byte    cr                        ;
  11742.     .byte    "          is  validated by  the remote"  ;
  11743.     .byte    cr                        ;
  11744.     .byte    "          server."                ;
  11745.     .byte    cr                        ;
  11746.     .byte    cr                        ;
  11747.     .byte    "Quit      Same as exit."
  11748.     .byte    cr
  11749.     .byte    cr
  11750.     .byte    "Receive   Receive a file or file group"
  11751.     .byte    cr
  11752.     .byte    "          from the remote host."
  11753.     .byte    cr
  11754.     .byte    cr
  11755.     .byte    "Restore   Restore  Kermit  parameters"    ;[47]
  11756.     .byte    cr
  11757.     .byte    "          from file KERMIT.INI."
  11758.     .byte    cr
  11759.     .byte    cr
  11760.     .byte    "Save      Save  Kermit  parameters in"    ;[47]
  11761.     .byte    cr
  11762.     .byte    "          file KERMIT.INI."
  11763.     .byte    cr
  11764.     .byte    cr
  11765.     .byte    "Send      Sends  a   file   from   the"
  11766.     .byte    cr
  11767.     .byte    "          Commodore  to   the   remote"
  11768.     .byte    cr
  11769.     .byte    "          host."
  11770.     .byte    cr
  11771.     .byte    cr
  11772.     .byte    "Set       Establish various parameters,"
  11773.     .byte    cr
  11774.     .byte    "          such as debugging mode,  eol"
  11775.     .byte    cr
  11776.     .byte    "          character, and  transmission"
  11777.     .byte    cr
  11778.     .byte    "          delay."
  11779.     .byte    cr
  11780.     .byte    cr
  11781.     .byte    "Show      Display  various  parameters"
  11782.     .byte    cr
  11783.     .byte    "          established   by   the   set"
  11784.     .byte    cr
  11785.     .byte    "          command."
  11786.     .byte    cr
  11787.     .byte    cr
  11788.     .byte    "Status    Give  information about  the"
  11789.     .byte    cr
  11790.     .byte    "          last file transfer."
  11791.     .byte    cr,nul
  11792.  
  11793. inthlp: .byte    "One of the following:"
  11794.     .byte    cr
  11795.     .byte    "     ? - this help message."
  11796.     .byte    cr
  11797.     .byte    "     b - send a break signal."
  11798.     .byte    cr
  11799.     .byte    "     c - close the connection."
  11800.     .byte    cr
  11801.     .byte    "     s - status of connection."
  11802.     .byte    cr
  11803.     .byte    "     0 - send a null."
  11804.     .byte    cr
  11805.     .byte    "     escape-char - transmit the escape character."
  11806.     .byte    cr,nul
  11807.  
  11808. .SBTTL    Message Text
  11809.  
  11810. ermes1: .byte    cr
  11811.     .byte    "? Unrecognized command"
  11812.     .byte    0        ; [53]
  11813.  
  11814. ermes3: .byte    cr
  11815.     .byte    "? Not confirmed"
  11816.     .byte    0        ; [53]
  11817.  
  11818. ermes4: .byte    cr
  11819.     .byte    "? Integer out of range"
  11820.     .byte    0        ; [53]
  11821.  
  11822. ermes5: .byte    cr
  11823.     .byte    "? ASCII character is not in proper range"
  11824.     .byte    0        ; [53]
  11825.  
  11826. ermes6: .byte    cr
  11827.     .byte    "? Expecting keyword"
  11828.     .byte    0        ; [53]
  11829.  
  11830. ermes7: .byte    cr
  11831.     .byte    "? Expecting file spec"
  11832.     .byte    0        ; [53]
  11833.  
  11834. ermes8: .byte    cr
  11835.     .byte    "? Expecting integer"
  11836.     .byte    0        ; [53]
  11837.  
  11838. ermes9: .byte    cr
  11839.     .byte    "? Expecting switch"
  11840.     .byte    0        ; [53]
  11841.  
  11842. ermesa:    .byte    cr
  11843.     .byte    "?"
  11844.     .byte    0        ; [53]
  11845.  
  11846. ermesb:    .byte    cr
  11847.     .byte    "? Null string found while looking for text"
  11848.     .byte    0        ; [53]
  11849.  
  11850. ermesc:    .byte    cr
  11851.     .byte    "? Could not send generic logout packet"
  11852.     .byte    0        ; [53]
  11853.  
  11854. ermesd:    .byte    cr
  11855.     .byte    "? Could not send generic finish packet"
  11856.     .byte    0        ; [53]
  11857.  
  11858. ermesf:    .byte    cr
  11859.     .byte    "? Drive number out of range"
  11860.     .byte    0        ; [53]
  11861.  
  11862.  
  11863. erms0a: .byte    "Disk error stat =       "
  11864.     .byte    0        ; [53]
  11865.  
  11866. ;erms10: .byte    "Cannot receive init     "
  11867. ;    .byte    0        ; [53]
  11868.  
  11869. ;erms11: .byte    "Cannot receive file-head"
  11870. ;    .byte    0        ; [53]
  11871.  
  11872. ;erms12: .byte    "Cannot receive data     "
  11873. ;    .byte    0        ; [53]
  11874.  
  11875. ;erms14: .byte    "Max retry count exceeded"
  11876. ;    .byte    0        ; [53]
  11877.  
  11878. erms15: .byte    "Bad chksum:pack, actual "
  11879.     .byte    0        ; [53]
  11880.  
  11881. erms16: .byte    "Program error in rpak   "
  11882.     .byte    0        ; [53]
  11883.  
  11884. ;erms17: .byte    "8-bit quoting refused   "
  11885. ;    .byte    0        ; [53]
  11886.  
  11887. ;erms18: .byte    "Transfer aborted by user"
  11888. ;    .byte    0        ; [53]
  11889.  
  11890. ;erms19: .byte    "Cannot alter filename   "
  11891. ;    .byte    0        ; [53]
  11892.  
  11893. erms1a: .byte    "File already exists     "
  11894.     .byte    0        ; [53]
  11895.  
  11896.  
  11897. kerftp: .byte    "ascii     "
  11898.     .byte    0        ; [53]
  11899.  
  11900.     .byte    "petscii   "
  11901.     .byte    0        ; [53]
  11902.  
  11903.     .byte    "script    "
  11904.     .byte    0        ; [53]
  11905.  
  11906.     .byte    "binary    "
  11907.     .byte    0        ; [53]
  11908.  
  11909.     .byte    "c-power   "
  11910.     .byte    0
  11911.  
  11912. kerprs:    .byte    "none "        ; parity strings
  11913.     .byte    0        ; [53]
  11914.  
  11915.     .byte    "space"        ;
  11916.     .byte    0        ; [53]
  11917.  
  11918.     .byte    "mark "        ;
  11919.     .byte    0        ; [53]
  11920.  
  11921.     .byte    "odd  "        ;
  11922.     .byte    0        ; [53]
  11923.  
  11924.     .byte    "even "        ;
  11925.     .byte    0        ; [53]
  11926.  
  11927.  
  11928. parval:    .byte    %00000000    ;[17] None
  11929.     .byte    %11100000    ;[17] Space
  11930.     .byte    %10100000    ;[17] Mark
  11931.     .byte    %00100000    ;[17] Odd
  11932.     .byte    %01100000    ;[17] Even
  11933.  
  11934. kerbds:    .byte    "300 "
  11935.     .byte    0
  11936.     .byte    "1200"
  11937.     .byte    0
  11938.     .byte    "2400"
  11939.     .byte    0
  11940.     .byte   "4800"
  11941.     .byte   0
  11942.     .byte   "9600"
  11943.     .byte   0
  11944.  
  11945. bdval:    .byte    $05,$07,$08,$0A,$0C    ; swiftlink values for 
  11946.                                     ; 300, 1200, 2400, 4800, 9600 baud
  11947.  
  11948. kerdms:    .byte    "off     "    ; Debug mode strings
  11949.     .byte    0        ; [53]
  11950.  
  11951.     .byte    "terse   "    ;
  11952.     .byte    0        ; [53]
  11953.  
  11954.     .byte    "verbose "    ;
  11955.     .byte    0        ; [53]
  11956.  
  11957. kertms:    .byte    "none  "    ; terminal emulation strings
  11958.     .byte    0
  11959.  
  11960.     .byte    "vt-52 "
  11961.     .byte    0
  11962.  
  11963.     .byte    "vt-100"
  11964.     .byte    0
  11965.  
  11966.  
  11967. kerrts: .byte    "Spak:     Sending           - "
  11968.     .byte    0        ; [53]
  11969.  
  11970.     .byte    "Spakch:   Send complete     - "
  11971.     .byte    0        ; [53]
  11972.  
  11973.     .byte    "Rpak:     Trying to receive - "
  11974.     .byte    0        ; [53]
  11975.  
  11976.     .byte    "Rpkfls:   Failed to receive - "
  11977.     .byte    0        ; [53]
  11978.  
  11979.     .byte    "Rpkret:   Received          - "
  11980.     .byte    0        ; [53]
  11981.  
  11982.  
  11983. debms1: .byte    "Additional data"
  11984.     .byte    0        ; [53]
  11985.  
  11986. debms2: .byte    "     Seq number           "
  11987.     .byte    0        ; [53]
  11988.  
  11989. debms3: .byte    "     Number of data chars "
  11990.     .byte    0        ; [53]
  11991.  
  11992. debms4: .byte    "     Packet checksum      "
  11993.     .byte    0        ; [53]
  11994.  
  11995.  
  11996. snin01: .byte    "Sending: packet no. "
  11997.     .byte    0        ; [53]
  11998.  
  11999. rcin01: .byte    "Waiting: packet no. "
  12000.     .byte    0        ; [53]
  12001.  
  12002.  
  12003. shin00: .byte    "Debugging is          "
  12004.     .byte    0        ; [53]
  12005.  
  12006. shin01: .byte    "Terminal emulation is "
  12007.     .byte    0        ; [53]
  12008.  
  12009. shin02: .byte    "Ibm-mode is           "
  12010.     .byte    0        ; [53]
  12011.  
  12012. shin03: .byte    "Local-echo is         "
  12013.     .byte    0        ; [53]
  12014.  
  12015. shin04: .byte    "Eight-bit-quoting is  "
  12016.     .byte    0        ; [53]
  12017.  
  12018. shin05: .byte    "File-warning is       "
  12019.     .byte    0        ; [53]
  12020.  
  12021. shin06: .byte    "Escape character is   "
  12022.     .byte    0        ; [53]
  12023.  
  12024. shin07: .byte    "Send"
  12025.     .byte    0        ; [53]
  12026.  
  12027. shin08: .byte    "  Eight-bit-quoting char is   "
  12028.     .byte    0        ; [53]
  12029.  
  12030. shin09: .byte    "  End-of-line character is    "
  12031.     .byte    0        ; [53]
  12032.  
  12033. shin10: .byte    "  Packet-length is            "
  12034.     .byte    0        ; [53]
  12035.  
  12036. shin11: .byte    "  Padding character is        "
  12037.     .byte    0        ; [53]
  12038.  
  12039. shin12: .byte    "  Amount of padding is        "
  12040.     .byte    0        ; [53]
  12041.  
  12042. shin13: .byte    "  Quote character is          "
  12043.     .byte    0        ; [53]
  12044.  
  12045. shin14: .byte    "  Timeout character is        "
  12046.     .byte    0        ; [53]
  12047.  
  12048. shin15: .byte    "Receive"
  12049.     .byte    0        ; [53]
  12050.  
  12051. shin16: .byte    "File-type mode is     "
  12052.     .byte    0        ; [53]
  12053.  
  12054. shin17: .byte    "File-byte-size is     "
  12055.     .byte    0        ; [53]
  12056.  
  12057. shin18: .byte    "RS-232 registers =    $"
  12058.     .byte    0        ; [53]
  12059.  
  12060. shin19:    .byte    "Baud rate is          "    ;[17]
  12061.     .byte    0        ; [53]
  12062.  
  12063. shin20:    .byte    "Parity is             "    ;  FOR /SHOW PARITY/
  12064.     .byte    0        ; [53]
  12065.  
  12066. shin21:    .byte    "Word-size is          "    ;[17]
  12067.     .byte    0        ; [53]
  12068.  
  12069. shin22:    .byte    "Flow-control is       "    ;[24]
  12070.     .byte    0        ; [53]
  12071.  
  12072. shin23:    .byte    "Working-drive is      "
  12073.     .byte    0        ; [53]
  12074.  
  12075. shin24: .byte   "Port-address is       $"
  12076.     .byte 0
  12077. shin25: .byte   "00"
  12078.     .byte 0
  12079.  
  12080.  
  12081. shon:    .byte    "on"
  12082.     .byte    0        ; [53]
  12083.  
  12084. shoff:  .byte    "off"
  12085.     .byte    0        ; [53]
  12086.  
  12087. shsbit: .byte    "seven-bit"
  12088.     .byte    0        ; [53]
  12089.  
  12090. shebit: .byte    "eight-bit"
  12091.     .byte    0        ; [53]
  12092.  
  12093.  
  12094. sstrng:    .byte    "Sending: "            ; for terse debug
  12095.     .byte    0        ; [53]
  12096.  
  12097. rstrng:    .byte    "Received: "            ;        ...
  12098.     .byte    0        ; [53]
  12099.  
  12100.  
  12101. stin00: .byte    "Number of data chars sent is:     "
  12102.     .byte    0        ; [53]
  12103.  
  12104. stin01: .byte    "Number of data chars received is: "
  12105.     .byte    0        ; [53]
  12106.  
  12107. stin02: .byte    "Total no. of chars sent is:       "
  12108.     .byte    0        ; [53]
  12109.  
  12110. stin03: .byte    "Total no. of chars received is:   "
  12111.     .byte    0        ; [53]
  12112.  
  12113. stin04: .byte    "Overhead for send packets is:     "
  12114.     .byte    0        ; [53]
  12115.  
  12116. stin05: .byte    "Overhead for receive packets is:  "
  12117.     .byte    0        ; [53]
  12118.  
  12119. stin06: .byte    "Last error encountered is:        "
  12120.     .byte    0        ; [53]
  12121.  
  12122.  
  12123. inf01a: .byte    "[Connecting to host: type "
  12124.     .byte    0        ; [53]
  12125.  
  12126. inf01b: .byte    " c to return]"        ; second half of connect message
  12127.     .byte    0        ; [53]
  12128.  
  12129. .SBTTL    General Screen Manipulation Routines
  12130.  
  12131. ;
  12132. ;    These routines perform screen manipulation functions.  The usually
  12133. ;    call a screen driver, but some call lower-level manipulation routines.
  12134. ;
  12135. ;    These routines all turn the cursor off before calling the screen
  12136. ;    driver.
  12137. ;
  12138.  
  12139. ;
  12140. ;    scrini - call the screen drivers initilization code
  12141. ;
  12142. ;    Input:    None
  12143. ;    Output: Assorted screen parameters are set
  12144. ;
  12145. ;    Registers destroyed - A,X,Y
  12146. ;
  12147. ;    This routine initilizes some parameters and calls all of the screen
  12148. ;    drivers initilization code.
  12149. ;
  12150.  
  12151. scrini:    lda    #$00
  12152.     sta    line25        ; the 25th line is a status line
  12153.     jsr    c40ini
  12154.     jsr    c80ini
  12155.     jsr    c28ini
  12156.     jsr    b80ini
  12157.     jsr    m80ini
  12158.     rts
  12159.  
  12160. ;
  12161. ;    scrent - start up a screen driver
  12162. ;
  12163. ;    Input:    Screen type in scrtype
  12164. ;    Output: None
  12165. ;
  12166. ;    Registers destroyed - A,X,Y
  12167. ;
  12168. ;    This routine sets some parameters and then calls the screen driver to
  12169. ;    start it and set its parameters.  It then calls scred2 to erase the
  12170. ;    screen.
  12171. ;
  12172.  
  12173. scrent:    lda    #$00        ; cursor starts at row 1, column 1
  12174.     sta    cx
  12175.     sta    cy
  12176.     jsr    scrent1        ; call the screen driver
  12177.     jsr    scrtxt        ; initialize screen driver in text mode
  12178.     jsr    scrrst        ; reset parameters to normal values
  12179.     lda    line25        ; save the status of the 25th line
  12180.     pha
  12181.     lda    #$01        ; allow the 25th line to be cleared
  12182.     sta    line25
  12183.     jsr    scred2        ; clear entire screen
  12184.     pla            ; restore the status of the 25th line
  12185.     sta    line25
  12186.     rts            ; all done
  12187.  
  12188. scrent1:ldy    scrtype
  12189.     jsr    case
  12190.     .word    c40ent
  12191.     .word    c80ent
  12192.     .word    c28ent
  12193.     .word    b80ent
  12194.     .word    m80ent
  12195.  
  12196. ;
  12197. ;    scrext - exit from the screen driver
  12198. ;
  12199. ;    Input:    Screen type in scrtype
  12200. ;    Output: None
  12201. ;
  12202. ;    Registers destroyed - A,X,Y
  12203. ;
  12204. ;    This routine calls the screen driver to exit.  The hardware is returned
  12205. ;    to the state it was left in before kermit started.
  12206. ;
  12207.  
  12208. scrext:    ldy    scrtype
  12209.     jsr    case
  12210.     .word    c40ext
  12211.     .word    c80ext
  12212.     .word    c28ext
  12213.     .word    b80ext
  12214.     .word    m80ext
  12215.  
  12216. ;
  12217. ;    scrrst - reset the screen parameters to normal values
  12218. ;
  12219. ;    Input:    None
  12220. ;    Output: Assorted parameters changed.
  12221. ;
  12222. ;    Registers destroyed - A
  12223. ;
  12224. ;    This routine sets reverse mode off, flashing off, the scrolling
  12225. ;    region to full size, and many other things
  12226. ;
  12227.  
  12228. scrrst:    lda    #0        ; top of scrolling area is line 1
  12229.     sta    top
  12230.     lda    #23        ; bottom of scrolling area is line 24
  12231.     clc
  12232.     adc    line25        ; or 25
  12233.     sta    bot
  12234.     lda    #$00
  12235.     sta    underln        ; underline is off
  12236.     sta    reverse        ; reverse is off
  12237.     sta    alternt        ; alternt colors are off
  12238.     sta    flash        ; flashing is disabled
  12239.     sta    deckpam        ; keypad is numeric
  12240.     sta    decckm        ; cursor is in application mode
  12241.     sta    decrev        ; screen is not reversed
  12242.     sta    decom        ; use absolute cursor addressing. not origion
  12243.     sta    lmn        ; new line mode is clear
  12244.     sta    irm        ; insert replace mode is replace
  12245.     sta    g0        ; mount U.S. character set on g0
  12246.     sta    g1        ; mount U.S. character set on g1
  12247.     sta    gx        ; select g0
  12248.     lda    #$01
  12249.     sta    wrap        ; autowrap is on
  12250.     sta    decanm        ; vt100 is not emulating a vt52
  12251.     sta    decarm        ; keys repeat by default
  12252.     jsr    scrsav        ; make these as the saved parameters
  12253.     ldx    #79        ; set/clear the tab stops for 80 columns
  12254. scrrst1:txa
  12255.     and    #$07        ; one tab stop every 8 characters
  12256.     sta    tabs,x        ; put the entry in tabs
  12257.     dex
  12258.     bpl    scrrst1        ; repeat for every column
  12259.     jsr    scrset        ; tell the screen driver that things changed
  12260.     rts            ; all done
  12261.  
  12262. ;
  12263. ;    scrset - reset the hardware after a "set screen xxxx" command
  12264. ;
  12265. ;    Input:    Screen type in scrtype.
  12266. ;        Assorted screen parameters
  12267. ;    Output: None
  12268. ;
  12269. ;    Registers destroyed - A,X,Y
  12270. ;
  12271. ;    This routine adjusts the hardware after a set command.
  12272. ;
  12273.  
  12274. scrset:    ldy    scrtype
  12275.     jsr    case
  12276.     .word    c40set
  12277.     .word    c80set
  12278.     .word    c28set
  12279.     .word    b80set
  12280.     .word    m80set
  12281.  
  12282. ;
  12283. ;    screee - fill screen with 'E's
  12284. ;
  12285. ;    Input:    Screen type in scrtype
  12286. ;    Output:    Screen is filled with 'E's
  12287. ;
  12288. ;    This routine simply fills the screen with 'E's.  Real exciting.
  12289. ;
  12290.  
  12291. screee:    jsr    scroff        ; turn cursor off now so we can use scrput3
  12292.     lda    cx        ; save the cursor x and y coordinates
  12293.     pha
  12294.     lda    cy
  12295.     pha
  12296.     jsr    scrbot        ; determine the line number of the bottom line
  12297.     sta    cy        ; row to start filling at
  12298. screee2:jsr    scrrgh        ; determine the column number of the far right
  12299.     sta    cx
  12300.     jsr    flowch        ; kludge.  Sends XOFF when/if necessary
  12301. screee1:lda    #'E-$20        ; 'E' in funny-ascii
  12302.     jsr    scrput3        ; scrput has too much overhead.  scrput3 works
  12303.     dec    cx        ; repeat till all of this line is done
  12304.     bpl    screee1
  12305.     dec    cy        ; repeat till all lines done
  12306.     bpl    screee2
  12307.     pla            ; restore cursor x and y coordinates
  12308.     sta    cy
  12309.     pla
  12310.     sta    cx
  12311.     rts            ; all done
  12312.  
  12313. ;
  12314. ;    scrput - put a character on the screen
  12315. ;
  12316. ;    Input:    Character to put in a-reg.
  12317. ;        Screen type in scrtype.
  12318. ;    Output: Screen ram, both color rams, and cursor position are changed.
  12319. ;
  12320. ;    Registers destroyed - A,X,Y
  12321. ;
  12322. ;    This routine puts a character on the screen.  It advances the cursor
  12323. ;    and scrolls the screen when necessary.  It handels a carriage
  12324. ;    return specially.  It prints a carriage return and line feed.
  12325. ;    This can only happen in the parser since telnet handels cr and lf
  12326. ;    special.
  12327. ;
  12328.  
  12329. scrput:    cmp    #$0d        ; is it a carriage return?
  12330.     bne    scrput4        ; no
  12331.     jsr    scrcr        ; yes.  Do a carriage return and line feed
  12332.     jsr    scrlf
  12333.     rts
  12334. scrput4:ldx    irm        ; insert replace mode set?
  12335.     beq    scrput6
  12336.     pha            ; save character to print
  12337.     jsr    scrirm        ; make room for it
  12338.     pla            ; remember character to print
  12339. scrput6:cmp    #'`        ; is this different in the graphics charset
  12340.     bcc    scrput5        ; no.
  12341.     ldx    gx        ; which character set is mouned
  12342.     ldy    g0,x        ; is the mounted charset graphics
  12343.     beq    scrput5        ; no
  12344.     clc            ; if grapics, add in 31
  12345.     adc    #31
  12346. scrput5:sec            ; convert to funey-ascii by subtracting $20
  12347.     sbc    #$20
  12348.     pha            ; save the character to put
  12349.     jsr    scroff        ; cant use screen driver while cursor blinks
  12350.     ldx    cx        ; check if cursor at rightmost edge
  12351.     jsr    scrrgh
  12352.     pla            ; restore character to put
  12353.     bcc    scrput2        ; no
  12354.     ldx    wrap        ; are we in wrap mode
  12355.     beq    scrput3        ; no. do not wrap
  12356.     pha            ; save the character to put
  12357.     jsr    scrcr        ; yes. do a carriage return
  12358.     jsr    scrlf        ; and a linefeed
  12359.     pla            ; restore the character to put
  12360. scrput2:jsr    scrput3        ; call the routine to put a character.
  12361.     inc    cx
  12362.     rts    
  12363.  
  12364. scrput3:ldy    scrtype        ; call the screen driver
  12365.     jsr    case
  12366.     .word    c40put
  12367.     .word    c80put
  12368.     .word    c28put
  12369.     .word    b80put
  12370.     .word    m80put
  12371.  
  12372. ;
  12373. ;    scrirm - make room for a character in insert/replace mode
  12374. ;
  12375.  
  12376. scrirm:    jsr    scroff        ; cant use screen driver while cursor blinks
  12377.     ldy    scrtype        ; call the screen driver
  12378.     jsr    case
  12379.     .word    c40irm
  12380.     .word    c80irm
  12381.     .word    c28irm
  12382.     .word    b80irm
  12383.     .word    m80irm
  12384.  
  12385. ;
  12386. ;    scrdch - delete one or more characters
  12387. ;    Input:    Number of characters to delete in A-reg
  12388. ;        screen type in scrtype
  12389. ;
  12390.  
  12391. scrdch:    pha            ; save number of characters to delete
  12392.     jsr    scroff        ; cant use screen driver while cursor blinks
  12393.     pla
  12394.     ldy    scrtype
  12395.     jsr    case
  12396.     .word    c40dch
  12397.     .word    c80dch
  12398.     .word    c28dch
  12399.     .word    b80dch
  12400.     .word    m80dch
  12401.  
  12402. ;
  12403. ;    scral - insert one or more lines
  12404. ;
  12405. ;    Input:    Number of lines to add in A-reg
  12406. ;        Cursor position in cx, cy
  12407. ;        Dimensions of scrolling region on top, bot
  12408. ;        Screen type in scrtype
  12409. ;
  12410.  
  12411. scral:    tax            ; save number of lines to add
  12412.     ldy    bot        ; see if cursor is below scrolling region
  12413.     cpy    cy
  12414.     bcc    scral2
  12415.     ldy    cy        ; see if cursor is above scrolling region
  12416.     cpy    top
  12417.     bmi    scral2
  12418.     lda    top
  12419.     pha            ; save the top of the scrolling region
  12420.     sty    top        ; set top to cy
  12421.     txa            ; restore number of lines to add
  12422.     jsr    scral1        ; go do it
  12423.     pla
  12424.     sta    top
  12425. scral2:    rts
  12426.  
  12427. scral1:    pha
  12428.     jsr    scroff        ; cannot run screen driver with cursor on
  12429.     pla            ; restore number of lines to add
  12430.     ldy    scrtype
  12431.     jsr    case
  12432.     .word    c40ri
  12433.     .word    c80ri
  12434.     .word    c28ri
  12435.     .word    b80ri
  12436.     .word    m80ri
  12437.  
  12438. ;
  12439. ;    scrdl - delete one or more lines
  12440. ;
  12441. ;    Input:    Number of lines to delete in A-reg
  12442. ;        Cursor position in cx, cy
  12443. ;        Dimensions of scrolling region on top, bot
  12444. ;        Screen type in scrtype
  12445. ;
  12446.  
  12447. scrdl:    tax            ; save number of lines to delete
  12448.     ldy    bot        ; see if cursor is below scrolling region
  12449.     cpy    cy
  12450.     bcc    scrdl2
  12451.     ldy    cy        ; see if cursor is above scrolling region
  12452.     cpy    top
  12453.     bmi    scrdl2
  12454.     lda    top
  12455.     pha            ; save the top of the scrolling region
  12456.     sty    top        ; set top to cy
  12457.     txa            ; restore number of lines to delete
  12458.     jsr    scrdl1        ; go do it
  12459.     pla
  12460.     sta    top
  12461. scrdl2:    rts
  12462.  
  12463. scrdl1:    pha
  12464.     jsr    scroff        ; cannot run screen driver with cursor on
  12465.     pla            ; restore number of lines to delete
  12466.     ldy    scrtype
  12467.     jsr    case
  12468.     .word    c40ind
  12469.     .word    c80ind
  12470.     .word    c28ind
  12471.     .word    b80ind
  12472.     .word    m80ind
  12473.  
  12474. ;
  12475. ;    scrcr - perform a carriage return
  12476. ;
  12477. ;    Input:    Screen type in scrtype.
  12478. ;        Cursor position in cx, cy
  12479. ;
  12480. ;    Output: New new cursor column in cx.
  12481. ;
  12482. ;    Registers destroyed - A,X,Y
  12483. ;
  12484. ;    This routine performs a carriage return.
  12485. ;
  12486.  
  12487. scrcr:    ldy    cy
  12488.     ldx    #$00        ; put cursor in column zero
  12489.     jsr    scrplt        ; move the cursor there
  12490.     rts            ; all done
  12491.  
  12492. ;
  12493. ;    scrlf - perform a line feed
  12494. ;
  12495. ;    Input:    screen type in scrtype
  12496. ;        cursor column in cy
  12497. ;        cursor row in cx
  12498. ;    Output: New cursor position in cx, cy.
  12499. ;
  12500. ;    Registers destroyed - A,X,Y
  12501. ;
  12502. ;    This routine performs a line feed.
  12503. ;
  12504.  
  12505. scrlf:    ldy    cy        ; check if bottom reached
  12506.     cpy    bot
  12507.     bcc    scrlf1        ; yes. scroll screen
  12508.     jmp    scrind
  12509. scrlf1:    iny
  12510.     ldx    cx
  12511.     jsr    scrplt        ; no. move the cursor down one line.
  12512.     rts
  12513. ;
  12514. ;    scrrlf - perform a reverse line feed with scrolling
  12515. ;
  12516. ;    Input:    Type of screen in scrtype
  12517. ;        Cursor coordinates in cx, cy
  12518. ;
  12519. ;    Output: None
  12520. ;
  12521. ;    Registers Destroyed: A,X,Y
  12522. ;
  12523. ;    This routine performs a reverse line feed.  The cursor is moved up
  12524. ;    one line.  If the cursor reaches the top of the scrolling area, scrri
  12525. ;    is called to scroll the screen backwards.
  12526. ;
  12527.  
  12528. scrrlf:    ldy    cy
  12529.     cpy    top
  12530.     beq    scrrlf1        ; reached top of the screen?
  12531.     dey            ; no, just move the cursor up
  12532.     ldx    cx
  12533.     jsr    scrplt
  12534.     rts
  12535. scrrlf1:jsr    scrri        ; yes, at top of screen.  Scroll backwards
  12536.     rts
  12537.  
  12538. ;
  12539. ;    scru - move the cursor up stopping at the top of the screen
  12540. ;
  12541. ;    Input:    Type of screen in scrtype
  12542. ;        Cursor coordinates in cx, cy
  12543. ;
  12544. ;    Output: None
  12545. ;
  12546. ;    Registers Destroyed: A,X,Y
  12547. ;
  12548. ;    This routine moves the cursor up.  If the cursor reaches the top
  12549. ;    of the screen it stops.
  12550. ;
  12551.  
  12552. scru:    ldy    cy
  12553.     beq    scru1        ; at top of screen?
  12554.     dey
  12555.     ldx    cx
  12556.     jsr    scrplt        ; move the cursor to its new position
  12557. scru1:    rts
  12558.  
  12559. ;
  12560. ;    scrd - move the cursor down stopping at the bottom of the screen
  12561. ;
  12562. ;    Input:    Type of screen in scrtype
  12563. ;        Cursor coordinates in cx, cy
  12564. ;
  12565. ;    Output: None
  12566. ;
  12567. ;    Registers Destroyed: A,X,Y
  12568. ;
  12569. ;    This routine moves the cursor down.  If the cursor reaches the bottom
  12570. ;    of the screen it stops.
  12571. ;
  12572.  
  12573. scrd:    ldy    cy
  12574.     iny
  12575.     jsr    scrbot        ; test to see if cursor past bottom
  12576.     bcs    scrd2        ; if so, dont move cursor
  12577.     ldx    cx
  12578.     jsr    scrplt        ; put the cursor at its new position
  12579. scrd2:    rts            ; all done
  12580.  
  12581. ;
  12582. ;    scrl - move the cursor left stopping at the left side of the screen
  12583. ;
  12584. ;    Input:    Type of screen in scrtype
  12585. ;        Cursor coordinates in cx, cy
  12586. ;
  12587. ;    Output: New cursor coordinates in cx, cy
  12588. ;
  12589. ;    Registers Destroyed: A,X,Y
  12590. ;
  12591. ;    This routine moves the cursor left.  If the cursor reaches the left
  12592. ;    most side of the display, it stops.
  12593. ;
  12594.  
  12595. scrl:    ldx    cx
  12596.     beq    scrl1        ; at left side of screen?
  12597.     dex
  12598.     ldy    cy
  12599.     jsr    scrplt        ; move the cursor to its new position
  12600. scrl1:    rts
  12601.  
  12602. ;
  12603. ;    scrr - move the cursor right stopping at the right side of the screen
  12604. ;
  12605. ;    Input:    Type of screen in scrtype
  12606. ;        Cursor coordinates in cx, cy
  12607. ;
  12608. ;    Output: New cursor coordinates in cx, cy
  12609. ;
  12610. ;    Registers Destroyed: A,X,Y
  12611. ;
  12612. ;    This routine moves the cursor right.  If the cursor reaches the right
  12613. ;    side of the screen it stops.
  12614. ;
  12615.  
  12616. scrr:    ldx    cx
  12617. scrr1:    inx            ; move the cursor right
  12618.     jsr    scrrgh        ; check if past rightmost edge
  12619.     bcs    scrr2
  12620.     ldy    cy
  12621.     jsr    scrplt        ; move the cursor to its new position
  12622. scrr2:    rts            ; all done
  12623.  
  12624. ;
  12625. ;    scrind - perfrom the VT100 index function (scroll the screen one line)
  12626. ;
  12627. ;    Input:    Screen type in scrtype
  12628. ;    Output:    None
  12629. ;
  12630. ;    Registers destroyed - A,X,Y
  12631. ;
  12632. ;    This routine scrolls the screen down one line. It calls either c40ind,
  12633. ;    c80ind, or c28ind depending on the screen type.
  12634. ;
  12635.  
  12636. scrind:    jsr    scroff        ; cant use screen driver while cursor blinks
  12637.     ldy    scrtype
  12638.     lda    #$01
  12639.     jsr    case
  12640.     .word    c40ind
  12641.     .word    c80ind
  12642.     .word    c28ind
  12643.     .word    b80ind
  12644.     .word    m80ind
  12645.  
  12646. ;
  12647. ;    scrri - perfrom the VT100 reverse index function (scroll backwards)
  12648. ;
  12649. ;    Input:    Screen type in scrtyp
  12650. ;    Output: Screen and color rams are changed
  12651. ;
  12652. ;    Registers destroyed - A,X,Y
  12653. ;
  12654. ;    This routine scrolls the screen up one line. It calls either c40ri,
  12655. ;    c80ri, or c28ri depending on the screen type.
  12656. ;
  12657.  
  12658. scrri:    jsr    scroff        ; cant use screen driver while cursor blinks
  12659.     ldy    scrtype
  12660.     lda    #$01
  12661.     jsr    case
  12662.     .word    c40ri
  12663.     .word    c80ri
  12664.     .word    c28ri
  12665.     .word    b80ri
  12666.     .word    m80ri
  12667.  
  12668. ;
  12669. ;    scrclr - home and clear the screen
  12670. ;
  12671. ;    This routine homes the cursor and clears the screen
  12672. ;
  12673.  
  12674. scrclr:    jsr    scrhom        ; home the cursor
  12675.     jsr    scred2        ; clear the screen
  12676.     rts            ; all done
  12677.  
  12678. ;
  12679. ;    scrhom - home the cursor
  12680. ;
  12681. ;    This routine homes the cursor
  12682. ;
  12683.  
  12684. scrhom:    ldx    #$00        ; home is at 0,0
  12685.     ldy    #$00
  12686.     jsr    scrplt        ; plot the cursor
  12687.     rts            ; all done
  12688.  
  12689. ;
  12690. ;    scred0 - perform the Erase Display #0 VT100 function
  12691. ;
  12692. ;    Input: Type of screen to erase in scrtype
  12693. ;
  12694. ;    Output: None
  12695. ;
  12696. ;    Registers Destroyed: A,X,Y
  12697. ;
  12698. ;    This routine clears from the cursor position to the end of the screen.
  12699. ;    This routine works in 40 column mode, 80 column mode, or Commodore 128
  12700. ;    mode.
  12701. ;
  12702.  
  12703. scred0:    lda    cy        ; save the cursor y position
  12704.     pha
  12705.     jsr    screl0        ; erase from the cursor to the line
  12706. scred0b:inc    cy        ; do the next line
  12707.     ldy    cy
  12708.     jsr    scrbot        ; on bottom line?
  12709.     bcs    scred0a        ; yes.
  12710.     jsr    screl2        ; erase all of this line
  12711.     jmp    scred0b        ; repeat till done
  12712. scred0a:pla            ; restore cursor y position
  12713.     sta    cy
  12714.     rts            ; all done
  12715.  
  12716. ;
  12717. ;    scred1 - perform the Erase Display #1 VT100 function
  12718. ;
  12719. ;    Input: Type of screen to erase in scrtype
  12720. ;
  12721. ;    Output: None
  12722. ;
  12723. ;    Registers Destroyed: A,X,Y
  12724. ;
  12725. ;    This routine clears from the beginning of the screen to the cursor.
  12726. ;    This routine works for 40 column mode, 80 column mode, and commodore
  12727. ;    128 mode.
  12728. ;
  12729.  
  12730.  
  12731. scred1:    lda    cy        ; save the cursor y position
  12732.     pha
  12733.     jsr    screl1        ; erase from beginning of line to cursor
  12734.     dec    cy        ; go up one line
  12735.     bmi    scred1a        ; on top of screen
  12736. scred1b:jsr    screl2        ; erase all of this line
  12737.     dec    cy
  12738.     bpl    scred1b        ; repeat till done
  12739. scred1a:pla            ; restore cursor position
  12740.     sta    cy
  12741.     rts            ; all done
  12742.  
  12743. ;
  12744. ;    scred2 - perform the Erase Display #2 VT100 function (clear screen)
  12745. ;
  12746. ;    Input: Type of screen to erase in scrtype
  12747. ;
  12748. ;    Output: None
  12749. ;
  12750. ;    Registers Destroyed: A,X,Y
  12751. ;
  12752. ;    This routine clears the entire screen in either 40 column mode,
  12753. ;    80 column mode, or c128 mode.  It calls screl2 to do the dirty work.
  12754. ;
  12755.  
  12756. scred2:    lda    cy        ; save the cursor y position
  12757.     pha
  12758.     jsr    scrbot        ; get bottom of screen
  12759.     sta    cy
  12760. scred2a:jsr    screl2        ; erase the line
  12761.     dec    cy        ; do the next line
  12762.     bpl    scred2a        ; repeat till done
  12763.     pla            ; restore cursor position
  12764.     sta    cy
  12765.     rts            ; all done
  12766.  
  12767. ;
  12768. ;    screl0 - Perform the VT100 Erase Line function #0
  12769. ;
  12770. ;    Input:    Line number to erase in cy
  12771. ;        Screen type in scrtyp
  12772. ;    Output: None
  12773. ;
  12774. ;    Registers destroyed - A,X,Y
  12775. ;
  12776. ;    This routine erases from the cursor to the end of the line
  12777. ;
  12778.  
  12779. screl0:    jsr    scroff        ; cant use screen driver while curosr blinks
  12780.     ldy    scrtype        ; which routine to use
  12781.     jsr    case
  12782.     .word    c40el0
  12783.     .word    c80el0
  12784.     .word    c28el0
  12785.     .word    b80el0
  12786.     .word    m80el0
  12787.  
  12788. ;
  12789. ;    screl1 - Perform the VT100 Erase Line function #1
  12790. ;
  12791. ;    Input:    Line number to erase in cy
  12792. ;        Screen type in scrtyp
  12793. ;    Output: None
  12794. ;
  12795. ;    Registers destroyed - A,X,Y
  12796. ;
  12797. ;    This routine erases from the beginning of line to the cursor
  12798. ;
  12799.  
  12800. screl1:    jsr    scroff        ; cant use screen driver while curosr blinks
  12801.     ldy    scrtype        ; which routine to use
  12802.     jsr    case
  12803.     .word    c40el1
  12804.     .word    c80el1
  12805.     .word    c28el1
  12806.     .word    b80el1
  12807.     .word    m80el1
  12808.  
  12809. ;
  12810. ;    screl2 - Perform the VT100 Erase Line function #2
  12811. ;
  12812. ;    Input:    Line number to erase in cy
  12813. ;        Type of screen in scrtype
  12814. ;    Output:    None
  12815. ;
  12816. ;    Registers destroyed - A,X,Y
  12817. ;
  12818. ;    This routine erases one line compleatly.
  12819. ;
  12820.  
  12821. screl2:    jsr    scroff        ; cant use screen driver while cursor blinks
  12822.     ldy    scrtype        ; which routine to use to erase
  12823.     jsr    case        ; go to proper routine
  12824.     .word    c40el2        ; erase one line on 40 column screen
  12825.     .word    c80el2        ; erase one line on 80 column screen
  12826.     .word    c28el2        ; erase one line on the commodore-128 screen
  12827.     .word    b80el2        ; erase one line on the BI-80 screen
  12828.     .word    m80el2        ; erase one line on the modified BI-80 screen
  12829.  
  12830. ;
  12831. ;    scrsav - save screen attributes and cursor position
  12832. ;
  12833. ;    Input:    screen attributes and cursor position
  12834. ;
  12835. ;    Output:    save1, save2, save3, ... save6
  12836. ;
  12837. ;    This routine saves the screen attributes and cursor position
  12838. ;    
  12839.  
  12840. scrsav:    lda    cx
  12841.     sta    save1
  12842.     lda    cy
  12843.     sta    save2
  12844.     lda    alternt
  12845.     sta    save3
  12846.     lda    underln
  12847.     sta    save4
  12848.     lda    flash
  12849.     sta    save5
  12850.     lda    reverse
  12851.     sta    save6
  12852.     lda    g0
  12853.     sta    save7
  12854.     lda    g1
  12855.     sta    save8
  12856.     lda    gx
  12857.     sta    save9
  12858.     rts
  12859.  
  12860. ;
  12861. ;    scrlod - load the saved screen attributes and cursor position
  12862. ;
  12863. ;    Input:    save1, save2, save3, ... save6
  12864. ;
  12865. ;    This routine restores the saved screen attributes and cursor position
  12866. ;
  12867.  
  12868. scrlod:    ldx    save1
  12869.     ldy    save2
  12870.     jsr    scrplt
  12871.     lda    save3
  12872.     sta    alternt
  12873.     lda    save4
  12874.     sta    underln
  12875.     lda    save5
  12876.     sta    flash
  12877.     lda    save6
  12878.     sta    reverse
  12879.     lda    save7
  12880.     sta    g0
  12881.     lda    save8
  12882.     sta    g1
  12883.     lda    save9
  12884.     sta    gx
  12885.     rts
  12886.  
  12887. ;
  12888. ;    scrplt - plot the cursor
  12889. ;
  12890. ;    Input:    Cursor X position in X-reg
  12891. ;        Cursor Y position in Y-reg
  12892. ;
  12893. ;    Output: cx and cy are set.
  12894. ;
  12895. ;    Registers destroyed - A,X,Y
  12896. ;
  12897. ;    This routine puts the cursor at X,Y.
  12898. ;
  12899.  
  12900. scrplt:    tya            ; save the new y position
  12901.     pha
  12902.     txa            ; save the new x position
  12903.     pha        
  12904.     jsr    scroff        ; turn off the cursor
  12905.     pla            ; get the new x position
  12906.     sta    cx
  12907.     pla            ; get the new y position
  12908.     sta    cy
  12909. scrplt1:rts            ; all done
  12910.  
  12911. ;
  12912. ;    scroff - disable the cursor.
  12913. ;
  12914. ;    Input:    cx, cy, curstat, curabrt, scrtype
  12915. ;
  12916. ;    Output: curabrt
  12917. ;
  12918. ;    Registers destroyed - A,X,Y
  12919. ;
  12920. ;    This routine disables the cursor.  It calls the proper screen driver
  12921. ;    to do the dirty work.
  12922. ;
  12923.  
  12924. scroff:    lda    curabrt        ; is the cursor flash already aborted?
  12925.     bne    scroff1        ; yes.
  12926.     lda    curstat        ; cursor light?
  12927.     beq    scroff1        ; yes.
  12928.     sta    curabrt        ; mark cursor flash as aborted
  12929.     jsr    scrtgl        ; toggle the cursor
  12930. scroff1:rts            ; all done
  12931.  
  12932. ;
  12933. ;    scrfls - flash the screen and cursor
  12934. ;
  12935. ;    Input:    curstat - status of cursor (light or dark)
  12936. ;        curabrt - flag indicating if cursor flash was aborted early.
  12937. ;        scrtype - type of screen
  12938. ;
  12939. ;    Output: curstat - curstat is toggled if time
  12940. ;        curabrt - curabrt is always cleared
  12941. ;
  12942. ;    Registers destroyed - A,X,Y
  12943. ;
  12944. ;    This routine flashes the screen and toggles the cursor. This routine
  12945. ;    should be called a frequently as possible.
  12946. ;
  12947.  
  12948. scrfls:    lda    curabrt        ; was the cursor flash aborted early?
  12949.     beq    scrfls1        ; no.  No need to light it.
  12950.     lda    #$00        ; clear the abort flag
  12951.     sta    curabrt
  12952.     jsr    scrtgl        ; toggle the cursor
  12953. scrfls1:jsr    rdtim        ; check the time 
  12954.     tay            ; save time for later use
  12955.     sec
  12956.     sbc    cntdown
  12957.     cmp    #20        ; have  36 jiffies elapsed?
  12958.     bcs    scrfls2        ; yes they have
  12959.     rts            ; no they havent.  stop here
  12960. scrfls2:sty    cntdown        ; reset the countdown timer
  12961.     jsr    scrtgl        ; toggle the cursor status
  12962.     ldy    scrtype        ; flash the flashing characters
  12963.     jsr    case
  12964.     .word    c40fls
  12965.     .word    c80fls
  12966.     .word    c28fls
  12967.     .word    b80fls
  12968.     .word    m80fls
  12969.  
  12970. ;
  12971. ;    scrtgl - Toggle the cursor
  12972. ;
  12973. ;    Input:    cx - x coordinate of cursor
  12974. ;        cy - y coordinate of cursor
  12975. ;        Type of screen in scrtype
  12976. ;
  12977. ;    Output: None
  12978. ;
  12979. ;    Registers destroyed - A,X,Y
  12980. ;
  12981. ;    this routine calls the screen driver to toggle the cursor
  12982. ;
  12983.  
  12984. scrtgl:    lda    curstat        ; keep track if cursor is dark or light
  12985.     eor    #$01
  12986.     sta    curstat
  12987.     ldy    scrtype        ; call the screen driver
  12988.     jsr    case
  12989.     .word    c40tgl
  12990.     .word    c80tgl
  12991.     .word    c28tgl
  12992.     .word    b80tgl
  12993.     .word    m80tgl
  12994.  
  12995. ;
  12996. ;    scrbel - stop the sound of the bell
  12997. ;
  12998. ;    Input:    lpcnt - time when the bell sound started
  12999. ;
  13000. ;    Output:    wave is zeroed to stop the bell
  13001. ;
  13002. ;    This routine stops the sound of the bell if enough jiffys
  13003. ;    have elapsed since it started.
  13004. ;    This routine should be called as often as possible.
  13005. ;
  13006.  
  13007. scrbel:    jsr    rdtim        ; what time is it now?
  13008.     sec
  13009.     sbc    lpcnt        ; subtract the time the bell started
  13010.     cmp    #6        ; been 6 jiffys since it started?
  13011.     bcc    scrbel1        ; nope.  Dont stop the bell yet
  13012.     lda    #$00
  13013.     sta    wave        ; stop the bell
  13014. scrbel1:rts            ; all done
  13015.  
  13016. ;
  13017. ;    scrbot - check to see if y-reg is below bottom of screen
  13018. ;
  13019. ;    Input:    line25
  13020. ;
  13021. ;    Output:    Carry flag set if past bottom of screen
  13022. ;        A-reg holds line number of screen bottom
  13023. ;
  13024. ;    This routine checks to see if the y-reg is greater than the bottom
  13025. ;    of the screen.
  13026.  
  13027. scrbot:    lda    line25        ; check to see if the 25th line is in use
  13028.     bne    scrbot1        ; branch if it is
  13029.     lda    #23
  13030.     cpy    #24
  13031.     rts
  13032. scrbot1:lda    #24        ; 25th line is enabled
  13033.     cpy    #25        ; lines 25 and up are illegal
  13034.     rts
  13035.  
  13036. ;
  13037. ;    scrrgh - check to see if x-reg is past right margin of screen
  13038. ;
  13039. ;    Input:    scrtype
  13040. ;
  13041. ;    Output:    Carry flag set if past right margin of screen
  13042. ;        A-reg holds right margin of screen
  13043. ;
  13044. ;    This routine checks to see if the x-reg is greater than the bottom
  13045. ;    of the screen.
  13046.  
  13047. scrrgh:    lda    scrtype        ; check to see if in 40-column mode
  13048.     beq    scrrgh1        ; branch if it is
  13049.     lda    #79
  13050.     cpx    #80
  13051.     rts
  13052. scrrgh1:lda    #39        ; only 40 columns available
  13053.     cpx    #40
  13054.     rts
  13055.  
  13056. ;
  13057. ;    scrdrw - draw a character in graphics mode
  13058. ;
  13059. ;    Input:    character to draw in a-reg
  13060. ;        place to draw in tektxlo, tektxhi, tektylo, tektylo
  13061. ;        screen driver in scrtype
  13062. ;    Output:    char is drawen
  13063. ;
  13064. ;    This routine calls the screen driver to draw a character in graphics
  13065. ;    mode.
  13066. ;
  13067.  
  13068. scrdrw:    ldy    scrtype
  13069.     jsr    case
  13070.     .word    c40drw        ; 40 column mode
  13071.     .word    c80drw        ; 80 column mode
  13072.     .word    c28drw        ; commodore-128 mode
  13073.     .word    b80drw        ; batteries included
  13074.     .word    m80drw        ; modified batteries included
  13075.  
  13076. ;
  13077. ;    scrtek - go into tektronix mode
  13078. ;
  13079. ;    Input:    screen driver in scrtype
  13080. ;
  13081. ;    This routine calls the proper screen driver to start tektronix mode.
  13082. ;
  13083.  
  13084. scrtek:    ldy    scrtype
  13085.     jsr    case
  13086.     .word    c40tek        ; 40 column mode
  13087.     .word    c80tek        ; 80 column mode
  13088.     .word    c28tek        ; commodore-128 mode
  13089.     .word    b80tek        ; batteries included mode
  13090.     .word    m80tek        ; modified batteries included mode
  13091.  
  13092. ;
  13093. ;    scrtxt - return to text mode from tektronix modoe
  13094. ;
  13095. ;    Input:    screen driver in scrtype
  13096. ;
  13097. ;    This routine calls the proper screen driver to exit tektronix mode.
  13098. ;
  13099.  
  13100. scrtxt:    lda    #$00
  13101.     sta    curstat
  13102.     lda    #$01        ; mark cursor flash as aborted
  13103.     sta    curabrt        ; cursor is off but supposed to be on
  13104.     jsr    rdtim        ; set cntdown to wait the usual amount of time
  13105.     sta    cntdown
  13106.     ldy    scrtype
  13107.     jsr    case
  13108.     .word    c40txt        ; 40 column mode
  13109.     .word    c80txt        ; 80 column mode
  13110.     .word    c28txt        ; commodore-128 mode
  13111.     .word    b80txt        ; batteries included mode
  13112.     .word    m80txt        ; modified batteries included mode
  13113.  
  13114. ;
  13115. ;    scrlin - draw a line in graphics mode
  13116. ;
  13117. ;    Input:    starting point: tekfxlo, tekfxhi, tekfylo, tekfyhi
  13118. ;        ending point:   tektxlo, tektxhi, tektylo, tektyhi
  13119. ;
  13120. ;    This routine calls the proper screen driver to draw a line.
  13121. ;
  13122.  
  13123. scrlin:    ldy    scrtype
  13124.     jsr    case
  13125.     .word    c40lin        ; 40 column mode
  13126.     .word    c80lin        ; 80 column mode
  13127.     .word    c28lin        ; commodore-128 mode
  13128.     .word    b80lin        ; batteries included mode
  13129.     .word    m80lin        ; modified batteries included mode
  13130.  
  13131. ;
  13132. ;    screra - erase the graphics screen
  13133. ;
  13134. ;    This routine calls the proper screen driver to erase the graphics
  13135. ;    screen.
  13136. ;
  13137.  
  13138. screra:    ldy    scrtype
  13139.     jsr    case
  13140.     .word    c40era        ; 40 column mode
  13141.     .word    c80era        ; 80 column mode
  13142.     .word    c28era        ; commodore-128 mode
  13143.     .word    b80era        ; batteries included mode
  13144.     .word    m80era        ; modified batteries included mode
  13145.  
  13146. ;
  13147. ;    scrint - put graphics coordinate into internal form
  13148. ;
  13149. ;    Input:    tekcxlo, tekcxhi, tekcylo, tekcyhi
  13150. ;        screen driver in scrtype
  13151. ;    Output: tektxlo, tektxhi, tektylo, tektylo
  13152. ;
  13153.  
  13154. scrint:    ldy    scrtype
  13155.     jsr    case
  13156.     .word    c40int        ; 40 column mode
  13157.     .word    c80int        ; 80 column mode
  13158.     .word    c28int        ; commodore-128
  13159.     .word    b80int        ; batteries included mode
  13160.     .word    m80int        ; modified batteries included mode
  13161.     
  13162. ;
  13163. ;    scrtst - test to see if a given screen driver is present
  13164. ;
  13165. ;    Input:    Desired screen type in a-reg
  13166. ;    Output: carry clear if present, set otherwise
  13167. ;
  13168. ;    Registers destroyed - A,X,Y
  13169. ;
  13170. ;    This routine checks to see if a given screen driver is present.
  13171. ;    Currently the only one that might not be available is the
  13172. ;    Commodore 128 80-column screen.
  13173. ;
  13174.  
  13175. scrtst:    tay            ; device to test for
  13176.     jsr    case
  13177.     .word    c40tst
  13178.     .word    c80tst
  13179.     .word    c28tst
  13180.     .word    b80tst
  13181.     .word    m80tst
  13182.  
  13183. .SBTTL    Modified Batteries Included 80-column screen driver
  13184.  
  13185. ;
  13186. ;    These routines manipulate the screen using a Batteries Included
  13187. ;    80-column card with a custom ROM.
  13188. ;
  13189.  
  13190. ;
  13191. ;    The only thing different in this screen driver is that this screen
  13192. ;    driver uses the uppercase/graphics half of the character rom.  It
  13193. ;    is the half that has been modified.
  13194.  
  13195. ;
  13196. ;    m80txt - enter text mode (possibly from graphics mode)
  13197. ;
  13198. ;    If the b80flag is clear, then we are in graphics mode and must
  13199. ;    call the 80-column screen driver to leave it.  Otherwise we
  13200. ;    just call a rom routine (on the bi-80 card) to initialize things.
  13201. ;
  13202.  
  13203. m80txt:    asl    b80flag        ; test and clear the flag
  13204.     bcs    m80txt1        ; skip graphics stuff if not in graphics mode
  13205.     jsr    m80ext        ; turn off graphics.
  13206. m80txt1:lda    #$37
  13207.     sta    $01        ; turn the rom back on.
  13208.     jsr    $80f4        ; initialize 80 column display
  13209.     lda    #$36
  13210.     sta    $01        ; back to normal memory map
  13211.     lda    #$0c        ; put in upper-case/graphics mode
  13212.     sta    $df00
  13213.     lda    #$20
  13214.     sta    $df10
  13215.     rts            ; all done
  13216.  
  13217. m80ini:    jmp    b80ini
  13218. m80ent:    jmp    b80ent
  13219. m80ext:    jmp    b80ext
  13220. m80set:    jmp    b80set
  13221. m80put:    jmp    b80put
  13222. m80irm:    jmp    b80irm
  13223. m80dch:    jmp    b80dch
  13224. m80ind:    jmp    b80ind
  13225. m80ri:    jmp    b80ri
  13226. m80el0:    jmp    b80el0
  13227. m80el1:    jmp    b80el1
  13228. m80el2:    jmp    b80el2
  13229. m80fls:    jmp    b80fls
  13230. m80tgl:    jmp    b80tgl
  13231. m80tek:    jmp    b80tek
  13232. m80drw:    jmp    b80drw
  13233. m80lin:    jmp    b80lin
  13234. m80era:    jmp    b80era
  13235. m80int:    jmp    b80int
  13236. m80tst:    jmp    b80tst
  13237.  
  13238. .SBTTL    Batteries Included 80-column screen driver
  13239.  
  13240. ; 
  13241. ;     These routines manipulate the screen in Batteries Included mode
  13242. ; 
  13243.  
  13244. ; 
  13245. ;    b80ini - initialize the Batteries Included screen.
  13246. ; 
  13247. ;     Input:    None
  13248. ; 
  13249. ;     Output:    None
  13250. ; 
  13251. ;    This routine does nothing because all the hardware is initialized
  13252. ;    when the 80-column card is entered.
  13253. ;
  13254.  
  13255. b80ini:    rts
  13256.  
  13257. ;
  13258. ;    b80ent - enter the Batteries Included screen driver
  13259. ;
  13260. ;    Input:    None
  13261. ;
  13262. ;    Output:    None
  13263. ;
  13264. ;    This routine sets a flag so that b80txt knows what to do.
  13265. ;
  13266.  
  13267. b80ent:    lda    #$80
  13268.     sta    b80flag
  13269.     rts
  13270.  
  13271. ;
  13272. ;    b80ext - exit from the Batteries Included screen-driver
  13273. ;
  13274. ;    Input:    None
  13275. ;
  13276. ;    Output:    None
  13277. ;
  13278. ;    This routine calls the rom routine at $80fd to de-init the CRTC chip
  13279. ;
  13280.  
  13281. b80ext:    lda    #$37
  13282.     sta    $01        ; turn the rom back on.
  13283.     jsr    $80fd        ; de-init the 80 column display
  13284.     lda    #$36
  13285.     sta    $01        ; back to normal memory map
  13286.     lda    bordold        ; border color fouled up by BI-80
  13287.     sta    $d020
  13288.     rts            ; all done
  13289.  
  13290. ;
  13291. ;    b80set - change the hardware after a "set screen xxx" command
  13292. ;
  13293. ;    This routine does nothing because there is nothing on the B80 card
  13294. ;    that can be set.
  13295. ;
  13296.  
  13297. b80set:    rts
  13298.  
  13299. ;
  13300. ;    b80put - put a character on the Batteries Included screen
  13301. ;
  13302. ;    Input:    A-reg is the character to put
  13303. ;        cx and cy show where to put it
  13304. ;
  13305. ;    Output:    A character is displayed upon the Batteries Included screen
  13306. ;
  13307. ;    This routine prints stuff on the Batteries Included screen.  It does
  13308. ;    not advance the cursor.
  13309. ;
  13310.  
  13311. b80put:    ldx    #b80map2-b80map1; run it through the translation table
  13312. b80put1:cmp    b80map1-1,x    ; look for character less than current
  13313.     bcs    b80put2
  13314.     dex
  13315.     bne    b80put1        ; always taken
  13316. b80put2:sbc    b80map1-1,x    ; carry already set
  13317.     clc
  13318.     adc    b80map2-1,x    ; now we have a screen code
  13319.     pha
  13320.     ldx    cx
  13321.     ldy    cy
  13322.     jsr    b80adrt        ; compute the address to store char at
  13323.     pla            ; remember screen code to store
  13324.     cmp    #$20        ; is it a space?
  13325.     beq    b80put3        ; dont reverse if highlighted space
  13326.     ldx    alternt        ; in alternate color mode?
  13327.     beq    b80put3
  13328.     ora    #$80        ; yes.  Reverse will have to do....
  13329. b80put3:ldx    reverse        ; is reverse on?
  13330.     beq    b80put4        ; no.  dont reverse
  13331.     ora    #$80
  13332. b80put4:ldx    underln        ; underline on?
  13333.     beq    b80put5
  13334.     ora    #$80        ; reverse will have to do...
  13335. b80put5:ldx    flash        ; flashing on?
  13336.     beq    b80put6        ; no, dont reverse
  13337.     ora    #$80        ; reverse will have to do...
  13338. b80put6:ldy    #$00        ; finally, store the character
  13339.     sta    (dest),y
  13340.     rts            ; all done
  13341.  
  13342. ;
  13343. ;    b80irm - make space for a character if insert replace mode is insert
  13344. ;
  13345.  
  13346. b80irm:    ldx    #$00
  13347.     ldy    cy
  13348.     jsr    b80adrt
  13349.     ldy    cx
  13350. b80irm4:lda    (dest),y        ; who cares what x is the first time?
  13351.     pha
  13352.     txa
  13353.     sta    (dest),y
  13354.     pla
  13355.     tax
  13356.     iny
  13357.     cpy    #80
  13358.     bcc    b80irm4
  13359.     rts
  13360.  
  13361. ;
  13362. ;    b80dch - delete one or more characters.
  13363. ;
  13364. ;    Input:    Number of characters to delete in A-reg
  13365. ;        Cursor position in cx, cy
  13366. ;
  13367.  
  13368. b80dch:    sta    freemem            ; save number of characters to delete
  13369.     lda    cx
  13370. b80dch2:pha                ; save counter
  13371.     tax                ; compute character address
  13372.     ldy    cy
  13373.     jsr    b80adrt
  13374.     clc                ; see if this character should be blank
  13375.     pla
  13376.     pha
  13377.     adc    freemem
  13378.     cmp    #80
  13379.     lda    #$20            ; get a blank ready
  13380.     bcs    b80dch1
  13381.     ldy    freemem            ; no blank.  get another character ready
  13382.     lda    (dest),y
  13383. b80dch1:ldy    #$00
  13384.     sta    (dest),y        ; put in the character
  13385.     clc                ; now add 1 to the counter and repeat
  13386.     pla
  13387.     adc    #$01
  13388.     cmp    #80
  13389.     bcc    b80dch2            ; more characters to handle?
  13390.     rts                ; all done
  13391.  
  13392. ;
  13393. ;    b80ind - scroll the screen in Batteries Included mode
  13394. ;
  13395. ;    Input:    top, bot
  13396. ;        Number of lines to scroll in a-reg
  13397. ;    Output:    Batteries Included ram is scrolled
  13398. ;
  13399. ;    This routine scrolls the area of the Batteries Included screen that
  13400. ;    is between top and bot
  13401. ;
  13402. ;    This routine is also used by delete line.
  13403. ;
  13404.  
  13405. b80ind:    tax            ; save number of lines to scroll
  13406.     lda    cy        ; save the cursor y position
  13407.     pha
  13408.     lda    top        ; top of scrolling region
  13409.     sta    cy
  13410.     txa            ; push number of lines to scroll
  13411.     pha
  13412. b80ind1:clc
  13413.     pla
  13414.     pha
  13415.     adc    cy
  13416.     cmp    bot
  13417.     beq    b80ind3
  13418.     bcs    b80ind2
  13419. b80ind3:tay
  13420.     ldx    #$00
  13421.     jsr    b80adrt        ; calculate source address
  13422.     lda    dest        ; source address must be moved from dest
  13423.     sta    source
  13424.     lda    dest+1
  13425.     sta    source+1
  13426.     ldy    cy        ; calculate destination address
  13427.     ldx    #$00
  13428.     jsr    b80adrt
  13429.     ldx    #10        ; 10 * 8 = 80 bytes to move
  13430.     jsr    move8        ; scroll one line
  13431.     inc    cy
  13432.     jmp    b80ind1
  13433. b80ind2:jsr    b80el2        ; erase the bottom line
  13434.     inc    cy
  13435.     ldy    bot
  13436.     cpy    cy
  13437.     bcs    b80ind1
  13438.     pla            ; discard number of lines to sccroll
  13439.     pla            ; restore the cursor position
  13440.     sta    cy
  13441.     rts
  13442.     
  13443. ;
  13444. ;    b80ri - perform the VT100 reverse index function (scroll backwards)
  13445. ;
  13446. ;    Input:    Number of lines to scroll in A-reg
  13447. ;    Output: None
  13448. ;
  13449. ;    Registers destroyed - A,X,Y
  13450. ;
  13451. ;    This routine scrolls the screen upwards in Batteries Include mode.
  13452. ;    Only the area in the scrolling region is changed.
  13453. ;
  13454. ;    This routine is also used for insert line.
  13455. ;
  13456.  
  13457. b80ri:    tax            ; save number of lines to scroll
  13458.     lda    cy        ; save the cursor y position
  13459.     pha
  13460.     lda    bot        ; top of scrolling region
  13461.     sta    cy
  13462.     txa            ; put number of lines to scroll on stack
  13463.     pha
  13464. b80ri1:    sec
  13465.     pla
  13466.     pha
  13467.     eor    #$ff
  13468.     adc    cy
  13469.     cmp    top        ; have we reached the bottom of the region?
  13470.     bmi    b80ri2
  13471.     tay
  13472.     ldx    #$00
  13473.     jsr    b80adrt        ; calculate source address
  13474.     lda    dest        ; source address must be moved from dest
  13475.     sta    source
  13476.     lda    dest+1
  13477.     sta    source+1
  13478.     ldy    cy        ; calculate destination address
  13479.     ldx    #$00
  13480.     jsr    b80adrt
  13481.     ldx    #10        ; 10 * 8 = 80 bytes to move
  13482.     jsr    move8        ; scroll one line
  13483.     dec    cy
  13484.     jmp    b80ri1        ; repeat until done
  13485. b80ri2:    jsr    b80el2        ; erase the bottom line
  13486.     dec    cy
  13487.     ldy    cy
  13488.     cpy    top
  13489.     bpl    b80ri1
  13490.     pla            ; discard number of lines to scroll
  13491.     pla            ; restore the cursor position
  13492.     sta    cy
  13493.     rts
  13494.  
  13495. ;
  13496. ;    b80el0 - erase from the cursor to the end of the current line
  13497. ;
  13498. ;    Input:    Cursor y coordinate in cy
  13499. ;
  13500. ;    Output:    A line is cleared on the Batteries Included card
  13501. ;
  13502. ;    This routine erases one line starting at the cursor
  13503. ;
  13504.  
  13505. b80el0:    ldy    cy        ; compute address of line to clear
  13506.     ldx    cx
  13507.     jsr    b80adrt
  13508.     ldy    #$00
  13509.     ldx    cx
  13510.     lda    #$20        ; clear with spaces
  13511. b80el0a:sta    (dest),y
  13512.     iny
  13513.     inx
  13514.     cpx    #80
  13515.     bcc    b80el0a        ; repeat till column 80 is cleared
  13516.     rts            ; all done
  13517.  
  13518. ;
  13519. ;    b80el1 - erase from the beginning of the line to the cursor
  13520. ;
  13521. ;    Input:    cy
  13522. ;
  13523. ;    Output:    spaces written to the Batteries Included screen
  13524. ;
  13525. ;    This routine erases form the beginning of the current line to the
  13526. ;    cursor
  13527. ;
  13528.  
  13529. b80el1:    ldy    cy        ; compute address to erase
  13530.     ldx    #$00
  13531.     jsr    b80adrt
  13532.     lda    #$20
  13533.     ldy    #$00
  13534. b80el1a:sta    (dest),y    ; erase text
  13535.     iny
  13536.     cpy    cx        ; repeat till done
  13537.     bcc    b80el1a
  13538.     beq    b80el1a
  13539.     rts            ; all done
  13540.  
  13541. ;
  13542. ;    b80el2 - erase one line totally
  13543. ;
  13544. ;    Input:    line to erase in cy
  13545. ;
  13546. ;    Output:    stuff written to the Batteries Included screen
  13547. ;
  13548. ;    This routine erases one line completly from the Batteries Included
  13549. ;    screen
  13550. ;
  13551.  
  13552. b80el2:    ldy    cy        ; compute address to erase
  13553.     ldx    #$00
  13554.     jsr    b80adrt
  13555.     ldx    #10        ; 10 * 8 = 80 bytes to erase
  13556.     lda    #$20
  13557.     jsr    fill8
  13558.     rts
  13559.  
  13560. ;
  13561. ;    b80fls - flash the screen Batteries Included mode
  13562. ;
  13563. ;    Input:    None
  13564. ;
  13565. ;    Output:    None
  13566. ;
  13567. ;    This routine does nothing because it is not possible to flash the
  13568. ;    Batteries Included screen
  13569.  
  13570. b80fls:    rts
  13571.  
  13572. ;
  13573. ;    b80tgl - toggle the cursor in Batteries included mode
  13574. ;
  13575. ;    Input:    cx, cy
  13576. ;
  13577. ;    Output:    The cursor is toggled
  13578. ;
  13579. ;    This routine toggles the cursor in Batteries Included mode
  13580. ;
  13581.  
  13582. b80tgl:    ldy    cy        ; get the address to toggle
  13583.     ldx    cx
  13584.     jsr    b80adrt
  13585.     ldy    #$00        ; toggle it
  13586.     lda    (dest),y
  13587.     eor    #$80
  13588.     sta    (dest),y
  13589.     rts            ; all done
  13590.  
  13591. ;
  13592. ;    b80txt - enter text mode (possibly from graphics mode)
  13593. ;
  13594. ;    If the b80flag is clear, then we are in graphics mode and must
  13595. ;    call the 80-column screen driver to leave it.  Otherwise we
  13596. ;    just call a rom routine (on the bi-80 card) to initialize things.
  13597. ;
  13598.  
  13599. b80txt:    asl    b80flag        ; test and clear the flag
  13600.     bcs    b80txt1        ; skip graphics stuff if not in graphics mode
  13601.     jsr    b80ext        ; turn off graphics.
  13602. b80txt1:lda    #$37
  13603.     sta    $01        ; turn the rom back on.
  13604.     jsr    $80f4        ; initialize 80 column display
  13605.     lda    #$0e        ; put in uppercase/lowercase mode
  13606.     jsr    chrout
  13607.     jsr    restoi        ; restore operating system
  13608.     lda    #$36
  13609.     sta    $01        ; back to normal memory map
  13610.     rts            ; all done
  13611.  
  13612. ;
  13613. ;    b80tek - enter tektronix mode
  13614. ;
  13615. ;    Since there is no graphics support on the batteries included
  13616. ;    card, we go to 80-column mode.
  13617. ;
  13618.  
  13619. b80tek:    jsr    b80ext        ; exit b80 screen driver
  13620.     jsr    c80ent        ; enter 80 column screen driver
  13621.     jsr    c80tek        ; set up for graphics
  13622.     rts
  13623.  
  13624. ;
  13625. ;    graphics routines.
  13626. ;
  13627.  
  13628. b80drw:    jmp    c80drw
  13629. b80lin:    jmp    c80lin
  13630. b80era:    jmp    c80era
  13631. b80int:    jmp    c80int
  13632.  
  13633. ;    b80adrt - compute the text address of x,y
  13634. ;
  13635. ;    Input:    x and y coordinates in X-reg and Y-reg
  13636. ;
  13637. ;    Output:    text address in (dest)
  13638. ;
  13639. ;    This routine calculates the address of text ram associated
  13640. ;    with x,y
  13641. ;
  13642.  
  13643. b80adrt:jsr    c28adr        ; compute the base address
  13644.     clc            ; add in the address of attribute ram
  13645.     lda    dest+1
  13646.     adc    #b80text^
  13647.     sta    dest+1
  13648.     rts    
  13649.  
  13650. ; 
  13651. ;    b80tst - test to see if the Batteries Included screen driver is present
  13652. ; 
  13653. ;     Input:    None
  13654. ;
  13655. ;     Output: carry set if Battries Included 80-column display not present
  13656. ; 
  13657. ;     Registers destroyed - A, X
  13658. ; 
  13659. ;     This routine returns with the carry clear if Batteries Included
  13660. ;     screen is available.  If it isn't, it returns with the carry set
  13661. ; 
  13662.  
  13663. b80tst:    lda    #$37        ; turn on the rom before reading from it
  13664.     sta    $01
  13665.     ldx    #b80tst4-b80tst3; look for "batteries included" at $8009
  13666. b80tst2:lda    b80tst3-1,x
  13667.     cmp    $8009-1,x
  13668.     bne    b80tst1
  13669.     dex
  13670.     bne    b80tst2
  13671.     lda    #$36        ; restore ram 
  13672.     sta    $01
  13673.     clc            ; found "batteries included".  Is available
  13674.     rts
  13675. b80tst1:lda    #$36        ; restore ram 
  13676.     sta    $01
  13677.     sec            ; is not available
  13678.     rts
  13679.  
  13680. b80tst3:.byte    "BATTERIES INCLUDED"
  13681. b80tst4:
  13682.  
  13683. ;
  13684. ;    b80map - translation table.  'funky' ascii -> screen code.
  13685. ;
  13686. ;    This table translates 'funky' ascii into screen codes.
  13687. ;
  13688.  
  13689. b80map1:.byte    $00        ; ' ' to '?'
  13690.     .byte    $20        ; '@'
  13691.     .byte    $21        ; 'A' to 'Z'
  13692.     .byte    $3b        ; '['
  13693.     .byte    $3c        ; '\'
  13694.     .byte    $3d        ; ']' to '^'
  13695.     .byte    $3f        ; '_'
  13696.     .byte    $40        ; '`'
  13697.     .byte    $41        ; 'a' to 'z'
  13698.     .byte    $5b        ; '{'
  13699.     .byte    $5c        ; '|'
  13700.     .byte    $5d        ; '}'
  13701.     .byte    $5e        ; '~'
  13702.     .byte    $5f        ; diamond
  13703.     .byte    $60        ; square
  13704.     .byte    $61        ; h-t
  13705.     .byte    $62        ; f-f
  13706.     .byte    $63        ; c-r, l-f, degrees, plus/minus
  13707.     .byte    $67        ; n-l
  13708.     .byte    $68        ; v-t
  13709.     .byte    $69        ; upper-left
  13710.     .byte    $6a        ; lower-left
  13711.     .byte    $6b        ; lower-right
  13712.     .byte    $6c        ; upper-right
  13713.     .byte    $6d        ; crossed lines
  13714.     .byte    $6e        ; scan 1, scan 3, scan 5, scan 7
  13715.     .byte    $72        ; scan 9
  13716.     .byte    $73        ; middle-right
  13717.     .byte    $74        ; middle-left
  13718.     .byte    $75        ; upper-middle, lower-middle
  13719.     .byte    $77        ; vertical line
  13720.     .byte    $78        ; <=
  13721.     .byte    $79        ; >=
  13722.     .byte    $7a        ; pi
  13723.     .byte    $7b        ; !=
  13724.     .byte    $7c        ; british pund
  13725.     .byte    $7d        ; dot
  13726. b80map2:.byte    $20        ; ' ' to '?'
  13727.     .byte    $00        ; '@'
  13728.     .byte    $41        ; 'A' to 'Z'
  13729.     .byte    $1b        ; '['
  13730.     .byte    $7f        ; '\'
  13731.     .byte    $1d        ; ']' to '^'
  13732.     .byte    $64        ; '_'
  13733.     .byte    $7e        ; '`'
  13734.     .byte    $01        ; 'a' to 'z'
  13735.     .byte    $75        ; '{'
  13736.     .byte    $69        ; '|'
  13737.     .byte    $76        ; '}'
  13738.     .byte    $5f        ; '~'
  13739.     .byte    $40        ; diamond
  13740.     .byte    $66        ; square
  13741.     .byte    $5c        ; h-t
  13742.     .byte    $7c        ; f-f
  13743.     .byte    $60        ; c-r, l-f, degrees, plus/minus
  13744.     .byte    $65        ; n-l
  13745.     .byte    $67        ; v-t
  13746.     .byte    $7d        ; upper-left
  13747.     .byte    $6e        ; lower-left
  13748.     .byte    $70        ; lower-right
  13749.     .byte    $6d        ; upper-right
  13750.     .byte    $5b        ; crossed lines
  13751.     .byte    $77        ; scan 1, scan 3, scan 5, scan 7
  13752.     .byte    $6f        ; scan 9
  13753.     .byte    $6b        ; middle-right
  13754.     .byte    $73        ; middle-left
  13755.     .byte    $71        ; upper-middle, lower-middle
  13756.     .byte    $5d        ; vertical line
  13757.     .byte    $68        ; <=
  13758.     .byte    $6a        ; >=
  13759.     .byte    $5e        ; pi
  13760.     .byte    $6c        ; !=
  13761.     .byte    $1c        ; british pund
  13762.     .byte    $74        ; dot
  13763. .SBTTL    Commodore 128 screen driver
  13764.  
  13765. ; 
  13766. ;     These routines manipulate the screen in Commodore 128 mode
  13767. ; 
  13768.  
  13769. ; 
  13770. ;    c28ini - initilize the commodore-128 screen.
  13771. ; 
  13772. ;     Input:    None
  13773. ; 
  13774. ;     Output:    Commodore 128 hardware initilized
  13775. ; 
  13776. ;     This routine is called once during powerup to initilize the
  13777. ;     Commodore 128 hardware
  13778. ;
  13779. ;    Warning:  The 8563 registers must be initialized lowest to highest.
  13780. ;    If you do it any other way, you will discover an undocumented "feature"
  13781. ; 
  13782.  
  13783. c28ini:    ldy    #$47        ; init smooth scroll to $47 if rev 8 chip
  13784.     lda    $d600        ; check the revision level
  13785.     beq    c28ini1        ; oops no 8563 here
  13786.     and    #$03        ; extract revision level
  13787.     bne    c28ini2        ; new 8563
  13788.     ldy    #$40        ; init to $40 if old 8563
  13789. c28ini2:tya    
  13790.     ldx    #25        ; init reg 25
  13791.     jsr    wr8563
  13792.     ldx    #$00        ; initilize 36 regs
  13793. c28ini4:lda    in8563,x    ; get byte to init with
  13794.     cmp    #$ff        ; nothing inits to $ff
  13795.     beq    c28ini3        ; was $ff.  dont init
  13796.     jsr    wr8563
  13797. c28ini3:inx            ; repeat till done
  13798.     cpx    #37        ; there are 36 registers to initialize
  13799.     bcc    c28ini4        ; not done yet
  13800. c28ini1:lda    #$fc        ; mark us as not being in fast mode
  13801.     sta    fast
  13802.     rts    
  13803.  
  13804. ;
  13805. ;    c28ent - enter the commodore-128 80-column screen-driver
  13806. ;
  13807. ;    This routine starts the 8563 screen driver and allows the use of fast
  13808. ;    mode.
  13809. ;
  13810.  
  13811. c28ent:    lda    #$fd        ; mark us as being in fast mode
  13812.     sta    fast
  13813.     rts
  13814.  
  13815. ;
  13816. ;    c28ext - exit from the commodore-128 80-column screen-driver
  13817. ;
  13818. ;    this routine does nothing because nothing exciting has to happen
  13819. ;    to turn off the 80-column screen.
  13820. ;
  13821.  
  13822. c28ext:    lda    #$fc        ; exit from fast mode
  13823.     sta    fast
  13824.     rts            ; this routine does nothing
  13825.  
  13826. ;
  13827. ;    c28set - change the hardware after a "set screen xxx" command
  13828. ;
  13829.  
  13830. c28set:    ldx    foreclr        ; foreclr only important when entering tek
  13831.     lda    c28map,x
  13832.     asl    a
  13833.     asl    a
  13834.     asl    a
  13835.     asl    a
  13836.     ldy    decrev        ; is screen bright or dark
  13837.     ldx    backclr,y
  13838.     ora    c28map,x
  13839.     ldx    #26
  13840.     jsr    wr8563
  13841.     rts
  13842.  
  13843. ;
  13844. ;    c28put - put a character on the Commodore-128 screen
  13845. ;
  13846. ;    Input:    A-reg is the character to put
  13847. ;        cx and cy show where to put it
  13848. ;
  13849. ;    Output:    A character is displayed upon the Commodore-128 screen
  13850. ;
  13851. ;    This routine prints stuff on the Commodore-128 screen.  It does
  13852. ;    not advance the cursor.
  13853. ;
  13854.  
  13855. c28put:    pha            ; save the character to put
  13856.     ldx    cx        ; compute the address in txt8563
  13857.     ldy    cy
  13858.     jsr    c28adrt
  13859.     jsr    c28r18        ; write it to 8563 regs 18 and 19
  13860.     pla            ; remember the character to put
  13861.     ldx    #31        ; reg 31 writes to ram
  13862.     jsr    wr8563        ; write to 8563 ram
  13863.     ldx    cx        ; compute the address in alt8563
  13864.     ldy    cy
  13865.     jsr    c28adra
  13866.     jsr    c28r18        ; write the address to 8563 regs 18 and 19
  13867.     ldy    alternt        ; check the alternt flag (1 or 0)
  13868.     ldx    foreclr,y    ; get the color to use
  13869.     lda    c28map,x    ; map to commodore-128 colors from c-64 colors
  13870.     ldx    reverse        ; if reverse is set, tell the 8563 about it
  13871.     beq    c28put1
  13872.     ora    #$40
  13873. c28put1:ldx    underln        ; if underlining is on, tell the 8563 about it
  13874.     beq    c28put2
  13875.     ora    #$20
  13876. c28put2:ldx    flash        ; if character is flashing, tell the 8563.
  13877.     beq    c28put4
  13878.     ora    #$10
  13879. c28put4:ldx    #31        ; write the attribute byte into 8563 ram
  13880.     jsr    wr8563
  13881.     rts    
  13882.  
  13883. ;
  13884. ;    c28irm - make space for a character if insert replace mode is insert
  13885. ;
  13886.  
  13887. c28irm:    ldx    cx
  13888.     cpx    #79        ; if in last column, no space needed
  13889.     bcc    c28irm1
  13890.     rts
  13891. c28irm1:ldy    cy
  13892.     jsr    c28adrt
  13893.     lda    #pad8563^    ; write the msb to r18
  13894.     ldx    #18
  13895.     jsr    wr8563
  13896.     inx            ; r19 gets the lsb
  13897.     lda    #pad8563\
  13898.     jsr    wr8563
  13899.     lda    in8563+24
  13900.     ora    #$80        ; set bit 7 in register 24
  13901.     ldx    #24
  13902.     jsr    wr8563
  13903.     jsr    c28r32        ; write source address to r32
  13904.     sec
  13905.     lda    #79
  13906.     sbc    cx
  13907.     pha
  13908.     ldx    #30        ; number of bytes to copy
  13909.     jsr    wr8563        ; go copy junk into the pad area
  13910.     inc    dest
  13911.     bne    c28irm2
  13912.     inc    dest+1
  13913. c28irm2:jsr    c28r18        ; write dest address to r18
  13914.     lda    in8563+24
  13915.     ora    #$80        ; set bit 7 in register 24
  13916.     ldx    #24
  13917.     jsr    wr8563
  13918.     lda    #pad8563^    ; write the msb to r32
  13919.     ldx    #32
  13920.     jsr    wr8563
  13921.     inx            ; r33 gets the lsb
  13922.     lda    #pad8563\
  13923.     jsr    wr8563
  13924.     pla            ; number of bytes to copy
  13925.     pha
  13926.     ldx    #30        ; number of bytes to copy
  13927.     jsr    wr8563        ; go copy junk into the pad area
  13928.     ldx    cx
  13929.     ldy    cy
  13930.     jsr    c28adra
  13931.     lda    #pad8563^    ; write the msb to r18
  13932.     ldx    #18
  13933.     jsr    wr8563
  13934.     inx            ; r33 gets the lsb
  13935.     lda    #pad8563\
  13936.     jsr    wr8563
  13937.     lda    in8563+24
  13938.     ora    #$80        ; set bit 7 in register 24
  13939.     ldx    #24
  13940.     jsr    wr8563
  13941.     jsr    c28r32        ; write source address to r32
  13942.     pla
  13943.     pha
  13944.     ldx    #30        ; number of bytes to copy
  13945.     jsr    wr8563        ; go copy junk into the pad area
  13946.     inc    dest
  13947.     bne    c28irm3
  13948.     inc    dest+1
  13949. c28irm3:jsr    c28r18        ; write dest address to r18
  13950.     lda    in8563+24
  13951.     ora    #$80        ; set bit 7 in register 24
  13952.     ldx    #24
  13953.     jsr    wr8563
  13954.     lda    #pad8563^    ; write the msb to r32
  13955.     ldx    #32
  13956.     jsr    wr8563
  13957.     inx            ; r33 gets the lsb
  13958.     lda    #pad8563\
  13959.     jsr    wr8563
  13960.     pla            ; number of bytes to copy
  13961.     ldx    #30        ; number of bytes to copy
  13962.     jsr    wr8563        ; go copy junk into the pad area
  13963.     rts
  13964.  
  13965. ;
  13966. ;    c28dch - delete one or more characters
  13967. ;
  13968. ;    Input:    Number of characters to delete in A-reg
  13969. ;        Cursor position in cx, cy
  13970. ;
  13971.  
  13972. c28dch:    tax            ; save number of characters to delete
  13973.     clc
  13974.     adc    cx
  13975.     cmp    #80        ; deleting rest of line?
  13976.     bcc    c28dch3
  13977.     jmp    c28el0        ; if so, just erase rest of line
  13978. c28dch3:txa            ; remember number of characters to delete
  13979.     pha            ; save number of characters to delete
  13980.     ldx    cx        ; set up destination address
  13981.     ldy    cy
  13982.     jsr    c28adrt
  13983.     jsr    c28r18
  13984.     lda    in8563+24
  13985.     ora    #%10000000    ; set bit seven
  13986.     ldx    #24
  13987.     jsr    wr8563
  13988.     clc            ; set up source address
  13989.     pla            ; restore and save number of characters to del
  13990.     pha
  13991.     adc    cx
  13992.     pha            ; 80 - this value is number of bytes to copy
  13993.     tax
  13994.     ldy    cy
  13995.     jsr    c28adrt
  13996.     jsr    c28r32
  13997.     sec            ; compute 80 - value on stack
  13998.     pla
  13999.     eor    #$ff
  14000.     adc    #80
  14001.     ldx    #30        ; write block count to register 30
  14002.     jsr    wr8563
  14003.     lda    #$00        ; write in a space at the end of the line
  14004.     ldx    #31
  14005.     jsr    wr8563
  14006.     sec
  14007.     pla            ; restore and save number of characters to del
  14008.     pha
  14009.     sbc    #$01    
  14010.     beq    c28dch1        ; skip this if zero additional blanks needed
  14011.     pha            ; save number of characters to blank
  14012.     lda    in8563+24    ; clear bit 7 of register 24
  14013.     and    #%01111111
  14014.     ldx    #24
  14015.     jsr    wr8563
  14016.     pla            ; restore number of characters to blank
  14017.     ldx    #30        ; block copy word count
  14018.     jsr    wr8563
  14019. c28dch1:ldx    cx        ; set up destination address
  14020.     ldy    cy
  14021.     jsr    c28adra
  14022.     jsr    c28r18
  14023.     lda    in8563+24
  14024.     ora    #%10000000    ; set bit seven
  14025.     ldx    #24
  14026.     jsr    wr8563
  14027.     clc            ; set up source address
  14028.     pla            ; restore and save number of characters to del
  14029.     pha
  14030.     adc    cx
  14031.     pha            ; 80 - this value is number of bytes to copy
  14032.     tax
  14033.     ldy    cy
  14034.     jsr    c28adra
  14035.     jsr    c28r32
  14036.     sec            ; compute 80 - value on stack
  14037.     pla
  14038.     eor    #$ff
  14039.     adc    #80
  14040.     ldx    #30        ; write block count to register 30
  14041.     jsr    wr8563
  14042.     lda    #$00        ; write in a space at the end of the line
  14043.     ldx    #31
  14044.     jsr    wr8563
  14045.     sec
  14046.     pla            ; save number of characters to del
  14047.     sbc    #$01        ; we already did one
  14048.     beq    c28dch2        ; skip this if zero additional blanks needed
  14049.     pha            ; save number of characters to blank
  14050.     lda    in8563+24    ; clear bit 7 of register 24
  14051.     and    #%01111111
  14052.     ldx    #24
  14053.     jsr    wr8563
  14054.     pla            ; restore number of characters to blank
  14055.     ldx    #30        ; block copy word count
  14056.     jsr    wr8563
  14057. c28dch2:rts
  14058.  
  14059. ;    
  14060. ;
  14061. ;    c28ind - scroll the screen in commodore-128 mode
  14062. ;
  14063. ;    Input:    top, bot
  14064. ;
  14065. ;    Output:    8563 ram is scrolled
  14066. ;
  14067. ;    This routine scrolls the area of the commodore-128 screen that
  14068. ;    is between top and bot
  14069. ;
  14070. ;    This routine is also used for delete line.
  14071. ;
  14072.  
  14073. c28ind:    tax            ; save the number of lines to scroll.
  14074.     lda    cy        ; save the cursor y position
  14075.     pha
  14076.     lda    top        ; start scrolling at the top
  14077.     sta    cy
  14078.     txa            ; push number of lines to scroll
  14079.     pha
  14080. c28ind1:clc
  14081.     pla
  14082.     pha
  14083.     adc    cy        ; compute the address of this line
  14084.     cmp    bot
  14085.     beq    c28ind3
  14086.     bcs    c28ind2
  14087. c28ind3:pha            ; save this result.  Usefull later
  14088.     tay
  14089.     ldx    #$00
  14090.     jsr    c28adrt
  14091.     jsr    c28r32        ; write it into block copy source addres
  14092.     ldy    cy
  14093.     ldx    #$00
  14094.     jsr    c28adrt
  14095.     lda    in8563+24    ; set bit seven in register 24
  14096.     ora    #$80
  14097.     ldx    #24
  14098.     jsr    wr8563
  14099.     jsr    c28r18        ; write destination address to 8563
  14100.     lda    #80        ; copy 80 bytes
  14101.     ldx    #30
  14102.     jsr    wr8563
  14103.     pla
  14104.     tay
  14105.     ldx    #$00        ; compute address of this line
  14106.     jsr    c28adra
  14107.     jsr    c28r32        ; write it into block copu source address
  14108.     ldy    cy        ; compute destination address
  14109.     ldx    #$00
  14110.     jsr    c28adra
  14111.     lda    in8563+24    ; set bit seven in register 24
  14112.     ora    #$80
  14113.     ldx    #24
  14114.     jsr    wr8563
  14115.     jsr    c28r18        ; write it into the destination address
  14116.     lda    #80        ; copy 80 bytes
  14117.     ldx    #30
  14118.     jsr    wr8563
  14119.     inc    cy
  14120.     jmp    c28ind1
  14121. c28ind2:jsr    c28el2
  14122.     inc    cy
  14123.     ldy    bot
  14124.     cpy    cy
  14125.     bcs    c28ind1        ; nope
  14126.     pla            ; discard number of lines to scroll
  14127.     pla            ; restore cursor position
  14128.     sta    cy
  14129.     rts
  14130.  
  14131. ;
  14132. ;    c28ri - scroll the screen backwards in commodore 128 mode
  14133. ;
  14134. ;    Input:    top, bot
  14135. ;        Number of lines to scroll in A-reg
  14136. ;    Output:    ram in the 8563 is scrolled backwards
  14137. ;
  14138. ;    This routine scrolls the part of the screen between top and bot
  14139. ;    in commodore 128 mode
  14140. ;
  14141. ;    This routine is also used for insert line.
  14142. ;
  14143.  
  14144. c28ri:    tax            ; save number of lines to scroll
  14145.     lda    cy        ; save the cursor position
  14146.     pha
  14147.     lda    bot
  14148.     sta    cy
  14149.     txa            ; push number of lines to scroll
  14150.     pha
  14151. c28ri1:    sec            ; comput cy-top_of_stack the hard way
  14152.     pla
  14153.     pha
  14154.     eor    #$ff
  14155.     adc    cy
  14156.     cmp    top        ; see if on screen
  14157.     bmi    c28ri2
  14158.     pha            ; save this result.  It is usefull
  14159.     tay
  14160.     ldx    #$00
  14161.     jsr    c28adrt        ; compute the source address
  14162.     jsr    c28r32
  14163.     ldy    cy        ; compute the destination address
  14164.     ldx    #$00
  14165.     jsr    c28adrt
  14166.     lda    in8563+24    ; set the msb in register 24
  14167.     ora    #$80
  14168.     ldx    #24
  14169.     jsr    wr8563
  14170.     jsr    c28r18        ; write the destination in r18
  14171.     lda    #80        ; block copy 80 bytes
  14172.     ldx    #30
  14173.     jsr    wr8563
  14174.     pla
  14175.     tay
  14176.     ldx    #$00
  14177.     jsr    c28adra        ; compute the source address
  14178.     jsr    c28r32
  14179.     ldy    cy        ; now do the same thing to the attribute ram
  14180.     ldx    #$00
  14181.     jsr    c28adra
  14182.     lda    in8563+24    ; set the msb in register 24
  14183.     ora    #$80
  14184.     ldx    #24
  14185.     jsr    wr8563
  14186.     jsr    c28r18        ; write the destination in r18
  14187.     lda    #80        ; block copy 80 bytes
  14188.     ldx    #30
  14189.     jsr    wr8563
  14190.     dec    cy
  14191.     jmp    c28ri1        ; repeat till done
  14192. c28ri2:    jsr    c28el2
  14193.     dec    cy
  14194.     ldy    cy
  14195.     cpy    top
  14196.     bpl    c28ri1
  14197.     pla            ; discard number of lines to scroll
  14198.     pla            ; restore cursor position
  14199.     sta    cy
  14200.     rts
  14201.  
  14202. ;
  14203. ;    c28el0 - erase from the cursor to the end of the current line
  14204. ;
  14205. ;    Input:    Cursor y coordinate in cy
  14206. ;
  14207. ;    Output:    A line is cleared on the 8563
  14208. ;
  14209. ;    This routine erases one line starting at the cursor
  14210. ;
  14211.  
  14212. c28el0:    ldy    cy
  14213.     ldx    cx
  14214.     jsr    c28adrt        ; compute the address to start erasing at
  14215.     jsr    c28r18        ; write it to the 8563
  14216.     lda    #$00        ; write zeros over the line
  14217.     ldx    #31
  14218.     jsr    wr8563        ; write one byte
  14219.     sec            ; how many more bytes?  Compute 79-cx
  14220.     lda    #79
  14221.     sbc    cx
  14222.     pha            ; save number of bytes that need erased
  14223.     beq    c28el0a        ; maby zero more bytes
  14224.     tay            ; save the number
  14225.     lda    in8563+24    ; clear bit seven in register 24
  14226.     ldx    #24
  14227.     jsr    wr8563
  14228.     tya            ; restore the number
  14229.     ldx    #30        ; block write
  14230.     jsr    wr8563
  14231. c28el0a:ldy    cy        ; now do the attribute ram
  14232.     ldx    cx
  14233.     jsr    c28adra        ; compute the address to start erasing at
  14234.     jsr    c28r18        ; write it to the 8563
  14235.     ldx    foreclr        
  14236.     lda    c28map,x
  14237.     ldx    #31
  14238.     jsr    wr8563        ; write one byte
  14239.     pla            ; remember the number of bytes to erase
  14240.     beq    c28el0b        ; maby zero more bytes
  14241.     tay            ; save the number
  14242.     lda    in8563+24    ; clear bit seven in register 24
  14243.     ldx    #24
  14244.     jsr    wr8563
  14245.     tya            ; restore the number
  14246.     ldx    #30        ; block write
  14247.     jsr    wr8563
  14248. c28el0b:rts            ; all done
  14249.  
  14250. ;
  14251. ;    c28el1 - erase from the beginning of the line to the cursor
  14252. ;
  14253. ;    Input:    cy
  14254. ;
  14255. ;    Output:    zeros written to the 8563
  14256. ;
  14257. ;    This routine erases from the beginning of the current line to the
  14258. ;    cursor
  14259. ;
  14260.  
  14261. c28el1:    ldy    cy
  14262.     ldx    #$00
  14263.     jsr    c28adrt        ; compute the starting area
  14264.     jsr    c28r18        ; write the address to the 8563
  14265.     ldx    #31        ; write a zero here
  14266.     lda    #$00
  14267.     jsr    wr8563
  14268.     lda    cx        ; how many more zeros necessary?
  14269.     beq    c28el1a        ; maby zero
  14270.     lda    in8563+24    ; clear bit seven in register 24
  14271.     ldx    #24
  14272.     jsr    wr8563
  14273.     lda    cx
  14274.     ldx    #30        ; block copy the zeros
  14275.     jsr    wr8563
  14276. c28el1a:ldy    cy
  14277.     ldx    #$00
  14278.     jsr    c28adra        ; compute the starting address
  14279.     jsr    c28r18        ; write the address to the 8563
  14280.     ldx    foreclr
  14281.     lda    c28map,x
  14282.     ldx    #31        ; write a zero here
  14283.     jsr    wr8563
  14284.     lda    cx        ; how many more zeros necessary?
  14285.     beq    c28el1b        ; maby zero
  14286.     lda    in8563+24    ; clear bit seven in register 24
  14287.     ldx    #24
  14288.     jsr    wr8563
  14289.     lda    cx
  14290.     ldx    #30        ; block copy
  14291.     jsr    wr8563
  14292. c28el1b:rts            ; all done
  14293.  
  14294. ;
  14295. ;
  14296. ;    c28el2 - erase one line totally
  14297. ;
  14298. ;    Input:    line to erase in cy
  14299. ;
  14300. ;    Output:    stuff written to the 8563
  14301. ;
  14302. ;    This routine erases one line completly from the commodore-128 screen
  14303. ;
  14304.  
  14305. c28el2:    ldy    cy        ; compute the starting address
  14306.     ldx    #$00
  14307.     jsr    c28adrt
  14308.     jsr    c28r18
  14309.     ldx    #31        ; write a zero to 8563 ram
  14310.     lda    #$00
  14311.     jsr    wr8563
  14312.     lda    in8563+24    ; clear bit seven in register 24
  14313.     ldx    #24
  14314.     jsr    wr8563
  14315.     lda    #79        ; copy 79 more zeros
  14316.     ldx    #30
  14317.     jsr    wr8563
  14318.     ldy    cy        ; now do the same thing to attribute ram
  14319.     ldx    #$00        ; compute the starting address
  14320.     jsr    c28adra
  14321.     jsr    c28r18
  14322.     ldx    foreclr
  14323.     lda    c28map,x
  14324.     ldx    #31        ; write a $04 to 8563 ram
  14325.     jsr    wr8563
  14326.     lda    in8563+24    ; clear bit seven in register 24
  14327.     ldx    #24
  14328.     jsr    wr8563
  14329.     lda    #79        ; copy 79 more zeros
  14330.     ldx    #30
  14331.     jsr    wr8563
  14332.     rts            ; all done
  14333.  
  14334. ;    c28fls - flash the screen in commodore 128 mode
  14335. ;
  14336. ;    Input:    None
  14337. ;
  14338. ;    Output:    None
  14339. ;
  14340. ;    This routine does nothing because the 8563 will flash characters
  14341. ;    with no attention from the cpu.
  14342. ;
  14343.  
  14344. c28fls:    rts            ; this routine does nothing
  14345.  
  14346. ;
  14347. ;    c28tgl - toggle the cursor in commodore 128 mode
  14348. ;
  14349. ;    Input:    cx,cy
  14350. ;
  14351. ;    Output:    registers in the 8563 are changed
  14352. ;
  14353. ;    This routine toggles the cursor in commodore 128 mode.
  14354. ;
  14355.  
  14356. c28tgl:    lda    curabrt        ; is the cursor being turned on?
  14357.     beq    c28tgl1        ; yes
  14358.     lda    #$a0
  14359.     ldx    #10
  14360.     jsr    wr8563        ; turn cursor off
  14361.     rts            ; all done
  14362. c28tgl1:ldy    cy        ; compute the address of the cursor
  14363.     ldx    cx
  14364.     jsr    c28adrt
  14365.     lda    dest+1        ; write the high byte into r14
  14366.     ldx    #14
  14367.     jsr    wr8563
  14368.     lda    dest        ; write the lsb into r15
  14369.     ldx    #15
  14370.     jsr    wr8563
  14371.     lda    in8563+10    ; turn cursor on
  14372.     ldx    #10
  14373.     jsr    wr8563
  14374.     lda    #$01        ; KLUDGE!! Mark the cursor as always on
  14375.     sta    curstat
  14376.     rts            ; all done
  14377.  
  14378. ;
  14379. ;    c28drw - draw a character at cx, cy
  14380. ;
  14381. ;    Input:    character to put in a-reg (use funny ascii)
  14382. ;    Output: A - size of character
  14383. ;
  14384. ;    Registers destroyed - A,X,Y
  14385. ;
  14386. ;    This routine puts a character at screen position tektx, tekty and
  14387. ;    returns the size of the character.
  14388. ;
  14389.  
  14390. c28drw:    sta    source
  14391.     lda    #$00
  14392.     sta    source+1
  14393.     asl    source        ; multiplied by 2
  14394.     rol    source+1
  14395.     asl    source        ; multiplied by 4
  14396.     rol    source+1
  14397.     asl    source        ; multiplied by 8
  14398.     rol    source+1
  14399.     lda    source        ; now add in font40
  14400.     adc    #font40\    ; carry is clear
  14401.     sta    source
  14402.     lda    source+1
  14403.     adc    #font40^
  14404.     sta    source+1
  14405.     lda    tektxhi
  14406.     cmp    #80        ; see if on screen
  14407.     bcs    c28drw5
  14408.     lda    #$00
  14409.     sta    tektylo        ; so that c40sub doesnt do too much...
  14410.     ldy    #$07        ; copy the character for c40sub
  14411. c28drw1:lda    (source),y
  14412.     sta    freemem,y
  14413.     dey
  14414.     bpl    c28drw1
  14415.     jsr    c40sub        ; offset the character
  14416.     lda    tektyhi
  14417.     sta    source+1
  14418.     ldy    #$00        ; 8 scan lines in a character
  14419. c28drw2:sty    source
  14420.     ldy    source+1
  14421.     cpy    #200        ; off screen?
  14422.     bcs    c28drw5        ; if so, quit now
  14423.     ldx    tektxhi
  14424.     jsr    c28adrg
  14425.     jsr    c28r18
  14426.     ldx    #31
  14427.     jsr    rd8563
  14428.     ldy    source
  14429.     ora    freemem,y
  14430.     sta    freemem,y
  14431.     lda    tektxhi
  14432.     cmp    #79        ; if in the last column, no rightmost half
  14433.     beq    c28drw3
  14434.     jsr    rd8563
  14435.     ora    freemem+16,y
  14436.     sta    freemem+16,y
  14437. c28drw3:jsr    c28r18
  14438.     ldx    #31
  14439.     lda    freemem,y
  14440.     jsr    wr8563
  14441.     lda    tektxhi
  14442.     cmp    #79
  14443.     beq    c28drw4
  14444.     lda    freemem+16,y
  14445.     jsr    wr8563
  14446. c28drw4:inc    source+1
  14447.     iny
  14448.     cpy    #$08
  14449.     bcc    c28drw2
  14450. c28drw5:lda    #13        ; 13 pixels wide
  14451.     rts
  14452.  
  14453. ;
  14454. ;    c28tek - initialize for tektronix mode
  14455. ;
  14456. ;    This routine sets up the 8563 for bit map graphics.  Note that register
  14457. ;    25 is special.  It is initialized differently depending on the chip
  14458. ;    version level.  Also note that the foreground color used when
  14459. ;    attributes are disabled is already set for us in c40set, even though
  14460. ;    that is not necessary for the display of text.
  14461. ;
  14462.  
  14463. c28tek:    ldx    #25        ; read register 25 from 8563
  14464.     jsr    rd8563
  14465.     ora    #$80
  14466.     and    #%10111111    ; disable attributes.
  14467.     jsr    wr8563
  14468.     lda    in8563+10    ; disable cursor
  14469.     and    #%10011111
  14470.     ora    #%00100000
  14471.     ldx    #10
  14472.     jsr    wr8563
  14473.     rts
  14474.  
  14475. ;
  14476. ;    c28txt - initialize the 8563 for displaying text
  14477. ;
  14478. ;    Input:    font40
  14479. ;    Output:    chr8563 (inside the 8563 ram) gets updated
  14480. ;
  14481. ;    This routine initializes the 8563 for displaying text by copying
  14482. ;    in the character set and clearing bit 7 of register 25.  Note that
  14483. ;    register 25 is special.  it is initialized differently for different
  14484. ;    versions of the chip.
  14485.  
  14486. c28txt:    ldx    #25        ; read register 25
  14487.     jsr    rd8563
  14488.     and    #$7f        ; clear bit 7
  14489.     ora    #%01000000    ; enable attributes
  14490.     jsr    wr8563        ; write it back
  14491.     lda    in8563+10    ; restart the cursor
  14492.     ldx    #10
  14493.     jsr    wr8563
  14494.     lda    #chr8563^    ; address (in 8563) to store character set
  14495.     ldx    #18
  14496.     jsr    wr8563        ; write it in
  14497.     lda    #chr8563\
  14498.     inx
  14499.     jsr    wr8563        ; write in the high order byte too
  14500.     lda    #font40\    ; copy in character definitions to chr8563
  14501.     sta    dest
  14502.     lda    #font40^
  14503.     sta    dest+1
  14504.     ldx    #31        ; write to 8563 ram
  14505.     lda    #95+32        ; loop for 95 printable characters + 32 graphic
  14506. c28txt4:pha    
  14507.     ldy    #$00
  14508. c28txt1:lda    (dest),y    ; write 8 bytes for the character
  14509.     jsr    wr8563
  14510.     iny    
  14511.     cpy    #$08
  14512.     bcc    c28txt1
  14513.     lda    #$00        ; now pad with 8 zeros
  14514. c28txt2:jsr    wr8563
  14515.     dey    
  14516.     bne    c28txt2
  14517.     clc    
  14518.     lda    dest        ; go on to the next character
  14519.     adc    #$08
  14520.     sta    dest
  14521.     bcc    c28txt3
  14522.     inc    dest+1
  14523. c28txt3:pla            ; repeat till all 95 characters done
  14524.     sec
  14525.     sbc    #$01
  14526.     bne    c28txt4
  14527.     rts
  14528.  
  14529. ;
  14530. ;    c28lin - draw a line from the current point to the destination point
  14531. ;
  14532. ;    Input:    tekfxlo, tekfxhi    - point to draw line from (x position)
  14533. ;        tekfyhi            - point to draw line from (y position)
  14534. ;        tektxlo, tektxhi    - point to draw line to (x position)
  14535. ;        tektyhi            - point to draw line to (y position)
  14536. ;
  14537. ;    This routine draws a line.
  14538. ;
  14539. ;    It works by computing a delta.  we then add the delta to the current
  14540. ;    point and plot.  we stop only when the current point is equal to the
  14541. ;    destination point.
  14542. ;
  14543. ;    We optimize this by multiplying the delta by 2 until we know that
  14544. ;    each point plotted is at a different spot.  (We do not need to plot
  14545. ;    the same point more than once)
  14546. ;
  14547.  
  14548. c28lin:    lda    #$00        ; zero the ultra-low coordinate (no yul!!)
  14549.     sta    tekfxul
  14550.     sec            ; compute delta x
  14551.     lda    tektxlo
  14552.     sbc    tekfxlo
  14553.     sta    tekdxul
  14554.     lda    tektxhi
  14555.     sbc    tekfxhi
  14556.     sta    tekdxlo
  14557.     lda    #$00
  14558.     sbc    #$00
  14559.     sta    tekdxhi
  14560.     sec            ; compute delta y    (ylo = 0!!)
  14561.     lda    tektyhi
  14562.     sbc    tekfyhi
  14563.     sta    tekdylo
  14564.     lda    #$00
  14565.     sbc    #$00
  14566.     sta    tekdyhi
  14567.     ldx    #$08        ; dont optimize more than 8 times!!!!
  14568. c28lin2:lda    tekdxlo        ; is the x delta negative
  14569.     bpl    c28lin3
  14570.     eor    #$ff        ; get the positive equivalent
  14571. c28lin3:cmp    #$0f        ; is it big enough
  14572.     bcs    c28lin1
  14573.     lda    tekdylo        ; is the y delta negative
  14574.     ldy    tekdyhi
  14575.     bpl    c28lin4
  14576.     eor    #$ff        ; get the positive equivalent
  14577. c28lin4:cmp    #$7f        ; is it big enough
  14578.     bcs    c28lin1
  14579.     asl    tekdxul        ; multiply the x delta by two
  14580.     rol    tekdxlo
  14581.     asl    tekdylo        ; multiply the y delta by two    (no dyul)
  14582.     dex
  14583.     bne    c28lin2        ; try to optimize some more
  14584. c28lin1:jsr    c28pnt        ; now we can finally plot a point
  14585.     clc            ; add in the x delta
  14586.     lda    tekfxul
  14587.     adc    tekdxul
  14588.     sta    tekfxul
  14589.     lda    tekfxlo
  14590.     adc    tekdxlo
  14591.     sta    tekfxlo
  14592.     lda    tekfxhi
  14593.     adc    tekdxhi
  14594.     sta    tekfxhi
  14595.     clc            ; add in the y delta    (no dyul or tylo)
  14596.     lda    tekfylo
  14597.     adc    tekdylo
  14598.     sta    tekfylo
  14599.     lda    tekfyhi
  14600.     adc    tekdyhi
  14601.     sta    tekfyhi
  14602.     lda    tekfxlo        ; compare current point with destination
  14603.     cmp    tektxlo
  14604.     bne    c28lin1        ; if not the same, go plot another point
  14605.     lda    tekfxhi        ; compare current point with destination
  14606.     cmp    tektxhi
  14607.     bne    c28lin1        ; if not the same, go plot another point
  14608.     lda    tekfyhi        ; compare current point with destination
  14609.     cmp    tektyhi
  14610.     bne    c28lin1        ; if not the same, go plot another point
  14611.     rts            ; all done
  14612.  
  14613. ;
  14614. ;    c28pnt - plot a point
  14615. ;
  14616. ;    input:    point to plot in tektxlo, tektxhi, tektyhi
  14617. ;
  14618. ;    This routine plots a point on the 8563 bitmap screen
  14619. ;
  14620.  
  14621. c28pnt:    ldx    tekfxhi        ; get x coordinate of character to change
  14622.     cpx    #80        ; check to see if off screen
  14623.     bcs    c28pnt1
  14624.     ldy    tekfyhi        ; get y coordinate of character to change
  14625.     cpy    #200        ; check to see if off screen
  14626.     bcs    c28pnt1
  14627.     jsr    c28adrg        ; get address of character to change
  14628.     lda    tekfxlo        ; get the column of the character to change
  14629.     lsr    a
  14630.     lsr    a
  14631.     lsr    a
  14632.     lsr    a
  14633.     lsr    a
  14634.     tay
  14635.     jsr    c28r18
  14636.     ldx    #31
  14637.     jsr    rd8563
  14638.     ora    powers,y
  14639.     tay
  14640.     jsr    c28r18
  14641.     tya
  14642.     ldx    #31
  14643.     jsr    wr8563
  14644. c28pnt1:rts
  14645.  
  14646. ;
  14647. ;    c28era - erase the graphics screen
  14648. ;
  14649. ;    This routine erases the graphics screen by filling all 16k of 8563
  14650. ;    ram with zeros
  14651. ;
  14652.  
  14653. c28era:    lda    #$00        ; fill 8563 memory starting at $0000
  14654.     ldx    #18        ; write $0000 into registers 18 and 19
  14655.     jsr    wr8563
  14656.     inx
  14657.     jsr    wr8563
  14658.     lda    #$00        ; fill memory with zeros
  14659.     ldx    #31
  14660.     jsr    wr8563
  14661.     lda    in8563+24    ; clear bit 7 in r24 for block write
  14662.     and    #%01111111
  14663.     ldx    #24
  14664.     jsr    wr8563
  14665.     lda    #$ff        ; write the rest of the page (255 bytes left)
  14666.     ldx    #30
  14667.     jsr    wr8563
  14668.     ldy    #$3f        ; $3f pages more to zero.
  14669.     lda    #$00        ; now work with full pages.
  14670. c28era1:jsr    wr8563
  14671.     dey
  14672.     bne    c28era1
  14673.     rts
  14674.  
  14675. ;
  14676. ;    c28int - put coordinates into internal form
  14677. ;
  14678. ;    Input:    tekcxlo, tekcxhi, tekcylo, tekcyhi
  14679. ;    Output:    tektxlo, tektxhi, tektyhi
  14680. ;
  14681. ;    This routine puts coordinates into internal form by calling the
  14682. ;    (very similiar) 40-column mode routine and then doubling the x
  14683. ;    resolution.  A change to the y-coordinate is made too.  The
  14684. ;    y-coordinate is no longer split into two bytes.
  14685. ;
  14686.  
  14687. c28int:    jsr    c40int        ; call similiar 40-column routine
  14688.     asl    tektxlo        ; double x resolution.
  14689.     rol    tektxhi
  14690.     asl    tektylo        ; store the y resolution in a single byte
  14691.     rol    tektyhi
  14692.     asl    tektylo
  14693.     rol    tektyhi
  14694.     asl    tektylo        ; (tektylo now zero)
  14695.     rol    tektyhi
  14696.     rts
  14697.  
  14698. ;
  14699. ;    c28tst - test to see if the Commodore 128 screen driver is present
  14700. ; 
  14701. ;     Input:    None
  14702. ;
  14703. ;     Output: carry set if Commodore 8563 80-column display not present
  14704. ; 
  14705. ;     Registers destroyed - A
  14706. ; 
  14707. ;     This routine returns with the carry clear if Commodore-128 80-column
  14708. ;     screen is available.  If it isnt, it returns with the carry set
  14709. ; 
  14710.  
  14711. c28tst:    lda    #$00
  14712.     cmp    $d600        ; Commodore-128 available if $d600 <> $00
  14713.     rts
  14714.  
  14715. ;
  14716. ;    c28adrg - compute the address of a character in graphics mode
  14717. ;
  14718. ;    Input:    x and y coordinates in x-reg and y-reg.  Offset in a-reg
  14719. ;    Output:    address in dest
  14720. ;
  14721.  
  14722. c28adrg:sty    dest        ; put y value in dest (expand to 2 bytes)
  14723.     lda    #$00
  14724.     sta    dest+1        
  14725.     asl    dest        ; multiply by 4
  14726.     rol    dest+1
  14727.     asl    dest
  14728.     rol    dest+1
  14729.     clc            ; add in one. 4 + 1 = 5
  14730.     tya
  14731.     adc    dest
  14732.     sta    dest
  14733.     lda    dest+1
  14734.     adc    #$00
  14735.     sta    dest+1
  14736.     asl    dest        ; multiply by 16 more for a total of times 80
  14737.     rol    dest+1
  14738.     asl    dest
  14739.     rol    dest+1
  14740.     asl    dest
  14741.     rol    dest+1
  14742.     asl    dest
  14743.     rol    dest+1
  14744.     clc            ; now add in x
  14745.     txa
  14746.     adc    dest
  14747.     sta    dest
  14748.     lda    dest+1
  14749.     adc    #$00
  14750.     sta    dest+1
  14751.     rts
  14752.  
  14753. ;
  14754. ;    c28adrt - compute the text address of x,y
  14755. ;
  14756. ;    Input:    x and y coordinates in X-reg and Y-reg
  14757. ;
  14758. ;    Output:    text address in (dest)
  14759. ;
  14760. ;    This routine calculates the text address at point x,y
  14761. ;
  14762.  
  14763. c28adrt:jmp    c28adr        ; no offset necessary
  14764.  
  14765. ;
  14766. ;    c28adra - compute the alternate address of x,y
  14767. ;
  14768. ;    Input:    x and y coordinates in X-reg and Y-reg
  14769. ;
  14770. ;    Output:    attribute address in (dest)
  14771. ;
  14772. ;    This routine calculates the address of attribute ram associated
  14773. ;    with x,y
  14774. ;
  14775.  
  14776. c28adra:jsr    c28adr        ; compute the base address
  14777.     clc            ; add in the address of attribute ram
  14778.     lda    dest+1
  14779.     adc    #alt8563^
  14780.     sta    dest+1
  14781.     rts    
  14782.  
  14783. ;
  14784. ;    c28adr - compute the base address associated with x,y
  14785. ;
  14786. ;    Input:    x and y coordinates in X-reg and Y-reg
  14787. ;
  14788. ;    Output:    base address in (dest)
  14789. ;
  14790. ;    This routine calculates the base address associated with x,y
  14791. ;
  14792.  
  14793. c28adr:    cpx    #80        ; in funny column?
  14794.     bcc    c28adr1
  14795.     ldx    #79        ; if so, reduce X to far left
  14796. c28adr1:lda    #$00        ; zero dest+1 while we have a free register
  14797.     sta    dest+1
  14798.     tya            ; put y where it can be shifted
  14799.     asl    a        ; multiplied by 2
  14800.     asl    a        ; multiplied by 4
  14801.     sta    dest
  14802.     tya            ; add in y.  now multiplied by 5
  14803.     clc            ; ( 5*25 < $100.  No msb yet)
  14804.     adc    dest        ; msb in dest+1. lsb in a-reg
  14805.     asl    a        ; multipled by 10
  14806.     rol    dest+1
  14807.     asl    a        ; multiplied by 20
  14808.     rol    dest+1
  14809.     asl    a        ; multiplied by 40
  14810.     rol    dest+1
  14811.     asl    a        ; multiplied by 80
  14812.     rol    dest+1
  14813.     sta    dest
  14814.     txa            ; add in x-reg
  14815.     clc    
  14816.     adc    dest
  14817.     sta    dest
  14818.     bcc    c28adr2
  14819.     inc    dest+1
  14820. c28adr2:rts    
  14821.  
  14822. ;
  14823. ;    c28r18 - write dest and dest+1 to r18 and r19 in the 8563
  14824. ;
  14825. ;    Input:    dest and dest+1
  14826. ;
  14827. ;    Output:    r18 and r19 in the 8563
  14828. ;
  14829. ;    This routine writes the address in dest to the 8563 update location
  14830. ;
  14831.  
  14832. c28r18:    lda    dest+1        ; write the msb to r18
  14833.     ldx    #18
  14834.     jsr    wr8563
  14835.     inx            ; r19 gets the lsb
  14836.     lda    dest
  14837.     jsr    wr8563
  14838.     rts    
  14839.  
  14840. ;
  14841. ;    c28r32 - write dest and dest+1 to r32 and r33 in the 8563
  14842. ;
  14843. ;    Input:    dest and dest+1
  14844. ;
  14845. ;    Output:    r32 and r33 in the 8563
  14846. ;
  14847. ;    This routine writes the address in dest to the 8563 block copy
  14848. ;    source address
  14849. ;
  14850.  
  14851. c28r32:    lda    dest+1        ; write the msb to r32
  14852.     ldx    #32
  14853.     jsr    wr8563
  14854.     inx            ; r33 gets the lsb
  14855.     lda    dest
  14856.     jsr    wr8563
  14857.     rts            ; all done
  14858.  
  14859. ;
  14860. ;    wr8563 - write to a register in the 8563
  14861. ;
  14862. ;    Input:    register to write to in x-reg
  14863. ;        data to write in a-reg
  14864. ;
  14865. ;    Output:    a register in the 8563 is changed
  14866. ;
  14867.  
  14868. wr8563:    stx    $d600        ; tell the 8563 which reg we want to write to
  14869. wr8563a:bit    $d600        ; wait for 8563 to be ready
  14870.     bpl    wr8563a        ; not yet ready
  14871.     sta    $d601        ; is ready. write.
  14872.     rts            ; all done
  14873.  
  14874. ;
  14875. ;    rd8563 - read from a register in the 8563
  14876. ;
  14877. ;    Input:    register to read from in x-reg
  14878. ;    Output:    Data in a-reg
  14879. ;
  14880. ;    This routine reads from a register in the 8563 80-column chip.
  14881. ;
  14882.  
  14883. rd8563:    stx    $d600        ; tell the 8563 which reg we want to read from
  14884. rd8563a:bit    $d600        ; wait for the 8563 to be ready
  14885.     bpl    rd8563a        ; not yet ready
  14886.     lda    $d601        ; is ready.  read.
  14887.     rts            ; all done
  14888.  
  14889. ;
  14890. ;    in8563 - data to write to the 8563 during powerup initilization
  14891. ;
  14892. ;    The zeroth value is written to r0, the first value is written to r1,
  14893. ;    and so on.  A value of $ff is not written.
  14894. ;
  14895.  
  14896. in8563:    .byte    $7e        ; horizontal total
  14897.     .byte    $50        ; horizontal displayed
  14898.     .byte    $66        ; horizontal sync position
  14899.     .byte    $49        ; horizontal/vertical sync width
  14900.     .byte    $20        ; vertical total
  14901.     .byte    $e0        ; vertical total adjust
  14902.     .byte    $19        ; vertical displayed
  14903.     .byte    $1d        ; vertical sync position
  14904.     .byte    $fc        ; interlace mode control
  14905.     .byte    $e7        ; character total, vertical
  14906.     .byte    $e0        ; cursor start scan line/cursor mode
  14907.     .byte    $f0        ; end scan line
  14908.     .byte    $00        ; display start address (hi)
  14909.     .byte    $00        ; display start address (lo)
  14910.     .byte    $20        ; cursor position (hi)
  14911.     .byte    $00        ; cursor position (lo)
  14912.     .byte    $ff        ; light pen vertical
  14913.     .byte    $ff        ; light pen horizontal
  14914.     .byte    chr8563^    ; update location (hi)
  14915.     .byte    chr8563\    ; update location (lo)
  14916.     .byte    $08        ; attribute start address (hi)
  14917.     .byte    $00        ; attribute start address (lo)
  14918.     .byte    $78        ; character displayed, horizontal
  14919.     .byte    $e8        ; character displayed, vertical
  14920.     .byte    $20        ; vertical smooth scroll
  14921.     .byte    $ff        ; smooth horizontal scroll
  14922.     .byte    $f0        ; background/foreground r, g, b, i
  14923.     .byte    $00        ; address increment per row
  14924.     .byte    $2f        ; 8563 ram type
  14925.     .byte    $e7        ; underline scan line count
  14926.     .byte    $ff        ; block copy word count
  14927.     .byte    $ff        ; cpu data
  14928.     .byte    $ff        ; block copy source address (hi)
  14929.     .byte    $ff        ; block copy source address (lo)
  14930.     .byte    $7d        ; display enable begin
  14931.     .byte    $64        ; display enable end
  14932.     .byte    $f5        ; 8563 ram refresh/scan line
  14933.  
  14934. c28map:    .byte    $00        ; black
  14935.     .byte    $0f        ; white
  14936.     .byte    $08        ; red
  14937.     .byte    $07        ; cyan
  14938.     .byte    $0b        ; purple
  14939.     .byte    $04        ; green
  14940.     .byte    $02        ; blue
  14941.     .byte    $0d        ; yellow
  14942.     .byte    $0a        ; "orange"
  14943.     .byte    $0c        ; brown
  14944.     .byte    $09        ; light red
  14945.     .byte    $01        ; medium grey    (not according to basic rom!)
  14946.     .byte    $06        ; dark grey    (not according to basic rom!)
  14947.     .byte    $05        ; light green
  14948.     .byte    $03        ; light blue
  14949.     .byte    $0e        ; light grey
  14950. .SBTTL    80 Column screen driver
  14951.  
  14952. ;
  14953. ;    These routines manipulate the screen in 80 column mode.
  14954. ;
  14955.  
  14956. ;
  14957. ;    c80ini - initilize 80 column screen during powerup
  14958. ;
  14959. ;    Input:    None
  14960. ;    Output: scrtype set to use 80 columns
  14961. ;
  14962. ;    Registers destroyed - None
  14963. ;
  14964. ;    This routine does all of the powerup initilization necessary for
  14965. ;    80 columns that was not done in c40ini, and sets the screen type
  14966. ;    to 80 columns.
  14967. ;
  14968.  
  14969. c80ini:    rts
  14970.  
  14971. ;
  14972. ;    c80ent - enter the 80 column screen driver
  14973. ;
  14974. ;    Input:    None
  14975. ;    Output: None
  14976. ;
  14977. ;    Registers destroyed - A,X,Y
  14978. ;
  14979. ;    This routine starts the 80 column screen driver.
  14980. ;
  14981.  
  14982. c80ent:    jmp    c40ent        ; hardware is initilized the same as 40 cols
  14983.  
  14984. ;
  14985. ;    c80ext - exit the 80 column screen driver
  14986. ;
  14987. ;    Input:    None
  14988. ;    Output: None
  14989. ;
  14990. ;    Registers destroyed - A,X,Y
  14991. ;
  14992. ;    This routine starts the 80 column screen driver.
  14993. ;
  14994.  
  14995. c80ext:    jmp    c40ext        ; hardware is de-initilized the same as 40 cols
  14996.  
  14997. ;
  14998. ;    c80set - reset the hardware after a "set screen xxxx" command
  14999. ;
  15000. ;    Input:    border color in bordclr
  15001. ;    Output: None
  15002. ;
  15003. ;    Registers destroyed - A
  15004. ;
  15005. ;    This routine adjusts the hardware after a set command.
  15006. ;
  15007.  
  15008. c80set:    jmp    c40set        ; hardware is the same as 40 cols
  15009.  
  15010. ;
  15011. ;    c80put - put a character at cx, cy
  15012. ;
  15013. ;    Input:    character to put in a-reg (use funny ascii)
  15014. ;    Output: None
  15015. ;
  15016. ;    Registers destroyed - A,X,Y
  15017. ;
  15018. ;    This routine puts a character at screen position cx,cy.  This routine
  15019. ;    does not advance the cursor position.
  15020. ;
  15021.  
  15022. c80put:    pha            ; save character put
  15023.     sta    source        ; compute character*8+font80
  15024.     lda    #$00
  15025.     sta    source+1
  15026.     asl    source        ; multiplied by 2
  15027.     rol    source+1
  15028.     asl    source        ; multiplied by 4
  15029.     rol    source+1
  15030.     asl    source        ; multiplied by 8
  15031.     rol    source+1
  15032.     lda    source        ; now add in font80
  15033.     adc    #font80\    ; carry is clear
  15034.     sta    source
  15035.     lda    source+1
  15036.     adc    #font80^
  15037.     sta    source+1
  15038.     ldy    cy        ; compute the address to store at
  15039.     ldx    cx
  15040.     jsr    c80adrt        
  15041.     ldy    #$07        ; copy in 8 bytes
  15042. c80put1:lda    (dest),y    ; select hi or low half      abcdefgh
  15043.     eor    (source),y    ;                 ABCDEFGH
  15044.     and    evenodd        ;                 xxxx0000
  15045.     eor    (dest),y    ;                 ABCDefgh
  15046.     ldx    reverse        ; $01 is reverse on, $00 is reverse off
  15047.     beq    c80put7
  15048.     eor    evenodd        ; reverse the character
  15049. c80put7:sta    (dest),y
  15050.     dey
  15051.     bpl    c80put1        ; put in the entire character (8 bytes)
  15052.     lda    underln        ; $01 is underline on, $00 is underline off
  15053.     beq    c80put2        ; do not underline
  15054.     lda    reverse        ; underline and reverse
  15055.     bne    c80put6
  15056.     ldy    #$07        ; underline the last row
  15057.     lda    evenodd
  15058.     ora    (dest),y
  15059.     sta    (dest),y    ; underlined, but not reversed
  15060.     jmp    c80put2
  15061. c80put6:ldy    #$07
  15062.     lda    evenodd
  15063.     eor    #$ff
  15064.     and    (dest),y
  15065.     sta    (dest),y
  15066. c80put2:pla            ; check to see if color must be updated
  15067.     bne    c80put3        ; if character is not a space, update
  15068.     lda    reverse        ; if reverse on, update
  15069.     bne    c80put3
  15070.     lda    underln        ; if underline on, update
  15071.     beq    c80put4
  15072. c80put3:ldy    cy        ; calculate primary color address
  15073.     ldx    cx
  15074.     jsr    c80adrp
  15075.     ldx    alternt        ; 1=alternate color, 0=normal color
  15076.     lda    foreclr,x    ; get proper foreground color
  15077.     asl    a        ; put in high nybble
  15078.     asl    a
  15079.     asl    a
  15080.     asl    a
  15081.     ldx    decrev        ; is the background bright or dark
  15082.     ora    backclr,x    ; or in background color
  15083.     ldy    #$00
  15084.     sta    (dest),y    ; adjust primary color ram
  15085.     pha            ; save for future use
  15086.     ldy    cy        ; compute alternate color address
  15087.     ldx    cx
  15088.     jsr    c80adra
  15089.     pla            ; restore colors used for primary color
  15090.     ldx    flash        ; can we use it?
  15091.     beq    c80put5        ; yes.
  15092.     ldx    decrev        ; is the background bright or dark
  15093.     lda    backclr,x    ; or in background color
  15094.     asl    a        ; use background color for forground
  15095.     asl    a
  15096.     asl    a
  15097.     asl    a
  15098.     ora    backclr,x    ; or in background color
  15099. c80put5:ldy    #$00
  15100.     sta    (dest),y    ; adjust alternate color ram
  15101. c80put4:rts            ; all done.
  15102.  
  15103. ;
  15104. ;    c80irm - make space for a character if insert replace mode is insert
  15105. ;
  15106. ;    Unfortunatly, there is no way to make room for the color information.
  15107. ;
  15108.  
  15109. c80irm:    ldy    #$07
  15110.     lda    #$00
  15111. c80irm1:sta    freemem,y
  15112.     dey
  15113.     bpl    c80irm1
  15114.     ldx    cx
  15115.     ldy    cy
  15116.     jsr    c80adrt
  15117.     ldx    cx
  15118.     bit    evenodd
  15119.     bmi    c80irm2
  15120.     ldy    #$07
  15121. c80irm3:lda    (dest),y
  15122.     sta    freemem,y
  15123.     and    #$f0
  15124.     sta    (dest),y
  15125.     dey
  15126.     bpl    c80irm3
  15127. c80irm6:inx
  15128.     inx
  15129. c80irm2:cpx    #80        ; all done?
  15130.     bcs    c80irm5
  15131.     txa            ; save column number currently working on
  15132.     pha
  15133.     ldy    cy
  15134.     jsr    c80adrt
  15135.     ldx    #$07
  15136.     ldy    #$07
  15137. c80irm4:lda    (dest),y
  15138.     lsr    freemem,x
  15139.     ror    a
  15140.     ror    freemem,x
  15141.     ror    a
  15142.     ror    freemem,x
  15143.     ror    a
  15144.     ror    freemem,x
  15145.     ror    a
  15146.     ror    freemem,x
  15147.     sta    (dest),y
  15148.     lsr    freemem,x
  15149.     lsr    freemem,x
  15150.     lsr    freemem,x
  15151.     lsr    freemem,x
  15152.     dey
  15153.     dex
  15154.     bpl    c80irm4
  15155.     pla
  15156.     tax            ; remember column number working on
  15157.     jmp    c80irm6
  15158. c80irm5:rts
  15159.  
  15160. ;
  15161. ;    c80dch - delete one or more characters.
  15162. ;
  15163. ;    Input:    Number of characters to delete in A-reg
  15164. ;        Cursor position in cx, cy
  15165. ;
  15166.  
  15167. c80dch:    tay            ; save number of characters to delete
  15168.     clc            ; compute x coordinate of first char to keep
  15169.     adc    cx        
  15170.     cmp    #80        ; see if fits on screen
  15171.     bcc    c80dch1
  15172.     jmp    c80el0
  15173. c80dch1:tya            ; remember number of characters to delete
  15174.     pha            ; save number of characters to delete
  15175.     ldx    cx        ; get address of first char to write over
  15176.     ldy    cy
  15177.     jsr    c80adrt
  15178.     bit    evenodd        ; must do funny things if in odd column
  15179.     bmi    c80dch2
  15180.     lda    dest        ; copy dest to source
  15181.     sta    source
  15182.     lda    dest+1
  15183.     sta    source+1
  15184.     pla            ; set up x-register.
  15185.     pha
  15186.     clc
  15187.     adc    cx
  15188.     tax
  15189.     ldy    cy        ; x already set up....
  15190.     jsr    c80adrt        ; get address of first char to keep
  15191.     ldy    #$07        ; copy in this character
  15192. c80dch3:lda    (dest),y
  15193.     bit    evenodd
  15194.     bpl    c80dch4    
  15195.     lsr    a
  15196.     lsr    a
  15197.     lsr    a
  15198.     lsr    a
  15199. c80dch4:eor    (source),y
  15200.     and    #$0f
  15201.     eor    (source),y
  15202.     sta    (source),y
  15203.     dey
  15204.     bpl    c80dch3
  15205. c80dch2:pla            ; remember number of chars to delete
  15206.     tax            ; save number of chars to delete
  15207.     lda    cx        ; set up cx so we can use c40dch (neat!)
  15208.     pha            ; save cx
  15209.     lsr    a        ; divide by two
  15210.     adc    #$00        ; round up
  15211.     sta    cx        ; freak out c40dch
  15212.     txa            ; remember number of characters to delete    
  15213.     pha            ; on stack too
  15214.     lsr    a        ; divide by two. (round down)
  15215.     jsr    c40dch        ; freaked out
  15216.     pla            ; remember number of characters to delete
  15217.     lsr    a        ; check if even or odd
  15218.     bcc    c80dch5        ; must delete another char if odd
  15219.     lda    #$00        ; shift in a blank
  15220.     ldy    #$07
  15221. c80dch6:sta    freemem,y
  15222.     dey
  15223.     bpl    c80dch6
  15224.     ldx    #40        ; still useing 40-column stuff
  15225. c80dch8:txa            ; save current column number on stack
  15226.     pha
  15227.     ldy    cy
  15228.     jsr    c40adrt        ; stil using 40-column stuff
  15229.     ldy    #$07        ; shift one character
  15230.     ldx    #$07
  15231. c80dch7:lda    (dest),y
  15232.     asl    freemem,x
  15233.     rol    a
  15234.     rol    freemem,x
  15235.     rol    a
  15236.     rol    freemem,x
  15237.     rol    a
  15238.     rol    freemem,x
  15239.     rol    a
  15240.     rol    freemem,x
  15241.     asl    freemem,x
  15242.     asl    freemem,x
  15243.     asl    freemem,x
  15244.     asl    freemem,x
  15245.     sta    (dest),y
  15246.     dex
  15247.     dey
  15248.     bpl    c80dch7
  15249.     pla
  15250.     tax
  15251.     dex
  15252.     cpx    cx
  15253.     bpl    c80dch8
  15254. c80dch5:pla            ; restore cx.  was freaked out to use c40dch
  15255.     sta    cx
  15256.     rts
  15257.  
  15258. ;    c80ind - perform the VT100 index function (scroll the screen)
  15259. ;
  15260. ;    Input:    None
  15261. ;    Output: None
  15262. ;
  15263. ;    Registers destroyed - A,X,Y
  15264. ;
  15265. ;    This routine scrolls the screen in 80 column mode.  Only the area
  15266. ;    in the scrolling region is changed.
  15267. ;
  15268. ;    This routine is also used for delete line.
  15269. ;
  15270.  
  15271. c80ind:    jmp    c40ind        ; the 40 column routine works in 80 cols too!
  15272.  
  15273. ;
  15274. ;    c80ri - perform the VT100 reverse index function (scroll backwards)
  15275. ;
  15276. ;    Input:    None
  15277. ;    Output: None
  15278. ;
  15279. ;    Registers destroyed - A,X,Y
  15280. ;
  15281. ;    This routine scrolls the screen in 80 column mode.  Only the area
  15282. ;    in the scrolling region is changed.
  15283. ;
  15284. ;    This routine is also used for insert line.
  15285. ;
  15286.  
  15287. c80ri:    jmp    c40ri        ; the 40 column routine works in 80 cols too!
  15288.  
  15289. ;
  15290. ;    c80el0 - Perform the VT100 Erase Line function #0 on 80 column screen
  15291. ;
  15292. ;    Input:    Number of line to erase in cy
  15293. ;    Output: None
  15294. ;
  15295. ;    Registers destroyed - A,X,Y
  15296. ;
  15297. ;    This routine erases from the cursor to the end of the line
  15298. ;
  15299.  
  15300. c80el0:    ldy    cy
  15301.     ldx    cx
  15302.     jsr    c80adrt
  15303.     txa            ; evaluate 40-x
  15304.     eor    #$ff
  15305.     sec
  15306.     adc    #40
  15307.     tax            ; put 40-x back in x
  15308.     bit    evenodd
  15309.     bmi    c80el0b        ; need to erase under cursor specially
  15310.     ldy    #$07        ; yes
  15311. c80el0a:lda    (dest),y
  15312.     and    #$f0
  15313.     sta    (dest),y    ; erase under the cursor
  15314.     dey
  15315.     bpl    c80el0a
  15316.     clc
  15317.     lda    dest        ; add 8 into the address clear8 starts from
  15318.     adc    #$08
  15319.     sta    dest
  15320.     bcc    c80el0c
  15321.     inc    dest+1
  15322. c80el0c:dex
  15323.     beq    c80el0d
  15324. c80el0b:jsr    clear8        ; erase characters
  15325. c80el0d:rts            ; all done
  15326.  
  15327. ;
  15328. ;    c80el1 - Perform the VT100 Erase Line function #1 on 80 column screen
  15329. ;
  15330. ;    Input:    Number of line to erase in cy
  15331. ;    Output: None
  15332. ;
  15333. ;    Registers destroyed - A,X,Y
  15334. ;
  15335. ;    This routine erases from the beginning of line to cursor
  15336. ;
  15337.  
  15338. c80el1:    ldy    cy
  15339.     ldx    cx
  15340.     jsr    c80adrt        ; compute the cursors address
  15341.     bit    evenodd        ; must clear under cursor specially?
  15342.     bpl    c80el1b
  15343.     ldy    #$07        ; yes
  15344. c80el1a:lda    (dest),y
  15345.     and    #$0f
  15346.     sta    (dest),y    ; erase under the cursor
  15347.     dey
  15348.     bpl    c80el1a
  15349. c80el1b:ldy    cy
  15350.     ldx    #$00
  15351.     jsr    c80adrt        ; compute the address to start clearing
  15352.     ldx    cx        ; compute the number of bytes to clear
  15353.     inx            ; round up if in odd column
  15354.     txa
  15355.     lsr    a
  15356.     tax            ; x = number_of_bytes / 8
  15357.     beq    c80el1c        ; carefull! there might be 0 bytes to clear!
  15358.     jsr    clear8        ; erase characters
  15359. c80el1c:rts            ; all done
  15360.  
  15361. ;
  15362. ;    c80el2 - Perform the VT100 Erase Line function #2 on 80 column screen
  15363. ;
  15364. ;    Input:    Number of line to erase in cy
  15365. ;    Output: None
  15366. ;
  15367. ;    Registers destroyed - A,X,Y
  15368. ;
  15369. ;    This routine erases one line compleatly from the 80 column display.
  15370. ;
  15371.  
  15372. c80el2:    jmp    c40el2        ; the 40 column routine works in 80 cols too!
  15373.  
  15374. ;
  15375. ;    c80fls - flash the screen and cursor in 80 column mode
  15376. ;
  15377. ;    Input:    None
  15378. ;    Output: None
  15379. ;
  15380. ;    Registers destroyed - A
  15381. ;
  15382. ;    This routine flashes the screen in 80 column mode
  15383. ;
  15384.  
  15385. c80fls:    jmp    c40fls        ; flashing is done the same way in 40 cols
  15386.  
  15387. ;
  15388. ;    c80tgl - toggle the cursor in 80 column mode
  15389. ;
  15390. ;    Input:    None
  15391. ;    Output: None
  15392. ;
  15393. ;    Registers destroyed - A,X,Y
  15394. ;
  15395. ;    This routine toggles the cursor in 80 column mode.
  15396. ;
  15397.  
  15398. c80tgl:    ldy    cy        ; compute cursor address
  15399.     ldx    cx
  15400.     jsr    c80adrt
  15401.     ldy    #$07        ; blink the cursor
  15402. c80tgl2:lda    (dest),y
  15403.     eor    evenodd
  15404.     sta    (dest),y
  15405.     dey
  15406.     bpl    c80tgl2
  15407. c80tgl1:rts
  15408.     
  15409. ;
  15410. ;    c80drw - draw a character at cx, cy
  15411. ;
  15412. ;    Input:    character to put in a-reg (use funny ascii)
  15413. ;    Output: A - size of character
  15414. ;
  15415. ;    Registers destroyed - A,X,Y
  15416. ;
  15417. ;    This routine puts a character at screen position tektx, tekty and
  15418. ;    returns the size of the character.
  15419. ;
  15420.  
  15421. c80drw:    sta    source
  15422.     lda    #$00
  15423.     sta    source+1
  15424.     asl    source        ; multiplied by 2
  15425.     rol    source+1
  15426.     asl    source        ; multiplied by 4
  15427.     rol    source+1
  15428.     asl    source        ; multiplied by 8
  15429.     rol    source+1
  15430.     lda    source        ; now add in font80
  15431.     adc    #font80\    ; carry is clear
  15432.     sta    source
  15433.     lda    source+1
  15434.     adc    #font80^
  15435.     sta    source+1
  15436.     ldy    #$07        ; copy the character for c40sub
  15437. c80drw1:lda    (source),y
  15438.     and    #$f0
  15439.     sta    freemem,y
  15440.     dey
  15441.     bpl    c80drw1
  15442.     jsr    c40sub        ; offset the character
  15443.     ldx    tektxhi
  15444.     cpx    #40        ; skip if past right of screen
  15445.     bcs    c80drw3
  15446.     ldy    tektyhi        ; compute the address to store at
  15447.     dey
  15448.     cpy    #25        ; skip if past bottom of screen
  15449.     bcs    c80drw3
  15450.     jsr    c40adrt        
  15451.     ldy    #$07        ; copy in the upper left
  15452. c80drw2:lda    freemem,y
  15453.     ora    (dest),y
  15454.     sta    (dest),y
  15455.     dey
  15456.     bpl    c80drw2
  15457. c80drw3:ldx    tektxhi
  15458.     inx            ; put this part of the character 1 space right
  15459.     cpx    #40        ; skip if past right edge
  15460.     bcs    c80drw5
  15461.     ldy    tektyhi
  15462.     dey
  15463.     cpy    #25        ; skip if past bottom of screen
  15464.     bcs    c80drw5
  15465.     jsr    c40adrt
  15466.     ldy    #$07        ; copy in the upper right
  15467. c80drw4:lda    freemem+16,y
  15468.     ora    (dest),y
  15469.     sta    (dest),y
  15470.     dey
  15471.     bpl    c80drw4
  15472. c80drw5:ldx    tektxhi
  15473.     cpx    #40        ; skip if past right edge
  15474.     bcs    c80drw7
  15475.     ldy    tektyhi
  15476.     cpy    #25        ; skip if past bottom
  15477.     bcs    c80drw7
  15478.     jsr    c40adrt
  15479.     ldy    #$07        ; copy in the lower left
  15480. c80drw6:lda    freemem+8,y
  15481.     ora    (dest),y
  15482.     sta    (dest),y
  15483.     dey
  15484.     bpl    c80drw6
  15485. c80drw7:ldx    tektxhi
  15486.     inx            ; put this part of the character 1 space left
  15487.     cpx    #40        ; skip if past right edge
  15488.     bcs    c80drw9
  15489.     ldy    tektyhi
  15490.     cpy    #25        ; skip if past bottom
  15491.     bcs    c80drw9
  15492.     jsr    c40adrt
  15493.     ldy    #$07        ; copy in the lower right
  15494. c80drw8:lda    freemem+24,y
  15495.     ora    (dest),y
  15496.     sta    (dest),y
  15497.     dey
  15498.     bpl    c80drw8
  15499. c80drw9:lda    #13        ; move cursor 13 pixels right
  15500.     rts
  15501.  
  15502. ;
  15503. ;    graphics routines
  15504. ;
  15505.  
  15506. c80tek:    jmp    c40tek
  15507. c80txt:    jmp    c40txt
  15508. c80lin:    jmp    c40lin
  15509. c80pnt:    jmp    c40pnt
  15510. c80era:    jmp    c40era
  15511. c80int:    jmp    c40int
  15512.  
  15513. ;
  15514. ;    c80tst - test to see if the 80 column screen driver is present
  15515. ;
  15516. ;    Input:    None
  15517. ;    Output: carry always clear because 80 columns is always available
  15518. ;
  15519. ;    Registers destroyed - None
  15520. ;
  15521. ;    This routine returns with the carry clear to indicate that the 80
  15522. ;    column screen is always available.
  15523. ;
  15524.  
  15525. c80tst:    clc
  15526.     rts
  15527.  
  15528. ;
  15529. ;    c80adrt - calculate address of a text character for 80 column mode
  15530. ;
  15531. ;    Input:    x coordinate in x-reg
  15532. ;        y coordinate in y-reg
  15533. ;    Output: dest
  15534. ;
  15535. ;    Registers destroyed - A,X,Y
  15536. ;
  15537. ;    This routine calculates the address of a character at x,y in 80
  15538. ;    column mode.  It uses c80adr to set things up and c40adrt to do the
  15539. ;    dirty work
  15540. ;
  15541.  
  15542. c80adrt:jsr    c80adr        ; freak out c40adr
  15543.     jmp    c40adrt        ; do the dirty work
  15544.  
  15545.  
  15546. ;
  15547. ;    c80adrp - calculate primary color address of a character at x,y
  15548. ;
  15549. ;    Input:    x coordinate in x-reg
  15550. ;        y coordinate in y-reg
  15551. ;    Output: dest
  15552. ;
  15553. ;    Registers destroyed - A,X,Y
  15554. ;
  15555. ;    This routine calculates the address of primary color memory for a
  15556. ;    character at x,y in 80 column mode.  It uses c80adr to set things up
  15557. ;    and c40adrp to do the dirty work.
  15558. ;
  15559.  
  15560. c80adrp:jsr    c80adr        ; freak out c40adr
  15561.     jmp    c40adrp        ; do the dirty work
  15562.  
  15563.  
  15564. ;
  15565. ;    c80adra - calculate alternate color address of a character at x,y
  15566. ;
  15567. ;    Input:    x coordinate in x-reg
  15568. ;        y coordinate in y-reg
  15569. ;    Output: dest
  15570. ;
  15571. ;    Registers destroyed - A,X,Y
  15572. ;
  15573. ;    This routine calculates the address of alternate color memory for a
  15574. ;    character at x,y in 80 column mode.  It uses c80adr to set things up
  15575. ;    and c40adra to do the dirty work.
  15576. ;
  15577.  
  15578. c80adra:jsr    c80adr        ; freak out c40adr
  15579.     jmp    c40adra        ; do the dirty work
  15580.  
  15581. ;
  15582. ;    c80adr - calculate int(y/2) and y%2
  15583. ;
  15584. ;    Input:    number in y-reg
  15585. ;    Output: evenodd = $0f if y is odd, $f0 if y is even
  15586. ;        y-reg = y-reg/2
  15587. ;
  15588. ;    Registers destroyed - A,Y
  15589. ;
  15590. ;    This routine calculated int(x/2) and x % 2.  It is used to freak
  15591. ;    c40adr into calculating addresses for 80 column mode.  Real
  15592. ;    funny things happen if the x-reg is the funny column (81).
  15593. ;
  15594.  
  15595. c80adr:    cpx    #80        ; is the cursor in the funny column?
  15596.     bcc    c80adr2        ; no
  15597.     ldx    #81        ; 81 % 2 = 1
  15598. c80adr2:txa            ; divide x by two
  15599.     lsr    a
  15600.     tax            ; put result back in x-reg
  15601.     lda    #$0f        ; put $0f in evenodd if odd
  15602.     bcs    c80adr1        ; is odd
  15603.     lda    #$f0        ; put $f0 in evenodd if even
  15604. c80adr1:sta    evenodd
  15605.     rts
  15606.  
  15607. ;
  15608. ;    Font80 - Character definitions
  15609. ;
  15610. ;    this defines the shape of the characters in 80 column mode
  15611. ;    this table is in ascii sequence
  15612. ;
  15613.  
  15614. font80:    .byte $00,$00,$00,$00,$00,$00,$00,$00    ; " "
  15615.     .byte $44,$44,$44,$44,$44,$00,$44,$00    ; "!"
  15616.     .byte $aa,$aa,$00,$00,$00,$00,$00,$00    ; """
  15617.     .byte $aa,$ee,$aa,$ee,$aa,$00,$00,$00    ; "#"
  15618.     .byte $44,$66,$88,$44,$22,$ee,$44,$00    ; "$"
  15619.     .byte $00,$99,$aa,$22,$55,$99,$00,$00    ; "%"
  15620.     .byte $44,$aa,$aa,$44,$aa,$aa,$55,$00    ; "&"
  15621.     .byte $22,$44,$00,$00,$00,$00,$00,$00    ; "'"
  15622.     .byte $22,$44,$44,$44,$44,$44,$22,$00    ; "("
  15623.     .byte $44,$22,$22,$22,$22,$22,$44,$00    ; ")"
  15624.     .byte $00,$99,$66,$ff,$66,$99,$00,$00    ; "*"
  15625.     .byte $00,$00,$44,$ee,$44,$00,$00,$00    ; "+"
  15626.     .byte $00,$00,$00,$00,$00,$44,$44,$88    ; ","
  15627.     .byte $00,$00,$00,$ee,$00,$00,$00,$00    ; "-"
  15628.     .byte $00,$00,$00,$00,$00,$00,$44,$00    ; "."
  15629.     .byte $00,$22,$22,$44,$44,$88,$88,$00    ; "/"
  15630.     .byte $44,$aa,$aa,$ee,$aa,$aa,$44,$00    ; "0"
  15631.     .byte $44,$cc,$44,$44,$44,$44,$ee,$00    ; "1"
  15632.     .byte $44,$aa,$22,$44,$88,$88,$ee,$00    ; "2"
  15633.     .byte $ee,$22,$44,$22,$22,$22,$cc,$00    ; "3"
  15634.     .byte $aa,$aa,$aa,$ee,$22,$22,$22,$00    ; "4"
  15635.     .byte $ee,$88,$cc,$22,$22,$22,$cc,$00    ; "5"
  15636.     .byte $44,$88,$88,$cc,$aa,$aa,$44,$00    ; "6"
  15637.     .byte $ee,$22,$22,$44,$44,$88,$88,$00    ; "7"
  15638.     .byte $44,$aa,$aa,$44,$aa,$aa,$44,$00    ; "8"
  15639.     .byte $44,$aa,$aa,$66,$22,$44,$88,$00    ; "9"
  15640.     .byte $00,$00,$44,$00,$00,$44,$00,$00    ; ":"
  15641.     .byte $00,$00,$44,$00,$44,$44,$88,$00    ; ";"
  15642.     .byte $00,$22,$44,$88,$44,$22,$00,$00    ; "<"
  15643.     .byte $00,$00,$ee,$00,$ee,$00,$00,$00    ; "="
  15644.     .byte $00,$88,$44,$22,$44,$88,$00,$00    ; ">"
  15645.     .byte $44,$aa,$22,$44,$44,$00,$44,$00    ; "?"
  15646.     .byte $44,$ee,$aa,$aa,$88,$66,$00,$00    ; "@"
  15647.     .byte $44,$aa,$aa,$ee,$aa,$aa,$aa,$00    ; "A"
  15648.     .byte $cc,$aa,$aa,$cc,$aa,$aa,$cc,$00    ; "B"
  15649.     .byte $66,$88,$88,$88,$88,$88,$66,$00    ; "C"
  15650.     .byte $cc,$aa,$aa,$aa,$aa,$aa,$cc,$00    ; "D"
  15651.     .byte $ee,$88,$88,$cc,$88,$88,$ee,$00    ; "E"
  15652.     .byte $ee,$88,$88,$cc,$88,$88,$88,$00    ; "F"
  15653.     .byte $44,$aa,$88,$88,$aa,$aa,$44,$00    ; "G"
  15654.     .byte $aa,$aa,$aa,$ee,$aa,$aa,$aa,$00    ; "H"
  15655.     .byte $ee,$44,$44,$44,$44,$44,$ee,$00    ; "I"
  15656.     .byte $66,$22,$22,$22,$22,$aa,$44,$00    ; "J"
  15657.     .byte $aa,$aa,$aa,$cc,$aa,$aa,$aa,$00    ; "K"
  15658.     .byte $88,$88,$88,$88,$88,$88,$ee,$00    ; "L"
  15659.     .byte $aa,$ee,$aa,$aa,$aa,$aa,$aa,$00    ; "M"
  15660.     .byte $cc,$aa,$aa,$aa,$aa,$aa,$aa,$00    ; "N"
  15661.     .byte $44,$aa,$aa,$aa,$aa,$aa,$44,$00    ; "O"
  15662.     .byte $cc,$aa,$aa,$cc,$88,$88,$88,$00    ; "P"
  15663.     .byte $44,$aa,$aa,$aa,$aa,$aa,$44,$22    ; "Q"
  15664.     .byte $cc,$aa,$aa,$cc,$aa,$aa,$aa,$00    ; "R"
  15665.     .byte $66,$88,$88,$44,$22,$22,$cc,$00    ; "S"
  15666.     .byte $ee,$44,$44,$44,$44,$44,$44,$00    ; "T"
  15667.     .byte $aa,$aa,$aa,$aa,$aa,$aa,$ee,$00    ; "U"
  15668.     .byte $aa,$aa,$aa,$aa,$aa,$aa,$44,$00    ; "V"
  15669.     .byte $aa,$aa,$aa,$aa,$aa,$ee,$aa,$00    ; "W"
  15670.     .byte $aa,$aa,$aa,$44,$aa,$aa,$aa,$00    ; "X"
  15671.     .byte $aa,$aa,$aa,$44,$44,$44,$44,$00    ; "Y"
  15672.     .byte $ee,$22,$22,$44,$88,$88,$ee,$00    ; "Z"
  15673.     .byte $ee,$88,$88,$88,$88,$88,$ee,$00    ; "["
  15674.     .byte $00,$88,$88,$44,$44,$22,$22,$00    ; "\"
  15675.     .byte $ee,$22,$22,$22,$22,$22,$ee,$00    ; "]"
  15676.     .byte $44,$aa,$00,$00,$00,$00,$00,$00    ; "^"
  15677.     .byte $00,$00,$00,$00,$00,$00,$00,$ff    ; "_"
  15678.     .byte $44,$22,$00,$00,$00,$00,$00,$00    ; "`"
  15679.     .byte $00,$00,$cc,$22,$66,$aa,$ee,$00    ; "a"
  15680.     .byte $88,$88,$cc,$aa,$aa,$aa,$cc,$00    ; "b"
  15681.     .byte $00,$00,$66,$88,$88,$88,$66,$00    ; "c"
  15682.     .byte $22,$22,$66,$aa,$aa,$aa,$66,$00    ; "d"
  15683.     .byte $00,$00,$44,$aa,$ee,$88,$66,$00    ; "e"
  15684.     .byte $00,$66,$88,$cc,$88,$88,$88,$00    ; "f"
  15685.     .byte $00,$00,$44,$aa,$aa,$66,$22,$cc    ; "g"
  15686.     .byte $88,$88,$cc,$aa,$aa,$aa,$aa,$00    ; "h"
  15687.     .byte $44,$00,$44,$44,$44,$44,$44,$00    ; "i"
  15688.     .byte $22,$00,$22,$22,$22,$22,$aa,$44    ; "j"
  15689.     .byte $88,$88,$aa,$aa,$cc,$aa,$aa,$00    ; "k"
  15690.     .byte $cc,$44,$44,$44,$44,$44,$ee,$00    ; "l"
  15691.     .byte $00,$00,$aa,$ee,$aa,$aa,$aa,$00    ; "m"
  15692.     .byte $00,$00,$cc,$aa,$aa,$aa,$aa,$00    ; "n"
  15693.     .byte $00,$00,$44,$aa,$aa,$aa,$44,$00    ; "o"
  15694.     .byte $00,$00,$cc,$aa,$aa,$cc,$88,$88    ; "p"
  15695.     .byte $00,$00,$44,$aa,$aa,$66,$22,$33    ; "q"
  15696.     .byte $00,$00,$66,$88,$88,$88,$88,$00    ; "r"
  15697.     .byte $00,$00,$66,$88,$44,$22,$cc,$00    ; "s"
  15698.     .byte $00,$44,$ee,$44,$44,$44,$22,$00    ; "t"
  15699.     .byte $00,$00,$aa,$aa,$aa,$aa,$ee,$00    ; "u"
  15700.     .byte $00,$00,$aa,$aa,$aa,$aa,$44,$00    ; "v"
  15701.     .byte $00,$00,$aa,$aa,$aa,$ee,$aa,$00    ; "w"
  15702.     .byte $00,$00,$aa,$aa,$44,$aa,$aa,$00    ; "x"
  15703.     .byte $00,$00,$aa,$aa,$aa,$66,$22,$cc    ; "y"
  15704.     .byte $00,$00,$ee,$22,$44,$88,$ee,$00    ; "z"
  15705.     .byte $66,$44,$44,$cc,$44,$44,$66,$00    ; "{"
  15706.     .byte $44,$44,$44,$44,$44,$44,$44,$00    ; "|"
  15707.     .byte $66,$22,$22,$33,$22,$22,$66,$00    ; "}"
  15708.     .byte $55,$aa,$00,$00,$00,$00,$00,$00    ; "~"
  15709.     .byte $00,$00,$44,$ee,$ee,$44,$00,$00    ; (graphics) diamond
  15710.     .byte $aa,$55,$aa,$55,$aa,$55,$aa,$55    ; (graphics) square
  15711.     .byte $aa,$ee,$aa,$00,$ee,$44,$44,$00    ; (graphics) h-t
  15712.     .byte $ee,$ee,$88,$00,$ee,$ee,$88,$00    ; (graphics) f-f
  15713.     .byte $ee,$88,$ee,$ee,$aa,$cc,$aa,$00    ; (graphics) c-r
  15714.     .byte $88,$88,$cc,$00,$ee,$ee,$88,$00    ; (graphics) l-f
  15715.     .byte $44,$aa,$44,$00,$00,$00,$00,$00    ; (graphics) degrees
  15716.     .byte $00,$00,$44,$ee,$44,$ee,$00,$00    ; (graphics) plus/minus
  15717.     .byte $aa,$ee,$aa,$00,$44,$44,$66,$00    ; (graphics) n-l
  15718.     .byte $aa,$aa,$44,$00,$ee,$44,$44,$00    ; (graphics) v-t
  15719.     .byte $44,$44,$44,$cc,$00,$00,$00,$00    ; (graphics) upper-left
  15720.     .byte $00,$00,$00,$cc,$44,$44,$44,$44    ; (graphics) lower-left
  15721.     .byte $00,$00,$00,$77,$44,$44,$44,$44    ; (graphics) lower-right
  15722.     .byte $44,$44,$44,$77,$00,$00,$00,$00    ; (graphics) upper-right
  15723.     .byte $44,$44,$44,$ee,$44,$44,$44,$44    ; (graphics) crossed lines
  15724.     .byte $ff,$00,$00,$00,$00,$00,$00,$00    ; (graphics) scan 1
  15725.     .byte $00,$ff,$00,$00,$00,$00,$00,$00    ; (graphics) scan 3
  15726.     .byte $00,$00,$00,$ff,$00,$00,$00,$00    ; (graphics) scan 5
  15727.     .byte $00,$00,$00,$00,$00,$ff,$00,$00    ; (graphics) scan 7
  15728.     .byte $00,$00,$00,$00,$00,$00,$00,$ff    ; (graphics) scan 9
  15729.     .byte $44,$44,$44,$77,$44,$44,$44,$44    ; (graphics) middle-right
  15730.     .byte $44,$44,$44,$cc,$44,$44,$44,$44    ; (graphics) middle-left
  15731.     .byte $44,$44,$44,$ff,$00,$00,$00,$00    ; (graphics) upper-middle
  15732.     .byte $00,$00,$00,$ff,$44,$44,$44,$44    ; (graphics) lower-middle
  15733.     .byte $44,$44,$44,$44,$44,$44,$44,$44    ; (graphics) vertical line
  15734.     .byte $00,$22,$44,$88,$44,$22,$ee,$00    ; (graphics) <=
  15735.     .byte $00,$88,$44,$22,$44,$88,$ee,$00    ; (graphics) >=
  15736.     .byte $00,$00,$00,$ee,$aa,$aa,$00,$00    ; (graphics) pi
  15737.     .byte $00,$22,$ee,$44,$ee,$88,$00,$00    ; (graphics) !=
  15738.     .byte $00,$00,$66,$44,$66,$44,$ee,$00    ; (graphics) british-pound
  15739.     .byte $00,$00,$00,$44,$00,$00,$00,$00    ; (graphics) dot
  15740.  
  15741. .SBTTL    40 Column screen driver
  15742.  
  15743. ;
  15744. ;    These routines manipulate the screen in 40 column mode.
  15745. ;
  15746.  
  15747. ;
  15748. ;    c40ini - initilize the 40 column screen
  15749. ;
  15750. ;    Input:    None
  15751. ;
  15752. ;    Output:    font40 created
  15753. ;
  15754. ;    Registers destroyed - A,X,Y
  15755. ;
  15756. ;    this routine builds the 40 column character font from stuff in rom
  15757. ;    and ram.  it calls move8 to do the copying.  the memory locations
  15758. ;    of the characters is stored in newchar.   the vic chip is initilized
  15759. ;    and the screen is cleared.  The memory map is changed to put ram where
  15760. ;    basic is now.
  15761. ;
  15762.  
  15763. c40ini:    sei            ; cannot have interrupts without I/O
  15764.     lda    #%00110010    ; swap out the I/O. Get the character rom
  15765.     sta    $01
  15766.     ldy    #$00        ; zero the y-reg
  15767.     ldx    newchar,y    ; number of characters defined in this chunk
  15768. c40ini1:iny
  15769.     lda    newchar,y    ; source of characters (lo order)
  15770.     sta    source
  15771.     iny
  15772.     lda    newchar,y    ; source of characters (hi order)
  15773.     sta    source+1
  15774.     iny
  15775.     lda    newchar,y    ; destination of characters (lo order)
  15776.     sta    dest
  15777.     iny
  15778.     lda    newchar,y    ; destination of characters (hi order)
  15779.     sta    dest+1
  15780.     iny
  15781.     tya            ; save y-reg across call to move8
  15782.     pha
  15783.     jsr    move8
  15784.     pla            ; restore y-reg
  15785.     tay
  15786.     ldx    newchar,y    ; number of characters in this chunk (0=end)
  15787.     bne    c40ini1        ; loop until done
  15788.     lda    #%00110110    ; swap I/O back in.  We gotta have it...
  15789.     sta    $01
  15790.     lda    $d020        ; save the bordor color
  15791.     sta    bordold
  15792.     rts
  15793.  
  15794. ;
  15795. ;    c40ent - enter the 40 column screen driver
  15796. ;
  15797. ;    Input:    None
  15798. ;    Output: None
  15799. ;
  15800. ;    Registers destroyed - A,X,Y
  15801. ;
  15802. ;    This routine starts the 40 column screen driver.
  15803. ;
  15804.  
  15805. c40ent:    lda    $dd02        ; select video bank
  15806.     ora    #$03        ;     ""
  15807.     sta    $dd02        ;     ""
  15808.     lda    $dd00        ;    ""
  15809.     and    #%11111100    ;    ""
  15810.     ora    #$03-<vicbank/$4000> ;    ""
  15811.     sta    $dd00        ;    ""
  15812.     lda    $d011        ; set bit-map mode
  15813.     ora    #$20        ;    ""
  15814.     sta    $d011        ;    ""
  15815.     rts            ; all done
  15816.  
  15817. ;
  15818. ;    c40ext - exit the 40 column screen driver
  15819. ;
  15820. ;    Input:    None
  15821. ;    Output: None
  15822. ;
  15823. ;    Registers destroyed - A,X,Y
  15824. ;
  15825. ;    This routine exits from the 40 column screen driver.
  15826. ;
  15827.  
  15828. c40ext:    lda    $dd02        ; select video bank
  15829.     and    #$fc        ;     ""
  15830.     sta    $dd02        ;     ""
  15831.     lda    $dd00        ;    ""
  15832.     ora    #$03        ;    ""
  15833.     sta    $dd00        ;    ""
  15834.     lda    $d011        ; re-set bit-map mode
  15835.     and    #$df
  15836.     sta    $d011        ;    ""
  15837.     lda    $d018        ; tell vic where to find screen & color ram
  15838.     and    #vicmsk
  15839.     ora    #vicnorm
  15840.     sta    $d018        ;    ""
  15841.     lda    bordold        ; restore the old bordor color
  15842.     sta    $d020
  15843.     rts            ; all done
  15844.  
  15845. ;
  15846. ;    c40set - reset the hardware after a "set screen xxxx" command
  15847. ;
  15848. ;    Input:    border color in bordclr
  15849. ;    Output: None
  15850. ;
  15851. ;    Registers destroyed - A
  15852. ;
  15853. ;    This routine adjusts the hardware after a set command.
  15854. ;
  15855. ;
  15856.  
  15857. c40set:    lda    bordclr
  15858.     sta    $d020
  15859.     lda    #vicclr1\    ; get the address of primary color ram
  15860.     sta    source
  15861.     lda    #vicclr1^
  15862.     sta    source+1
  15863.     lda    #vicclr2\    ; get the address of alternate color ram
  15864.     sta    dest
  15865.     lda    #vicclr2^
  15866.     sta    dest+1
  15867.     ldx    decrev        ; is screen bright or dark
  15868.     lda    #25        ; do 25 lines
  15869. c40set3:pha
  15870.     ldy    #39        ; reverse 40 columns
  15871. c40set2:lda    (source),y    ; get the color in primary color memory
  15872.     cmp    (dest),y    ; character is flasing if alternate != primary
  15873.     php            ; remember if character is flashing
  15874.     and    #$f0        ; replace the upper nybble with the new backclr
  15875.     ora    backclr,x
  15876.     sta    (source),y
  15877.     plp            ; remember if character is flashing
  15878.     beq    c40set1        ; if not flashing, alternate == primary
  15879.     asl    a        ; if flashing, alternate(hi & lo) = backclr
  15880.     asl    a
  15881.     asl    a
  15882.     asl    a
  15883.     ora    backclr,x
  15884. c40set1:sta    (dest),y
  15885.     dey            ; repeat for all of the columns
  15886.     bpl    c40set2
  15887.     clc            ; go do the next row
  15888.     lda    source
  15889.     adc    #40
  15890.     sta    source
  15891.     lda    source+1
  15892.     adc    #$00
  15893.     sta    source+1
  15894.     lda    dest
  15895.     adc    #40
  15896.     sta    dest
  15897.     lda    dest+1
  15898.     adc    #$00
  15899.     sta    dest+1
  15900.     pla            ; count off 25 rows
  15901.     sec
  15902.     sbc    #$01
  15903.     bne    c40set3
  15904. c40set5:rts            ; all done
  15905.  
  15906. ;
  15907. ;    c40put - put a character at cx, cy
  15908. ;
  15909. ;    Input:    character to put in a-reg (use funny ascii)
  15910. ;    Output: None
  15911. ;
  15912. ;    Registers destroyed - A,X,Y
  15913. ;
  15914. ;    This routine puts a character at screen position cx,cy.  This routine
  15915. ;    does not advance the cursor position.
  15916. ;
  15917.  
  15918. c40put:    sta    source
  15919.     lda    #$00
  15920.     sta    source+1
  15921.     asl    source        ; multiplied by 2
  15922.     rol    source+1
  15923.     asl    source        ; multiplied by 4
  15924.     rol    source+1
  15925.     asl    source        ; multiplied by 8
  15926.     rol    source+1
  15927.     lda    source        ; now add in font40
  15928.     adc    #font40\    ; carry is clear
  15929.     sta    source
  15930.     lda    source+1
  15931.     adc    #font40^
  15932.     sta    source+1
  15933.     ldy    cy        ; compute the address to store at
  15934.     ldx    cx
  15935.     jsr    c40adrt        
  15936.     ldy    #$07        ; copy in 8 bytes
  15937. c40put1:lda    (source),y
  15938.     ldx    reverse        ; $01 is reverse on, $00 is reverse off
  15939.     beq    c40put3
  15940.     eor    #$ff
  15941. c40put3:sta    (dest),y
  15942.     dey
  15943.     bpl    c40put1        ; put in the entire character (8 bytes)
  15944.     lda    underln        ; $ff is underline on, $00 is underline off
  15945.     beq    c40put2        ; do not underline
  15946.     lda    reverse        ; underline and reverse?
  15947.     beq    c40put6        ; yes.
  15948.     lda    #$00        ; turn all the bits off
  15949.     ldy    #$07
  15950.     sta    (dest),y
  15951.     jmp    c40put2
  15952. c40put6:lda    #$ff        ; turn all the bits on
  15953.     ldy    #$07        ; underline the last row
  15954.     sta    (dest),y
  15955. c40put2:ldy    cy        ; calculate primary color address
  15956.     ldx    cx
  15957.     jsr    c40adrp
  15958.     ldx    alternt        ; 1=alternate color, 0=normal color
  15959.     lda    foreclr,x    ; get proper foreground color
  15960.     asl    a        ; put in high nybble
  15961.     asl    a
  15962.     asl    a
  15963.     asl    a
  15964.     ldx    decrev        ; is the background bright or dark
  15965.     ora    backclr,x    ; or in background color
  15966.     ldy    #$00
  15967.     sta    (dest),y    ; adjust primary color ram
  15968.     pha            ; save for future use
  15969.     ldy    cy        ; compute alternate color address
  15970.     ldx    cx
  15971.     jsr    c40adra
  15972.     pla            ; restore colors used for primary color
  15973.     ldx    flash        ; can we use it?
  15974.     beq    c40put5        ; yes.
  15975.     ldx    decrev        ; is the background bright or dark
  15976.     lda    backclr,x    ; or in background color
  15977.     asl    a        ; use background color for forground
  15978.     asl    a
  15979.     asl    a
  15980.     asl    a
  15981.     ora    backclr,x    ; or in background color
  15982. c40put5:ldy    #$00
  15983.     sta    (dest),y    ; adjust alternate color ram
  15984. c40put4:rts            ; all done.
  15985.  
  15986. ;
  15987. ;    c40irm - make space for a character if insert replace mode is insert
  15988. ;
  15989. ;    In this code, the sense of dest and source are reversed.
  15990. ;
  15991.  
  15992. c40irm:    ldx    #39
  15993.     ldy    cy
  15994.     jsr    c40adrt
  15995. c40irm2:sec
  15996.     lda    dest
  15997.     sta    source
  15998.     sbc    #$08
  15999.     sta    dest
  16000.     lda    dest+1
  16001.     sta    source+1
  16002.     sbc    #$00
  16003.     sta    dest+1
  16004.     dex
  16005.     bmi    c40irm1
  16006.     cpx    cx
  16007.     bcc    c40irm1
  16008.     ldy    #$07
  16009. c40irm3:lda    (dest),y
  16010.     sta    (source),y
  16011.     dey
  16012.     bpl    c40irm3
  16013.     bmi    c40irm2            ; always taken
  16014. c40irm1:ldx    #$00
  16015.     ldy    cy
  16016.     jsr    c40adra
  16017.     ldy    cx
  16018. c40irm4:lda    (dest),y        ; who cares what x is the first time?
  16019.     pha
  16020.     txa
  16021.     sta    (dest),y
  16022.     pla
  16023.     tax
  16024.     iny
  16025.     cpy    #40
  16026.     bcc    c40irm4
  16027.     ldx    #$00
  16028.     ldy    cy
  16029.     jsr    c40adrp
  16030.     ldy    cx
  16031. c40irm5:lda    (dest),y        ; who cares what x is the first time?
  16032.     pha
  16033.     txa
  16034.     sta    (dest),y
  16035.     pla
  16036.     tax
  16037.     iny
  16038.     cpy    #40
  16039.     bcc    c40irm5
  16040.     rts
  16041.  
  16042. ;
  16043. ;    c40dch - delete one or more characters.
  16044. ;
  16045. ;    Input:    Number of characters in A-reg
  16046. ;        Cursor position in cx, cy
  16047. ;
  16048. ;    Note that in this routine, the sense of dest and source are reversed
  16049. ;
  16050.  
  16051. c40dch:    sta    freemem            ; save number of characters to delete
  16052.     lda    cx
  16053. c40dch3:pha                ; save counter
  16054.     tax                ; address of character to cover up
  16055.     ldy    cy
  16056.     jsr    c40adrt            ; copy dest -> source
  16057.     lda    dest
  16058.     sta    source
  16059.     lda    dest+1
  16060.     sta    source+1
  16061.     clc
  16062.     pla                ; remember counter
  16063.     pha                ; save again
  16064.     adc    freemem            ; what to cover character with
  16065.     cmp    #40            ; cover with a blank?
  16066.     bcs    c40dch1
  16067.     tax                ; compute address of character to use
  16068.     ldy    cy
  16069.     jsr    c40adrt
  16070.     ldy    #$07            ; copy in 8 bytes
  16071. c40dch2:lda    (dest),y
  16072.     sta    (source),y
  16073.     dey
  16074.     bpl    c40dch2
  16075.     pla                ; remember & save counter
  16076.     pha
  16077.     tax                ; compute primary color address
  16078.     ldy    cy
  16079.     jsr    c40adrp
  16080.     ldy    freemem            ; number of characters to delele
  16081.     lda    (dest),y        ; attribute for character to use
  16082.     ldy    #$00
  16083.     sta    (dest),y        ; address of character to replace
  16084.     pla                ; remember & save counter
  16085.     pha
  16086.     tax                ; compute alternate color address
  16087.     ldy    cy
  16088.     jsr    c40adra
  16089.     ldy    freemem            ; number of characters to delele
  16090.     lda    (dest),y        ; attribute for character to use
  16091.     ldy    #$00
  16092.     sta    (dest),y        ; address of character to replace
  16093.     clc                ; now add 1 to the counter and repeat
  16094.     pla
  16095.     adc    #$01
  16096.     bcc    c40dch3            ; always taken
  16097. c40dch1:lda    #$00            ; replace character with a blank
  16098.     ldy    #$07            ; 8 bytes
  16099. c40dch4:sta    (dest),y
  16100.     dey
  16101.     bpl    c40dch4
  16102.     clc                ; now add 1 to the counter and repeat
  16103.     pla
  16104.     adc    #$01
  16105.     cmp    #40
  16106.     bcc    c40dch3
  16107.     rts                ; all done
  16108.  
  16109. ;
  16110. ;    c40drw - draw a character at cx, cy
  16111. ;
  16112. ;    Input:    character to put in a-reg (use funny ascii)
  16113. ;    Output: A - size of character
  16114. ;
  16115. ;    Registers destroyed - A,X,Y
  16116. ;
  16117. ;    This routine puts a character at screen position tektx, tekty and
  16118. ;    returns the size of the character.
  16119. ;
  16120.  
  16121. c40drw:    sta    source
  16122.     lda    #$00
  16123.     sta    source+1
  16124.     asl    source        ; multiplied by 2
  16125.     rol    source+1
  16126.     asl    source        ; multiplied by 4
  16127.     rol    source+1
  16128.     asl    source        ; multiplied by 8
  16129.     rol    source+1
  16130.     lda    source        ; now add in font40
  16131.     adc    #font40\    ; carry is clear
  16132.     sta    source
  16133.     lda    source+1
  16134.     adc    #font40^
  16135.     sta    source+1
  16136.     ldy    #$07        ; copy the character for c40sub
  16137. c40drw1:lda    (source),y
  16138.     sta    freemem,y
  16139.     dey
  16140.     bpl    c40drw1
  16141.     jsr    c40sub        ; offset the character
  16142.     ldx    tektxhi
  16143.     cpx    #40        ; skip if past right of screen
  16144.     bcs    c40drw3
  16145.     ldy    tektyhi        ; compute the address to store at
  16146.     dey
  16147.     cpy    #25        ; skip if past bottom of screen
  16148.     bcs    c40drw3
  16149.     jsr    c40adrt        
  16150.     ldy    #$07        ; copy in the upper left
  16151. c40drw2:lda    freemem,y
  16152.     ora    (dest),y
  16153.     sta    (dest),y
  16154.     dey
  16155.     bpl    c40drw2
  16156. c40drw3:ldx    tektxhi
  16157.     inx            ; put this part of the character 1 space right
  16158.     cpx    #40        ; skip if past right edge
  16159.     bcs    c40drw5
  16160.     ldy    tektyhi
  16161.     dey
  16162.     cpy    #25        ; skip if past bottom of screen
  16163.     bcs    c40drw5
  16164.     jsr    c40adrt
  16165.     ldy    #$07        ; copy in the upper right
  16166. c40drw4:lda    freemem+16,y
  16167.     ora    (dest),y
  16168.     sta    (dest),y
  16169.     dey
  16170.     bpl    c40drw4
  16171. c40drw5:ldx    tektxhi
  16172.     cpx    #40        ; skip if past right edge
  16173.     bcs    c40drw7
  16174.     ldy    tektyhi
  16175.     cpy    #25        ; skip if past bottom
  16176.     bcs    c40drw7
  16177.     jsr    c40adrt
  16178.     ldy    #$07        ; copy in the lower left
  16179. c40drw6:lda    freemem+8,y
  16180.     ora    (dest),y
  16181.     sta    (dest),y
  16182.     dey
  16183.     bpl    c40drw6
  16184. c40drw7:ldx    tektxhi
  16185.     inx            ; put this part of the character 1 space left
  16186.     cpx    #40        ; skip if past right edge
  16187.     bcs    c40drw9
  16188.     ldy    tektyhi
  16189.     cpy    #25        ; skip if past bottom
  16190.     bcs    c40drw9
  16191.     jsr    c40adrt
  16192.     ldy    #$07        ; copy in the lower right
  16193. c40drw8:lda    freemem+24,y
  16194.     ora    (dest),y
  16195.     sta    (dest),y
  16196.     dey
  16197.     bpl    c40drw8
  16198. c40drw9:lda    #26        ; move cursor 26 pixels right
  16199.     rts
  16200.  
  16201. ;
  16202. ;    freemem        |    freemem + 16
  16203. ;    ------------------------------------
  16204. ;    freemem + 8    |    freemem + 24
  16205. ;
  16206.  
  16207. c40sub:    ldy    #$17        ; zero 24 bytes at freemem+8
  16208.     lda    #$00
  16209. c40sub1:sta    freemem+8,y
  16210.     dey
  16211.     bpl    c40sub1
  16212.     lda    tektylo        ; how far to offset down?
  16213.     lsr    a        ; divide by 2
  16214.     lsr    a        ; divide by 4
  16215.     lsr    a        ; divide by 8
  16216.     lsr    a        ; divide by 16
  16217.     lsr    a        ; divide by 32
  16218.     beq    c40sub5        ; skip this if zero
  16219.     tay            ; remember how may bits to sift
  16220. c40sub3:ldx    #$0e        ; shift down
  16221. c40sub4:lda    freemem,x
  16222.     sta    freemem+1,x
  16223.     dex
  16224.     bpl    c40sub4
  16225.     lda    #$00
  16226.     sta    freemem
  16227.     dey
  16228.     bne    c40sub3
  16229. c40sub5:lda    tektxlo        ; how far to offset left?
  16230.     lsr    a        ; divide by 2
  16231.     lsr    a        ; divide by 4
  16232.     lsr    a        ; divide by 8
  16233.     lsr    a        ; divide by 16
  16234.     lsr    a        ; divide by 32
  16235.     beq    c40sub6        ; skip this if zero
  16236.     tay            ; remember
  16237. c40sub7:ldx    #$0f
  16238. c40sub8:lsr    freemem,x
  16239.     ror    freemem+16,x
  16240.     dex
  16241.     bpl    c40sub8
  16242.     dey
  16243.     bne    c40sub7
  16244. c40sub6:rts
  16245.  
  16246. ;
  16247. ;    c40ind - perform the VT100 index function (scroll the screen)
  16248. ;
  16249. ;    Input:    number of lines to scroll in A-reg
  16250. ;    Output: None
  16251. ;
  16252. ;    Registers destroyed - A,X,Y
  16253. ;
  16254. ;    This routine scrolls the screen in 40 column mode.  Only the area
  16255. ;    in the scrolling region is changed.
  16256. ;
  16257. ;    This routine is also used for delete line.
  16258. ;
  16259.  
  16260. c40ind:    tax            ; save number of lines to delete
  16261.     lda    cy        ; save the cursor y position
  16262.     pha
  16263.     lda    top        ; top of scrolling region
  16264.     sta    cy
  16265.     txa            ; put number of liens to delete on stack
  16266.     pha
  16267. c40ind1:clc            ; get source line
  16268.     pla
  16269.     pha
  16270.     adc    cy
  16271.     cmp    bot        ; see if this line is on the scrolling area
  16272.     beq    c40ind3
  16273.     bcs    c40ind2
  16274. c40ind3:pha            ; save this result -- useful later
  16275.     tay
  16276.     ldx    #$00
  16277.     jsr    c40adrt        ; calculate source address
  16278.     lda    dest        ; source address must be moved from dest
  16279.     sta    source
  16280.     lda    dest+1
  16281.     sta    source+1
  16282.     ldy    cy        ; calculate destination address
  16283.     ldx    #$00
  16284.     jsr    c40adrt
  16285.     ldx    #40        ; 40 * 8 = 320 bytes to move
  16286.     jsr    move8        ; scroll one line
  16287.     pla            ; source line numver
  16288.     pha
  16289.     tay
  16290.     ldx    #$00
  16291.     jsr    c40adrp        ; calculate source address
  16292.     lda    dest        ; source address must be moved from dest
  16293.     sta    source
  16294.     lda    dest+1
  16295.     sta    source+1
  16296.     ldy    cy        ; calculate destination address
  16297.     ldx    #$00
  16298.     jsr    c40adrp
  16299.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16300.     jsr    move8        ; scroll one line
  16301.     pla
  16302.     tay
  16303.     ldx    #$00
  16304.     jsr    c40adra        ; calculate source address
  16305.     lda    dest        ; source address must be moved from dest
  16306.     sta    source
  16307.     lda    dest+1
  16308.     sta    source+1
  16309.     ldy    cy        ; calculate destination address
  16310.     ldx    #$00
  16311.     jsr    c40adra
  16312.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16313.     jsr    move8        ; scroll one line
  16314.     inc    cy        ; no do the next line
  16315.     jmp    c40ind1
  16316. c40ind2:jsr    c40el2        ; whoops...  Clear a line at bottom of area
  16317.     inc    cy        ; go do the next line
  16318.     ldy    bot
  16319.     cpy    cy
  16320.     bcs    c40ind1
  16321.     pla            ; discard number of lines to scroll
  16322.     pla            ; restore the cursor position
  16323.     sta    cy
  16324.     rts
  16325.     
  16326. ;
  16327. ;    c40ri - perform the VT100 reverse index function (scroll backwards)
  16328. ;
  16329. ;    Input:    Number of lines to scroll in A-reg.
  16330. ;    Output: None
  16331. ;
  16332. ;    Registers destroyed - A,X,Y
  16333. ;
  16334. ;    This routine scrolls the screen upwards in 40 column mode.  Only the
  16335. ;    area in the scrolling region is changed.
  16336. ;
  16337. ;    This routine is also used for insert line.
  16338. ;
  16339.  
  16340. c40ri:    tax            ; save numver of lines to delete
  16341.     lda    cy        ; save the cursor y position
  16342.     pha
  16343.     lda    bot        ; top of scrolling region
  16344.     sta    cy
  16345.     txa            ; put number of lines to delete on stack
  16346.     pha
  16347. c40ri1:    sec            ; compute cy-top_of_stack the hard way
  16348.     pla
  16349.     pha
  16350.     eor    #$ff
  16351.     adc    cy
  16352.     cmp    top
  16353.     bmi    c40ri2        ; ran off the top of the scrolling region
  16354.     pha            ; save this results.  Useful later
  16355.     tay
  16356.     ldx    #$00
  16357.     jsr    c40adrt        ; calculate source address
  16358.     lda    dest        ; source address must be moved from dest
  16359.     sta    source
  16360.     lda    dest+1
  16361.     sta    source+1
  16362.     ldy    cy        ; calculate destination address
  16363.     ldx    #$00
  16364.     jsr    c40adrt
  16365.     ldx    #40        ; 40 * 8 = 320 bytes to move
  16366.     jsr    move8        ; scroll one line
  16367.     pla
  16368.     pha
  16369.     tay
  16370.     ldx    #$00
  16371.     jsr    c40adrp        ; calculate source address
  16372.     lda    dest        ; source address must be moved from dest
  16373.     sta    source
  16374.     lda    dest+1
  16375.     sta    source+1
  16376.     ldy    cy        ; calculate destination address
  16377.     ldx    #$00
  16378.     jsr    c40adrp
  16379.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16380.     jsr    move8        ; scroll one line
  16381.     pla
  16382.     tay
  16383.     ldx    #$00
  16384.     jsr    c40adra        ; calculate source address
  16385.     lda    dest        ; source address must be moved from dest
  16386.     sta    source
  16387.     lda    dest+1
  16388.     sta    source+1
  16389.     ldy    cy        ; calculate destination address
  16390.     ldx    #$00
  16391.     jsr    c40adra
  16392.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16393.     jsr    move8        ; scroll one line
  16394.     dec    cy
  16395.     jmp    c40ri1        ; repeat until done
  16396. c40ri2:    jsr    c40el2        ; erase the bottom line
  16397.     dec    cy
  16398.     ldy    cy
  16399.     cpy    top
  16400.     bpl    c40ri1
  16401.     pla            ; discard number of lines to delete
  16402.     pla            ; restore the cursor position
  16403.     sta    cy
  16404.     rts
  16405.     
  16406. ;
  16407. ;    c40el0 - Perform the VT100 Erase Line function #0 on 40 column screen
  16408. ;
  16409. ;    Input:    Number of line to erase in cy
  16410. ;    Output: None
  16411. ;
  16412. ;    Registers destroyed - A,X,Y
  16413. ;
  16414. ;    This routine erases from the cursor to the end of the line
  16415. ;
  16416.  
  16417. c40el0:    ldy    cy
  16418.     ldx    cx
  16419.     jsr    c40adrt        ; find address to clear
  16420.     lda    #40
  16421.     sec
  16422.     sbc    cx        ; number of characters to erase
  16423.     tax
  16424.     jsr    clear8        ; zero some memory
  16425.     rts
  16426.  
  16427. ;
  16428. ;    c40el1 - Perform the VT100 Erase Line function #1 on 40 column screen
  16429. ;
  16430. ;    Input:    Number of line to erase in cy
  16431. ;    Output: None
  16432. ;
  16433. ;    Registers destroyed - A,X,Y
  16434. ;
  16435. ;    This routine erases from the beginning of line to cursor
  16436. ;
  16437.  
  16438. c40el1:    ldy    cy
  16439.     ldx    #$00
  16440.     jsr    c40adrt        ; find address to clear
  16441.     ldx    cx
  16442.     jsr    clear8        ; zero some memory
  16443.     rts
  16444.  
  16445. ;
  16446. ;    c40el2 - Perform the VT100 Erase Line function #2 on 40 column screen
  16447. ;
  16448. ;    Input:    Number of line to erase in cy
  16449. ;    Output: None
  16450. ;
  16451. ;    Registers destroyed - A,X,Y
  16452. ;
  16453. ;    This routine erases one line compleatly from the 40 column display.
  16454. ;
  16455.  
  16456. c40el2:    ldy    cy        ; get line to erase
  16457.     ldx    #$00        ; start erasing at start of line
  16458.     jsr    c40adrt        ; put address of text to erase in dest
  16459.     ldx    #40        ; number of bytes to erase (320 / 8 = 40)
  16460.     jsr    clear8
  16461.     ldy    cy        ; erase the color ram too
  16462.     ldx    #$00
  16463.     jsr    c40adrp
  16464.     lda    foreclr        ; get proper foreground color
  16465.     asl    a        ; put in high nybble
  16466.     asl    a
  16467.     asl    a
  16468.     asl    a
  16469.     ldx    decrev        ; is the background bright or dark
  16470.     ora    backclr,x    ; or in background color
  16471.     pha            ; save color stuff for secondary color ram
  16472.     ldx    #5        ; number of bytes to fill (40 / 8 = 5)
  16473.     jsr    fill8        ; erase one line
  16474.     ldy    cy        ; erase secondary color ram
  16475.     ldx    #$00
  16476.     jsr    c40adra
  16477.     pla            ; remember what to erase it with
  16478.     ldx    #5        ; number of bytes to fill (40 / 8 = 5)
  16479.     jsr    fill8        ; erase one line
  16480.     rts            ; all done
  16481.  
  16482. ;
  16483. ;    c40int - convert tektronix coordinates into internal form
  16484. ;
  16485. ;    Input:    tekcxlo, tekcxhi
  16486. ;        tekcylo, tekcyhi
  16487. ;    Output:    tektxlo, tektxhi
  16488. ;        tektylo, tektyhi
  16489. ;
  16490. ;    This routine converts tektronix coordinates into internal form
  16491. ;
  16492. ;    In tektronix form, there is a 10 bit number in tekcxlo, tekcxhi 
  16493. ;    representing the distance from the left edge.
  16494. ;
  16495. ;    In internal form, there is a number in tektxhi between 0 and 39
  16496. ;    representing the number of characters between the left edge and the
  16497. ;    point in ;    question.  There is a number
  16498. ;    (one of 0,32,64,96,...,224) in tekcxlo representing a fraction of
  16499. ;    a character.
  16500. ;
  16501. ;    In tektronix form, there is a 10 bit number in tekcylo, tekcyhi
  16502. ;    representing the distance from the _bottom_ of the screen.
  16503. ;
  16504. ;    In internal form, there is a number in tektyhi between 0 and 24
  16505. ;    representing the distance from the _top_ of the screen in characters.
  16506. ;    The fractional part of a character is stored in tektylo.  It will
  16507. ;    be one of these numbers: 0,32,64,96,...,224.
  16508. ;
  16509.  
  16510. c40int:    lda    tekcxlo        ; get the current x coordinate
  16511.     sta    tektxlo
  16512.     lda    tekcxhi
  16513.     sta    tektxhi
  16514.     asl    tektxlo        ; multiply x coordinate by 4
  16515.     rol    tektxhi
  16516.     asl    tektxlo
  16517.     rol    tektxhi
  16518.     clc            ; add in one.  Now multiplied by 5
  16519.     lda    tektxlo
  16520.     adc    tekcxlo
  16521.     sta    tektxlo
  16522.     lda    tektxhi
  16523.     adc    tekcxhi
  16524.     sta    tektxhi
  16525.     asl    tektxlo        ; multiply by 2 more for a total of 10. done.
  16526.     rol    tektxhi
  16527.     sec            ; invert the sence of y coordinate (799 - y)
  16528.     lda    #779\
  16529.     sbc    tekcylo
  16530.     sta    tektylo
  16531.     lda    #779^
  16532.     sbc    tekcyhi
  16533.     sta    tektyhi
  16534.     asl    tektylo        ; multiply by 8 (800 * 8 / 256 = 25)
  16535.     rol    tektyhi        ; now multiplied by 2
  16536.     asl    tektylo
  16537.     rol    tektyhi        ; now multiplied by 4
  16538.     asl    tektylo
  16539.     rol    tektyhi        ; now multiplied by 8
  16540.     rts
  16541.  
  16542. ;
  16543. ;    c40lin - draw a line from the current point to the destination point
  16544. ;
  16545. ;    Input:    tekfxlo, tekfxhi    - point to draw line from (x position)
  16546. ;        tekfylo, tekfyhi    - point to draw line from (y position)
  16547. ;        tektxlo, tektxhi    - point to draw line to (x position)
  16548. ;        tektylo, tektyhi    - point to draw line to (y position)
  16549. ;
  16550. ;    This routine draws a line.
  16551. ;
  16552. ;    It works by computing a delta.  we then add the delta to the current
  16553. ;    point and plot.  we stop only when the current point is equal to the
  16554. ;    destination point.
  16555. ;
  16556. ;    We optimize this by multiplying the delta by 2 until we know that
  16557. ;    each point plotted is at a different spot.  (We do not need to plot
  16558. ;    the same point more than once)
  16559. ;
  16560.  
  16561. c40lin:    lda    #$00        ; zero the ultra-low coordinate
  16562.     sta    tekfxul
  16563.     sta    tekfyul
  16564.     sec            ; compute delta x
  16565.     lda    tektxlo
  16566.     sbc    tekfxlo
  16567.     sta    tekdxul
  16568.     lda    tektxhi
  16569.     sbc    tekfxhi
  16570.     sta    tekdxlo
  16571.     lda    #$00
  16572.     sbc    #$00
  16573.     sta    tekdxhi
  16574.     sec            ; compute delta y
  16575.     lda    tektylo
  16576.     sbc    tekfylo
  16577.     sta    tekdyul
  16578.     lda    tektyhi
  16579.     sbc    tekfyhi
  16580.     sta    tekdylo
  16581.     lda    #$00
  16582.     sbc    #$00
  16583.     sta    tekdyhi
  16584.     ldx    #$08        ; dont optimize more than 8 times!!!!
  16585. c40lin2:lda    tekdxlo        ; is the x delta negative
  16586.     bpl    c40lin3
  16587.     eor    #$ff        ; get the positive equivalent
  16588. c40lin3:cmp    #$0f        ; is it big enough
  16589.     bcs    c40lin1
  16590.     lda    tekdylo        ; is the y delta negative
  16591.     bpl    c40lin4
  16592.     eor    #$ff        ; get the positive equivalent
  16593. c40lin4:cmp    #$0f        ; is it big enough
  16594.     bcs    c40lin1
  16595.     asl    tekdxul        ; multiply the x delta by two
  16596.     rol    tekdxlo
  16597.     asl    tekdyul        ; multiply the y delta by two
  16598.     rol    tekdylo
  16599.     dex
  16600.     bne    c40lin2        ; try to optimize some more
  16601. c40lin1:jsr    c40pnt        ; now we can finally plot a point
  16602.     clc            ; add in the x delta
  16603.     lda    tekfxul
  16604.     adc    tekdxul
  16605.     sta    tekfxul
  16606.     lda    tekfxlo
  16607.     adc    tekdxlo
  16608.     sta    tekfxlo
  16609.     lda    tekfxhi
  16610.     adc    tekdxhi
  16611.     sta    tekfxhi
  16612.     clc            ; add in the y delta
  16613.     lda    tekfyul
  16614.     adc    tekdyul
  16615.     sta    tekfyul
  16616.     lda    tekfylo
  16617.     adc    tekdylo
  16618.     sta    tekfylo
  16619.     lda    tekfyhi
  16620.     adc    tekdyhi
  16621.     sta    tekfyhi
  16622.     lda    tekfxlo        ; compare current point with destination
  16623.     cmp    tektxlo
  16624.     bne    c40lin1        ; if not the same, go plot another point
  16625.     lda    tekfxhi        ; compare current point with destination
  16626.     cmp    tektxhi
  16627.     bne    c40lin1        ; if not the same, go plot another point
  16628.     lda    tekfylo        ; compare current point with destination
  16629.     cmp    tektylo
  16630.     bne    c40lin1        ; if not the same, go plot another point
  16631.     lda    tekfyhi        ; compare current point with destination
  16632.     cmp    tektyhi
  16633.     bne    c40lin1        ; if not the same, go plot another point
  16634.     rts            ; all done
  16635.  
  16636. ;
  16637. ;    c40pnt - plot a point
  16638. ;
  16639. ;    input:    point to plot in tektxlo, tektxhi, tektylo, tektyhi
  16640. ;
  16641. ;    This routine plots a point in 40 column mode
  16642. ;
  16643.  
  16644. c40pnt:    ldx    tekfxhi        ; get x coordinate of character to change
  16645.     cpx    #40        ; check to see if off screen
  16646.     bcs    c40pnt1
  16647.     ldy    tekfyhi        ; get y coordinate of character to change
  16648.     cpy    #25        ; check to see if off screen
  16649.     bcs    c40pnt1
  16650.     jsr    c40adrt        ; get address of character to change
  16651.     lda    tekfylo        ; get the row of the character to change
  16652.     lsr    a
  16653.     lsr    a
  16654.     lsr    a
  16655.     lsr    a
  16656.     lsr    a
  16657.     tay
  16658.     lda    tekfxlo        ; get the column of the character to change
  16659.     lsr    a
  16660.     lsr    a
  16661.     lsr    a
  16662.     lsr    a
  16663.     lsr    a
  16664.     tax
  16665.     lda    powers,x
  16666.     ora    (dest),y    ; plot the character
  16667.     sta    (dest),y
  16668. c40pnt1:rts
  16669.  
  16670. ;
  16671. ;    c40era - erase the graphics screen in tektronix mode
  16672. ;
  16673.  
  16674. c40era:    jmp    c40clr        ; just like erasing in text mode
  16675.  
  16676. ;
  16677. ;    c40txt - show the text screen
  16678. ;
  16679. ;    This routine swaps the text and graphics screens
  16680. ;
  16681.  
  16682. c40txt:    lda    $d018        ; tell vic where to find screen & color ram
  16683.     and    #vicmsk
  16684.     ora    #vicdat1
  16685.     sta    $d018        ;    ""
  16686.     rts
  16687.  
  16688. ;
  16689. ;    c40tek - show the graphics screen
  16690. ;
  16691. ;    This routine swaps the current screen in underneath the kernal and IO,
  16692. ;    and swaps the hidden screen back out.
  16693. ;
  16694.  
  16695. c40tek:    lda    $d018        ; tell vic where to find screen & color ram
  16696.     and    #vicmsk
  16697.     ora    #vicdat1
  16698.     sta    $d018
  16699.     lda    #vicclr1\    ; fill the color ram
  16700.     sta    dest
  16701.     lda    #vicclr1^
  16702.     sta    dest+1
  16703.     lda    foreclr
  16704.     asl    a
  16705.     asl    a
  16706.     asl    a
  16707.     asl    a
  16708.     ora    backclr
  16709.     ldx    #$400/$08
  16710.     jsr    fill8
  16711.     rts
  16712.  
  16713. ;
  16714. ;    c40clr - clear the graphics screen in 40 column mode
  16715. ;
  16716.  
  16717. c40clr:    lda    #victext\
  16718.     sta    dest
  16719.     lda    #victext^
  16720.     sta    dest+1
  16721.     jsr    clr8k
  16722.     rts
  16723.  
  16724. ;
  16725. ;    c40fls - flash the screen in 40 column mode
  16726. ;
  16727. ;    Input:    None
  16728. ;    Output: None
  16729. ;
  16730. ;    Registers destroyed - A,X,Y
  16731. ;
  16732. ;    This routine flashes the screen in 40 column mode
  16733. ;
  16734.  
  16735. c40fls:    lda    $d018        ; swap between primary color ram and alternate
  16736.         eor    #vicswap
  16737.         sta    $d018
  16738.         rts            ; all done
  16739.  
  16740. ;
  16741. ;    c40tgl - toggle the cursor in 40 column mode
  16742. ;
  16743. ;    Input:    None
  16744. ;    Output: None
  16745. ;
  16746. ;    Registers destroyed - A,X,Y
  16747. ;
  16748. ;    This routine toggles the cursor in 40 column mode.
  16749. ;
  16750.  
  16751. c40tgl:    ldy    cy        ; compute cursor address
  16752.     ldx    cx
  16753.     jsr    c40adrt
  16754.     ldy    #$07        ; blink the cursor
  16755. c40tgl2:lda    (dest),y
  16756.     eor    #$ff
  16757.     sta    (dest),y
  16758.     dey
  16759.     bpl    c40tgl2
  16760. c40tgl1:rts
  16761.     
  16762. ;
  16763. ;    c40tst - test to see if the 40 column screen driver is present
  16764. ;
  16765. ;    Input:    None
  16766. ;    Output: carry always clear because 40 columns is always available
  16767. ;
  16768. ;    Registers destroyed - None
  16769. ;
  16770. ;    This routine returns with the carry clear to indicate that the 40
  16771. ;    column screen is always available.
  16772. ;
  16773.  
  16774. c40tst:    clc
  16775.     rts
  16776.  
  16777. ;
  16778. ;    c40adrt - Compute the address of 40 column text
  16779. ;
  16780. ;    Input:    Line number to y-reg
  16781. ;        Column number in  x-reg
  16782. ;    Output: Address stored in dest
  16783. ;
  16784. ;    Registers destroyed - A,X,Y
  16785. ;
  16786. ;    This routine calculates the memory address of a character in 40 column
  16787. ;    mode.
  16788. ;
  16789.  
  16790. c40adrt:jsr    c40adr        ; compute 40*y+x
  16791.     asl    dest        ; multiply by 2
  16792.     rol    dest+1
  16793.     asl    dest        ; multiply by 4
  16794.     rol    dest+1
  16795.     asl    dest        ; multiply by 8
  16796.     rol    dest+1
  16797.     lda    dest        ; add in start of screen
  16798.     adc    #victext\    ; carry already clear
  16799.     sta    dest
  16800.     lda    dest+1
  16801.     adc    #victext^
  16802.     sta    dest+1
  16803.     rts
  16804.  
  16805. ;
  16806. ;    c40adrp - Compute the address of 40 column primary color ram
  16807. ;
  16808. ;    Input:    Line number to y-reg
  16809. ;        Column number in  x-reg
  16810. ;    Output: Address stored in dest
  16811. ;
  16812. ;    Registers destroyed - A,X,Y
  16813. ;
  16814. ;    This routine calculates the memory address of a character in 40 column
  16815. ;    mode.   The address returned is the address of the primary color ram.
  16816. ;
  16817.  
  16818. c40adrp:jsr    c40adr        ; compute base address
  16819.     clc            ; add in vicclr1
  16820.     lda    dest
  16821.     adc    #vicclr1\
  16822.     sta    dest
  16823.     lda    dest+1
  16824.     adc    #vicclr1^
  16825.     sta    dest+1
  16826.     rts
  16827.  
  16828. ;
  16829. ;    c40adra - Compute the address of 40 column alternate color ram
  16830. ;
  16831. ;    Input:    Line number to y-reg
  16832. ;        Column number in  x-reg
  16833. ;    Output: Address stored in dest
  16834. ;
  16835. ;    Registers destroyed - A,X,Y
  16836. ;
  16837. ;    This routine calculates the memory address of a character in 40 column
  16838. ;    mode.  The address returned is the address of the alternate color ram.
  16839. ;
  16840.  
  16841. c40adra:jsr    c40adr        ; compute base address
  16842.     clc            ; add in vicclr1
  16843.     lda    dest
  16844.     adc    #vicclr2\
  16845.     sta    dest
  16846.     lda    dest+1
  16847.     adc    #vicclr2^
  16848.     sta    dest+1
  16849.     rts
  16850.  
  16851. ;
  16852. ;    c40adr - calculate 40*y+x
  16853. ;
  16854. ;    Input:    numbers in x-reg and y-reg
  16855. ;    Output: dest
  16856. ;
  16857. ;    Registers destroyed - A,Y
  16858. ;
  16859. ;    This routine calculates 40*y+x and puts the result in dest.  If x > 40,
  16860. ;    one is subtracted first.  This will happen after a character is printed
  16861. ;    on the last character on a line.  This routine is for calculating
  16862. ;    screen addresses.
  16863. ;
  16864.  
  16865. c40adr:    sty    dest        ; put y-reg in dest
  16866.     lda    #$00        ; zero extend
  16867.     sta    dest+1
  16868.     asl    dest        ; multiplied by 2
  16869.     rol    dest+1
  16870.     asl    dest        ; multiplied by 4
  16871.     rol    dest+1
  16872.     tya            ; add in y to get 5*y
  16873.     adc    dest        ; carry is clear
  16874.     sta    dest
  16875.     bcc    c40adr1
  16876.     inc    dest+1
  16877. c40adr1:asl    dest        ; multiplied by 10
  16878.     rol    dest+1
  16879.     asl    dest        ; multiplied by 20
  16880.     rol    dest+1
  16881.     asl    dest        ; multiplied by 40
  16882.     rol    dest+1
  16883.     cpx    #40        ; are we in the funny row?
  16884.     bcc    c40adr2        ; no
  16885.     ldx    #39
  16886. c40adr2:txa            ; add in x-reg
  16887.     clc
  16888.     adc    dest
  16889.     sta    dest
  16890.     bcc    c40adr3
  16891.     inc    dest+1
  16892. c40adr3:rts            ; all done
  16893.  
  16894. ;
  16895. ;    Newchar - character mapping table
  16896. ;
  16897. ;    This table is used to define the 80 column and 40 column character sets
  16898. ;    The format of this table is:
  16899. ;        Number of characters to copy    (byte)
  16900. ;        Source of characters        (word)
  16901. ;        Destination for characters    (word)
  16902. ;
  16903.  
  16904. newchar:.byte 32    ; <space> - ?
  16905.     .word $d000+<32*8>
  16906.     .word font40+<00*8>
  16907.  
  16908.     .byte 28    ; @ A-Z [
  16909.     .word $d000+<00*8>
  16910.     .word font40+<32*8>
  16911.  
  16912.     .byte 1        ; \
  16913.     .word char92
  16914.     .word font40+<60*8>
  16915.  
  16916.     .byte 1        ; ]
  16917.     .word $d000+<29*8>
  16918.     .word font40+<61*8>
  16919.  
  16920.     .byte 3        ; ^ _ `
  16921.     .word char94
  16922.     .word font40+<62*8>
  16923.  
  16924.     .byte 26    ; a-z
  16925.     .word $d800+<01*8>
  16926.     .word font40+<65*8>
  16927.  
  16928.     .byte 4        ; { | } ~
  16929.     .word char123
  16930.     .word font40+<91*8>
  16931.  
  16932.     .byte 1        ; diamond 
  16933.     .word $d000+<90*8>
  16934.     .word font40+<95*8>
  16935.  
  16936.     .byte 1        ; square
  16937.     .word $d000+<102*8>
  16938.     .word font40+<96*8>
  16939.  
  16940.     .byte 8        ; h-t, f-f, c-r, l-f, degrees, plus/minus, n-l, v-t
  16941.     .word char129
  16942.     .word font40+<97*8>
  16943.  
  16944.     .byte 1        ; upper-left
  16945.     .word $d000+<125*8>
  16946.     .word font40+<105*8>
  16947.  
  16948.     .byte 1        ; lower-left
  16949.     .word $d000+<110*8>
  16950.     .word font40+<106*8>
  16951.  
  16952.     .byte 1        ; lower-right
  16953.     .word $d000+<112*8>
  16954.     .word font40+<107*8>
  16955.  
  16956.     .byte 1        ; upper-right
  16957.     .word $d000+<109*8>
  16958.     .word font40+<108*8>
  16959.  
  16960.     .byte 1        ; crossed lines
  16961.     .word $d000+<91*8>
  16962.     .word font40+<109*8>
  16963.  
  16964.     .byte 1        ; scan 1
  16965.     .word $d000+<119*8>
  16966.     .word font40+<110*8>
  16967.  
  16968.     .byte 1        ; scan 3
  16969.     .word $d000+<69*8>
  16970.     .word font40+<111*8>
  16971.  
  16972.     .byte 1        ; scan 5
  16973.     .word $d000+<67*8>
  16974.     .word font40+<112*8>
  16975.  
  16976.     .byte 1        ; scan 7
  16977.     .word $d000+<82*8>
  16978.     .word font40+<113*8>
  16979.  
  16980.     .byte 1        ; scan 9
  16981.     .word $d000+<111*8>
  16982.     .word font40+<114*8>
  16983.  
  16984.     .byte 1        ; middle-right
  16985.     .word $d000+<107*8>
  16986.     .word font40+<115*8>
  16987.  
  16988.     .byte 1        ; middle-left
  16989.     .word $d000+<115*8>
  16990.     .word font40+<116*8>
  16991.  
  16992.     .byte 2        ; upper-middle, lower-middle
  16993.     .word $d000+<113*8>
  16994.     .word font40+<117*8>
  16995.  
  16996.     .byte 1        ; vertical line
  16997.     .word $d000+<93*8>
  16998.     .word font40+<119*8>
  16999.  
  17000.     .byte 2        ; <=, >=
  17001.     .word char152
  17002.     .word font40+<120*8>
  17003.  
  17004.     .byte 1        ; pi
  17005.     .word $d000+<94*8>
  17006.     .word font40+<122*8>
  17007.  
  17008.     .byte 1        ; !=
  17009.     .word char155
  17010.     .word font40+<123*8>
  17011.  
  17012.     .byte 1        ; british pound
  17013.     .word $d000+<28*8>
  17014.     .word font40+<124*8>
  17015.  
  17016.     .byte 1        ; dot
  17017.     .word char157
  17018.     .word font40+<125*8>
  17019.  
  17020.     .byte 0        ; end of table
  17021.  
  17022.     .byte    *-newchar    ; abort assembly if table too long
  17023.  
  17024. ;
  17025. ;    charXXX - 40 column character definitions not available in rom
  17026. ;
  17027.  
  17028. char92:    .byte    $00,$60,$30,$18,$0c,$06,$03,$00    ; \
  17029. char94:    .byte    $00,$00,$18,$3c,$66,$00,$00,$00    ; ^
  17030.     .byte    $00,$00,$00,$00,$00,$00,$00,$7f    ; _
  17031.     .byte    $30,$18,$0c,$00,$00,$00,$00,$00    ; `
  17032. char123:.byte    $0e,$18,$08,$3c,$08,$18,$0e,$00    ; {
  17033.     .byte    $18,$18,$18,$00,$18,$18,$18,$00 ; |
  17034.     .byte    $70,$18,$10,$3c,$10,$18,$70,$00    ; }
  17035.     .byte    $00,$00,$3b,$6e,$00,$00,$00,$00    ; ~
  17036. char129:.byte    $a0,$a0,$e0,$ae,$a4,$04,$04,$00 ; (graphics) h-t
  17037.     .byte    $e0,$80,$ee,$88,$8e,$08,$08,$00 ; (graphics) f-f
  17038.     .byte    $60,$80,$8c,$6a,$0c,$0a,$0a,$00 ; (graphics) c-r
  17039.     .byte    $80,$80,$8e,$88,$ee,$08,$08,$00 ; (graphics) l-f
  17040.     .byte    $18,$24,$24,$18,$00,$00,$00,$00 ; (graphics) degrees
  17041.     .byte    $00,$18,$7e,$18,$7e,$00,$00,$00 ; (graphics) plus/minus
  17042.     .byte    $a0,$e0,$e8,$e8,$a8,$08,$0e,$00 ; (graphics) n-l
  17043.     .byte    $a0,$a0,$a0,$4e,$04,$04,$04,$00 ; (graphics) v-t
  17044. char152:.byte    $06,$18,$30,$18,$06,$00,$7e,$00 ; (graphics) <=
  17045.     .byte    $60,$18,$06,$18,$60,$00,$7e,$00 ; (graphics) >=
  17046. char155:.byte    $00,$03,$7e,$0c,$7e,$30,$60,$00 ; (graphics) !=
  17047. char157:.byte    $00,$00,$00,$18,$18,$00,$00,$00 ; (graphics) dot
  17048.  
  17049. .SBTTL    Miscellaneous routines
  17050.  
  17051. ;
  17052. ;    These are miscellaneous routines used in many different places
  17053. ;
  17054.  
  17055. ;
  17056. ;    Move8 - move x-reg 8-byte chunks of memory
  17057. ;
  17058. ;    Input: X - Number of 8-byte chunks of memory to move
  17059. ;           (source) - address of source of memory move
  17060. ;           (dest) - address of destination of memory move
  17061. ;
  17062. ;    Output: Memory is moved
  17063. ;
  17064. ;    Registers Destroyed: A,X,Y
  17065. ;
  17066.  
  17067. move8:    ldy    #$00        ; zero y-reg
  17068. move8a:    lda    (source),y    ; get one byte to move
  17069.     sta    (dest),y    ; move it
  17070.     iny            ; go on to the next byte
  17071.     lda    (source),y    ; duplicated for speed
  17072.     sta    (dest),y
  17073.     iny
  17074.     lda    (source),y    ; duplicated for speed
  17075.     sta    (dest),y
  17076.     iny
  17077.     lda    (source),y    ; duplicated for speed
  17078.     sta    (dest),y
  17079.     iny
  17080.     lda    (source),y    ; duplicated for speed
  17081.     sta    (dest),y
  17082.     iny
  17083.     lda    (source),y    ; duplicated for speed
  17084.     sta    (dest),y
  17085.     iny
  17086.     lda    (source),y    ; duplicated for speed
  17087.     sta    (dest),y
  17088.     iny
  17089.     lda    (source),y    ; duplicated for speed
  17090.     sta    (dest),y
  17091.     iny
  17092.     bne    move8b        ; crossed page boundry?
  17093.     inc    source+1
  17094.     inc    dest+1
  17095. move8b:    dex            ; anything more to move?
  17096.     bne    move8a        ; yes, move it.
  17097.     rts
  17098.     
  17099. ;
  17100. ;    clr8k -    clear 8000 (not 8192!) bytes of memory
  17101. ;
  17102.  
  17103. clr8k:    lda    #4        ; loop through 4 times
  17104. clr8k1:    pha    
  17105.     lda    dest+1
  17106.     pha    
  17107.     lda    dest
  17108.     pha    
  17109.     ldx    #250        ; clear 2000 bytes  (250 * 8 = 2000)
  17110.     jsr    clear8
  17111.     pla    
  17112.     clc    
  17113.     adc    #2000\
  17114.     sta    dest
  17115.     pla    
  17116.     adc    #2000^
  17117.     sta    dest+1
  17118.     pla    
  17119.     sec    
  17120.     sbc    #$01
  17121.     bne    clr8k1
  17122.     rts    
  17123.  
  17124. ;
  17125. ;    Clear8 - clear x-reg 8-byte chunks of memory
  17126. ;
  17127. ;    Input: X - Number of 8-byte chunks of memory to clear
  17128. ;           (dest) - address of destination of memory move
  17129. ;
  17130. ;    Output: Memory is cleared
  17131. ;
  17132. ;    Registers Destroyed: A,X,Y
  17133. ;
  17134.  
  17135. clear8:    lda #$00        ; clear memory by filling with $00
  17136.     jsr fill8
  17137.     rts
  17138.     
  17139. ;
  17140. ;    Fill8 - fill x-reg 8-byte chunks of memory with a-reg
  17141. ;
  17142. ;    Input: X - Number of 8-byte chunks of memory to fill
  17143. ;           A - Byte to fill memory with
  17144. ;           (dest) - address of destination of memory move
  17145. ;
  17146. ;    Output: Memory is filled
  17147. ;
  17148. ;    Registers Destroyed: A,X,Y
  17149. ;
  17150.  
  17151. fill8:    ldy    #$00        ; zero y-reg
  17152. fill8a:    sta    (dest),y    ; fill it
  17153.     iny            ; go on to the next byte
  17154.     sta    (dest),y    ; duplicated for speed
  17155.     iny
  17156.     sta    (dest),y    ; duplicated for speed
  17157.     iny
  17158.     sta    (dest),y    ; duplicated for speed
  17159.     iny
  17160.     sta    (dest),y    ; duplicated for speed
  17161.     iny
  17162.     sta    (dest),y    ; duplicated for speed
  17163.     iny
  17164.     sta    (dest),y    ; duplicated for speed
  17165.     iny
  17166.     sta    (dest),y    ; duplicated for speed
  17167.     iny
  17168.     bne    fill8b        ; crossed page boundry?
  17169.     inc    dest+1
  17170. fill8b:    dex            ; anything more to fill?
  17171.     bne    fill8a        ; yes, fill it.
  17172.     rts
  17173.  
  17174. ;
  17175. ;    Case - Pascal like case function
  17176. ;
  17177. ;    Input: Y - Case statement to select
  17178. ;               The addresses of the routines to select are compiled inline
  17179. ;
  17180. ;    Registers Destroyed: X, Y
  17181. ;
  17182. ;    this routine transfers controll to a routine selected by the Y register
  17183. ;
  17184.  
  17185. case:    tax            ; preserve a-reg across case statement
  17186.     pla            ; get lo bype of case list
  17187.     sta source        ; save it
  17188.     pla            ; get hi byte of case list
  17189.     sta source+1        ; save it
  17190.     tya            ; put case selector into a-reg
  17191.     sec            ; add one half
  17192.     rol a            ; and multiply by two
  17193.     tay            ; put (2*case_selector)+1 into y-reg
  17194.     lda (source),y        ; get lo byte of routine to go to
  17195.     sta dest        ; save it
  17196.     iny            ; prepare to get hi byte of routines address
  17197.     lda (source),y        ; get hi byte of routines address
  17198.     sta dest+1        ; save it
  17199.     txa            ; preserve a-reg across case statement
  17200.     jmp (dest)        ; go to appropriate
  17201.  
  17202. ;
  17203. ;    powers - powers of 2
  17204. ;
  17205.  
  17206. powers:    .byte    $80
  17207.     .byte    $40
  17208.     .byte    $20
  17209. c10    .byte    $10
  17210. c08    .byte    $08
  17211.     .byte    $04
  17212.     .byte    $02
  17213.     .byte    $01
  17214. c07    .byte    $07
  17215. c0f    .byte   $0F
  17216.  
  17217. anyrts:    rts            ; a handy return from subroutine instruction
  17218. anybrk:    brk            ; a handy break instruction
  17219.  
  17220. end.asm:=    *
  17221.  
  17222. .SBTTL    Data for the screen package
  17223.  
  17224. fast:    .byte    $ff    ; flag for fast mode.  Copied to $d030.
  17225. b80flag:.byte    $ff    ; flag for b80.  set if initializing. clear otherwise
  17226. bordold:.byte    $ff    ; saved bordor color
  17227. line25:    .byte    $ff    ; $01=use 25th line, $00=keep line as blank or sysline
  17228. top:    .byte    $ff    ; top of scrolling area
  17229. bot:    .byte    $ff    ; bottom of scrolling area
  17230. cx:    .byte    $ff    ; cursor x coordinate
  17231. cy:    .byte    $ff    ; cursor y coordinate
  17232. cntdown:.byte    $ff    ; countdown timer
  17233. curabrt:.byte    $ff    ; $00=cursor disabled.  Incremented & decremented.
  17234. curstat:.byte    $ff    ; $00=cursor light now, $01=cursor dark now
  17235. evenodd:.byte    $ff    ; $f0=cursor on even column, $0f=cursor on odd column
  17236. save1:    .byte    $ff    ; screen save area #1
  17237. save2:    .byte    $ff    ; screen save area #2
  17238. save3:    .byte    $ff    ; screen save area #3
  17239. save4:    .byte    $ff    ; screen save area #4
  17240. save5:    .byte    $ff    ; screen save area #5
  17241. save6:    .byte    $ff    ; screen save area #6
  17242. save7:    .byte    $ff    ; screen save area #7
  17243. save8:    .byte    $ff    ; screen save area #8
  17244. save9:    .byte    $ff    ; screen save area #9
  17245.  
  17246. vt100gs    =    8    ; there are seven graphic rendition parameters
  17247. vt100gr    .blkb    vt100gs    ; graphic rendition params for vt100 emulation
  17248. alternt    =    vt100gr+1; $00=normal color, $01=alternate color
  17249. underln    =    vt100gr+4; $00=underline off, $ff=underline on
  17250. flash    =    vt100gr+5; $00=normal text, $01=flashing text
  17251. reverse    =    vt100gr+7; $00=reverse off, $ff=reverse on
  17252.  
  17253. vt100ss    =    10    ; there are nine settable switches
  17254. vt100sw:.blkb    vt100ss    ; vt100 switches
  17255. decckm    =    vt100sw+1; $01=cursor keys in application mode
  17256. decanm    =    vt100sw+2; $01=normal emulation, $00=vt100 emulating vt52
  17257. decrev    =    vt100sw+5; $01=screen reversed, $00=screen normal
  17258. decom    =    vt100sw+6; $01=relative, $00=absolute
  17259. wrap    =    vt100sw+7; $01=automatic wrapping, $00=no automatic wrapping
  17260. decarm    =    vt100sw+8; $01=automatic key repeat, $00=no automatic repeat
  17261. deckpam    .byte    $ff    ; $00 = use numeric keypad, $01=use alternat keypad
  17262. lmn:    .byte    $ff    ; $00 = new line mode clear, $01 = new line mode set
  17263. irm:    .byte    $ff    ; $00 = insert/replace mode = replace, $01 = insert
  17264. g0:    .byte    $ff    ; $00 = U.S. charset on g0, $01 = graphics on g0
  17265. g1:    .byte    $ff    ; $00 = U.S. charset on g1, $01 = graphics on g1
  17266. gx:    .byte    $ff    ; $00 = g0 selected, $01 = g1 selected
  17267.  
  17268. .SBTTL    Data for the key scanner
  17269.  
  17270. keylast:.byte    $ff
  17271. keyrept:.byte    $ff
  17272. keytime:.byte    $ff
  17273. keycol:    .byte    $ff
  17274. keycol1:.byte    $ff
  17275.  
  17276. .SBTTL    Data for the vt100 emulation package
  17277.  
  17278. vt100st:.byte    $ff    ; parser state
  17279. vt100pt:.byte    $ff    ; parameter pointer
  17280. tekmode:.byte    $ff    ; mode of the tektronics PLOT10 command parser
  17281. tekpen:    .byte    $ff    ; $00 = pen up, $01 = pen down
  17282. tekrxlo:.byte    $ff    ; tektronix receive buffer
  17283. tekrxhi:.byte    $ff
  17284. tekrylo:.byte    $ff
  17285. tekryhi:.byte    $ff
  17286. tekcxlo:.byte    $ff    ; tektronix cursor (tektronix format)
  17287. tekcxhi:.byte    $ff
  17288. tekcylo:.byte    $ff
  17289.  
  17290. tekcyhi:.byte    $ff
  17291. tekfxlo:.byte    $ff    ; tektronix 'from point' (screen driver format)
  17292. tekfxhi:.byte    $ff
  17293. tekfylo:.byte    $ff
  17294. tekfyhi:.byte    $ff
  17295. tektxlo:.byte    $ff    ; tektronix 'to point' (screen driver fromat)
  17296. tektxhi:.byte    $ff
  17297. tektylo:.byte    $ff
  17298. tektyhi:.byte    $ff
  17299. tekdxlo:.byte    $ff    ; tektronix 'delta' for line drawing
  17300. tekdxhi:.byte    $ff
  17301. tekdylo:.byte    $ff
  17302. tekdyhi:.byte    $ff
  17303. tekfxul:.byte    $ff    ; ultra-low from point (only used in line drawing)
  17304. tekfyul:.byte    $ff    ; ultra-low from point (only used in line drawing)
  17305. tekdxul:.byte    $ff    ; ultra-low delta point (only used in line drawing)
  17306. tekdyul:.byte    $ff    ; ultra-low delta point (only used in line drawing)
  17307. sftklu:    .byte    $ff
  17308. trtail    .byte    $ff
  17309. trhead    .byte    $ff
  17310. rdtail    .byte    $ff
  17311. rdhead    .byte    $ff
  17312.  
  17313. .SBTTL    Scratch area
  17314.  
  17315. freesiz    =    $20
  17316. freemem:.blkb    freesiz
  17317. tabs:    .blkb    81    ; tab stops
  17318.     .blkb    $100    ; safe and documented area for binary patches.
  17319. cmbuf:  .blkb    $100        ; Input command buffer
  17320. atmbuf:    .blkb    $100        ; Atombuffer, (for cmtxt and cmifil)
  17321. plnbuf: .blkb    $100        ;[DD] Port line buffer
  17322. font40    =    $9000
  17323.  
  17324. ; Memory map of high kermit memory ver 2.2 (76)
  17325. ;
  17326. ;  Kermit code             $0800-$7FE0
  17327. ;  Data Tables             $7FE1-$84A4
  17328. ;  Free Space              $84A5-$86FF
  17329. ;  RS-232 input Buffer    $8700-$87FF
  17330. ;  Second Color Map        $8800-$8BFF
  17331. ;  Primary Color Map    $8C00-$8FFF
  17332. ;  Font40 Definition    $9000-$93F7
  17333. ;  Free Space           $93F8-$97FF
  17334. ;  BI-80 Text Buff??    $9800-$9FCF
  17335. ;  Free Space (???)     $9FD0-$9FFF
  17336. ;  High Res Screen      $A000-$BFFF
  17337. ;  Reserved for MONITOR $C000-$CFFF
  17338. ;  IO Space                $D000-$DFFF
  17339. ;  Kernal                $E000-$FFFF
  17340.