home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c64cross / c64ker.m65 < prev    next >
Text File  |  2020-01-01  |  449KB  |  17,005 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        Be: 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. ;    VERSION 3.0 Starts Here
  461.  
  462. ;
  463. ;  nnn        By: xxxxxxxx xxxxxxxx        On: nn-XXX-19nn
  464. ;        xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  465. ;        xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  466. ;        xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  467. ;
  468. ;+
  469.  
  470. .SBTTL    Define start address for assembly
  471.  
  472.            .=    $801        ; Start assembly at hex 801
  473.  
  474. .SBTTL    BASIC start sequence   10 SYS(2064)
  475.  
  476. basic:    .byte    $0D,$08,$0A,$00        ; Line 10 in BASIC
  477.     .byte    $9E            ; SYS
  478.     .byte    "(2064)"        ;
  479.     .byte    $00,$00,$00        ; end of line
  480.  
  481.     .byte    $00
  482.  
  483.         .=    $810
  484.  
  485. .SBTTL    Jump to start of code
  486.  
  487. kst:    jmp    kstart        ; Go past the data to the beginning of the code
  488.  
  489. .SBTTL    Macro definitions
  490.  
  491. ; Macro to open a file
  492. ; [53] as6502 will not handle macros.  Macros have been expanded.
  493. ; .macro    openm,p1,p2,p3,p4,p5     ;lun,dv,sa,fnm,len
  494. ;     lda     p1    
  495. ;     ldx     p2
  496. ;     ldy     p3
  497. ;     jsr    setlfs
  498. ;     ldx    #p4\
  499. ;     ldy    #p4^
  500. ;     lda    p5
  501. ;     jsr    setnam
  502. ;     jsr    open
  503. ; .endm
  504.  
  505. .SBTTL    C64 kernel entry points
  506.  
  507. acptr    =    $ffa5        ;[42] Get byte from serial bus
  508. chkin    =    $ffc6        ; change kernel input channel
  509. chkout    =    $ffc9        ; change kernel output channel
  510. chrin    =    $ffcf        ; input a character
  511. chrout    =    $ffd2        ; output a character
  512. cint    =    $ff81        ;[EL] initialize screen editor
  513. ciout    =    $ffa8        ;[42] Output byte to serial port
  514. clall    =    $ffe7        ; close all channels and files
  515. close    =    $ffc3        ; close a channel
  516. clrchn    =    $ffcc        ; close input and output channel
  517. getin    =    $ffe4        ; input a character
  518. ioinit    =    $ff84        ;[EL] initialize I/O devices
  519. load    =    $ffd5        ;[42] Load RAM from a device
  520. open    =    $ffc0        ; open a channel
  521. plot    =    $fff0        ; fetch/set cursor position (40 col)
  522. ramtas    =    $ff87        ;[EL] init RAM, tape buffer, screen memory
  523. readst    =    $ffb7        ; read I/O status
  524. restoi    =    $ff8a        ;[EL] restore default I/O vectors
  525. rdtim    =    $ffde        ; read the builtin timer
  526. save    =    $ffd8        ;[42] Save RAM to device
  527. setlfs    =    $ffba        ;[EL] set open parameters
  528. setnam    =    $ffbd        ;[EL] set filename
  529. stop    =    $ffe1        ; Check if STOP key is pressed
  530. talk    =    $ffb4        ;[42] Send serial bus talk
  531. tksa    =    $ff96        ;[42] Send secondary address after talk
  532. untalk    =    $ffab        ;[42] Send serial bus untalk
  533.  
  534. dos    =    $a002        ; BASIC NMI vector
  535.  
  536. .SBTTL    Character and string definitions
  537.  
  538. nul    =    $00        ; <null>
  539. soh    =    $01        ; <soh>
  540. bs    =    $08        ; <bs>
  541. tab    =    $09        ; <tab> (ctrl/I)
  542. lf    =    $0a        ; <lf>
  543. ffd    =    $0c        ; Form feed
  544. cr    =    $0d        ; <cr>
  545. ctrlu    =    $15        ; <ctrl/U>
  546. ctrlx    =    $18        ; <ctrl/X>
  547. ctrly    =    $19        ; <ctrl/Y>
  548. esc    =    $1b        ; <esc>
  549. sp    =    $20        ; <space>
  550. space    =    $20        ; """"
  551. del    =    $7f        ; <del>
  552. cdel    =    $14        ; commodore del
  553. quest    =    $3F        ; <?>
  554. ctrlw    =    $17        ; <ctrl/W>
  555. dquot    =    $22        ; '"'        ?
  556. quot    =    $27        ; "'"        ?
  557. slash    =    $2f        ; '/'        ?
  558. apos    =    quot        ; "'"        ?
  559. rabr    =    $3e        ; '>'        ?
  560. colon    =    $3a        ; ':'        ?
  561.  
  562. .SBTTL    Commodore I/O addresses
  563.  
  564. vicbank =    $8000        ; vic bank select (remember -- rom present)
  565. victext =    $a000        ; 40 column and 80 column bit map area
  566. vicclr1    =    $8c00        ; primary color area
  567. vicclr2    =    $8800        ; secondary color area
  568. vicmsk    =    %00000111    ; info to set up vic chip to use this memory
  569. vicdat1    =    %00111000    ;        ""
  570. vicdat2    =    %00101000    ;        ""
  571. vicswap    =    %00010000
  572. vicnorm    =    %00010000    ;        ""
  573.  
  574. freqhi    =    $d401        ;[EL] sid frequency (high byte)
  575. attdec    =    $d405        ;[EL] sid attack/decay
  576. susrel    =    $d406        ;[EL] sid sustain/release
  577. vol    =    $d418        ;[EL] sid volume
  578. wave    =    $d404        ;[EL] sid waveform select
  579.  
  580. .SBTTL    Commodore-128 8563 addresses
  581.  
  582. chr8563    =    $2000
  583. txt8563    =    $0000
  584. alt8563    =    $0800
  585. pad8563    =    $1000
  586.  
  587. .SBTTL    Batteries Included 80-column screen addresses
  588.  
  589. b80text    =    $9800
  590.  
  591. ch    =    $d3        ;Cursor Horizontal position (col)
  592. cv    =    $d6        ;Cursor Vertical position (row)
  593. basl    =    $d1        ;L.O. byte of base address of current line
  594. bash    =    $d2        ;H.O. byte of base address of current line
  595. bas2l    =    $50        ;Base address work area
  596. bas2h    =    $51        ;Base address work area
  597. source    =    $fb        ;[19] indirect address to be read
  598. dest    =    $fd        ;[19] indirect address to be stored
  599. pnth    =    $71        ;[19][41] hires screen pntr (^cassette buffer)
  600. ndx    =    $c6        ;[EL] number of keyboard bytes pending
  601. r6510    =    $01        ;[EL] Memory control register for 6510 
  602. ribuf    =    $f7        ;[19] rs-232 input buffer pointer (2-byte)
  603. robuf    =    $f9        ;[19] rs-232 ouput buffer pointer (2-byte)
  604. bitci    =    $a8        ;[19] rs-232 input bit count
  605. enabl    =    $2a0        ; rs-232 operations in progress
  606. clock    =    $a0        ;[EL] Jiffy clock (3-byte)
  607. ldtb1    =    $d9        ;[19] Editor line link table (40 col)
  608. qtsw    =    $d4        ;[EL] quote-mode switch (40 col)
  609.  
  610. ridbe    =    $29b        ;[EL] RS-232 index to end of input buffer
  611. ridbs    =    $29c        ;[EL] RS-232 index to start of input buffer
  612. shflag    =    $28d        ;[EL] shift key flags (commodore key = bit 1)
  613. hibase    =    $288        ;[EL] video matrix page number (40 col)
  614. color    =    $286        ;[EL] 40 column foreground color
  615.  
  616. rsout    =    $9000        ;[24] address of rs-232 output buffer
  617. rsin    =    $9100        ;[24] address of rs-232 input buffer
  618.  
  619. char:    .byte    $00        ;[26] Character just read
  620. stat:    .byte    $00        ;[33] RS232 status byte
  621. lpcnt:    .byte    $00        ;[EL] cursor blink counter
  622. lineh:    .byte    $00        ;[19] hires cursor line number
  623. colh:    .byte    $00        ;[19] hires cursor column number
  624. hilo:    .byte    $f0        ;[19] hires nibble mask
  625. rvmask:    .byte    $00        ;[19] reverse video mask ($f=rev, $0=normal)
  626. cflag:    .byte    $ff        ;[19] 0 if char under cursor has been reversed
  627. cstate:    .byte    $00        ;[19] top nibble of char und. cursor if cflag=0
  628. flag79:    .byte    $00        ;[19] non-0 if previous char printed in col 79
  629. fla79:    .byte    $00        ;[19] one shot copy of previous flag79
  630. suspend:.byte    $00        ;[24] RS-232 reads suspended if non-zero
  631. fxoff:    .byte    $00        ;[24] Xoff has been sent if non-zero
  632. commflg:.byte    $00        ;[24] non-zero if commodore key is depressed
  633.  
  634. .SBTTL    Translation and Font Tables
  635.  
  636. ;     ASCII/PETSCII Translation Tables
  637.  
  638. ;    Pt2as - PETSCII to ASCII
  639.  
  640. pt2as:    .byte    $00    ;[31] ^@ NUL
  641.     .byte    $01    ;[31] ^A SOH
  642.     .byte    $02    ;[31] ^B 
  643.     .byte    $03    ;[31] ^C 
  644.     .byte    $04    ;[31] ^D 
  645.     .byte    $05    ;[31] ^E 
  646.     .byte    $06    ;[31] ^F 
  647.     .byte    $07    ;[31] ^G BEL
  648.     .byte    $08    ;[31] ^H BS
  649.     .byte    $09    ;[31] ^I TAB
  650.     .byte    $0a    ;[31] ^J LF
  651.     .byte    $0b    ;[31] ^K 
  652.     .byte    $0c    ;[31] ^L FF
  653.     .byte    $0d    ;[31] ^M CR
  654.     .byte    $0e    ;[31] ^N 
  655.     .byte    $0f    ;[31] ^O 
  656.     .byte    $10    ;[31] ^P 
  657.     .byte    $11    ;[31] ^Q 
  658.     .byte    $12    ;[31] ^R 
  659.     .byte    $13    ;[31] ^S 
  660.     .byte    $14    ;[31] ^T
  661.     .byte    $15    ;[31] ^U 
  662.     .byte    $16    ;[31] ^V 
  663.     .byte    $17    ;[31] ^W 
  664.     .byte    $18    ;[31] ^X 
  665.     .byte    $19    ;[31] ^Y 
  666.     .byte    $1a    ;[31] ^Z 
  667.     .byte    $1b    ;[31] ^[ 
  668.     .byte    $1c    ;[31] ^\ 
  669.     .byte    $1d    ;[31] ^] 
  670.     .byte    $1e    ;[31] ^^ 
  671.     .byte    $1f    ;[31] ^_ 
  672.     .byte    $20    ;[31] SPACE
  673.     .byte    '!    ;[31] ! 
  674.     .byte    '"    ;[31] " 
  675.     .byte    '#    ;[31] # 
  676.     .byte    '$    ;[31] $ 
  677.     .byte    '%    ;[31] % 
  678.     .byte    '&    ;[31] & 
  679.     .byte    ''    ;[31] ' 
  680.     .byte    '(    ;[31] ( 
  681.     .byte    ')    ;[31] ) 
  682.     .byte    '*    ;[31] * 
  683.     .byte    '+    ;[31] + 
  684.     .byte    ',    ;[31] , 
  685.     .byte    '-    ;[31] - 
  686.     .byte    '.    ;[31] . 
  687.     .byte    '/    ;[31] / 
  688.     .byte    '0    ;[31] 0 
  689.     .byte    '1    ;[31] 1 
  690.     .byte    '2    ;[31] 2 
  691.     .byte    '3    ;[31] 3 
  692.     .byte    '4    ;[31] 4 
  693.     .byte    '5    ;[31] 5 
  694.     .byte    '6    ;[31] 6 
  695.     .byte    '7    ;[31] 7 
  696.     .byte    '8    ;[31] 8 
  697.     .byte    '9    ;[31] 9 
  698.     .byte    ':    ;[31] : 
  699.     .byte    ';    ;[31] ; 
  700.     .byte    '<    ;[31] < 
  701.     .byte    '=    ;[31] = 
  702.     .byte    '>    ;[31] > 
  703.     .byte    '?    ;[31] ? 
  704.     .byte    '@    ;[31] @ 
  705.     .byte    'a    ;[31] a 
  706.     .byte    'b    ;[31] b 
  707.     .byte    'c    ;[31] c 
  708.     .byte    'd    ;[31] d 
  709.     .byte    'e    ;[31] e 
  710.     .byte    'f    ;[31] f 
  711.     .byte    'g    ;[31] g 
  712.     .byte    'h    ;[31] h 
  713.     .byte    'i    ;[31] i 
  714.     .byte    'j    ;[31] j 
  715.     .byte    'k    ;[31] k 
  716.     .byte    'l    ;[31] l 
  717.     .byte    'm    ;[31] m 
  718.     .byte    'n    ;[31] n 
  719.     .byte    'o    ;[31] o 
  720.     .byte    'p    ;[31] p 
  721.     .byte    'q    ;[31] q 
  722.     .byte    'r    ;[31] r 
  723.     .byte    's    ;[31] s 
  724.     .byte    't    ;[31] t 
  725.     .byte    'u    ;[31] u 
  726.     .byte    'v    ;[31] v 
  727.     .byte    'w    ;[31] w 
  728.     .byte    'x    ;[31] x 
  729.     .byte    'y    ;[31] y 
  730.     .byte    'z    ;[31] z 
  731.     .byte    '[    ;[31] [ 
  732.     .byte    '\    ;[31] \ 
  733.     .byte    ']    ;[31] ] 
  734.     .byte    '^    ;[31] ^ 
  735.     .byte    '_    ;[31] _
  736.     .byte    $60    ;[31] 
  737.     .byte    'A    ;[31] A
  738.     .byte    'B    ;[31] B
  739.     .byte    'C    ;[31] C
  740.     .byte    'D    ;[31] D 
  741.     .byte    'E    ;[31] E 
  742.     .byte    'F    ;[31] F 
  743.     .byte    'G    ;[31] G 
  744.     .byte    'H    ;[31] H 
  745.     .byte    'I    ;[31] I 
  746.     .byte    'J    ;[31] J 
  747.     .byte    'K    ;[31] K 
  748.     .byte    'L    ;[31] L 
  749.     .byte    'M    ;[31] M 
  750.     .byte    'N    ;[31] N 
  751.     .byte    'O    ;[31] O 
  752.     .byte    'P    ;[31] P 
  753.     .byte    'Q    ;[31] Q 
  754.     .byte    'R    ;[31] R 
  755.     .byte    'S    ;[31] S 
  756.     .byte    'T    ;[31] T 
  757.     .byte    'U    ;[31] U 
  758.     .byte    'V    ;[31] V 
  759.     .byte    'W    ;[31] W 
  760.     .byte    'X    ;[31] X 
  761.     .byte    'Y    ;[31] Y 
  762.     .byte    'Z    ;[31] Z 
  763.     .byte    '{    ;[31] { 
  764.     .byte    '|    ;[31] | 
  765.     .byte    '}    ;[31] } 
  766.     .byte    '~    ;[31] ~ 
  767.     .byte    $7f    ;[31] DEL
  768.     .byte    '?    ;[31] illegal
  769.     .byte    '?    ;[31]
  770.     .byte    '?    ;[31]
  771.     .byte    '?    ;[31]
  772.     .byte    '?    ;[31]
  773.     .byte    '?    ;[31]
  774.     .byte    '?    ;[31]
  775.     .byte    '?    ;[31]
  776.     .byte    '?    ;[31]
  777.     .byte    '?    ;[31]
  778.     .byte    '?    ;[31]
  779.     .byte    '?    ;[31]
  780.     .byte    '?    ;[31]
  781.     .byte    '?    ;[31]
  782.     .byte    '?    ;[31] illegal
  783.     .byte    '?    ;[31] illegal
  784.     .byte    '?    ;[31] illegal
  785.     .byte    '?    ;[31] illegal
  786.     .byte    '?    ;[31] illegal
  787.     .byte    '?    ;[31] illegal
  788.     .byte    '?    ;[31] illegal
  789.     .byte    '?    ;[31] illegal
  790.     .byte    '?    ;[31] illegal
  791.     .byte    '?    ;[31] illegal
  792.     .byte    '?    ;[31] illegal
  793.     .byte    '?    ;[31] illegal
  794.     .byte    '?    ;[31] illegal
  795.     .byte    '?    ;[31] illegal
  796.     .byte    '?    ;[31] illegal
  797.     .byte    '?    ;[31] illegal
  798.     .byte    '?    ;[31] illegal
  799.     .byte    '?    ;[31] illegal
  800.     .byte    '?    ;[31] illegal
  801.     .byte    '?    ;[31] illegal
  802.     .byte    '?    ;[31] illegal
  803.     .byte    '?    ;[31] illegal
  804.     .byte    '?    ;[31] illegal
  805.     .byte    '?    ;[31] illegal
  806.     .byte    '?    ;[31] illegal
  807.     .byte    '?    ;[31] illegal
  808.     .byte    '?    ;[31] illegal
  809.     .byte    '?    ;[31] illegal
  810.     .byte    '?    ;[31] illegal
  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    'A    ;[31] A from A key (dup)
  834.     .byte    'B    ;[31] B from B key (dup)
  835.     .byte    'C    ;[31] C from C key (dup)
  836.     .byte    'D    ;[31] D from D key (dup)
  837.     .byte    'E    ;[31] E from E key (dup)
  838.     .byte    'F    ;[31] F from F key (dup)
  839.     .byte    'G    ;[31] G from G key (dup)
  840.     .byte    'H    ;[31] H from H key (dup)
  841.     .byte    'I    ;[31] I from I key (dup)
  842.     .byte    'J    ;[31] J from J key (dup)
  843.     .byte    'K    ;[31] K from K key (dup)
  844.     .byte    'L    ;[31] L from L key (dup)
  845.     .byte    'M    ;[31] M from M key (dup)
  846.     .byte    'N    ;[31] N from N key (dup)
  847.     .byte    'O    ;[31] O from O key (dup)
  848.     .byte    'P    ;[31] P from P key (dup)
  849.     .byte    'Q    ;[31] Q from Q key (dup)
  850.     .byte    'R    ;[31] R from R key (dup)
  851.     .byte    'S    ;[31] S from S key (dup)
  852.     .byte    'T    ;[31] T from T key (dup)
  853.     .byte    'U    ;[31] U from U key (dup)
  854.     .byte    'V    ;[31] V from V key (dup)
  855.     .byte    'W    ;[31] W from W key (dup)
  856.     .byte    'X    ;[31] X from X key (dup)
  857.     .byte    'Y    ;[31] Y from Y key (dup)
  858.     .byte    'Z    ;[31] Z from Z key (dup)
  859.     .byte    '{    ;[31] { from SHIFT/+ key (dup)
  860.     .byte    '|    ;[31] | from ????? (dup)
  861.     .byte    '}    ;[31] } from SHIFT/- key (dup)
  862.     .byte    '~    ;[31] ~ from SHIFT/^ key (dup)
  863.     .byte    $7f    ;[31] DEL from ?????
  864.     .byte    $20    ;[31] SPACE from SHIFT/SPACE key (dup)
  865.     .byte    '?    ;[31] illegal
  866.     .byte    '?    ;[31] illegal
  867.     .byte    '?    ;[31] illegal
  868.     .byte    '?    ;[31] illegal
  869.     .byte    '?    ;[31] illegal
  870.     .byte    '?    ;[31] illegal
  871.     .byte    '?    ;[31] illegal
  872.     .byte    '?    ;[31] illegal
  873.     .byte    '?    ;[31] illegal
  874.     .byte    '?    ;[31] illegal
  875.     .byte    '?    ;[31] illegal
  876.     .byte    '?    ;[31] illegal
  877.     .byte    '?    ;[31] illegal
  878.     .byte    '?    ;[31] illegal
  879.     .byte    '?    ;[31] illegal
  880.     .byte    '?    ;[31] illegal
  881.     .byte    '?    ;[31] illegal
  882.     .byte    '?    ;[31] illegal
  883.     .byte    '?    ;[31] illegal
  884.     .byte    '?    ;[31] illegal
  885.     .byte    '?    ;[31] illegal
  886.     .byte    '?    ;[31] illegal
  887.     .byte    '?    ;[31] illegal
  888.     .byte    '?    ;[31] illegal
  889.     .byte    '?    ;[31] illegal
  890.     .byte    '?    ;[31] illegal
  891.     .byte    '?    ;[31] illegal
  892.     .byte    '?    ;[31] illegal
  893.     .byte    '?    ;[31] illegal
  894.     .byte    '?    ;[31] illegal
  895.     .byte    '?    ;[31] illegal
  896.  
  897. ;    As2pt - ASCII to PETSCII
  898.  
  899. as2pt:    .byte    $00    ;[31] NUL
  900.     .byte    $01    ;[31] ^A 
  901.     .byte    $02    ;[31] ^B 
  902.     .byte    $03    ;[31] ^C 
  903.     .byte    $04    ;[31] ^D 
  904.     .byte    $05    ;[31] ^E 
  905.     .byte    $06    ;[31] ^F 
  906.     .byte    $07    ;[31] BEL
  907.     .byte    $08    ;[31] BS
  908.     .byte    $09    ;[31] TAB
  909.     .byte    $0a    ;[31] NL
  910.     .byte    $0b    ;[31] ^K 
  911.     .byte    $0c    ;[31] ^L 
  912.     .byte    $0d    ;[31] CR 
  913.     .byte    $0e    ;[31] ^N 
  914.     .byte    $0f    ;[31] ^O 
  915.     .byte    $10    ;[31] ^P 
  916.     .byte    $11    ;[31] ^Q 
  917.     .byte    $12    ;[31] ^R 
  918.     .byte    $13    ;[31] ^S 
  919.     .byte    $14    ;[31] ^T 
  920.     .byte    $15    ;[31] ^U 
  921.     .byte    $16    ;[31] ^V 
  922.     .byte    $17    ;[31] ^W 
  923.     .byte    $18    ;[31] ^X 
  924.     .byte    $19    ;[31] ^Y 
  925.     .byte    $1a    ;[31] ^Z 
  926.     .byte    $1b    ;[31] ^[ 
  927.     .byte    $1c    ;[31] ^\ 
  928.     .byte    $1d    ;[31] ^] 
  929.     .byte    $1e    ;[31] ^^ 
  930.     .byte    $1f    ;[31] ^_ 
  931.     .byte    $20    ;[31] SPACE
  932.     .byte    $21    ;[31] ! 
  933.     .byte    $22    ;[31] " 
  934.     .byte    $23    ;[31] # 
  935.     .byte    $24    ;[31] $ 
  936.     .byte    $25    ;[31] % 
  937.     .byte    $26    ;[31] & 
  938.     .byte    $27    ;[31] ' 
  939.     .byte    $28    ;[31] ( 
  940.     .byte    $29    ;[31] ) 
  941.     .byte    $2a    ;[31] * 
  942.     .byte    $2b    ;[31] + 
  943.     .byte    $2c    ;[31] , 
  944.     .byte    $2d    ;[31] - 
  945.     .byte    $2e    ;[31] . 
  946.     .byte    $2f    ;[31] / 
  947.     .byte    $30    ;[31] 0 
  948.     .byte    $31    ;[31] 1 
  949.     .byte    $32    ;[31] 2 
  950.     .byte    $33    ;[31] 3 
  951.     .byte    $34    ;[31] 4 
  952.     .byte    $35    ;[31] 5 
  953.     .byte    $36    ;[31] 6 
  954.     .byte    $37    ;[31] 7 
  955.     .byte    $38    ;[31] 8 
  956.     .byte    $39    ;[31] 9 
  957.     .byte    $3a    ;[31] : 
  958.     .byte    $3b    ;[31] ; 
  959.     .byte    $3c    ;[31] < 
  960.     .byte    $3d    ;[31] = 
  961.     .byte    $3e    ;[31] > 
  962.     .byte    $3f    ;[31] ? 
  963.     .byte    $40    ;[31] @ 
  964.     .byte    $c1    ;[31][52] A 
  965.     .byte    $c2    ;[31][52] B 
  966.     .byte    $c3    ;[31][52] C 
  967.     .byte    $c4    ;[31][52] D 
  968.     .byte    $c5    ;[31][52] E 
  969.     .byte    $c6    ;[31][52] F 
  970.     .byte    $c7    ;[31][52] G 
  971.     .byte    $c8    ;[31][52] H 
  972.     .byte    $c9    ;[31][52] I 
  973.     .byte    $ca    ;[31][52] J 
  974.     .byte    $cb    ;[31][52] K 
  975.     .byte    $cc    ;[31][52] L 
  976.     .byte    $cd    ;[31][52] M 
  977.     .byte    $ce    ;[31][52] N 
  978.     .byte    $cf    ;[31][52] O 
  979.     .byte    $d0    ;[31][52] P 
  980.     .byte    $d1    ;[31][52] Q 
  981.     .byte    $d2    ;[31][52] R 
  982.     .byte    $d3    ;[31][52] S 
  983.     .byte    $d4    ;[31][52] T 
  984.     .byte    $d5    ;[31][52] U 
  985.     .byte    $d6    ;[31][52] V 
  986.     .byte    $d7    ;[31][52] W 
  987.     .byte    $d8    ;[31][52] X 
  988.     .byte    $d9    ;[31][52] Y 
  989.     .byte    $da    ;[31][52] Z 
  990.     .byte    $5b    ;[31] [ 
  991.     .byte    $5c    ;[31] \ 
  992.     .byte    $5d    ;[31] ] 
  993.     .byte    $5e    ;[31] ^ 
  994.     .byte    $5f    ;[31] _ 
  995.     .byte    $c0    ;[31][52]
  996.     .byte    $41    ;[31] a 
  997.     .byte    $42    ;[31] b 
  998.     .byte    $43    ;[31] c 
  999.     .byte    $44    ;[31] d 
  1000.     .byte    $45    ;[31] e 
  1001.     .byte    $46    ;[31] f 
  1002.     .byte    $47    ;[31] g 
  1003.     .byte    $48    ;[31] h 
  1004.     .byte    $49    ;[31] i 
  1005.     .byte    $4a    ;[31] j 
  1006.     .byte    $4b    ;[31] k 
  1007.     .byte    $4c    ;[31] l 
  1008.     .byte    $4d    ;[31] m 
  1009.     .byte    $4e    ;[31] n 
  1010.     .byte    $4f    ;[31] o 
  1011.     .byte    $50    ;[31] p 
  1012.     .byte    $51    ;[31] q 
  1013.     .byte    $52    ;[31] r 
  1014.     .byte    $53    ;[31] s 
  1015.     .byte    $54    ;[31] t 
  1016.     .byte    $55    ;[31] u 
  1017.     .byte    $56    ;[31] v 
  1018.     .byte    $57    ;[31] w 
  1019.     .byte    $58    ;[31] x 
  1020.     .byte    $59    ;[31] y 
  1021.     .byte    $5a    ;[31] z 
  1022.     .byte    $db    ;[31][52] { 
  1023.     .byte    $dc    ;[31][52] | 
  1024.     .byte    $dd    ;[31][52] } 
  1025.     .byte    $de    ;[31][52] ~ 
  1026.     .byte    $7f    ;[31] DEL
  1027.  
  1028. .SBTTL    Flag definitions
  1029.  
  1030. ;    The following are flags passed in the Y register
  1031.  
  1032. cmfehf    =    1        ;[EL] Extra help available
  1033. cmfdff    =    2        ;[EL] Default value present
  1034.  
  1035. .SBTTL    Parse types
  1036.  
  1037. ;    The following are different items to parse for
  1038.  
  1039. cmini    =    0        ; Token to indicate parser init
  1040. cmkey    =    1        ; Token to parse for keyword
  1041. cmifi    =    2        ; Token to parse for input file
  1042. cmofi    =    3        ; Token to parse for output file
  1043. cmcfm    =    4        ; Token to parse for confirm
  1044. cmnum    =    5        ; Token to parse for a number
  1045. cmswi    =    6        ; Token to parse for a switch
  1046. cmfls    =    7        ; Token to parse for a floating-point number
  1047. cmtxt    =    8        ; Token to parse for an unquoted string
  1048. cmtok    =    9        ; Token to parse for a single char token
  1049.  
  1050. .SBTTL    Parser support
  1051.  
  1052. ;  Define storage for pointers into command buffer. They must be
  1053. ;  on zero-page to take advantage of pre- and post-indexed indirect
  1054. ;  and also the simulated indirect addressing mode.
  1055.  
  1056. saddr    =    $20        ; Saved string address - must be on page zero
  1057. cm.rty  =    $22        ; Byte pointer to CTRL/R Text
  1058. cm.bfp  =    $04        ; Byte pointer to start of text buffer
  1059. cm.ptr  =    $06        ; Byte pointer to Next Input to be parsed
  1060. cm.inc  =    $08        ; Number of characters left in buffer
  1061. cm.cnt  =    $09        ; Space left in buffer
  1062. cminf1  =    $0a        ; Information passed to comnd routines
  1063. cminf2  =    $0c        ;        ...
  1064. cmdptr    =    cminf2        ; Pointer to default for parse
  1065. cmkptr  =    $0e        ; Pointer for Cmkeyw routine
  1066. cmsptr  =    $10        ; Saved character pointer
  1067. cmspt2  =    $12        ; Saved keyword table pointer
  1068. cmspt3  =    $14        ; Saved buffer pointer
  1069. cmhptr  =    $24        ; Ptr. to current help text
  1070. cmptab  =    $26        ; Ptr. to beginning of current keyword table
  1071. cmfcb    =    $1a        ; Pointer to FCB
  1072. cmehpt    =    $1c        ; Pointer to help commands
  1073.  
  1074. .SBTTL    COMND package entry points
  1075.  
  1076. ;
  1077. ;    The following addresses are locations in a jump table which
  1078. ;    dispatch to appropriate routines in the Comnd package.
  1079. ;
  1080.  
  1081. mul16    =    comnd+3        ; 16-bit multiply routine
  1082. prcrlf    =    mul16+3        ; Routine to print a crelf
  1083. prstr    =    prcrlf+3    ; Routine to print an ASCIZ string
  1084. rskp    =    prstr+3        ; Routine to skip 3 bytes on return
  1085. setbrk    =    rskp+3        ; Routine to set a break char in brkwrd
  1086. rstbrk    =    setbrk+3    ; Routine to reset break char in brkwrd
  1087.  
  1088. .SBTTL    COMND JSYS routines
  1089.  
  1090. ;
  1091. ;    The following set of routines provides a user oriented way of parsing
  1092. ;    commands. It is similar to that of the COMND JSYS in TOPS-20. For
  1093. ;    convenience, a dispatch table is used.
  1094. ;
  1095.  
  1096. comnd:  jmp    comand        ;  Dispatch to main command routine
  1097.     jmp    ml16        ;  Dispatch to 16-bit multiply routine
  1098.     jmp    prcl.0        ;  Dispatch to Prcrlf
  1099.     jmp    prst.0        ;  Dispatch to Prstr
  1100.     jmp    rskp.0        ;  Dispatch to Rskp
  1101.     jmp    sbrk.0        ;  Dispatch to Setbrk
  1102.     jmp    rbrk.0        ;  Dispatch to Rstbrk
  1103.  
  1104. .SBTTL      Storage Declarations
  1105.  
  1106. ;
  1107. ;    Following is the storage decalarations for the Comnd routines
  1108. ;
  1109.  
  1110. ;
  1111. ;    cmbuf and atmbuf have been moved to the end so that the text
  1112. ;    segment does not fall below $8000.  The BI-80 card puts its own
  1113. ;    rom at $8000
  1114. ;cmbuf: .blkb    $100        ; Input command buffer
  1115. ;atmbuf:.blkb    $100        ; Atombuffer, (for cmtxt and cmifil)
  1116. lenabf:    .byte            ; Length of atom in Atombuffer
  1117. brkwrd:    .blkb    $16        ; Break mask
  1118. savea:  .byte            ;
  1119. savex:  .byte            ;
  1120. savey:  .byte            ;
  1121. cmbase: .byte            ; Base of integer to be parsed
  1122. cmmres: .blkb    4        ; Return value from cmmult call
  1123. cmintg: .blkb    4        ; Return value for cminum call
  1124. cmfltp: .blkb    6        ; Return value for cmflot call
  1125. cmflen: .byte            ; Field length
  1126. cmcdrv: .byte            ; Current drive
  1127. cmostp: .word            ; Save area for stack pointer
  1128. cmrprs: .word            ; Reparse address
  1129. cmaflg: .byte            ; Non-zero when an action char has been found
  1130. cmcffl:    .byte    0        ; Non-Zero when previous command failed
  1131. cmfrcf:    .byte    0        ; Non-Zero when signif char has been seen
  1132. cmccnt: .byte            ; Non-zero if a significant char is found
  1133. cmocnt:    .byte            ; Saved length of command buffer
  1134. cmoptr:    .word            ; Saved ptr to command buffer for <ctrl/H>
  1135. cmsflg: .byte            ; Non-zero when the last char was a space
  1136. cmstat: .byte            ; Save area for parse type
  1137. cmprmx:    .byte            ; Hold area for Comnd parameters
  1138. cmprmy:    .byte            ; Hold area for Comnd flags
  1139. cmkyln: .byte            ; Keyword length
  1140. cmtlen: .byte            ; Test length (for ?-prompting)
  1141. cmscrs: .byte            ; Screen output switch
  1142. cmentr: .byte            ; Number of remaining entries in table
  1143. cmehix:    .byte            ; Index to extra help command buffer
  1144. keylen: .byte            ; Keyword length
  1145. cmwrk1: .byte            ; Command processing scratch area
  1146. cmwrk2: .byte            ;
  1147. cmwrk3: .byte            ;
  1148. cmwrk4: .byte            ;
  1149.  
  1150. .SBTTL    Symbol definitions
  1151.  
  1152. ; [53] commented out following section.  Caused extra definition errors in as65
  1153. ; true    =    $01        ; Symbol for true return code
  1154. ; false    =    $00        ; Symbol for false return code
  1155. ; on    =    $01        ; Symbol for value of 'on' keyword
  1156. ; off    =    $00        ; Symbol for value of 'off' keyword
  1157. ; yes    =    $01        ; Symbol for value of 'yes' keyword
  1158. ; no    =    $00        ; Symbol for value of 'no' keyword
  1159.  
  1160. .SBTTL    Prompt subroutine
  1161.  
  1162. ;
  1163. ;    This routine prints the prompt for the program and specifies the
  1164. ;    reparse address.
  1165. ;
  1166. ;        Inputs:        X - L.O. byte address of prompt
  1167. ;                Y - H.O. byte address of prompt
  1168. ;
  1169. ;        Outputs:
  1170. ;
  1171. ;        Registers destroyed:    A,X,Y
  1172. ;
  1173.  
  1174. prompt: pla            ; Get Low order byte of return address
  1175.     sta    cmrprs        ; Save that half of reparse address
  1176.     pla            ; Get High order byte
  1177.     sta    cmrprs+1    ; Save the half
  1178.     pha            ; Restore the return
  1179.     lda    cmrprs        ;  address to
  1180.     pha            ;    the stack
  1181.     clc            ; Clear the carry
  1182.     adc    #$01        ; Increment this address since it is one
  1183.     sta    cmrprs        ;    short of the desired target.
  1184.     lda    cmrprs+1    ; Account for the carry, if any
  1185.     adc    #$00        ;        ...
  1186.     sta    cmrprs+1    ;        ...
  1187.     stx    cm.rty        ; Save the address of the prompt in
  1188.     sty    cm.rty+1    ; pointer to the ctrl/r text
  1189.     tsx            ; Get the stack pointer
  1190.     stx    cmostp        ; Save it for later restoral
  1191.     lda    #cmbuf\        ; Get low order byte of buffer address
  1192.     sta    cm.bfp        ; Init start of text buffer
  1193.     sta    cm.ptr        ; Init next input to be parsed
  1194.     lda    #cmbuf^        ; Get high order byte of buffer address
  1195.     sta    cm.bfp+1    ; H.O. byte of text buffer pointer
  1196.     sta    cm.ptr+1    ; H.O. byte of next input pointer
  1197.     lda    #$00        ; Clear AC
  1198.     sta    cmaflg        ; Clear the flags
  1199.     sta    cmccnt        ;
  1200.     sta    cmsflg        ;
  1201.     jsr    prcrlf        ; Print crlf
  1202.     ldx    cm.rty        ; Get L.O. byte of prompt address to be passed
  1203.     ldy    cm.rty+1    ; Get H.O. byte of prompt address
  1204.     jsr    prstr        ; Print the prompt
  1205.     rts            ; Return
  1206.  
  1207. .SBTTL    Repars routine
  1208.  
  1209. ;
  1210. ;    This routine sets stuff up to reparse the current command
  1211. ;    buffer.
  1212. ;
  1213. ;        Input:
  1214. ;
  1215. ;        Output:        Reinitialize comnd pointers and flags
  1216. ;
  1217. ;        Registers destroyed:    A,X
  1218. ;
  1219.  
  1220. repars: ldx    cmostp        ; Fetch old Stack pointer
  1221.     txs            ; Make it the current one
  1222.     lda    #cmbuf\        ; Get L.O. byte address of cmbuf
  1223.     sta    cm.ptr        ; Stuff it
  1224.     lda    #cmbuf^        ; Get H.O. byte address of cmbuf
  1225.     sta    cm.ptr+1    ; The buffer pointer is now reset
  1226.     lda    #$00        ; Clear AC
  1227.     sta    cmsflg        ; Clear the space flag
  1228.     jmp    (cmrprs)    ; Jump at the reparse address
  1229.  
  1230. .SBTTL    Prserr routine
  1231.  
  1232. ;
  1233. ;    This routine is used when a parsing error occurs. It resets ALL
  1234. ;    of the pointers and flags and then goes to the reparse address.
  1235. ;
  1236. ;        Input:
  1237. ;
  1238. ;        Output:
  1239. ;
  1240. ;        Registers destroyed:
  1241. ;
  1242.  
  1243. prserr:    lda    cm.ptr        ; Store old command line pointer
  1244.     sta    cmoptr        ;        ...
  1245.     lda    cm.ptr+1    ;         ...
  1246.     sta    cmoptr+1    ;         ...
  1247.     lda    cmccnt        ; Store old character count
  1248.     sta    cmocnt        ;        ...
  1249.     lda    #$ff        ; Set the failure flag
  1250.     sta    cmcffl        ;        ...
  1251.     ldx    cmostp        ; Fetch the saved SP
  1252.     txs            ; Make it the current one
  1253.     lda    #cmbuf\        ; Set up the command buffer
  1254.     sta    cm.bfp        ;     address in both the
  1255.     sta    cm.ptr        ;     buffer pointer and the 
  1256.     lda    #cmbuf^        ;    next input pointer.
  1257.     sta    cm.bfp+1    ;        ...
  1258.     sta    cm.ptr+1    ;        ...
  1259.     lda    #$00        ; Clear AC
  1260.     sta    cmaflg        ; Zero the action flag
  1261.     sta    cmccnt        ;    the character count
  1262.     sta    cmsflg        ;    and the space flag
  1263.     jsr    prcrlf        ; Print a crelf
  1264.     ldx    cm.rty        ;  Get the address of the prompt
  1265.     ldy    cm.rty+1    ;        ...
  1266.     jsr    prstr        ; Reprint the prompt
  1267.     jmp    (cmrprs)    ; Jump at the reparse address
  1268.  
  1269. .SBTTL    COMND - Entry point for command Jsys stuff
  1270.  
  1271. ;
  1272. ;    COMND routine - This routine checks the code in the AC for
  1273. ;    what parse type is wanted and then dispatches to an appropriate
  1274. ;    routine to look for it. Additional information is located in
  1275. ;    CMINF1 and CMINF2 on page zero.
  1276. ;
  1277. ;        Input:        A - parse type
  1278. ;                X,Y - optional parameters
  1279. ;
  1280. ;        Output:        A - +1 = success
  1281. ;                    +4 = failure (assumes JMP after call)
  1282. ;
  1283. ;        Registers destroyed:    A
  1284. ;
  1285.  
  1286. comand: sta    cmstat        ; Save what we are parsing
  1287.     stx    cmprmx        ; Save these parameters also
  1288.     sty    cmprmy        ;        ...
  1289.     cmp    #cmini        ; Initialize the world?
  1290.     bne    comn0        ; No, handle like a normal parse type
  1291.     jmp    prompt        ; Do the prompt routine to set things up
  1292. comn0:  jsr    cminbf        ; Get characters until action or erase
  1293.     cmp    #cmcfm        ; Parse a confirm?
  1294.     bne    comn1        ; Nope
  1295.     jmp    cmcfrm        ; Yes, try for the confirm
  1296. comn1:  cmp    #cmkey        ; Parse a keyword perhaps?
  1297.     bne    comn2        ; No, next item
  1298.     jmp    cmkeyw        ; Get the keyword
  1299. comn2:  cmp    #cmifi        ; Parse an input file?
  1300.     bne    comn3        ; No, try next one
  1301.     jmp    cmifil        ; Get the input file
  1302. comn3:  cmp    #cmofi        ; Parse an output file?
  1303.     bne    comn4        ; No, try next
  1304.     jmp    cmofil        ; Get the output file
  1305. comn4:  cmp    #cmswi        ; Parse a switch?
  1306.     bne    comn5        ; No, try next again
  1307.     jmp    cmswit        ; Yes, do a switch
  1308. comn5:  cmp    #cmnum        ; Parse an integer?
  1309.     bne    comn6        ; No, try next type
  1310.     jmp    cminum        ; Do the parse integer routine
  1311. comn6:  cmp    #cmfls        ; Parse a floating point?????
  1312.     bne    comn7        ; Nope, thats it for types
  1313.     jmp    cmflot        ; Yes, go get a floating point number
  1314. comn7:    cmp    #cmtxt        ;  Parse for an unquoted string?
  1315.     bne    comn8        ;  Nope, go try last type
  1316.     jmp    cmunqs        ;  Go parse the string
  1317. comn8:    cmp    #cmtok        ;  Parse for a single character?
  1318.     bne    comn9        ;  Nope, no more parse types
  1319.     jmp    cmtokn        ;  Go parse for char
  1320. comn9:  ldx    #cmer00\    ; Error 0 - Bad parse type
  1321.     ldy    #cmer00^
  1322.     jsr    prstr        ; Print the error text
  1323.     lda    #$04        ; Fail
  1324.     rts            ; Return to caller
  1325.  
  1326. .SBTTL    Cmcfrm routine - get a confirm
  1327.  
  1328. ;
  1329. ;    This routine tries to get a confirm from the command input
  1330. ;    buffer.
  1331. ;
  1332. ;        Input:  Cm.ptr  - Beginning of next field to be parsed
  1333. ;
  1334. ;        Output: On success, routine skip returns
  1335. ;
  1336. ;        Registers destroyed:    A,X,Y
  1337. ;
  1338.  
  1339. cmcfrm: lda    cm.ptr        ; Save the current comand line pointer
  1340.     pha            ;    on the stack in case the user
  1341.     lda    cm.ptr+1    ;    wants to parse for an alternate item
  1342.     pha            ;
  1343. cmcfr0: jsr    cmgtch        ; Get a character
  1344.     cmp    #$00        ; Is it negative?
  1345.     bpl    cmcfrr        ; No, fail
  1346.     and    #$7f        ; Yes, zero the sign bit
  1347.     cmp    #esc        ; An escape?
  1348.     bne    cmcfr2        ; No, continue
  1349.     jsr    bell        ; Sound bell, er
  1350.     lda    #$00        ; Clear AC
  1351.     sta    cmaflg        ; Clear the action flag
  1352.     sec            ; Set carry for subtraction
  1353.     lda    cm.bfp        ; Get L.O. byte
  1354.     sbc    #$01        ; Decrement it once
  1355.     sta    cm.bfp        ; Store it back
  1356.     sta    cm.ptr        ; Make this pointer look like the other one
  1357.     bcs    cmcfr1        ; If set, we don't have to do H.O. byte
  1358.     dec    cm.bfp+1    ; Adjust H.O. byte
  1359. cmcfr1: lda    cm.bfp+1    ; Move this to H.O. byte of the other pointer
  1360.     sta    cm.ptr+1
  1361.     dec    cmccnt        ; Decrement the character count
  1362.     jmp    cmcfr0        ; Try again.
  1363. cmcfr2: cmp    #'?        ; User need help??
  1364.     bne    cmcfr3        ; Nope
  1365.     jsr    cout        ; Print the '?'
  1366.     ldx    #cmin00\    ; Get address of some help info
  1367.     ldy    #cmin00^    ;
  1368.     jsr    prstr        ; Print it.
  1369.     jsr    prcrlf        ; Print the crelf
  1370.     ldx    cm.rty        ;  Get address of prompt
  1371.     ldy    cm.rty+1    ;
  1372.     jsr    prstr        ; Reprint the prompt
  1373.     lda    #$00        ; Clear AC
  1374.     ldy    #$00        ; Clear Y
  1375.     sta    (cm.ptr),y    ; Drop null at end of command buffer
  1376.     sec            ; Set carry for subtraction
  1377.     lda    cm.bfp        ; Get L.O. byte
  1378.     sbc    #$01        ; Decrement it
  1379.     sta    cm.bfp        ; Store it back
  1380.     lda    cm.bfp+1    ; Now do H.O. byte
  1381.     sbc    #$00        ;
  1382.     sta    cm.bfp+1    ;
  1383.     ldx    #cmbuf\        ; Get address of the command buffer
  1384.     ldy    #cmbuf^        ;
  1385.     jsr    prstr        ; Reprint the command line
  1386.     lda    #$00        ; Clear AC
  1387.     sta    cmaflg        ; Action flag off
  1388.     jmp    repars        ; Go reparse the line
  1389. cmcfr3: cmp    #ffd        ; Is it a form feed?
  1390.     bne    cmcfr4        ; Nope
  1391.     jsr    scrclr        ; Yes, blank the screen
  1392. cmcfr4: pla            ; Since this succeeded, we can flush the
  1393.     pla            ;    old command line pointer
  1394.     lda    #$00        ;  Reset the failure flag
  1395.     sta    cmcffl        ; 
  1396.     jmp    rskp        ; Do a return skip
  1397.  
  1398. cmcfrr: pla            ;  Restore the old comand line pointer
  1399.     sta    cm.ptr+1    ; 
  1400.     sta    cmoptr+1    ; 
  1401.     pla            ; 
  1402.     sta    cm.ptr        ; 
  1403.     sta    cmoptr        ; 
  1404.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  1405.     sta    cmocnt        ; 
  1406.     lda    #$ff        ;  Set failure
  1407.     sta    cmcffl        ; 
  1408.     rts            ; Return
  1409.  
  1410. .SBTTL    Cmkeyw - Try to parse a keyword next
  1411.  
  1412. ;
  1413. ;    This routine tries to parse a keyword from the table
  1414. ;    pointed to by cminf1. The keywords must be in alphabetical
  1415. ;    order. The routine returns the two bytes of data associated
  1416. ;    with the keyword. The format of the table is as follows:
  1417. ;
  1418. ;    addr:    .byte    n    ; Where n is the # of entries in the table.
  1419. ;        .byte    m    ; m is the size of the next keyword
  1420. ;        .asciz  /string/; keyword ending in a null
  1421. ;        .byte    a,b    ; 16 bits of data related to keyword
  1422. ;
  1423. ;        Input:  Cminf1- Pointer to keyword table
  1424. ;
  1425. ;        Output: X-    byte a
  1426. ;            Y-    byte b
  1427. ;
  1428. ;        Registers destroyed:    A,X,Y
  1429. ;
  1430.  
  1431. cmkeyw: lda    cm.ptr        ; Save the old comand line pointer
  1432.     pha            ;
  1433.     lda    cm.ptr+1
  1434.     pha            ;
  1435.     lda    #$00        ;  Clear the 'real character' flag
  1436.     sta    cmfrcf        ; 
  1437.     lda    cminf1        ; Copy to address of
  1438.     sta    cmptab        ;    the keyword table
  1439.     clc            ; Clear the carry
  1440.     adc    #$01        ; Add one to the addr. (pass the table length)
  1441.     sta    cmkptr        ; Save the keyword pointer (L.O. byte)
  1442.     lda    cminf1+1    ; Get H.O. byte
  1443.     sta    cmptab+1    ; Save a copy of that
  1444.     bcc    cmkey1        ; Carry?
  1445.     adc    #$00        ; Add in the carry for cmkptr
  1446. cmkey1: sta    cmkptr+1    ; Save it
  1447.     ldy    #$00        ; Clear Y
  1448.     lda    (cmptab),y    ; Get the table length
  1449.     sta    cmentr        ; Save number of entries in the table
  1450. cmky10:    jsr    cmgtch        ; Get first character
  1451.     cmp    #$00        ; Was the first character a terminator?
  1452.     bmi    cmky11        ; Yup, the saved pointer does not get decr.
  1453.     sec            ; Make sure saved buffer pointer is correct
  1454.     lda    cm.ptr        ; Now, reset it back one character for later
  1455.     sbc    #$01        ;
  1456.     sta    cm.ptr        ;
  1457.     sta    cmsptr        ;
  1458.     lda    cm.ptr+1    ;
  1459.     sbc    #$00        ;
  1460.     sta    cm.ptr+1    ;
  1461.     sta    cmsptr+1    ;
  1462.     jmp    cmkey2        ; Continue
  1463. cmky11: ldy    cm.ptr        ; Just move the pointer to the save area
  1464.     sty    cmsptr        ;
  1465.     ldy    cm.ptr+1    ;
  1466.     sty    cmsptr+1    ;
  1467.     and    #$7f        ;[EL] ????
  1468.     cmp    #esc        ;  Was the first terminator an escape?
  1469.     beq    cmky12        ;  Yes, handle this
  1470.     jmp    cmkey2        ;  No, continue
  1471. cmky12:    lda    #cmfdff        ;  Is there a default?
  1472.     bit    cmprmy        ;         ...
  1473.     bne    cmky13        ;  Yes, go copy it
  1474.     lda    #$00        ;  Shut the action flag
  1475.     sta    cmaflg        ;         ...
  1476.     jsr    bell        ;  Yes, start by feeping terminal
  1477.     sec            ;  Set the carry bit for subtraction
  1478.     lda    cm.bfp        ;  Take L.O. byte of buffer pointer
  1479.     sbc    #$01        ;  Decrement it (back up before escape)
  1480.     sta    cm.bfp        ;  Store it
  1481.     sta    cm.ptr        ;  And stuff it in next input char pointer
  1482.     bcs    cmkync        ;  If carry is clear, we are done
  1483.     dec    cm.bfp+1    ;  Do the carry on H.O. byte
  1484. cmkync:    lda    cm.bfp+1    ;  Copy this to next char to parse pointer
  1485.     sta    cm.ptr+1    ;         ...
  1486.     jmp    cmky10        ;  Continue by fetching a character again
  1487. cmky13:    lda    #$00        ;  Zero the action flag
  1488.     sta    cmaflg        ;         ...
  1489.     jmp    cmcpdf        ;   Do the copy    
  1490. cmkey2: lda    cmentr        ; Get number of entries left
  1491.     cmp    #$00        ; 0 entries left?
  1492.     bne    cmky21        ; No, go try next entry
  1493.     pla            ; Fetch back to previous comand line pointer
  1494.     sta    cm.ptr+1    ;        ...
  1495.     sta    cmoptr+1    ;        ...
  1496.     pla            ;        ...
  1497.     sta    cm.ptr        ;        ...
  1498.     sta    cmoptr        ;        ...
  1499.     lda    cmccnt        ; Save count in case of <ctrl/H>
  1500.     sta    cmocnt        ;        ...
  1501.     lda    #$ff        ; Set the command-failure flag
  1502.     sta    cmcffl        ;        ...
  1503.     rts
  1504. cmky21: ldy    #$00        ; Clear Y
  1505.     lda    (cmkptr),y    ; Get length of keyword
  1506.     sta    keylen        ; Store it
  1507.     lda    cmkptr        ; Get the new table pointer
  1508.     sta    cmspt2        ;    and save it for later
  1509.     lda    cmkptr+1    ;        ...
  1510.     sta    cmspt2+1    ;        ...
  1511.     inc    cmkptr        ; Increment the L.O. byte once
  1512.     bne    cmkey3        ; If it didn't wrap, there is no carry
  1513.     inc    cmkptr+1    ; There was a carry, add it in.
  1514. cmkey3: dec    keylen        ; Decrement the number of chars. left
  1515.     lda    keylen        ; Get the remaining length
  1516.     cmp    #$ff        ; Have we passed the end
  1517.     bpl    cmk3a        ; No
  1518.     jmp    cmkey5        ; Yes
  1519. cmk3a:  jsr    cmgtch        ; Get a character
  1520.     cmp    #$00        ; Is it a terminator?
  1521.     bmi    cmk3b        ; Yup, it is negative
  1522.     jmp    cmkey4        ; Nope, it's positive
  1523. cmk3b:  and    #$7f        ; Shut off the minus bit
  1524.     cmp    #'?        ; Need any help?
  1525.     bne    cmky31        ; Nope
  1526.     jsr    cout        ; And print the question mark
  1527.     lda    #$00        ; Clear AC
  1528.     sta    cmaflg        ; Clear the action flag
  1529.     lda    cmstat        ; Get saved parse type
  1530.     cmp    #cmswi        ; Are we really doing a switch?
  1531.     beq    cmk3b1        ; Yes, give that message instead
  1532.     ldx    #cmin01\    ; L.O. byte addr of informational message
  1533.     ldy    #cmin01^    ; H.O. byte of addr
  1534.     jmp    cmk3b2        ; Go print the message
  1535. cmk3b1: ldx    #cmin02\    ; Load address of switch message
  1536.     ldy    #cmin02^    ;        ...
  1537. cmk3b2: jsr    prstr        ; Print the message
  1538.     jsr    prcrlf        ; Print a crelf
  1539.     jsr    cmktp        ;    and the valid entries in keyword table
  1540.     jsr    prcrlf        ; Print another crlf
  1541.     lda    #cmfehf        ;  Load extra help flag
  1542.     bit    cmprmy        ;  Test bit
  1543.     beq    cmk3b3        ;  No extra help
  1544.     jsr    cmehlp        ;  Go give extra help
  1545. cmk3b3:    ldx    cm.rty        ; Get  address of prompt
  1546.     ldy    cm.rty+1    ; 
  1547.     jsr    prstr        ; Reprint the prompt
  1548.     lda    #$00        ; Clear AC
  1549.     ldy    #$00        ; Clear Y
  1550.     sta    (cm.ptr),y    ; Stuff a null in the buffer at that point
  1551.     sec            ; Set the carry
  1552.     lda    cm.bfp        ; Get ready to decrement buffer pointer
  1553.     sbc    #$01        ; Subtract it
  1554.     sta    cm.bfp        ; Store it
  1555.     bcs    cmky3a        ; Do we have to account for carry
  1556.     dec    cm.bfp+1    ; Decrement the H.O. byte
  1557. cmky3a: ldx    #cmbuf\        ; Get  address of buffer
  1558.     ldy    #cmbuf^        ;
  1559.     jsr    prstr        ; Reprint the command line
  1560.     jmp    repars        ; Go reparse all of it
  1561. cmky31: cmp    #esc        ; escape character?
  1562.     beq    cmk3c        ; Yup, process it
  1563.     jmp    cmky35        ; Nope.
  1564. cmk3c:  lda    #$00        ; Clear AC
  1565.     sta    cmaflg        ; Clear action flag
  1566.     lda    keylen        ; Save on the stack, the
  1567.     pha            ;    keylength
  1568.     lda    cmentr        ;    number of entries left
  1569.     pha            ;        ...
  1570.     lda    cmkptr        ;    L.O. byte of keyword table pointer
  1571.     pha            ;        ...
  1572.     lda    cmkptr+1    ;    H.O. byte of keyword table pointer
  1573.     pha            ;        ...
  1574.     jsr    cmambg        ; Is it ambiguous?
  1575.      jmp    cmky32        ; Nope
  1576.     lda    #cmfdff        ;  Load the default-present flag
  1577.     bit    cmprmy        ;  Check against flags
  1578.     beq    cmk3d        ;  No, complain to user
  1579.     lda    cmfrcf        ;  Have we seen a real character yet?
  1580.     bne    cmk3d        ;  No, tell user
  1581.     jmp    cmcpdf        ;  Yes, go copy the default
  1582. cmk3d:    jsr    bell        ; Yes, start by feeping terminal
  1583.     sec            ; Set the carry bit for subtraction
  1584.     lda    cm.bfp        ; Take L.O. byte of buffer pointer
  1585.     sbc    #$01        ; Decrement it (back up before escape)
  1586.     sta    cm.bfp        ; Store it
  1587.     sta    cm.ptr        ; And stuff it in next input char pointer
  1588.     bcs    cmky3b        ; If carry is clear, we are done
  1589.     dec    cm.bfp+1    ; Do the carry on H.O. byte
  1590. cmky3b: lda    cm.bfp+1    ; Copy this to the next char to parse pointer
  1591.     sta    cm.ptr+1    ;        ...
  1592.     dec    cmccnt        ; Decrement the character count
  1593.     pla            ;        ...
  1594.     sta    cmkptr+1    ; Restore the keyword table pointer
  1595.     pla            ;        ...
  1596.     sta    cmkptr        ;
  1597.     pla            ;
  1598.     sta    cmentr        ;    Number of entries left in table
  1599.     pla            ;        ...
  1600.     sta    keylen        ;    And the remaining keylength
  1601.     inc    keylen        ; Adjust the keylength to make it correct
  1602.     jmp    cmkey3        ; And go back to try again
  1603. cmky32: ldy    #$00        ; Clear Y
  1604.     sec            ; Set the carry flag
  1605.     lda    cm.bfp        ; Move buffer pointer behind the escape
  1606.     sbc    #$01        ;        ...
  1607.     sta    cm.bfp        ;        ...
  1608.     sta    cm.ptr        ;        ...
  1609.     bcs    cmk32c        ;        ...
  1610.     dec    cm.bfp+1    ; Have to adjust the H.O. byte
  1611. cmk32c: lda    cm.bfp+1    ;        ...
  1612.     sta    cm.ptr+1    ;        ...
  1613.     pla            ; Fetch the old keytable pointer
  1614.     sta    cmkptr+1    ;        ...
  1615.     pla            ;        ...
  1616.     sta    cmkptr        ;        ...
  1617.     pha            ; Now push it back on the stack
  1618.     lda    cmkptr+1    ;        ...
  1619.     pha            ;        ...
  1620. cmky33: lda    (cmkptr),y    ; Get next character
  1621.     cmp    #$00        ; Done?
  1622.     beq    cmky34        ; Yes
  1623.     tax            ; No, hold on to the byte
  1624.     clc            ; Clear the carry flag
  1625.     lda    cmkptr        ; Adjust the keyword pointer up one place
  1626.     adc    #$01        ; Do L.O. byte
  1627.     sta    cmkptr        ; Store it
  1628.     bcc    cmky3c        ; Carry?
  1629.     inc    cmkptr+1    ; Yes, increment H.O. byte
  1630. cmky3c: txa            ; Get the data
  1631.     sta    (cm.ptr),y    ; Stuff it in the buffer
  1632.     clc            ; Clear the carry flag again
  1633.     lda    cm.ptr        ; Get L.O byte of buffer pointer
  1634.     adc    #$01        ; Increment it
  1635.     sta    cm.ptr        ; Store it
  1636.     bcc    cmky3d        ; Carry?
  1637.     inc    cm.ptr+1    ; Increment H.O. byte
  1638. cmky3d: inc    cmccnt        ; Increment character count
  1639.     jmp    cmky33        ; Get next character from table
  1640. cmky34: inc    cmccnt        ; Incrment the character count
  1641.     lda    #$20        ; Clear AC (this is a terminator!)
  1642.     sta    (cm.ptr),y    ; Stuff a null in the buffer
  1643.     ldx    cm.bfp        ; Get L.O. byte of buffer pointer
  1644.     ldy    cm.bfp+1    ;    and H.O byte - save these for later
  1645.     clc            ; Clear carry
  1646.     lda    cm.ptr        ; Increment next char of input pointer
  1647.     adc    #$01        ;        ...
  1648.     sta    cm.ptr        ;        ...
  1649.     sta    cm.bfp        ;        ...
  1650.     bcc    cmky3e        ; Carry?
  1651.     inc    cm.ptr+1    ; Do H.O. byte
  1652. cmky3e: lda    cm.ptr+1    ; Make buffer pointer match next char pointer
  1653.     sta    cm.bfp+1    ;        ...
  1654.     sty    savey        ; Hold y for a bit
  1655.     lda    #$00        ; Put a null in the buffer to terminate string
  1656.     ldy    #$00        ;        ...
  1657.     sta    (cm.ptr),y    ;        ...
  1658.     ldy    savey        ; Get Y value back
  1659.     jsr    prstr        ; Print remainder of keyword
  1660.     pla            ; Restore the
  1661.     sta    cmkptr+1    ;    H.O. byte of keyword table pointer
  1662.     pla            ;        ...
  1663.     sta    cmkptr        ;     L.O. byte of keyword table pointer
  1664.     pla            ;        ...
  1665.     sta    cmentr        ;    Number of entries left in table
  1666.     pla            ;        ...
  1667.     sta    keylen        ;    And the remaining keylength
  1668.     jmp    cmky37        ; Go get some data to return
  1669. cmky35: lda    cmkptr        ; Save on the stack the  keyword table pointer
  1670.     pha            ;
  1671.     lda    cmkptr+1    ;
  1672.     pha            ;        ...
  1673.     lda    keylen        ;    The keylength
  1674.     pha            ;        ...
  1675.     jsr    cmambg        ; Check for ambiguity
  1676.      jmp    cmky36        ; Not ambiguous
  1677.     ldx    #cmer01\    ; Get addr of ambiguous error
  1678.     ldy    #cmer01^    ;        ...
  1679.     jsr    prstr        ; Print the error message
  1680.     jmp    prserr        ; Go do parsing error stuff
  1681. cmky36: pla            ; Fetch off of the stack 
  1682.     sta    keylen        ;    remaining keylength
  1683.     pla            ;        ...
  1684.     sta    cmkptr+1    ;    H.O. byte of keyword table address
  1685.     pla            ;        ...
  1686.     sta    cmkptr        ;     L.O. byte of keyword table address
  1687. cmky37: inc    keylen        ; Adjust the remaining keylength
  1688.     inc    keylen        ;        ...
  1689.     clc            ; Clear the carry flag
  1690.     lda    cmkptr        ; Get the keyword table pointer
  1691.     adc    keylen        ; Add in remaining keylength
  1692.     sta    cmkptr        ; Store it
  1693.     bcc    cmky3f        ; Carry?
  1694.     inc    cmkptr+1    ; Yes, adjust H.O. byte
  1695. cmky3f: ldy    #$00        ; Make sure Y is clear
  1696.     lda    (cmkptr),y    ; Get first data byte
  1697.     tax            ; Put it in X
  1698.     iny            ; Up the index once
  1699.     lda    (cmkptr),y    ; Get the second data byte
  1700.     tay            ; Put that in Y
  1701.     pla            ; Flush the old comand line pointer
  1702.     pla            ;        ...
  1703.     lda    #$00        ; Reset the failure flag
  1704.     sta    cmcffl        ; 
  1705.     jmp    rskp        ; Return skip means it succeeds!
  1706. cmkey4: cmp    #$41        ; Check range for upper case
  1707.     bmi    cmky41        ;        ...
  1708.     cmp    #$5b        ;        ...
  1709.     bpl    cmky41        ;        ...
  1710.     ora    #$20        ; Cutesy way to convert to lower case
  1711. cmky41: sta    cmwrk3        ; Save the character
  1712.     lda    #$ff        ;  Set the 'real character' flag
  1713.     sta    cmfrcf        ; 
  1714.     ldy    #$00        ; Clear Y again
  1715.     lda    (cmkptr),y    ; Get next keyword byte
  1716.     sta    cmwrk4        ; Hold that for now
  1717.     clc            ; Clear the carry flag
  1718.     lda    cmkptr        ; Get L.O. byte of keyword pointer
  1719.     adc    #$01        ; Add one
  1720.     sta    cmkptr        ; Store it
  1721.     bcc    cmky4a        ; Need to do carry?
  1722.     inc    cmkptr+1    ; Yes, do H.O. byte
  1723. cmky4a: lda    cmwrk3        ; Get input character
  1724.     cmp    cmwrk4        ; Does it match keyword character?
  1725.     bne    cmkey5        ; No, advance to next keyword in table
  1726.     jmp    cmkey3        ; Yup, try next input byte
  1727. cmkey5: inc    keylen        ; Adjust keylength so that it is correct
  1728.     inc    keylen        ;        ...
  1729.     inc    keylen        ;        ...
  1730.     clc            ; Clear carry
  1731.     lda    cmkptr        ; Ok, get keyword pointer and
  1732.     adc    keylen        ; Add the remaining keylength
  1733.     sta    cmkptr        ; Store it
  1734.     bcc    cmky5a        ; See if we have to do carry
  1735.     inc    cmkptr+1    ; Yes, increment H.O. byte
  1736. cmky5a: dec    cmentr        ; Decrement the number of entries left
  1737.     lda    cmsptr        ; Get the saved buffer pointer and
  1738.     sta    cm.ptr        ;    restore it
  1739.     lda    cmsptr+1    ;        ...
  1740.     sta    cm.ptr+1    ;        ...
  1741.     jmp    cmkey2        ; Try to parse this keyword now
  1742.  
  1743. .SBTTL    Cmambg - check if keyword prefix is ambiguous
  1744.  
  1745. ;
  1746. ;    This routine looks at the next keyword in the table and
  1747. ;    determines if the prefix entered in the buffer is ambiguous
  1748. ;    or not. If it is ambiguous, it skip returns, otherwise it
  1749. ;    returns normally.
  1750. ;
  1751. ;        Input:  Cmentr- number of entries left in table
  1752. ;            Cmkptr- current keyword table pointer
  1753. ;            Keylen- remaining keyword length
  1754. ;
  1755. ;        Output: If ambiguous, does a skip return
  1756. ;
  1757. ;        Registers destroyed:    A,X,Y
  1758. ;
  1759.  
  1760. cmambg: dec    cmentr        ; Start by decrementing remaining entries
  1761.     bpl    cma1        ; We still have stuff left
  1762.     rts            ; Nothing left, it can't be ambiguous
  1763. cma1:    inc    keylen        ; Adjust this up by one
  1764.     lda    keylen        ; Save character count
  1765.     sta    cmwrk3        ;        ...
  1766.     clc            ; Clear the carry
  1767.     adc    #$03        ; Adjust the keylength to include terminator
  1768.     sta    keylen        ;    and data bytes
  1769.     clc            ; Clear carry
  1770.     lda    cmkptr        ; Up the keyword table pointer
  1771.     adc    keylen        ;    by remaining keylength
  1772.     sta    cmkptr        ; Save it
  1773.     bcc    cma2        ; Need to adjust H.O byte?
  1774.     inc    cmkptr+1    ; Yes, do it
  1775. cma2:    ldy    #$00        ; Clear Y
  1776.     lda    (cmkptr),y    ; Get keyword length
  1777.     sta    cmwrk4        ; Hold that byte
  1778.     clc            ; Clear carry
  1779.     lda    cmkptr        ; Advance keyword table pointer
  1780.     adc    #$01        ;        ...
  1781.     sta    cmkptr        ;        ...
  1782.     bcc    cma3        ;        ...
  1783.     inc    cmkptr+1    ;        ...
  1784. cma3:    lda    (cmspt2),y    ; Get previous keyword length
  1785.     sec            ; Set carry
  1786.     sbc    cmwrk3        ; Subtract number of characters left
  1787.     beq    cmambs        ;  If test len is 0, don't bother trying
  1788.     sta    cmtlen        ; This is the testing length
  1789.     cmp    cmwrk4        ; Check this against length of new keyword
  1790.     bmi    cmamb0        ; This may be ambiguous
  1791.     rts            ; Test length is longer, cannot be ambiguous
  1792. cmamb0: ldy    #$00        ; Clear Y
  1793. cmamb1: dec    cmtlen        ; Decrement the length to test
  1794.     bpl    cma4        ; Still characters left to check
  1795. cmambs:    jmp    rskp        ;  The whole thing matched, it is ambiguous
  1796. cma4:    lda    (cmkptr),y    ; Get next character of keyword
  1797.     sta    cmwrk3        ; Hold that for now
  1798.     lda    (cmsptr),y    ; Get next parsed character
  1799.     iny            ; Up the pointer once
  1800.     cmp    #$61        ; Check the range for lower case
  1801.     bmi    cmamb2        ;        ...
  1802.     cmp    #$7b        ;        ...
  1803.     bpl    cmamb2        ;        ...
  1804.     and    #$5F        ; Capitalize it
  1805. cmamb2:    and    #$7f        ; Reset the H.O. bit
  1806.     cmp    cmwrk3        ; Same as keyword table character
  1807.     beq    cmamb1        ; Yup, check next character
  1808.     rts            ; Nope, prefix is not ambiguous
  1809.  
  1810.  
  1811. .SBTTL    Cmktp - print entries in keyword table matching prefix
  1812.  
  1813. ;
  1814. ;    This routine steps through the keyword table passed to cmkeyw
  1815. ;    and prints all the keywords with the prefix currently in the
  1816. ;    command buffer. If there is no prefix, it issues an error.
  1817. ;
  1818. ;        Input:  Cmptab- ptr to beginning of table
  1819. ;            Cmsptr- saved buffer pointer
  1820. ;            Cm.ptr- current buffer pointer
  1821. ;
  1822. ;        Output: List of possible keywords to screen
  1823. ;
  1824. ;        Registers destroyed:    A,X,Y
  1825. ;
  1826.  
  1827. cmktp:  lda    cmptab        ; Get a copy of the pointer
  1828.     sta    cminf2        ;    to the beginning of
  1829.     lda    cmptab+1    ;    the current keyword table
  1830.     sta    cminf2+1    ;        ...
  1831.     ldy    #$00        ; Clear Y
  1832.     sty    cmscrs        ; Clear the 'which half of screen' switch
  1833.     sty    cmwrk3        ; Clear the 'print any keywords?' switch
  1834.     lda    (cminf2),y    ; Get the table length
  1835.     sta    cmwrk1        ;    and save it in a safe place
  1836.     sec            ; Prepare for some subtracting
  1837.     lda    cm.ptr        ; Get difference between the current pointer
  1838.     sbc    cmsptr        ;    and pointer to beginning of keyword
  1839.     sta    cmtlen        ; That is how much we must test
  1840.     clc            ; Clear carry
  1841.     lda    cminf2        ; Increment the pointer to the table
  1842.     adc    #$01        ;        ...
  1843.     sta    cminf2        ;        ...
  1844.     bcc    cmktp1        ; Need to increment H.O. byte?
  1845.     inc    cminf2+1    ; Yup
  1846. cmktp1: dec    cmwrk1        ; 1 less keyword to do
  1847.     lda    cmwrk1        ; Now...
  1848.     bmi    cmkdon        ; No keywords left, we are done
  1849.     lda    (cminf2),y    ; Get the keyword length
  1850.     sta    cmkyln        ;    and stuff it
  1851.     clc            ; Clear carry
  1852.     lda    cminf2        ; Increment pointer to table again
  1853.     adc    #$01        ;        ...
  1854.     sta    cminf2        ;        ...
  1855.     bcc    cmktp2        ; Need to up the H.O. byte?
  1856.     inc    cminf2+1    ; Yup
  1857. cmktp2: lda    cmtlen        ; Get test length
  1858.     beq    cmktp3        ; If test length is zero, just print keyword
  1859. cmkp21: lda    (cminf2),y    ; Get character from table
  1860.     cmp    (cmsptr),y    ; Compare it to the buffer character
  1861.     bne    cmadk        ; Nope, advance to next keyword
  1862.     iny            ; Up the index
  1863.     cpy    cmtlen        ; Compare with the test length
  1864.     bmi    cmkp21        ; Not yet, do next character
  1865. cmktp3: jsr    cmprk        ; Print the keyword
  1866.  
  1867. cmadk:  inc    cmkyln        ; Adjust cmkyln to include terminator and data
  1868.     inc    cmkyln        ;        ...
  1869.     inc    cmkyln        ;        ...
  1870.     clc            ; Clear the carry
  1871.     lda    cminf2        ; Get the L.O. byte
  1872.     adc    cmkyln        ; Add in the keyword length
  1873.     sta    cminf2        ; Store it away
  1874.     bcc    cmadk2        ; Need to do the H.O. byte?
  1875.     inc    cminf2+1    ; Yup
  1876. cmadk2: ldy    #$00        ; Zero the index
  1877.     jmp    cmktp1        ; Go back to the top of the loop
  1878.  
  1879. cmkdon: lda    cmwrk3        ; See if we printed anything
  1880.     bne    cmkdn2        ; Yup, go exit
  1881.     lda    cmstat        ; Are we parsing switches or keywords?
  1882.     cmp    #cmswi        ;        ...
  1883.     beq    cmkdse        ; The error should be for switches
  1884.     ldx    #cmer03\    ; Nope, get address of error message
  1885.     ldy    #cmer03^    ;        ...
  1886.     jmp    cmkdn1        ; Go print the message now
  1887. cmkdse: ldx    #cmer04\    ; Get address of switch error message
  1888.     ldy    #cmer04^    ;        ...
  1889. cmkdn1: jsr    prstr        ; Print error
  1890.     jsr    prcrlf        ; Print a crelf
  1891. cmkdn2: lda    cmscrs        ; Where did we end up?
  1892.     beq    cmkdn3        ; Beginning of line, good
  1893.     jsr    prcrlf        ; Print a crelf
  1894. cmkdn3: rts            ; Return
  1895.  
  1896. ;
  1897. ;    Cmprk - prints one keyword from the table. Consults the
  1898. ;        cmscrs switch to see which half of the line it
  1899. ;        is going to and acts accordingly.
  1900. ;
  1901. ;        Input:  Cmscrs- Which half of screen
  1902. ;            Cminf2- Pointer to string to print
  1903. ;
  1904. ;        Output: print keyword on screen
  1905. ;
  1906. ;        Registers destroyed:    A,X,Y
  1907. ;
  1908.  
  1909. cmprk:  lda    #on        ; Make sure to tell them we printed something
  1910.     sta    cmwrk3        ; Put it back
  1911.     lda    cmstat        ; Get saved parse type
  1912.     cmp    #cmswi        ; Is it a switch we are looking for?
  1913.     bne    cmpr2        ;
  1914.     lda    #'/        ; Yes, do not forget slash prefix
  1915.     jsr    cout        ; Print slash
  1916. cmpr2:  ldx    cminf2        ; L.O. byte of string pointer
  1917.     ldy    cminf2+1    ; H.O. byte of string pointer
  1918.     jsr    prstr        ; Print the keyword
  1919.     lda    cmscrs        ; Where were we?
  1920.     bne    cmprms        ; Mid screen
  1921.     jsr    screl0        ; Clear to end of line
  1922.     sec            ;[37] Get cursor coordinates
  1923.     jsr    ploth        ;[37]        ...
  1924.     ldy    #$14        ; Advance cursor to middle of screen
  1925.     clc            ;[DD]        ...
  1926.     jsr    ploth        ;[DD][26]    ...
  1927.     jmp    cmprdn        ; We are done
  1928. cmprms: jsr    prcrlf        ; Print a crelf
  1929. cmprdn: lda    cmscrs        ; Flip the switch now
  1930.     eor    #$01
  1931.     sta    cmscrs        ; Stuff it back
  1932.     rts            ; Return
  1933.  
  1934. .SBTTL    Cmswit - try to parse a switch next
  1935.  
  1936. ;
  1937. ;    This routine tries to parse a switch from the command buffer. It
  1938. ;    first looks for the / and then calls cmkeyw to handle the keyword
  1939. ;    lookup.
  1940. ;
  1941. ;        Input:  Cminf1- Address of keyword table
  1942. ;
  1943. ;        Output: X-    byte a
  1944. ;            Y-    byte b
  1945. ;
  1946. ;        Registers destroyed:    A,X,Y
  1947. ;
  1948.  
  1949. cmswit: lda    cm.ptr        ; Save the old comand line pointer
  1950.     pha            ;    user wants to try another item
  1951.     lda    cm.ptr+1    ;        ...
  1952.     pha            ;        ...
  1953. cmswi0: jsr    cmgtch        ; Go get a character
  1954.     cmp    #$00        ; Action?
  1955.     bmi    cmswi1        ; Yes, process it
  1956.     jmp    cmswi3        ; No, it is a real character
  1957. cmswi1: and    #$7f        ; Turn off the minus
  1958.     cmp    #'?        ; Does the user need help?
  1959.     bne    cmsw12        ; No
  1960.     jsr    cout        ; And print the question mark
  1961.     lda    #$00        ; Clear AC
  1962.     sta    cmaflg        ; Clear Action flag
  1963.     ldx    #cmin02\    ; Low order byte addr of info message
  1964.     ldy    #cmin02^    ; High order byte addr of info message
  1965.     jsr    prstr        ; Print the message
  1966.     jsr    prcrlf        ; Print a crelf
  1967.     jsr    cmktp        ; Any valid entries from keyword table
  1968.     jsr    prcrlf        ; And another crelf
  1969.     lda    #cmfehf        ;  Load extra help flag
  1970.     bit    cmprmy        ;  Test bit
  1971.     beq    cmsw10        ;  No extra help
  1972.     jsr    cmehlp        ;  Go give extra help
  1973. cmsw10:    ldx    cm.rty        ; Load the address of the prompt
  1974.     ldy    cm.rty+1    ;
  1975.     jsr    prstr        ; Reprint it
  1976.     lda    #$00        ; Clear AC
  1977.     ldy    #$00        ; Clear Y
  1978.     sta    (cm.ptr),y    ; Stuff a null at the end of the buffer
  1979.     sec            ; Set the carry flag
  1980.     lda    cm.bfp        ; Increment buffer pointer
  1981.     sbc    #$01        ;        ...
  1982.     sta    cm.bfp        ;        ...
  1983.     bcs    cmsw1a        ; Borrow?
  1984.     dec    cm.bfp+1    ; Yup
  1985. cmsw1a: ldx    #cmbuf\        ; L.O. addr of command buffer
  1986.     ldy    #cmbuf^        ; H.O. byte
  1987.     jsr    prstr        ; Reprint the command line
  1988.     jmp    repars        ; Go reparse everything
  1989. cmsw12: cmp    #esc        ; Lazy??
  1990.     beq    cmsw2a        ; Yes, try to help
  1991.     jmp    cmswi2        ; No, this is something else
  1992. cmsw2a: lda    #$00        ; Clear AC
  1993.     sta    cmaflg        ; Clear action flag
  1994.     lda    #cmfdff        ;  See if there is a default
  1995.     bit    cmprmy        ; 
  1996.     beq    cmswnd        ;  No help, tell user
  1997.     jmp    cmcpdf        ;  Go copy the default
  1998. cmswnd:    jsr    bell        ; Yes, it is ambiguous - ring bell
  1999.     sec            ; Set carry
  2000.     lda    cm.bfp        ; Decrement buffer pointer
  2001.     sbc    #$01        ;        ...
  2002.     sta    cm.bfp        ;        ...
  2003.     sta    cm.ptr        ; Make this pointer point there too
  2004.     bcs    cmsw2b        ; No carry to handle
  2005.     dec    cm.bfp+1    ; Do H.O. byte
  2006. cmsw2b: lda    cm.bfp+1    ; Now make H.O. byte match
  2007.     sta    cm.ptr+1    ;        ...
  2008.     dec    cmccnt        ; Decrement the character count
  2009.     jmp    cmswi0        ; Try again
  2010. cmsw2c: lda    #'/        ; Load a slash
  2011.     jsr    cout        ; Print slash
  2012.     clc            ; Clear carry
  2013.     lda    cminf1        ; Set the keyword table pointer
  2014.     adc    #$02        ;    to point at the beginning
  2015.     sta    cmkptr        ;    of the keyword and move it
  2016.     lda    cminf1+1    ;    to cmkptr
  2017.     bcc    cmsw2d        ;        ...
  2018.     adc    #$00        ;        ...
  2019. cmsw2d: sta    cmkptr+1    ;        ...
  2020.     ldy    #$00        ; Clear Y
  2021.     sec            ; Set carry
  2022.     lda    cm.bfp        ; Increment the buffer pointer
  2023.     sbc    #$01        ;        ...
  2024.     sta    cm.bfp        ;        ...
  2025.     bcs    cmsw2e        ;        ...
  2026.     dec    cm.bfp+1    ;        ...
  2027. cmsw2e: lda    (cmkptr),y    ; Get next character
  2028.     cmp    #$00        ; Done?
  2029.     beq    cmsw13        ; Yes
  2030.     tax            ; No, hold on to the byte
  2031.     clc            ;    while we increment the pointer
  2032.     lda    cmkptr        ; Do L.O. byte
  2033.     adc    #$01        ;        ...
  2034.     sta    cmkptr        ;        ...
  2035.     bcc    cmsw2f        ; And, if neccesary
  2036.     inc    cmkptr+1    ;    the H.O. byte as well
  2037. cmsw2f: txa            ; Get the data
  2038.     sta    (cm.ptr),y    ; Stuff it in the buffer
  2039.     clc            ; Clear carry
  2040.     lda    cm.ptr        ; Increment the next character pointer
  2041.     adc    #$01        ;        ...
  2042.     sta    cm.ptr        ;        ...
  2043.     bcc    cmsw2g        ;        ...
  2044.     inc    cm.ptr+1    ;        ...
  2045. cmsw2g: inc    cmccnt        ; Increment the character count
  2046.     jmp    cmsw2e        ; Get next character from table
  2047. cmsw13: inc    cmccnt        ; Increment the character count
  2048.     lda    #$00        ; Clear AC
  2049.     sta    (cm.ptr),y    ; Stuff a null in the buffer
  2050.     ldx    cm.bfp        ; Hold on to this pointer
  2051.     ldy    cm.bfp+1    ;    for later printing of switch
  2052.     clc            ; Clear carry
  2053.     lda    cm.ptr        ; Now make both pointers look like
  2054.     adc    #$01        ;    (cm.ptr)+1
  2055.     sta    cm.ptr        ;        ...
  2056.     sta    cm.bfp        ;        ...
  2057.     bcc    cmsw3a        ;        ...
  2058.     inc    cm.ptr+1    ;        ...
  2059. cmsw3a: lda    cm.ptr+1    ; Copy H.O. byte
  2060.     sta    cm.bfp+1    ;        ...
  2061.     jsr    prstr        ; Now print string with pointer saved earlier
  2062.     ldx    #$01        ; Set up argument
  2063.     jsr    prbl2        ; Print one blank
  2064. cmsw14: clc            ; Clear carry
  2065.     lda    cmkptr        ; Increment keyword pointer
  2066.     adc    #$01        ; Past null terminator
  2067.     sta    cmkptr        ;        ...
  2068.     bcc    cmsw4a        ;        ...
  2069.     inc    cmkptr+1    ;        ...
  2070. cmsw4a: ldy    #$00        ; Clear Y
  2071.     lda    (cmkptr),y    ; Get first data byte
  2072.     tax            ; Put it here
  2073.     iny            ; Up the index
  2074.     lda    (cmkptr),y    ; Get second data byte
  2075.     tay            ; Put that in Y
  2076.     pla            ; Flush the old comand line pointer
  2077.     pla            ;        ...
  2078.     lda    #$00        ;  Clear the failure flag
  2079.     sta    cmcffl        ;         ...
  2080.     jmp    rskp        ; And give a skip return
  2081. cmswi2: ldy    #$00        ; Clear Y
  2082.     lda    (cminf1),y    ; Get length of table
  2083.     cmp    #$02        ; Greater than 1
  2084.     bmi    cmsw21        ; No, go fetch data
  2085.     ldx    #cmer01\    ; Yes, fetch pointer to error message
  2086.     ldy    #cmer01^    ;        ...
  2087.     jsr    prstr        ; Print the error
  2088.     jmp    prserr        ; And go handle the parser error
  2089. cmsw21: iny            ; Add one to the index
  2090.     lda    (cminf1),y    ; Get the length of the keyword
  2091.     sta    keylen        ; Save that
  2092.     lda    cminf1+1    ; Copy pointer to table
  2093.     sta    cmkptr+1    ;        ...
  2094.     clc            ; Get set to increment an address
  2095.     lda    cminf1        ; Do L.O. byte last for efficiency
  2096.     adc    keylen        ; Add in the keyword length
  2097.     adc    #$02        ; Now account for table length and terminator
  2098.     sta    cmkptr        ; Save the new pointer
  2099.     bcc    cmsw22        ; If no carry, continue
  2100.     inc    cmkptr+1    ; Adjust H.O. byte
  2101. cmsw22: jmp    cmsw4a        ; Go to load data and skip return
  2102. cmswi3: cmp    #'/        ; Is the real character a slash?
  2103.     beq    cmswi4        ; Yes, go do the rest
  2104.     tax            ; Move the data byte
  2105.     lda    #$00        ; Clear AC
  2106.     pla            ; Fetch back the old comand line pointer
  2107.     sta    cm.ptr+1    ;        ...
  2108.     sta    cmoptr+1    ;         ...
  2109.     pla            ;        ...
  2110.     sta    cm.ptr        ;        ...
  2111.     sta    cmoptr        ;        ...
  2112.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2113.     sta    cmocnt        ;  
  2114.     lda    #$ff        ;  Set failure  flag
  2115.     sta    cmcffl        ;         ...
  2116.     rts            ; Fail - non-skip return
  2117. cmswi4: jsr    cmkeyw        ; Let Keyw do the work for us
  2118.      jmp    cmswi5        ; We had problems, restore comand ptr and ret.
  2119.     pla            ; Flush the old comand pointer
  2120.     pla
  2121.     lda    #$00        ;  Reset the failre flag
  2122.     sta    cmcffl        ; 
  2123.     jmp    rskp        ; Success - skip return!
  2124. cmswi5: pla            ; Fetch back the old comand line pointer
  2125.     sta    cm.ptr+1    ;        ...
  2126.     sta    cmoptr+1    ;         ...
  2127.     pla            ;        ...
  2128.     sta    cm.ptr        ;        ...
  2129.     sta    cmoptr        ;         ...
  2130.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2131.     sta    cmocnt        ; 
  2132.     lda    #$ff        ;  Set failure flag
  2133.     sta    cmcffl        ; 
  2134.     rts            ; Now return
  2135.  
  2136. .SBTTL    Cmifil - try to parse an input file spec next
  2137.  
  2138. ;
  2139. ;    This routine attempts to parse an input file spec.
  2140. ;
  2141. ;        Input:  X - Max filename length
  2142. ;
  2143. ;        Output: Filename parsed is in buffer pointed to by X,Y
  2144. ;
  2145. ;        Registers destroyed:    A,X,Y
  2146. ;
  2147.  
  2148. cmifil: inx            ;  Increment max file length for tests
  2149.     stx    cmprmx        ;  Maximum filename length
  2150.     lda    cm.ptr        ; Save the old comand line pointer in case
  2151.     pha            ;
  2152.     lda    cm.ptr+1    ;
  2153.     pha            ;
  2154.     lda    #$00        ; Zero the
  2155.     sta    lenabf        ;  length of the atom buffer
  2156. cmifl0: ldy    #$00        ; Zero Y
  2157.     lda    #'          ; Blank the AC 
  2158. ;    ora    #$80        ; Make it look like a terminator
  2159. cmifi0: sta    atmbuf,y    ; Now zero the buffer
  2160.     iny            ;        ...
  2161.     cpy    cmprmx      ;  Done?
  2162.     bpl    cmifi1        ; Yes, start parsing
  2163.     jmp    cmifi0        ; No, continue blanking
  2164. cmifi1: jsr    cmgtch        ; Get a character from command buffer
  2165.     cmp    #$00        ; Is it an action character?
  2166.     bmi    cmif10        ;  Yes, check it out
  2167.     jmp    cmifi2        ;  No , process it as a normal character
  2168. cmif10:    and    #$7f        ;  Yes, turn off the minus bit
  2169.     cmp    #'?        ; Does the user need help?
  2170.     bne    cmif12        ; Nope
  2171.     jsr    cout        ; And print the question mark
  2172.     ldy    #$00        ; Yes
  2173.     sty    cmaflg        ; Clear the action flag
  2174.     ldx    #cmin03\    ; Now get set to give the 'file spec' message
  2175.     ldy    #cmin03^    ;        ...
  2176.     jsr    prstr        ; Print it
  2177.     jsr    prcrlf        ; Print a crelf
  2178.     lda    #cmfehf        ;  Load extra help flag
  2179.     bit    cmprmy        ;  Test bit
  2180.     beq    cmifnh        ;  No extra help
  2181.     jsr    cmehlp        ;  Go give extra help
  2182. cmifnh:    ldx    cm.rty        ;  Set up to reprint the prompt
  2183.     ldy    cm.rty+1    ;        ...
  2184.     jsr    prstr        ; Do it
  2185.     sec            ; Set the carry flag for subtraction
  2186.     lda    cm.bfp        ; Get the buffer pointer
  2187.     sbc    #$01        ; Decrement it once
  2188.     sta    cm.bfp        ;        ...
  2189.     bcs    cmif11        ; If it's set, we need not do H.O. byte
  2190.     dec    cm.bfp+1    ; Adjust the H.O. byte
  2191. cmif11: dec    cmccnt        ; Decrement the character count
  2192.     ldy    #$00        ; Clear Y
  2193.     lda    #$00        ; Clear AC
  2194.     sta    (cm.bfp),y    ; Stuff a null at the end of the command buffer
  2195.     ldx    #cmbuf\        ; Now get the address of the command buffer
  2196.     ldy    #cmbuf^        ;        ...
  2197.     jsr    prstr        ; Reprint the command line
  2198.     jmp    cmifi1        ; Go back and continue
  2199. cmif12: cmp    #esc        ; Got an escape?
  2200.     bne    cmif13        ; No
  2201.     lda    #$00        ; Yup, clear the action flag
  2202.     sta    cmaflg        ;        ...
  2203.     lda    #cmfdff        ;  Load default-present flag
  2204.     bit    cmprmy        ;  Test bit
  2205.     beq    cmifnd        ;  No default
  2206.     lda    lenabf        ;  Now check if user typed anything
  2207.     bne    cmifnd        ;  Yup, can't use default
  2208.     jmp    cmcpdf        ;  Go copy the default
  2209. cmifnd:    jsr    bell        ; Escape does not work here, ring the bell
  2210.     sec            ; Set carry for subtraction
  2211.     lda    cm.bfp        ; Decrement the buffer pointer
  2212.     sbc    #$01        ;    once
  2213.     sta    cm.bfp        ;        ...
  2214.     sta    cm.ptr        ; Make both pointers look at the same spot
  2215.     lda    cm.bfp+1    ;        ...
  2216.     sbc    #$00        ; H.O. byte adjustment
  2217.     sta    cm.bfp+1    ;        ...
  2218.     sta    cm.ptr+1    ;        ...
  2219.     dec    cmccnt        ; Decrement the character count
  2220.     jmp    repars        ;    and go reparse everything
  2221. cmif13: lda    lenabf        ;  Get the length of the buffer
  2222.     cmp    #$00        ; Is it zero?
  2223.     bne    cmif14        ; No, continue
  2224.     jmp    cmifi9        ; Yes, this is not good
  2225. cmif14: cmp    cmprmx      ;  Are we over the maximum file length?
  2226.     bmi    cmif15        ; Not quite yet
  2227.     jmp    cmifi9        ; Yes, blow up
  2228. cmif15: ldy    lenabf        ;  Get the filename length
  2229.     lda    #nul        ;    and stuff a null at that point
  2230.     sta    atmbuf,y    ; 
  2231.     pla            ; Flush the old comand line pointer
  2232.     pla            ;        ...
  2233.     ldx    #atmbuf\    ;  Set up the atombuffer address
  2234.     ldy    #atmbuf^    ;        ...
  2235.     lda    #$00        ;  Reset the failure flag
  2236.     sta    cmcffl        ; 
  2237.     lda    lenabf        ;  Load length into AC to be passed back
  2238.     jmp    rskp        ; No, we are successful
  2239. cmifi2: cmp    #sp        ;  Bad character?
  2240.     bmi    cmifi9        ; Yes, blow up
  2241.     cmp    #del        ; 
  2242.     bpl    cmifi9        ; This is bad, punt
  2243.     cmp    #$61        ; Lower case alphabetic?
  2244.     bmi    cmifi8        ; Don't capitalize if it's not alphabetic
  2245.     cmp    #$7b        ;        ...
  2246.     bpl    cmifi8        ;        ...
  2247.     and    #$5f        ; Capitalize
  2248. cmifi8: ldy    lenabf        ;  Set up length of buffer in Y
  2249.     sta    atmbuf,y    ;  Stuff character in FCB
  2250.     inc    lenabf        ;  Increment the length of the name
  2251.     jmp    cmifi1        ; Go back for the next character
  2252. cmifi9: pla            ; Restore the old comand line pointer
  2253.     sta    cm.ptr+1    ;  in case the user wants to parse
  2254.     sta    cmoptr+1    ;         ...
  2255.     pla            ;    for something else
  2256.     sta    cm.ptr        ;        ...
  2257.     sta    cmoptr        ;         ...
  2258.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2259.     sta    cmocnt        ;         ...
  2260.     lda    #$ff        ;  Set failure flag
  2261.     sta    cmcffl        ; 
  2262.     rts
  2263.  
  2264. .SBTTL    Cmofil - try to parse an output file spec
  2265.  
  2266. ;
  2267. ;    This routine attempts to parse an output file spec from the
  2268. ;    command buffer.
  2269. ;
  2270. ;        Input:  cminf1- Pointer to FCB
  2271. ;
  2272. ;        Output:
  2273. ;
  2274. ;        Registers destroyed:
  2275. ;
  2276.  
  2277. cmofil: jmp    cmifil        ; Same as parsing input file spec for now
  2278.  
  2279. .SBTTL    Cminum - Try to parse an integer number
  2280.  
  2281. ;
  2282. ;    This routine tries to parse an integer number in the base
  2283. ;    specified. It will return a 16-bit number in cmintg.
  2284. ;    Cmintg is formatted H.O. byte first!
  2285. ;
  2286. ;        Input:  X-    Base of integer (2<=x<=16)
  2287. ;
  2288. ;        Output: Cmintg- 16-bit integer
  2289. ;
  2290. ;        Registers destroyed:    A,X,Y
  2291. ;
  2292.  
  2293. cminum: lda    cm.ptr        ; Save the old comand line pointer
  2294.     pha            ;        ...
  2295.     lda    cm.ptr+1    ;        ...
  2296.     pha            ;        ...
  2297.     cpx    #$11        ; Are we within the proper range?
  2298.     bmi    cmin1        ; If so, check high range
  2299.     jmp    cmine1        ; No, tell them about it
  2300. cmin1:  cpx    #$02        ; Too small of a base??
  2301.     bpl    cmin2        ; No, continue
  2302.     jmp    cmine1        ; Base too small, tell them about it
  2303. cmin2:  stx    cmbase        ; The base requested is good, store it
  2304.     lda    #$00        ; Clear AC
  2305.     sta    cmmres        ;    and initialize these areas
  2306.     sta    cmmres+1    ;        ...
  2307.     sta    cmmres+2    ;        ...
  2308.     sta    cmmres+3    ;        ...
  2309.     sta    cmintg        ;        ...
  2310.     sta    cmintg+1    ;        ...
  2311.     sta    cmintg+2    ;        ...
  2312.     sta    cmintg+3    ;        ...
  2313. cminm1: jsr    cmgtch        ; Get next character from command buffer
  2314.     cmp    #$00        ; Is this an action character
  2315.     bmi    cmin1a        ; Yes, handle it
  2316.     jmp    cminm4        ; No, look for a digit
  2317. cmin1a: and    #$7f        ; It is, turn off the H.O. bit
  2318.     cmp    #esc        ; Is it an escape?
  2319.     bne    cminm2        ; No, try something else
  2320.     lda    #cmfdff        ;  Load default-present flag
  2321.     bit    cmprmy        ;  Test bit
  2322.     beq    cminnd        ;  No, default
  2323.     lda    cmmres        ;  Check if user typed anything significant
  2324.     ora    cmmres+1    ;         ...
  2325.     bne    cminnd        ;  Yup, can't use default
  2326.     jmp    cmcpdf        ;  Go copy the default
  2327. cminnd:    jsr    bell        ; Yes, but escape is not allowed, ring bell
  2328.     lda    #$00        ; Zero
  2329.     sta    cmaflg        ;    the action flag
  2330.     sec            ; Set the carry flag for subtraction
  2331.     lda    cm.bfp        ; Get the command buffer pointer
  2332.     sbc    #$01        ; Decrement it once
  2333.     sta    cm.bfp        ; Store it away
  2334.     sta    cm.ptr        ; Make this pointer look like it also
  2335.     bcs    cmin11        ; If carry set don't adjust H.O. byte
  2336.     dec    cm.bfp+1    ; Adjust the H.O. byte
  2337. cmin11: lda    cm.bfp+1    ; Move a copy of this H.O. byte
  2338.     sta    cm.ptr+1    ;    to this pointer
  2339.     dec    cmccnt        ; Decrement the character count
  2340.     jmp    cminm1        ; Go try for another character
  2341. cminm2: cmp    #'?        ; Does the user need help?
  2342.     bne    cminm3        ; If not, back up the pointer and accept
  2343.     jsr    cout        ; And print the question mark
  2344.     ldx    #cmin05\    ; Set up the pointer to info message to be
  2345.     ldy    #cmin05^    ;    printed
  2346.     jsr    prstr        ; Print the text of the message
  2347.     lda    cmbase        ; Get the base of the integer number
  2348.     cmp    #$0a        ; Is it greater than decimal 10?
  2349.     bmi    cmin21        ; No, just print the L.O. digit
  2350.     clc            ; Clear the carry
  2351.     lda    #$01        ; Print the H.O. digit as a 1
  2352.     adc    #$30        ; Make it printable
  2353.     jsr    cout        ; Print the '1'
  2354.     lda    cmbase        ; Get the base back
  2355.     sec            ; Set the carry flag for subtraction
  2356.     sbc    #$0a        ; Subtract off decimal 10
  2357. cmin21: clc            ; Clear carry for addition
  2358.     adc    #$30        ; Make it printable
  2359.     jsr    cout        ; Print the digit
  2360.     jsr    prcrlf        ; Print a crelf
  2361.     lda    #cmfehf        ;  Load extra help flag
  2362.     bit    cmprmy        ;  Test bit
  2363.     beq    cminnh        ;  No extra help
  2364.     jsr    cmehlp        ;  Go give extra help
  2365. cminnh:    ldx    cm.rty        ; Set up the pointer so we can print the prompt
  2366.     ldy    cm.rty+1    ;        ...
  2367.     jsr    prstr        ; Reprint the prompt
  2368.     lda    #$00        ; Clear AC
  2369.     ldy    #$00        ; Clear Y
  2370.     sta    (cm.ptr),y    ; Drop a null at the end of the command buffer
  2371.     sec            ; Set the carry flag for subtraction
  2372.     lda    cm.bfp        ; Get the L.O. byte of the address
  2373.     sbc    #$01        ; Decrement it once
  2374.     sta    cm.bfp        ; Store it back
  2375.     bcs    cmin22        ; If carry set, don't adjust H.O. byte
  2376.     dec    cm.bfp+1    ; Adjust H.O. byte
  2377. cmin22: ldx    #cmbuf\        ; Get the address of the command buffer
  2378.     ldy    #cmbuf^        ;        ...
  2379.     jsr    prstr        ; Reprint the command buffer
  2380.     lda    #$00        ; Clear the
  2381.     sta    cmaflg        ;    action flag
  2382.     jmp    repars        ; Reparse everything
  2383. cminm3: ldx    cmmres        ;  Move L.O. byte
  2384.     ldy    cmmres+1    ;  Move H.O. byte
  2385.     pla            ; Flush the old comand line pointer
  2386.     pla            ;        ...
  2387.     lda    #$00        ;  Reset the failure flag
  2388.     sta    cmcffl        ; 
  2389.     jmp    rskp        ;
  2390. cminm4: cmp    #$60        ; Is this a letter?
  2391.     bmi    cmin41        ; Nope, skip this stuff
  2392.     sec            ; It is, bring it into the proper range
  2393.     sbc    #$27        ;        ...
  2394. cmin41: sec            ; Set carry for subtraction
  2395.     sbc    #$30        ; Make the number unprintable
  2396.     cmp    #$00        ; Is the number in the proper range?
  2397.     bmi    cminm5        ; No, give an error
  2398.     cmp    cmbase        ;        ...
  2399.     bmi    cminm6        ; This number is good
  2400. cminm5: pla            ; Restore the old comand line pointer
  2401.     sta    cm.ptr+1    ;        ...
  2402.     sta    cmoptr        ;         ...
  2403.     pla            ;        ...
  2404.     sta    cm.ptr        ;        ...
  2405.     sta    cmoptr        ;         ...
  2406.     lda    cmccnt        ;  Save count in case of <ctrl/H>
  2407.     sta    cmocnt        ;         ...
  2408.     lda    #$ff        ;  Set failure flag
  2409.     sta    cmcffl        ;         ...
  2410.     rts            ; Then return
  2411. cminm6: pha            ; Save the number to add in
  2412.     lda    cmmres+1    ; Move the number to multiply
  2413.     pha            ;     onto the stack for 
  2414.     lda    cmmres        ;    call to mul16
  2415.     pha            ;        ...
  2416.     lda    #$00        ; Move base onto the stack (H.O. byte first)
  2417.     pha            ;        ...
  2418.     lda    cmbase        ;        ...
  2419.     pha            ;        ...
  2420.     jsr    mul16        ; Multiply this out
  2421.     pla            ; Get L.O. byte of product
  2422.     sta    cmmres        ; Store it for now
  2423.     pla            ; Get H.O. byte of product
  2424.     sta    cmmres+1    ; Store that too
  2425.     pla            ; Get the digit to add in
  2426.     clc            ; Clear the carry for the add
  2427.     adc    cmmres        ; Add in L.O. byte of result
  2428.     sta    cmmres        ; Store it back
  2429.     lda    cmmres+1    ; Get the H.O. byte
  2430.     adc    #$00        ; Add in the carry
  2431.     sta    cmmres+1    ; Save the H.O. byte
  2432.     bcs    cmine2        ; Wrong, we overflowed
  2433.     jmp    cminm1        ; Try for the next digit
  2434. cmine1: ldx    #cmer06\    ; Get the address of the error message
  2435.     ldy    #cmer06^    ;        ...
  2436.     jsr    prstr        ; Print the error
  2437.     jmp    prserr        ; Handle the parse error
  2438. cmine2: ldx    #cmer07\    ; Get the address of the error message
  2439.     ldy    #cmer07^    ;        ...
  2440.     jsr    prstr        ; Print the error message
  2441.     jmp    prserr        ; Handle the error
  2442.  
  2443. .SBTTL    Cmflot - Try to parse a floating point number
  2444.  
  2445. ;
  2446. ;    This routine tries to parse a floating point number in the
  2447. ;    format:
  2448. ;        sd-d.d-dEsddd
  2449. ;
  2450. ;        s is an optional sign bit
  2451. ;        d is a decimal digit
  2452. ;        E is the letter 'E'
  2453. ;        . is a decimal point
  2454. ;
  2455. ;        Input:
  2456. ;
  2457. ;        Output: Cmfltp- 6 byte floating point number
  2458. ;                4.5 byte signed mantissa
  2459. ;                1.5 byte signed exponent
  2460. ;
  2461. ;
  2462. ;        bit    0 1      35 36 37    47
  2463. ;
  2464. ;        Registers destroyed:    A,X,Y
  2465. ;
  2466.  
  2467. cmflot: rts
  2468.  
  2469. .SBTTL    Cmunqs - Try to parse an unquoted string
  2470.  
  2471. ;
  2472. ;    This routine tries to parse an unquoted string terminating
  2473. ;    with one of the break characters in brkwrd.
  2474. ;
  2475. ;        Input:    
  2476. ;
  2477. ;        Output:    X - L.O. byte address of ASCII string
  2478. ;            Y - H.O. byte address of ASCII string
  2479. ;            A - Length of string parsed
  2480. ;
  2481. ;        Registers destroyed:    A,X,Y
  2482. ;
  2483.  
  2484. cmunqs:    lda    cm.ptr        ; Save the command buffer pointer
  2485.     pha            ;        ...
  2486.     lda    cm.ptr+1    ;        ...
  2487.     pha            ;        ...
  2488.     lda    #$00        ; Zero length of Atom buffer
  2489.     sta    lenabf        ;        ...
  2490. cmunq1:    jsr    cmgtch        ; Get a character
  2491.     jsr    chkbrk        ; Is it one of the break characters?
  2492.      jmp    cmunq3        ; Yes, handle that condition
  2493.     cmp    #$00        ; No, is it an action character?
  2494.     bpl    cmunq2        ; No, handle it as normal text
  2495.     and    #$7f        ; We don't need the H.O. bit
  2496.     cmp    #'?        ; Does the user need help?
  2497.     bne    cmun13        ; Nope, try next possibility
  2498.     jsr    cout        ; Print '?'
  2499.     ldy    #$00        ; Zero the action flag
  2500.     sty    cmaflg        ;        ...
  2501.     ldx    #cmin06\    ; Get the help message
  2502.     ldy    #cmin06^    ;        ...
  2503.     jsr    prstr        ;    and print it.
  2504.     jsr    prcrlf        ; Print a crelf after it
  2505.     lda    #cmfehf        ; Check for extra help.
  2506.     bit    cmprmy        ;        ...
  2507.     beq    cmun11        ; If no help, continue
  2508.     jsr    cmehlp        ; Process extra help
  2509. cmun11:    ldx    cm.rty        ; Go reprint prompt
  2510.     ldy    cm.rty+1    ;        ...
  2511.     jsr    prstr        ;        ...
  2512.     sec            ; Adjust buffer pointer
  2513.     lda    cm.bfp        ;        ...
  2514.     sbc    #$01        ;        ...
  2515.     sta    cm.bfp        ;        ...
  2516.     bcs    cmun12        ;        ...
  2517.     dec    cm.bfp+1    ; Adjust H.O. byte
  2518. cmun12:    dec    cmccnt        ; Correct character count
  2519.     ldy    #$00        ; Stuff a null at end of usable buffer
  2520.     lda    #$00        ;        ...
  2521.     sta    (cm.bfp),y    ;        ...
  2522.     ldx    #cmbuf\        ; Reprint command line
  2523.     ldy    #cmbuf^        ;        ...
  2524.     jsr    prstr        ;        ...
  2525.     jmp    cmunq1        ; Go back for more characters
  2526. cmun13:    cmp    #esc        ; Did the user type <esc>?
  2527.     bne    cmunq2        ; No, just stuff the character and cont.
  2528.     lda    #$00        ; Clear the action flag
  2529.     sta    cmaflg        ;        ...
  2530.     lda    #cmfdff        ; Check if there is a default value
  2531.     bit    cmprmy        ;        ...
  2532.     beq    cmun14        ; If not, the <esc> loses
  2533.     lda    lenabf        ; Ok, there is a default, but if
  2534.     bne    cmun14        ;    something has been typed, <esc> loses
  2535.     jmp    cmcpdf        ; Go copy default and reparse
  2536. cmun14:    jsr    bell        ; Feep at user
  2537.     sec            ;    and reset the buffer pointer
  2538.     lda    cm.bfp        ;        ...
  2539.     sbc    #$01        ;        ...
  2540.     sta    cm.bfp        ;        ...
  2541.     sta    cm.ptr        ;        ...
  2542.     lda    cm.bfp+1    ;        ...
  2543.     sbc    #$00        ;        ...
  2544.     sta    cm.bfp+1    ;        ...
  2545.     sta    cm.ptr+1    ;        ...
  2546.     dec    cmccnt        ; Adjust the character count
  2547.     jmp    repars        ;    and reparse the command line
  2548. cmunq2:    ldy    lenabf        ; Fetch where we are in atmbuf
  2549.     sta    atmbuf,y    ;    and store our character there
  2550.     inc    lenabf        ; Reflect increased length
  2551.     jmp    cmunq1        ; Go back for more characters
  2552. cmunq3:    lda    lenabf        ; Get the length
  2553.     beq    cmunqf        ; If we parsed a null string, fail
  2554.     pla            ; Flush old command line pointer
  2555.     pla            ;        ...
  2556.     ldx    #atmbuf\    ; Now, set up the return parameter
  2557.     ldy    #atmbuf^    ;        ...
  2558.     lda    #$00        ; Reset the failure flag
  2559.     sta    cmcffl        ;        ...
  2560.     lda    lenabf        ; Set up atom length
  2561.     jmp    rskp        ; Return
  2562. cmunqf:    pla            ; Restore old command line pointer
  2563.     sta    cm.ptr+1    ;        ...
  2564.     sta    cmoptr+1    ;        ...
  2565.     pla            ;        ...
  2566.     sta    cm.ptr        ;        ...
  2567.     sta    cmoptr        ;        ...
  2568.     lda    cmccnt        ; Save count in case of <ctrl/H>
  2569.     sta    cmocnt        ;        ...
  2570.     lda    #$ff        ; Set failure flag
  2571.     sta    cmcffl        ;        ...
  2572.     rts            ; Return
  2573.  
  2574. .SBTTL    Cmtokn - Try to parse for a single character token
  2575.  
  2576. ;
  2577. ;    This routine tries to parse for the character in the X-register.
  2578. ;
  2579. ;        Input:    X - Character to be parsed    
  2580. ;
  2581. ;        Output: +1 - failed to find character
  2582. ;            +4 - success, found character
  2583. ;
  2584. ;        Registers destroyed:    A,X,Y
  2585. ;
  2586.  
  2587. cmtokn:    lda    cm.ptr        ; First, save the old command pointer
  2588.     pha            ;    on the stack
  2589.     lda    cm.ptr+1    ;        ...
  2590.     pha            ;        ...
  2591. cmtk0:    jsr    cmgtch        ; Fetch the next character
  2592.     bpl    cmtk3        ; Not an action character
  2593.     and    #$7f        ; It's an action character
  2594.     cmp    #esc        ; User trying to be lazy?
  2595.     bne    cmtk2        ; Nope, try next option
  2596.     jsr    bell        ; Yes, well, he's not allowed to be lazy
  2597.     lda    #$00        ; Clear the action flag
  2598.     sta    cmaflg        ;        ...
  2599.     sec            ; Adjust the buffer pointer back once
  2600.     lda    cm.bfp        ;        ...
  2601.     sbc    #$01        ;        ...
  2602.     sta    cm.bfp        ;        ...
  2603.     sta    cm.ptr        ; Copy it into command pointer
  2604.     bcs    cmtk1        ; Need to adjust H.O. byte?
  2605.     dec    cm.bfp+1    ; Yes, do it
  2606. cmtk1:    lda    cm.bfp+1    ; Copy it to command pointer
  2607.     sta    cm.ptr+1    ;        ...
  2608.     dec    cmccnt        ; Adjust the character count
  2609.     jmp    cmtk0        ;    and try again
  2610. cmtk2:    cmp    #'?        ; User need help?
  2611.     bne    cmtk4        ; No, go fail
  2612.     jsr    cout        ; Print it
  2613.     ldx    #cmin07\    ; Point to the information message
  2614.     ldy    #cmin07^    ;        ...
  2615.     jsr    prstr        ;    and print it
  2616.     lda    #dquot        ; Print the character we are looking for
  2617.     jsr    cout        ;    in between double quotes
  2618.     lda    cmprmx        ;        ...
  2619.     jsr    cout        ;        ...
  2620.     lda    #dquot        ;        ...
  2621.     jsr    cout        ;        ...
  2622.     jsr    prcrlf        ; End it with a crelf
  2623.     lda    #cmfehf        ; Load extra help flag
  2624.     bit    cmprmy        ; Test bit
  2625.     beq    cmtknh        ; No extra help
  2626.     jsr    cmehlp        ; Go give extra help
  2627. cmtknh:    ldx    cm.rty        ; Point to prompt
  2628.     ldy    cm.rty+1    ;        ...
  2629.     jsr    prstr        ;    and print it
  2630.     sec            ; Adjust the buffer pointer back one
  2631.     lda    cm.bfp        ;        ...
  2632.     sbc    #$01        ;        ...
  2633.     sta    cm.bfp        ;        ...
  2634.     lda    cm.bfp+1    ;        ...
  2635.     sbc    #$00        ;        ...
  2636.     sta    cm.bfp+1    ;        ...
  2637.     lda    #$00        ; Stuff a null at the end of the buffer
  2638.     ldy    #$00        ;        ...
  2639.     sta    (cm.ptr),y    ;        ...
  2640.     ldx    #cmbuf\        ; Point to command buffer
  2641.     ldy    #cmbuf^        ;        ...
  2642.     jsr    prstr        ;    and reprint it
  2643.     lda    #$00        ; Clear action flag
  2644.     sta    cmaflg        ;        ...
  2645.     jmp    repars        ;    and go reparse
  2646. cmtk3:    cmp    cmprmx        ; Ok, this either is or is not the
  2647.     bne    cmtk4        ;    char we want. If not, go fail.
  2648.     pla            ; It is, flush the old address
  2649.     pla            ;        ...
  2650.     lda    #$00        ; Reset the failure flag
  2651.     sta    cmcffl        ;        ...
  2652.     jmp    rskp        ;    and skip return
  2653. cmtk4:    pla            ; Restore old pointer
  2654.     sta    cm.ptr+1    ;        ...
  2655.     sta    cmoptr+1    ;        ...
  2656.     pla            ;        ...
  2657.     sta    cm.ptr        ;        ...
  2658.     sta    cmoptr        ;        ...
  2659.     lda    cmccnt        ; Save the count for <ctrl/H>
  2660.     sta    cmocnt        ;        ...
  2661.     lda    #$ff        ; Set failure flag
  2662.     sta    cmcffl        ;        ...
  2663.     rts            ; Return
  2664.  
  2665. .SBTTL    Cminbf - read characters from keyboard
  2666.  
  2667. ;
  2668. ;    This routine reads characters from the keyboard until
  2669. ;    an action or editing character comes up.
  2670. ;
  2671. ;        Input:
  2672. ;
  2673. ;        Output:        Cmbuf- characters from keyboard
  2674. ;
  2675. ;        Registers destroyed:
  2676. ;
  2677.  
  2678. cminbf: pha            ; Save the AC
  2679.     txa            ;    and X
  2680.     pha            ;        ...
  2681.     tya            ;    and Y
  2682.     pha            ;        ...
  2683.     php            ; Save the processor status
  2684.     ldy    #$00        ; Clear Y
  2685.     lda    cmaflg        ; Fetch the action flag
  2686.     cmp    #$00        ; Set??
  2687.     beq    cminb1        ; Nope
  2688.     jmp    cminb9        ; Yes, so leave
  2689. cminb1: inc    cmccnt        ; Up the character count once
  2690.     bne    cminb0        ;  If we are overflowing the command buffer
  2691.     jsr    bell        ;    Feep at the user and do Prserr
  2692.     dec    cmccnt        ;  Make sure this doesn't happen again
  2693.     jmp    prserr        ;    for same string
  2694. cminb0:    jsr    rdkey        ; Get next character from keyboard
  2695.     lda    char        ;[31]
  2696.     cmp    #$90
  2697.     bcs    cminb10
  2698.     cmp    #$80        ; check if numeric keypad
  2699.     bcc    cminb10
  2700.     sbc    #$80-'0        ; convert to a digit.  Carry already set
  2701. cminb10:cmp    #$c0        ; check if special key
  2702.     bcc    cminb11
  2703.     cmp    #$c4
  2704.     bcs    cminb11
  2705.     tax
  2706.     lda    out4a1-$c0,x    ; convert spcial key
  2707. cminb11:cmp    #esc        ; esc is a legal non-printing character
  2708.     beq    cminb8
  2709.     cmp    #cr        ; cr is a legal non-printing character
  2710.     beq    cminb8
  2711.     cmp    #lf        ; lf is a legal non-printing character
  2712.     beq    cminb8
  2713.     cmp    #tab        ; tab is a legal non-printing character
  2714.     beq    cminb8
  2715.     cmp    #ctrlu        ; ctrlu is a legal non-printing character
  2716.     beq    cminb8
  2717.     cmp    #ctrlw        ; ctrlw is a legal non-printing character
  2718.     beq    cminb8
  2719.     cmp    #ffd        ; form feed is a legal non-printing character
  2720.     beq    cminb8
  2721.     cmp    #del        ; del is a legal non-printing character
  2722.     beq    cminb8
  2723.     cmp    #bs        ; bs is a legal non-printing character
  2724.     beq    cminb8
  2725.     cmp    #$20        ; ignore non-printing characters
  2726.     bcc    cminb0
  2727.     cmp    #$20+95        ; ignore non-printing characters
  2728.     bcs    cminb0
  2729. cminb8:    cmp    #$7f        ;[46]
  2730.     beq    cmind        ;  Yes
  2731.     cmp    #bs        ;  Also a retry
  2732.     bne    cmnbnh        ;  No, go on
  2733. cmind:    ldx    cmccnt        ;  Check character count
  2734.     cpx    #$01        ;  Is this the first character?
  2735.     bne    cmnbnh        ;  Nope, can't help him
  2736.     ldx    cmcffl        ;  Did the previous command fail?
  2737.     bpl    cmnbnh        ;  No, we can't reparse a good command
  2738.     lda    cmoptr        ;  Ok, get the old pointer and set up
  2739.     sta    cm.ptr        ;     the old command line again
  2740.     sta    cm.bfp        ;         ...
  2741.     lda    cmoptr+1    ;         ...
  2742.     sta    cm.ptr+1    ;         ...
  2743.     sta    cm.bfp+1    ;         ...
  2744.     lda    cmocnt        ;  Restore the character count
  2745.     sta    cmccnt        ;         ...
  2746.     lda    #$00        ;  Zero this so we can safely use the
  2747.     sta    cmwrk2        ;     code that reprints a line after ^W
  2748.     jmp    cmnbna        ;  Go reprint the line
  2749. cmnbnh:    ldy    #$00        ;        ...
  2750.     sta    (cm.bfp),y    ; Stuff it in buffer
  2751.     tax            ; Hold it here for a while
  2752.     clc            ; Clear the carry
  2753.     lda    cm.bfp        ; Increment the buffer pointer
  2754.     adc    #$01        ;        ...
  2755.     sta    cm.bfp        ;        ...
  2756.     bcc    cmnb11        ; Carry?
  2757.     inc    cm.bfp+1    ; Yup, do H.O. byte
  2758. cmnb11: txa            ; Get the data back
  2759.     cmp    #ctrlu        ; Is it a ^U
  2760.     bne    cminb2        ; Nope
  2761. cmnb12: jsr    screl2        ; Yes, clear the whole line
  2762.     sec            ;[37] Get the cursor coordinates
  2763.     jsr    ploth        ;[37]        ...
  2764.     ldy    #$00        ;[DD] Reset cursor position to beg. of line
  2765.     clc            ;[DD]        ...
  2766.     jsr    ploth        ;[DD][26]    ...
  2767.     ldx    cm.rty        ;  Get L.O. byte addr of prompt
  2768.     ldy    cm.rty+1    ;     and H.O. byte
  2769.     jsr    prstr        ; Reprint the prompt
  2770.     jsr    screl0        ; Get rid of garbage on that line
  2771.     lda    #cmbuf\        ; Now reset the buffer pointer
  2772.     sta    cm.bfp        ;     to the beginning of the buffer
  2773.     lda    #cmbuf^        ;        ...
  2774.     sta    cm.bfp+1    ;        ...
  2775.     lda    #$00        ; Clear AC
  2776.     sta    cmccnt        ; Clear the character count
  2777.     jmp    repars        ; Reparse new line from beginning
  2778. cminb2: cmp    #bs        ; Is it a <bs>?
  2779.     beq    cminb3        ; Yes
  2780. ;    cmp    #cdel        ; A <del>?
  2781.     cmp    #$7f        ;[46]
  2782.     bne    cminb4        ; No
  2783. cminb3: jsr    scrl        ; move the cursor left
  2784.     jsr    screl0        ; Now clear from there to end of line
  2785.     dec    cmccnt        ; Decrement the character count
  2786.     dec    cmccnt        ;    twice.
  2787.     lda    cmccnt        ; Now fetch it
  2788.     cmp    #$00        ; Did we back up too far??
  2789.     bpl    cmnb32        ; No, go on
  2790.     jsr    bell        ; Yes, ring the bell and
  2791.     jmp    cmnb12        ;    go reprint prompt and reparse line
  2792. cmnb32: sec            ; Set the carry
  2793.     lda    cm.bfp        ; Now decrement the buffer pointer
  2794.     sbc    #$02        ;    twice.
  2795.     sta    cm.bfp        ; Store it
  2796.     bcs    cmnb33
  2797.     dec    cm.bfp+1    ; Decrement to account for the borrow
  2798. cmnb33: jmp    repars        ; Time to reparse everything
  2799. cminb4:    cmp    #ctrlw        ;  Delete a word?
  2800.     beq    cmnb41        ;  Yes, go take care of that
  2801.     jmp    cmib40        ;  Nope, continue
  2802. cmnb41:    lda    #$03        ;  Set up negative offset count
  2803.     sta    cmwrk2        ;         ...
  2804.     sec            ;  Set up to adjust buffer pointer
  2805.     lda    cm.bfp        ;  Get the L.O. byte
  2806.     sbc    #$03        ;  Adjust pointer down by 3
  2807.     sta    cm.bfp        ;  Store it back
  2808.     bcs    cmnb42        ;  Don't worry about H.O. byte
  2809.     dec    cm.bfp+1    ;  Adjust H.O. byte also
  2810. cmnb42:    lda    cmwrk2        ;  First, check the count
  2811.     cmp    cmccnt        ;  Cmwrk2 > cmccnt?
  2812.     bmi    cmints        ;  No, go test characters
  2813.     jmp    cmnb12        ;  Yes, go clear the whole line
  2814. cmints:    ldy    #$00        ;  Zero Y
  2815.     lda    (cm.bfp),y    ;  Get previous character
  2816.     cmp    #lf        ;  Start to test ranges...
  2817.     bpl    cmits1        ;     Between <lf> and <cr>?
  2818.     jmp    cminac        ;  No, not in range at all
  2819. cmits1:    cmp    #cr+1        ;         ...
  2820.     bmi    cmnb43        ;  Yes, handle it
  2821.     cmp    #space        ;  Between <sp> and '"'?
  2822.     bpl    cmits2        ;  Possible, continue
  2823.     jmp    cminac        ;  No, advance to previous character
  2824. cmits2:    cmp    #dquot+1    ;         ...
  2825.     bmi    cmnb43        ;  Yes, delete back to there
  2826.     cmp    #apos        ;  Between Apostrophy and '/'?
  2827.     bpl    cmits3        ;  Could be, continue
  2828.     jmp    cminac        ;  Nope, advance character
  2829. cmits3:    cmp    #slash+1    ;         ...
  2830.     bmi    cmnb43        ;  Yup, found a delimiter
  2831.     cmp    #colon        ;  Between ':' and '>' perhaps?
  2832.     bpl    cmits4        ;  Maybe
  2833.     jmp    cminac        ;  Nope, advance to previous character    
  2834. cmits4:    cmp    #rabr+1     ;         ...
  2835.     bmi    cmnb43        ;  It is, go delete back to there
  2836.     cmp    #quot        ;  Is it a "'"?
  2837.     bne    cminac        ;  No, advance
  2838. cmnb43:    dec    cmwrk2        ;  Adjust this count
  2839.     clc            ;     and the buffer pointer
  2840.     lda    cm.bfp        ;         ...
  2841.     adc    #$01        ;         ...
  2842.     sta    cm.bfp        ;         ...
  2843.     bcc    cmnb44        ;         ...
  2844.     inc    cm.bfp+1    ;         ...
  2845. cmnb44:    lda    cmccnt        ;  Get the command buffer length
  2846. cmnbcc:    sec            ;[37] Get the cursor coordinates
  2847.     jsr    ploth        ;[37]        ...
  2848.     sty    savey        ;[37] Save cursor position
  2849.     cmp    savey        ;[37]  Check against horizontal cursor position
  2850.     bmi    cmnbna        ;  It's smaller, skip vert. cursor adjust
  2851.     dex            ;[37]  Adjust cursor vertical position
  2852.     pha            ; Save the AC across this call
  2853.     clc            ;[37] Set the cursor to the new position
  2854.     jsr    ploth        ;[26]        ...
  2855.     pla            ; Restore the AC
  2856.     sec            ;  Reflect this in number of characters
  2857.     sbc    #$28        ;     we skipped back over
  2858.     jmp    cmnbcc        ;  Go check again
  2859. cmnbna:    lda    #$00        ;  Put a null at the end of the buffer
  2860.     ldy    #$00        ;         ...
  2861.     sta    (cm.bfp),y    ;         ...
  2862.     jsr    screl2        ;  Clear current line
  2863.     sec            ;[37] Get the cursor position
  2864.     jsr    ploth        ;[37]        ...
  2865.     ldy    #$00        ;[EL] Zero the column number
  2866.     clc            ;[37]        ...
  2867.     jsr    ploth        ;[26]        ...
  2868.     ldx    cm.rty        ;  Reprint prompt
  2869.     ldy    cm.rty+1    ;         ...
  2870.     jsr    prstr        ;         ...
  2871.     ldx    #cmbuf\        ;  Reprint command buffer
  2872.     ldy    #cmbuf^        ;         ...
  2873.     jsr    prstr        ;         ...
  2874.     sec            ;  Now adjust the command character count
  2875.     lda    cmccnt        ;         ...
  2876.     sbc    cmwrk2        ;     by what we have accumulated
  2877.     sta    cmccnt        ;         ...
  2878.     jsr    screl0        ;  Clear to the end of this line
  2879.     jmp    repars        ;  Go reparse the command
  2880. cminac:    inc    cmwrk2        ;  Increment count of chars to back up
  2881.     sec            ;  Adjust the buffer pointer down again
  2882.     lda    cm.bfp        ;         ...
  2883.     sbc    #$01        ;         ...
  2884.     sta    cm.bfp        ;         ...
  2885.     bcs    cmnb45        ;  If carry set, skip H.O. byte adjustment
  2886.     dec    cm.bfp+1    ;  Adjust this
  2887. cmnb45:    jmp    cmnb42        ;  Go around once again
  2888.  
  2889. cmib40:    cmp    #quest        ; Need help?
  2890.     beq    cminb6        ;        ...
  2891.     cmp    #esc        ; Is he lazy?
  2892.     beq    cminb6        ;        ...
  2893.     cmp    #cr        ; Are we at end of line?
  2894.     beq    cminb5        ;        ...
  2895.     cmp    #lf        ; End of line?
  2896.     beq    cminb5        ;        ...
  2897.     cmp    #ffd        ; Is it a form feed?
  2898.     bne    cminb7        ; None of the above
  2899.     jsr    scrclr        ; clear the screen and home the cursor
  2900. cminb5: lda    cmccnt        ; Fetch character count
  2901.     cmp    #$01        ; Any characters yet?
  2902.     bne    cminb6        ; Yes
  2903.     jmp    prserr        ; No, parser error
  2904. cminb6: lda    #$ff        ; Go
  2905.     sta    cmaflg        ;    and set the action flag
  2906.     jmp    cminb9        ; Leave
  2907. cminb7:    cmp    #space        ; Is the character a space ?
  2908.     bne    cmnb71        ; No
  2909.     jsr    cout        ; Output the character
  2910.     jmp    cminb1        ; Yes, get another character
  2911. cmnb71:    cmp    #tab        ; Is it a <tab>?
  2912.     bne    cmnb72        ; No
  2913. ;    jsr    cout        ; Output the character
  2914.     jsr    prttab        ;[46]
  2915.     jmp    cminb1        ; Yes, get more characters 
  2916. cmnb72:    jsr    cout        ; Print the character on the screen
  2917.     jmp    cminb1        ; Get more characters
  2918. cminb9: dec    cmccnt        ; Decrement the count once
  2919.     plp            ; Restore the processor status
  2920.     pla            ;    the Y register
  2921.     tay            ;        ...
  2922.     pla            ;    the X register
  2923.     tax            ;        ...
  2924.     pla            ;    and the AC
  2925.     rts            ;    and return!
  2926.  
  2927.  
  2928. .SBTTL    Cmgtch - get a character from the command buffer
  2929.  
  2930. ;
  2931. ;    This routine takes the next character out of the command
  2932. ;    buffer, does some checking (action character, space, etc.)
  2933. ;    and then returns it to the calling program in the AC
  2934. ;
  2935. ;        Input:  NONE
  2936. ;
  2937. ;        Output: A-    Next character from command buffer
  2938. ;
  2939. ;        Registers destroyed:    A,X,Y
  2940. ;
  2941.  
  2942. cmgtch: ldy    #$00        ; Y should always be zero here to index buffer
  2943.     lda    cmaflg        ; Fetch the action flag
  2944.     cmp    #$00        ; Set??
  2945.     bne    cmgt1        ; Yes
  2946.     jsr    cminbf        ; No, go fetch some more input
  2947. cmgt1:  lda    (cm.ptr),y    ; Get the next character
  2948.     tax            ; Hold on to it here for a moment
  2949.     clc            ; Clear the carry flag
  2950.     lda    cm.ptr        ; Increment
  2951.     adc    #$01        ;    the next character pointer
  2952.     sta    cm.ptr        ;        ...
  2953.     bcc    cmgt2        ;        ...
  2954.     inc    cm.ptr+1    ; Have carry, increment H.O. byte
  2955. cmgt2:  txa            ; Now, get the data
  2956.     cmp    #space        ; Space?
  2957.     beq    cmgtc2        ; Yes
  2958.     cmp    #tab        ; <tab>?
  2959.     bne    cmgtc3        ; Neither space nor <tab>
  2960. cmgtc2:    pha            ; Hold the character here till we need it
  2961.     lda    #cmtxt        ; Are we parsing a string?
  2962.     cmp    cmstat        ;         ...
  2963.     beq    cmgtis        ; Yes, ignore space flag test
  2964.     lda    #cmifi        ; Are we parsing a file name?
  2965.     cmp    cmstat        ;        ...
  2966.     beq    cmgtis        ; Yes, ignore the space flag test
  2967.     lda    cmsflg        ; Get the space flag
  2968.     cmp    #$00        ; Was the last character a space?
  2969.     beq    cmgtis        ;  No, go set space flag
  2970.     pla            ;  Pop the character off
  2971.     jmp    cmgtch        ;  But ignore it and get another
  2972. cmgtis:    lda    #$ff        ; Set
  2973.     sta    cmsflg        ;    the space flag
  2974.     pla            ;  Restore the space or <tab>
  2975.     jmp    cmgtc5        ; Go return
  2976. cmgtc3: php            ; Save the processor status
  2977.     pha            ; Save this so it doesn't get clobbered
  2978.     lda    #$00        ; Clear AC
  2979.     sta    cmsflg        ; Clear space flag
  2980.     pla            ; Restore old AC
  2981.     plp            ; Restore the processor status
  2982.     cmp    #esc        ; Escape?
  2983.     beq    cmgtc5        ;
  2984.     cmp    #quest        ; Need help?
  2985.     beq    cmgtc4        ;
  2986.     cmp    #cr        ; <cr>?
  2987.     beq    cmgtc4        ;
  2988.     cmp    #lf        ; <lf>?
  2989.     beq    cmgtc4        ;
  2990.     cmp    #ffd        ; <ff>?
  2991.     beq    cmgtc4        ;
  2992.     and    #$7f        ; Make sure the character is positive
  2993.     rts            ; Not an action character, just return
  2994. cmgtc4: tax            ; Hold the data
  2995.     sec            ; Set the carry flag
  2996.     lda    cm.ptr        ; Get the next character pointer
  2997.     sbc    #$01        ;    and decrement it
  2998.     sta    cm.ptr        ;
  2999.     bcs    cmgtc5        ;
  3000.     dec    cm.ptr+1    ;
  3001. cmgtc5: txa            ; Now, fetch the data
  3002.     ora    #$80        ; Make it look like a terminator
  3003.     rts            ; Go back
  3004.  
  3005. .SBTTL    Prcrlf subroutine - print a crelf
  3006.  
  3007. ;
  3008. ;    This routine sets up a call to prstr pointing to the crlf
  3009. ;    string.
  3010. ;
  3011. ;        Registers destroyed:    A
  3012. ;
  3013.  
  3014. prcl.0: lda    #cr        ; Get a cr in the AC
  3015.     jsr    cout        ;    and print it out
  3016.     rts            ; Return
  3017.  
  3018. .SBTTL    Prstr subroutine
  3019.  
  3020. ;
  3021. ;    This routine prints a string ending in a null.
  3022. ;
  3023. ;        Input:  X-    Low order byte address of string
  3024. ;            Y-    High order byte address of string
  3025. ;
  3026. ;        Output:        Prints string on screen
  3027. ;
  3028. ;        Registers destroyed:    A,X,Y
  3029. ;
  3030.  
  3031. prst.0: stx    saddr        ; Save Low order byte
  3032.     sty    saddr+1        ; Save High order byte
  3033.     ldx    #3        ;[DD] Open chan 3 for output
  3034.     jsr    chkout        ;[DD]        ...
  3035.     ldy    #$00        ; Clear Y reg
  3036.  
  3037. prst1:
  3038. prst3:    lda    (saddr),y    ; Get the next byte of the string
  3039.     beq    prsdon        ; If it is null, we are done
  3040.     and    #$7f        ;[DD] mask 7 bits
  3041.     jsr    cout        ;[DD] output to screen
  3042.     jsr    dely        ;[44] Delay
  3043.     iny            ; Up the index
  3044.     bne    prst2        ; If it is zero, the string is <256, continue
  3045.     inc    saddr+1        ; Increment page number
  3046. prst2:  jmp    prst1        ; Go back to print next byte
  3047.  
  3048. prsdon: rts            ; Return
  3049.  
  3050. dely:    tya            ;[44] Save Y
  3051.     pha            ;[44]        ...
  3052.     ldy    #2        ;[44] Delay 2 ms.
  3053. del1:    ldx    #250        ;[44] Inner loop 1 ms.
  3054. del2:    dex            ;[44] Delay 1 ms.
  3055.     bne    del2        ;[44]        ...
  3056.     dey            ;[44]  2 times.
  3057.     bne    del1        ;[44]        ...
  3058.     pla            ;[44] Restore Y
  3059.     tay            ;[44]        ...
  3060.     rts            ;[44] Return
  3061.  
  3062.  
  3063. .SBTTL    Mul16 - 16-bit multiply routine
  3064.  
  3065. ;
  3066. ;    This and the following four routines is math support for the
  3067. ;    Comnd package. These routines come from '6502 Assembly Language
  3068. ;    Subroutines' by Lance A. Leventhal. Refer to that source for
  3069. ;    more complete documentation.
  3070. ;
  3071.  
  3072. ml16:    pla            ; Save the return address
  3073.     sta    rtaddr        ;        ...
  3074.     pla            ;        ...
  3075.     sta    rtaddr+1    ;        ...
  3076.     pla            ; Get multiplier
  3077.     sta    mlier        ;        ...
  3078.     pla            ;        ...
  3079.     sta    mlier+1        ;        ...
  3080.     pla            ; Get multiplicand
  3081.     sta    mcand        ;        ...
  3082.     pla            ;        ...
  3083.     sta    mcand+1        ;        ...
  3084.     lda    #$00        ; Zero
  3085.     sta    hiprod        ;    high word of product
  3086.     sta    hiprod+1    ;        ...
  3087.     ldx    #17        ; Number of bits in multiplier plus 1, the
  3088.                 ;    extra loop is to move the last carry
  3089.                 ;    into the product.
  3090.     clc            ; Clear carry for first time through the loop
  3091. mullp:  ror    hiprod+1    ; Shift the whole thing down
  3092.     ror    hiprod        ;        ...
  3093.     ror    mlier+1        ;        ...
  3094.     ror    mlier        ;        ...
  3095.     bcc    deccnt        ; Branch if next bit of multiplier is 0
  3096.     clc            ; next bit is 1 so add multiplicand to product
  3097.     lda    mcand        ;        ...
  3098.     adc    hiprod        ;        ...
  3099.     sta    hiprod        ;        ...
  3100.     lda    mcand+1        ;        ...
  3101.     adc    hiprod+1    ;        ...
  3102.     sta    hiprod+1    ; Carry = overflow from add
  3103. deccnt: dex            ;        ...
  3104.     bne    mullp        ; Continue until done
  3105.     lda    mlier+1        ; Get low word of product and push it
  3106.     pha            ;    onto the stack
  3107.     lda    mlier        ;        ...
  3108.     pha            ;        ...
  3109.     lda    rtaddr+1    ; Restore the return address
  3110.     pha            ;        ...
  3111.     lda    rtaddr        ;        ...
  3112.     pha            ;        ...
  3113.     rts            ; Return
  3114.  
  3115. mcand:  .blkb    2        ; Multiplicand
  3116. mlier:  .blkb    2        ; Multiplier and low word of product
  3117. hiprod: .blkb    2        ; High word of product
  3118. rtaddr: .blkb    2        ; Save area for return address
  3119.  
  3120. .SBTTL    Rskp - Do a skip return
  3121.  
  3122. ;
  3123. ;    This routine returns, skipping the instruction following the
  3124. ;    original call. It is assumed that the instruction following the
  3125. ;    call is a JMP.
  3126. ;
  3127. ;        Input:
  3128. ;
  3129. ;        Output:
  3130. ;
  3131. ;        Registers destroyed:    None
  3132. ;
  3133.  
  3134. rskp.0:    sta    savea        ; Save the registers
  3135.     stx    savex        ;
  3136.     sty    savey        ;
  3137.     pla            ; Get Low order byte of return address
  3138.     tax            ; Hold it
  3139.     pla            ; Get High order byte
  3140.     tay            ; Hold that
  3141.     txa            ; Get Low order byte
  3142.     clc            ; Clear the carry flag
  3143.     adc    #$04        ; Add 4 to the address
  3144.     bcc    rskp2        ; No carry
  3145.     iny            ; Increment the high order byte
  3146. rskp2:  sta    saddr        ; Store L.O. byte
  3147.     sty    saddr+1        ; Store H.O. byte
  3148.     lda    savea        ;
  3149.     ldx    savex        ;
  3150.     ldy    savey        ;
  3151.     jmp    (saddr)        ; Jump at the new address
  3152.  
  3153. .SBTTL    Setbrk and Rstbrk
  3154.  
  3155. ;
  3156. ;    These routines are called from the user program to set or reset
  3157. ;    break characters to be used by Cmunqs. The byte to set or reset
  3158. ;    is located in the Accumulator. Rstbrk has the option to reset
  3159. ;    the entire break-word. This occurs if the H.O. bit of AC is on.
  3160. ;
  3161.  
  3162. sbrk.0:    and    #$7f        ; We don't want the H.O. bit
  3163.     ldy    #$00        ; Set up Y to index the byte we want
  3164. sbrkts:    cmp    #$08        ; Is the offset > 8
  3165.     bmi    sbrkfw        ; No, we are at the right byte now
  3166.     sec            ; Yes, adjust it down again
  3167.     sbc    #$08        ;        ...
  3168.     iny            ; Advance index
  3169.     jmp    sbrkts        ;    and try again
  3170. sbrkfw:    tax            ; This is the remaining offset
  3171.     lda    #$80        ; Start with H.O. bit on
  3172. sbrklp:    cpx    #$00        ; Is it necessary to shift down?
  3173.     beq    sbrkfb        ; No, we are done
  3174.     dex            ; Yes, adjust offset
  3175.     lsr    a        ; Shift bit down once
  3176.     jmp    sbrklp        ; Go back and try again
  3177. sbrkfb:    ora    brkwrd,y    ; We found the bit, use the byte offset
  3178.     sta    brkwrd,y    ;    from above, set the bit and resave
  3179.     rts            ; Return
  3180.  
  3181. rbrk.0:    asl    a        ; Check H.O. bit
  3182.     bcs    rbrkal        ; If that was on, Zero entire brkwrd
  3183.     lsr    a        ; Else shift back (H.O. bit is zeroed)
  3184. rbrkts:    cmp    #$08        ; Are we in the right word?
  3185.     bmi    rbrkfw        ; Yes, go figure the rest of the offset
  3186.     sec            ; No, Adjust the offset down
  3187.     sbc    #$08        ;        ...
  3188.     iny            ;    and the index up
  3189.     jmp    rbrkts        ; Try again
  3190. rbrkfw:    tax            ; Stuff the remaining offset in X
  3191.     lda    #$7f        ; Start with H.O. bit off
  3192. rbrklp:    cpx    #$00        ; Do we need to offset some more?
  3193.     beq    rbrkfb        ; No, we have the correct bit
  3194.     dex            ; Yes, decrement the offset
  3195.     sec            ; Make sure carry is on
  3196.     ror    a        ;    and rotate a 1 bit into mask
  3197.     jmp    rbrklp        ; Go back and try again
  3198. rbrkfb:    and    brkwrd,y    ; We found the bit, now shut it off
  3199.     sta    brkwrd,y    ;        ...
  3200.     rts            ;    and return
  3201. rbrkal:    lda    #$00        ; Go stuff zeros in the entire word
  3202.     ldy    #$00        ;        ...
  3203. rbrksz:    sta    brkwrd,y    ; Stuff the zero
  3204.     iny            ; Up the index once
  3205.     cpy    #$10        ; Are we done?
  3206.     bmi    rbrksz        ; Not yet
  3207.     rts            ; Yes, return
  3208.  
  3209. .SBTTL    Chkbrk
  3210.  
  3211. ;
  3212. ;    Chkbrk - This routine looks for the flag in the break word
  3213. ;    which represents the character passed to it. If this bit is
  3214. ;    on, it is a break character and the routine will simply
  3215. ;    return. If it is not a break character, the routine skips..
  3216. ;
  3217.  
  3218. chkbrk:    sta    savea        ; Save byte to be checked
  3219.     and    #$7f        ; Shut H.O. bit
  3220.     ldy    #$00        ; Zero this index
  3221. cbrkts:    cmp    #$08        ; Are we at the right word?
  3222.     bmi    cbrkfw        ; Yes, go calculate bit position
  3223.     sec            ; No, adjust offset down
  3224.     sbc    #$08        ;        ...
  3225.     iny            ; Increment the index
  3226.     jmp    cbrkts        ; Go back and test again
  3227. cbrkfw:    tax            ; Stuff the remaining offset in X
  3228.     lda    #$80        ; Set H.O. bit on for testing
  3229. cbrklp:    cpx    #$00        ; Are we in position yet?
  3230.     beq    cbrkfb        ; Yes, go test the bit
  3231.     dex            ; No, decrement the offset
  3232.     lsr    a        ;    and adjust the bit position
  3233.     jmp    cbrklp        ; Go and try again
  3234. cbrkfb:    and    brkwrd,y    ; See if the bit is on
  3235.     bne    cbrkbc        ; It is a break character
  3236.     lda    savea        ; Restore the character
  3237.     jmp    rskp        ; Not a break character, skip return
  3238. cbrkbc:    lda    savea        ; Restore the character
  3239.     rts            ; Return
  3240.  
  3241. .SBTTL    Cmehlp - Do extra help on Question-mark prompting
  3242.  
  3243. ;
  3244. ;    Cmehlp - This routine uses a string of commands passed to it
  3245. ;    in order to display alternate valid parse types to the user.
  3246. ;
  3247. ;        Input:    Cmehpt-    Pointer to valid parse types (end in 00)
  3248. ;
  3249. ;        Output:    Display on screen, alternate parse types
  3250. ;
  3251. ;        Registers destroyed:    A,X,Y
  3252. ;
  3253.  
  3254. cmehlp:    lda    cmstat        ; We are going to need this so
  3255.     pha            ;    save it across the call
  3256.     ldy    #$00        ; Zero out the help index
  3257.     sty    cmehix        ;        ...
  3258. cmehl1:    ldy    cmehix        ; Load the extra help index
  3259.     lda    (cmehpt),y    ; Fetch next type
  3260.     sta    cmstat        ; Store it here
  3261.     inc    cmehix        ; Increase the index by one
  3262.     cmp    #$00        ; Is the type null?
  3263.     bne    cmeh0        ; No, continue
  3264.     jmp    cmehrt        ; Yes, terminate
  3265. cmeh0:    cmp    #cmtok+1    ; If the type is out of range, leave
  3266.     bmi    cmeh1        ;        ...
  3267.     jmp    cmehrt        ;        ...
  3268. cmeh1:    pha            ; Save the type across the call
  3269.     ldx    #cmors\        ; Set up address of 'OR ' string
  3270.     ldy    #cmors^        ;        ...
  3271.     jsr    prstr        ;    and print it
  3272.     pla            ; Restore AC
  3273.     cmp    #cmkey        ; Compare with keyword
  3274.     bne    cmeh2        ; No, try next type
  3275. cmeh10:    tax            ; Hold type in X register
  3276.     lda    cmsptr        ; Save these parms so they can be restored
  3277.     pha            ;        ...
  3278.     lda    cmsptr+1    ;        ...
  3279.     pha            ;        ...
  3280.     lda    cm.ptr        ; Copy the pointer to the saved pointer
  3281.     sta    cmsptr        ;    so the keyword print routine prints
  3282.     pha            ;    the entire table. Also, save it on
  3283.     lda    cm.ptr+1    ;    the stack so it can be restored later
  3284.     sta    cmsptr+1    ;        ...
  3285.     pha            ;        ...
  3286.     lda    cmptab        ; Save the table address also
  3287.     pha            ;        ...
  3288.     lda    cmptab+1    ;        ...
  3289.     pha            ;        ...
  3290.     txa            ; Restore type
  3291.     cmp    #cmkey        ; Keyword?
  3292.     bne    cmeh11        ; No, it must be a switch table
  3293.     ldx    #cmin01\    ; Set up address of message
  3294.     ldy    #cmin01^    ;        ...
  3295.     jmp    cmeh12        ; Go print the string
  3296. cmeh11:    ldx    #cmin02\    ; Set up address of 'switch' string
  3297.     ldy    #cmin02^    ;        ...
  3298. cmeh12:    jsr    prstr        ; Print the message
  3299.     ldy    cmehix        ; Get the index into help string
  3300.     lda    (cmehpt),y    ; Fetch L.O. byte of table address
  3301.     sta    cmptab        ; Set that up for Cmktp
  3302.     iny            ; Increment the index
  3303.     lda    (cmehpt),y    ; Get H.O. byte
  3304.     sta    cmptab+1    ; Set it up for Cmktp
  3305.     iny            ; Advance the index
  3306.     sty    cmehix        ;    and store it
  3307.     jsr    cmktp        ; Print the keyword table
  3308.     pla            ; Now restore all the stuff we saved before
  3309.     sta    cmptab+1    ;        ...
  3310.     pla            ;        ...
  3311.     sta    cmptab        ;        ...
  3312.     pla            ;        ...
  3313.     sta    cm.ptr+1    ;        ...
  3314.     pla            ;        ...
  3315.     sta    cm.ptr        ;        ...
  3316.     pla            ;        ...
  3317.     sta    cmsptr+1    ;        ...
  3318.     pla            ;        ...
  3319.     sta    cmsptr        ;        ...
  3320.     jmp    cmehl1        ; See if there is more to do
  3321. cmeh2:    cmp    #cmswi        ; Type is switch?
  3322.     bne    cmeh3        ; No, continue
  3323.     jmp    cmeh10        ; We can treat this just like a keyword
  3324. cmeh3:    cmp    #cmifi        ; Input file?
  3325.     bne    cmeh4        ; No, go on
  3326.     ldx    #cmin03\    ; Set up the message address
  3327.     ldy    #cmin03^    ;        ...
  3328.     jmp    cmehps        ; Go print it
  3329. cmeh4:    cmp    #cmofi        ; Output file?
  3330.     bne    cmeh5        ; Nope, try again
  3331.     ldx    #cmin04\    ; Set up message address
  3332.     ldy    #cmin04^    ;        ...
  3333.     jmp    cmehps        ; Go print the string
  3334. cmeh5:    cmp    #cmcfm        ; Confirm?
  3335.     bne    cmeh6        ; No
  3336.     ldx    #cmin00\    ; Set up address
  3337.     ldy    #cmin00^    ;        ...
  3338.     jmp    cmehps        ; Print the string
  3339. cmeh6:    cmp    #cmtxt        ; Unquoted string?
  3340.     bne    cmeh7        ; No, try next one
  3341.     ldx    #cmin06\    ; Set up address
  3342.     ldy    #cmin06^    ;        ...
  3343.     jmp    cmehps        ; Print
  3344. cmeh7:    cmp    #cmnum        ; Integer?
  3345.     bne    cmeh8        ; Try again
  3346.     ldx    #cmin05\    ; Set up message
  3347.     ldy    #cmin05^    ;        ...
  3348.     jsr    prstr        ; Print it
  3349.     ldy    cmehix        ; Get index
  3350.     inc    cmehix        ; Advance index
  3351.     lda    (cmehpt),y    ; Get base of integer
  3352.     cmp    #$0a        ; Is it greater than decimal 10?
  3353.     bmi    cmeh71        ; No, just print the L.O. digit
  3354.     lda    #$31        ; Print the H.O. digit as a 1
  3355.     jsr    cout        ; Print the '1'
  3356.     ldy    cmehix        ; Load index
  3357.     dey            ; Point back to last byte
  3358.     lda    (cmehpt),y    ; Get the base back
  3359.     sec            ; Set the carry flag for subtraction
  3360.     sbc    #$0a        ; Subtract off decimal 10
  3361. cmeh71:    clc            ; Clear carry for addition
  3362.     adc    #$30        ; Make it printable
  3363.     jsr    cout        ; Print the digit
  3364.     jsr    prcrlf        ; Print a crelf
  3365.     jsr    prbyte        ; Print the byte
  3366.     jmp    cmehl1        ; Go back for more
  3367. cmeh8:    ldx    #cmin07\    ; Assume it's a token
  3368.     ldy    #cmin07^    ;        ...
  3369. cmehps:    jsr    prstr        ; Print string
  3370.     jsr    prcrlf        ; Print a crelf
  3371.     jmp    cmehl1        ; Go back
  3372. cmehrt:    pla            ; Restore
  3373.     sta    cmstat        ;    current parse type
  3374.     rts
  3375.  
  3376. .SBTTL    Cmcpdf - Copy a default string into the command buffer
  3377.  
  3378. ;
  3379. ;    Cmcpdf - This routine copies a default for a field
  3380. ;    into the command buffer andreparses the string.
  3381. ;
  3382. ;        Input:    Cmdptr-    Pointer to default field value (asciz)
  3383. ;
  3384. ;        Output:
  3385. ;
  3386. ;        Registers destroyed:    A,X,Y
  3387. ;
  3388.  
  3389. cmcpdf:    sec            ; Reset the buffer pointer
  3390.     lda    cm.bfp        ;        ...
  3391.     sbc    #$01        ;        ...
  3392.     sta    cm.bfp        ;        ...
  3393.     bcs    cmcpst        ; If carry set, don't adjust H.O. byte
  3394.     dec    cm.bfp+1    ;        ...
  3395. cmcpst:    dec    cmccnt        ; Adjust the character count
  3396.     ldy    #$00        ; Zero the index
  3397. cmcplp:    lda    (cmdptr),y    ; Get byte
  3398.     beq    cmcpdn        ; Copy finished, leave
  3399.     ldx    cmccnt        ; Check character count
  3400.     inx            ; If it is just short of wrapping
  3401.     bne    cmcpl1        ;    then we are overflowing buffer
  3402.     jsr    bell        ; If that is the case, tell the user
  3403.     dec    cmccnt        ; Make sure it doesn't happen again
  3404.     jmp    prserr        ;    for same string.
  3405. cmcpl1:    
  3406. ;    ora    #$80        ; Be consistent, make sure H.O. bit is on
  3407.     sta    (cm.bfp),y    ; Stuff it in the buffer
  3408.     inc    cmccnt        ; Adjust character count
  3409.     iny            ; Up the buffer index
  3410.     jmp    cmcplp        ; Go to top of loop
  3411. cmcpdn:    lda    #space        ; Get a space
  3412.     sta    (cm.bfp),y    ;    and place it in buffer after keyword
  3413.     iny            ; Increment the buffer index
  3414.     lda    #nul        ; Get a null
  3415.     sta    (cm.bfp),y    ;    and stuff that at the end of buffer
  3416.     clc            ; Now recompute the end of usable buffer
  3417.     tya            ; Get the number of chars added
  3418.     adc    cm.bfp        ; Add that to the buffer pointer
  3419.     sta    cm.bfp        ;        ...
  3420.     lda    #$00        ;        ...
  3421.     adc    cm.bfp+1    ;        ...
  3422.     sta    cm.bfp+1    ;        ...
  3423.     lda    #$00        ; Reset the action flag
  3424.     sta    cmaflg        ;        ...
  3425.     sec            ; Now adjust the command pointer to the
  3426.     lda    cm.ptr        ;    beginning of the copied field
  3427.     sbc    #$01        ;        ...
  3428.     tax            ; Set it up in X and Y so we can call Prstr
  3429.     lda    cm.ptr+1    ;        ...
  3430.     sbc    #$00        ;        ...
  3431.     tay            ;        ...
  3432.     jsr    prstr        ; Print the added field
  3433.     jmp    repars        ; Now go reparse the whole command
  3434.  
  3435. .SBTTL    Comnd Jsys messages and table storage
  3436.  
  3437. cmer00: .byte    cr
  3438.     .byte    "? Program error:  invalid comnd call"
  3439.     .byte    0        ; [53]
  3440.  
  3441. cmer01: .byte    cr
  3442.     .byte    "? Ambiguous"
  3443.     .byte    0        ; [53]
  3444.  
  3445. cmer02: .byte    cr
  3446.     .byte    "? Illegal input file spec"
  3447.     .byte    0        ; [53]
  3448.  
  3449. cmer03: .byte    cr
  3450.     .byte    "? No keywords match this prefix"
  3451.     .byte    0        ; [53]
  3452.  
  3453. cmer04: .byte    cr
  3454.     .byte    "? No switches match this prefix"
  3455.     .byte    0        ; [53]
  3456.  
  3457. cmer05: .byte    cr
  3458.     .byte    "? Bad character in integer number"
  3459.     .byte    0        ; [53]
  3460.  
  3461. cmer06: .byte    cr
  3462.     .byte    "? Base of integer out of range"
  3463.     .byte    0        ; [53]
  3464.  
  3465. cmer07: .byte    cr
  3466.     .byte    "? Overflow while reading integer number"
  3467.     .byte    0        ; [53]
  3468.  
  3469. cmin00: .byte    " Confirm with carriage return"
  3470.     .byte    0        ; [53]
  3471.  
  3472. cmin01: .byte    " Keyword, one of the following:"
  3473.     .byte    0        ; [53]
  3474.  
  3475. cmin02: .byte    " Switch, one of the following:"
  3476.     .byte    0        ; [53]
  3477.  
  3478. cmin03: .byte    " Input file spec"
  3479.     .byte    0        ; [53]
  3480.  
  3481. cmin04: .byte    " Output file spec"
  3482.     .byte    0        ; [53]
  3483.  
  3484. cmin05: .byte    " Integer number in base "
  3485.     .byte    0        ; [53]
  3486.  
  3487. cmin06:    .byte    " Unquoted text string "
  3488.     .byte    0        ; [53]
  3489.  
  3490. cmin07:    .byte    " Single character token "
  3491.     .byte    0        ; [53]
  3492.  
  3493.  
  3494. cmors:    .byte    " or "
  3495.     .byte    0        ; [53]
  3496.  
  3497.  
  3498. .SBTTL    Kermit defaults for operational parameters
  3499.  
  3500. ;
  3501. ;    The following are the defaults which this Kermit uses for
  3502. ;    the protocol.
  3503. ;
  3504.  
  3505. dquote  =    '#        ; The quote character
  3506. dpakln  =    $5e        ; The packet length
  3507. dpadch  =    nul        ; The padding character
  3508. dpadln  =    0        ; The padding length
  3509. dmaxtr  =    $14        ; The maximum number of tries
  3510. debq    =    '&        ; The eight-bit-quote character
  3511. dtime    =    10        ; The default time-out amount
  3512. deol    =    cr        ; The end-of-line character
  3513.  
  3514. .SBTTL    Kermit data
  3515.  
  3516. ;
  3517. ;    The following is data storage used by Kermit
  3518. ;
  3519.  
  3520. mxpack  =    dpakln        ; Maximum packet size
  3521. mxfnl    =    $1e        ; Maximum file-name length
  3522. eof    =    $01        ; This is the value for End-of-file
  3523. buflen  =    $ff        ; Buffer length for received data
  3524. kerbf1  =    $1a        ; This always points to packet buffer
  3525. kerbf2    =    $1c        ; This always points to data buffer
  3526. true    =    $01        ; Symbol for true return code
  3527. false    =    $00        ; Symbol for false return code
  3528. on    =    $01        ; Symbol for value of 'on' keyword
  3529. off    =    $00        ; Symbol for value of 'off' keyword
  3530. yes    =    $01        ; Symbol for value of 'yes' keyword
  3531. no    =    $00        ; Symbol for value of 'no' keyword
  3532. terse    =    $01        ; Symbol for terse debug mode
  3533. verbose    =    $02        ; Symbol for verbose debug mode
  3534. xon    =    $11        ; Xon for Ibm-mode
  3535. fbsbit  =    $01        ; Value for SEVEN-BIT FILE-BYTE-SIZE
  3536. fbebit  =    $00        ; Value for EIGHT-BIT FILE-BYTE-SIZE
  3537. nparit    =    $00        ; Value for PARITY NONE
  3538. sparit    =    $01        ; Value for PARITY SPACE
  3539. mparit    =    $02        ; Value for PARITY MARK
  3540. oparit    =    $03        ; Value for PARITY ODD
  3541. eparit    =    $04        ; Value for PARITY EVEN
  3542. bd50    =    $00        ;[17] Value for BAUD 50
  3543. bd75    =    $01        ;[17]
  3544. bd110    =    $02        ;[17] Value for BAUD 110
  3545. bd150    =    $03        ;[17] Value for BAUD 150
  3546. bd300    =    $04        ;[17] Value for BAUD 300
  3547. bd1200    =    $05        ;[17] Value for BAUD 1200
  3548. bd1800    =    $06        ;[17] Value for BAUD 1800
  3549. bd2400    =    $07        ;[17] Value for BAUD 2400
  3550. eprflg    =    $40        ;    'Error packet received' flag
  3551. errcri  =    $01        ; Error code - cannot receive init
  3552. errcrf  =    $02        ; Error code - cannot receive file-header
  3553. errcrd  =    $03        ; Error code - cannot receive data
  3554. errmrc  =    $04        ; Error code - maximum retry count exceeded
  3555. errbch  =    $05        ; Error code - bad checksum
  3556. errfae  =    $0a        ; Error code - file already exists
  3557. emesln  =    $19        ; Standard error message length
  3558. kerrns  =    $1f        ; Routine name and action string length
  3559. kerdel  =    $15        ; Disk error length
  3560. kerems  =    $19        ; Error message size
  3561. kerfts    =    $0b        ; Size of file-type strings (incl. term. nul)
  3562. kerdsz    =    $09        ; Length of debug mode strings
  3563. kerpsl    =    $06        ; Size of parity strings
  3564. kerbsl    =    $05        ;[17] Size of baud strings
  3565. keremu    =    $07        ; size of terminal emulation strings
  3566. kerfrm    =    cminf1        ; 'From string' pointer for Kercpy routine
  3567. kerto    =    cminf2        ; 'To string' pointer for Kercpy routine
  3568.  
  3569. pdbuf:  .blkb    mxpack-2    ; Packet buffer
  3570. pdlen:  .byte            ; Common area to place data length
  3571. ptype:  .byte            ; Common area to place current packet type
  3572. pnum:    .byte            ; Common area to put packet number received
  3573. ;    plnbuf moved to the end.  Make sure text segment does not extend
  3574. ;    past $8000.  BI-80 rom lives at $8000, and interferes.
  3575. ;plnbuf: .blkb    $100        ;[DD] Port line buffer
  3576. pdtend: .byte            ; End of plnbuf pointer
  3577. pdtind: .byte            ; Index for plnbuf
  3578. rstat:  .byte            ; Return status
  3579. kerrta: .word            ; Save area for return address
  3580. prmt:    .byte    "Kermit-65>"    ; Prompting text
  3581.     .byte    0        ; [53]
  3582.  
  3583. lprmt    =    .-prmt        ; Length of prompting text
  3584. connec:    .byte    $00        ;[48] non-zero if in terminal mode
  3585. datind: .byte            ; Data index into packet buffer
  3586. chebo:  .byte            ; Switch to tell if 8th-bit was on
  3587. escflg: .byte            ; Flag indicating we have seen and escape ($1b)
  3588. addlf:  .byte            ; Add a <lf> flag
  3589. dellf:  .byte            ; Flush a <lf> flag
  3590. jtaddr: .word            ; Jump table address hold area
  3591. hch:    .byte            ; Hold area for ch
  3592. hcv:    .byte            ; Hold area for cv
  3593. kwrk01: .byte            ; Work area for Kermit
  3594. kwrk02: .byte            ; Work area for Kermit
  3595. kertpc:    .byte            ; Hold area for parity check
  3596. ksavea:    .byte            ; Save area for accumulator
  3597. ksavex:    .byte            ; Save area for X reg
  3598. ksavey:    .byte            ; Save area for Y reg
  3599. kerchr: .byte            ; Current character read off port
  3600. kermbs: .word            ; Base address of message table
  3601. debchk: .byte            ; Checksum for debug routine
  3602. debinx: .byte            ; Debug routine action index
  3603. fld:    .byte            ; State of receive in rpak routine
  3604. retadr: .word            ; Hold area for return address
  3605. n:    .byte            ; Message #
  3606. numtry: .byte            ; Number of tries for this packet
  3607. oldtry: .byte            ; Number of tries for previous packet
  3608. maxtry: .byte    dmaxtr        ; Maximum tries allowed for a packet
  3609. state:  .byte            ; Current state of system
  3610. local:    .byte            ; Local/Remote switch
  3611. size:    .byte            ; Size of present data
  3612. chksum: .byte            ; Checksum for packet
  3613. rtot:    .word            ; Total number of characters received
  3614. stot:    .word            ; Total number of characters sent
  3615. rchr:    .word            ; Number characters received, current file
  3616. schr:    .word            ; Number of characters sent, current file
  3617. rovr:    .word            ; Number of overhead characters on receive
  3618. sovr:    .word            ; Number of overhead characters on send
  3619. tpak:    .word            ; Number of packets for this transfer
  3620. eofinp: .byte            ; End-of-file (no characters left to send)
  3621. eodind: .byte            ; End-of-data reached on disk
  3622. errcod: .byte            ; Error indicator
  3623. errrkm:    .blkb    mxpack-2    ; Error message from remote Kermit
  3624. kerosp: .byte            ; Save area for stack pointer
  3625. escp:    .byte    $19        ; Character for escape from connection
  3626. fbsize: .byte    fbsbit        ; File-byte-size
  3627. filmod: .byte            ; Current file type
  3628. usehdr: .byte    off        ; Switch - where to get filename (on=file-head)
  3629. lecho:  .byte    off        ; Local-echo switch
  3630. ibmmod: .byte    off        ; Ibm-mode switch
  3631. vtmod:  .byte    on        ; VT-52 Emulation mode switch
  3632. parity: .byte    nparit        ; Parity setting
  3633. baud:    .byte    bd300        ;[17] Baud setting
  3634. wrdsiz:    .byte    fbebit        ;[17] Word length setting
  3635. flowmo:    .byte    off        ;[24] Flow-Control switch
  3636. delay:  .byte            ; Amount of delay before first send
  3637. filwar: .byte    off        ; File-warning switch
  3638. debug:  .byte    off        ; Debug switch
  3639. ebqmod: .byte    off        ; Eight-bit-quoting mode
  3640. cntrl:    .byte    $06        ;[EL] rs-232 control reg (300 baud default)
  3641. cmmnd:    .byte    $00        ;[EL] rs-232 command reg
  3642. optbdl:    .byte    $3c        ;[22] Kluge value for 1200 baud
  3643. optbdh:    .byte    $01        ;[22] Kluge value for 1200 baud
  3644. scrtype:.byte    $01        ; Default screen is 80-columns
  3645.  
  3646. ;
  3647. ;    These fields are set parameters and should be kept in this
  3648. ;    order to insure integrity when setting and showing values
  3649. ;
  3650.  
  3651. srind:  .byte            ; Switch to indicate which parm to print
  3652. ebq:    .byte    debq        ; Eight-bit quote character (rec. and send)
  3653.     .byte    debq        ;        ...
  3654. pad:    .byte    dpadln        ; Number of padding characters (rec. and send)
  3655.     .byte    dpadln        ;        ...
  3656. padch:  .byte    dpadch        ; Padding character (receive and send)
  3657.     .byte    dpadch
  3658. eol:    .byte    deol        ; End-of-line character (recevie and send)
  3659.     .byte    deol
  3660. psiz:    .byte    dpakln        ; Packet size (receive and send)
  3661.     .byte    dpakln
  3662. time:    .byte    dtime        ; Time-out interval (receive and send)
  3663.     .byte    dtime        ;
  3664. quote:  .byte    dquote        ; Quote character (receive and send)
  3665.     .byte    dquote        ;        ...
  3666. backclr:.byte    $ff        ; background color
  3667. britclr:.byte    $ff        ; light background color (selected with decrev)
  3668. foreclr:.byte    $ff        ; foreground color
  3669. altclr:    .byte    $ff        ; alternate color
  3670. bordclr:.byte    $ff        ; border color
  3671.  
  3672. ttime:    .word    $0000        ;[49] Time out interval (receive and send)
  3673.  
  3674. ;
  3675. ;    Some definitions to make life easier when referencing the above
  3676. ;    fields.
  3677. ;
  3678.  
  3679. rebq    =    ebq        ; Receive eight-bit-quote char
  3680. sebq    =    ebq+1        ; Send eight-bit-quote char
  3681. rpad    =    pad        ; Receive padding amount
  3682. spad    =    pad+1        ; Send padding amount
  3683. rpadch    =    padch        ; Receive padding character
  3684. spadch    =    padch+1        ; Send padding character
  3685. reol    =    eol        ; Receive end-of-line character
  3686. seol    =    eol+1        ; Send end-of-line character
  3687. rpsiz    =    psiz        ; Receive packet length
  3688. spsiz    =    psiz+1        ; Send packet length
  3689. rtime    =    time        ; Receive time out interval
  3690. stime    =    time+1        ; Send time out interval
  3691. rquote    =    quote        ; Receive quote character
  3692. squote    =    quote+1        ; Send quote character
  3693.  
  3694. .SBTTL    Kermit - CBM DOS support
  3695.  
  3696. ;
  3697. ;    The following definitions and storage will be used when setting
  3698. ;    up and executing calls to the DOS.
  3699. ;
  3700.  
  3701. fncrea  =    'R        ; Read function code
  3702. fncwrt  =    'W        ; Write function code
  3703. drdoll    =    '$        ;[40] Directory string
  3704. drcolo    =    ':        ;[40]
  3705. drstar    =    '*        ;[40]
  3706. kerfcb    =    $1e        ; Pointer to FCB
  3707. buff    =    $200        ; Temp disk char read
  3708.  
  3709. fmrcod: .byte    0        ; Disk status return code
  3710. primfn: .blkb    $23        ; File name
  3711. decnum:    .word            ; [54] Number being converted to decimal
  3712. dskers: .blkb    110        ; Storage for disk error messages
  3713. dosffm:    .byte    $00        ; 'First file modification done' switch
  3714. dosfni:    .byte    $00        ; Filename index
  3715. dosfvn:    .byte    $00        ; File version number for the alter routine
  3716. drivno:    .byte    $00        ;[40] Current drive device number
  3717. drunit:    .byte    '0        ;[40] Current drive Unit number
  3718. fcb1:    .blkb    mxfnl        ; Fcb for file being transmitted
  3719. flsrw:  .byte    0        ; Switch for r(ead) or w(rite)
  3720. flssp:  .byte    0        ; Switch for file type s or p
  3721. len:    .byte    0        ; Length for Dos open
  3722. fcmd:    .byte    "I0"        ; String to send 'Init BAM' command
  3723.  
  3724. .SBTTL    Kermit initialization
  3725.  
  3726. ;
  3727. ;    The following code sets up Kermit-65 for normal operation.
  3728. ;
  3729.  
  3730. kstart:    jsr    clall        ;[] First close all open channels
  3731.     jsr    ioinit        ;[16] Initialize I/O devices
  3732.     jsr    restoi        ; restore vectors
  3733.     jsr    scrini        ; initilize the screen packages
  3734.     jsr    restin        ; restore parameters from kermit.ini
  3735.  
  3736. init:    jsr    openrs        ;[34] Open the RS-232 port
  3737. ;     openm    #1,#0,#$ff,cntrl,#0    ;[DD] Open the keyboard
  3738.     lda    #1        ; [53]
  3739.     ldx    #0
  3740.     ldy    #$ff
  3741.     jsr    setlfs
  3742.     ldx    #cntrl\
  3743.     ldy    #cntrl^
  3744.     lda    #0
  3745.     jsr    setnam
  3746.     jsr    open
  3747.  
  3748. ;     openm    #3,#3,#$ff,cntrl,#0    ;[DD] Open the screen
  3749.     lda    #3        ; [53]
  3750.     ldx    #3
  3751.     ldy    #$ff
  3752.     jsr    setlfs
  3753.     ldx    #cntrl\
  3754.     ldy    #cntrl^
  3755.     lda    #0
  3756.     jsr    setnam
  3757.     jsr    open
  3758.  
  3759.     jsr    dopari        ;[]
  3760.     jsr    dobad        ;[]
  3761.     jsr    dowrd        ;[]
  3762.     ldx    #versio1\    ;Get address of version message
  3763.     ldy    #versio1^    ;        ...
  3764.     jsr    prstr        ;Print the version
  3765.     lda    #$01        ; use bold for "type ? for help"
  3766.     sta    alternt
  3767.     ldx    #versio2\
  3768.     ldy    #versio2^
  3769.     jsr    prstr
  3770.     lda    #$00
  3771.     sta    alternt
  3772.     jsr    kermit        ;Go execute kermit
  3773.     jmp    exit1        ;[17] and reenter BASIC
  3774.  
  3775. .SBTTL    Kermit - main routine
  3776.  
  3777. ;
  3778. ;    This routine is the main KERMIT loop. It prompts for commands
  3779. ;    and then it dispatches to the appropriate routine.
  3780. ;
  3781.  
  3782. kermit: tsx            ; Get the stack pointer
  3783.     stx    kerosp        ;    and save it in case of a fatal error
  3784.     ldx    #prmt\        ;  Fetch the address of the prompt
  3785.     ldy    #prmt^        ;        ...
  3786.     lda    #cmini        ; Argument for comnd call
  3787.     jsr    comnd        ; Set up the parser and print the prompt
  3788.     lda    #kercmd\    ; addr of command table
  3789.     sta    cminf1        ;        ...
  3790.     lda    #kercmd^    ;        ...
  3791.     sta    cminf1+1    ;        ...
  3792.     lda    #kerhlp\    ; Store address of help text
  3793.     sta    cmhptr        ;  in help pointer
  3794.     lda    #kerhlp^    ;        ...
  3795.     sta    cmhptr+1    ;        ...
  3796.     ldy    #$00        ;  No special flags needed
  3797.     lda    #cmkey        ; Set up for keyword parse
  3798.     jsr    comnd        ; Try to parse it
  3799.      jmp    kermt2        ; Failed
  3800.     lda    #kermtb\    ; Get address of jump table
  3801.     sta    jtaddr        ;        ...
  3802.     lda    #kermtb^    ;        ...
  3803.     sta    jtaddr+1    ;        ...
  3804.     txa            ; Offset to AC
  3805. jmpind: clc            ;[DD] Jump indexed
  3806.     adc    jtaddr        ; Add offset to low byte
  3807.     sta    jtaddr        ;        ...
  3808.     bcc    jmpin1        ;        ...
  3809.     inc    jtaddr+1    ; If carry inc high byte
  3810. jmpin1: jmp    (jtaddr)    ; Jump to address
  3811.  
  3812. kermtb: jmp    telnet        ; Connect command
  3813.     jmp    exit        ; Exit command
  3814.     jmp    help        ; Help command
  3815.     jmp    log        ; Log command
  3816.     jmp    exit        ; Quit command
  3817.     jmp    receve        ; Receive command
  3818.     jmp    send        ; Send command
  3819.     jmp    setcom        ; Set command
  3820.     jmp    show        ; Show command
  3821.     jmp    status        ; Status command
  3822.     jmp    bye        ;[EL] Shut and logout remote server command
  3823.     jmp    finish        ;[EL] Shut remote server
  3824.     jmp    getfrs        ;[EL] Get file from remote server
  3825.     jmp    doscmd        ;[40] Send disk command
  3826.     jmp    dirst        ;[40] Get directory
  3827.     jmp    savst        ;[47] Save parameters
  3828.     jmp    restst        ;[47] Restore parameters
  3829. kermt2: ldx    #ermes1\    ; L.O. byte of error message
  3830.     ldy    #ermes1^    ; H.O. byte of error message
  3831.     jsr    prstr        ; Print the error
  3832.     jmp    kermit        ; Go back
  3833. kermt3: ldx    #ermes3\    ; L.O. byte of error
  3834.     ldy    #ermes3^    ; H.O. byte of error
  3835.     jsr    prstr        ; Print it
  3836.     jmp    kermit        ; Try again
  3837. kermt4: ldx    #ermes4\    ; L.O. byte of error
  3838.     ldy    #ermes4^    ; H.O. byte of error
  3839.     jsr    prstr        ; Print the text
  3840.     jmp    kermit        ; Try again
  3841. kermt5: ldx    #ermes6\    ; L.O. byte of error
  3842.     ldy    #ermes6^    ; H.O. byte of error
  3843.     jsr    prstr        ; Print error text ('keyword')
  3844.     jmp    kermit        ; Start at the beginning again
  3845. kermt6: ldx    #ermes7\    ; L.O. byte of error
  3846.     ldy    #ermes7^    ; H.O. byte of error
  3847.     jsr    prstr        ; Print the error message ('file spec')
  3848.     jmp    kermit        ;    and try again
  3849. kermt7: ldx    #ermes8\    ; L.O. byte of error message text
  3850.     ldy    #ermes8^    ; H.O. byte of error
  3851.     jsr    prstr        ; Print it ('integer')
  3852.     jmp    kermit        ; Try for another command line
  3853. kermt8: ldx    #ermes9\    ; L.O. byte of error
  3854.     ldy    #ermes9^    ; H.O. byte of error
  3855.     jsr    prstr        ; Print the message ('switch')
  3856.     jmp    kermit        ; Try for another command line
  3857. kermt9: ldx    #ermesa\    ; L.O. byte of error message
  3858.     ldy    #ermesa^    ; H.O. byte of error message
  3859.     jsr    prstr        ; Print the message ('')
  3860.     jmp    kermit        ; Try for another command line
  3861. kermta:    ldx    #ermesb\    ; L.O. byte of error message
  3862.     ldy    #ermesb^    ; H.O. byte of error message
  3863.     jsr    prstr        ; Print the message ('text')
  3864.     jmp    kermit        ; Go back to top of loop
  3865.  
  3866. .SBTTL    Telnet routine
  3867.  
  3868. ;
  3869. ;    This routine handles the connect command. After connecting
  3870. ;    to a host system, this routine alternates calling routines
  3871. ;    which will pass input from the port to the screen and pass
  3872. ;    output from the keyboard to the port. This kermit will
  3873. ;    ignore all characters until it sees and assigned escape
  3874. ;    character.
  3875. ;
  3876. ;        Input:  RS232 REGISTERS IN CNTRL,CMMND
  3877. ;
  3878. ;        Output: NONE
  3879. ;
  3880. ;        Registers destroyed:    A,X,Y
  3881. ;
  3882.  
  3883. telnet: jsr    prcfm        ; Parse and print a confirm
  3884.     lda    #true        ;[48]
  3885.     sta    connec        ;[48]
  3886.     ldx    #inf01a\    ; Get address of first half of message
  3887.     ldy    #inf01a^    ;        ...
  3888.     jsr    prstr        ; Print it out
  3889.     lda    escp        ; Get the 'break connection' character
  3890.     jsr    prchr        ; Print that as a special character
  3891.     ldx    #inf01b\    ; Get address of second half of message
  3892.     ldy    #inf01b^    ;        ...
  3893.     jsr    prstr        ; Print that
  3894.     jsr    prcrlf        ;    and a crelf
  3895.     lda    fast        ; put us in fast mode, if possible
  3896.     sta    $d030
  3897.     jsr    openrs        ;[27]
  3898.     lda    #$00        ; turn off graphics mode
  3899.     sta    tekmode
  3900.  
  3901. chrlup:    jsr    scrbel        ; stop the nasty bell tone after 6 jiffys
  3902.     ldx    tekmode        ; do not flash anything in graphics mod
  3903.     bne    chrlup1
  3904.     jsr    scrfls        ; flash the cursor and screen if time to do so
  3905. chrlup1:jsr    keyscn
  3906.     bne    telcnc
  3907. telprc:    jsr    getrs        ; Check for a port character
  3908.     bne    chrlup        ; None available, check keyboard
  3909.     lda    char        ;[31] Get the character read
  3910.     and    #$7f        ;[31] Shut off the high order bit
  3911.     sta    char        ;[26][31] Store the character back
  3912.     ldx    tekmode        ; in tektronics mode
  3913.     beq    telprc1
  3914.     jsr    tek        ; if so, handle this character special
  3915.     jmp    chrlup        ; and then get the next character
  3916. telprc1:ldx    escflg        ; Was previous character an escape?
  3917.     cpx    #on        ;        ...
  3918.     bne    telp2a        ; If not, skip vt52 emulation stuff
  3919.     ldy    vtmod        ; get type of terminal to emulate
  3920.     jsr    case
  3921.     .word    telp2a        ; glass tty. skip vt52 emulation
  3922.     .word    dovt52        ; call vt52 and jmp to telprr
  3923.     .word    dovt100        ; call vt100 and jmp to telprr
  3924.  
  3925. dovt52:    jsr    vt52        ; process the character after the esc
  3926.     jmp    telprr
  3927.  
  3928. dovt100:jsr    vt100        ; process a character in an esc sequence
  3929.     jmp    telprr
  3930.  
  3931. telp2a:    cmp    #$20        ; if less than $20, not printable character
  3932.     bcc    telp3a
  3933.     cmp    #$20+95        ; one of the 95 printable characters?
  3934.     bcs    telp3a        ; nope
  3935.     jsr    cout        ; print the normal character
  3936.     clc            ; repeat forever
  3937.     bcc    chrlup
  3938. telp3a:    jsr    telpr3        ; process it
  3939. telprr:    clc            ;[39] Repeat Main terminal loop
  3940.     bcc    chrlup        ;[39]        ...
  3941.  
  3942. telcnc:    cmp    #$80
  3943.     bcs    out        ; handle special character sequences on output
  3944. tlcnc5:    cmp    escp        ; Is it the connect-escape character?
  3945.     bne    telp6a
  3946.     jmp    intchr        ; If so, go handle the interupt character
  3947. telp6a:    cmp    #cr        ; is this a cr
  3948.     bne    telp6b        ; no.
  3949.     ldx    lmn        ; is this a cr with new line mode set
  3950.     beq    telp6b        ; no
  3951.     jsr    putrs        ; if so, send the cr
  3952.     lda    #lf        ; and a line feed
  3953. telp6b:    jsr    putrs        ;[39] Output the port character
  3954.     ldx    lecho        ; Is local-echo turned on?
  3955.     cpx    #on        ;        ...
  3956.     bne    telcrs        ; If not, we are done
  3957.     cmp    #bs        ; backspace is a real funny character
  3958.     beq    telp5a
  3959.     cmp    #cr        ; cr is a printable character
  3960.     beq    telp4a
  3961.     cmp    #$20        ; is this a printable character?
  3962.     bcc    telcrs        ; no, so dont echo it
  3963.     cmp    #$20+95        ; is this a printable character?
  3964.     bcs    telcrs        ; no, so dont echo it
  3965. telp4a:    jsr    cout        ; Output a copy to the screen
  3966. telcrs: jmp    chrlup        ;[39]        ...
  3967. telp5a:    jsr    scrl        ; handle the backspace in local-echo mode
  3968.     jmp    chrlup
  3969.  
  3970. ;
  3971. ;    out - output a special character sequence
  3972. ;
  3973. ;    Input:    A-reg holds a number indicating which sequence is to be output
  3974. ;
  3975. ;    Output:    putrs called to output character(s)
  3976. ;
  3977. ;    This routine handles special key sequences like cursor up, pf1,
  3978. ;    and the likes.
  3979. ;
  3980.  
  3981. out:    jsr    outit
  3982.     jmp    chrlup
  3983.  
  3984. outit:    pha            ; save the identifier
  3985.     lsr    a        ; get the family
  3986.     lsr    a
  3987.     lsr    a
  3988.     lsr    a
  3989.     and    #$07
  3990.     tay            ; case selector is family
  3991.     pla            ; remember the identifier
  3992.     and    #$0f        ; extract the family member to pass
  3993.     jsr    case
  3994.     .word    out0        ; numeric key pad
  3995.     .word    out1        ; pf key
  3996.     .word    out2        ; cursor key
  3997.     .word    out3        ; programmable function key
  3998.     .word    out4        ; miscellaneous keys
  3999.     .word    out5        ; null
  4000.  
  4001. out0:    ldx    #deckpam-vt100sw; check if keyboard is numeric or alternate
  4002.     jsr    outsub
  4003.     jsr    case
  4004.     .word    out0a        ; keypad does not exist if not emulating vtXX
  4005.     .word    out0a        ; keypad in vt52 numeric mode
  4006.     .word    out0a        ; keypad in vt100 numeric mode
  4007.     .word    out0b        ; keypad in vt52 alternate mode
  4008.     .word    out0c        ; keypad in vt100 alternate mode
  4009.  
  4010. out0a:    ora    #'0        ; convert to digit
  4011.     jsr    putrs        ; send it
  4012.     rts            ; all done
  4013.  
  4014. out0b:    pha            ; save the key
  4015.     lda    #esc        ; send an escape
  4016.     jsr    putrs
  4017.     lda    #'?        ; send a '?'
  4018.     jsr    putrs
  4019.     pla
  4020.     clc
  4021.     adc    #'p        ; send 'p' plus whatever
  4022.     jsr    putrs
  4023.     rts            ; all done
  4024.  
  4025. out0c:    pha            ; save the key
  4026.     lda    #esc        ; send an escape
  4027.     jsr    putrs
  4028.     lda    #'O        ; send a 'O'
  4029.     jsr    putrs
  4030.     pla
  4031.     clc
  4032.     adc    #'p        ; send 'p' plus whatever
  4033.     jsr    putrs
  4034.     rts            ; all done
  4035.  
  4036. out1:    ldy    vtmod        ; get terminal emulation
  4037.     jsr    case
  4038.     .word    anyrts        ; if not emulating anything, no pf keys
  4039.     .word    out1a        ; pfkeys in vt52 mode
  4040.     .word    out1b        ; pfkeys in vt100 mode
  4041.  
  4042. out1a:    pha            ; save the key
  4043.     lda    #esc        ; send an escape
  4044.     jsr    putrs
  4045.     pla            ; send 'P' plus whatever
  4046.     clc
  4047.     adc    #'P
  4048.     jsr    putrs
  4049.     rts
  4050.  
  4051. out1b:    pha            ; save the key
  4052.     lda    #esc        ; send an escape
  4053.     jsr    putrs
  4054.     lda    #'O        ; send 'O'
  4055.     jsr    putrs
  4056.     pla
  4057.     clc
  4058.     adc    #'P        ; send 'P' plus whatever
  4059.     jsr    putrs
  4060.     rts
  4061.  
  4062. out2:    ldx    #decckm-vt100sw    ; check the setting of the cursor keys
  4063.     jsr    outsub
  4064.     jsr    case
  4065.     .word    anyrts        ; cursor keys do not exist if not emulating vt
  4066.     .word    out2a        ; vt52
  4067.     .word    out2b        ; vt100 in cursor mode
  4068.     .word    out2a        ; cursor mode does not matter if emulating vt52
  4069.     .word    out2c        ; vt100 in application mode
  4070.  
  4071. out2a:    pha            ; save the key to send
  4072.     lda    #esc        ; send esc
  4073.     jsr    putrs
  4074.     pla
  4075.     clc
  4076.     adc    #'A        ; send 'A' plus whatever
  4077.     jsr    putrs
  4078.     rts            ; all done
  4079.  
  4080. out2b:    pha            ; save the key to send
  4081.     lda    #esc        ; send an escape
  4082.     jsr    putrs
  4083.     lda    #'[        ; send an '['
  4084.     jsr    putrs
  4085.     pla
  4086.     clc
  4087.     adc    #'A        ; send 'A' plus whatever
  4088.     jsr    putrs
  4089.     rts            ; all done
  4090.  
  4091. out2c:    pha            ; save the key to send
  4092.     lda    #esc        ; send an escape
  4093.     jsr    putrs
  4094.     lda    #'O        ; send 'O'
  4095.     jsr    putrs
  4096.     pla
  4097.     clc
  4098.     adc    #'A        ; send 'A' plus whatever
  4099.     jsr    putrs
  4100.     rts
  4101.  
  4102. out3:    rts            ; not handled yet
  4103.  
  4104. out4:    ldx    #deckpam-vt100sw    ; check the setting of the keypad
  4105.     jsr    outsub
  4106.     jsr    case
  4107.     .word    out4a        ; if no terminal emulation
  4108.     .word    out4a        ; emulating vt52 in numeric keypad mode
  4109.     .word    out4a        ; emulating vt100 in numeric keypad mode
  4110.     .word    out4b        ; emulating vt52 in alternate keypad mode
  4111.     .word    out4c        ; emulating a vt100 in alternate keypad mode
  4112.  
  4113. out4a:    tax            ; look it up in out4a1
  4114.     lda    out4a1,x
  4115.     jsr    putrs        ; send it
  4116.     rts
  4117.  
  4118. out4b:    pha            ; save it
  4119.     lda    #esc        ; send an escape
  4120.     jsr    putrs
  4121.     lda    #'?        ; send a '?'
  4122.     jsr    putrs
  4123.     pla            ; remember character to send
  4124.     tax            ; look it up in out4b1
  4125.     lda    out4b1,x
  4126.     jsr    putrs        ; send it
  4127.     rts
  4128.  
  4129. out4c:    pha            ; save it
  4130.     lda    #esc        ; send an escape
  4131.     jsr    putrs
  4132.     lda    #'O        ; send a 'O'
  4133.     jsr    putrs
  4134.     pla            ; remember character to send
  4135.     tax            ; look it up in out4b1
  4136.     lda    out4b1,x
  4137.     jsr    putrs        ; send it
  4138.     rts
  4139.     
  4140. out5:    tay            ; get the function to perfrom
  4141.     jsr    case
  4142.     .word    out5a        ; send a null
  4143.     .word    sbreak        ; send a break
  4144.  
  4145. out5a:    lda    #$00        ; send a nulll
  4146.     jsr    putrs
  4147.     rts            ; all done
  4148.  
  4149. ;
  4150. ;    outsub - handy routine to determine which subroutine to call
  4151. ;
  4152. ;    Input:    X-reg index into vt100sw
  4153. ;
  4154. ;    Output:    Y-reg contains an index
  4155. ;
  4156. ;    This routine returns 0 if no terminal is being emulated,
  4157. ;    1 if a vt52 is being emulated,
  4158. ;    2 if a vt100 is being emulated,
  4159. ;    3 if a vt52 is being emulated and vt100sw,x is set
  4160. ;    4 if a vt100 is being emulated and vt100sw,x is set
  4161. ;
  4162.  
  4163. outsub:    ldy    vt100sw,x    ; check the switch
  4164.     bne    outsub1        ; switch is set
  4165.     ldy    vtmod
  4166.     rts
  4167. outsub1:ldy    vtmod        ; get terminal emulation
  4168.     cpy    #$00
  4169.     beq    outsub2        ; if zero, don't adjust for the switch
  4170.     iny            ; add two to adjust for the switch being set
  4171.     iny
  4172. outsub2:rts
  4173.  
  4174. ;    Handle special input characters
  4175.  
  4176. telpr3:    cmp    #$07        ; Is it a ^G (bell)
  4177.     bne    tlpr3a        ; No
  4178.     jsr    bell        ; Ring bell
  4179.     rts            ;[39]
  4180. tlpr3a: cmp    #$0d        ; Is it a ^M (cr) ?
  4181.     bne    tlpr3b        ; No
  4182.     jsr    scrcr        ; Go do a <cr>
  4183.     rts            ;[39]
  4184. tlpr3b:    cmp    #$09        ;[26] Is it a ^I (tab) ?
  4185.     bne    tlpr3c        ;[26] No
  4186.     jsr    prttab        ;[26] Print to the next tab stop
  4187.     rts            ;[39]
  4188. tlpr3c:    cmp    #$1b        ; Was it an 'escape'?
  4189.     bne    tlpr3d        ; No
  4190.     lda    #on        ; Set the escape flag on
  4191.     sta    escflg        ;        ...
  4192.     lda    #$00        ; zero pointers for vt100 emulation
  4193.     sta    vt100st        ; state is zero
  4194.     sta    vt100pt        ; parameter pointer is zero
  4195.     rts            ; Return
  4196. tlpr3d:    cmp    #$0a        ; was it a line feed
  4197.     bne    tlpr3e
  4198.     jsr    scrlf        ; perform the line feed
  4199.     ldx    lmn        ; is new line mode set
  4200.     beq    tlpr3d1        ; if not, do nothing special
  4201.     jsr    scrcr        ; if it is set, lf implys cr
  4202. tlpr3d1:rts 
  4203. tlpr3e:    cmp    #$08        ; was it a backspace?
  4204.     bne    tlpr3f
  4205.     jsr    scrl        ; move the cursor left
  4206. tlpr3f:    cmp    #$0e        ; Was it a 'shift out'
  4207.     bne    tlpr3g        ; No
  4208.     lda    #$01        ; select the g1 character set
  4209.     sta    gx
  4210.     rts
  4211. tlpr3g:    cmp    #$0f        ; Was it a 'shift in'
  4212.     bne    tlpr3h        ; No
  4213.     lda    #$00        ; select g0 character set
  4214.     sta    gx
  4215. tlpr3h:    rts
  4216.  
  4217. ;
  4218. ;    out4a1 - table of characters to send when keypad is in numeric mode
  4219. ;
  4220. ;    This is a table of characters to send when '-', '+', '.', or enter
  4221. ;    is pushed on the numeric keypad.
  4222.  
  4223. out4a1:    .byte    "-+."
  4224.     .byte    cr
  4225.  
  4226. ;
  4227. ;    out4b1 - table of characters to send when keypad is in alternate mode
  4228. ;
  4229. ;    This is a table of characters to send when '-', '+', '.', or enter
  4230. ;    is pushed on the numeric keypad
  4231.  
  4232. out4b1:    .byte    "mlnM"
  4233. ;
  4234. ;    Intchr - processes the character which frollows the interupt
  4235. ;    character and performs functions based on what that character
  4236. ;    is.
  4237. ;
  4238.  
  4239. intchr:    lda    tekmode        ; if we are in tek mode, we have to get out
  4240.     beq    intch5
  4241.     lda    #$00
  4242.     sta    tekmode
  4243.     jsr    scrtxt
  4244.     lda    line25        ; clear the entire text screen including line25
  4245.     pha
  4246.     lda    #$01
  4247.     sta    line25
  4248.     jsr    scrclr
  4249.     pla
  4250.     sta    line25
  4251. intch5:    jsr    rdkey        ; Get the next character
  4252.     lda    char        ;[31]
  4253.     sta    kerchr        ; Save a copy of it
  4254.     and    #$5f        ; Capitalize it
  4255.     cmp    #'C        ; Does user want the connection closed?
  4256.     bne    intch0        ; If not, try next option
  4257.     lda    #$fc        ; if we are in fast mode, we have to get out
  4258.     sta    $d030
  4259.     pla            ;[39] Fix the stack
  4260.     pla            ;[39]
  4261.     lda    #false        ;[48]
  4262.     sta    connec        ;[48]
  4263.     lda    #$00        ; make sure output is turned on when we resume
  4264.     sta    suspend
  4265.     jsr    scrrst        ; reset the screen to normal characterstics
  4266.     jmp    kermit        ;[39]
  4267. intch0: cmp    #'S        ; Does the user want status?
  4268.     bne    intch1        ; Nope
  4269.     jsr    stat01        ;[EL] Give it to him
  4270.     jmp    telcrs        ;[39]
  4271. intch1: cmp    #'B        ;[DD] Send break?
  4272.     bne    intc1a        ; No
  4273.     jsr    sbreak        ; Yes, go send one
  4274.     jmp    telcrs        ;[39]
  4275. intc1a: lda    kerchr        ; Fetch back the original character
  4276.     and    #$7f        ; Get rid of the H.O. bit
  4277.     cmp    #'?        ; Does user need help?
  4278.     bne    intch2        ; If not, continue
  4279.     ldx    #inthlp\    ; Get the address of the proper help string
  4280.     ldy    #inthlp^    ;        ...
  4281.     jsr    prstr        ; Print the help stuff
  4282.     jmp    intchr        ; Get another option character
  4283. intch2: cmp    escp        ; Is it another connect-escape?
  4284.     bne    intch4        ;[39]
  4285.     jsr    putrs        ; Stuff the character at the port
  4286.     jmp    telcrs        ;[39]
  4287. intch4: cmp    #'0        ;[39]
  4288.     bne    intch3        ;[39] Nope, this is an error
  4289.     lda    #$00        ;[39]
  4290.     jsr    putrs        ;[39]
  4291.     jmp    telcrs        ;[39]
  4292. intch3: jsr    bell        ; Sound bell at the user
  4293.     jmp    telcrs        ;[39]
  4294.  
  4295. ;
  4296. ;    Vt52 - will carry out the equivalent of most of the vt52 functions
  4297. ;    available.
  4298. ;
  4299.  
  4300. vt52:    lda    #off        ; First, turn off the escape flag
  4301.     sta    escflg        ;        ...
  4302.     lda    char        ;[26] Get the character to check
  4303.     and    #$7f        ; Turn off the H.O. bit
  4304. vt52z:    sec            ;[26] Get the cursor position
  4305.     jsr    ploth        ;[26] in X,Y
  4306.     sty    hch        ;[39]
  4307.     stx    hcv        ;[39]
  4308.     cmp    #'A        ; It is, is it an 'A'?
  4309.     bne    vt52a        ; No, try next character
  4310.     jsr    scru        ; Go up one line
  4311.     rts            ; Return
  4312. vt52a:  cmp    #'B        ; Is it a 'B'?
  4313.     bne    vt52b        ; Next char
  4314.     jsr    scrd        ; Yes, go down one line
  4315.     rts            ;    and go back
  4316. vt52b:  cmp    #'C        ; 'C'?
  4317.     bne    vt52c        ; Nope
  4318.     jsr    scrr        ; Yes, go forward one space
  4319.     rts            ;    and return
  4320. vt52c:  cmp    #'D        ; 'D'?
  4321.     bne    vt52d        ; No
  4322.     jsr    scrl        ; Yes, do a back-space
  4323.     rts            ; Return
  4324. vt52d:  cmp    #'H        ; 'H'?
  4325.     bne    vt52e        ; No, try next character
  4326.     jsr    scrhom        ; Home cursor (no clear screen)
  4327.     rts            ;    then return
  4328. vt52e:  cmp    #'I        ; 'I'?
  4329.     bne    vt52f        ; Nope
  4330.     jsr    scrrlf        ;[39] Do a reverse line feed
  4331.     rts            ;  and return
  4332. vt52f:  cmp    #'J        ; 'J'?
  4333.     bne    vt52g        ; No
  4334.     jsr    scred0        ; Clear from where we are to end-of-page
  4335.     rts            ;    then return
  4336. vt52g:  cmp    #'K        ; 'K'?
  4337.     bne    vt52h        ; Try last option
  4338.     jsr    screl0        ; Clear to end-of-line
  4339.     rts            ; Return
  4340. vt52h:  cmp    #'Y        ; 'Y'
  4341.     bne    vt52i        ;[19]
  4342.     jsr    vtdca        ; Do direct cursor addressing
  4343.     rts            ;    then return
  4344. vt52i:    cmp    #'o        ;[19] 'o'
  4345.     bne    vt52j        ;[19]
  4346.     lda    #$01
  4347.     sta    reverse        ; turn reverse on
  4348.     rts            ;[19] Return
  4349. vt52j:    cmp    #'n        ;[19] 'n'
  4350.     bne    vt52k
  4351.     lda    #$00
  4352.     sta    reverse        ; turn reverse off
  4353.     rts            ;[19]
  4354. vt52k:    cmp    #'>        ; '>'
  4355.     bne    vt52l
  4356.     lda    #$00        ; put keypad in numeric mode
  4357.     sta    deckpam
  4358.     rts
  4359. vt52l:    cmp    #'=        ; '='
  4360.     bne    vt52m
  4361.     lda    #$01        ; put keypad in alternate mode
  4362.     sta    deckpam
  4363.     rts
  4364. vt52m:    cmp    #'<        ; '>'
  4365.     bne    vt52n
  4366.     lda    #$02        ; set terminal emulation to vt100
  4367.     sta    vtmod
  4368.     rts
  4369. vt52n:    cmp    #'Z        ; 'Z'
  4370.     bne    vt52o
  4371.     lda    #esc        ; identify terminal type
  4372.     jsr    putrs
  4373.     lda    #'/
  4374.     jsr    putrs
  4375.     lda    #'Z
  4376.     jsr    putrs
  4377.     rts
  4378. vt52o:    cmp    #'F        ; set graphics mode
  4379.     bne    vt52p
  4380.     lda    #$01
  4381.     sta    g0
  4382.     sta    g1
  4383.     rts
  4384. vt52p:    cmp    #'G        ; clear graphics mode
  4385.     bne    vt52q
  4386.     lda    #$00
  4387.     sta    g0
  4388.     sta    g1
  4389.     rts
  4390. vt52q:    cmp    #$0c        ; put in tek mode
  4391.     bne    vtig
  4392.     jsr    scrtek
  4393.     jsr    screra        ; erase the graphics screen
  4394.     lda    #$01
  4395.     sta    tekmode        ; and enter grahics mode
  4396.     lda    #747\
  4397.     sta    tekcylo
  4398.     lda    #747^
  4399.     sta    tekcyhi
  4400.     lda    #$00
  4401.     sta    tekcxlo
  4402.     sta    tekcxhi
  4403.     rts
  4404. vtig:    pha            ; Save a copy
  4405.     lda    #esc        ; Get an escape
  4406.     jsr    prchr        ; Print the special character
  4407.     pla            ; Fetch the other character back
  4408.     cmp    #esc        ; Is it a second escape?
  4409.     bne    vtig1        ; Nope, print it
  4410.     lda    #on        ; Set escflg on again for next time around
  4411.     sta    escflg        ;        ...
  4412.     rts            ;    and return
  4413. vtig1:  jsr    prchr        ; Print the character
  4414.     rts            ;    and return
  4415.  
  4416. vtdca:    jsr    getrs        ; Check for a character from the port
  4417.     bne    vtdca        ; Try again
  4418.     lda    char        ;[31]
  4419.     and    #$7f        ; Make sure H.O. bit is off
  4420.     sec            ; Subtract hex 30 (make it num from 0 to 23)
  4421.     sbc    #$20        ;        ...
  4422. vtdca2: pha            ; save it
  4423. vtdca3:    jsr    getrs        ; Check port for character
  4424.     bne    vtdca3        ;    go back and try again
  4425.     lda    char        ;[31]
  4426.     and    #$7f        ; Make sure h.o. bit is off
  4427.     sec            ; Subtract hex 20 (make it num from 0 to 23)
  4428.     sbc    #$20        ;        ...
  4429. vtdca5: tax            ; this is the horizontal position
  4430.     pla            ; remember the vertical position
  4431.     tay
  4432.     jsr    scrplt        ; move the cursor here
  4433.     rts            ;    and return
  4434.  
  4435.  
  4436. .SBTTL    VT100 Emulation Routines
  4437.  
  4438. ;
  4439. ;    vt100 - parse a character in a vt100 command sequence
  4440. ;
  4441. ;    Input - A character in the A-reg
  4442. ;
  4443. ;    This routine processes characters after an esc in VT100 mode.
  4444. ;    It parses the command and calls a routine to perform the requested
  4445. ;    function when the last character in the sequence has been received.
  4446. ;
  4447.  
  4448. vt100:    ldx    vt100st        ; state of the command parser
  4449. vt100d:    ldy    vt100ta,x    ; check the parser table
  4450.     beq    vt100b        ; escape sequence is illegal
  4451.     bpl    vt100a        ; is parameter expected?
  4452.     cmp    #1+'9        ; yes.  Was a digit received?
  4453.     bcs    vt100a        ; no, it is not a digit
  4454.     cmp    #'0
  4455.     bcc    vt100a        ; not a digit (carry set for next line)
  4456.     sbc    #'0        ; convert the digit to a value (0..9)
  4457.     pha            ; save it
  4458.     ldy    vt100pt        ; pointer into parameter list
  4459.     lda    freemem,y        ; get the current value
  4460.     asl    a        ; multiplied by 2
  4461.     pha            ; save that too
  4462.     asl    a        ; multiplied by 4
  4463.     asl    a        ; multiplied by 8
  4464.     sta    freemem,y
  4465.     pla
  4466.     clc
  4467.     adc    freemem,y    ; multiplied by 10
  4468.     sta    freemem,y
  4469.     pla
  4470.     clc
  4471.     adc    freemem,y    ; add in the digit
  4472.     sta    freemem,y    ; save the new value of the parameter
  4473.     rts            ; all done (for now. escflg still set)
  4474.  
  4475. vt100a:    cmp    vt100ta,x    ; found character in table?
  4476.     beq    vt100c        ; yes. go change state
  4477.     inx            ; skip to the next entry
  4478.     inx
  4479.     inx
  4480.     jmp    vt100d        ; check this character
  4481.  
  4482. vt100c:    lda    vt100ta+2,x    ; high order byte of routine to call
  4483.     beq    vt100e        ; $00 = state change
  4484.     sta    dest+1
  4485.     lda    vt100ta+1,x    ; low order byte of routine to call
  4486.     sta    dest
  4487.     lda    #$00
  4488.     sta    escflg        ; this command is complete
  4489.     jmp    (dest)        ; perform requested function
  4490.  
  4491. vt100e:    ldy    vt100ta+1,x    ; state to change to
  4492.     sty    vt100st        ; change to it
  4493.     lda    vt100ta,y    ; is a parameter expected?
  4494.     bpl    vt100f        ; no.
  4495.     inc    vt100pt        ; make pointer point to next parameter
  4496.     ldy    vt100pt        ; and zero the parameter
  4497.     cpy    #freesiz    ; still freespace available?
  4498.     bcs    vt100b        ; no.
  4499.     lda    #$00
  4500.     sta    freemem,y
  4501. vt100f:    rts            ; all done (for now. escflg still set)
  4502.  
  4503. vt100b:    lda    #$00        ; an error has occured.  abort processing
  4504.     sta    escflg
  4505.     rts            ; all done
  4506.  
  4507. ;
  4508. ;    vt100b1 - process the <esc> '['  integer 'J' vt100 sequence
  4509. ;
  4510. ;    This routine calls scred0, scred1, or scred2 depending on the
  4511. ;    value of the integer.
  4512. ;
  4513.  
  4514. vt100b1:ldy    freemem+1    ; what is the integer
  4515.     cpy    #$03        ; check for strange vt100 sequences
  4516.     bcs    vt100er        ; this is a strange sequence
  4517.     jsr    case        ; call the proper routine
  4518.     .word    scred0        ; call scred0 if the integer is 0
  4519.     .word    scred1        ; call scred1 if the integer is 1
  4520.     .word    scred2        ; call scred2 if the integer is 2
  4521.  
  4522. ;
  4523. ;    vt100c1 - process the <esc> '[' integer 'K'
  4524. ;
  4525. ;    This routine calls screl0, screl1, or screl2 depending on the
  4526. ;    value of the integer.
  4527.  
  4528. vt100c1:ldy    freemem+1    ; what is the integer
  4529.     cpy    #$03        ; check for strange vt100 sequences
  4530.     bcs    vt100er        ; this is a strange sequence
  4531.     jsr    case        ; call the proper routine
  4532.     .word    screl0        ; call screl0 if the integer is 0
  4533.     .word    screl1        ; call screl1 if the integer is 1
  4534.     .word    screl2        ; call screl2 if the integer is 2
  4535.  
  4536. ;
  4537. ;    vt100d1 - process the <esc> '[' integer ';' integer 'f' and
  4538. ;                 <esc> '[' integer ';' integer 'H' vt100 commands
  4539. ;
  4540. ;    This routine calls scrplt to put the cursor at the position indicated
  4541. ;    by the two integers.
  4542.  
  4543. vt100d1:ldx    #$00        ; get the first integer
  4544.     ldy    #$01        ; default value is 1
  4545.     jsr    vt100pa
  4546.     ldx    decom        ; is origin mode absolute
  4547.     beq    vt100d4        ; if absolute, do not add in top
  4548.     clc
  4549.     adc    top        ; if relative, add in top
  4550. vt100d4:tay
  4551.     dey            ; solve the off-by-one problem
  4552.     cpy    #25        ; check it for reasonability
  4553.     bcc    vt100d2
  4554.     ldy    #24        ; if unreasonable, move cursor to bottom line
  4555. vt100d2:sty    dest        ; save y position
  4556.     ldx    #$01        ; get the second integer
  4557.     ldy    #$01        ; default value is 1
  4558.     jsr    vt100pa
  4559.     tax
  4560.     dex            ; solve the off-by-one problem
  4561.     jsr    scrrgh        ; check it for reasconablilty
  4562.     bcc    vt100d3
  4563.     tax            ; if unreasonable, move cursor to far right
  4564. vt100d3:ldy    dest        ; get y position
  4565.     jsr    scrplt        ; finally move the cursor
  4566.     rts            ; all done
  4567.  
  4568. ;
  4569. ;    vt100e1 - process the <esc> integer ';' integer 'r' sequence
  4570. ;
  4571. ;    This routine sets the top and bottom of the scrolling area.
  4572. ;
  4573.  
  4574. vt100e1:ldx    #$00        ; get the first parameter
  4575.     ldy    #$01        ; default value is one
  4576.     jsr    vt100pa
  4577.     sta    dest        ; save it in a safe place
  4578.     dec    dest        ; solve the off-by-one problem
  4579.     jsr    scrbot        ; get default for second parameter
  4580.     tay
  4581.     iny            ; solve the off-by-one problem
  4582.     ldx    #$01        ; get the second parameter
  4583.     jsr    vt100pa
  4584.     tay
  4585.     dey            ; solve the off-by-one problem
  4586.     jsr    scrbot        ; check it for reasonablilty
  4587.     bcs    vt100e2
  4588.     cpy    dest        ; second must be greater than first
  4589.     bcc    vt100e2        ; unreasonable
  4590.     sty    bot        ; set the bottom margin
  4591.     ldy    dest        ; set the top margin
  4592.     sty    top
  4593.     lda    decom        ; check origin mode
  4594.     bne    vt100e3        ; if origin mode off, move to top of area
  4595.     ldy    #$00        ; if origin mode on, move to top of screen
  4596. vt100e3:ldx    #$00        ; in any case, move cursor to far left
  4597.     jsr    scrplt
  4598. vt100e2:rts
  4599.  
  4600. vt100er:rts
  4601.     
  4602. ;
  4603. ;    vt100f1 - process the <esc> '[' integer 'A' sequence
  4604. ;
  4605. ;    This routine moves the cursor up <integer> lines
  4606. ;
  4607.  
  4608. vt100f1:ldx    #$00        ; get the parameter
  4609.     ldy    #$01        ; default value is one
  4610.     jsr    vt100pa
  4611.     sec            ; cutsy way to subtract it form cursor pos
  4612.     eor    #$ff
  4613.     adc    cy
  4614.     tay
  4615.     bcc    vt100f3        ; gone past top of screen
  4616.     cpy    top        ; outside scrolling area
  4617.     bcs    vt100f2        ; no
  4618. vt100f3:ldy    top        ; move cursor to top
  4619. vt100f2:ldx    cx
  4620.     jsr    scrplt        ; plot the cursor here
  4621.     rts
  4622.  
  4623. ;
  4624. ;    vt100g1 - process the <esc> '[' integer 'B' sequence
  4625. ;
  4626. ;    This routine moves the cursor down <integer> lines
  4627. ;
  4628.  
  4629. vt100g1:ldx    #$00        ; get the parameter
  4630.     ldy    #$01        ; the default is one
  4631.     jsr    vt100pa
  4632.     clc            ; add the parameter to cy
  4633.     adc    cy
  4634.     tay
  4635.     cpy    bot        ; see if still in scrolling area
  4636.     bcc    vt100g2
  4637.     ldy    bot        ; nope. move the cursor to the bottom
  4638. vt100g2:ldx    cx
  4639.     jsr    scrplt        ; plot the cursor here
  4640.     rts            ; all done
  4641.  
  4642. ;
  4643. ;    vt100h1 - process the <esc> '[' integer 'C' sequence
  4644. ;
  4645. ;    This routine moves the cursor right <integer> characters
  4646. ;
  4647.  
  4648. vt100h1:ldx    #$00        ; get the parameter
  4649.     ldy    #$01        ; default value is one
  4650.     jsr    vt100pa
  4651.     clc            ; add it into the current cursor position
  4652.     adc    cx
  4653.     tax
  4654.     jsr    scrrgh        ; check it for reasonability
  4655.     bcc    vt100h2        ; it is reasonable
  4656.     tax            ; if unreasonable, move cursor to far right
  4657. vt100h2:ldy    cy        ; plot the cursor here
  4658.     jsr    scrplt
  4659.     rts
  4660.  
  4661. ;
  4662. ;    vt100i1 - process the <esc>  '[' integer 'D' sequence
  4663. ;
  4664. ;    This routine moves the cursor left <integer> characters
  4665. ;
  4666.  
  4667. vt100i1:ldx    #$00        ; get the parameter
  4668.     ldy    #$01        ; default value is one
  4669.     jsr    vt100pa
  4670.     sec            ; cutsy way to subtract from cx
  4671.     eor    #$ff
  4672.     adc    cx
  4673.     bcs    vt100i2        ; check if gone past left margin
  4674.     lda    #$00        ; if so, move to far left
  4675. vt100i2:tax
  4676.     ldy    cy        ; plot the cursor here
  4677.     jsr    scrplt
  4678.     rts
  4679.  
  4680. ;
  4681. ;    vt100j1 - process the <esc> '[' [  integer ';' ...] 'm' sequence
  4682. ;
  4683. ;    This routine sets the graphic rendition (reverse, alternate colors,
  4684. ;    underline and flashing) parameters.  Note that it may be passed
  4685. ;    0 or more parameters
  4686. ;
  4687.  
  4688. vt100j1:ldx    #$00        ; start with the first parameter
  4689. vt100j5:ldy    #$00        ; default value is zero
  4690.     jsr    vt100pa
  4691.     beq    vt100j3        ; if zero, clear everything
  4692.     tay
  4693.     cpy    #vt100gs
  4694.     bcs    vt100j4        ; unreasonable parameter!
  4695.     lda    #$01        ; set the proper parameter
  4696.     sta    vt100gr,y
  4697.     bne    vt100j4        ; always taken
  4698. vt100j3:jsr    vt100j2        ; clear everything
  4699. vt100j4:inx            ; get the next parameter
  4700.     cpx    vt100pt        ; all done?
  4701.     bcc    vt100j5        ; nope.  Do some more
  4702.     rts            ; all done.
  4703.  
  4704. vt100j2:lda    #$00        ; clear everything
  4705.     sta    alternt        ; alternate color (highlighting)
  4706.     sta    flash        ; flashing off
  4707.     sta    underln        ; dont underline
  4708.     sta    reverse        ; dont reverse
  4709.     rts            ; everything cleared.
  4710.  
  4711. ;
  4712. ;    vt100k - process the <esc> '[' '?' integer 'h' sequence
  4713. ;
  4714. ;    This routine sets a vt100 switch
  4715. ;
  4716.  
  4717. vt100k:    ldx    #$00        ; start with the first parameter
  4718. vt100k1:ldy    #$00        ; default value is zero
  4719.     jsr    vt100pa        ; get the value of the parameter
  4720.     cmp    #vt100ss    ; is this a legal switch?
  4721.     bcs    vt100k2        ; nope.  Better not try to set it
  4722.     tay
  4723.     lda    #$01
  4724.     sta    vt100sw,y    ; set this switch
  4725.     cpy    #decrev-vt100sw    ; reverse entire screen?
  4726.     bne    vt100k2
  4727.     txa            ; save x register
  4728.     pha
  4729.     jsr    scrset        ; call screen driver
  4730.     pla
  4731.     tax            ; restore x register
  4732. vt100k2:inx
  4733.     cpx    vt100pt        ; done yet?
  4734.     bcc    vt100k1
  4735.     rts            ; all done
  4736.     
  4737. ;
  4738. ;    vt100l - process the <esc> '[' '?' integer 'l' sequence
  4739. ;
  4740. ;    This routine clears a vt100 switch
  4741. ;
  4742.  
  4743. vt100l:    ldx    #$00        ; start with the first parameter
  4744. vt100l1:ldy    #$00        ; default value is zero
  4745.     jsr    vt100pa        ; get the value of the parameter
  4746.     cmp    #vt100ss    ; is this a legal switch?
  4747.     bcs    vt100l2        ; nope.  Better not try to clear it
  4748.     cmp    #decanm-vt100sw    ; enter vt52 emulation?
  4749.     bne    vt100l3
  4750.     jsr    scrrst        ; reset the terminal
  4751.     ldy    #$01        ; put terminal in vt52 mode
  4752.     sty    vtmod
  4753.     rts
  4754. vt100l3:tay
  4755.     lda    #$00
  4756.     sta    vt100sw,y    ; clear this switch
  4757.     cpy    #decrev-vt100sw    ; reverse entire screen?
  4758.     bne    vt100l2
  4759.     txa            ; save x register
  4760.     pha
  4761.     jsr    scrset        ; call screen driver
  4762.     pla
  4763.     tax            ; restore x register
  4764. vt100l2:inx
  4765.     cpx    vt100pt        ; done yet?
  4766.     bcc    vt100l1
  4767.     rts            ; all done
  4768.  
  4769. ;
  4770. ;    vt100m - put the keypad in numeric mode
  4771. ;
  4772. ;    This routine puts the keypad into numeric mode
  4773. ;
  4774.  
  4775. vt100m:    lda    #$00
  4776.     sta    deckpam
  4777.     rts
  4778.  
  4779. ;
  4780. ;    vt100n - put the keypad into alternate mode
  4781. ;
  4782. ;    This routine puts the keypad into alternate mode
  4783. ;
  4784.  
  4785. vt100n:    lda    #$01
  4786.     sta    deckpam
  4787.     rts
  4788.  
  4789. ;
  4790. ;    vt100o - perform the next line function
  4791. ;
  4792. ;    This routine moves the cursor down one line and to the leftmost column
  4793. ;
  4794.  
  4795. vt100o:    jsr    scrlf        ; move the cursor down one line
  4796.     jsr    scrcr        ; move the cursor to the leftmost column
  4797.     rts            ; all done
  4798.  
  4799. ;
  4800. ;    vt100p - set a tab stop
  4801. ;
  4802. ;    This routine sets a tab stop at the current cursor position
  4803. ;
  4804.  
  4805. vt100p:    ldx    cx        ; get the current cursor position
  4806.     lda    #$00        ; zero means tab stop here
  4807.     sta    tabs,x        ; set the tab
  4808.     rts            ; all done
  4809.  
  4810. ;
  4811. ;    vt100q - clear tab stop(s)
  4812. ;
  4813. ;    This routine processes the <esc> '[' integer 'g' sequence
  4814. ;
  4815. ;    If 'integer' is zero, a tab stop is cleared.  If 'integer' is three
  4816. ;    all the tab stops are cleared.   Otherwise, nothing happens.
  4817. ;
  4818.  
  4819. vt100q:    ldx    #$00        ; get the first parameter
  4820.     ldy    #$00        ; default value is zero
  4821.     jsr    vt100pa        ; get the parameter
  4822.     beq    vt100q1        ; if zero, clear a tab stop
  4823.     cmp    #3        ; if not zero or three, ignore
  4824.     bne    vt100q3        ; if non-zero (usually 3), clear all tabs
  4825.     ldx    #79        ; clear 80 tab stops
  4826.     lda    #$01        ; non-zero entry in tabs means tab cleared
  4827. vt100q2:sta    tabs,x        ; cleared one
  4828.     dex
  4829.     bpl    vt100q2        ; repeat till done
  4830.     rts            ; all done
  4831. vt100q1:lda    #$01        ; non-zero entry in tabs means tab cleared
  4832.     ldx    cx        ; get tabstop to clear
  4833.     sta    tabs,x        ; cleared
  4834. vt100q3:rts            ; all done
  4835.  
  4836. ;
  4837. ;    vt100r - make a terminal report
  4838. ;
  4839. ;    This routine processes the <esc> '[' integer 'n' sequence
  4840. ;
  4841. ;    If 'integer' is 5, the 'terminal OK' reply is generated.  Otherwise
  4842. ;    the cursor position reply is generated.
  4843. ;
  4844.  
  4845. vt100r:    ldx    #$00        ; get the first parameter
  4846.     ldy    #$00        ; default is 0
  4847.     jsr    vt100pa        ; get the parameter
  4848.     cmp    #5        ; want the 'terminal OK' report?
  4849.     beq    vt100r1        ; vt100r1 sends the 'terminal OK' reply
  4850.     cmp    #6        ; if neither report desired, ignore
  4851.     bne    vt100r3
  4852.     lda    #esc        ; send <esc> '[' <line> ';' <column> 'R'
  4853.     jsr    putrs
  4854.     lda    #'[
  4855.     jsr    putrs
  4856.     lda    cy        ; send the line
  4857.     ldy    decom        ; if in origin mode, subtract top
  4858.     beq    vt100r2
  4859.     sec
  4860.     sbc    top
  4861. vt100r2:clc
  4862.     adc    #$01        ; solve the off by one problem
  4863.     jsr    outad        ; print a decimal number to the modem
  4864.     lda    #';        ; send ';'
  4865.     jsr    putrs
  4866.     lda    cx        ; send the cursor column
  4867.     clc
  4868.     adc    #$01        ; solve the off by one problem
  4869.     jsr    outad        ; print a decimal number to the modem
  4870.     lda    #'R
  4871.     jsr    putrs
  4872.     rts            ; all done
  4873. vt100r1:lda    #esc        ; send <esc> '[0n'  (Terminal OK reply code)
  4874.     jsr    putrs
  4875.     lda    #'[
  4876.     jsr    putrs
  4877.     lda    #'0
  4878.     jsr    putrs
  4879.     lda    #'n
  4880.     jsr    putrs
  4881. vt100r3:rts            ; done
  4882.  
  4883. ;
  4884. ;    vt100s - report device attributes
  4885. ;
  4886. ;    This routine processes the <esc> 'Z' and <esc> '[' 'c' sequences
  4887. ;
  4888. ;    The device attributes are sent to the modem.
  4889. ;
  4890.  
  4891. vt100s:    lda    #esc        ; send <esc> '[?1;1c' (Device attribute string)
  4892.     jsr    putrs
  4893.     lda    #'[
  4894.     jsr    putrs
  4895.     lda    #'?
  4896.     jsr    putrs
  4897.     lda    #'1
  4898.     jsr    putrs
  4899.     lda    #';
  4900.     jsr    putrs
  4901.     lda    #'2        ; we have AVO (Advanced video option)
  4902.     jsr    putrs
  4903.     lda    #'c
  4904.     jsr    putrs
  4905.     rts            ; all done
  4906.  
  4907. ;
  4908. ;    vt100t - reset terminal
  4909. ;
  4910. ;    This routine processes the <esc> 'c' sequence
  4911. ;
  4912. ;    The terminal is reset
  4913. ;
  4914.  
  4915. vt100t:    jsr    scrrst        ; reset the terminal
  4916.     jsr    scrhom        ; home the cursor
  4917.     lda    line25        ; save the status of the 25th line
  4918.     pha
  4919.     lda    #$01        ; allow the 25th line to be cleared
  4920.     sta    line25
  4921.     jsr    scred2        ; clear entire screen
  4922.     pla            ; restore the status of the 25th line
  4923.     sta    line25
  4924.     rts            ; all done
  4925.  
  4926. ;
  4927. ;    vt100v - set/reset new line mode
  4928. ;
  4929. ;    These routines processes <esc> '[' integer h and <esc> '[' integer 'l'
  4930. ;
  4931. ;        vt100v1 - set new line mode if 'integer' is 20
  4932. ;            - set insert replace mode if 'integer' is 4
  4933. ;        vt100v2 - clear new line mode if 'integer' is 20
  4934. ;            - clear insert replace mde if 'integer' is 4
  4935. ;
  4936.  
  4937. vt100v1:ldx    #$00        ; get the first parameter
  4938.     ldy    #$00        ; default is 0
  4939.     jsr    vt100pa        ; get the parameter
  4940.     cmp    #20        ; is it 20
  4941.     bne    vt100v3        ; if not, ignore it
  4942.     lda    #$01        ; set new line mode
  4943.     sta    lmn
  4944.     rts            ; all done
  4945. vt100v3:cmp    #4        ; is it 4
  4946.     bne    vt100v0        ; if not, ignore it
  4947.     lda    #$01
  4948.     sta    irm
  4949.     rts
  4950. vt100v2:ldx    #$00        ; get the first parameter
  4951.     ldy    #$00        ; default is 0
  4952.     jsr    vt100pa        ; get the parameter
  4953.     cmp    #20        ; is it 20
  4954.     bne    vt100v4        ; if not, ignore it
  4955.     lda    #$00        ; set new line mode
  4956.     sta    lmn
  4957.     rts
  4958. vt100v4:cmp    #4        ; is it 4
  4959.     bne    vt100v0        ; if not, ignre it
  4960.     lda    #$00
  4961.     sta    irm
  4962. vt100v0:rts            ; all done
  4963.  
  4964. ;
  4965. ;    vt100w - mount a character set
  4966. ;
  4967. ;        vt100w1 - mount U.S. ascii character set on g0
  4968. ;        vt100w2 - mount graphics character set on g0
  4969. ;        vt100w3 - mount U.S. ascii character set on g1
  4970. ;        vt100w4 - mount graphics character set on g1
  4971. ;
  4972.  
  4973. vt100w1:lda    #$00        ; mount U.S. ascii character set on g0
  4974.     sta    g0
  4975.     rts
  4976. vt100w2:lda    #$01        ; mount graphics character set on g0
  4977.     sta    g0
  4978.     rts
  4979. vt100w3:lda    #$00        ; mount U.S. ascii character set on g1
  4980.     sta    g1
  4981.     rts
  4982. vt100w4:lda    #$01        ; mount graphics character set on g1
  4983.     sta    g1
  4984.     rts
  4985.  
  4986. ;
  4987. ;    vt100x1 - enter graphics mode
  4988.  
  4989.  
  4990. vt100x1:jsr    scrtek        ; turn on the graphics screen
  4991.     jsr    screra        ; erase the graphics screen
  4992.     lda    #$01
  4993.     sta    tekmode        ; and enter grahics mode
  4994.     lda    #747\
  4995.     sta    tekcylo
  4996.     lda    #747^
  4997.     sta    tekcyhi
  4998.     lda    #$00
  4999.     sta    tekcxlo
  5000.     sta    tekcxhi
  5001.     rts
  5002.  
  5003. ;
  5004. ;    vt100y1 - process the <esc> '[' integer 'P' vt102 commands
  5005. ;
  5006. ;    This routine calls scrdch to delete some characters
  5007. ;
  5008.  
  5009. vt100y1:ldx    #$00        ; get the first integer
  5010.     ldy    #$01        ; default value is 1
  5011.     jsr    vt100pa        ; how many characters to delete
  5012.     jsr    scrdch        ; go delete them
  5013.     rts            ; all done
  5014.  
  5015. ;
  5016. ;    vt100z1 - process the <es> '[' integer 'L' vt102 comand
  5017. ;
  5018. ;    This routine calls scral to add some lines
  5019. ;
  5020.  
  5021. vt100z1:ldx    #$00        ; get the first integer
  5022.     ldy    #$01        ; default value is 1
  5023.     jsr    vt100pa        ; how many lines to insert
  5024.     jsr    scral        ; go insert them
  5025.     rts            ; all done
  5026.  
  5027. ;
  5028. ;    vt100z2 - process the <esc> '[' integer 'M' vt102 comand
  5029. ;
  5030. ;    This routine calls scrdl to delete some lines
  5031. ;
  5032.  
  5033. vt100z2:ldx    #$00        ; get the first integer
  5034.     ldy    #$01        ; default value is 1
  5035.     jsr    vt100pa        ; how many lines to delete
  5036.     jsr    scrdl        ; go insert them
  5037.     rts            ; all done
  5038.  
  5039. ;
  5040. ;    vt100z3 - process the <esc> <comma> sequence
  5041. ;
  5042. ;    This routine delays processing for a 4 sixtieths of a second.  The
  5043. ;    delay is intended to be used in a visual-bell escape sequence, so we
  5044. ;    synchronize ourself with the VIC raster scan.  (Too bad we
  5045. ;    can't synchronize with the 8563 raster scan.)
  5046. ;
  5047.  
  5048. vt100z3:ldx    #4
  5049. vt100z4:bit    $d011
  5050.     bmi    vt100z4
  5051. vt100z5:bit    $d011
  5052.     bpl    vt100z5
  5053.     dex
  5054.     bne    vt100z4
  5055.     rts
  5056.  
  5057. ;
  5058. ;    outad - send a decimal number to modem.
  5059. ;
  5060. ;    Input: A - Number to be printed
  5061. ;
  5062. ;    Registers Destroyed:    A,X,Y
  5063. ;
  5064. ;    Note the similarity between this routine and printad.
  5065. ;
  5066. ;    This routine sends to the modem instead of the screen, and
  5067. ;    this routine only accepts numbers less than 255.
  5068. ;
  5069.  
  5070. outad:    ldx    #2        ; up to 3 digits (0..2)
  5071. outad1:    cmp    tens1,x        ; drop any leading zeros
  5072.     bcs    outad2
  5073.     dex
  5074.     bpl    outad1
  5075. outad2:    ldy    #'0        ; y is the ascii value to print
  5076. outad3:    cmp    tens1,x        ; compare with 10^x
  5077.     bcc    outad4        ; result would be negative.
  5078.     sbc    tens1,x        ; carry is already set
  5079.     iny            ; keep track of the value of this digit
  5080.     bne    outad3        ; always taken
  5081. outad4:    pha            ; save the number we are printing
  5082.     txa            ; save X
  5083.     pha
  5084.     tya            ; print the character in Y
  5085.     jsr    putrs
  5086.     pla            ; restore X
  5087.     tax
  5088.     pla            ; remember the number we are printing
  5089.     dex            ; print the next digit.
  5090.     bpl    outad2
  5091.     rts
  5092.  
  5093. ;
  5094. ;    vt100pa - get a parameter for vt100 emulation
  5095. ;
  5096. ;    Input:    X-reg - which parameter is desired (0..n)
  5097. ;        Y-reg - default value of this parameter
  5098. ;
  5099. ;    Output:    A-reg - value of this parameter
  5100. ;
  5101. ;    This routine returns the value of the requested parameter.  If
  5102. ;    the parameter is zero or undefined, it returns the default value.
  5103. ;
  5104.  
  5105. vt100pa:cpx    vt100pt        ; was the necessary number of params given
  5106.     bcs    vt100pb        ; no, use the default
  5107.     lda    freemem+1,x    ; get this parameter
  5108.     beq    vt100pb        ; if zero, use the default
  5109.     rts
  5110. vt100pb:tya            ; return the default
  5111.     rts
  5112.  
  5113. ;
  5114. ;    vt100ta - parser table for vt100 commands
  5115. ;
  5116. ;    the first byte of each entry is a character to expect.  If the
  5117. ;    character to expect is negative, it means to parse a parameter
  5118. ;    and remain in the current state.  If it is zero, that is the end
  5119. ;    of the entry.  If it is the character received,    the next word is looked
  5120. ;    at.  If it is less than $100, the parser changes into that state.  If
  5121. ;    it is greater or equal to $100, the routine at that address is called.
  5122. ;
  5123.  
  5124. vt100ta:.byte    '[        ; many different sequences begin with <ESC>[
  5125.     .word    vt100a1-vt100ta
  5126.     .byte    '#        ; many different sequences begin with <ESC>#
  5127.     .word    vt100a5-vt100ta
  5128.     .byte    'M        ; <esc> 'M'
  5129.     .word    scrrlf        ;        is reverse index
  5130.     .byte    'E        ; <esc> 'E'
  5131.     .word    vt100o        ;        is next line
  5132.     .byte    'D        ; <esc> 'D'
  5133.     .word    scrlf        ;        is index
  5134.     .byte    '7        ; <esc> '7'
  5135.     .word    scrsav        ;        means save cursor position
  5136.     .byte    '8        ; <esc> '8'
  5137.     .word    scrlod        ;        means load cursor position
  5138.     .byte    'H        ; <esc> 'H'
  5139.     .word    vt100p        ;        means set a tab stop
  5140.     .byte    '=        ; <esc> '>'
  5141.     .word    vt100n        ;    puts keypad in alternate mode    
  5142.     .byte    '>        ; <esc> '='
  5143.     .word    vt100m        ;    puts keypad in numeric mode
  5144.     .byte    'Z        ; <esc> 'Z'
  5145.     .word    vt100s        ;        sends the terminal identity
  5146.     .byte    'c        ; <esc> 'c'
  5147.     .word    vt100t        ;        resets the terminal
  5148.     .byte    '(        ; <esc> '('
  5149.     .word    vt100a6-vt100ta    ;        means mount a character set
  5150.     .byte    ')        ; <esc> ')'
  5151.     .word    vt100a7-vt100ta    ;        means mount a character set
  5152.     .byte    $0c        ; <esc> form-feed 
  5153.     .word    vt100x1        ;        means enter graphics mode
  5154.     .byte    ',        ; <esc> ','
  5155.     .word    vt100z3        ;        means delay for 250 ms
  5156.     .byte    $00
  5157.  
  5158. vt100a1:.byte    $ff
  5159.     .word    0
  5160.     .byte    'J        ; <esc> '[' integer 'J'
  5161.     .word    vt100b1
  5162.     .byte    'K        ; <esc> '[' integer 'K'
  5163.     .word    vt100c1
  5164.     .byte    'A        ; <esc> '[' integer 'A'
  5165.     .word    vt100f1
  5166.     .byte    'B        ; <esc> '[' integer 'B'
  5167.     .word    vt100g1
  5168.     .byte    'C        ; <esc> '[' integer 'C'
  5169.     .word    vt100h1
  5170.     .byte    'D        ; <esc> '[' integer 'D'
  5171.     .word    vt100i1
  5172.     .byte    'm        ; <esc> '[' integer ';']... 'm'
  5173.     .word    vt100j1
  5174.     .byte    ';
  5175.     .word    vt100a2-vt100ta
  5176.     .byte    'f        ; <esc> '[' 'f'
  5177.     .word    vt100d1
  5178.     .byte    'H        ; <esc> '[' 'H'
  5179.     .word    vt100d1
  5180.     .byte    'r        ; <esc> '[' 'r'
  5181.     .word    vt100e1
  5182.     .byte    '?        ; <esc> '[' '?'
  5183.     .word    vt100a3-vt100ta
  5184.     .byte    'g        ; <esc> '[' integer 'g'
  5185.     .word    vt100q        ;        means clear tab stop(s)
  5186.     .byte    'n        ; <esc> '[' integer 'n'
  5187.     .word    vt100r        ;         means create a reply message
  5188.     .byte    'c        ; <esc> '[' integer 'c'
  5189.     .word    vt100s        ;         sends terminal identification
  5190.     .byte    'h        ; <esc> '[' integer 'h'
  5191.     .word    vt100v1        ;        means set new line mode
  5192.     .byte    'l        ; <esc> '[' integer 'l'
  5193.     .word    vt100v2        ;        means clear new line mode
  5194.     .byte    'P        ; <esc> '[' integer 'P'
  5195.     .word    vt100y1        ;        means delete some characters
  5196.     .byte    'L        ; <esc> '[' integer 'L'
  5197.     .word    vt100z1        ;        means insert some lines
  5198.     .byte    'M        ; <esc> '[' integer 'M'
  5199.     .word    vt100z2        ;        means delete some lines
  5200.     .byte    $00
  5201.  
  5202. vt100a2:.byte    $ff
  5203.     .word    0
  5204.     .byte    'H
  5205.     .word    vt100d1        ; <esc> '[' integer ';' integer 'H'
  5206.     .byte    'f
  5207.     .word    vt100d1        ; <esc> '[' integer ';' integer 'f'
  5208.     .byte    'r
  5209.     .word    vt100e1        ; <esc> '[' integer ';' integer 'r'
  5210.     .byte    'm
  5211.     .word    vt100j1        ; <esc> '[' integer ';' integer 'm'
  5212.     .byte    ';
  5213.     .word    vt100a4-vt100ta    ; <esc> '[' integer ';' integer ';' ... 'm'
  5214.     .byte    0
  5215.  
  5216. vt100a3:.byte    $ff
  5217.     .word    0
  5218.     .byte    'h        ; <esc> '[' '?' integer 'h'
  5219.     .word    vt100k        ;         means set switchs
  5220.     .byte    'l        ; <esc> '[' '?' integer 'l'
  5221.     .word    vt100l        ;        means reset switchs
  5222.     .byte    ';
  5223.     .word    vt100a3-vt100ta
  5224.     .byte    0
  5225.  
  5226. vt100a4:.byte    $ff
  5227.     .word    0
  5228.     .byte    ';
  5229.     .word    vt100a4-vt100ta    ; <esc> '[' integer ';' integer ';' integer..
  5230.     .byte    'm
  5231.     .word    vt100j1        ; <esc> '[' [ingeger ';'] ... 'm'
  5232.     .byte    0
  5233.  
  5234. vt100a5:.byte    '8        ; <ESC>#8 fills the screen with 'E's
  5235.     .word    screee
  5236.     .byte    0
  5237.  
  5238. vt100a6:.byte    'A        ; <esc> '(' 'A' means mount U.S. chars on g0
  5239.     .word    vt100w1
  5240.     .byte    'B        ; <esc> '(' 'B' means mount U.S. chars on g0
  5241.     .word    vt100w1
  5242.     .byte    '1        ; <esc> '(' '1' means mount U.S. chars on g0
  5243.     .word    vt100w1
  5244.     .byte    '2        ; <esc> '(' '2' means mount U.S. chars on g0
  5245.     .word    vt100w1
  5246.     .byte    '0        ; <esc> '(' '0' means mount graphic chars on g0
  5247.     .word    vt100w2
  5248.     .byte    $00
  5249.  
  5250. vt100a7:.byte    'A        ; <esc> ')' 'A' means mount U.S. chars on g1
  5251.     .word    vt100w3
  5252.     .byte    'B        ; <esc> ')' 'B' means mount U.S. chars on g1
  5253.     .word    vt100w3
  5254.     .byte    '1        ; <esc> ')' '1' means mount U.S. chars on g1
  5255.     .word    vt100w3
  5256.     .byte    '2        ; <esc> ')' '2' means mount U.S. chars on g1
  5257.     .word    vt100w3
  5258.     .byte    '0        ; <esc> ')' '0' means mount graphic chars on g1
  5259.     .word    vt100w4
  5260.     .byte    $00
  5261.  
  5262.     .byte    *-vt100ta    ; abort assembly if table length > $100
  5263.  
  5264. .SBTTL    Tektronix
  5265.  
  5266. ;
  5267. ;    These routines interpret Tektronix PLOT10 commands and draw lines
  5268. ;
  5269.  
  5270. ;
  5271. ;    tek - process tek4014 commands
  5272. ;
  5273. ;    Input -    character to process in A-reg
  5274. ;
  5275. ;    This routine processes characters when tekmode != 0.  It is called
  5276. ;    by telnet.
  5277. ;
  5278.  
  5279. tek:    ldx    escflg        ; was the last character an escape?
  5280.     beq    tek2
  5281.     ldx    #$00        ; clear the escape flag
  5282.     stx    escflg
  5283.     cmp    #$0c        ; got a <esc> ff?
  5284.     bne    tek1a
  5285.     jsr    screra        ; clear the screen
  5286.     lda    #$00        ; home the cursor
  5287.     sta    tekcxlo
  5288.     sta    tekcxhi
  5289.     lda    #747\
  5290.     sta    tekcylo
  5291.     lda    #747^
  5292.     sta    tekcyhi
  5293.     lda    #$01        ; and prepare to receive text.
  5294.     sta    tekmode
  5295. tekrts:    rts
  5296. tek1a:    cmp    #'?        ; got <esc> '?' ??
  5297.     bne    tek1b
  5298.     lda    #$7f        ; simulate a DEL
  5299.     jmp    tek2
  5300. tek1b:    cmp    #'[        ; got a '[' or an upper case letter = exit tek
  5301.     beq    tek1c
  5302.     cmp    #'A
  5303.     bcc    tekrts        ; otherwise, ignore
  5304.     cmp    #'Z+1
  5305.     bcs    tekrts        ; otherwise, ignore
  5306. tek1c:    pha            ; save character to re-scan in vt100/vt52 mode
  5307.     jsr    scrtxt        ; exit tektronix mode
  5308.     lda    line25        ; clear the entire text screen including line25
  5309.     pha
  5310.     lda    #$01
  5311.     sta    line25
  5312.     jsr    scrclr
  5313.     pla
  5314.     sta    line25
  5315.     ldx    #$00
  5316.     stx    tekmode
  5317.     ldx    #on        ; Set the escape flag on
  5318.     stx    escflg        ;        ...
  5319.     ldx    #$00        ; zero pointers for vt100 emulation
  5320.     stx    vt100st        ; state is zero
  5321.     stx    vt100pt        ; parameter pointer is zero
  5322.     pla            ; restore character to re-scan
  5323.     jmp    telprc1        ; attempt to process the escape sequence
  5324. tek2:    cmp    #$1e        ; start incremental plotting mode?
  5325.     bne    tek3
  5326.     lda    #$06
  5327.     sta    tekmode
  5328.     rts
  5329. tek3:    cmp    #$1f        ; got a record seporator?
  5330.     bne    tek4
  5331.     lda    #$01        ; if so, prepare to receive text.
  5332.     sta    tekmode
  5333.     rts
  5334. tek4:    cmp    #$1d        ; got a group separator?
  5335.     bne    tek5
  5336.     lda    #$02        ; if so, prepare to receive graphics statements
  5337.     sta    tekmode
  5338.     lda    #$00        ; and lift the pen up
  5339.     sta    tekpen
  5340.     rts
  5341. tek5:    cmp    #$18        ; got a can?
  5342.     bne    tek7
  5343.     jsr    scrtxt        ; exit tek mode
  5344.     lda    line25        ; clear the entire text screen including line25
  5345.     pha
  5346.     lda    #$01
  5347.     sta    line25
  5348.     jsr    scrclr
  5349.     pla
  5350.     sta    line25
  5351.     lda    #$00
  5352.     sta    tekmode
  5353.     rts
  5354. tek7:    cmp    #$0d        ; got a carriage return?
  5355.     bne    tek8
  5356.     lda    #$01        ; prepare to receive text
  5357.     sta    tekmode
  5358.     lda    #$00        ; move cursor to far left
  5359.     sta    tekcxlo
  5360.     sta    tekcxhi
  5361.     rts
  5362. tek8:    cmp    #$0a        ; got a line feed?
  5363.     bne    tek9
  5364.     lda    #$01        ; prepare to receive text
  5365.     sta    tekmode
  5366.     sec            ; move cursor down 
  5367.     lda    tekcylo
  5368.     sbc    #32
  5369.     sta    tekcylo
  5370.     lda    tekcyhi
  5371.     sbc    #0
  5372.     sta    tekcyhi
  5373.     bpl    tek8a        ; wrap up to the top
  5374.     lda    #747\
  5375.     sta    tekcylo
  5376.     lda    #747^
  5377.     sta    tekcyhi
  5378. tek8a:    rts
  5379. tek9:    cmp    #$1b        ; got an escape?
  5380.     bne    tek6
  5381.     lda    #$01        ; if so, set the escape flag
  5382.     sta    escflg
  5383.     rts
  5384. tek6:    ldy    tekmode        ; what type of command is expected?
  5385.     jsr    case        ; go process the command.
  5386.     .word    anybrk        ; can't happen.  only called when tekmode != 0
  5387.     .word    tekm1
  5388.     .word    tekm2
  5389.     .word    tekm3
  5390.     .word    tekm4
  5391.     .word    tekm5
  5392.     .word    tekm6
  5393. tekm1:    cmp    #$7f        ; cant print a del
  5394.     beq    tekm1a
  5395.     sec            ; convert to funny ascii
  5396.     sbc    #$20
  5397.     bcc    tekm1a        ; if non-ascii character, ignore
  5398.     pha
  5399.     jsr    scrint        ; convert coordinate to internal format
  5400.     pla
  5401.     jsr    scrdrw        ; draw the letter (returns size of letter)
  5402.     clc
  5403.     adc    tekcxlo
  5404.     sta    tekcxlo
  5405.     bcc    tekm1a
  5406.     inc    tekcxhi
  5407. tekm1a:    rts
  5408. tekm2:    and    #$60        ; what type of command did we get?
  5409.     cmp    #$20        ; is this the command we expected
  5410.     bne    tekm3
  5411.     lda    char        ; get the character
  5412.     and    #$1f        ; extract the low 5 bits
  5413.     sta    tekryhi
  5414.     lda    #$02        ; save this state
  5415.     sta    tekmode
  5416.     rts
  5417. tekm3:    and    #$60        ; what type of command did we get?
  5418.     cmp    #$60        ; is this the command we expected
  5419.     bne    tekm4
  5420.     lda    char        ; get the character
  5421.     and    #$1f        ; extract the low 5 bits
  5422.     sta    tekrylo        ; and set the low y coordinate
  5423.     lda    #$03        ; save this state
  5424.     sta    tekmode
  5425.     rts
  5426. tekm4:    and    #$60        ; what type of command did we get?
  5427.     cmp    #$20        ; is this the command we expected
  5428.     bne    tekm5
  5429.     lda    char        ; get the character
  5430.     and    #$1f        ; extract the low 5 bits.
  5431.     sta    tekrxhi        ; and set the high y coordinate
  5432.     lda    #$04        ; save this state
  5433.     sta    tekmode
  5434.     rts
  5435. tekm5:    and    #$60        ; what type of command did we get?
  5436.     cmp    #$40        ; is this the command we expected
  5437.     bne    tekm5b        ; no.  this is not a legial escape sequence
  5438.     lda    char        ; get the character
  5439.     and    #$1f        ; extract the low 5 bits
  5440.     sta    tekrxlo        ; and set the low x coordinate
  5441.     jsr    teksave        ; save up the current point as the destination
  5442.     lda    tekrxlo        ; now compute tekcxlo and tekcxhi
  5443.     sta    tekcxlo
  5444.     lda    tekrxhi
  5445.     asl    a
  5446.     asl    a
  5447.     asl    a
  5448.     asl    a
  5449.     asl    a
  5450.     ora    tekcxlo
  5451.     sta    tekcxlo
  5452.     lda    tekrxhi
  5453.     lsr    a
  5454.     lsr    a
  5455.     lsr    a
  5456.     sta    tekcxhi
  5457.     lda    tekrylo        ; now compute tekcylo and tekcyhi
  5458.     sta    tekcylo
  5459.     lda    tekryhi
  5460.     asl    a
  5461.     asl    a
  5462.     asl    a
  5463.     asl    a
  5464.     asl    a
  5465.     ora    tekcylo
  5466.     sta    tekcylo
  5467.     lda    tekryhi
  5468.     lsr    a
  5469.     lsr    a
  5470.     lsr    a
  5471.     sta    tekcyhi
  5472.     jsr    scrint        ; convert coordinates to internal format
  5473.     lda    tekpen        ; is the pen down
  5474.     beq    tekm5c        ; no, dont draw any line.
  5475.     jsr    scrlin        ; draw the line
  5476.     lda    #$02        ; prepare to draw another line
  5477.     sta    tekmode
  5478.     rts
  5479. tekm5c:    lda    #$01        ; put the pen down
  5480.     sta    tekpen
  5481.     lda    #$02        ; prepare to draw another line
  5482.     sta    tekmode
  5483. tekm5b:    rts
  5484. tekm6:    cmp    #$20        ; pick pen up?
  5485.     bne    tekm6e
  5486.     lda    #$00
  5487.     sta    tekpen
  5488.     rts
  5489. tekm6e:    cmp    #$50        ; put pen down?
  5490.     bne    tekm6f
  5491.     lda    #$01
  5492.     sta    tekpen
  5493.     rts
  5494. tekm6f:    pha            ; remember character to process
  5495.     jsr    teksave        ; save the starting coordinate of the line
  5496.     pla            ; restore coordinate
  5497.     lsr    a        ; incremental plotting mode
  5498.     bcc    tekm6a
  5499.     inc    tekcxlo        ; go to the east
  5500.     bne    tekm6a
  5501.     inc    tekcxhi
  5502. tekm6a:    lsr    a
  5503.     bcc    tekm6b
  5504.     ldx    tekcxlo        ; go to the west
  5505.     bne    tekm6a1
  5506.     dec    tekcxhi
  5507. tekm6a1:dec    tekcxlo
  5508. tekm6b:    lsr    a
  5509.     bcc    tekm6c
  5510.     inc    tekcylo        ; go to the north
  5511.     bne    tekm6c
  5512.     inc    tekcyhi
  5513. tekm6c:    lsr    a
  5514.     bcc    tekm6d
  5515.     ldx    tekcylo        ; go to the south
  5516.     bne    tekm6c1
  5517.     dec    tekcyhi
  5518. tekm6c1:dec    tekcylo
  5519. tekm6d:    lda    tekpen        ; see if pen down
  5520.     beq    tekm6d1
  5521.     jsr    scrint
  5522.     jsr    scrlin        ; draw the line
  5523. tekm6d1:rts
  5524.  
  5525. ;
  5526. ;    teksave - convert the current position to internal form and save it
  5527. ;
  5528. ;    This routine sets up the 'from' point for line drawing
  5529. ;
  5530.  
  5531. teksave:jsr    scrint
  5532.     lda    tektxlo
  5533.     sta    tekfxlo
  5534.     lda    tektxhi
  5535.     sta    tekfxhi
  5536.     lda    tektylo
  5537.     sta    tekfylo
  5538.     lda    tektyhi
  5539.     sta    tekfyhi
  5540.     rts
  5541.  
  5542. .SBTTL    Exit routine
  5543.  
  5544. ;
  5545. ;    This routine exits properly from Kermit-65 and reenters
  5546. ;    BASIC.
  5547. ;
  5548. ;        Input:  NONE
  5549. ;
  5550. ;        Output: NONE
  5551. ;
  5552. ;        Registers destroyed:    A,X
  5553. ;
  5554.  
  5555. exit:    lda    #cmcfm        ; Try to get a confirm
  5556.     jsr    comnd        ; Do it
  5557.      jmp    kermt3        ; Give '?not confirmed' message
  5558. exit1:    jsr    restor        ;[36] Restore everything to its' default state
  5559.     lda    r6510        ;[17] Prepare to terminate
  5560.     ora    #1        ;[17]  by paging BASIC ROM in
  5561.     sta    r6510        ;[17]         ...
  5562. exit2:  jmp    (dos)        ; Now restart BASIC
  5563.  
  5564. restor:    jsr    clall        ;[19][36] Close all channels
  5565.     jsr    scrext        ; restore screen hardward to its initial state
  5566.     lda    #00
  5567.     sta    ndx        ; empty the key queue.
  5568.     rts            ;[36] Return
  5569.  
  5570. .SBTTL    Help routine
  5571.  
  5572. ;
  5573. ;    This routine prints help from the current help text
  5574. ;    area.
  5575. ;
  5576. ;        Input:  Cmhptr  - Pointer to the desired text to be printed
  5577. ;
  5578. ;        Output: ASCIZ string at Cmhptr is printed on screen
  5579. ;
  5580. ;        Registers destroyed:    A,X,Y
  5581. ;
  5582.  
  5583. help:    lda    #cmcfm        ; Try to get a confirm
  5584.     jsr    comnd        ; Go get it
  5585.      jmp    kermt3        ; Didn't find one? Give 'not confirmed' message
  5586. help2:  ldx    cmhptr        ; L.O. byte of current help text address
  5587.     ldy    cmhptr+1    ; H.O. byte of address
  5588.     jsr    prstr        ; Print it
  5589.     jmp    kermit        ; Return to main routine
  5590.  
  5591. .SBTTL    Log routine
  5592.  
  5593. ;
  5594. ;    This routine logs a session to a disk file.
  5595. ;
  5596. ;        Input:  NONE
  5597. ;
  5598. ;        Output: NONE
  5599. ;
  5600. ;        Registers destroyed:    NONE
  5601. ;
  5602.  
  5603. log:    jmp    kermit
  5604.  
  5605. .SBTTL    Bye routine
  5606.  
  5607. ;
  5608. ;    This routine terminates the remote server, logs out and terminates
  5609. ;    the local Kermit.
  5610. ;
  5611.  
  5612. bye:    jsr    prcfm        ; Go parse and print the confirm
  5613.     jsr    logo        ; Tell other Kermit to log out
  5614.      jmp    kermit        ; Don't exit if there was an error
  5615.     jmp    exit1        ; Leave
  5616.  
  5617. ;
  5618. ;    Logo - This routine does the actual work to send the logout
  5619. ;    packet to the remote server
  5620. ;
  5621.  
  5622. logo:    jsr    openrs        ;[27] Reset the RS-232 channel
  5623.     lda    #$00        ; Zero the number of tries
  5624.     sta    numtry        ;        ...
  5625.     sta    tpak        ;    and the total packet number
  5626.     sta    tpak+1        ;        ...
  5627.     lda    #pdbuf\        ;[29] Get the address of the packet buffer
  5628.     sta    kerbf1        ;[29]   and save it for Spak
  5629.     lda    #pdbuf^        ;[29]        ...
  5630.     sta    kerbf1+1    ;[29]        ...
  5631. logo1:    lda    numtry        ; Fetch the number of tries
  5632.     cmp    maxtry        ; Have we exceeded Maxtry?
  5633.     bmi    logo3        ; Not yet, go send the packet
  5634. logo2:    ldx    #ermesc\    ; Yes, give an error message
  5635.     ldy    #ermesc^    ;        ...
  5636.     jsr    prstr        ;        ...
  5637.     jsr    prcrlf        ;        ...
  5638.     rts            ;    and return
  5639. logo3:    inc    numtry        ; Increment the number of tries for packet
  5640.     lda    #$00        ; Make it packet number 0
  5641.     sta    pnum        ;        ...
  5642.     lda    #$01        ; Data length is only 1
  5643.     sta    pdlen        ;        ...
  5644.     lda    #'L        ; The 'Logout' command
  5645.     sta    pdbuf        ; Put that in first character of buffer
  5646.     lda    #'G        ; Generic command packet type
  5647.     sta    ptype        ;        ...
  5648.     jsr    flshin        ;[25] Flush the RS232 buffer
  5649.     jsr    spak        ; Send the packet
  5650.     jsr    rpak        ; Try to fetch an ACK
  5651.     cmp    #true        ; Did we receive successfully?
  5652.     bne    logo1        ; No, try to send the packet again
  5653.     lda    ptype        ; Get the type
  5654.     cmp    #'Y        ; An ACK?
  5655.     bne    logoce        ; No, go check for error
  5656.     jmp    rskp        ; Yes, skip return
  5657. logoce:    cmp    #'E        ; Error packet?
  5658.     bne    logo1        ; Nope, resend packet
  5659.     jsr    prcerp        ; Go display the error
  5660.     rts            ;    and return
  5661.  
  5662. .SBTTL    Finish routine
  5663.  
  5664. ;
  5665. ;    This routine terminates the remote server but does not log
  5666. ;    it out. It also keeps the local Kermit running.
  5667. ;
  5668.  
  5669. finish:    jsr    prcfm        ; Go parse and print the confirm
  5670.     jsr    openrs        ;[27] Reset the RS232 channel
  5671.     lda    #$00        ; Zero the number of tries
  5672.     sta    numtry        ;        ...
  5673.     sta    tpak        ;    and the total packet number
  5674.     sta    tpak+1        ;        ...
  5675.     lda    #pdbuf\        ;[29] Get the address of the packet buffer
  5676.     sta    kerbf1        ;[29]   and save it for Spak
  5677.     lda    #pdbuf^        ;[29]        ...
  5678.     sta    kerbf1+1    ;[29]        ...
  5679. finsh1:    lda    numtry        ; Fetch the number of tries
  5680.     cmp    maxtry        ; Have we exceeded Maxtry?
  5681.     bmi    finsh3        ; Not yet, go send the packet
  5682. finsh2:    ldx    #ermesd\    ; Yes, give an error message
  5683.     ldy    #ermesd^    ;        ...
  5684.     jsr    prstr        ;        ...
  5685.     jsr    prcrlf        ;        ...
  5686.     jmp    kermit        ;    and go back for more commands
  5687. finsh3:    inc    numtry        ; Increment the number of tries for packet
  5688.     lda    #$00        ; Make it packet number 0
  5689.     sta    pnum        ;        ...
  5690.     lda    #$01        ; Data length is only 1
  5691.     sta    pdlen        ;        ...
  5692.     lda    #'F        ; The 'Finish' command
  5693.     sta    pdbuf        ; Put that in first character of buffer
  5694.     lda    #'G        ; Generic command packet type
  5695.     sta    ptype        ;        ...
  5696.     jsr    flshin        ;[25] Flush the RS232 buffer
  5697.     jsr    spak        ; Send the packet
  5698.     jsr    rpak        ; Try to fetch an ACK
  5699.     cmp    #true        ; Did we receive successfully?
  5700.     bne    finsh1        ; No, try to send the packet again
  5701.     lda    ptype        ; Get the type
  5702.     cmp    #'Y        ; An ACK?
  5703.     bne    fince        ; No, go check for error
  5704.     jmp    kermit        ; Yes, go back for more commands
  5705. fince:    cmp    #'E        ; Error packet?
  5706.     bne    finsh1        ; Nope, resend packet
  5707.     jsr    prcerp        ;; Go display the error
  5708.     jmp    kermit        ; Go back for more 
  5709.  
  5710. .SBTTL    Get routine
  5711.  
  5712. ;
  5713. ;    This routine accepts an unquoted string terminated by 
  5714. ;    <cr>,<lf>,<ff>, or <esc> and tries to fetch the file
  5715. ;    represented by that string from a remote server Kermit.
  5716. ;
  5717.  
  5718. getfrs:    jsr    openrs        ;[27] Reset the RS232 channel
  5719.     lda    #yes        ; Make KERMIT use file headers
  5720.     sta    usehdr        ;    for file names
  5721.     lda    #mxfnl+1    ; The buffer size is one more than max
  5722.     sta    kwrk01        ;    file name length
  5723.     lda    #fcb1\        ; Point to the buffer
  5724.     sta    kerto        ;        ...
  5725.     lda    #fcb1^        ;        ...
  5726.     sta    kerto+1        ;        ...
  5727.     jsr    kerflm        ; Clear the buffer
  5728.     lda    #$80        ; Reset all break characters
  5729.     jsr    rstbrk        ;        ...
  5730.     lda    #cr        ;        ...
  5731.     jsr    setbrk        ;        ...
  5732.     lda    #lf        ;        ...
  5733.     jsr    setbrk        ;        ...
  5734.     lda    #ffd        ;        ...
  5735.     jsr    setbrk        ;        ...
  5736.     lda    #esc        ;        ...
  5737.     jsr    setbrk        ;        ...
  5738.     ldy    #$00        ;        ...
  5739.     lda    #cmtxt        ; Parse for text
  5740.     jsr    comnd        ; Do it
  5741.      jmp    kermta        ; Found null string
  5742.     cmp    spsiz        ; Larger than the set packet size?
  5743.     bmi    getf1        ; No, continue
  5744.     lda    spsiz        ; Yes, it will have to be truncated
  5745. getf1:    sta    kwrk01        ; Store packet size for Kercpy
  5746.     sta    pdlen        ;    and Spak
  5747.     lda    #pdbuf\        ; Point to the data buffer as destination
  5748.     sta    kerto        ;        ...
  5749.     sta    kerbf1        ; Store L.O.B. here for Spak routine
  5750.     lda    #pdbuf^        ;        ...
  5751.     sta    kerto+1        ;        ...
  5752.     sta    kerbf1+1    ; Store H.O.B. here for Spak routine
  5753.     stx    kerfrm        ; Point to the atom buffer from Comnd
  5754.     sty    kerfrm+1    ;    as the source address
  5755.     txa            ; Save the 'from buffer' pointers for later
  5756.     pha            ;        ...
  5757.     tya            ;        ...
  5758.     pha            ;        ...
  5759.     jsr    kercpy        ; Copy the string
  5760.     pla            ; Restore these for the next move
  5761.     sta    kerfrm+1    ;        ...
  5762.     pla            ;        ...
  5763.     sta    kerfrm        ;        ...
  5764.     lda    #fcb1\        ; Set up the address of the target
  5765.     sta    kerto        ;        ...
  5766.     lda    #fcb1^        ;        ...
  5767.     sta    kerto+1        ;        ...
  5768.     jsr    clrfcb        ; Clear the fcb first
  5769.     jsr    kercpy        ; Go move the string
  5770.     jsr    prcfm        ; Go parse and print the confirm
  5771.     lda    #'R        ; Packet type is 'Receive-init'
  5772.     sta    ptype        ;        ...
  5773.     lda    #$00        ; Packet number should be zero
  5774.     sta    pnum        ;        ...
  5775.     jsr    spak        ; Packet length was set above, 
  5776.     jsr    rswt        ;    so just call spak and try to receive
  5777.     jmp    kermit        ; Go back for more commands
  5778.  
  5779.  
  5780. .SBTTL    Receve routine
  5781.  
  5782. ;
  5783. ;    This routine receives a file from the remote kermit and
  5784. ;    writes it to a disk file.
  5785. ;
  5786. ;        Input:  Filename returned from comnd, if any
  5787. ;
  5788. ;        Output: If file transfer is good, file is output to disk
  5789. ;
  5790. ;        Registers destroyed:    A,X,Y
  5791. ;
  5792.  
  5793. receve:    jsr    openrs        ;[27] Reset the RS232 channel
  5794.     lda    #on        ; Set use file-header switch on in case we
  5795.     sta    usehdr        ;    don't parse a filename
  5796.     lda    #kerehr\    ; Point to extra help commands
  5797.     sta    cmehpt        ;        ...
  5798.     lda    #kerehr^    ;        ...
  5799.     sta    cmehpt+1    ;        ...
  5800.     ldx    #mxfnl        ; Longest length a filename may be
  5801.     ldy    #cmfehf        ; Tell Comnd about extra help
  5802.     lda    #cmifi        ; Load opcode for parsing input files
  5803.     jsr    comnd        ; Call comnd routine
  5804.      jmp    recev1        ; Continue, don't turn file-header switch off
  5805.     sta    kwrk01        ; Store length of file parsed
  5806.     stx    kerfrm        ; Save the from address (addr[atmbuf])
  5807.     sty    kerfrm+1    ;        ...
  5808.     lda    #fcb1\        ; Save the to address (Fcb1)
  5809.     sta    kerto        ;        ...
  5810.     lda    #fcb1^        ;        ...
  5811.     sta    kerto+1        ;        ...
  5812.     jsr    clrfcb        ; Clear the fcb
  5813.     jsr    kercpy        ; Copy the string
  5814.     lda    #off        ; We parsed a filename so we don't need the
  5815.     sta    usehdr        ;    info from the file-header
  5816. recev1: ;lda    #cmcfm        ; Get token for confirm
  5817.     ;jsr    comnd        ;    and try to parse that
  5818.     ; jmp    kermt3        ; Failed - give the error
  5819.     jsr    prcfm        ;[] Parse and print a confirm
  5820.     jsr    rswt        ; Perform send-switch routine
  5821.     jmp    kermit        ; Go back to main routine
  5822. rswt:    lda    #'R        ; The state is receive-init
  5823.     sta    state        ; Set that up
  5824.     lda    #$00        ; Zero the packet sequence number
  5825.     sta    n        ;        ...
  5826.     sta    numtry        ;    Number of tries
  5827.     sta    oldtry        ;    Old number of tries
  5828.     sta    eofinp        ;    End of input flag
  5829.     sta    errcod        ;    Error indicator
  5830.     sta    rtot        ;    Total received characters
  5831.     sta    rtot+1        ;        ...
  5832.     sta    stot        ;    Total Sent characters
  5833.     sta    stot+1        ;        ...
  5834.     sta    rchr        ;    Received characters, current file
  5835.     sta    rchr+1        ;        ...
  5836.     sta    schr        ;    and Sent characters, current file
  5837.     sta    schr+1        ;        ...
  5838.     sta    tpak        ;    and the total packet number
  5839.     sta    tpak+1        ;        ...
  5840. rswt1:  lda    state        ; Fetch the current system state
  5841.     cmp    #'D        ; Are we trying to receive data?
  5842.     bne    rswt2        ; If not, try the next one
  5843.     jsr    rdat        ; Go try for the data packet
  5844.     jmp    rswt1        ; Go back to the top of the loop
  5845. rswt2:  cmp    #'F        ; Do we need a file header packet?
  5846.     bne    rswt3        ; If not, continue checking
  5847.     jsr    rfil        ; Go get the file-header
  5848.     jmp    rswt1        ; Return to top of loop
  5849. rswt3:  cmp    #'R        ; Do we need the init?
  5850.     bne    rswt4        ; No, try next state
  5851.     jsr    rini        ; Yes, go get it
  5852.     jmp    rswt1        ; Go back to top
  5853. rswt4:  cmp    #'C        ; Have we completed the transfer?
  5854.     bne    rswt5        ; No, we are out of states, fail
  5855.     lda    #true        ; Load AC for true return
  5856.     rts            ; Return
  5857. rswt5:  lda    #false        ; Set up AC for false return
  5858.     rts            ; Return
  5859.  
  5860. rini:    lda    #pdbuf\        ; Point kerbf1 at the packet data buffer
  5861.     sta    kerbf1        ;        ...
  5862.     lda    #pdbuf^        ;        ...
  5863.     sta    kerbf1+1    ;        ...
  5864.     lda    numtry        ; Get current number of tries
  5865.     inc    numtry        ; Increment it for next time
  5866.     cmp    maxtry        ; Have we tried this one enougth times
  5867.     beq    rini1        ; Not yet, go on
  5868.     bcs    rini1a        ; Yup, go abort this transfer
  5869. rini1:  jmp    rini2        ; Continue
  5870. rini1a: lda    #'A        ; Change state to 'abort'
  5871.     sta    state        ;        ...
  5872.     lda    #errcri        ; Fetch the error index
  5873.     sta    errcod        ;    and store it as the error code
  5874.     lda    #false        ; Load AC with false status
  5875.     rts            ;    and return
  5876. rini2:  jsr    rpak        ; Go try to receive a packet
  5877.     sta    rstat        ; Store the return status for later
  5878.     lda    ptype        ; Fetch the packet type we got
  5879.     cmp    #'S        ; Was it an 'Init'?
  5880.     bne    rini2a        ; No, check the return status
  5881.     jmp    rinici        ; Go handle the init case
  5882. rini2a: lda    rstat        ; Fetch the saved return status
  5883.     cmp    #false        ; Is it false?
  5884.     beq    rini2b        ; Yes, just return with same state
  5885.     lda    #errcri        ; No, fetch the error index
  5886.     sta    errcod        ;    and store it as the error code
  5887.     jsr    prcerp        ; Check for error packet and process it
  5888.     lda    #'A        ; Abort this transfer
  5889.     sta    state        ; State is now 'abort'
  5890.     lda    #false        ; Set return status to 'false'
  5891.     rts            ; Return
  5892. rini2b: lda    n        ; Get packet sequence number expected
  5893.     sta    pnum        ; Stuff that parameter at the Nakit routine
  5894.     jsr    nakit        ; Go send the Nak
  5895.     lda    #false        ; Set up failure return status
  5896.     rts            ;    and go back
  5897.  
  5898. rinici: lda    pnum        ; Get the packet number we received
  5899.     sta    n        ; Synchronize our packet numbers with this
  5900.     jsr    rpar        ; Load in the init stuff from packet buffer
  5901.     jsr    spar        ; Stuff our init info into the packet buffer
  5902.     lda    #'Y        ; Store the 'Ack' code into the packet type
  5903.     sta    ptype        ;        ...
  5904.     lda    n        ; Get sequence number
  5905.     sta    pnum        ; Stuff that parameter
  5906.     lda    sebq        ; See what we got for an 8-bit quoting
  5907.     cmp    #$21        ; First check the character range
  5908.     bmi    rinicn        ; Not in range
  5909.     cmp    #$3f        ;        ...
  5910.     bmi    rinicy        ; Inrange
  5911.     cmp    #$60        ;        ...
  5912.     bmi    rinicn        ; Not in range
  5913.     cmp    #$7f        ;        ...
  5914.     bmi    rinicy        ; Inrange
  5915. rinicn: lda    #off        ; No, punt 8-bit quoting
  5916.     sta    ebqmod        ;        ...
  5917.     lda    #$06        ; BTW, the data length is now only 6
  5918.     jmp    rinic1        ; Continue
  5919. rinicy: lda    #on        ; Make sure everything is on
  5920.     sta    ebqmod        ;        ...
  5921.     lda    #$07        ; Data length for ack-init is 7
  5922. rinic1: sta    pdlen        ; Store packet data length
  5923.     jsr    spak        ; Send that packet
  5924.     lda    numtry        ; Move the number of tries for this packet
  5925.     sta    oldtry        ;    to prev packet try count
  5926.     lda    #$00        ; Zero
  5927.     sta    numtry        ;    the number of tries for current packet
  5928.     jsr    incn        ; Increment the packet number once
  5929.     lda    #'F        ; Advance to 'File-header' state
  5930.     sta    state        ;        ...
  5931.     lda    #true        ; Set up return code
  5932.     rts            ; Return
  5933.  
  5934. rfil:    lda    numtry        ; Get number of tries for this packet
  5935.     inc    numtry        ; Increment it for next time around
  5936.     cmp    maxtry        ; Have we tried too many times?
  5937.     beq    rfil1        ; Not yet
  5938.     bcs    rfil1a        ; Yes, go abort the transfer
  5939. rfil1:  jmp    rfil2        ; Continue transfer
  5940. rfil1a: lda    #'A        ; Set state of system to 'abort'
  5941.     sta    state        ;        ...
  5942.     lda    #false        ; Return code should be 'false'
  5943.     rts            ; Return
  5944. rfil2:  jsr    rpak        ; Try to receive a packet
  5945.     sta    rstat        ; Save the return status
  5946.     lda    ptype        ; Get the packet type we found
  5947.     cmp    #'S        ; Was it an 'init' packet?
  5948.     bne    rfil2a        ; Nope, try next one
  5949.     jmp    rfilci        ; Handle the init case
  5950. rfil2a: cmp    #'Z        ; Is it an 'eof' packet??
  5951.     bne    rfil2b        ; No, try again
  5952.     jmp    rfilce        ; Yes, handle that case
  5953. rfil2b: cmp    #'F        ; Is it a 'file-header' packet???
  5954.     bne    rfil2c        ; Nope
  5955.     jmp    rfilcf        ; Handle file-header case
  5956. rfil2c: cmp    #'B        ; Break packet????
  5957.     bne    rfil2d        ; Wrong, go get the return status
  5958.     jmp    rfilcb        ; Handle a break packet
  5959. rfil2d: lda    rstat        ; Fetch the return status from Rpak
  5960.     cmp    #false        ; Was it a false return?
  5961.     beq    rfil2e        ; Yes, Nak it and return
  5962.     lda    #errcrf        ; No, fetch the error index
  5963.     sta    errcod        ;    and store it as the error code
  5964.     jsr    prcerp        ; Check for error packet and process it
  5965.     lda    #'A        ; Abort this transfer
  5966.     sta    state        ;        ...
  5967.     lda    #false        ; Set up failure return code
  5968.     rts            ;    and return
  5969. rfil2e: lda    n        ; Move the expected packet number
  5970.     sta    pnum        ;    into the spot for the parameter
  5971.     jsr    nakit        ; Nak the packet
  5972.     lda    #false        ; Do a false return but don't change state
  5973.     rts            ; Return
  5974. rfilci: lda    oldtry        ; Get number of tries for prev packet
  5975.     inc    oldtry        ; Increment it
  5976.     cmp    maxtry        ; Have we tried this one too much?
  5977.     beq    rfili1        ; Not quite yet
  5978.     bcs    rfili2        ; Yes, go abort this transfer
  5979. rfili1: jmp    rfili3        ; Continue
  5980. rfili2:
  5981. rfili5: lda    #'A        ; Move abort code
  5982.     sta    state        ;    to system state
  5983.     lda    #errcrf        ; Fetch the error index
  5984.     sta    errcod        ;    and store it as the error code
  5985.     lda    #false        ; Prepare failure return
  5986.     rts            ;    and go back
  5987. rfili3: lda    pnum        ; See if pnum=n-1
  5988.     clc            ;        ...
  5989.     adc    #$01        ;        ...
  5990.     cmp    n        ;        ...
  5991.     beq    rfili4        ; If it does, than we are ok
  5992.     jmp    rfili5        ; Otherwise, abort
  5993. rfili4: jsr    spar        ; Set up the init parms in the packet buffer
  5994.     lda    #'Y        ; Set up the code for Ack
  5995.     sta    ptype        ; Stuff that parm
  5996.     lda    #$06        ; Packet length for init
  5997.     sta    pdlen        ; Stuff that also
  5998.     jsr    spak        ; Send the ack
  5999.     lda    #$00        ; Clear out
  6000.     sta    numtry        ;    the number of tries for current packet
  6001.     lda    #true        ; This is ok, return true with current state
  6002.     rts            ; Return
  6003. rfilce: lda    oldtry        ; Get number of tries for previous packet
  6004.     inc    oldtry        ; Up it for next time we have to do this
  6005.     cmp    maxtry        ; Too many times for this packet?
  6006.     beq    rfile1        ; Not yet, continue
  6007.     bcs    rfile2        ; Yes, go abort it
  6008. rfile1: jmp    rfile3        ;        ...
  6009. rfile2:
  6010. rfile5:    lda    #'A        ; Load abort code
  6011.     sta    state        ;    into current system state
  6012.     lda    #errcrf        ; Fetch the error index
  6013.     sta    errcod        ;    and store it as the error code
  6014.     lda    #false        ; Prepare failure return
  6015.     rts            ;    and return
  6016. rfile3:    lda    pnum        ; First, see if pnum=n-1
  6017.     clc            ;        ...
  6018.     adc    #$01        ;        ...
  6019.     cmp    n        ;        ...
  6020.     beq    rfile4        ; If so, continue
  6021.     jmp    rfile5        ; Else, abort it
  6022. rfile4: lda    #'Y        ; Load 'ack' code
  6023.     sta    ptype        ; Stuff that in the packet type
  6024.     lda    #$00        ; This packet will have a packet data length
  6025.     sta    pdlen        ;    of zero
  6026.     jsr    spak        ; Send the packet out
  6027.     lda    #$00        ; Zero number of tries for current packet
  6028.     sta    numtry        ;        ...
  6029.     lda    #true        ; Set up successful return code
  6030.     rts            ;    and return
  6031. rfilcf: lda    pnum        ; Does pnum=n?
  6032.     cmp    n        ;        ...
  6033.     bne    rfilf1        ; If not, abort
  6034.     jmp    rfilf2        ; Else, we can continue
  6035. rfilf1:    lda    #'A        ; Load the abort code
  6036.     sta    state        ;    and stuff it as current system state
  6037.     lda    #errcrf        ; Fetch the error index
  6038.     sta    errcod        ;    and store it as the error code
  6039.     lda    #false        ; Prepare failure return
  6040.     rts            ;    and go back
  6041. rfilf2: jsr    getfil        ; Get the filename we are to use
  6042.     lda    #fncwrt        ; Tell the open routine we want to write
  6043.     jsr    openf        ; Open up the file
  6044.     lda    #'Y        ; Stuff code for 'ack'
  6045.     sta    ptype        ; Into packet type parm
  6046.     lda    #$00        ; Stuff a zero in as the packet data length
  6047.     sta    pdlen        ;        ...
  6048.     jsr    spak        ; Ack the packet
  6049.     lda    numtry        ; Move current tries to previous tries
  6050.     sta    oldtry        ;        ...
  6051.     lda    #$00        ; Clear the
  6052.     sta    numtry        ; Number of tries for current packet
  6053.     jsr    incn        ; Increment the packet sequence number once
  6054.     lda    #'D        ; Advance the system state to 'receive-data'
  6055.     sta    state        ;        ...
  6056.     lda    #true        ; Set up success return
  6057.     rts            ;    and go back
  6058. rfilcb: lda    pnum        ; Does pnum=n?
  6059.     cmp    n        ;        ...
  6060.     bne    rfilb1        ; If not, abort the transfer process
  6061.     jmp    rfilb2        ; Otherwise, we can continue
  6062. rfilb1:    lda    #'A        ; Code for abort
  6063.     sta    state        ; Stuff that into system state
  6064.     lda    #errcrf        ; Fetch the error index
  6065.     sta    errcod        ;    and store it as the error code
  6066.     lda    #false        ; Load failure return status
  6067.     rts            ;    and return
  6068. rfilb2: lda    #'Y        ; Set up 'ack' packet type
  6069.     sta    ptype        ;        ...
  6070.     lda    #$00        ; Zero out
  6071.     sta    pdlen        ;    the packet data length
  6072.     jsr    spak        ; Send out this packet
  6073.     lda    #'C        ; Advance state to 'complete'
  6074.     sta    state        ;    since we are now done with the transfer
  6075.     lda    #true        ; Return a true
  6076.     rts            ;        ...
  6077.  
  6078. rdat:    lda    numtry        ; Get number of tries for current packet
  6079.     inc    numtry        ; Increment it for next time around
  6080.     cmp    maxtry        ; Have we gone beyond number of tries allowed?
  6081.     beq    rdat1        ; Not yet, so continue
  6082.     bcs    rdat1a        ; Yes, we have, so abort
  6083. rdat1:  jmp    rdat2        ;        ...
  6084. rdat1a: lda    #'A        ; Code for 'abort' state
  6085.     sta    state        ; Stuff that in system state
  6086.     lda    #errcrd        ; Fetch the error index
  6087.     sta    errcod        ;    and store it as the error code
  6088.     lda    #false        ; Set up failure return code
  6089.     rts            ;    and go back
  6090. rdat2:  jsr    rpak        ; Go try to receive a packet
  6091.     sta    rstat        ; Save the return status for later
  6092.     lda    ptype        ; Get the type of packet we just picked up
  6093.     cmp    #'D        ; Was it a data packet?
  6094.     bne    rdat2a        ; If not, try next type
  6095.     jmp    rdatcd        ; Handle a data packet
  6096. rdat2a: cmp    #'F        ; Is it a file-header packet?
  6097.     bne    rdat2b        ; Nope, try again
  6098.     jmp    rdatcf        ; Go handle a file-header packet
  6099. rdat2b: cmp    #'Z        ; Is it an eof packet???
  6100.     bne    rdat2c        ; If not, go check the return status from rpak
  6101.     jmp    rdatce        ; It is, go handle eof processing
  6102. rdat2c: lda    rstat        ; Fetch the return status
  6103.     cmp    #false        ; Was it a failure return?
  6104.     beq    rdat2d        ; If it was, Nak it
  6105.     lda    #errcrd        ; Fetch the error index
  6106.     sta    errcod        ;    and store it as the error code
  6107.     jsr    prcerp        ; Check for error packet and process it
  6108.     lda    #'A        ; Give up the whole transfer
  6109.     sta    state        ; Set system state to 'false'
  6110.     lda    #false        ; Set up a failure return
  6111.     rts            ;    and go back
  6112. rdat2d: lda    n        ; Get the expected packet number
  6113.     sta    pnum        ; Stuff that parameter for Nak routine
  6114.     jsr    nakit        ; Send a Nak packet
  6115.     lda    #false        ; Give failure return
  6116.     rts            ; Go back
  6117.  
  6118. rdatcd: lda    pnum        ; Is pnum the right sequence number?
  6119.     cmp    n        ;        ...
  6120.     bne    rdatd1        ; If not, try another approach
  6121.     jmp    rdatd7        ; Otherwise, everything is fine
  6122. rdatd1: lda    oldtry        ; Get number of tries for previous packet
  6123.     inc    oldtry        ; Increment it for next time we need it
  6124.     cmp    maxtry        ; Have we exceeded that limit?
  6125.     beq    rdatd2        ; Not just yet, continue
  6126.     bcs    rdatd3        ; Yes, go abort the whole thing
  6127. rdatd2: jmp    rdatd4        ; Just continue working on the thing
  6128. rdatd3:
  6129. rdatd6:    lda    #'A        ; Load 'abort' code into the
  6130.     sta    state        ;    current system state
  6131.     lda    #errcrd        ; Fetch the error index
  6132.     sta    errcod        ;    and store it as the error code
  6133.     lda    #false        ; Make this a failure return
  6134.     rts            ; Return
  6135. rdatd4: lda    pnum        ; Is pnum=n-1... Is the received packet
  6136.     clc            ;    the one previous to the currently
  6137.     adc    #$01        ;    expected packet?
  6138.     cmp    n        ;        ...
  6139.     beq    rdatd5        ; Yes, continue transfer
  6140.     jmp    rdatd6        ; Nope, abort the whole thing
  6141. rdatd5:    lda    #'Y        ; Make it look like an ack to a send-init
  6142.     sta    ptype        ;        ...
  6143.     jsr    spak        ; Go send the ack
  6144.     lda    #$00        ; Clear the
  6145.     sta    numtry        ;    number of tries for current packet
  6146.     lda    #true        ;        ...
  6147.     rts            ; Return (successful!)
  6148. rdatd7: jsr    bufemp        ; Go empty the packet buffer
  6149.     lda    #'Y        ; Set up an ack packet
  6150.     sta    ptype        ;        ...
  6151.     lda    n        ;        ...
  6152.     sta    pnum        ;        ...
  6153.     lda    #$00        ; Don't forget, there is no data
  6154.     sta    pdlen        ;        ...
  6155.     jsr    spak        ; Send it!
  6156.     lda    numtry        ; Move tries for current packet count to
  6157.     sta    oldtry        ;    tries for previous packet count
  6158.     lda    #$00        ; Zero the
  6159.     sta    numtry        ;    number of tries for current packet
  6160.     jsr    incn        ; Increment the packet sequence number once
  6161.     lda    #'D        ; Advance the system state to 'receive-data'
  6162.     sta    state        ;        ...
  6163.     lda    #true        ;        ...
  6164.     rts            ; Return (successful)
  6165.  
  6166. rdatcf: lda    oldtry        ; Fetch number of tries for previous packet
  6167.     inc    oldtry        ; Increment it for when we need it again
  6168.     cmp    maxtry        ; Have we exceeded maximum tries allowed?
  6169.     beq    rdatf1        ; Not yet, go on
  6170.     bcs    rdatf2        ; Yup, we have to abort this thing
  6171. rdatf1: jmp    rdatf3        ; Just continue the transfer
  6172. rdatf2:
  6173. rdatf5:    lda    #'A        ; Move 'abort' code to current system state
  6174.     sta    state        ;        ...
  6175.     lda    #errcrd        ; Fetch the error index
  6176.     sta    errcod        ;    and store it as the error code
  6177.     lda    #false        ;        ...
  6178.     rts            ;    and return false
  6179. rdatf3: lda    pnum        ; Is this packet the one before the expected
  6180.     clc            ;    one?
  6181.     adc    #$01        ;        ...
  6182.     cmp    n        ;        ...
  6183.     beq    rdatf4        ; If so, we can still ack it
  6184.     jmp    rdatf5        ; Otherwise, we should abort the transfer
  6185. rdatf4: lda    #'Y        ; Load 'ack' code
  6186.     sta    ptype        ; Stuff that parameter
  6187.     lda    #$00        ; Use zero as the packet data length
  6188.     sta    pdlen        ;        ...
  6189.     jsr    spak        ; Send it!
  6190.     lda    #$00        ; Zero the number of tries for current packet
  6191.     sta    numtry        ;        ...
  6192.     lda    #true        ;        ...
  6193.     rts            ; Return (successful)
  6194.  
  6195. rdatce: lda    pnum        ; Is this the packet we are expecting?
  6196.     cmp    n        ;        ...
  6197.     bne    rdate1        ; No, we should go abort
  6198.     jmp    rdate2        ; Yup, go handle it
  6199. rdate1:    lda    #'A        ; Load 'abort' code into
  6200.     sta    state        ;    current system state
  6201.     lda    #errcrd        ; Fetch the error index
  6202.     sta    errcod        ;    and store it as the error code
  6203.     lda    #false        ;        ...
  6204.     rts            ; Return (failure)
  6205. rdate2:;lda    #fcb1\        ; Get the pointer to the fcb
  6206. ;    sta    kerfcb        ;    and store it where the close routine
  6207. ;    lda    #fcb1^        ;    can find it
  6208. ;    sta    kerfcb        ;        ...
  6209. ;    lda    #$00        ; Make CLOSEF see there are no errors
  6210.     jsr    closef        ; We are done with this file, so close it
  6211.     jsr    incn        ; Increment the packet number
  6212.     lda    #'Y        ; Get set up for the ack
  6213.     sta    ptype        ; Stuff the packet type
  6214.     lda    n        ;    packet number
  6215.     sta    pnum        ;        ...
  6216.     lda    #$00        ;    and packet data length
  6217.     sta    pdlen        ;    parameters
  6218.     jsr    spak        ; Go send it!
  6219.     lda    #'F        ; Advance system state to 'file-header'
  6220.     sta    state        ;    incase more files are coming
  6221.     lda    #true        ;        ...
  6222.     rts            ; Return (successful)
  6223.  
  6224. .SBTTL    Send routine
  6225.  
  6226. ;
  6227. ;    This routine reads a file from disk and sends packets
  6228. ;    of data to the remote kermit.
  6229. ;
  6230. ;        Input:  Filename returned from Comnd routines
  6231. ;
  6232. ;        Output: File is sent over port
  6233. ;
  6234. ;        Registers destroyed:    A,X,Y
  6235. ;
  6236.  
  6237. send:    jsr    openrs        ;[27] Reset the RS232 channel
  6238.     ldx    #mxfnl        ; Longest length a filename may be
  6239.     ldy    #$00        ; No special flags needed
  6240.     lda    #cmifi        ; Load opcode for parsing input files
  6241.     jsr    comnd        ; Call comnd routine
  6242.      jmp    kermt6        ; Give the 'missing filespec' error
  6243.     sta    kwrk01        ; Store length of file parsed
  6244.     stx    kerfrm        ; Save the from address (addr[atmbuf])
  6245.     sty    kerfrm+1    ;        ...
  6246.     lda    #fcb1\        ; Save the to address (Fcb1)
  6247.     sta    kerto        ;        ...
  6248.     lda    #fcb1^        ;        ...
  6249.     sta    kerto+1        ;        ...
  6250.     jsr    clrfcb        ; Clear the fcb
  6251.     jsr    kercpy        ; Copy the string
  6252.     ldy    kwrk01        ; Get filename length
  6253.     lda    #nul        ; Fetch a null character
  6254.     sta    (kerto),y    ; Stuff a null at end-of-buffer
  6255.     jsr    prcfm        ; Parse and print a confirm
  6256.     jsr    sswt        ; Perform send-switch routine
  6257.     jmp    kermit        ; Go back to main routine
  6258.  
  6259. sswt:    lda    #'S        ; Set up state variable as
  6260.     sta    state        ;    Send-init
  6261.     lda    #$00        ; Clear
  6262.     sta    eodind        ;    The End-of-Data indicator
  6263.     sta    n        ;    Packet number
  6264.     sta    numtry        ;    Number of tries
  6265.     sta    oldtry        ;    Old number of tries
  6266.     sta    eofinp        ;    End of input flag
  6267.     sta    errcod        ;    Error indicator
  6268.     sta    rtot        ;    Total received characters
  6269.     sta    rtot+1        ;        ...
  6270.     sta    stot        ;    Total Sent characters
  6271.     sta    stot+1        ;        ...
  6272.     sta    rchr        ;    Received characters, current file
  6273.     sta    rchr+1        ;        ...
  6274.     sta    schr        ;    and Sent characters, current file
  6275.     sta    schr+1        ;        ...
  6276.     sta    tpak        ;    and the total packet number
  6277.     sta    tpak+1        ;        ...
  6278.     lda    #pdbuf\        ; Set up the address of the packet buffer
  6279.     sta    saddr        ;    so that we can clear it out
  6280.     lda    #pdbuf^        ;        ...
  6281.     sta    saddr+1        ;        ...
  6282.     lda    #$00        ; Clear AC
  6283.     ldy    #$00        ; Clear Y
  6284. clpbuf: sta    (saddr),y    ; Step through buffer, clearing it out
  6285.     iny            ; Up the index
  6286.     cpy    #mxpack-4    ; Done?
  6287.     bmi    clpbuf        ; No, continue
  6288. sswt1:  lda    state        ; Fetch state of the system
  6289.     cmp    #'D        ; Do Send-data?
  6290.     bne    sswt2        ; No, try next one
  6291.     jsr    sdat        ; Yes, send a data packet
  6292.     jmp    sswt1        ; Go to the top of the loop
  6293. sswt2:  cmp    #'F        ; Do we want to send-file-header?
  6294.     bne    sswt3        ; No, continue
  6295.     jsr    sfil        ; Yes, send a file header packet
  6296.     jmp    sswt1        ; Return to top of loop
  6297. sswt3:  cmp    #'Z        ; Are we due for an Eof packet?
  6298.     bne    sswt4        ; Nope, try next state
  6299.     jsr    seof        ; Yes, do it
  6300.     jmp    sswt1        ; Return to top of loop
  6301. sswt4:  cmp    #'S        ; Must we send an init packet
  6302.     bne    sswt5        ; No, continue
  6303.     jsr    sini        ; Yes, go do it
  6304.     jmp    sswt1        ; And continue
  6305. sswt5:  cmp    #'B        ; Time to break the connection?
  6306.     bne    sswt6        ; No, try next state
  6307.     jsr    sbrk        ; Yes, go send a break packet
  6308.     jmp    sswt1        ; Continue from top of loop
  6309. sswt6:  cmp    #'C        ; Is the entire transfer complete?
  6310.     bne    sswt7        ; No, something is wrong, go abort
  6311.     lda    #true        ; Return true
  6312.     rts            ;        ...
  6313. sswt7:  lda    #false        ; Return false
  6314.     rts            ;        ...
  6315.  
  6316. sdat:    lda    numtry        ; Fetch the number for tries for current packet
  6317.     inc    numtry        ; Add one to it
  6318.     cmp    maxtry        ; Is it more than the maximum allowed?
  6319.     beq    sdat1        ; No, not yet
  6320.     bcs    sdat1a        ; If it is, go abort
  6321. sdat1:  jmp    sdat1b        ; Continue
  6322. sdat1a: lda    #'A        ; Load the 'abort' code
  6323.     sta    state        ; Stuff that in as current state
  6324.     lda    #false        ; Enter false return code
  6325.     rts            ;    and return
  6326. sdat1b: lda    #'D        ; Packet type will be 'Send-data'
  6327.     sta    ptype        ;        ...
  6328.     lda    n        ; Get packet sequence number
  6329.     sta    pnum        ; Store that parameter to Spak
  6330.     lda    size        ; This is the size of the data in the packet
  6331.     sta    pdlen        ; Store that where it belongs
  6332.     jsr    spak        ; Go send the packet
  6333. sdat2:  jsr    rpak        ; Try to get an ack
  6334.     sta    rstat        ; First, save the return status
  6335.     lda    ptype        ; Now get the packet type received
  6336.     cmp    #'N        ; Was it a NAK?
  6337.     bne    sdat2a        ; No, try for an ACK
  6338.     jmp    sdatcn        ; Go handle the nak case
  6339. sdat2a: cmp    #'Y        ; Did we get an ACK?
  6340.     bne    sdat2b        ; No, try checking the return status
  6341.     jmp    sdatca        ; Yes, handle the ack
  6342. sdat2b: lda    rstat        ; Fetch the return status
  6343.     cmp    #false        ; Failure return?
  6344.     beq    sdat2c        ; Yes, just return with current state
  6345.     jsr    prcerp        ; Check for error packet and process it
  6346.     lda    #'A        ; Stuff the abort code
  6347.     sta    state        ;    as the current system state
  6348.     lda    #false        ; Load failure return code
  6349. sdat2c: rts            ; Go back
  6350. sdatcn: dec    pnum        ; Decrement the packet sequence number
  6351.     lda    n        ; Get the expected packet sequence number
  6352.     cmp    pnum        ; If n=pnum-1 then this is like an ack
  6353.     bne    sdatn1        ; No, continue handling the nak
  6354.     jmp    sdata2        ; Jump to ack bypassing sequence check
  6355. sdata1:
  6356. sdatn1: lda    #false        ; Failure return
  6357.     rts            ;        ...
  6358. sdatca: lda    n        ; First check packet number
  6359.     cmp    pnum        ; Did he ack the correct packet?
  6360.     bne    sdata1        ; No, go give failure return
  6361. sdata2: lda    #$00        ; Zero out number of tries for current packet
  6362.     sta    numtry        ;        ...
  6363.     jsr    incn        ; Increment the packet sequence number
  6364.     jsr    bufill        ; Go fill the packet buffer with data
  6365.     sta    size        ; Save the data size returned
  6366.     lda    eofinp        ; Load end-of-file indicator
  6367.     cmp    #true        ; Was this set by Bufill?
  6368.     beq    sdatrz        ; If so, return state 'Z' ('Send-eof')
  6369.     jmp    sdatrd        ; Otherwise, return state 'D' ('Send-data')
  6370. sdatrz:    lda    #$00        ; Clear
  6371.     sta    eofinp        ;    End of input flag
  6372.     lda    #fcb1\        ; Get the pointer to the fcb
  6373.     sta    kerfcb        ;    and store it where the close routine
  6374.     lda    #fcb1^        ;    can find it
  6375.     sta    kerfcb        ;        ...
  6376.     lda    #$00        ; Make CLOSEF see there are no errors
  6377.     jsr    closef        ; We are done with this file, so close it
  6378.     lda    #'Z        ; Load the Eof code
  6379.     sta    state        ;    and make it the current system state
  6380.     lda    #true        ; We did succeed, so give a true return
  6381.     rts            ; Go back
  6382. sdatrd: lda    #'D        ; Load the Data code
  6383.     sta    state        ; Set current system state to that
  6384.     lda    #true        ; Set up successful return
  6385.     rts            ;    and go back
  6386.  
  6387. sfil:
  6388. sfil0:    lda    numtry        ; Fetch the current number of tries
  6389.     inc    numtry        ; Up it by one
  6390.     cmp    maxtry        ; See if we went up to too many
  6391.     beq    sfil1        ; Not yet
  6392.     bcs    sfil1a        ; Yes, go abort
  6393. sfil1:    jmp    sfil1b        ; If we are still ok, take this jump
  6394. sfil1a:    lda    #'A        ; Load code for abort
  6395.     sta    state        ;    and drop that in as the current state
  6396.     lda    #false        ; Load false for a return code
  6397.     rts            ;    and return
  6398. sfil1b:    ldy    #$00        ; Clear Y
  6399. sfil1c:    lda    fcb1,y        ; Get a byte from the filename
  6400.     cmp    #$00        ; Is it a null?
  6401.     beq    sfil1d        ; No, continue
  6402.     cmp    #$20        ; <sp>?
  6403.     beq    sfil1d        ;[DD]
  6404.     sta    pdbuf,y        ; Move the byte to this buffer
  6405.     iny            ; Up the index once
  6406.     jmp    sfil1c        ; Loop and do it again
  6407. sfil1d:    sty    pdlen        ; This is the length of the filename
  6408.     lda    #'F        ; Load type ('Send-file')
  6409.     sta    ptype        ; Stuff that in as the packet type
  6410.     lda    n        ; Get packet number
  6411.     sta    pnum        ; Store that in its common area
  6412.     jsr    spak        ; Go send the packet
  6413. sfil2:    jsr    rpak        ; Go try to receive an ack
  6414.     sta    rstat        ; Save the return status
  6415.     lda    ptype        ; Get the returned packet type
  6416.     cmp    #'N        ; Is it a NAK?
  6417.     bne    sfil2a        ; No, try the next packet type
  6418.     jmp    sfilcn        ; Handle the case of a nak
  6419. sfil2a:    cmp    #'Y        ; Is it, perhaps, an ACK?
  6420.     bne    sfil2b        ; If not, go to next test
  6421.     jmp    sfilca        ; Go and handle the ack case
  6422. sfil2b:    lda    rstat        ; Get the return status
  6423.     cmp    #false        ; Is it a failure return?
  6424.     bne    sfil2c        ; No, just go abort the send
  6425.     rts            ; Return failure with current state
  6426. sfil2c:    jsr    prcerp        ; Check for error packet and process it
  6427.     lda    #'A        ; Set state to 'abort'
  6428.     sta    state        ; Stuff it in its place
  6429.     lda    #false        ; Set up a failure return code
  6430.     rts            ;    and go back
  6431. sfilcn:    dec    pnum        ; Decrement the receive packet number once
  6432.     lda    pnum        ; Load it into the AC
  6433.     cmp    n        ; Compare that with what we are looking for
  6434.     bne    sfiln1        ; If n=pnum-1 then this is like an ack, do it
  6435.     jmp    sfila2        ; This is like an ack
  6436. sfila1:    
  6437. sfiln1:    lda    #false        ; Load failure return code
  6438.     rts            ;    and return
  6439. sfilca:    lda    n        ; Get the packet number
  6440.     cmp    pnum        ; Is that the one that was acked?
  6441.     bne    sfila1        ; They are not equal
  6442. sfila2:    lda    #$00        ; Clear AC
  6443.     sta    numtry        ; Zero the number of tries for current packet
  6444.     jsr    incn        ; Up the packet sequence number
  6445.     lda    #fcb1\        ; Load the fcb address into the pointer
  6446.     sta    kerfcb        ;    for the DOS open routine
  6447.     lda    #fcb1^        ;        ...
  6448.     sta    kerfcb+1    ;        ...
  6449.     lda    #fncrea        ; Open for input
  6450.     jsr    openf        ; Open the file
  6451.     jsr    bufill        ; Go get characters from the file
  6452.     sta    size        ; Save the returned buffer size
  6453.     lda    #'D        ; Set state to 'Send-data'
  6454.     sta    state        ;        ...
  6455.     lda    #true        ; Set up true return code
  6456.     rts            ;    and return
  6457.  
  6458. seof:    lda    numtry        ; Get the number of attempts for this packet
  6459.     inc    numtry        ; Now up it once for next time around
  6460.     cmp    maxtry        ; Are we over the allowed max?
  6461.     beq    seof1        ; Not quite yet
  6462.     bcs    seof1a        ; Yes, go abort
  6463. seof1:  jmp    seof1b        ; Continue sending packet
  6464. seof1a: lda    #'A        ; Load 'abort' code
  6465.     sta    state        ; Make that the state of the system
  6466.     lda    #errmrc        ; Fetch the error index
  6467.     sta    errcod        ;    and store it as the error code
  6468.     lda    #false        ; Return false
  6469.     rts            ;        ...
  6470. seof1b: lda    #'Z        ; Load the packet type 'Z' ('Send-eof')
  6471.     sta    ptype        ; Save that as a parm to Spak
  6472.     lda    n        ; Get the packet sequence number
  6473.     sta    pnum        ; Copy in that parm
  6474.     lda    #$00        ; This is our packet data length (0 for EOF)
  6475.     sta    pdlen        ; Copy it
  6476.     jsr    spak        ; Go send out the Eof
  6477. seof2:  jsr    rpak        ; Try to receive an ack for it
  6478.     sta    rstat        ; Save the return status
  6479.     lda    ptype        ; Get the received packet type
  6480.     cmp    #'N        ; Was it a nak?
  6481.     bne    seof2a        ; If not, try the next packet type
  6482.     jmp    seofcn        ; Go take care of case nak
  6483. seof2a: cmp    #'Y        ; Was it an ack
  6484.     bne    seof2b        ; If it wasn't that, try return status
  6485.     jmp    seofca        ; Take care of the ack
  6486. seof2b: lda    rstat        ; Fetch the return status
  6487.     cmp    #false        ; Was it a failure?
  6488.     beq    seof2c        ; Yes, just fail return with current state
  6489.     jsr    prcerp        ; Check for error packet and process it
  6490.     lda    #'A        ; No, abort the whole thing
  6491.     sta    state        ; Set the state to that
  6492.     lda    #false        ; Get false return status
  6493. seof2c: rts            ; Return
  6494. seofcn: dec    pnum        ; Decrement the received packet sequence number
  6495.     lda    n        ; Get the expected sequence number
  6496.     cmp    pnum        ; If it's the same as pnum-1, it is like an ack
  6497.     bne    seofn1        ; It isn't, continue handling the nak
  6498.     jmp    seofa2        ; Switch to an ack but bypass sequence check
  6499. seofa1:
  6500. seofn1: lda    #false        ; Load failure return status
  6501.     rts            ;    and return
  6502. seofca: lda    n        ; Check sequence number expected against
  6503.     cmp    pnum        ;    the number we got.
  6504.     bne    seofa1        ; If not identical, fail and return curr. state
  6505. seofa2: lda    #$00        ; Clear the number of tries for current packet
  6506.     sta    numtry        ;        ...
  6507.     jsr    incn        ; Up the packet sequence number
  6508.     jsr    getnfl        ; Call the routine to get the next file
  6509.     cmp    #eof        ; If it didn't find any more
  6510.     beq    seofrb        ;    then return state 'B' ('Send-Eot')
  6511.     jmp    seofrf        ; Otherwise, return 'F' ('Send-file')
  6512. seofrb: lda    #'B        ; Load Eot state code
  6513.     sta    state        ; Store that as the current state
  6514.     lda    #true        ; Give a success on the return
  6515.     rts            ;        ...
  6516. seofrf: lda    #'F        ; Load File-header state code
  6517.     sta    state        ; Make that the current system state
  6518.     lda    #true        ; Make success the return status
  6519.     rts            ;    and return
  6520.  
  6521. sini:    lda    #pdbuf\        ; Load the pointer to the
  6522.     sta    kerbf1        ;    packet buffer into its
  6523.     lda    #pdbuf^        ;    place on page zero
  6524.     sta    kerbf1+1    ;        ...
  6525.     jsr    spar        ; Go fill in the send init parms
  6526.     lda    numtry        ; If numtry > maxtry
  6527.     cmp    maxtry        ;        ...
  6528.     beq    sini1        ;        ...
  6529.     bcs    sini1a        ;    then we are in bad shape, go fail
  6530. sini1:  jmp    sini1b        ; Otherwise, we just continue
  6531. sini1a:    lda    #'A        ; Set state to 'abort'
  6532.     sta    state        ;        ...
  6533.     lda    #errmrc        ; Fetch the error index
  6534.     sta    errcod        ;    and store it as the error code
  6535.     lda    #$00        ; Set return status (AC) to fail
  6536.     rts            ; Return
  6537. sini1b: inc    numtry        ; Increment the number of tries for this packet
  6538.     lda    #'S        ; Packet type is 'Send-init'
  6539.     sta    ptype        ; Store that
  6540. ;    lda    ebqmod        ; Do we want 8-bit quoting?
  6541. ;    cmp    #on        ;        ...
  6542. ;    beq    sini1c        ; If so, data length is 7
  6543. ;    lda    #$06        ; Else it is 6
  6544. ;    jmp    sini1d        ;        ...
  6545. sini1c: lda    #$07        ; The length of data in a send-init is always 7
  6546. sini1d: sta    pdlen        ; Store that parameter
  6547.     lda    n        ; Get the packet number
  6548.     sta    pnum        ; Store that in its common area
  6549.     jsr    flshin        ;[25] Flush input buffer
  6550.     jsr    spak        ; Call the routine to ship the packet out
  6551.     jsr    rpak        ; Now go try to receive a packet
  6552.     sta    rstat        ; Hold the return status from that last routine
  6553. sinics: lda    ptype        ; Case statement, get the packet type
  6554.     cmp    #'Y        ; Was it an ACK?
  6555.     bne    sinic1        ; If not, try next type
  6556.     jmp    sinicy        ; Go handle the ack
  6557. sinic1: cmp    #'N        ; Was it a NAK?
  6558.     bne    sinic2        ; If not, try next condition
  6559.     jmp    sinicn        ; Handle a nak
  6560. sinic2: lda    rstat        ; Fetch the return status
  6561.     cmp    #false        ; Was this, perhaps false?
  6562.     bne    sinic3        ; Nope, do the 'otherwise' stuff
  6563.     jmp    sinicf        ; Just go and return
  6564. sinic3:    jsr    prcerp        ; Check for error packet and process it
  6565.     lda    #'A        ; Set state to 'abort'
  6566.     sta    state        ;        ...
  6567. sinicn:
  6568. sinicf: rts            ; Return
  6569.  
  6570. sinicy: ldy    #$00        ; Clear Y
  6571.     lda    n        ; Get packet number
  6572.     cmp    pnum        ; Was the ack for that packet number?
  6573.     beq    siniy1        ; Yes, continue
  6574.     lda    #false        ; No, set false return status
  6575.     rts            ;    and go back
  6576. siniy1: jsr    rpar        ; Get parms from the ack packet
  6577.     lda    sebq        ; Check if other Kermit agrees to 8-bit quoting
  6578. ;    cmp    #'Y        ;        ...
  6579. ;    beq    siniy2        ; Yes!
  6580. ;    lda    #off        ; Shut it off
  6581. ;    sta    ebqmod        ;        ...
  6582.     cmp    #'N        ;[30]
  6583.     bne    siniy3        ;[30] Yes! Leave it alone
  6584.     lda    #off        ;[30] No .. Shut it off
  6585.     sta    ebqmod        ;[30]        ...
  6586. siniy2:
  6587. siniy3: lda    #'F        ; Load code for 'Send-file' into AC
  6588.     sta    state        ; Make that the new state
  6589.     lda    #$00        ; Clear AC
  6590.     sta    numtry        ; Reset numtry to 0 for next send
  6591.     jsr    incn        ; Up the packet sequence number
  6592.     lda    #true        ; Return true
  6593.     rts
  6594.  
  6595. sbrk:    lda    numtry        ; Get the number of tries for this packet
  6596.     inc    numtry        ; Incrment it for next time
  6597.     cmp    maxtry        ; Have we exceeded the maximum
  6598.     beq    sbrk1        ; Not yet
  6599.     bcs    sbrk1a        ; Yes, go abort the whole thing
  6600. sbrk1:  jmp    sbrk1b        ; Continue send
  6601. sbrk1a:    lda    #'A        ; Load 'abort' code
  6602.     sta    state        ; Make that the system state
  6603.     lda    #errmrc        ; Fetch the error index
  6604.     sta    errcod        ;    and store it as the error code
  6605.     lda    #false        ; Load the failure return status
  6606.     rts            ;    and return
  6607. sbrk1b: lda    #'B        ; We are sending an Eot packet
  6608.     sta    ptype        ; Store that as the packet type
  6609.     lda    n        ; Get the current sequence number
  6610.     sta    pnum        ; Copy in that parameter
  6611.     lda    #$00        ; The packet data length will be 0
  6612.     sta    pdlen        ; Copy that in
  6613.     jsr    spak        ; Go send the packet
  6614. sbrk2:  jsr    rpak        ; Try to get an ack
  6615.     sta    rstat        ; First, save the return status
  6616.     lda    ptype        ; Get the packet type received
  6617.     cmp    #'N        ; Was it a NAK?
  6618.     bne    sbrk2a        ; If not, try for the ack
  6619.     jmp    sbrkcn        ; Go handle the nak case
  6620. sbrk2a: cmp    #'Y        ; An ACK?
  6621.     bne    sbrk2b        ; If not, look at the return status
  6622.     jmp    sbrkca        ; Go handle the case of an ack
  6623. sbrk2b: lda    rstat        ; Fetch the return status from Rpak
  6624.     cmp    #false        ; Was it a failure?
  6625.     beq    sbrk2c        ; Yes, just return with current state
  6626.     jsr    prcerp        ; Check for error packet and process it
  6627.     lda    #'A        ; No, set up the 'abort' code
  6628.     sta    state        ;    as the system state
  6629.     lda    #false        ;    load the false return status
  6630. sbrk2c: rts            ;    and return
  6631. sbrkcn: dec    pnum        ; Decrement the received packet number once
  6632.     lda    n        ; Get the expected sequence number
  6633.     cmp    pnum        ; If =pnum-1 then this nak is like an ack
  6634.     bne    sbrkn1        ; No, this was no the case
  6635.     jmp    sbrka2        ; Yes! Go do the ack, but skip sequence check
  6636. sbrka1:
  6637. sbrkn1: lda    #false        ; Load failure return code
  6638.     rts            ;    and go back
  6639. sbrkca: lda    n        ; Get the expected packet sequence number
  6640.     cmp    pnum        ; Did we get what we expected?
  6641.     bne    sbrka1        ; No, return failure with current state
  6642. sbrka2: lda    #$00        ; Yes, clear number of tries for this packet
  6643.     sta    numtry        ;        ...
  6644.     jsr    incn        ; Up the packet sequence number
  6645.     lda    #'C        ; The transfer is now complete, reflect this
  6646.     sta    state        ;    in the system state
  6647.     lda    #true        ; Return success!
  6648.     rts
  6649.  
  6650. .SBTTL    Setcom routine
  6651.  
  6652. ;
  6653. ;    This routine sets Kermit-65 parameters.
  6654. ;
  6655. ;        Input:  Parameters from command line
  6656. ;
  6657. ;        Output: NONE
  6658. ;
  6659. ;        Registers destroyed:    A,X,Y
  6660. ;
  6661.  
  6662. setcom: lda    #setcmd\    ; Load the address of the keyword table
  6663.     sta    cminf1        ;
  6664.     lda    #setcmd^    ;
  6665.     sta    cminf1+1    ;
  6666.     ldy    #$00        ; No special flags needed
  6667.     lda    #cmkey        ; Comnd code for parse keyword
  6668.     jsr    comnd        ; Go get it
  6669.      jmp    kermt2        ; Give an error
  6670.     lda    #setcmb\    ; Get the address of jump table
  6671.     sta    jtaddr        ;
  6672.     lda    #setcmb^    ;
  6673.     sta    jtaddr+1    ;
  6674.     txa            ; Offset to AC
  6675.     jmp    jmpind        ;[DD] Jump
  6676. setcmb: jmp    stesc        ; Set escape character
  6677.     jmp    stibm        ; Set ibm-mode switch
  6678.     jmp    stle        ; Set local-echo switch
  6679.     jmp    strc        ; Set receive parameters
  6680.     jmp    stsn        ; Set send parameters
  6681.     jmp    stvt        ; Set vt52-emulation switch
  6682.     jmp    stfw        ; Set file-warning switch
  6683.     jmp    steb        ; Set Eight-bit quoting character
  6684.     jmp    stdb        ; Set debugging switch
  6685.     jmp    stmod        ; Set file-type mode
  6686.     jmp    stfbs        ; Set the file-byte-size for transfer
  6687.     jmp    stccr        ;[DD] Set rs232 registers 
  6688.     jmp    stpari        ; Set the parity for communication
  6689.     jmp    stbaud        ;[17] Set the baud rate for communication
  6690.     jmp    stwrd        ;[17] Set the word length for communication
  6691.     jmp    stflow        ;[24] Set flow control for communication
  6692.     jmp    stscre        ;[37] Set the screen size
  6693.     jmp    stc1        ; set background color
  6694.     jmp    stc2        ; set bright color
  6695.     jmp    stc3        ; set foreground color
  6696.     jmp    stc4        ; set alternate color
  6697.     jmp    stc5        ; set border color
  6698.  
  6699. stesc:  ldx    #$10        ; Base should be hex
  6700.     ldy    #$00        ; No special flags needed
  6701.     lda    #cmnum        ; Parse for integer
  6702.     jsr    comnd        ; Go!
  6703.      jmp    kermt4        ; Number is bad
  6704.     stx    ksavex        ; Hold the number across the next call
  6705.     sty    ksavey        ;        ...
  6706.     lda    #cmcfm        ; Parse for confirm
  6707.     jsr    comnd        ; Do it
  6708.      jmp    kermt3        ; Not confirmed
  6709.     lda    ksavey        ; If this isn't zero
  6710.     cmp    #$00        ;    it's not an ASCII character
  6711.     beq    stesc1        ; It is, continue
  6712.     jmp    kermt4        ; Bad number, tell them
  6713. stesc1:    lda    ksavex        ; Get L.O. byte
  6714.     cmp    #$7f        ; It shouldn't be bigger than this
  6715.     bmi    stesc2        ; If it's less, it is ok
  6716.     jmp    kermt4        ; Tell the user it is bad
  6717. stesc2: sta    escp        ; Stuff it
  6718.     jmp    kermit
  6719.  
  6720. stibm:  jsr    prson        ; Try parsing an 'on' or 'off'
  6721.      jmp    kermt2        ; Bad keyword
  6722.     stx    ibmmod        ; Store value in the mode switch location
  6723.     stx    lecho        ; Also set local echo accordingly
  6724.     ldy    #nparit        ; Get ready to set the parity parameter
  6725.     lda    #fbebit        ;[17] Get ready to set the word-size parameter
  6726.     cpx    #on        ; Setting ibm mode on?
  6727.     bne    stibm1        ; Nope so set parity none/word-size eight-bit
  6728.     ldy    #mparit        ; Set mark parity
  6729.     lda    #fbsbit        ;[17] Set up for seven bit word size
  6730.     ldx    #off        ;[38] Turn off flow-control
  6731.     stx    flowmo        ;[38]        ...
  6732. stibm1:    sty    parity        ; Store the value
  6733.     sta    wrdsiz        ;[17]        ...
  6734.     lda    #cmcfm        ;[17] Parse for confirm
  6735.     jsr    comnd        ;[17] Do it
  6736.      jmp    kermt3        ;[17] Not confirmed, tell the user that
  6737.     jsr    dopari        ;[17] Really set the parity
  6738.     jsr    dowrd        ;[17] Really set the word size
  6739.     jmp    kermit        ;
  6740.  
  6741. stle:    jsr    prson        ; Try parsing an 'on' or 'off'
  6742.      jmp    kermt2        ; Bad keyword
  6743.     stx    lecho        ; Store value in the mode switch location
  6744.     lda    #cmcfm        ; Parse for confirm
  6745.     jsr    comnd        ; Do it
  6746.      jmp    kermt3        ; Not confirmed, tell the user that
  6747.     jmp    kermit
  6748.  
  6749. strc:    lda    #$00        ; Set srind for receive parms
  6750.     sta    srind        ;        ...
  6751.     lda    #stscmd\    ; Load the address of the keyword table
  6752.     sta    cminf1        ; Save it for the keyword routine
  6753.     lda    #stscmd^    ;
  6754.     sta    cminf1+1    ;
  6755.     ldy    #$00        ; No special flags needed
  6756.     lda    #cmkey        ; Comnd code for parse keyword
  6757.     jsr    comnd        ; Go get it
  6758.      jmp    kermt2        ; Give an error
  6759.     lda    #stcct\        ; Get addr. of jump table
  6760.     sta    jtaddr        ;
  6761.     lda    #stcct^        ;        ...
  6762.     sta    jtaddr+1    ;        ...
  6763.     txa            ; Offset to AC
  6764.     jmp    jmpind      ;[DD] Jump
  6765.  
  6766. stsn:    lda    #$01        ; Set srind for send parms
  6767.     sta    srind        ;        ...
  6768.     lda    #stscmd\    ; Load the address of the keyword table
  6769.     sta    cminf1        ; Save it for the keyword routine
  6770.     lda    #stscmd^    ;        ...
  6771.     sta    cminf1+1    ;        ...
  6772.     ldy    #$00        ; No special flags needed
  6773.     lda    #cmkey        ; Comnd code for parse keyword
  6774.     jsr    comnd        ; Go get it
  6775.      jmp    kermt2        ; Give an error
  6776.     lda    #stcct\        ; Get addr. of jump table
  6777.     sta    jtaddr        ;
  6778.     lda    #stcct^        ;
  6779.     sta    jtaddr+1    ;
  6780.     txa            ; offset to AC
  6781.     jmp    jmpind        ;[DD] Jump
  6782.  
  6783. stcct:  jmp    stpdc        ; Set send/rec padding character
  6784.     jmp    stpad        ; Set amount of padding on send/rec
  6785.     jmp    stebq        ; Set send/rec eight-bit-quoting character
  6786.     jmp    steol        ; Set send/rec end-of-line
  6787.     jmp    stpl        ; Set send/rec packet length
  6788.     jmp    stqc        ; Set send/rec quote character
  6789.     jmp    sttim        ; Set send/rec timeout
  6790.  
  6791. stvt:    lda    #termemu\    ; parse for terminal emulation type
  6792.     sta    cminf1
  6793.     lda    #termemu^
  6794.     sta    cminf1+1
  6795.     ldy    #$00        ; no special flags needed
  6796.     lda    #cmkey        ; parse for a keyword
  6797.     jsr    comnd        ; do it
  6798.      jmp    kermt2        ; go tell the user about the error
  6799.     stx    vtmod        ; Store value in the mode switch location
  6800.     lda    #cmcfm        ; Parse for confirm
  6801.     jsr    comnd        ; Do it
  6802.      jmp    kermt3        ; Not confirmed, tell the user that
  6803.     jmp    kermit
  6804.  
  6805. stfw:    jsr    prson        ; Try parsing an 'on' or 'off'
  6806.      jmp    kermt2        ; Bad keyword
  6807.     stx    filwar        ; Store value in the mode switch location
  6808.     lda    #cmcfm        ; Parse for confirm
  6809.     jsr    comnd        ; Do it
  6810.      jmp    kermt3        ; Not confirmed, tell the user that
  6811.     jmp    kermit
  6812.  
  6813. steb:    jsr    prson        ; Try parsing an 'on' or 'off'
  6814.      jmp    kermt2        ; Bad keyword
  6815.     stx    ebqmod        ; Store value in the mode switch location
  6816.     lda    #cmcfm        ; Parse for confirm
  6817.     jsr    comnd        ; Do it
  6818.      jmp    kermt3        ; Not confirmed, tell the user that
  6819.     jmp    kermit
  6820.  
  6821. stdb:    ldx    #debkey\    ;  Load the address of the keyword table
  6822.     ldy    #debkey^
  6823.     stx    cminf1        ;  Save it for the keyword routine
  6824.     sty    cminf1+1
  6825.     ldy    #$00        ; No special flags needed
  6826.     lda    #cmkey        ; Comnd code for parse keyword
  6827.     jsr    comnd        ; Go get it
  6828.      jmp    kermt2        ; Give an error
  6829.     stx    debug        ; Stuff returned value into debug switch
  6830.     lda    #cmcfm        ; Parse for a confirm
  6831.     jsr    comnd        ; Do it
  6832.      jmp    kermt3        ; Not confirmed, tell the user that
  6833.     jmp    kermit
  6834.  
  6835.  
  6836. stebq:  ldx    #$10        ; Base for ASCII value
  6837.     ldy    #$00        ; No special flags needed
  6838.     lda    #cmnum        ; Code for integer number
  6839.     jsr    comnd        ; Go do it
  6840.      jmp    kermt4        ; The number was bad
  6841.     tya            ; If this isn't zero
  6842.     cmp    #$00        ;    it's not an ASCII character
  6843.     beq    steb1        ; It is, continue
  6844.     jmp    kermt4        ; Bad number, tell them
  6845. steb1:    txa            ; Get L.O. byte
  6846.     cmp    #$7f        ; It shouldn't be bigger than this
  6847.     bmi    steb2        ; If it's less, it is ok
  6848.     jmp    kermt4        ; Tell the user it is bad
  6849. steb2:  cmp    #$21        ; First check the character range
  6850.     bmi    steb4        ; Not in range
  6851.     cmp    #$3f        ;        ...
  6852.     bmi    steb3        ; Inrange
  6853.     cmp    #$60        ;        ...
  6854.     bmi    steb4        ; Not in range
  6855. steb3:  ldx    srind        ; Get index for receive or send parms
  6856.     sta    ebq,x        ; Stuff it
  6857.     lda    #cmcfm        ; Parse for confirm
  6858.     jsr    comnd        ; Do it
  6859.      jmp    kermt3        ; Not confirmed, tell the user that
  6860.     jmp    kermit        ;
  6861. steb4:  ldx    #ermes5\    ; Get error message
  6862.     ldy    #ermes5^    ;        ...
  6863.     jsr    prstr        ; Print the error
  6864.     jsr    prcfm        ; Go parse and print a confirm
  6865.     jmp    kermit        ; Go back
  6866.  
  6867. steol:  ldx    #$10        ; Base for ASCII value
  6868.     ldy    #$00        ; No special flags needed
  6869.     lda    #cmnum        ; Code for integer number
  6870.     jsr    comnd        ; Go do it
  6871.      jmp    kermt4        ; The number was bad
  6872.     tya            ; If this isn't zero
  6873.     cmp    #$00        ;    it's not an ASCII character
  6874.     beq    steo1        ; It is, continue
  6875.     jmp    kermt4        ; Bad number, tell them
  6876. steo1:    txa            ; Get L.O. byte
  6877.     cmp    #$7f        ; It shouldn't be bigger than this
  6878.     bmi    steo2        ; If it's less, it is ok
  6879.     jmp    kermt4        ; Tell the user it is bad
  6880. steo2:  ldx    srind        ; Fetch index for receive or send parms
  6881.     sta    eol,x        ; Stuff it
  6882.     jsr    prcfm        ; Go parse and print a confirm
  6883.     jmp    kermit        ; Go back
  6884.  
  6885. stpad:  ldx    #$10        ; Base for ASCII value
  6886.     ldy    #$00        ; No special flags needed
  6887.     lda    #cmnum        ; Code for integer number
  6888.     jsr    comnd        ; Go do it
  6889.      jmp    kermt4        ; The number was bad
  6890.     tya            ; If this isn't zero
  6891.     cmp    #$00        ;    it's not an ASCII character
  6892.     beq    stpd1        ; It is, continue
  6893.     jmp    kermt4        ; Bad number, tell them
  6894. stpd1:    txa            ; Get L.O. byte
  6895.     cmp    #$7f        ; It shouldn't be bigger than this
  6896.     bmi    stpd2        ; If it's less, it is ok
  6897.     jmp    kermt4        ; Tell the user it is bad
  6898. stpd2:  ldx    srind        ; Get index (receive or send)
  6899.     sta    pad,x        ; Stuff it
  6900.     jsr    prcfm        ; Go parse and print a confirm
  6901.     jmp    kermit        ; Go back
  6902.  
  6903. stpdc:  ldx    #$10        ; Base for ASCII value
  6904.     ldy    #$00        ; No special flags needed
  6905.     lda    #cmnum        ; Code for integer number
  6906.     jsr    comnd        ; Go do it
  6907.      jmp    kermt4        ; The number was bad
  6908.     tya            ; If this isn't zero
  6909.     cmp    #$00        ;    it's not an ASCII character
  6910.     beq    stpc1        ; It is, continue
  6911.     jmp    kermt4        ; Bad number, tell them
  6912. stpc1:    txa            ; Get L.O. byte
  6913.     cmp    #$7f        ; It shouldn't be bigger than this
  6914.     bmi    stpc2        ; If it's less, it is ok
  6915.     jmp    kermt4        ; Tell the user it is bad
  6916. stpc2:  ldx    srind        ; Get index for parms
  6917.     sta    padch,x        ; Stuff it
  6918.     jsr    prcfm        ; Go parse and print a confirm
  6919.     jmp    kermit        ; Go back
  6920.  
  6921. stpl:    ldx    #$10        ; Base for ASCII value
  6922.     ldy    #$00        ; No special flags needed
  6923.     lda    #cmnum        ; Code for integer number
  6924.     jsr    comnd        ; Go do it
  6925.      jmp    kermt4        ; The number was bad
  6926.     tya            ; If this isn't zero
  6927.     cmp    #$00        ;    it's not an ASCII character
  6928.     beq    stpl1        ; It is, continue
  6929.     jmp    kermt4        ; Bad number, tell them
  6930. stpl1:    txa            ; Get L.O. byte
  6931.     cmp    #mxpack        ; It shouldn't be bigger than this
  6932.     bmi    stpl2        ; If it's less, it is ok
  6933.     jmp    kermt4        ; Tell the user it is bad
  6934. stpl2:  ldx    srind        ; Get index
  6935.     sta    psiz,x        ; Stuff it
  6936.     jsr    prcfm        ; Go parse and print a confirm
  6937.     jmp    kermit        ; Go back
  6938.  
  6939. stqc:    ldx    #$10        ; Base for ASCII value
  6940.     ldy    #$00        ; No special flags needed
  6941.     lda    #cmnum        ; Code for integer number
  6942.     jsr    comnd        ; Go do it
  6943.      jmp    kermt4        ; The number was bad
  6944.     tya            ; If this isn't zero
  6945.     cmp    #$00        ;    it's not an ASCII character
  6946.     beq    stqc1        ; It is, continue
  6947.     jmp    kermt4        ; Bad number, tell them
  6948. stqc1:    txa            ; Get L.O. byte
  6949.     cmp    #$7f        ; It shouldn't be bigger than this
  6950.     bmi    stqc2        ; If it's less, it is ok
  6951.     jmp    kermt4        ; Tell the user it is bad
  6952. stqc2:  ldx    srind        ; Fetch index for receive or send parms
  6953.     sta    quote,x        ; Stuff it
  6954.     jsr    prcfm        ; Go parse and print a confirm
  6955.     jmp    kermit        ; Go back
  6956.  
  6957. sttim:  ldx    #$10        ; Base for ASCII value
  6958.     ldy    #$00        ; No special flags needed
  6959.     lda    #cmnum        ; Code for integer number
  6960.     jsr    comnd        ; Go do it
  6961.      jmp    kermt4        ; The number was bad
  6962.     tya            ; If this isn't zero
  6963.     cmp    #$00        ;    it's not an ASCII character
  6964.     beq    sttm1        ; It is, continue
  6965.     jmp    kermt4        ; Bad number, tell them
  6966. sttm1:    txa            ; Get L.O. byte
  6967.     cmp    #$7f        ; It shouldn't be bigger than this
  6968.     bmi    sttm2        ; If it's less, it is ok
  6969.     jmp    kermt4        ; Tell the user it is bad
  6970. sttm2:  ldx    srind        ; Fetch index for receive or send parms
  6971.     sta    time,x        ; Stuff it
  6972.     jsr    prcfm        ; Go parse and print a confirm
  6973.     jmp    kermit        ; Go back
  6974.  
  6975. stmod:    lda    #ftcmd\        ; Load the address of the keyword table
  6976.     sta    cminf1        ;
  6977.     lda    #ftcmd^        ;
  6978.     sta    cminf1+1    ;
  6979.     lda    #ftcdef\    ; Load default address
  6980.     sta    cmdptr        ;        ...
  6981.     lda    #ftcdef^    ;        ...
  6982.     sta    cmdptr+1    ;        ...
  6983.     ldy    #cmfdff        ; Tell Comnd there is a default
  6984.     lda    #cmkey        ; Comnd code for parse keyword
  6985.     jsr    comnd        ; Go get it
  6986.      jmp    kermt2        ; Give an error
  6987.     stx    filmod        ; Save the file-type mode
  6988.     lda    #cmcfm        ; Parse for a confirm
  6989.     jsr    comnd        ; Do it
  6990.      jmp    kermt3        ; Not confirmed, tell the user that
  6991.     jmp    kermit
  6992.  
  6993. stfbs:    lda    #fbskey\    ; Load the address of the keyword table
  6994.     sta    cminf1        ;
  6995.     lda    #fbskey^    ;
  6996.     sta    cminf1+1    ;
  6997.     ldy    #$00        ; No special flags needed
  6998.     lda    #cmkey        ; Comnd code for parse keyword
  6999.     jsr    comnd        ; Go get it
  7000.      jmp    kermt2        ; Give an error
  7001.     stx    fbsize        ; Stuff the returned value into file-byte-size
  7002.     lda    #cmcfm        ; Parse for a confirm
  7003.     jsr    comnd        ; Do it
  7004.      jmp    kermt3        ; Not confirmed, tell the user that
  7005.     jmp    kermit
  7006.  
  7007.  
  7008. stccr:  ldx    #$10        ;[DD] Base should be hex
  7009.     ldy    #$00        ; No special flags needed
  7010.     lda    #cmnum        ;[DD] Parse for integer
  7011.     jsr    comnd        ;[DD] Go do it
  7012.      jmp    kermt4        ;[DD] The number was bad
  7013. stccr1:    stx    ksavex        ; Store it while we confirm
  7014.     sty    ksavey        ;        ...
  7015.     lda    #cmcfm        ; Set up to parse confirm
  7016.     jsr    comnd        ; Do it
  7017.      jmp    kermt3        ; Wasn't properly confirmed
  7018.     lda    ksavex        ; Fetch back L.O. byte
  7019.     sta    cntrl        ;[DD][EL] To rs232 reg 0
  7020.     lda    ksavey        ;[18] Fetch back H.O. byte
  7021.     sta    cmmnd        ;[DD] To rs232 reg 1
  7022.     jmp    kermit        ;[DD] 
  7023.  
  7024. stpari:    lda    #parkey\    ; Load the address of the keyword table
  7025.     sta    cminf1        ; Save it for the keyword routine
  7026.     lda    #parkey^    ;        ...
  7027.     sta    cminf1+1    ;        ...
  7028.     ldy    #$00        ; No special flags needed
  7029.     lda    #cmkey        ; Comnd code for parse keyword
  7030.     jsr    comnd        ; Go get it
  7031.      jmp    kermt2        ; Give an error
  7032.     stx    parity        ; Stuff returned value into parity
  7033.     lda    #cmcfm        ; Parse for a confirm
  7034.     jsr    comnd        ; Do it
  7035.      jmp    kermt3        ; Not confirmed, tell the user that
  7036.     jsr    dopari        ;[17] Now really set the parity
  7037.     jmp    kermit        ;
  7038.  
  7039. dopari:    lda    cmmnd        ;[17] Get the command register
  7040.     and    #$1f        ;[17]
  7041.     sta    cmmnd        ;[17] Store it back
  7042.     ldx    parity        ;[17] Get the index
  7043.     lda    parval,x    ;[17]    and the parity value from the table
  7044.     ora    cmmnd        ;[17]
  7045.     sta    cmmnd        ;[17] Store it back
  7046.     rts            ;[17] Return
  7047.  
  7048. stbaud:    lda    #bdkey\        ;[17] Load the address of the keyword table
  7049.     sta    cminf1        ;[17] Save it for the keyword routine
  7050.     lda    #bdkey^        ;[17]        ...
  7051.     sta    cminf1+1    ;[17]        ...
  7052.     ldy    #$00        ;[17] No special flags needed
  7053.     lda    #cmkey        ;[17] Parse for a keyword
  7054.     jsr    comnd        ;[17] Do it
  7055.      jmp    kermt2        ;[17] Give an error
  7056.     stx    baud        ;[17] Stuff the returned value
  7057.     lda    #cmcfm        ;[17] Set up for a confirm
  7058.     jsr    comnd        ;[17] Do it
  7059.      jmp    kermt3        ;[17] Not confirmed
  7060.     jsr    dobad        ;[17] Really set the baud rate
  7061.     jmp    kermit        ;[17] 
  7062.  
  7063. dobad:    lda    baud
  7064.     asl    a
  7065.     eor    fast
  7066.     and    #$fe
  7067.     eor    fast
  7068.     asl    a
  7069.     tax
  7070.     lda    bdval,x
  7071.     sta    optbdl
  7072.     lda    bdval+1,x
  7073.     sta    optbdh
  7074.     rts            ;[17]
  7075.  
  7076. stwrd:    lda    #fbskey\    ;[17] Load the address of the keyword table
  7077.     sta    cminf1        ;[17] Save it for the keyword routine
  7078.     lda    #fbskey^    ;[17]        ...
  7079.     sta    cminf1+1    ;[17]        ...
  7080.     ldy    #$00        ;[17] No special flags needed
  7081.     lda    #cmkey        ;[17] Comnd code for parse keyword
  7082.     jsr    comnd        ;[17] Go get it
  7083.      jmp    kermt2        ;[17] Give an error
  7084.     stx    wrdsiz        ;[17] Stuff the returned value into wrd len
  7085.     lda    #cmcfm        ;[17] Parse for a confirm
  7086.     jsr    comnd        ;[17] Do it
  7087.      jmp    kermt3        ;[17] Not confirmed, tell the user that
  7088.     jsr    dowrd        ;[17] Really set the word size
  7089.     jmp    kermit        ;[17]        ...
  7090.  
  7091. dowrd:    lda    cntrl        ;[17] Get the control register
  7092.     and    #$8f        ;[17]
  7093.     sta    cntrl        ;[17] Store it back
  7094.     lda    wrdsiz        ;[17] Get the word size
  7095.     cmp    #fbsbit        ;[17] Is it seven-bit ?
  7096.     bne    dwrd1        ;[17] No, we have the value for eight-bit
  7097.     lda    #$20        ;[17] Yes, get value for seven-bit word size
  7098. dwrd1:    ora    cntrl        ;[17] Set it
  7099.     sta    cntrl        ;[17] Store it
  7100.     rts            ;[17] Return
  7101.  
  7102. stflow: jsr    prson        ;[24] Try parsing an 'on' or 'off'
  7103.      jmp    kermt2        ;[24] Bad keyword
  7104.     stx    flowmo        ;[24] Store it
  7105.     lda    #cmcfm        ;[24] Parse for confirm
  7106.     jsr    comnd        ;[24] Do it
  7107.      jmp    kermt3        ;[24] Not confirmed, tell the user that
  7108.     jmp    kermit        ;[24]
  7109.  
  7110. stscre:    lda    #scrkey\    ;[37] Get the address of the screen mode table
  7111.     sta    cminf1        ;[37]        ...
  7112.     lda    #scrkey^    ;[37]        ...
  7113.     sta    cminf1+1    ;[37]        ...
  7114.     ldy    #$00        ;[37] No special flags needed
  7115.     lda    #cmkey        ;[37] Comnd code for parse keyword
  7116.     jsr    comnd        ;[37] Go get it
  7117.      jmp    kermt2        ;[37] Give an error
  7118.     stx    kwrk01        ;[37] Stuff the returned value into kwrk01
  7119.     lda    #cmcfm        ;[37] Parse for a confirm
  7120.     jsr    comnd        ;[37] Do it
  7121.      jmp    kermt3        ;[37] Not confirmed, tell the user that
  7122.     lda    kwrk01        ;[37] Are we switching to 80 columns?
  7123.  
  7124. get:    pha            ; save the id of the screen driver we want
  7125.     jsr    scrext        ; exit the old screen driver
  7126.     pla
  7127.     pha            ; keep the id of the screen driver on the stack
  7128.     jsr    scrtst        ; does this screen driver exist?
  7129.     pla            ; restore desired screen type
  7130.     bcc    get1
  7131.     lda    #$01        ; if it does not exist, use 80-columns instead
  7132. get1:    sta    scrtype
  7133.     jsr    scrent        ; enter the screen driver
  7134.     jsr    dobad        ; reset baud kludge value based on fast mode
  7135.     jmp    kermit        ; all done
  7136.  
  7137. stc1:    lda    #colors\    ; parse for color type
  7138.     sta    cminf1
  7139.     lda    #colors^
  7140.     sta    cminf1+1
  7141.     ldy    #$00        ; no special flags needed
  7142.     lda    #cmkey        ; parse for a keyword
  7143.     jsr    comnd        ; do it
  7144.      jmp    kermt2        ; go tell the user about the error
  7145.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7146.     lda    #cmcfm        ; Parse for a confirm
  7147.     jsr    comnd        ; Do it
  7148.      jmp    kermt3        ; Not confirmed, tell the user that
  7149.     lda    kwrk01        ; What color are we switching to?
  7150.     sta    backclr        ; set the background color
  7151.     jsr    scrset
  7152.     jmp    kermit
  7153.  
  7154. stc2:    lda    #colors\    ; parse for color type
  7155.     sta    cminf1
  7156.     lda    #colors^
  7157.     sta    cminf1+1
  7158.     ldy    #$00        ; no special flags needed
  7159.     lda    #cmkey        ; parse for a keyword
  7160.     jsr    comnd        ; do it
  7161.      jmp    kermt2        ; go tell the user about the error
  7162.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7163.     lda    #cmcfm        ; Parse for a confirm
  7164.     jsr    comnd        ; Do it
  7165.      jmp    kermt3        ; Not confirmed, tell the user that
  7166.     lda    kwrk01        ; What color are we switching to?
  7167.     sta    britclr        ; set the highlighting color
  7168.     jsr    scrset
  7169.     jmp    kermit
  7170.  
  7171. stc3:    lda    #colors\    ; parse for color type
  7172.     sta    cminf1
  7173.     lda    #colors^
  7174.     sta    cminf1+1
  7175.     ldy    #$00        ; no special flags needed
  7176.     lda    #cmkey        ; parse for a keyword
  7177.     jsr    comnd        ; do it
  7178.      jmp    kermt2        ; go tell the user about the error
  7179.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7180.     lda    #cmcfm        ; Parse for a confirm
  7181.     jsr    comnd        ; Do it
  7182.      jmp    kermt3        ; Not confirmed, tell the user that
  7183.     lda    kwrk01        ; What color are we switching to?
  7184.     sta    foreclr        ; set the foreground color
  7185.     jsr    scrset
  7186.     jmp    kermit
  7187.  
  7188. stc4:    lda    #colors\    ; parse for color type
  7189.     sta    cminf1
  7190.     lda    #colors^
  7191.     sta    cminf1+1
  7192.     ldy    #$00        ; no special flags needed
  7193.     lda    #cmkey        ; parse for a keyword
  7194.     jsr    comnd        ; do it
  7195.      jmp    kermt2        ; go tell the user about the error
  7196.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7197.     lda    #cmcfm        ; Parse for a confirm
  7198.     jsr    comnd        ; Do it
  7199.      jmp    kermt3        ; Not confirmed, tell the user that
  7200.     lda    kwrk01        ; What color are we switching to?
  7201.     sta    altclr        ; set the alternate color
  7202.     jsr    scrset
  7203.     jmp    kermit
  7204.  
  7205. stc5:    lda    #colors\    ; parse for color type
  7206.     sta    cminf1
  7207.     lda    #colors^
  7208.     sta    cminf1+1
  7209.     ldy    #$00        ; no special flags needed
  7210.     lda    #cmkey        ; parse for a keyword
  7211.     jsr    comnd        ; do it
  7212.      jmp    kermt2        ; go tell the user about the error
  7213.     stx    kwrk01        ; Stuff the returned value into kwrk01
  7214.     lda    #cmcfm        ; Parse for a confirm
  7215.     jsr    comnd        ; Do it
  7216.      jmp    kermt3        ; Not confirmed, tell the user that
  7217.     lda    kwrk01        ; What color are we switching to?
  7218.     sta    bordclr        ; set the border color
  7219.     jsr    scrset
  7220.     jmp    kermit
  7221.  
  7222. .SBTTL    Show routine
  7223.  
  7224. ;
  7225. ;    This routine shows any of the operational parameters that
  7226. ;    can be altered with the set command.
  7227. ;
  7228. ;        Input:  Parameters from command line
  7229. ;
  7230. ;        Output: Display parameter values on screen
  7231. ;
  7232. ;        Registers destroyed:    A,X,Y
  7233. ;
  7234.  
  7235. show:    lda    #shocmd\    ; Load address of keyword table
  7236.     sta    cminf1        ;
  7237.     lda    #shocmd^    ;
  7238.     sta    cminf1+1    ;
  7239.     lda    #shodef\    ; Fetch default address
  7240.     sta    cmdptr        ;        ...
  7241.     lda    #shodef^    ;        ...
  7242.     sta    cmdptr+1    ;        ...
  7243.     ldy    #cmfdff        ; Indicate that there is a default
  7244.     lda    #cmkey        ; Comnd code to parse keyword
  7245.     jsr    comnd        ; Go parse the keyword
  7246.      jmp    kermt2        ; Bad keyword, go give an error
  7247.     lda    #shocmb\     ; Get addr. of jump table
  7248.     sta    jtaddr        ;
  7249.     lda    #shocmb^    ;
  7250.     sta    jtaddr+1    ;
  7251.     txa            ; Offset to AC
  7252.     jmp    jmpind        ;[DD] Jump
  7253.  
  7254. shocmb: jsr    prcfm        ; Parse for confirm
  7255.     jsr    shall        ; Show all setable parameters
  7256.     jmp    kermit        ; Go to top of main loop
  7257.     jsr    prcfm        ; Parse for confirm
  7258.     jsr    shesc        ; Show escape character
  7259.     jmp    kermit        ; Go to top of main loop
  7260.     jsr    prcfm        ; Parse for confirm
  7261.     jsr    shibm        ; Show ibm-mode switch
  7262.     jmp    kermit        ; Go to top of main loop
  7263.     jsr    prcfm        ; Parse for confirm
  7264.     jsr    shle        ; Show local-echo switch
  7265.     jmp    kermit        ; Go to top of main loop
  7266.     nop            ; We should not parse for confirm
  7267.     nop            ;    since this routine parses for
  7268.     nop            ;    a keyword next
  7269.     jsr    shrc        ; Show receive parameters
  7270.     jmp    kermit        ; Go to top of main loop
  7271.     nop            ; We should not parse for confirm
  7272.     nop            ;    since this routine parses for
  7273.     nop            ;    a keyword next
  7274.     jsr    shsn        ; Show send parameters
  7275.     jmp    kermit        ; Go to top of main loop
  7276.     jsr    prcfm        ; Parse for confirm
  7277.     jsr    shvt        ; Show vt52-emulation mode switch
  7278.     jmp    kermit        ; Go to top of main loop
  7279.     jsr    prcfm        ; Parse for confirm
  7280.     jsr    shfw        ; Show file-warning switch
  7281.     jmp    kermit        ; Go to top of main loop
  7282.     jsr    prcfm        ; Parse for confirm
  7283.     jsr    sheb        ; Show eight-bit-quoting switch
  7284.     jmp    kermit        ; Go to top of main loop
  7285.     jsr    prcfm        ; Parse for confirm
  7286.     jsr    shdb        ; Show debugging mode switch
  7287.     jmp    kermit        ; Go to top of main loop
  7288.     jsr    prcfm        ; Parse for confirm
  7289.     jsr    shmod        ; Show File mode
  7290.     jmp    kermit        ; Go to top of main loop
  7291.     jsr    prcfm        ; Parse for confirm
  7292.     jsr    shfbs        ; Show the file-byte-size
  7293.     jmp    kermit        ; Go to top of main loop
  7294.     jsr    prcfm        ;[DD] Parse for confirm 
  7295.     jsr    shccr        ;[DD] Show rs232 regs.
  7296.     jmp    kermit        ;[DD] Go to top of main loop
  7297.     jsr    prcfm        ; Parse for confirm
  7298.     jsr    shpari        ; Show Parity
  7299.     jmp    kermit        ; Go to top of main loop
  7300.     jsr    prcfm        ;[17] Parse for a confirm
  7301.     jsr    shbad        ;[17] Show baud
  7302.     jmp    kermit        ;[17] Go to top of main loop
  7303.     jsr    prcfm        ;[17] Parse for a confirm
  7304.     jsr    shwrd        ;[17] Show word size
  7305.     jmp    kermit        ;[17] Go to top of main loop
  7306.     jsr    prcfm        ;[24] Parse for a confirm
  7307.     jsr    shflow        ;[24] Show flow-control
  7308.     jmp    kermit        ;[24] Go to top of main loop
  7309.  
  7310. shall:  jsr    shdb        ; Show debugging mode switch
  7311.     jsr    shvt        ; Show vt52-emulation mode switch
  7312.     jsr    shibm        ; Show ibm-mode switch
  7313.     jsr    shle        ; Show local-echo switch
  7314.     jsr    shbad        ;[17] Show baud rate
  7315.     jsr    shpari        ; Show parity setting
  7316.     jsr    shwrd        ;[17] Show word length
  7317.     jsr    shflow        ;[24] Show flow-control
  7318.     jsr    sheb        ; Show eight-bit-quoting switch
  7319.     jsr    shfw        ; Show file-warning switch
  7320.     jsr    shesc        ; Show the current escape character
  7321.     jsr    shmod        ; Show the file-type mode
  7322.     jsr    shfbs        ; Show the file-byte-size
  7323.     jsr    shccr        ;[DD] Show rs232 regs.
  7324.     jsr    shrcal        ; Show receive parameters
  7325.     jsr    shsnal        ; Show send parameters
  7326.     rts            ; Return
  7327.  
  7328. shdb:    ldx    #shin00\    ; Get address of message for this item
  7329.     ldy    #shin00^
  7330.     jsr    prstr        ; Print that message
  7331.     lda    debug        ; Get the switch value
  7332.     cmp    #$03        ; Is it >= 3?
  7333.     bmi    shdb1        ; If not just get the string and print it
  7334.     lda    #$00        ; This is index for debug mode we want
  7335. shdb1:    tax            ; Hold this index
  7336.     lda    #kerdms\    ; Get the address of the device strings
  7337.     sta    kermbs        ; And stuff it here for genmad
  7338.     lda    #kerdms^    ;        ...
  7339.     sta    kermbs+1    ;        ...
  7340.     lda    #kerdsz        ; Get the string length
  7341.     pha            ; Push that
  7342.     txa            ; Fetch the index back
  7343.     pha            ; Push that parm then
  7344.     jsr    genmad        ;    call genmad
  7345.     jsr    prstr        ; Print the the string at that address
  7346.     jsr    prcrlf        ; Print a crelf after it
  7347.     rts
  7348.  
  7349. shvt:    ldx    #shin01\    ; Get address of message for this item
  7350.     ldy    #shin01^
  7351.     jsr    prstr        ; Print that message
  7352.     lda    #kertms\    ; get address of messages for this item
  7353.     sta    kermbs
  7354.     lda    #kertms^
  7355.     sta    kermbs+1
  7356.     lda    #keremu        ; length of the messages
  7357.     pha
  7358.     lda    vtmod        ; which message
  7359.     pha
  7360.     jsr    genmad        ; calculate address of selected message
  7361.     jsr    prstr        ; print selected message
  7362.     jsr    prcrlf        ; and a carriage return / line feed
  7363.     rts            ; all done
  7364.  
  7365. shibm:  ldx    #shin02\    ; Get address of message for this item
  7366.     ldy    #shin02^
  7367.     jsr    prstr        ; Print that message
  7368.     lda    ibmmod        ; Get the switch value
  7369.     jmp    pron        ; Go print the 'on' or 'off' string
  7370.  
  7371. shle:    ldx    #shin03\    ; Get address of message for this item
  7372.     ldy    #shin03^
  7373.     jsr    prstr        ; Print that message
  7374.     lda    lecho        ; Get the switch value
  7375.     jmp    pron        ; Go print the 'on' or 'off' string
  7376.  
  7377. sheb:    ldx    #shin04\    ; Get address of message for this item
  7378.     ldy    #shin04^
  7379.     jsr    prstr        ; Print that message
  7380.     lda    ebqmod        ; Get the switch value
  7381.     jmp    pron        ; Go print the 'on' or 'off' string
  7382.  
  7383. shfw:    ldx    #shin05\    ; Get address of message for this item
  7384.     ldy    #shin05^
  7385.     jsr    prstr        ; Print that message
  7386.     lda    filwar        ; Get the switch value
  7387.     jmp    pron        ; Go print the 'on' or 'off' string
  7388.  
  7389. shesc:  ldx    #shin06\    ; Get address of message
  7390.     ldy    #shin06^
  7391.     jsr    prstr        ; Print message
  7392.     lda    escp        ; Get the escape character
  7393.     jsr    prchr        ; Print the special character
  7394.     jsr    prcrlf        ; Print a crelf
  7395.     rts            ;    and return
  7396.  
  7397. shccr:  ldx    #shin18\    ;[DD][EL] Print rs232 registers cntrl,cmmnd 
  7398.     ldy    #shin18^    ;[DD]
  7399.     jsr    prstr        ;[DD]
  7400.     lda    cmmnd        ;[DD] Print rs232 reg 1
  7401.     jsr    prbyte        ;[DD]
  7402.     lda    cntrl        ;[DD] Print rs232 reg 0
  7403.     jsr    prbyte        ;[DD]
  7404.     jsr    prcrlf        ;[DD]    and a crlf
  7405.     rts            ;[DD]
  7406.  
  7407.  
  7408. shsn:    lda    #$01        ; Set up index to be used later
  7409.     sta    srind
  7410.     lda    #stscmd\    ; Get the set option table address
  7411.     sta    cminf1        ;
  7412.     lda    #stscmd^    ;
  7413.     sta    cminf1+1    ;
  7414.     ldy    #$00        ; No special flags needed
  7415.     lda    #cmkey        ; Code for keyword parse
  7416.     jsr    comnd        ; Try to parse it
  7417.      jmp    kermt2        ; Invalid keyword
  7418.     stx    kwrk01        ; Hold offset into jump table
  7419.     jsr    prcfm        ; Parse and print a confirm
  7420.     lda    #shcmb\      ; Get addr. of jump table
  7421.     sta    jtaddr        ;
  7422.     lda    #shcmb^        ;
  7423.     sta    jtaddr+1    ;
  7424.     lda    kwrk01        ; Get offset  back
  7425.     asl    a        ; Double it
  7426.     jmp    jmpind      ;[DD] Jump
  7427. ;
  7428. shrc:    lda    #$00        ; Set up index to be used later
  7429.     sta    srind
  7430.     lda    #stscmd\    ; Get the set option table address
  7431.     sta    cminf1        ;
  7432.     lda    #stscmd^    ;
  7433.     sta    cminf1+1    ;
  7434.     ldy    #$00        ; No special flags needed
  7435.     lda    #cmkey        ; Code for keyword parse
  7436.     jsr    comnd        ; Try to parse it
  7437.      jmp    kermt2        ; Invalid keyword
  7438.     stx    kwrk01        ; Hold offset into jump table
  7439.     jsr    prcfm        ; Parse and print a confirm
  7440.     lda    #shcmb\        ; Get addr. ofl jump table
  7441.     sta    jtaddr        ;
  7442.     lda    #shcmb^        ;
  7443.     sta    jtaddr+1    ;
  7444.     lda    kwrk01        ; Get offset  back
  7445.     asl    a        ; Double it
  7446.     jmp    jmpind        ;[DD] Jump
  7447.  
  7448. shcmb:  jsr    shpdc        ; Show send/rec padding character
  7449.     jmp    kermit        ; Go back
  7450.     jsr    shpad        ; Show amount of padding for send/rec
  7451.     jmp    kermit        ; Go back
  7452.     jsr    shebq        ; Show send/rec eight-bit-quoting character
  7453.     jmp    kermit        ; Go back
  7454.     jsr    sheol        ; Show send/rec end-of-line character
  7455.     jmp    kermit        ; Go back
  7456.     jsr    shpl        ; Show send/rec packet length
  7457.     jmp    kermit        ; Go back
  7458.     jsr    shqc        ; Show send/rec quote character
  7459.     jmp    kermit        ; Go back
  7460.     jsr    shtim        ; Show send/rec timeout
  7461.     jmp    kermit        ; Go back
  7462.  
  7463. shpdc:  ldx    #shin11\    ; Get address of 'pad char' string
  7464.     ldy    #shin11^
  7465.     jsr    prstr        ; Print that
  7466.     ldx    srind        ; Load index so we print correct parm
  7467.     lda    padch,x        ; If index is 1, this gets spadch
  7468.     jsr    prchr        ; Print the special character
  7469.     jsr    prcrlf        ; Print a crelf after it
  7470.     rts
  7471. shpad:  ldx    #shin12\    ; Get address of 'padding amount' string
  7472.     ldy    #shin12^
  7473.     jsr    prstr        ; Print that
  7474.     ldx    srind        ; Load index so we print correct parm
  7475.     lda    pad,x        ; If index is 1, this gets spad
  7476.     jsr    prbyte        ; Print the amount of padding
  7477.     jsr    prcrlf        ; Print a crelf after it
  7478.     rts
  7479. shebq:  ldx    #shin08\    ; Get address of 'eight-bit-quote' string
  7480.     ldy    #shin08^
  7481.     jsr    prstr        ; Print that
  7482.     ldx    srind        ; Load index so we print correct parm
  7483.     lda    ebq,x        ; If index is 1, this gets sebq
  7484.     jsr    prchr        ; Print the special character
  7485.     jsr    prcrlf        ; Print a crelf after it
  7486.     rts
  7487. sheol:  ldx    #shin09\    ; Get address of 'end-of-line' string
  7488.     ldy    #shin09^
  7489.     jsr    prstr        ; Print that
  7490.     ldx    srind        ; Load index so we print correct parm
  7491.     lda    eol,x        ; If index is 1, this gets seol
  7492.     jsr    prchr        ; Print the special character
  7493.     jsr    prcrlf        ; Print a crelf after it
  7494.     rts
  7495. shpl:    ldx    #shin10\    ; Get address of 'packet length' string
  7496.     ldy    #shin10^
  7497.     jsr    prstr        ; Print that
  7498.     ldx    srind        ; Load index so we print correct parm
  7499.     lda    psiz,x        ; If index is 1, this gets spsiz
  7500.     jsr    prbyte        ; Print the packet length
  7501.     jsr    prcrlf        ; Print a crelf after it
  7502.     rts            ;    and return
  7503. shqc:    ldx    #shin13\    ; Get address of 'quote-char' string
  7504.     ldy    #shin13^
  7505.     jsr    prstr        ; Print that
  7506.     ldx    srind        ; Load index so we print correct parm
  7507.     lda    quote,x        ; If index is 1, this gets squote
  7508.     jsr    prchr        ; Print the special character
  7509.     jsr    prcrlf        ; Print a crelf after it
  7510.     rts
  7511. shtim:  ldx    #shin14\    ; Get address of 'timeout' string
  7512.     ldy    #shin14^
  7513.     jsr    prstr        ; Print that
  7514.     ldx    srind        ; Load index so we print correct parm
  7515.     lda    time,x        ; If index is 1, this gets stime
  7516.     jsr    prbyte        ; Print the hex value
  7517.     jsr    prcrlf        ; Print a crelf after it
  7518.     rts
  7519.  
  7520. shsnal: lda    #$01        ; Set up index for show parms
  7521.     sta    srind        ;    and stuff it here
  7522.     ldx    #shin07\    ; Get address of 'send' string
  7523.     ldy    #shin07^    ;
  7524.     jsr    prstr        ; Print it
  7525.     jsr    prcrlf        ; Print a crelf
  7526.     jsr    shpdc        ; Show the padding character
  7527.     jsr    shpad        ; Show amount of padding
  7528.     jsr    shebq        ; Show eight-bit-quote character
  7529.     jsr    sheol        ; Show end-of-line character
  7530.     jsr    shpl        ; Show packet-length
  7531.     jsr    shqc        ; Show quote character
  7532.     jsr    shtim        ; Show timeout length
  7533.     rts
  7534.  
  7535. shrcal: lda    #$00        ; Set up index for show parms
  7536.     sta    srind        ;    and stuff it here
  7537.     ldx    #shin15\    ; Get address of 'receive' string
  7538.     ldy    #shin15^
  7539.     jsr    prstr        ; Print it
  7540.     jsr    prcrlf        ; Print a crelf
  7541.     jsr    shpdc        ; Show the padding character
  7542.     jsr    shpad        ; Show amount of padding
  7543.     jsr    shebq        ; Show eight-bit-quote character
  7544.     jsr    sheol        ; Show end-of-line character
  7545.     jsr    shpl        ; Show packet-length
  7546.     jsr    shqc        ; Show quote character
  7547.     jsr    shtim        ; Show timeout length
  7548.     rts
  7549.  
  7550. shmod:  ldx    #shin16\    ; Get address of 'timeout' string
  7551.     ldy    #shin16^
  7552.     jsr    prstr        ; Print that
  7553.     lda    filmod        ; Get the file-type mode
  7554.     cmp    #$05        ; Is it >= 4?
  7555.     bmi    shmod1        ; If not just get the string and print it
  7556.     lda    #$03        ; This is the index to the file-type we want
  7557. shmod1: tax            ; Hold this index
  7558.     lda    #kerftp\    ; Get the address if the file type strings
  7559.     sta    kermbs        ;
  7560.     lda    #kerftp^    ;
  7561.     sta    kermbs+1    ;
  7562.     lda    #kerfts        ; Get the string length
  7563.     pha            ; Push that
  7564.     txa            ; Fetch the index back
  7565.     pha            ; Push that parm then
  7566.     jsr    genmad        ;    call genmad
  7567.     jsr    prstr        ; Print the the string at that address
  7568.     jsr    prcrlf        ; Print a crelf after it
  7569.     rts
  7570.  
  7571. shfbs:  ldx    #shin17\    ; Get address of 'file-byte-size' string
  7572.     ldy    #shin17^
  7573.     jsr    prstr        ; Print that
  7574.     lda    fbsize        ; Get the file-type mode
  7575.     beq    shfbse        ; It is in eight-bit mode
  7576.     ldx    #shsbit\    ; Get address of 'SEVEN-BIT' string
  7577.     ldy    #shsbit^    ;
  7578.     jsr    prstr        ; Print that
  7579.     jsr    prcrlf        ;    then a crelf
  7580.     rts            ;    and return
  7581. shfbse: ldx    #shebit\    ; Get the address of 'EIGHT-BIT' string
  7582.     ldy    #shebit^    ;
  7583.     jsr    prstr        ; Print the the string at that address
  7584.     jsr    prcrlf        ; Print a crelf after it
  7585.     rts
  7586.  
  7587. shpari:    ldx    #shin20\    ; Get address of 'parity' string
  7588.     ldy    #shin20^    ;        ...
  7589.     jsr    prstr        ; Print that
  7590.     lda    parity        ; Get the parity index
  7591.     cmp    #$05        ; Is it >= 5?
  7592.     bmi    shpar1        ; If not just get the string and print it
  7593.     lda    #$00        ; This is the index to the parity we want
  7594. shpar1:    tax            ; Hold this index
  7595.     lda    #kerprs\    ; Get address of the parity strings
  7596.     sta    kermbs        ; And stuff it here for genmad
  7597.     lda    #kerprs^    ;        ...
  7598.     sta    kermbs+1    ;        ...
  7599.     lda    #kerpsl        ; Get the string length
  7600.     pha            ; Push that
  7601.     txa            ; Fetch the index back
  7602.     pha            ; Push that parm then
  7603.     jsr    genmad        ;    call genmad
  7604.     jsr    prstr        ; Print the the string at that address
  7605.     jsr    prcrlf        ; Print a crelf after it
  7606.     rts
  7607.  
  7608. shbad:    ldx    #shin19\    ;[17] Get the address of the 'baud' string
  7609.     ldy    #shin19^    ;[17]         ...
  7610.     jsr    prstr        ;[17] Print it
  7611.     lda    baud        ;[17] Get the baud rate
  7612.     cmp    #$08        ;[17] Is it >= 8 ?
  7613.     bmi    shbad1        ;[17] No, just print the string
  7614.     lda    #$04        ;[17] Use 300 baud as default
  7615. shbad1:    tax            ;[17] Hold the index here
  7616.     lda    #kerbds\    ;[17] Get the address of
  7617.     sta    kermbs        ;[17]    the baud rate strings
  7618.     lda    #kerbds^    ;[17]        ...
  7619.     sta    kermbs+1    ;[17]        ...
  7620.     lda    #kerbsl        ;[17] Get the length of the baud rate strings
  7621.     pha            ;[17] Push that
  7622.     txa            ;[17]
  7623.     pha            ;[17]
  7624.     jsr    genmad        ;[17]
  7625.     jsr    prstr        ;[17]
  7626.     jsr    prcrlf        ;[17]
  7627.     rts            ;[17]
  7628.  
  7629. shwrd:    ldx    #shin21\    ;[17] Get the address of the 'wrod-size'
  7630.     ldy    #shin21^    ;[17]    message
  7631.     jsr    prstr        ;[17] Print that
  7632.     lda    wrdsiz        ;[17] Get the word-size
  7633.     beq    shwrde        ;[17] 
  7634.     ldx    #shsbit\    ;[17] Get address of 'SEVEN-BIT' string
  7635.     ldy    #shsbit^    ;[17]        ...
  7636.     jsr    prstr        ;[17] Print that
  7637.     jsr    prcrlf        ;[17]    then a crelf
  7638.     rts            ;[17]    and return
  7639. shwrde:    ldx    #shebit\    ;[17] Get address of 'EIGHT-BIT' string
  7640.     ldy    #shebit^    ;[17]        ...
  7641.     jsr    prstr        ;[17] Print that
  7642.     jsr    prcrlf        ;[17]    and a crelf
  7643.     rts            ;[17]    and return
  7644.  
  7645. shflow:    ldx    #shin22\    ;[24]
  7646.     ldy    #shin22^    ;[24]
  7647.     jsr    prstr        ;[24]
  7648.     lda    flowmo        ;[24]
  7649.     jmp    pron        ;[24]
  7650.  
  7651.  
  7652. .SBTTL    Status routine
  7653.  
  7654. ;
  7655. ;    This routine shows the status of the most recent transmission
  7656. ;    session.
  7657. ;
  7658. ;        Input:  NONE
  7659. ;
  7660. ;        Output: Status of last transmission is sent to screen
  7661. ;
  7662. ;        Registers destroyed:    A,X,Y
  7663. ;
  7664.  
  7665. status: jsr    prcfm        ; Parse and print a confirm
  7666.     jsr    stat01        ;[45] Go Give the status
  7667.     jmp    kermit        ;[45]   and parse for more commands
  7668.  
  7669. stat01: ldx    #stin00\    ; Get address of first line of text
  7670.     ldy    #stin00^    ;        ...
  7671.     jsr    prstr        ; Print that
  7672.     lda    schr        ; Get low order byte of character count
  7673.     tax            ; Put that in x
  7674.     lda    schr+1        ; Get high order byte
  7675.     jsr    prntax        ; Print that pair in hex
  7676.     jsr    prcrlf        ; Add a crelf at the end
  7677.     ldx    #stin01\    ; Get address of second line
  7678.     ldy    #stin01^    ;        ....
  7679.     jsr    prstr        ; Print it
  7680.     lda    rchr        ; Get L.O. byte of char count
  7681.     tax            ; Stuff it here for the call
  7682.     lda    rchr+1        ; Get H.O. byte
  7683.     jsr    prntax        ; Print that count
  7684.     jsr    prcrlf        ; Add a crelf at the end
  7685.     ldx    #stin02\    ; Get L.O. address of message
  7686.     ldy    #stin02^    ;
  7687.     jsr    prstr        ; Print message
  7688.     lda    stot        ; Get L.O. byte of count
  7689.     tax            ; Save it
  7690.     lda    stot+1        ; Get H.O. byte
  7691.     jsr    prntax        ; Print the count
  7692.     jsr    prcrlf        ; Add a crelf at the end
  7693.     ldx    #stin03\    ; Get address of next status item message
  7694.     ldy    #stin03^
  7695.     jsr    prstr        ; Print it
  7696.     lda    rtot        ; Get the proper count (L.O. byte)
  7697.     tax            ; Hold it here for the call
  7698.     lda    rtot+1        ; Get H.O. byte
  7699.     jsr    prntax        ; Print the 16-bit count
  7700.     jsr    prcrlf        ; Add a crelf at the end
  7701.     jsr    prcrlf        ; Add a crelf at the end
  7702.     ldx    #stin04\    ; Get address of overhead message
  7703.     ldy    #stin04^    ;
  7704.     jsr    prstr        ; Print that message
  7705.     sec            ; Get ready to calculate overhead amount
  7706.     lda    stot        ; Get total character count and
  7707.     sbc    schr        ;    subtract off data character count
  7708.     tax            ; Stuff that here for printing
  7709.     lda    stot+1
  7710.     sbc    schr+1
  7711.     jsr    prntax        ; Print it
  7712.     jsr    prcrlf        ; Add a crelf at the end
  7713.     ldx    #stin05\    ; Get address of next overhead message
  7714.     ldy    #stin05^    ;        ...
  7715.     jsr    prstr        ; Print that
  7716.     sec            ; Get ready to calculate overhead amount
  7717.     lda    rtot        ; Get total character count and
  7718.     sbc    rchr        ;    subtract off data character count
  7719.     tax            ; Stuff that here for printing
  7720.     lda    rtot+1        ;        ...
  7721.     sbc    rchr+1        ;        ...
  7722.     jsr    prntax        ; Print the count
  7723.     jsr    prcrlf        ; Add a crelf at the end
  7724.     jsr    prcrlf        ; Add a crelf at the end
  7725.     lda    errcod        ; check and see if there even is an error
  7726.     beq    stat04
  7727.     ldx    #stin06\      ; Get message for 'last error'
  7728.     ldy    #stin06^    ;        ...
  7729.     jsr    prstr        ; Print the message
  7730.     jsr    prcrlf        ; Print a crelf before the error message
  7731.     bit    errcod        ; Test for 'Error packet received' bit
  7732.     bpl    stat02
  7733.     bvs    statpe        ; Go process an error packet
  7734.     bpl    stat02
  7735.     ldx    #erms0a\    ; this is a dos error.
  7736.     ldy    #erms0a^
  7737.     jsr    prstr
  7738.     ldx    #dskers\
  7739.     ldy    #dskers^
  7740.     jsr    prstr
  7741.     jsr    prcrlf
  7742.     rts
  7743. stat02:    lda    #kerems        ; Get the error message size
  7744.     pha            ; Push it
  7745.     lda    errcod        ; Get the error message offset in table
  7746.     pha            ; Push that parameter
  7747.     lda    #erms0a\    ; Use 'dskers' as the base address
  7748.     sta    kermbs        ;        ...
  7749.     lda    #erms0a^    ;        ...
  7750.     sta    kermbs+1    ;        ...
  7751. statle:    jsr    genmad        ; Translate code to address of message
  7752.     jsr    prstr        ; Print the text of error message
  7753.     jsr    prcrlf        ; Add a crelf at the end
  7754. ;    jmp    kermit        ; Start at the top
  7755.     rts            ;[45] Return to the caller
  7756. statpe:    ldx    #errrkm\    ; L.O. byte address of remote kermit error
  7757.     ldy    #errrkm^    ; H.O. byte address...
  7758.     jsr    prstr        ; Print the text from the error packet
  7759.     jsr    prcrlf        ; Print an extra crelf
  7760. ;    jmp    kermit        ; Start at the top again
  7761. stat04:    rts            ;[45] Return to the caller
  7762.  
  7763. .SBTTL    Packet routines - SPAK - send packet
  7764.  
  7765. ;
  7766. ;    This routine forms and sends out a complete packet in the
  7767. ;    following format:
  7768. ;
  7769. ;    <SOH><char(pdlen)><char(pnum)><ptype><data><char(chksum)><eol>
  7770. ;
  7771. ;        Input:  kerbf1- Pointer to packet buffer
  7772. ;            pdlen-  Length of data
  7773. ;            pnum-    Packet number
  7774. ;            ptype-  Packet type
  7775. ;
  7776. ;        Output: A-    True or False return code
  7777. ;
  7778.  
  7779. spak:    lda    fast        ; do this in fast mode if we can
  7780.     sta    $d030
  7781.     jsr    scrclr        ; clear the screen
  7782.     ldx    #snin01\    ; Give the user info on what we are doing
  7783.     ldy    #snin01^    ;        ...
  7784.     jsr    prstr        ; Print the information
  7785.     ldx    #false        ;[49]
  7786.     jsr    timset        ;[49]
  7787.     lda    tpak+1        ; Get the total packets count
  7788.     jsr    prbyte        ;    and print that
  7789.     lda    tpak        ;        ...
  7790.     jsr    prbyte        ;        ...
  7791.     jsr    prcrlf        ; Output a crelf
  7792.     lda    #$00        ; Clear packet data index
  7793.     sta    pdtind        ;        ...
  7794. spaknd: lda    spadch        ; Get the padding character
  7795.     ldx    #$00        ; Init counter
  7796. spakpd: cpx    spad        ; Are we done padding?
  7797.     bcs    spakst        ;  Yes, start sending packet
  7798.     inx            ; No, up the index and count by one
  7799.     jsr    putplc        ; Output a padding character
  7800.     jmp    spakpd        ; Go around again
  7801. spakst: lda    #soh        ; Get the start-of-header char into AC
  7802.     jsr    putplc        ; Send it
  7803.     lda    pdlen        ; Get the data length
  7804.     clc            ; Clear the carry
  7805.     adc    #$03        ; Adjust it
  7806.     pha            ; Save this to be added into stot
  7807.     clc            ; Clear carry again
  7808.     adc    #sp        ; Make the thing a character
  7809.     sta    chksum        ; First item,  start off chksum with it
  7810.     jsr    putplc        ; Send the character
  7811.     pla            ; Fetch the pdlen and add it into the
  7812.     clc            ;    'total characters sent' counter
  7813.     adc    stot        ;        ...
  7814.     sta    stot        ;        ...
  7815.     lda    stot+1        ;        ...
  7816.     adc    #$00        ;        ...
  7817.     sta    stot+1        ;        ...
  7818.     lda    pnum        ; Get the packet number
  7819.     clc            ;        ...
  7820.     adc    #sp        ; Char it
  7821.     pha            ; Save it in this condition
  7822.     clc            ; Clear carry
  7823.     adc    chksum        ; Add this to the checksum
  7824.     sta    chksum        ;        ...
  7825.     pla            ; Restore character
  7826.     jsr    putplc        ; Send it
  7827.     lda    ptype        ; Fetch the packet type
  7828.     and    #$7f        ; Make sure H.O. bit is off for chksum
  7829.     pha            ; Save it on stack
  7830.     clc            ; Add to chksum
  7831.     adc    chksum        ;        ...
  7832.     sta    chksum        ;        ...
  7833.     pla            ; Get the original character off stack
  7834.     jsr    putplc        ; Send packet type
  7835.     ldy    #$00        ; Initialize data count
  7836.     sty    datind        ; Hold it here
  7837. spaklp: ldy    datind        ; Get the current index into the data
  7838.     cpy    pdlen        ; Check against packet data length, done?
  7839.     bmi    spakdc        ; Not yet, process another character
  7840.     jmp    spakch        ; Go do chksum calculations
  7841. spakdc: lda    (kerbf1),y    ; Fetch data from packet buffer
  7842.     clc            ; Add the character into the chksum
  7843.     adc    chksum        ;        ...
  7844.     sta    chksum        ;        ...
  7845.     lda    (kerbf1),y    ; Refetch data from packet buffer
  7846.     jsr    putplc        ; Send it
  7847.     inc    datind        ; Up the counter and index
  7848.     jmp    spaklp        ; Loop to do next character
  7849. spakch: lda    chksum        ; Now, adjust the chksum to fit in 6 bits
  7850.     and    #$c0        ; First, take bits 6 and 7
  7851.     lsr    a        ;    and shift them to the extreme right
  7852.     lsr    a        ;    side of the AC
  7853.     lsr    a        ;        ...
  7854.     lsr    a        ;        ...
  7855.     lsr    a        ;        ...
  7856.     lsr    a        ;        ...
  7857.     clc            ; Now add in the original chksum byte
  7858.     adc    chksum        ;        ...
  7859.     and    #$3f        ; All this should be mod decimal 64
  7860.     clc            ;        ...
  7861.     adc    #sp        ; Put it in printable range
  7862.     jsr    putplc        ;    and send it
  7863.     lda    seol        ; Fetch the eol character
  7864.     jsr    putplc        ; Send that as the last byte of the packet
  7865.     lda    pdtind        ; Set the end of buffer pointer
  7866.     sta    pdtend        ;        ...
  7867.     lda    #$00        ; Set index to zero
  7868.     sta    pdtind        ;        ...
  7869.     lda    debug        ; Is the debug option turned on?
  7870.     cmp    #off        ;        ...
  7871.     beq    spaksp        ; Nope, go stuff packet at other kermit
  7872.     lda    #$00        ; Option 0
  7873.     jsr    debg        ; Do it
  7874. spaksp: lda    #$00        ; Zero the index
  7875.     sta    pdtind        ;        ...
  7876. spakdl: ldx    pdtind        ; Are we done?
  7877.     cpx    pdtend        ;        ...
  7878.     bpl    spakcd        ; Yes, go call debug again
  7879.     lda    plnbuf,x    ; Get the byte to send
  7880.     jsr    putrs        ; Ship it out
  7881.     inc    pdtind        ; Increment the index once
  7882.     jmp    spakdl        ; Go to top of data send loop
  7883. spakcd: lda    debug        ; Get debug switch
  7884.     cmp    #off        ; Do we have to do it?
  7885.     beq    spakcr        ; Nope, return
  7886.     lda    #$01        ; Option 1
  7887.     jsr    debg        ; Do the debug stuff
  7888. spakcr:    lda    #$fc        ; leave fast mode
  7889.     sta    $d030
  7890.     rts            ;    and return
  7891.  
  7892. .SBTTL    Packet routines - RPAK - receive a packet
  7893.  
  7894. ;
  7895. ;    This routine receives a standard Kermit packet and then breaks
  7896. ;    it apart returning the individuals components in their respective
  7897. ;    memory locations.
  7898. ;
  7899. ;        Input:
  7900. ;
  7901. ;        Output: kerbf1- Pointer to data from packet
  7902. ;            pdlen-  Length of data
  7903. ;            pnum-    Packet number
  7904. ;            ptype-  Packet type
  7905. ;
  7906.  
  7907. rpak:    lda    fast        ; put us in fast mode, if possible
  7908.     sta    $d030
  7909.     jsr    gobble        ; Gobble a line up from the port
  7910.      jmp    rpkfls        ; Must have gotten a keyboard interupt, fail
  7911.     lda    ibmmod        ; Is ibm-mode on?
  7912.     cmp    #on        ;        ...
  7913.     bne    rpakst        ; If not, start working on the packet
  7914. rpakc0:    jsr    getc        ; Any characters yet?
  7915.      jmp    rpakst        ; Got one from the keyboard
  7916.     lda    char        ;[31]
  7917.     cmp    #xon        ; Is it an XON?
  7918.     bne    rpakc0        ; Nope, try again
  7919. rpakst:    jsr    scrclr        ; clear the screen
  7920.     ldx    #rcin01\     ; Give the user info on what we are doing
  7921.     ldy    #rcin01^    ;        ...
  7922.     jsr    prstr        ; Print the information
  7923.     ldx    #true        ;[49]
  7924.     jsr    timset        ;[49] Set the timeout length
  7925.     lda    tpak+1        ; Get the total packets count
  7926.     jsr    prbyte        ;    and print that
  7927.     lda    tpak        ;        ...
  7928.     jsr    prbyte        ;        ...
  7929.     jsr    prcrlf        ; Output a crelf
  7930.     lda    debug        ; Is debugging on?
  7931.     cmp    #off        ;        ...
  7932.     beq    rpaknd        ;  Nope, no debugging, continue
  7933.     lda    #$02        ; Option 2 <reflect the fact we are in rpak>
  7934.     jsr    debg        ; Do debug stuff
  7935. rpaknd: lda    #$00        ; Clear the
  7936.     sta    chksum        ;    chksum
  7937.     sta    datind        ;    index into packet buffer
  7938.     sta    kerchr        ;    and the current character input
  7939. rpakfs: jsr    getplc        ; Get a char, find SOH
  7940.      jmp    rpkfls        ; Got a keyboard interupt instead
  7941.     sta    kerchr        ; Save it
  7942.     and    #$7f        ; Shut off H.O. bit
  7943.     cmp    #soh        ; Is it an SOH character?
  7944.     bne    rpakfs        ; Nope, try again
  7945.     lda    #$01        ; Set up the switch for receive packet
  7946.     sta    fld        ;        ...
  7947. rpklp1: lda    fld        ; Get switch
  7948.     cmp    #$06        ; Compare for <= 5
  7949.     bmi    rpklp2        ; If it still is, continue
  7950.     jmp    rpkchk        ; Otherwise, do the chksum calcs
  7951. rpklp2: cmp    #$05        ; Check fld
  7952.     bne    rpkif1        ; If it is not 5, go check for SOH
  7953.     lda    datind        ; Fetch the data index
  7954.     cmp    #$00        ; If the data index is not null
  7955.     bne    rpkif1        ;    do the same thing
  7956.     jmp    rpkif2        ; Go process the character
  7957. rpkif1: jsr    getplc        ; Get a char, find SOH
  7958.      jmp    rpkfls        ; Got a keyboard interupt instead
  7959.     sta    kerchr        ; Save that here
  7960.     and    #$7f        ; Make sure H.O. bit is off
  7961.     cmp    #soh        ; Was it another SOH?
  7962.     bne    rpkif2        ; If not, we don't have to resynch
  7963.     lda    #$00        ; Yes, resynch
  7964.     sta    fld        ; Reset the switch
  7965. rpkif2: lda    fld        ; Get the field switch
  7966.     cmp    #$04        ; Is it < = 3?
  7967.     bpl    rpkswt        ; No, go check the different cases now
  7968.     lda    kerchr        ; Yes, it was, get the character
  7969.     clc            ;    and add it into the chksum
  7970.     adc    chksum        ;        ...
  7971.     sta    chksum        ;        ...
  7972. rpkswt: lda    fld        ; Now check the different cases of fld
  7973.     cmp    #$00        ; Case 0?
  7974.     bne    rpkc1        ; Nope, try next one
  7975.     lda    #$00        ; Yes, zero the chksum
  7976.     sta    chksum        ;        ...
  7977.     jmp    rpkef        ;    and restart the loop
  7978. rpkc1:  cmp    #$01        ; Is it case 1?
  7979.     bne    rpkc2        ; No, continue checking
  7980.     lda    kerchr        ; Yes, get the length of packet
  7981.     sec            ;        ...
  7982.     sbc    #sp        ; Unchar it
  7983.     sec            ;        ...
  7984.     sbc    #$03        ; Adjust it down to data length
  7985.     sta    pdlen        ; That is the packet data length, put it there
  7986.     jmp    rpkef        ; Continue on to next item
  7987. rpkc2:  cmp    #$02        ; Case 2 (packet number)?
  7988.     bne    rpkc3        ; If not, try case 3
  7989.     lda    kerchr        ; Fetch the character
  7990.     sec            ;        ...
  7991.     sbc    #sp        ; Take it down to what it really is
  7992.     sta    pnum        ; That is the packet number, save it
  7993.     jmp    rpkef        ; On to the next packet item
  7994. rpkc3:  cmp    #$03        ; Is it case 3 (packet type)?
  7995.     bne    rpkc4        ; If not, try next one
  7996.     lda    kerchr        ; Get the character and
  7997.     sta    ptype        ;    stuff it as is into the packet type
  7998.     jmp    rpkef        ; Go on to next item
  7999. rpkc4:  cmp    #$04        ; Is it case 4???
  8000.     bne    rpkc5        ; No, try last case
  8001.     ldy    #$00        ; Set up the data index
  8002.     sty    datind        ;        ...
  8003. rpkchl: ldy    datind        ; Make sure datind is in Y
  8004.     cpy    pdlen        ; Compare to the packet data length, done?
  8005.     bmi    rpkif3        ; Not yet, process the character as data
  8006.     jmp    rpkef        ; Yes, go on to last field (chksum)
  8007. rpkif3: cpy    #$00        ; Is this the first time through the data loop?
  8008.     beq    rpkacc        ; If so, SOH has been checked, skip it
  8009.     jsr    getplc        ; Get a char, find SOH
  8010.      jmp    rpkfls        ; Got a keyboard interupt instead
  8011.     sta    kerchr        ; Store it here
  8012.     and    #$7f        ; Shut H.O. bit
  8013.     cmp    #soh        ; Is it an SOH again?
  8014.     bne    rpkacc        ; No, go accumulate chksum
  8015.     lda    #$ff        ; Yup, SOH, go resynch packet input once again
  8016.     sta    fld        ;        ...
  8017.     jmp    rpkef        ;        ...
  8018. rpkacc: lda    kerchr        ; Get the character
  8019.     clc            ;        ...
  8020.     adc    chksum        ; Add it to the chksum
  8021.     sta    chksum        ;    and save new chksum
  8022.     lda    ptype        ; GROSS AND UGLY KLUDGE FOR CKERMIT
  8023.     and    #$7f        ;     ignore any data in an ack packet.
  8024.     cmp    #'Y        ;     Ckermit puts funny things in an F ack.
  8025.     bne    ckrmt1        ;     These bytes overwrite our next packet.
  8026.     lda    state        ;     ... but not while expecting an init
  8027.     cmp    #'R        ;     .... while receiving a file
  8028.     bne    ckrmt2
  8029. ckrmt1:    lda    kerchr        ; Get the character again
  8030.     ldy    datind        ; Get our current data index
  8031.     sta    (kerbf1),y    ; Stuff the current character into the buffer
  8032. ckrmt2:    inc    datind        ; Up the index once
  8033.     jmp    rpkchl        ; Go back and check if we have to do this again
  8034. rpkc5:  cmp    #$05        ; Last chance, is it case 5?
  8035.     beq    rpkc51        ; Ok, continue
  8036.     jmp    rpkpe        ; Warn user about program error
  8037. rpkc51: lda    chksum        ; Do chksum calculations
  8038.     and    #$c0        ; Grab bits 6 and 7
  8039.     lsr    a        ; Shift them to the right (6 times)
  8040.     lsr    a        ;        ...
  8041.     lsr    a        ;        ...
  8042.     lsr    a        ;        ...
  8043.     lsr    a        ;        ...
  8044.     lsr    a        ;        ...
  8045.     clc            ; Clear carry for addition
  8046.     adc    chksum        ; Add this into original chksum
  8047.     and    #$3f        ; Make all of this mod decimal 64
  8048.     sta    chksum        ;    and resave it
  8049. rpkef:  inc    fld        ; Now increment the field switch
  8050.     jmp    rpklp1        ; And go check the next item
  8051. rpkchk: lda    kerchr        ; Get chksum from packet
  8052.     sec            ; Set carry for subtraction
  8053.     sbc    #sp        ; Unchar it
  8054.     cmp    chksum        ; Compare it to the one this Kermit generated
  8055.     beq    rpkret        ; We were successful, tell the caller that
  8056.     lda    #$06        ; Store the error code
  8057.     sta    errcod        ;        ...
  8058.     ldx    #erms15\    ; Create pointer to error text
  8059.     ldy    #erms15^    ;
  8060.     jsr    prstr        ; Print the chksum error
  8061.     lda    kerchr        ; Print chksum from packet
  8062.     jsr    prbyte        ;        ...
  8063.     lda    #sp        ; Space things out a bit
  8064.     jsr    cout        ;        ...
  8065.     lda    chksum        ; Now get what we calculated
  8066.     jsr    prbyte        ;    and print that
  8067. rpkfls:    lda    #$00        ; Zero the index for debug mode
  8068.     sta    pdtind        ;        ...
  8069.     lda    debug        ; Is debug switch on?
  8070.     cmp    #off        ;        ...
  8071.     beq    rpkfnd        ;  Return doing no debug stuff
  8072.     lda    #$03        ; Option 3 <we are in rpkfls>
  8073.     jsr    debg        ; Output debug information
  8074. rpkfnd: lda    pdlen        ; Get the packet data length
  8075.     clc            ;    and add it into the
  8076.     adc    rtot        ;    'total characters received' counter
  8077.     sta    rtot        ;        ...
  8078.     lda    rtot+1        ;        ...
  8079.     adc    #$00        ;        ...
  8080.     sta    rtot+1        ;        ...
  8081.     lda    #$fc        ; exit fast mode
  8082.     sta    $d030
  8083.     lda    #false        ; Set up failure return
  8084.     sta    ptype        ;[DD] Set packet type false
  8085.     rts            ;    and go back
  8086. rpkret:    lda    #$00        ; Zero the index for debug mode
  8087.     sta    pdtind        ;        ...
  8088.     lda    debug        ; Check debug switch
  8089.     cmp    #off        ; Is it on?
  8090.     beq    rpkrnd        ; No, return with no debug
  8091.     lda    #$04        ; Yes, use option 4 <we received a packet>
  8092.     jsr    debg        ; Print out the debug info
  8093. rpkrnd: lda    pdlen        ; Get the packet data length
  8094.     clc            ;    and add it into the
  8095.     adc    rtot        ;    'total characters received' counter
  8096.     sta    rtot        ;        ...
  8097.     lda    rtot+1        ;        ...
  8098.     adc    #$00        ;        ...
  8099.     sta    rtot+1        ;        ...
  8100.     lda    #$fc        ; turn off fast mode
  8101.     sta    $d030
  8102.     lda    #true        ; Show a successful return
  8103.     rts            ;    and return
  8104. rpkpe:  ldx    #erms16\    ; Set up pointer to error text
  8105.     ldy    #erms16^    ;        ...
  8106.     jsr    prstr        ; Print the error
  8107.     lda    #$07        ; Load error code and store in errcod
  8108.     sta    errcod        ;        ...
  8109.     jmp    rpkfls        ; Go give a false return
  8110.  
  8111. .SBTTL    Timset and Timout
  8112.  
  8113. ;
  8114. ;    Routines to set and check for Kermit timeouts
  8115. ;
  8116.  
  8117. ;
  8118. ;    Timset - Set the timeout for receive or send
  8119. ;
  8120. ;    Input:    X - True for receive, false for send
  8121. ;
  8122. ;    Registers Detsroyed: A
  8123. ;
  8124.  
  8125. timset:    lda    clock+1        ;[49] Get the current seconds
  8126.     clc            ;[49]
  8127.     cpx    #true        ;[49] Are we receiving?
  8128.     bne    timsst        ;[49] No
  8129.     adc    rtime        ;[49] Add in the receive timeout
  8130.     sta    ttime+1        ;[49]     and store it
  8131.     adc    #$00        ;[49] Account for the carry if any
  8132.     sta    ttime        ;[49]    and store it
  8133.     rts            ;[49] Return
  8134. timsst:    adc    stime        ;[49] Add in the send timeout
  8135.     sta    ttime+1        ;[49]    and store it
  8136.     adc    #$00        ;[49] Account for the carry if any
  8137.     sta    ttime        ;[49]    and store it
  8138.     rts            ;[49] Return
  8139.  
  8140. ;
  8141. ;    Timout - Check to see if we have exceeded the timeout limit.
  8142. ;
  8143. ;    Input:  Ttim - time to timeout at
  8144. ;        Clock+1 - current time
  8145. ;
  8146. ;    Registers Destroyed: A
  8147. ;
  8148.  
  8149. timout:    lda    clock        ;[49] Get the current minutes
  8150.     cmp    ttime        ;[49] Compare it to the old minutes
  8151.     bmi    timskp        ;[49] Still less
  8152.     lda    clock+1        ;[49] Get the current seconds
  8153.     cmp    ttime+1        ;[49] Compare it to the old seconds
  8154.     bmi    timskp        ;[49] Still less 
  8155. timret:    rts            ;[49] We have timed out, return
  8156. timskp:    jmp    rskp        ;[49] No timeout, return with a skip
  8157.  
  8158. .SBTTL    DEBG - debugging output routines
  8159.  
  8160. ;
  8161. ;    When the debugging option is turned on, these routines periodically
  8162. ;    display information about what data is being sent or received.
  8163. ;
  8164. ;        Input:  A-    Action type
  8165. ;            Ptype-  Packet type sent or received
  8166. ;            Pnum-    Packet number sent or received
  8167. ;            Pdlen-  Packet data length
  8168. ;
  8169. ;        Output: Display info on current packet status
  8170. ;
  8171. ;        Registers destroyed:    A,X,Y
  8172. ;
  8173.  
  8174. debg:    tax            ; Hold the action code here
  8175.     sta    debinx        ; Save it here
  8176.     lda    debug        ; Get the debug switch
  8177.     cmp    #terse        ; Is it terse
  8178.     bne    debgvr        ; Nope, must be Verbose mode
  8179.     jmp    debgtr        ; Yes, to terse debug output
  8180. debgvr:    lda    state        ; Check the current state
  8181.     cmp    #$00        ; If we just started this thing
  8182.     beq    debgrf        ;    then we don't need debug output yet
  8183.     cmp    #'C        ; If the transmission state is 'complete'
  8184.     beq    debgrf        ;    we don't need debug output either
  8185.     lda    #kerrts\    ; Get base address of the routine name and
  8186.     sta    kermbs        ;    action table so that we can calculate
  8187.     lda    #kerrts^    ;        ...
  8188.     sta    kermbs+1    ;        ...
  8189.     lda    #kerrns        ; Load the routine name size
  8190.     pha            ; Push that
  8191.     txa            ; Fetch the offset for the one we want
  8192.     pha            ; And push that parameter
  8193.     jsr    genmad        ; Go generate the message address
  8194.     jsr    prstr        ; Now, go print the string
  8195.     lda    ptype        ; Get the current packet type
  8196.     pha            ; Save this accross the routine calls
  8197.     jsr    cout        ; Write that out
  8198.     jsr    prcrlf        ; Now write a crelf
  8199.     pla            ; Get back the packet type
  8200.     sta    debchk        ;    and start the checksum with that
  8201.     lda    debinx        ; Get the debug action index
  8202.     bne    debg1        ; If not 'sending', continue
  8203.     jsr    debprd        ; Yes, go do some extra output
  8204. debg1:  cmp    #$04        ; Have we just received a packet?
  8205.     bne    debgrt        ; No, just return
  8206.     jsr    debprd        ; Print the packet info
  8207. debgrt: lda    #true        ; Load true return code into AC
  8208.     rts            ;    and return
  8209. debgrf: lda    #false        ; Set up failure return
  8210.     rts            ;    and go back
  8211.  
  8212. ;
  8213. ;    Debprd - does special information output including packet number,
  8214. ;    packet data length, the entire packet buffer, and the checksum
  8215. ;    of the packet as calculted by this routine.
  8216. ;
  8217.  
  8218. debprd: jsr    prcrlf        ; Start by giving us a new line
  8219.     ldx    #debms1\    ; Get the first info message address
  8220.     ldy    #debms1^    ;        ...
  8221.     jsr    prstr        ;    and print it
  8222.     jsr    prcrlf        ; New line
  8223.     ldx    #debms3\    ; Get address of message text
  8224.     ldy    #debms3^    ;        ...
  8225.     jsr    prstr        ; Print it
  8226.     inc    pdtind        ; Pass the SOH
  8227.     ldx    pdtind        ; Get the index
  8228.     lda    plnbuf,x    ; Get the data length
  8229.     sec            ; Uncharacter this value
  8230.     sbc    #$20        ;        ...
  8231.     jsr    prbyte        ; Print the hex value
  8232.     jsr    prcrlf        ; New line
  8233.     ldx    #debms2\    ; Get address of message text
  8234.     ldy    #debms2^    ;        ...
  8235.     jsr    prstr        ; Print it
  8236.     inc    pdtind        ; Next character is packet number
  8237.     ldx    pdtind        ;        ...
  8238.     lda    plnbuf,x    ; Load it
  8239.     sec            ; Uncharacter this value
  8240.     sbc    #$20        ;        ...
  8241.     jsr    prbyte        ; Print the hex value
  8242.     jsr    prcrlf        ; New line
  8243.     inc    pdtind        ; Bypass the packet type
  8244.     ldy    #$ff        ; Start counter at -1
  8245.     sty    kwrk02        ; Store it here
  8246. debprc:    inc    kwrk02        ; Increment the counter
  8247.     ldy    kwrk02        ; Get counter
  8248.     cpy    pdlen        ; Are we done printing the packet data?
  8249.     bpl    debdon        ; If so, go finish up
  8250.     inc    pdtind        ; Point to next character
  8251.     ldx    pdtind        ; Fetch the index
  8252.     lda    plnbuf,x    ; Get next byte from packet
  8253.     jsr    prchr        ; Go output special character
  8254.     lda    #space        ; Now print 1 space
  8255.     jsr    cout        ;        ...
  8256.     jmp    debprc        ; Go check next character
  8257. debdon:    jsr    prcrlf        ; Next line
  8258.     ldx    #debms4\    ; Get the address to the 'checksum' message
  8259.     ldy    #debms4^    ;        ...
  8260.     jsr    prstr        ; Print that message
  8261.     inc    pdtind        ; Get next byte, this is the checksum
  8262.     ldx    pdtind        ;        ...
  8263.     lda    plnbuf,x    ;        ...
  8264.     sec            ; Uncharacter this value
  8265.     sbc    #$20        ;        ...
  8266.     jsr    prbyte        ; Print the hex value of the checksum
  8267.     jsr    prcrlf        ; Print two(2) crelfs
  8268.     jsr    prcrlf        ;        ...
  8269.     rts            ;    and return
  8270.  
  8271. .SBTTL    Terse debug output
  8272.  
  8273. ;
  8274. ;    This routine does brief debug output. It prints only the contents
  8275. ;    of the packet with no identifying text.
  8276. ;
  8277.  
  8278. debgtr:    txa            ; Look at Option
  8279.     cmp    #$00        ; Sending?
  8280.     beq    debgsn        ; Yes, output 'SENDING: '
  8281.     cmp    #$03        ; Failed receive?
  8282.     beq    debgrc        ; Yes, output 'RECEIVED: '
  8283.     cmp    #$04        ; Receive?
  8284.     beq    debgrc        ; Yes, output 'RECEIVED: '
  8285.     rts            ; Neither, just return
  8286. debgsn:    ldx    #sstrng\    ; Get ready to print the string
  8287.     ldy    #sstrng^    ;        ...
  8288.     jsr    prstr        ; Do it!
  8289.     jsr    prcrlf        ; Print a crelf
  8290.     jmp    debgdp        ; Go dump the packet
  8291. debgrc:    ldx    #rstrng\    ; Get ready to print the string
  8292.     ldy    #rstrng^    ;        ...
  8293.     jsr    prstr        ; Do it!
  8294.     jsr    prcrlf        ; Print a crelf
  8295. debgdp:    ldx    pdtind        ; Get index
  8296.     cpx    pdtend        ; Are we done?
  8297.     bpl    debgfn        ; Yes, return
  8298.     lda    plnbuf,x    ; Get the character
  8299.     jsr    prchr        ; Print it
  8300.     lda    #space        ; Print a space
  8301.     jsr    cout        ;        ...
  8302.     inc    pdtind        ; Advance the index
  8303.     jmp    debgdp        ; Do next character
  8304. debgfn:    jsr    prcrlf        ; Print a crelf then...
  8305.     rts            ;    Return
  8306.  
  8307. .SBTTL    Dos routines
  8308.  
  8309. ;
  8310. ;    These routines handle files and calls to the DOS
  8311. ;
  8312.  
  8313. ;
  8314. ;    This routine opens a file for either input or output. If it
  8315. ;    opens it for output, and the file exists, and file-warning is
  8316. ;    on, the routine will issue a warning and attempt to modify
  8317. ;    the filename so that it is unique.
  8318. ;
  8319. ;        Input:    A- Fncrea - open for read
  8320. ;               Fncwrt - open for write
  8321. ;
  8322. ;        Output:    File is opened or error is issued
  8323. ;
  8324.  
  8325. openf:  sta    flsrw          ;[DD] Save mode  w or r
  8326. ;     openm    #15,#8,#15,fcmd,#2    ;[DD] Open error channel
  8327.     lda    #15        ; [53]
  8328.     ldx    #8
  8329.     ldy    #15
  8330.     jsr    setlfs
  8331.     ldx    #fcmd\
  8332.     ldy    #fcmd^
  8333.     lda    #2
  8334.     jsr    setnam
  8335.     jsr    open
  8336.  
  8337.     lda    flsrw        ;[23] Get the file mode
  8338.     cmp    #fncwrt        ;[23] Are we opening for output?
  8339.     bne    opnnlu        ;[23] No, no lookup needed
  8340.     lda    #on        ;[23] Yes, set the 'first mod' switch
  8341.     sta    dosffm        ;[23]    in case we have to alter the filename
  8342.     lda    filwar        ;[23] Get the file warning switch
  8343.     cmp    #on        ;[23] Is it on?
  8344.     bne    opnnlu        ;[23] If not, don't do the lookup
  8345. opnlu:    jsr    lookup        ;[23] Do the lookup
  8346.      jmp    opnnlu        ;[23] Suceeded, open the file
  8347.     lda    dosffm        ;[23] Is this the first time through?
  8348.     cmp    #on        ;[23]        ...
  8349.     bne    opnalt        ;[23] If not, continue
  8350.     ldx    #erms1a\    ;[23] Otherwise, print an error message since
  8351.     ldy    #erms1a^    ;[23]    the file already exists
  8352.     jsr    prstr        ;[23]        ...
  8353. opnalt:    jsr    alterf        ;[23] No good, go alter the filename
  8354.     jmp    opnlu        ;[23] Try the lookup again
  8355. opnnlu:    jsr    bldprm        ;[23] Build the filename again
  8356. ;     openm    #8,#8,#8,primfn,len    ;[DD] Open file without lookup
  8357.     lda    #8        ; [53]
  8358.     ldx    #8
  8359.     ldy    #8
  8360.     jsr    setlfs
  8361.     ldx    #primfn\
  8362.     ldy    #primfn^
  8363.     lda    len
  8364.     jsr    setnam
  8365.     jsr    open
  8366.  
  8367. opnfi1:    jsr    rddsk          ;[DD] Get disk status
  8368.     cmp    #00        ;[DD] Is it 0?
  8369.     bne      opfail         ;[DD] If not, error
  8370.     sta    eodind        ;[DD] Clear end of dat flag
  8371. opnex:  lda    #true        ;[DD] The open worked, return true
  8372.     rts            ;[DD]        ...
  8373. opfail: jmp    fatal        ;[DD] Failed, go handle that
  8374. ;    rts            ;[DD]        ...
  8375.  
  8376.  
  8377. ;
  8378. ;    Lookup - searches for a filename in a directory. It is used to
  8379. ;    support file warning during the opening of a file.
  8380. ;
  8381.  
  8382. lookup:    lda    #fncrea        ;[23] Get an 'R
  8383.     sta    flsrw        ;[23] Store it in the file mode switch
  8384.     jsr    locent        ;[23] Go try to locate that file
  8385.      jmp    locfnf        ;[23] File not found? We are in good shape
  8386.     lda    #errfae        ;[23] Store the error code
  8387.     sta    errcod        ;[23]        ...
  8388.     jmp    rskp        ;[23] Return with skip, have to alter filename
  8389. locfnf:    lda    #fncwrt        ;[23] Get a 'W
  8390.     sta    flsrw        ;[23] Store that
  8391.     rts            ;[23] Return without a skip
  8392.  
  8393. ;
  8394. ;    Alterf - changes a filename in the filename buffer to make it unique.
  8395. ;    It accomplishes this in the following manner.
  8396. ;
  8397. ;        1) First time through, it finds the last significant character
  8398. ;            in the filename and appends a '.0' to it.
  8399. ;
  8400. ;        2) Each succeeding time, it will increment the trailing integer
  8401. ;            that it inserted the first time through.
  8402. ;
  8403.  
  8404. alterf:    lda    dosffm        ;[23] Get the 'first mod' flag
  8405.     cmp    #on        ;[23] Is it on?
  8406.     beq    altfm        ;[23] If it is, do an initial modification
  8407.     jmp    altsm        ;[23] Otherwise, just increment the version
  8408. altfm:    lda    #off        ;[23] Shut the 'first mod' flag off
  8409.     sta    dosffm        ;[23]        ...
  8410.     ldy    #mxfnl-1    ;[23] Stuff the maximum filename length in y
  8411. altgnc:    lda    fcb1,y        ;[23] Get the character from the buffer
  8412.     cmp    #space        ;[23] Is it a space?
  8413.     bne    altco        ;[23] If it is, try the character before it
  8414.     dey            ;[23] Down the index once
  8415.     tya
  8416.     cmp    #$00
  8417.     bpl    altgnc        ;[23] Get the next character
  8418.     ldy    #$00        ;[23] No filename, so user 0 as the index
  8419. altco:    sty    dosfni        ;[23] Save the filename index
  8420.     iny            ;[23] Increment it twice
  8421.     iny            ;[23]        ...
  8422.     cpy    #mxfnl        ;[23] Does this exceed the filename length?
  8423.     bpl    altng        ;[23] Cannot do the alterations
  8424.     lda    #$2e        ;[23] Get the dot
  8425.     ldy    dosfni        ;[23] Get the original index back
  8426.     iny            ;[23] Up it once
  8427.     sta    fcb1,y        ;[23] Store the dot
  8428.     lda    #$00        ;[23] Zero the version count
  8429.     sta    dosfvn        ;[23]        ...
  8430.     iny            ;[23] Up the index again
  8431.     sty    dosfni        ;[23] This will be saved for future alterations
  8432.     jsr    altstv        ;[23] Go store the version in the filename
  8433.     rts            ;[23]    and return
  8434. altsm:    ldx    dosfvn        ;[23] Get the file version number
  8435.     inx            ;[23] Increment it
  8436.     stx    dosfvn        ;[23] Save the new version number
  8437.     txa            ;[23] Get the version number in the AC
  8438.     cmp    #0        ;[23] Is it 0 ?
  8439.     beq    altng        ;[23] Yes, cannot alter name
  8440.     jsr    altstv        ;[23] Go store the version
  8441.     rts            ;[23] And return
  8442. altng:    lda    #$09        ;[23] Store the error code
  8443.     sta    errcod        ;[23]        ...
  8444.     ldx    kerosp        ;[23] Get the old stack pointer
  8445.     txs            ;[23]    and restore it
  8446.     jmp    kermit        ;[23] Go back to top of loop
  8447.  
  8448. ;
  8449. ;    Altstv - stores the version number passed to it into the filename
  8450. ;    buffer at whatever position dosfni is pointing to.
  8451. ;
  8452.  
  8453. altstv:    ldy    dosfni        ;[23] Get the filename index
  8454.     pha            ;[23] Save the value
  8455.     lsr    a        ;[23] Shift out the low order nibble
  8456.     lsr    a        ;[23]        ...
  8457.     lsr    a        ;[23]        ...
  8458.     lsr    a        ;[23]        ...
  8459.     jsr    altstf        ;[23] Stuff the character
  8460.     pla            ;[23] Grab back the original value
  8461.     and    #$0f        ;[23] Take the low order nibble
  8462.     iny            ;[23] Increment the filename index
  8463.     jsr    altstf        ;[23] Stuff the next character
  8464.     rts            ;[23]    and return
  8465.  
  8466. altstf:    ora    #$30        ;[23] Make the character printable
  8467.     cmp    #$3a        ;[23] If it is less than '9'
  8468.     bcc    altdep        ;[23]    then go depisit the character
  8469.     adc    #$06        ;[23] Put the character in the proper range
  8470. altdep:    sta    fcb1,y        ;[23] Stuff the character
  8471.     rts            ;[23]    and return
  8472.  
  8473. ;
  8474. ;    Locent -  Try to find a file 
  8475. ;
  8476.  
  8477. locent:    jsr    bldprm        ;[23]
  8478. ;     openm    #8,#8,#8,primfn,len    ;[23] Open file
  8479.     lda    #8        ; [53]
  8480.     ldx    #8
  8481.     ldy    #8
  8482.     jsr    setlfs
  8483.     ldx    #primfn\
  8484.     ldy    #primfn^
  8485.     lda    len
  8486.     jsr    setnam
  8487.     jsr    open
  8488.  
  8489.     jsr    rddsk          ;[23] Get disk status
  8490.     cmp    #00        ;[23] Is it 0?
  8491.     bne      locok         ;[23] No, file doesn't exist
  8492.     lda    #8        ;[23] Fle exists, close the file
  8493.     jsr    close        ;[23]        ...
  8494.     jmp    rskp        ;[23] Return with a skip!
  8495. locok:    lda    #8        ;[23] File doesn't exist, close the file
  8496.     jsr    close        ;[23]        ...
  8497.     rts            ;[23] Return
  8498.  
  8499. ;
  8500. ;    Bldprm - Build the primary filename
  8501. ;
  8502.  
  8503. bldprm:    ldx    #'P        ;[DD]        ...
  8504.     lda    filmod        ;[DD] Get the file-type mode
  8505.     and    #$02        ;[DD] If 0 or 1
  8506.     bne    bldpr1        ;[DD] If > 1 P (PRG file)
  8507.     ldx    #'S        ;[DD] S for 0 or 1 (SEQ file)
  8508. bldpr1:    stx    flssp        ;[DD] Store it
  8509.     ldy      #0        ;[DD] Start index
  8510. bldpr2:    lda    fcb1,y         ;[DD] Get char from file name
  8511.     beq      bldfln      ;[DD] End at null
  8512.     cmp      #$20        ;[DD]   or space
  8513.     beq      bldfln        ;[DD]        ...
  8514.     sta      primfn,y     ;[DD] Save in filename
  8515.     iny            ;[DD] Increment index
  8516.     bne    bldpr2         ;[DD] Get more
  8517. bldfln: lda    #',          ;[DD] Add comma
  8518.     sta    primfn,y    ;[DD] Save in filename
  8519.     lda    flssp          ;[DD] Add S or P
  8520.     iny            ;[DD] Increment index
  8521.     sta    primfn,y    ;[DD] Save in filename
  8522.     iny            ;[DD] Increment index
  8523.     lda     #',          ;[DD] Add comma
  8524.     sta    primfn,y    ;[DD] Save in filename
  8525.     iny            ;[DD] Increment index
  8526.     lda    flsrw        ;[DD] Get mode W or R
  8527.     sta    primfn,y    ;[DD] Save in filename
  8528.     iny            ;[DD] Increment index
  8529. bldfl3: sty    len          ;[DD] Len of file name
  8530.     rts            ;[23] Return
  8531.  
  8532. ;
  8533. ;    Closef - closes the file which was open for transfer. 
  8534. ;
  8535.  
  8536. closef: lda    #8        ;[DD] Close disk file
  8537.     jsr     close        ;[DD]        ...
  8538.     lda    #15        ;[DD] Close error channel    
  8539.     jsr    close          ;[DD]        ...
  8540.     lda    #true        ; the close worked, return true
  8541.     rts            ;        ...
  8542.  
  8543. ;
  8544. ;    Dirst - Get a disk directory
  8545. ;
  8546.  
  8547. dirst:    jsr    clrbuf        ;[40] Clear the dos command buffer
  8548.     lda    #drdoll        ;[40] Get a '$'
  8549.     sta    buff        ;[40]
  8550.     lda    drunit        ;[40] Get the current drive unit no.
  8551.     sta    buff+1        ;[40]
  8552.     lda    #drcolo        ;[40] Get a ':'
  8553.     sta    buff+2        ;[40]
  8554.     lda    #drstar        ;[40] Get a '*'
  8555.     sta    buff+3        ;[40]
  8556. dirprm:    jsr    dosprs        ;[40] Parse for the command
  8557.     ldx    len        ;[50]
  8558.     bne    drnone        ;[50]
  8559.     inc    len        ;[50]
  8560. drnone:    inc    len        ;[40]
  8561.     inc    len        ;[40]
  8562.     inc    len        ;[40]
  8563. dirsfo:    ; openm    #8,#8,#0,buff,len    ;[40] Get directory
  8564.     lda     #8        ; [53]
  8565.     ldx     #8
  8566.     ldy     #0
  8567.     jsr    setlfs
  8568.     ldx    #buff\
  8569.     ldy    #buff^
  8570.     lda    len
  8571.     jsr    setnam
  8572.     jsr    open
  8573.     bcs    drclos        ;[DD] Close if error
  8574.     ldx    #$08        ;[DD] Open for input
  8575.     jsr    chkin        ;[DD] Get 3 bytes
  8576.     jsr    chrin        ;[DD]
  8577.     jsr    chrin        ;[DD]
  8578. drst1:  jsr    chrin        ;[DD] Get  byte
  8579.     jsr    readst        ;[DD] If eof close
  8580.     bne    drclos        ;[DD]
  8581.     jsr    chrin        ;[DD] Get 2nd byte
  8582.     beq    drclos        ;[DD]
  8583.     jsr    clrchn        ;[DD] Set input to keybd
  8584.     jsr    getin        ;[DD] Check for space or run/stop
  8585.     cmp    #$03        ; if run/stop
  8586.     beq    drclos        ;     then end directory listing
  8587.     cmp    #$20        ;[DD]
  8588.     bne    drskp        ;[DD] If not space skip
  8589. drloop: jsr    getin        ;[DD] Loop until
  8590.     beq    drloop        ;[DD] Any key pressed
  8591. drskp:  ldx    #$08        ;[DD] Set input to disk
  8592.     jsr    chkin        ;[DD]
  8593.     jsr    chrin        ;[DD] Get a byte
  8594.     pha            ;[DD]
  8595.     jsr    chrin        ;[DD] Get a byte
  8596.     tay            ;[DD]
  8597.     pla            ;[DD]
  8598.     tax            ;[DD]
  8599.     tya            ;[DD]
  8600.     jsr    prntad        ;[DD] [54] Print block count in Decimal
  8601.     lda    #$20        ;[DD]
  8602.     jsr    scrput        ;[DD] Print  a space
  8603. drprnt: jsr    chrin        ;[DD] Get byte
  8604.     beq    dreol        ;[DD] If null end of line
  8605.     cmp    #18        ; reverse on?
  8606.     bne    drpr1
  8607.     lda    #$01
  8608.     sta    reverse
  8609.     jmp    drprnt        ; do the next character
  8610. drpr1:    jsr    scrput        ;[DD] Print byte
  8611.     clc            ;[37]
  8612.     bcc    drprnt        ;[37]
  8613. dreol:  jsr    scrcr        ; print a cr
  8614.     jsr    scrlf        ; print a linefeed
  8615.     lda    #$00
  8616.     sta    reverse        ; turn off reverse
  8617.     lda    #$00        ;[37]
  8618.     sta    rvmask        ;[37]
  8619.     beq    drst1        ;[DD] Go back for more
  8620. drclos: jsr    clrchn        ;[DD] Close channels
  8621.     lda    #$08        ;[DD] Close 8
  8622.     jsr    close        ;[DD]
  8623.     jmp    kermit        ;[40]
  8624.  
  8625. ;
  8626. ;    Doscmd - Send a string to the disk command channel
  8627. ;
  8628.  
  8629. doscmd:    lda    #15        ;[DD] Close command channel
  8630.     jsr    close        ;[DD]        ...
  8631.     jsr    clrbuf        ;[40] Clear the dos command buffer
  8632. dosprm:    jsr    dosprs        ;[40] Parse for the command
  8633. ;     openm    #15,#8,#15,buff+3,len    ;[DD] Send command out
  8634.     lda    #15        ; [53]
  8635.     ldx    #8
  8636.     ldy    #15
  8637.     jsr    setlfs
  8638.     ldx    #buff+3\
  8639.     ldy    #buff+3^
  8640.     lda    len
  8641.     jsr    setnam
  8642.     jsr    open
  8643.     jsr    rddsk        ;[DD]   Get disk status
  8644.     lda    #15        ; in any case, close #15
  8645.     jsr    close
  8646.     jmp    kermit        ;[40] Go back for more commands
  8647.  
  8648. ;
  8649. ;    Dosprs - parses a string to be passed to the
  8650. ;    disk drive command channel.
  8651. ;
  8652. ;    Registeres Destroyed:
  8653. ;
  8654.  
  8655. dosprs:    jsr    clrchn        ;[40] Set default I/O channels
  8656.     lda    #kerehr\    ;[40] Point to the extra help commands
  8657.     sta    cmehpt        ;[40]        ...
  8658.     lda    #kerehr^    ;[40]        ...
  8659.     sta    cmehpt+1    ;[40]        ..
  8660.     ldx    #$2f        ;[40] Longest length a disk string may be
  8661.     ldy    #cmfehf        ;[40] Tell Comnd about extra help
  8662.     lda    #cmifi        ;[40] Load opcode for parsing file
  8663.     jsr    comnd        ;[40] Call Comnd routine
  8664.      jmp    dos1        ;[40] Continue, no string parsed
  8665.     stx    kerfrm        ;[40] Save the from address (addr[atmbuf])
  8666.     sty    kerfrm+1    ;[40]        ...
  8667.     sta    kwrk01        ;[40] Save length of string parsed
  8668.     lda    #03        ;[40] Get the address of the buffer
  8669.     sta    kerto        ;[40]        ...
  8670.     lda    #02        ;[40]        ...
  8671.     sta    kerto+1        ;[40]        ...
  8672.     jsr    kercpy        ;[40] Copy the string
  8673.     ldy    kwrk01        ;[40] Get the length back
  8674. ;    iny            ;[40] Increment it by one
  8675.     lda    #0        ;[40] Stuff a null at the end
  8676.     sta    buff+3,y    ;[40]        ...
  8677. ;    iny            ;[40]
  8678.     sty    len        ;[40]
  8679.     clc            ;[40]
  8680.     bcc    dos2        ;[40]
  8681. dos1:    lda    #0        ;[40]
  8682.     sta    len        ;[40]
  8683. dos2:    jsr    prcfm        ;[40]
  8684.     rts            ;[40]
  8685.  
  8686. ;
  8687. ;    Bufill - takes characters from the file, does any neccesary quoting,
  8688. ;    and then puts them in the packet data buffer. It returns the size
  8689. ;    of the data in the AC. If the size is zero and it hit end-of-file,
  8690. ;    it turns on eofinp.
  8691. ;
  8692.  
  8693. bufill:    lda    #$00        ; Zero
  8694.     sta    datind        ;    the buffer index
  8695. bufil1:    lda    addlf        ; Get the 'add a lf' flag
  8696.     cmp    #on        ; Is it on?
  8697.     bne    bufil3        ; No, continue with normal processing
  8698.     lda    #off        ; Zero the flag first
  8699.     sta    addlf        ;        ...
  8700.     lda    #lf        ; Get a <lf>
  8701.     bne    bufcv2a        ; always skip over character translation
  8702. bufil3:    jsr    fgetc        ; Get a character from the file
  8703.      jmp    bffchk        ; Go check for actual end-of-file
  8704.     sta    kerchr        ; Got a character, save it
  8705.     tax            ;[31] and a copy to X
  8706.     lda    filmod        ;[DD] Check if conversion necessary
  8707.     cmp    #1        ;[DD] Is it PETASCI?
  8708.     bne    bufcv1        ;[DD] No
  8709.     lda    pt2as,x        ;[31] Get ASCII equivalent
  8710.     sta    kerchr        ;
  8711.     jmp    bufceb        ;[DD] 
  8712. bufcv1: cmp    #2        ;[DD] Is it Speedscript?
  8713.     bne    bufcv2        ;[DD] No
  8714.     jsr    cvs2a        ;[DD] Conv. Speedscript to ASCII
  8715.     jmp    bufceb
  8716. bufcv2:    cmp    #4        ; is it c-power
  8717.     bne    bufceb
  8718.     lda    #'_
  8719.     cpx    #$a4        ; $a4 is an underbar
  8720.     beq    bufcv2a
  8721.     lda    #'~
  8722.     cpx    #$af        ; $af is a tilde
  8723.     beq    bufcv2a
  8724.     lda    #'|
  8725.     cpx    #$df        ; $df is a pipe
  8726.     beq    bufcv2a
  8727.     lda    pt2as,x        ; if all else fails, use pt2as table
  8728. bufcv2a:sta    kerchr
  8729. bufceb: lda    ebqmod        ; Check if 8-bit quoting is on
  8730.     cmp    #on        ;        ...
  8731.     beq    bufil2        ; If it is, see if we have to use it
  8732.     jmp    bffqc        ; Otherwise, check normal quoting only
  8733. bufil2: lda    kerchr        ; Get the character
  8734.     and    #$80        ; Mask everything off but H.O. bit
  8735.     beq    bffqc        ; H.O. bit was not on, so continue
  8736.     lda    sebq        ; H.O. bit was on, get 8-bit quote
  8737.     ldy    datind        ; Set up the data index
  8738.     sta    (kerbf1),y    ; Stuff the quote character in buffer
  8739.     iny            ; Up the data index
  8740.     sty    datind        ; And save it
  8741.     lda    kerchr        ; Get the original character saved
  8742.     and    #$7f        ; Shut H.O. bit, we don't need it
  8743.     sta    kerchr        ;        ...
  8744. bffqc:  lda    kerchr        ; Fetch the character
  8745.     and    #$7f        ; When checking for quoting, use only 7 bits
  8746. bffqc0: cmp    #sp        ; Is the character less than a space?
  8747.     bpl    bffqc1        ; If not, try next possibility
  8748.     ldx    filmod        ; Get the file-type
  8749.     cpx    #3        ;[DD] IF = 3
  8750.     beq    bffctl        ; If it is not text, ignore <cr> problem
  8751.     cmp    #cr        ; Do we have a <cr> here?
  8752.     bne    bffctl        ; Nope, continue processing
  8753.     ldx    #on        ; Set flag to add a <lf> next time through
  8754.     stx    addlf        ;        ...
  8755.     jmp    bffctl        ; This has to be controlified
  8756. bffqc1: cmp    #del        ; Is the character a del?
  8757.     bne    bffqc2        ; If not, try something else
  8758.     jmp    bffctl        ; Controlify it
  8759. bffqc2: cmp    squote        ; Is it the quote character?
  8760.     bne    bffqc3        ; If not, continue trying
  8761.     jmp    bffstq        ; It was, go stuff a quote in buffer
  8762. bffqc3: lda    ebqmod        ; Is 8-bit quoting turned on?
  8763.     cmp    #on        ;        ...
  8764.     bne    bffstf        ; If not, skip this junk
  8765.     lda    kerchr        ;    otherwise, check for 8-bit quote char.
  8766.     cmp    sebq        ; Is it an 8-bit quote?
  8767.     bne    bffstf        ; Nope, just stuff the character itself
  8768.     jmp    bffstq        ; Go stuff a quote in the buffer
  8769. bffctl: lda    kerchr        ; Get original character back
  8770.     eor    #$40        ; Ctl(AC)
  8771.     sta    kerchr        ; Save the character again
  8772. bffstq: lda    squote        ; Get the quote character
  8773.     ldy    datind        ;    and the index into the buffer
  8774.     sta    (kerbf1),y    ; Store it in the next location
  8775.     iny            ; Up the data index once
  8776.     sty    datind        ; Save the index again
  8777. bffstf: inc    schr        ; Increment the data character count
  8778.     bne    bffsdc        ;        ...
  8779.     inc    schr+1        ;        ...
  8780. bffsdc: lda    kerchr        ; Get the saved character
  8781.     ldy    datind        ;    and the data index
  8782.     sta    (kerbf1),y    ; This is the actual char we must store
  8783.     iny            ; Increment the index
  8784.     sty    datind        ; And resave it
  8785.     tya            ; Take this index, put it in AC
  8786.     clc            ; Clear carry for addition
  8787.     adc    #$06        ; Adjust it so we can see if it
  8788.     cmp    spsiz        ;    is >= spsiz-6
  8789.     bpl    bffret        ; If it is, go return
  8790.     jmp    bufil1        ; Otherwise, go get more characters
  8791. bffret: lda    datind        ; Get the index, that will be the size
  8792.     rts            ; Return with the buffer size in AC
  8793. bffchk:    lda    datind        ;[21] Get the data index
  8794.     cmp    #$00        ;[21] Is it zero?
  8795.     bne    bffne        ;[21] Nope, just return
  8796.     tay            ;[21] Yes, this means the entire file has
  8797.     lda    #true        ;     been transmitted so turn on
  8798.     sta    eofinp        ;    the eofinp flag
  8799.     tya            ;[21] Get back the size of zero
  8800. bffne:  rts            ; Return
  8801.  
  8802. ;
  8803. ;    Bufemp - takes a full data buffer, handles all quoting transforms
  8804. ;    and writes the reconstructed data out to the file using calls to
  8805. ;    FPUTC.
  8806. ;
  8807.  
  8808. bufemp: lda    #$00        ; Zero
  8809.     sta    datind        ;    the data index
  8810. bfetol: lda    datind        ; Get the data index
  8811.     cmp    pdlen        ; Is it >= the packet data length?
  8812.     bmi    bfemor        ; No, there is more to come
  8813.     rts            ; Yes, we emptied the buffer, return
  8814. bfemor: lda    #false        ; Reset the H.O.-bit-on flag to false
  8815.     sta    chebo        ;        ...
  8816.     ldy    datind        ; Get the current buffer index
  8817.     lda    (kerbf1),y    ; Fetch the character in that position
  8818.     sta    kerchr        ; Save it for the moment
  8819.     cmp    rebq        ; Is it the 8-bit quote?
  8820.     bne    bfeqc        ; No, go check for normal quoting
  8821.     lda    ebqmod        ; Is 8-bit quoting on?
  8822.     cmp    #on        ;        ...
  8823.     bne    bfeout        ; No quoting at all, place char in file
  8824.     lda    #true        ; Set H.O.-bit-on flag to true
  8825.     sta    chebo        ;        ...
  8826.     inc    datind        ; Increment the data index
  8827.     ldy    datind        ; Fetch it into Y
  8828.     lda    (kerbf1),y    ; Get the next character from buffer
  8829.     sta    kerchr        ; Save it
  8830. bfeqc:  cmp    rquote        ; Is it the normal quote character
  8831.     bne    bfeceb        ; No, pass this stuff up
  8832.     inc    datind        ; Increment the data index
  8833.     ldy    datind        ;    and fetch it in the Y-reg
  8834.     lda    (kerbf1),y    ; Get the next character from buffer
  8835.     sta    kerchr        ; Save it
  8836.     and    #$7f        ; Check only 7 bits for quote
  8837.     cmp    rquote        ; Were we quoting a quote?
  8838.     beq    bfeceb        ; Yes, nothing has to be done
  8839.     cmp    rebq        ; Check for eight-bit quote char as well
  8840.     beq    bfeceb        ; Skip the character adjustment
  8841.     lda    kerchr        ; Fetch back the original character
  8842.     eor    #$40        ; No, so controlify this again
  8843.     sta    kerchr        ; Resave it
  8844. bfeceb: lda    chebo        ; Is the H.O.-bit-on flag lit?
  8845.     cmp    #true        ;        ...
  8846.     bne    bfeout        ; Just output the character to the file
  8847.     lda    kerchr        ; Fetch the character
  8848.     ora    #$80        ; Light up the H.O. bit
  8849.     sta    kerchr        ; Resave it
  8850. bfeout: lda    filmod        ; Check if this is a text file
  8851.     cmp    #3        ;[DD] Filmod = 3 ?
  8852.     beq    bfefpc        ; If not, continue normal processing
  8853.     lda    kerchr        ; Get a copy of the character
  8854.     and    #$7f        ; Make sure we test L.O. 7-bits only
  8855.     tax            ;[31] Put a copy in X
  8856.     cmp    #cr        ; Do we have a <cr>?
  8857.     bne    bfeclf        ; No, then check for <lf>
  8858.     lda    #on        ; Yes, set the 'Delete <lf>' flag
  8859.     sta    dellf        ;        ...
  8860.     jmp    bfefpc        ; And then continue
  8861. bfeclf: cmp    #lf        ; Do we have a <lf>?
  8862.     bne    bfenlf        ; Nope, We must go shut the Dellf flag.
  8863.     lda    dellf        ; We have a <lf>, is the flag on?
  8864.     cmp    #on        ;        ...
  8865.     bne    bfefpc        ; If not, continue normally
  8866.     lda    #off        ; Flag is on, <lf> follows <cr>, ignore it
  8867.     sta    dellf        ; Start by zeroing flag
  8868.     jmp    bfeou1        ; Now go to end of loop
  8869. bfenlf: lda    #off        ; Zero Dellf
  8870.     sta    dellf        ;        ...
  8871. bfefpc: lda    filmod        ;[DD] Get file type 
  8872.     cmp    #1        ;[DD] Check PETASCI
  8873.     bne    bfefp2        ;[DD]
  8874.     lda    as2pt,x        ;[31] Get ASCII equivalent
  8875.     sta    kerchr        ;[31]
  8876.     jmp    bfefp4        ;[DD]
  8877. bfefp2: cmp    #2        ;[DD] Check Speedscript
  8878.     bne    bfefp3        ;[DD]
  8879.     jsr    cva2s        ;[DD] Convert ASCII to Speedscript
  8880.     jmp    bfefp4
  8881. bfefp3:    cmp    #4        ; check for c-power
  8882.     bne    bfefp4
  8883.     lda    #$a4        ; $a4 is an underbar
  8884.     cpx    #'_
  8885.     beq    bfefp3a
  8886.     lda    #$af        ; $af is a tilde
  8887.     cpx    #'~
  8888.     beq    bfefp3a
  8889.     lda    #$df        ; $df is a pipe
  8890.     cpx    #'|
  8891.     beq    bfefp3a
  8892.     lda    as2pt,x        ; when all else fails, use as2pt table
  8893. bfefp3a:sta    kerchr
  8894. bfefp4: lda    kerchr        ; Get the character once more
  8895.     jsr    fputc        ; Go write it to the file
  8896.      jmp    bfeerr        ; Check out the error
  8897.     inc    rchr        ; Increment the 'data characters receive' count
  8898.     bne    bfeou1        ;        ...
  8899.     inc    rchr+1        ;        ...
  8900. bfeou1: inc    datind        ; Up the buffer index once
  8901.     jmp    bfetol        ; Return to the top of the loop
  8902.  
  8903. bfeerr: sta    errcod        ; Store the error code where it belongs
  8904.     and    #$7f        ; Shut off H.O. bit
  8905.     lda    #false        ; Indicate failure
  8906.     rts            ;    and return
  8907.  
  8908. ;
  8909. ;    Getnfl - returns the next filename to be transferred. Currently
  8910. ;    it always return Eof to indicate there are no other files to
  8911. ;    process.
  8912. ;
  8913.  
  8914. getnfl: lda    #eof        ; No more files (return eof)
  8915.     rts
  8916.  
  8917. ;
  8918. ;    Getfil - gets the filename from the receive command if one was
  8919. ;    parsed. Otherwise, it returns the name in the file header packet.
  8920. ;
  8921.  
  8922. getfil: lda    usehdr        ; Get the use-header switch
  8923.     cmp    #on        ; Is it on
  8924.     bne    getfl1        ; If not, keep what we have in the fcb
  8925.     jsr    clrfcb        ;        ...
  8926.     ldy    #$00        ; Initialize the y reg
  8927. ;    lda    pdlen        ; Copy the packet data length
  8928. ;    sec            ; Now subtract off the overhead
  8929. ;    sbc    #$03        ;        ...
  8930. ;    sta    kwrk02        ;    into a work area
  8931. getfl0: lda    (kerbf1),y    ; Get a character from the packet buffer
  8932.     sta    fcb1,y        ; Stuff it in the fcb
  8933.     iny            ; Up the index once
  8934.     cpy    pdlen        ; Are we finished?
  8935.     bmi    getfl0        ; Nope, go do next byte
  8936. ;    lda    #0        ;
  8937. ;    sta    fcb1,y        ; Nul at end
  8938. getfl1: rts
  8939.  
  8940.  
  8941. ;
  8942. ;    Fgetc - returns the next character from the file in the AC. It
  8943. ;    handles all of the low level disk I/O. Whenever it successfully
  8944. ;    gets a character, it skips on return. If it does not get a
  8945. ;    character, it doesn't skip.
  8946. ;
  8947.  
  8948. fgetc:    lda    eodind        ;[DD] Check end-of-data flag
  8949.     cmp    #off        ;[21] Is it on?
  8950.     beq    fgtc2a        ;[DD][21] No, get next character
  8951.     jmp    fgteof        ;[21] Yes, no data to read
  8952. fgtc2a:    ldx    #8        ;[DD] No, change input channel
  8953.     jsr    chkin        ;[DD]    to disk
  8954.     jsr    getin          ;[DD] Get a char
  8955.     pha            ;[DD] Save it
  8956.     jsr    readst         ;[DD] Get status
  8957.     sta    eodind         ;[DD] Save eof stat for next time
  8958.     cmp    #$00          ;[DD] If 0 then ok
  8959.     beq    fgtgnc        ; Return
  8960.     jsr    closef        ;[DD] Eof so close but return
  8961. fgtgnc:    pla            ; Get back character
  8962. fgtgn1:    ldx    fbsize        ; Get the file-byte-size
  8963.     cpx    #fbsbit        ; Is it seven-bit?
  8964.     bne    fgtexi        ; If not, leave with character intact
  8965.     and    #$7f        ; Shut off the H.O. byte
  8966. fgtexi:    jmp    rskp          ; Return skip
  8967. fgteof:    lda    #$00        ; Return null
  8968.     rts            ;        ... 
  8969. fgtcan: jmp    fatal         ; Just go give an error
  8970.  
  8971. ;
  8972. ;
  8973. ;    Fputc - takes a character passed to it in the AC and writes it
  8974. ;    to the file being transferred in.
  8975. ;
  8976.  
  8977. fputc:    pha             ;[DD] Save it
  8978.     ldx    #8        ;[DD] Change output channel
  8979.     jsr    chkout        ;[DD]    to disk
  8980.     pla              ;[DD] Get it back
  8981.     jsr    chrout        ;[DD] Write it to disk
  8982.     jsr    readst        ;[DD] Check for errors
  8983.     cmp    #00        ;[DD] Do we really need this?
  8984.     beq    fputex        ;[DD] No error
  8985.     sta    errcod      ;[DD] If error
  8986.     ldx    #erms0a\    ;[DD] Get the address of the error message
  8987.     ldy    #erms0a^    ;[DD]        ...
  8988.     jsr    prstr       ;[DD] Print message
  8989.     lda    errcod        ;[DD]     and status
  8990.     jsr    prbyte      ;[DD]        ...
  8991.     jmp    fatal        ;[DD] Blow up
  8992. fputex: lda    #00        ; Return null
  8993.     jmp    rskp          ;     with a skip!
  8994.  
  8995. ; Check disk status
  8996.  
  8997. rddsk:    ldx    #15        ;[DD] Change Kernel input channel
  8998.     jsr    chkin        ;[DD]  to disk error channel
  8999.     ldy    #0        ;[DD]
  9000. rdds1:    jsr    getin        ;[DD] Get a character
  9001.     cmp    #cr        ;[DD] Is it a <cr> ?
  9002.     beq    rdds2        ;[DD] Yes, we are done
  9003.     sta    dskers,y    ;[DD] Store it
  9004.     iny            ;[DD] Increment the index
  9005.     bne    rdds1        ;[DD] Loop for more
  9006. rdds2:    lda    #0        ;[DD] Stuff a null at the end
  9007.     sta    dskers,y    ;[DD]        ...
  9008.     lda     dskers         ;[DD] Get 1st digit
  9009.     sec            ;[DD] Convert to bcd
  9010.     sbc    #$30         ;[DD]        ...
  9011.     sta    fmrcod        ;[DD]
  9012.     asl    a         ;[DD] *2
  9013.     asl    a         ;[DD] *4
  9014.     asl     a        ;[DD] *8
  9015.     asl    a          ;[DD] *16
  9016.     sta    fmrcod        ;[DD]
  9017.     beq    rddex        ;[DD] If first digit is zero exit
  9018.     lda    dskers+1     ;[DD] Get 2n digit
  9019.     sec            ;[DD] Convert to binary
  9020.     sbc    #$30        ;[DD]        ...
  9021.     clc            ;[DD]        ...
  9022.     adc    fmrcod        ;[DD]
  9023.     sta    fmrcod        ;[DD]
  9024.     beq    rddex        ;[DD] If error = 0 exit
  9025.     ldx    #dskers\    ;[DD] Get the address of the disk
  9026.     ldy    #dskers^    ;[DD]   error message
  9027.     jsr    prstr        ;[DD] Print it
  9028.     lda    fmrcod        ;[DD] 
  9029.     ora    #$80        ;[DD] Set high hbit
  9030. rddex:    sta     errcod        ;[DD]
  9031.     jsr    clrchn        ; turn off disk drive
  9032.     lda    errcod
  9033.     rts            ;[DD] Return
  9034.  
  9035.  
  9036. .SBTTL    Save and Restore Parameters
  9037.  
  9038. ;    The following routines will save and restore kermit 
  9039. ;    parameters in a file named 'KERMIT.INI'. Eventually 
  9040. ;    will add ability to specify file for save/restore.
  9041. ;
  9042.  
  9043. ;
  9044. ;    Savst - Save parameters
  9045. ;
  9046. ;    Registers Destroyed: A,X,Y
  9047. ;
  9048.  
  9049. savst:    jsr    prcfm        ;[47] Parse and print a confirm
  9050.     lda    #fncwrt        ;[47]
  9051.     ldy    #$0d        ;[47]
  9052.     sta    inifil,y    ;[47]
  9053.     iny            ;[47]
  9054.     sty    len        ;[47]
  9055. ;     openm    #8,#8,#8,inifil,len    ;[47]
  9056.     lda    #8        ; [53]
  9057.     ldx    #8
  9058.     ldy    #8
  9059.     jsr    setlfs
  9060.     ldx    #inifil\
  9061.     ldy    #inifil^
  9062.     lda    len
  9063.     jsr    setnam
  9064.     jsr    open
  9065.  
  9066.     ldx    #8        ;[47]
  9067.     jsr    chkout        ;[47]
  9068.     ldy    #0        ;[47] Start with the escape character
  9069. savlop:    lda    escp,y        ;[47]        ...
  9070.     jsr    chrout        ;[47] Write it to disk
  9071.     iny            ;[47]
  9072.     cpy    #bordclr+1-escp    ;[47] Are we at the end?
  9073.     bne    savlop        ;[47] No, do the next parameter
  9074.     jsr    readst        ;[47] Get the drive status
  9075.     bne    saverr        ;[47] We got an error
  9076.     lda    #8        ;[47] OK, close the file when done
  9077.     jsr    close        ;[47]        ...
  9078.     jmp    kermit        ;[47]    and parse for more commands
  9079. saverr:    lda    #8        ;[47] OK, close the file when done
  9080.     jsr    close        ;[47]        ...
  9081.     jmp    kermit        ;[47]    and parse for more commands
  9082.  
  9083. ;
  9084. ;    Restst - Restore parameters
  9085. ;
  9086.  
  9087. restst:    jsr    prcfm        ;[47] Parse and print a confirm
  9088.     jsr    scrext        ; exit the old screen driver
  9089.     jsr    restin        ;[47] Go restore the parameters
  9090.     jmp    kermit        ;[47] Failed, restart kermit
  9091.  
  9092. restin: lda    #fncrea        ;[47] Get switch for read
  9093.     ldy    #$0d        ;[47] Get index into init filename
  9094.     sta    inifil,y    ;[47] Store the switch there
  9095.     iny            ;[47] Increment the index
  9096.     sty    len        ;[47] Store it 
  9097. ;     openm    #8,#8,#8,inifil,len    ;[47] Open the init file
  9098.     lda    #8        ; [53]
  9099.     ldx    #8
  9100.     ldy    #8
  9101.     jsr    setlfs
  9102.     ldx    #inifil\
  9103.     ldy    #inifil^
  9104.     lda    len
  9105.     jsr    setnam
  9106.     jsr    open
  9107.  
  9108.     jsr    readst        ;[47] 
  9109.     bne    rsterr        ;[47] No, failed - don't restore parameters
  9110.     ldx    #8        ;[47] Change kernel input channel
  9111.     jsr    chkin        ;[47]    to disk
  9112.     ldy    #0        ;[47] Start index at escp
  9113. rstlop:    sty    savey        ;[47] Save the current index
  9114.     jsr    chrin        ;[47] Get a byte from the disk
  9115.     ldy    savey        ;[47] Restore the index
  9116.     sta    escp,y        ;[47] Store the character away
  9117.     iny            ;[47] Increment the index
  9118.     cpy    #bordclr+1-escp    ;[47] Are we at the end of the parameter list?
  9119.     bne    rstlop        ;[47] No, get next parameter
  9120.     lda    scrtype        ; check if the new screen driver exists
  9121.     jsr    scrtst
  9122.     bcc    rstlop1        ; no it doesnt
  9123. rsterr:    lda    #$01        ; default to 80-columns
  9124.     sta    scrtype
  9125. rstlop1:jsr    scrent        ; initilize the new screen package
  9126.     lda    #8        ;[47] Close the init file
  9127.     jsr    close        ;[47]        ...
  9128.     lda    baud
  9129.     ldy    #$00        ; new value for 300 baud
  9130.     cmp    #$04        ; old value for 300 baud
  9131.     beq    rstlop2
  9132.     iny            ; new value for 1200 baud
  9133.     cmp    #$05        ; old value for 1200 baud
  9134.     beq    rstlop2
  9135.     iny            ; new value for 2400 baud
  9136.     cmp    #$07        ; old value for 2400 baud
  9137.     beq    rstlop2
  9138.     dey            ; default to 1200 baud
  9139.     cmp    #$03        ; not a legit new value -> 1200 baud.
  9140.     bcs    rstlop2
  9141.     tay            ; we have a new value.  Use it.
  9142. rstlop2:sty    baud
  9143.     jsr    dobad
  9144.     rts            ; all done
  9145.  
  9146. inifil:    .byte    "KERMIT.INI,S,W";[47] Name of the init file
  9147.     .byte    nul
  9148.  
  9149. .SBTTL    Utility routines
  9150.  
  9151. ;
  9152. ;    The following routines are short low-level routines which help
  9153. ;    shorten the code and make it more readable
  9154. ;
  9155. ;
  9156. ;    Incn - increment the packet sequence number expected by this
  9157. ;    Kermit. Then take that number Mod $3f.
  9158. ;
  9159.  
  9160. incn:    pha            ; Save AC
  9161.     lda    n        ; Get the packet number
  9162.     clc            ; Clear the carry flag for the add
  9163.     adc    #$01        ; Up the number by one
  9164.     and    #$3f        ; Do this Mod $3f!
  9165.     sta    n        ; Stuff the number where it belongs
  9166.     clc            ; Clear carry again
  9167.     lda    tpak        ; Increment lo byte
  9168.     adc    #$01        ;    total packet count
  9169.     sta    tpak        ;        ...
  9170.     lda    tpak+1        ; Do H.O. byte
  9171.     adc    #$00        ;        ...
  9172.     sta    tpak+1        ;        ...
  9173.     pla            ; Restore the AC
  9174.     rts            ;    and return
  9175.  
  9176. ;
  9177. ;    Prcerp - Process error packet. Moves the Remote Kermit error
  9178. ;    text into a save area, notes that there was an error received
  9179. ;    from the remote Kermit in Errcod (set H.O. bit), and displays
  9180. ;    the text on the screen.
  9181. ;
  9182.  
  9183. prcerp:    lda    ptype        ; Reload the packet type
  9184.     cmp    #'E        ; Is it an error packet?
  9185.     beq    prcer1        ; Yes, continue processing
  9186.     rts            ; No, return
  9187. prcer1:    lda    #pdbuf\        ; Set up from-address
  9188.     sta    kerfrm        ;        ...
  9189.     lda    #pdbuf^        ;        ...
  9190.     sta    kerfrm+1    ;        ...
  9191.     lda    #errrkm\    ; Set up the to-address
  9192.     sta    kerto        ;        ...
  9193.     lda    #errrkm^    ;        ...
  9194.     sta    kerto+1        ;        ...
  9195.     ldy    pdlen        ; Get packet data length
  9196.     sty    kwrk01        ; Store for the copy routine
  9197.     lda    #$00        ; Start by storing a null at the end
  9198.     sta    (kerto),y    ;        ...
  9199.     jsr    kercpy        ; Copy the error text
  9200.     lda    errcod        ; Set the bit in the error code
  9201.     ora    #eprflg        ;    saying that the remote Kermit sent us
  9202.     sta    errcod        ;    an error packet.
  9203.     ldx    #errrkm\    ; Finally, display the error packet
  9204.     ldy    #errrkm^    ;        ...
  9205.     jsr    prstr        ; Print string
  9206.     jsr    prcrlf        ; Make it look neat, add a crlf
  9207.     rts            ; Return to caller
  9208.  
  9209. ;
  9210. ;    Gobble - snarfs a line of characters from the port up to
  9211. ;    the receive end-of-line character. If it sees a keyboard
  9212. ;    interupt, it punts and does not skip.
  9213. ;
  9214.  
  9215. gobble:    lda    #$00        ; Zero the index pointing to end of line buffer
  9216.     sta    pdtend        ;        ...
  9217.     sta    ndx        ; Make sure no unwarranted keyboard intrpt
  9218. gobb:    jsr    getc        ; Get a character
  9219.      jmp    gobb2        ; Got a keyboard interupt
  9220.     lda    char        ;[31]
  9221.     cmp    #soh        ; Is it a start-of-header?
  9222.     bne    gobb        ; No, flush until first SOH
  9223.     jmp    gobbst        ; Ok, now we can start
  9224. gobb0:    jsr    getc        ; Get a character
  9225.      jmp    gobb2        ; Got a keyboard interupt
  9226.     lda    char        ;[31]
  9227.     cmp    #soh        ; If this not an SOH
  9228.     bne    gobb1        ;    continue here
  9229.     tax            ; Hold the character here
  9230.     lda    #$00        ; Rezero the index pointing to end of buf
  9231.     sta    pdtend        ;        ...
  9232.     txa            ; Get the SOH back
  9233.     jmp    gobbdb        ; Go stuff the character in the buffer
  9234. gobb1:    cmp    reol        ; Is it the end-of-line character?
  9235.     beq    gobb3        ; Yes, finish up
  9236. gobbst:    ldx    pdtend        ; Get the index we need
  9237. gobbdb:    sta    plnbuf,x    ; Stuff the character at the buffer
  9238.     inc    pdtend        ; Increment the index once
  9239.     jmp    gobb0        ; Loop for another character
  9240. gobb2:    rts            ; Just return, no skip
  9241. gobb3:    ldx    pdtend        ; Get end pointer again
  9242.     sta    plnbuf,x    ; Store the End-of-line before we leave
  9243.     lda    #$00        ; Zero the index, leave eob ptr where it is
  9244.     sta    pdtind        ;        ...
  9245.     jmp    rskp        ; Return with a skip!
  9246.  
  9247. ;
  9248. ;    Getplc - gets a character from the port line buffer and
  9249. ;    returns it. If the buffer is empty, it returns without
  9250. ;    skipping.
  9251. ;
  9252.  
  9253. getplc: ldx    pdtind        ; Get the current index
  9254.     cpx    pdtend        ; Less than the end buffer pointer?
  9255.     bmi    getpl1        ; If so, go return the next character
  9256.     rts            ; Return without a skip
  9257. getpl1: lda    plnbuf,x    ; Get the next character from the buffer
  9258.     inc    pdtind        ; Up the index once
  9259.     jmp    rskp        ; Return with a skip!
  9260.  
  9261. ;
  9262. ;
  9263. ;    Putplc - puts a character to the port line buffer.
  9264. ;
  9265.  
  9266. putplc: ldx    pdtind        ; Get the current index
  9267.     inx            ; Check if we are at end of buffer
  9268.     bne    putpl1        ; No, continue
  9269.     rts            ; Return without a skip
  9270. putpl1: dex            ; Set index back to what it was
  9271.     sta    plnbuf,x    ; Get the next character from the buffer
  9272.     inc    pdtind        ; Up the index once
  9273.     rts            ; Return
  9274.  
  9275. ;
  9276. ;    Getc - skip returns with a character from the port or does
  9277. ;    a normal return if a key from the keyboard is received first.
  9278. ;    If it skips, the character from the port is returned in the
  9279. ;    AC.
  9280. ;
  9281.  
  9282. getc:    jsr    keyscn        ; Try and get a keyboard character
  9283.     bne    getcy        ;[] Got one
  9284.     jmp    getc1        ;[] None available, try port
  9285. getcy:    cmp    #ctrlx        ;[43] Was it an 'abort current file' interrupt?
  9286.     beq    getc3        ; Yes
  9287. getc2:    cmp    #ctrly        ;[43] Was it 'abort file group' interrupt ?
  9288.     bne    getc0        ;[43] Nope, continue
  9289. getc3:    lda    #$08        ; Error code for 'file trans abort'
  9290.     sta    errcod        ; Stuff it here
  9291.     jsr    closef        ;[28] Close the current file
  9292. abo0:    lda    #$00        ;[43] Send a 'Z' packet with a 'D' field
  9293.     sta    numtry        ;[43]
  9294.     sta    tpak        ;[43]
  9295.     sta    tpak+1        ;[43]
  9296.     lda    #pdbuf\        ;[43] Get the address of the packet buffer
  9297.     sta    kerbf1        ;[43]   and save it for Spak
  9298.     lda    #pdbuf^        ;[43]        ...
  9299.     sta    kerbf1+1    ;[43]        ...
  9300. abo1:    lda    numtry        ;[43] Fetch the number of tries
  9301.     cmp    maxtry        ;[43] Have we exceeded Maxtry?
  9302.     bmi    abo3        ;[43] Not yet, go send the packet
  9303. abo2:    ldx    #ermesc\    ;[43] Yes, give an error message
  9304.     ldy    #ermesc^    ;[43]        ...
  9305.     jsr    prstr        ;[43]        ...
  9306.     jsr    prcrlf        ;[43]        ...
  9307.     jmp    abo4        ;[43]    and restart kermit
  9308. abo3:    inc    numtry        ;[43] Increment the number of tries for packet
  9309.     lda    #$00        ;[43] Make it packet number 0
  9310.     sta    pnum        ;[43]        ...
  9311.     lda    #$01        ;[43] Data length is only 1
  9312.     sta    pdlen        ;[43]        ...
  9313.     lda    #'D        ;[43] The 'Discard' command
  9314.     sta    pdbuf        ;[43] Put that in first character of buffer
  9315.     lda    #'Z        ;[43] EOF command packet type
  9316.     sta    ptype        ;[43]        ...
  9317.     jsr    flshin        ;[43] Flush the RS232 buffer
  9318.     jsr    spak        ;[43] Send the packet
  9319.     ;jsr    rpak        ;[43] Try to fetch an ACK
  9320.     ;cmp    #true        ;[43] Did we receive successfully?
  9321.     ;bne    abo1        ;[43] No, try to send the packet again
  9322.     ;lda    ptype        ;[43] Get the type
  9323.     ;cmp    #'Y        ;[43] An ACK?
  9324.     ;bne    aboce        ;[43] No, go check for error
  9325.     jmp    abo4        ;[43] Yes, restart Kermit
  9326. aboce:    ;cmp    #'E        ;[43] Error packet?
  9327.     ;bne    abo1        ;[43] Nope, resend packet
  9328.     ;jsr    prcerp        ;[43] Go display the error
  9329.  
  9330. abo4:    ldx    kerosp        ; Get the old stack pointer back
  9331.     txs            ; Restore it
  9332.     jmp    kermit        ; Warmstart kermit
  9333.  
  9334. getc0:  lda    #$00        ;[EL] And reset the strobe
  9335.     sta    ndx        ;[EL]        ...
  9336.     rts            ; Keyboard interupt, return
  9337. getc1:    jsr    scrbel        ; time to stop the beep?  (after parity err)
  9338.     jsr    timout        ;[49] Have we timed out?
  9339.      jmp    getc0        ;[49] Yes return
  9340.     jsr    getrs        ; No, Check the port
  9341.     beq    getcn        ;[] Got a character
  9342.     jmp    getc        ;[] No char, go back to top of loop
  9343. getcn:    lda    char        ;[31] Get the character read
  9344.     jmp    rskp        ;    and return skip!
  9345.  
  9346. ;
  9347. ;    Prson - parses an 'on' or an 'off' keyword and passes
  9348. ;    the result back to the calling routine in the x-index
  9349. ;    register. If there is an error, it pops the return
  9350. ;    address off the stack and transfers control to kermt2
  9351. ;    to issue the error message.
  9352. ;
  9353.  
  9354. prson:  lda    #oncmd\        ; Command table address
  9355.     sta    cminf1        ;        ...
  9356.     lda    #oncmd^        ;        ...
  9357.     sta    cminf1+1    ;        ...
  9358.     lda    #shon\        ; Set up default string for parse
  9359.     sta    cmdptr        ;        ...
  9360.     lda    #shon^        ;        ...
  9361.     sta    cmdptr+1    ;        ...
  9362.     ldy    #cmfdff        ; Show there is a default
  9363.     lda    #cmkey        ; Code for keyword
  9364.     jsr    comnd        ; Go do it
  9365.      rts            ; The command was not recognized
  9366.      nop
  9367.      nop
  9368.     jmp    rskp        ; Good, skip return
  9369.  
  9370. ;
  9371. ;    prcfm - parses for a confirm, then transfers control directly
  9372. ;    to the top of the main loop
  9373. ;
  9374.  
  9375. prcfm:  lda    #cmcfm        ; Load token for confirm
  9376.     jsr    comnd        ; Parse a confirm
  9377.      jmp    kermt3        ; No confirm, give an error
  9378.     lda    #cr        ; Print a crlf
  9379.     jsr    cout        ;        ...
  9380.     rts            ; Return
  9381.  
  9382. ;
  9383. ;    Pron - checks the value in the AC and prints either 'ON' or
  9384. ;    'OFF'. (on=1, off=0).
  9385. ;
  9386.  
  9387. pron:    cmp    #on        ; Should we print 'on'?
  9388.     bne    pron1        ; No, go print 'off'
  9389.     ldx    #shon\        ; Point to the 'on' string
  9390.     ldy    #shon^        ;        ...
  9391. pron0:  jsr    prstr        ; Print it
  9392.     jsr    prcrlf        ; Add a crelf at the end
  9393.     rts            ; And return
  9394. pron1:  ldx    #shoff\        ; Point to the 'off' string
  9395.     ldy    #shoff^        ;        ...
  9396.     jmp    pron0        ; Go print it
  9397.  
  9398. ;
  9399. ;    Nonftl - handles non-fatal DOS errors. When Kermit does its
  9400. ;    initialization it points the error vector and the basic
  9401. ;    warmstart vector here.
  9402. ;
  9403.  
  9404. nonftl: lda    fmrcod        ; Get the DOS return code
  9405.     ora    #$80        ;        ...
  9406.     sta    errcod        ; Save that here
  9407.     ldx    kerosp        ; Get the old stack pointer back
  9408.     txs            ; Restore it
  9409.     jmp    kermit        ; Warmstart kermit
  9410.  
  9411. ;
  9412. ;    Fatal - closes and deletes a file on which a bad error
  9413. ;    has occured (most likely a 'disk full' error). It then
  9414. ;    restores the old stack pointer and warmstarts Kermit.
  9415. ;
  9416.  
  9417. fatal:    lda    fmrcod        ; Get the DOS return code
  9418.     ora    #$80        ; Set H.O. bit to indicate DOS error
  9419.     sta    errcod        ; Store the error code
  9420.     jsr    closef        ; Close the file
  9421. ;    jsr    dosdel        ; Now, delete the useless file
  9422.     ldx    kerosp        ; Get the old stack pointer
  9423.     txs            ; Restore it
  9424.     jmp    kermit        ; Warmstart kermit
  9425.  
  9426. ;
  9427. ;    Clrfcb - clears the area FCB1 so the filename placed there
  9428. ;    will not be corrupted.
  9429. ;
  9430.  
  9431. clrfcb:    ldx    #mxfnl        ; Load max filename length
  9432.     lda    #space        ; We will be filling with spaces
  9433. clrfc1:    sta    fcb1,x        ; Stuff the space
  9434.     dex            ; Decrement our pointer
  9435.     bpl    clrfc1        ; Not done, go back
  9436.     rts            ; Return
  9437.  
  9438. ;
  9439. ;    Clrbuf - clears the area BUFF so the disk string placed there
  9440. ;    will not be corrupted
  9441. ;
  9442.  
  9443. clrbuf:    ldx    #$2e        ;[40]
  9444.     lda    #space        ;[40]
  9445. clrbf1:    sta    buff,x        ;[40]
  9446.     dex            ;[40]
  9447.     bpl    clrbf1        ;[40]
  9448.     rts            ;[40]
  9449.  
  9450. ;
  9451. ;    Kercpy - copies the string pointed to by Kerfrm to the
  9452. ;    block of memory pointed to by Kerto for Kwrk01 characters.
  9453. ;
  9454.  
  9455. kercpy:    ldy    kwrk01        ; Get the length of the string
  9456. kerclp:    dey            ; One character less
  9457.     bmi    kercrt        ; If this went negative, we're done
  9458.     lda    (kerfrm),y    ; Get the next character
  9459.     sta    (kerto),y    ; And put it where it belongs
  9460.     jmp    kerclp        ; Go back for next char
  9461. kercrt:    rts            ; Job is done, return
  9462.  
  9463. ;
  9464. ;    Kerflm - fills the buffer pointed to by Kerto with the
  9465. ;    character in kwrk02 for Kwrk01 characters.
  9466. ;
  9467.  
  9468. kerflm:    ldy    kwrk01        ; Get the length of the string
  9469. kerflp:    dey            ; One character less
  9470.     bmi    kerflr        ; If this went negative, we're done
  9471.     lda    kwrk02        ; Get the fill character
  9472.     sta    (kerto),y    ; And put it in the next position
  9473.     jmp    kerflp        ; Go back to do next char
  9474. kerflr:    rts            ; Job is done, return
  9475.  
  9476. ;
  9477. ;    Prchr - takes a character from the AC and prints it. It
  9478. ;    echos control characters as '^<chr>' and escape as '$'.
  9479. ;
  9480.  
  9481. prchr:  and    #$7f        ; Make sure it's in range
  9482.     cmp    #$20        ; Less than escape??
  9483.     bpl    prchr1        ; If not, continue
  9484.     pha            ; Hold the character
  9485.     lda    #'^        ; Load the up-arrow for cntrl characters
  9486.     jsr    cout        ; Print the character
  9487.     pla            ; Get the character back
  9488.     clc            ; Clear carry for add
  9489.     adc    #$40        ; Put this in the alphabetic range
  9490. prchr1: jsr    cout        ;    and print it
  9491.     rts            ; Done, go back
  9492.  
  9493. ;
  9494. ;    Genmad - takes a message base, offset and size and calculates
  9495. ;    the address of the message leaving it in the X and Y registers
  9496. ;    ready for a call to PRSTR. The size and offset are taken from
  9497. ;    the stack and the base address is found in kermbs.
  9498. ;
  9499.  
  9500. genmad: pla            ; Get return address
  9501.     sta    kerrta        ;    and save it till later
  9502.     pla            ;
  9503.     sta    kerrta+1    ;
  9504.     pla            ; Get message offset
  9505.     tax            ; Hold it here for a while
  9506.     pla            ; Get the message length
  9507.     tay            ;    and put it here
  9508.     lda    #$00        ; H.O. byte of message offset for mul16
  9509.     pha            ;
  9510.     txa            ; L.O. byte of message offset
  9511.     pha            ;
  9512.     lda    #$00        ; H.O. byte of message size for mul16
  9513.     pha            ;
  9514.     tya            ; L.O. byte of message size
  9515.     pha            ;
  9516.     jsr    mul16        ; Calculate the actual offset in table
  9517.     pla            ; Get L.O. byte of result
  9518.     clc            ; Clear the carry for addition
  9519.     adc    kermbs        ; Add the L.O. byte of the base address
  9520.     tax            ; Put it in X for the return
  9521.     pla            ; Get the H.O. byte
  9522.     adc    kermbs+1    ; Add the H.O. byte of the base address w/carry
  9523.     tay            ; Stuff it here for the return
  9524.     lda    kerrta+1    ; Replace the return address on the stack
  9525.     pha            ;        ...
  9526.     lda    kerrta        ;        ...
  9527.     pha            ;        ...
  9528.     rts            ; Return
  9529.  
  9530.  
  9531. .SBTTL     Video Support Routines
  9532.  
  9533. ;
  9534. ;    Prttab - Go to next tab stop
  9535. ;
  9536.  
  9537. prttab:    ldx    cx        ; get the cursor x position
  9538. prttab1:inx            ; move cursor let
  9539.     jsr    scrrgh        ; do not allow the cursor past the right margin
  9540.     bcs    prttab2        ; if past right margin, goto next line
  9541.     lda    tabs,x        ; see if tab stop here
  9542.     bne    prttab1        ; if zero, there is a tabstop here
  9543.     ldy    cy        ; get the cursor y position
  9544.     jsr    scrplt        ; plot the new cursor position
  9545.     rts            ; all done
  9546. prttab2:jsr    scrlf        ; goto the next line if past right margin
  9547.     jsr    scrcr        ; goto the leftmost column
  9548.     rts            ; all done
  9549.  
  9550. ;
  9551. ;    Ploth - Plot the cursor position
  9552. ;
  9553. ;    Input: Carry set to read cursor position
  9554. ;           X-reg cursor y position            (if carry is set)
  9555. ;           Y-reg curosr x position            (if carry is set)
  9556. ;
  9557. ;    Output:X-reg is cursor y position        (if carry is clear)
  9558. ;           Y-reg is cursor x position        (if carry is clear)
  9559. ;
  9560. ;    Registers Destroyed:  None            (if carry is set)
  9561. ;
  9562.  
  9563. ploth:    bcc    ploth1
  9564.     ldx    cy
  9565.     ldy    cx
  9566.     rts
  9567.  
  9568. ploth1:    tya            ; swap a-reg and x-reg
  9569.     pha
  9570.     txa
  9571.     tay
  9572.     pla
  9573.     tax
  9574.     jsr    scrplt
  9575.     rts
  9576.  
  9577. ;    Print (X) spaces
  9578.  
  9579. prbl2:  stx    savex        ;[DD] Save X
  9580.     lda    #sp        ;[DD] Get a space
  9581.     jsr    cout        ;[DD] Print it
  9582.     ldx    savex        ;[DD] Get back X
  9583.     dex            ;[DD] Decrement it
  9584.     bne    prbl2        ;[DD] If not 0, do more
  9585.     rts            ;[DD] Return
  9586.  
  9587. ; Print a reg as 2 hex nibbles
  9588.  
  9589. prbyte:             ;[DD] Output byte in hex
  9590. by2hx:  pha            ;[DD] Save byte
  9591.     lsr    a        ;[DD]
  9592.     lsr    a        ;[DD]
  9593.     lsr    a        ;[DD]
  9594.     lsr    a        ;[DD]
  9595.     jsr    ny2hx             ;[DD] High nyble
  9596.     tax                 ;[DD] to x
  9597.     pla                 ;[DD] Get back
  9598.     and    #$0f             ;[DD] Low nyble
  9599.     jsr    ny2hx        ;[DD] Translate to Hex
  9600.     pha            ;[DD] Save low nyble
  9601.     txa            ;[DD] Get high nyble
  9602.     jsr    cout        ;[DD] Print it
  9603.     pla            ;[DD] Get back low nyble
  9604.     jmp    cout        ;[DD] Print and return
  9605.  
  9606. ; Translate nyble to hex
  9607.  
  9608. ny2hx:    clc            ;[DD]
  9609.     adc    #$f6        ;[DD]
  9610.     bcc    ny2h2        ;[DD]
  9611.     adc    #$06        ;[DD]
  9612. ny2h2:  adc    #$3a        ;[DD]
  9613.     rts            ;[DD]
  9614.  
  9615. ; Print hex of A,X
  9616.  
  9617. prntax: stx    savex        ;[DD] Save X
  9618.     jsr    prbyte        ;[DD] Print A first
  9619.     lda    savex        ;[DD] Get X into A
  9620.     jsr    prbyte        ;[DD] Print that next
  9621.     rts            ;[DD] Return
  9622.  
  9623. ;    Prntad - Print a number in base 10.  Leading zeros are skipped.
  9624. ;
  9625. ;    Input: A,X - Number to be printed
  9626. ;
  9627. ;    Registers Destroyed:    A,X,Y
  9628. ;
  9629. ;    This routine works by repeated subtraction.  10^X is subtracted
  9630. ;    until the result would be negative.  After each subtraction, Y
  9631. ;    is incremented. Y starts out at '0.  Thus, Y is the ascii value
  9632. ;    of the next digit.
  9633.  
  9634. prntad:    stx    decnum        ; [54] Save the number to print
  9635.     sta    decnum+1    ; [54]
  9636.  
  9637.     ldx    #4        ; [54] Up to 5 digits (0..4)
  9638. prntad1:lda    decnum        ; [54] Compare with 10^x
  9639.     cmp    tens1,x        ; [54]
  9640.     lda    decnum+1    ; [54]
  9641.     sbc    tens2,x        ; [54]
  9642.     bcs    prntad2        ; [54] If greater, found first nonzero digit
  9643.     dex            ; [54] Skip the leading zero
  9644.     bne    prntad1        ; [54] Go test the next digit, unless last
  9645.  
  9646. prntad2:ldy    #'0        ; [54] Y is the ascii value to print
  9647. prntad3:lda    decnum        ; [54] Compare with 10^x
  9648.     cmp    tens1,x        ; [54]
  9649.     lda    decnum+1    ; [54]
  9650.     sbc    tens2,x        ; [54]
  9651.     bcc    prntad4        ; [54] Result would be negative.
  9652.  
  9653.     lda    decnum        ; [54] Now subtract 10^x
  9654.     sbc    tens1,x        ; [54] carry is already set
  9655.     sta    decnum        ; [54]
  9656.     lda    decnum+1    ; [54]
  9657.     sbc    tens2,x        ; [54]
  9658.     sta    decnum+1    ; [54]
  9659.     iny            ; [54] Keep track of the value of this digit
  9660.     bne    prntad3        ; [54] Always taken
  9661.  
  9662. prntad4:txa            ; [54] Save X
  9663.     pha            ; [54]
  9664.     tya            ; [54] Print the character in Y
  9665.     jsr    cout        ; [54]
  9666.     pla            ; [54] Restore X
  9667.     tax            ; [54]
  9668.     dex            ; [54] Print the next digit.
  9669.     bpl    prntad2        ; [54]
  9670.     rts
  9671. tens1    .byte    1\,10\,100\,1000\,10000\ ; [54] Powers of ten for prntad
  9672. tens2    .byte    1^,10^,100^,1000^,10000^
  9673.  
  9674. ;
  9675. ;    Cout - Print byte to screen
  9676. ;
  9677. ;    Input:    A - character to be printed
  9678. ;
  9679. ;    Output:
  9680. ;
  9681. ;    Registers Destroyed:    A,X,Y
  9682. ;
  9683.  
  9684. cout:    sta    source        ; Save A-reg
  9685.     pha            ; save A-reg again
  9686.     txa
  9687.     pha            ; save X-reg
  9688.     tya
  9689.     pha            ; save Y-reg
  9690.     lda    source
  9691.     jsr    scrput        ; print the character
  9692.     pla            ; restore Y-reg
  9693.     tay
  9694.     pla            ; restore X-reg
  9695.     tax
  9696.     pla            ; restore A-reg
  9697.     rts
  9698.  
  9699. ;    Rdkey - Read keyboard until a byte appears
  9700. ;
  9701. ;    Input:
  9702. ;
  9703. ;    Output:
  9704. ;
  9705. ;    Registers Destroyed:
  9706. ;
  9707.  
  9708. rdkey:    jsr    keyscn        ;[DD] Try and get a keyboard byte
  9709.     sta    char
  9710.     bne    rdret        ;[DD] None, try again
  9711.     jsr    scrfls        ; flash the cursor
  9712.     jsr    scrbel        ; stop the nasty bell tone after 6 jiffys
  9713.     jmp    rdkey        ;[]
  9714. rdret:    rts            ;[DD]        ...
  9715.  
  9716. ;    Bell - Initiate sounds - will be terminated next cursor blink
  9717. ;
  9718. ;    Input:    None
  9719. ;
  9720. ;    Output: None
  9721. ;
  9722. ;    Registers Destroyed: None
  9723. ;
  9724.  
  9725. bell:    pha            ;[EL] Save the AC
  9726. beephi:    lda    #$50        ;[EL] Select high frequency
  9727.     bne    beep        ;[33]        ...
  9728. beeplo:    pha            ;[33] Save the AC
  9729.     lda    #$14        ;[33] Select low frequency
  9730.  
  9731. beep:    sta    freqhi        ;[EL]        ...
  9732.     lda    #$0f        ;[EL] Select fast attack, slow decay
  9733.     sta    attdec        ;[EL]        ...
  9734.     lda    #$12        ;[EL] Select sustain ...
  9735.     sta    susrel        ;[EL]        ...
  9736.     lda    #6        ;[EL] Select not-too-loud volume
  9737.     sta    vol        ;[EL]        ...
  9738.     lda    #$21        ;[EL] Select sawtooth wave
  9739.     sta    wave        ;[EL]        ...
  9740.     jsr    rdtim        ; remember when the sound started
  9741.     sta    lpcnt        ;[EL]        ...
  9742.     pla            ;[EL] Restore the AC
  9743.     rts            ;[EL] Return
  9744.  
  9745. ;
  9746. ;    keyscn - scan the keyboard
  9747. ;
  9748. ;    Input:    None
  9749. ;
  9750. ;    Output:    zero flag and A reg
  9751. ;
  9752. ;    This routine checks the keyboard.  If a new key is pressed, or if
  9753. ;    it is time for the current key to be repeated, it returns the
  9754. ;    the ascii (not petascii) value of the key, and clears the zero flag.
  9755. ;    If no key is pressed, or if it is not time to repeat the current
  9756. ;    key, it returns zero and sets the zero flag.
  9757. ;
  9758. ;    This routine also returns the row/column of the key pressed in the
  9759. ;    X-reg.  This is used to determine if a new key was pushed.
  9760. ;
  9761.  
  9762. keyscn:    jsr    rdtim        ; only scan once per jiffy (avoid keybounce)
  9763.     cmp    keytime
  9764.     beq    keyscn1        ; not time yet. return
  9765.     sta    keytime
  9766.     jsr    keyscn2        ; scan the keyboard
  9767.     beq    keyscn3        ; if no key pressed, reset repeat counter
  9768.     cpx    keylast
  9769.     bne    keyscn3        ; if new key pressed, reset repeat counter
  9770.     ldy    decarm        ; if keyboard not in automatic repeat mode...
  9771.     beq    keyscn1        ; ... then no key pushed.
  9772.     dec    keyrept        ; if same key pressed, decrement repeat counter
  9773.     bne    keyscn1        ; if not time to repeat yet, return $00
  9774.     ldy    #7        ; repeat every 7 jiffys (after the first rept)
  9775.     .byte    $2c        ; skip the ldy #30
  9776. keyscn3:ldy    #30        ; set the repeat counter to 30 jiffys
  9777.     sty    keyrept
  9778.     stx    keylast        ; remember row/column of last keypress
  9779.     ldx    $d600        ; is this a commodore-128?
  9780.     beq    keyscn0        ; if not, then there is no caps lock key
  9781.     cmp    #'a        ; is this a lower case letter?
  9782.     bcc    keyscn0        ; if not, then caps lock has no effect
  9783.     cmp    #'z+1        ; is this a lower case letter?
  9784.     bcs    keyscn0        ; if not, then caps lock has no effect
  9785.     pha            ; save the letter
  9786.     lda    $01
  9787.     and    #$40
  9788.     cmp    #$40        ; carry clear if and only if caps lock down
  9789.     pla            ; remember the letter
  9790.     bcs    keyscn0
  9791.     adc    #'A-'a        ; make the letter capital (note: carry clear)
  9792. keyscn0:cmp    #$00        ; set zero flag if new key, otherwise clear
  9793.     rts    
  9794. keyscn1:lda    #$00        ; not time to scan keyboard yet. 
  9795.     rts
  9796.  
  9797. keyscn2:sei            ; only one key scanner at once, please
  9798.     ldx    #$ff        ; no keypress detected (yet)
  9799.     lda    #$00        ; check if any key is pressed
  9800.     sta    $dc00
  9801.     sta    $d02f        ; the extra keys on the C128 live here
  9802.     lda    $dc01
  9803.     cmp    #$ff
  9804.     beq    keyscn4        ; no key pressed. Skip excess junk.
  9805.     lda    #$fe        ; start scanning with the first column
  9806.     sta    keycol
  9807.     sta    $dc00
  9808.     lda    #$ff
  9809.     sta    keycol1
  9810.     sta    $d02f
  9811.     ldx    #$00
  9812. keyscn6:lda    $dc01
  9813.     ora    keynon,x    ; cancel out non-characters (shift, control)
  9814.     cmp    #$ff        ; any key pressed in this column?
  9815.     bne    keyscn5        ; nope.  Skip this junk
  9816.     sec            ; check the next column
  9817.     rol    keycol
  9818.     rol    keycol1
  9819.     lda    keycol
  9820.     sta    $dc00
  9821.     lda    keycol1
  9822.     sta    $d02f
  9823.     inx
  9824.     cpx    #11        ; check for 11 different columns
  9825.     bcc    keyscn6
  9826.     ldx    #$ff        ; so '$' works.  (last = 11 if only shift)
  9827.     lda    #$00        ; the key press has gone away during the scan
  9828.     cli            ; re-allow interupts
  9829.     rts
  9830. keyscn5:pha            ; save the row data
  9831.     txa            ; multiply X-reg by 8 (8 rows/column)
  9832.     asl    a
  9833.     asl    a
  9834.     asl    a
  9835.     tax
  9836.     pla            ; remember row data
  9837.     sec            ; make sure carry is always set in keyscn7 loop
  9838.     dex            ; compensate for next inx
  9839. keyscn7:inx            ; inx till grounded row found
  9840.     ror    a
  9841.     bcs    keyscn7
  9842.     lda    #$ff
  9843.     sta    $d02f
  9844.     lda    #%01111111    ; check the ctrl key
  9845.     sta    $dc00
  9846.     lda    $dc01
  9847.     and    #%00000100
  9848.     beq    keyscn8        ; control pushed
  9849.     lda    #%11111101    ; next check the left shift key
  9850.     sta    $dc00
  9851.     lda    $dc01
  9852.     and    #%10000000
  9853.     beq    keyscn9        ; left shift pushed
  9854.     lda    #%10111111    ; next check the right shift key
  9855.     sta    $dc00
  9856.     lda    $dc01
  9857.     and    #%00010000
  9858.     beq    keyscn9        ; right shift pushed
  9859.     lda    keytbl1,x    ; look up ascii value for given row/column
  9860.     cli            ; re-allow interupts
  9861.     rts            ; all done
  9862. keyscn8:lda    keytbl2,x    ; look up ascii value for control + row/column
  9863.     cli            ; re-allow interupts
  9864.     rts            ; all done
  9865. keyscn9:lda    keytbl3,x    ; look up ascii value for shift + row/column
  9866.     cli            ; re-allow interupts
  9867.     rts            ; all done
  9868. keyscn4:lda    #$ff        ; fix things so that the keypad doesn't
  9869.     sta    $d02f        ; interfere with the suspend flag
  9870.     lda    #$00        ; no key pushed anywhere
  9871.     cli            ; re-allow interupts
  9872.     rts
  9873.  
  9874. ;
  9875. ;    keynon - position of non-character keys.
  9876. ;
  9877. ;    This table defines the position of non-character keys.  A
  9878. ;    non-character key is any key that does not return a character.
  9879. ;    Example: Shift, Control, C=.
  9880. ;
  9881.  
  9882. keynon:    .byte    %00000000
  9883.     .byte    %10000000    ; left-shift
  9884.     .byte    %00000000
  9885.     .byte    %00000000
  9886.     .byte    %00000000
  9887.     .byte    %00000000
  9888.     .byte    %00010000    ; right-shift
  9889.     .byte    %00100100    ; unused, control
  9890.     .byte    %00000000    ; <commodore-128 keys start here>
  9891.     .byte    %00000000
  9892.     .byte    %10000001    ; no_scroll, alt
  9893.  
  9894. ;
  9895. ;    keytbl1 - ascii values of characters at given row/column
  9896. ;
  9897. ;    This table is used to translage row/column positions to ascii
  9898. ;    values.  This table is only used if neither the shift or control
  9899. ;    keys is pushed.
  9900. ;
  9901. ;    The following special non-ascii values exist:
  9902. ;
  9903. ;    $80 .. $89        - numeric keypad
  9904. ;    $90 .. $93        - pf keys
  9905. ;    $a0 .. $a3        - cursor keys
  9906. ;    $b0 .. $b7        - programmable function keys
  9907. ;    $c0            - '-' (on the numeric keypad)
  9908. ;    $c1            - '+' (on the numeric keypad)
  9909. ;    $c2            - '.' (on the numeric keypad)
  9910. ;    $c3            - enter (on the numeric keypad)
  9911. ;    $d0            - null (ctrl-@) and (ctrl-space)
  9912. ;    $d1            - break (shift DEL)
  9913. ;
  9914.  
  9915. keytbl1:.byte    $7f        ; row 0, column 0
  9916.     .byte    $0d        ; row 1, column 0
  9917.     .byte    $a2        ; row 2, column 0
  9918.     .byte    $08        ; row 3, column 0    (should be $b6)
  9919.     .byte    '_        ; row 4, column 0    (should be $b0)
  9920.     .byte    '`        ; row 5, column 0    (should be $b2)
  9921.     .byte    '{        ; row 6, column 0    (should be $b4)
  9922.     .byte    $a1        ; row 7, column 0
  9923.     .byte    '3        ; row 0, column 1
  9924.     .byte    'w        ; row 1, column 1
  9925.     .byte    'a        ; row 2, column 1
  9926.     .byte    '4        ; row 3, column 1
  9927.     .byte    'z        ; row 4, column 1
  9928.     .byte    's        ; row 5, column 1
  9929.     .byte    'e        ; row 6, column 1
  9930.     .byte    $00        ; row 7, column 1
  9931.     .byte    '5        ; row 0, column 2
  9932.     .byte    'r        ; row 1, column 2
  9933.     .byte    'd        ; row 2, column 2
  9934.     .byte    '6        ; row 3, column 2
  9935.     .byte    'c        ; row 4, column 2
  9936.     .byte    'f        ; row 5, column 2
  9937.     .byte    't        ; row 6, column 2
  9938.     .byte    'x        ; row 7, column 2
  9939.     .byte    '7        ; row 0, column 3
  9940.     .byte    'y        ; row 1, column 3
  9941.     .byte    'g        ; row 2, column 3
  9942.     .byte    '8        ; row 3, column 3
  9943.     .byte    'b        ; row 4, column 3
  9944.     .byte    'h        ; row 5, column 3
  9945.     .byte    'u        ; row 6, column 3
  9946.     .byte    'v        ; row 7, column 3
  9947.     .byte    '9        ; row 0, column 4
  9948.     .byte    'i        ; row 1, column 4
  9949.     .byte    'j        ; row 2, column 4
  9950.     .byte    '0        ; row 3, column 4
  9951.     .byte    'm        ; row 4, column 4
  9952.     .byte    'k        ; row 5, column 4
  9953.     .byte    'o        ; row 6, column 4
  9954.     .byte    'n        ; row 7, column 4
  9955.     .byte    '+        ; row 0, column 5
  9956.     .byte    'p        ; row 1, column 5
  9957.     .byte    'l        ; row 2, column 5
  9958.     .byte    '-        ; row 3, column 5
  9959.     .byte    '.        ; row 4, column 5
  9960.     .byte    ':        ; row 5, column 5
  9961.     .byte    '@        ; row 6, column 5
  9962.     .byte    ',        ; row 7, column 5
  9963.     .byte    '\        ; row 0, column 6
  9964.     .byte    '*        ; row 1, column 6
  9965.     .byte    ';        ; row 2, column 6
  9966.     .byte    $08        ; row 3, column 6
  9967.     .byte    $00        ; row 4, column 6
  9968.     .byte    '=        ; row 5, column 6
  9969.     .byte    '^        ; row 6, column 6
  9970.     .byte    '/        ; row 7, column 6
  9971.     .byte    '1        ; row 0, column 7
  9972.     .byte    $1b        ; row 1, column 7
  9973.     .byte    $00        ; row 2, column 7
  9974.     .byte    '2        ; row 3, column 7
  9975.     .byte    $20        ; row 4, column 7
  9976.     .byte    $00        ; row 5, column 7
  9977.     .byte    'q        ; row 6, column 7
  9978.     .byte    $03        ; row 7, column 7
  9979.     .byte    '?        ; row 0, column 8
  9980.     .byte    $88        ; row 1, column 8
  9981.     .byte    $85        ; row 2, column 8
  9982.     .byte    $09        ; row 3, column 8
  9983.     .byte    $82        ; row 4, column 8
  9984.     .byte    $84        ; row 5, column 8
  9985.     .byte    $87        ; row 6, column 8
  9986.     .byte    $81        ; row 7, column 8
  9987.     .byte    $1b        ; row 0, column 9
  9988.     .byte    $c1        ; row 1, column 9
  9989.     .byte    $c0        ; row 2, column 9
  9990.     .byte    $0a        ; row 3, column 9
  9991.     .byte    $c3        ; row 4, column 9
  9992.     .byte    $86        ; row 5, column 9
  9993.     .byte    $89        ; row 6, column 9
  9994.     .byte    $83        ; row 7, column 9
  9995.     .byte    $00        ; row 0, column 10
  9996.     .byte    $80        ; row 1, column 10
  9997.     .byte    $c2        ; row 2, column 10
  9998.     .byte    $a0        ; row 3, column 10
  9999.     .byte    $a1        ; row 4, column 10
  10000.     .byte    $a3        ; row 5, column 10
  10001.     .byte    $a2        ; row 6, column 10
  10002.     .byte    $00        ; row 7, column 10
  10003.  
  10004. ;
  10005. ;    keytbl2 - ascii values of characters at given row/column
  10006. ;
  10007. ;    This table is used to translage row/column positions to ascii
  10008. ;    values.  This table is only used if control is pushed
  10009. ;
  10010. ;    The following special non-ascii values exist:
  10011. ;
  10012. ;    $80 .. $89        - numeric keypad
  10013. ;    $90 .. $93        - pf keys
  10014. ;    $a0 .. $a3        - cursor keys
  10015. ;    $b0 .. $b7        - programmable function keys
  10016. ;    $c0            - '-' (on the numeric keypad)
  10017. ;    $c1            - '+' (on the numeric keypad)
  10018. ;    $c2            - '.' (on the numeric keypad)
  10019. ;    $c3            - enter (on the numeric keypad)
  10020. ;    $d0            - null (ctrl-@) and (ctrl-space)
  10021. ;    $d1            - break (shift DEL)
  10022. ;
  10023.  
  10024. keytbl2:.byte    $7f        ; row 0, column 0
  10025.     .byte    $c3        ; row 1, column 0
  10026.     .byte    $a2        ; row 2, column 0
  10027.     .byte    $93        ; row 3, column 0
  10028.     .byte    $90        ; row 4, column 0
  10029.     .byte    $91        ; row 5, column 0
  10030.     .byte    $92        ; row 6, column 0
  10031.     .byte    $a0        ; row 7, column 0
  10032.     .byte    $83        ; row 0, column 1
  10033.     .byte    $17        ; row 1, column 1
  10034.     .byte    $01        ; row 2, column 1
  10035.     .byte    $84        ; row 3, column 1
  10036.     .byte    $1a        ; row 4, column 1
  10037.     .byte    $13        ; row 5, column 1
  10038.     .byte    $05        ; row 6, column 1
  10039.     .byte    $00        ; row 7, column 1
  10040.     .byte    $85        ; row 0, column 2
  10041.     .byte    $12        ; row 1, column 2
  10042.     .byte    $04        ; row 2, column 2
  10043.     .byte    $86        ; row 3, column 2
  10044.     .byte    $03        ; row 4, column 2
  10045.     .byte    $06        ; row 5, column 2
  10046.     .byte    $14        ; row 6, column 2
  10047.     .byte    $18        ; row 7, column 2
  10048.     .byte    $87        ; row 0, column 3
  10049.     .byte    $19        ; row 1, column 3
  10050.     .byte    $07        ; row 2, column 3
  10051.     .byte    $88        ; row 3, column 3
  10052.     .byte    $02        ; row 4, column 3
  10053.     .byte    $08        ; row 5, column 3
  10054.     .byte    $15        ; row 6, column 3
  10055.     .byte    $16        ; row 7, column 3
  10056.     .byte    $89        ; row 0, column 4
  10057.     .byte    $09        ; row 1, column 4
  10058.     .byte    $0a        ; row 2, column 4
  10059.     .byte    $80        ; row 3, column 4
  10060.     .byte    $0d        ; row 4, column 4
  10061.     .byte    $0b        ; row 5, column 4
  10062.     .byte    $0f        ; row 6, column 4
  10063.     .byte    $0e        ; row 7, column 4
  10064.     .byte    $c1        ; row 0, column 5
  10065.     .byte    $10        ; row 1, column 5
  10066.     .byte    $0c        ; row 2, column 5
  10067.     .byte    $c0        ; row 3, column 5
  10068.     .byte    $c2        ; row 4, column 5
  10069.     .byte    $1b        ; row 5, column 5
  10070.     .byte    $d0        ; row 6, column 5
  10071.     .byte    ',        ; row 7, column 5
  10072.     .byte    $1c        ; row 0, column 6
  10073.     .byte    '*        ; row 1, column 6
  10074.     .byte    $1d        ; row 2, column 6
  10075.     .byte    $08        ; row 3, column 6
  10076.     .byte    $00        ; row 4, column 6
  10077.     .byte    $1f        ; row 5, column 6
  10078.     .byte    $1e        ; row 6, column 6
  10079.     .byte    '/        ; row 7, column 6
  10080.     .byte    $81        ; row 0, column 7
  10081.     .byte    $1b        ; row 1, column 7
  10082.     .byte    $00        ; row 2, column 7
  10083.     .byte    $82        ; row 3, column 7
  10084.     .byte    $d0        ; row 4, column 7
  10085.     .byte    $00        ; row 5, column 7
  10086.     .byte    $11        ; row 6, column 7
  10087.     .byte    $03        ; row 7, column 7
  10088.     .byte    '?        ; row 0, column 8
  10089.     .byte    $88        ; row 1, column 8
  10090.     .byte    $85        ; row 2, column 8
  10091.     .byte    $09        ; row 3, column 8
  10092.     .byte    $82        ; row 4, column 8
  10093.     .byte    $84        ; row 5, column 8
  10094.     .byte    $87        ; row 6, column 8
  10095.     .byte    $81        ; row 7, column 8
  10096.     .byte    $1b        ; row 0, column 9
  10097.     .byte    $c1        ; row 1, column 9
  10098.     .byte    $c0        ; row 2, column 9
  10099.     .byte    $0a        ; row 3, column 9
  10100.     .byte    $c3        ; row 4, column 9
  10101.     .byte    $86        ; row 5, column 9
  10102.     .byte    $89        ; row 6, column 9
  10103.     .byte    $83        ; row 7, column 9
  10104.     .byte    $00        ; row 0, column 10
  10105.     .byte    $80        ; row 1, column 10
  10106.     .byte    $c2        ; row 2, column 10
  10107.     .byte    $a0        ; row 3, column 10
  10108.     .byte    $a1        ; row 4, column 10
  10109.     .byte    $a3        ; row 5, column 10
  10110.     .byte    $a2        ; row 6, column 10
  10111.     .byte    $00        ; row 7, column 10
  10112.  
  10113. ;
  10114. ;    keytbl3 - ascii values of characters at given row/column
  10115. ;
  10116. ;    This table is used to translage row/column positions to ascii
  10117. ;    values.  This table is used only if shift, but not control, is pushed
  10118. ;
  10119. ;    The following special non-ascii values exist:
  10120. ;
  10121. ;    $80 .. $89        - numeric keypad
  10122. ;    $90 .. $93        - pf keys
  10123. ;    $a0 .. $a3        - cursor keys
  10124. ;    $b0 .. $b7        - programmable function keys
  10125. ;    $c0            - '-' (on the numeric keypad)
  10126. ;    $c1            - '+' (on the numeric keypad)
  10127. ;    $c2            - '.' (on the numeric keypad)
  10128. ;    $c3            - enter (on the numeric keypad)
  10129. ;    $d0            - null (ctrl-@) and (ctrl-space)
  10130. ;    $d1            - break (shift DEL)
  10131. ;
  10132.  
  10133. keytbl3:.byte    $d1        ; row 0, column 0
  10134.     .byte    $0d        ; row 1, column 0
  10135.     .byte    $a3        ; row 2, column 0
  10136.     .byte    $00        ; row 3, column 0    (should be $b7)
  10137.     .byte    '|        ; row 4, column 0    (should be $b1)
  10138.     .byte    '~        ; row 5, column 0    (should be $b3)
  10139.     .byte    '}        ; row 6, column 0    (should be $b5)
  10140.     .byte    $a0        ; row 7, column 0
  10141.     .byte    '#        ; row 0, column 1
  10142.     .byte    'W        ; row 1, column 1
  10143.     .byte    'A        ; row 2, column 1
  10144.     .byte    '$        ; row 3, column 1
  10145.     .byte    'Z        ; row 4, column 1
  10146.     .byte    'S        ; row 5, column 1
  10147.     .byte    'E        ; row 6, column 1
  10148.     .byte    $00        ; row 7, column 1
  10149.     .byte    '%        ; row 0, column 2
  10150.     .byte    'R        ; row 1, column 2
  10151.     .byte    'D        ; row 2, column 2
  10152.     .byte    '&        ; row 3, column 2
  10153.     .byte    'C        ; row 4, column 2
  10154.     .byte    'F        ; row 5, column 2
  10155.     .byte    'T        ; row 6, column 2
  10156.     .byte    'X        ; row 7, column 2
  10157.     .byte    ''        ; row 0, column 3
  10158.     .byte    'Y        ; row 1, column 3
  10159.     .byte    'G        ; row 2, column 3
  10160.     .byte    '(        ; row 3, column 3
  10161.     .byte    'B        ; row 4, column 3
  10162.     .byte    'H        ; row 5, column 3
  10163.     .byte    'U        ; row 6, column 3
  10164.     .byte    'V        ; row 7, column 3
  10165.     .byte    ')        ; row 0, column 4
  10166.     .byte    'I        ; row 1, column 4
  10167.     .byte    'J        ; row 2, column 4
  10168.     .byte    '0        ; row 3, column 4
  10169.     .byte    'M        ; row 4, column 4
  10170.     .byte    'K        ; row 5, column 4
  10171.     .byte    'O        ; row 6, column 4
  10172.     .byte    'N        ; row 7, column 4
  10173.     .byte    '{        ; row 0, column 5
  10174.     .byte    'P        ; row 1, column 5
  10175.     .byte    'L        ; row 2, column 5
  10176.     .byte    '}        ; row 3, column 5
  10177.     .byte    '>        ; row 4, column 5
  10178.     .byte    '[        ; row 5, column 5
  10179.     .byte    '`        ; row 6, column 5
  10180.     .byte    '<        ; row 7, column 5
  10181.     .byte    '|        ; row 0, column 6
  10182.     .byte    '*        ; row 1, column 6
  10183.     .byte    ']        ; row 2, column 6
  10184.     .byte    $0c        ; row 3, column 6
  10185.     .byte    $00        ; row 4, column 6
  10186.     .byte    '_        ; row 5, column 6
  10187.     .byte    '~        ; row 6, column 6
  10188.     .byte    '?        ; row 7, column 6
  10189.     .byte    '!        ; row 0, column 7
  10190.     .byte    $1b        ; row 1, column 7
  10191.     .byte    $00        ; row 2, column 7
  10192.     .byte    '"        ; row 3, column 7
  10193.     .byte    $20        ; row 4, column 7
  10194.     .byte    $00        ; row 5, column 7
  10195.     .byte    'Q        ; row 6, column 7
  10196.     .byte    $03        ; row 7, column 7
  10197.     .byte    '?        ; row 0, column 8
  10198.     .byte    $88        ; row 1, column 8
  10199.     .byte    $85        ; row 2, column 8
  10200.     .byte    $09        ; row 3, column 8
  10201.     .byte    $82        ; row 4, column 8
  10202.     .byte    $84        ; row 5, column 8
  10203.     .byte    $87        ; row 6, column 8
  10204.     .byte    $81        ; row 7, column 8
  10205.     .byte    $1b        ; row 0, column 9
  10206.     .byte    $c1        ; row 1, column 9
  10207.     .byte    $c0        ; row 2, column 9
  10208.     .byte    $0a        ; row 3, column 9
  10209.     .byte    $c3        ; row 4, column 9
  10210.     .byte    $86        ; row 5, column 9
  10211.     .byte    $89        ; row 6, column 9
  10212.     .byte    $83        ; row 7, column 9
  10213.     .byte    $00        ; row 0, column 10
  10214.     .byte    $80        ; row 1, column 10
  10215.     .byte    $c2        ; row 2, column 10
  10216.     .byte    $a0        ; row 3, column 10
  10217.     .byte    $a1        ; row 4, column 10
  10218.     .byte    $a3        ; row 5, column 10
  10219.     .byte    $a2        ; row 6, column 10
  10220.     .byte    $00        ; row 7, column 10
  10221.  
  10222. .SBTTL    RS232 Support Routines
  10223.  
  10224. ;
  10225. ;    Openrs - Open the RS-232 Channel
  10226. ;
  10227. ;    Input:    RS232 Parameters in CNTRL,CMMD
  10228. ;
  10229. ;    Ouput:
  10230. ;
  10231. ;    Registers Destroyed: A
  10232. ;
  10233.  
  10234. openrs:    lda    #2        ;[27] Close the Current channel
  10235.     jsr    close        ;[27]        ...
  10236. ;     openm    #2,#2,#$ff,cntrl,#4    ;[27] Open new channel
  10237.     lda    #2        ; [53]
  10238.     ldx    #2
  10239.     ldy    #$ff
  10240.     jsr    setlfs
  10241.     ldx    #cntrl\
  10242.     ldy    #cntrl^
  10243.     lda    #4
  10244.     jsr    setnam
  10245.     jsr    open
  10246.  
  10247.  
  10248. ;
  10249. ;    Alocrs - Subroutine - allocate the RS232 buffers
  10250. ;
  10251. ;    Input:    Buffer locations in RSOUT,RSIN
  10252. ;
  10253. ;    Output:
  10254. ;
  10255. ;    Registers Destroyed: A
  10256. ;
  10257.  
  10258. alocrs:    lda    #rsout\        ;[24] Allocate the RS-232 buffers
  10259.     sta    robuf        ;[24]        ...
  10260.     lda    #rsout&$ff00^    ;[24]        ...
  10261.     sta    robuf+1        ;[24]        ...
  10262.     lda    #rsin\        ;[24]        ...
  10263.     sta    ribuf        ;[24]        ...
  10264.     lda    #rsin&$ff00^    ;[24]        ...
  10265.     sta    ribuf+1        ;[24]        ...
  10266.     rts            ;[24] Return
  10267.  
  10268. ;
  10269. ;    Getrs - Get byte from rs232 port
  10270. ;
  10271. ;    Input:    
  10272. ;
  10273. ;    Output:    Character read in CHAR
  10274. ;
  10275. ;
  10276. ;
  10277. ;    Registers Destroyed: A,X
  10278. ;
  10279.  
  10280. getrs:    jsr    flowco        ;[24] Do flow control if necessary
  10281.     lda    suspend        ;[24] Is RS-232 reading suspended?
  10282.     bne    getr3        ; Yes, 
  10283. getr2:    ldx    #2        ;[DD] Change Kernel input
  10284.     jsr    chkin        ;[DD]    channel to RS-232
  10285.     jsr    getin        ;[DD] Get a byte
  10286.     sta    char        ;[31] Store it here
  10287.     jsr    readst        ;[33] Read the status
  10288.     sta    stat        ;[33] Store it here
  10289.     jsr    rserrs        ;[33] Check for RS232 errrors
  10290.     bne    getr3        ;[33] If error, return no byte
  10291.     lda    stat        ;[33] Check stat to see if byte was read
  10292.     and    #$08        ;[33]        ...
  10293. getr3:    rts            ;[DD] Return
  10294.  
  10295. ;
  10296. ;    Rserrs - Check for RS232 errors
  10297. ;
  10298. ;    Input:    Status in STAT
  10299. ;
  10300. ;    Output:
  10301. ;
  10302. ;    Registers Destroyed: A
  10303.  
  10304. rserrs:    lda    stat        ;[33] Get the status
  10305.     and    #$f7        ;[33]
  10306.     beq    erret        ;[33]
  10307.     jsr    beeplo        ;[33] Error, Feep!
  10308.     lda    #1        ;[33]
  10309. erret:    rts            ;[33]
  10310.  
  10311. ;
  10312. ;    Flowco - perform RS-232 flow control
  10313. ;
  10314. ;    Input:
  10315. ;
  10316. ;    Output:
  10317. ;
  10318. ;    Registers Destroyed: A,X
  10319. ;
  10320.  
  10321. flowco:    lda    flowmo        ;[24] Get the flow control mode switch
  10322.     cmp    #on        ;[24] Is it on?
  10323.     bne    flowre        ;[24] No
  10324.     lda    shflag        ;[24] Check commodore key
  10325.     and    #$02        ;[24] Is it depressed?
  10326.     beq    nocomm        ;[24] No
  10327.     lda    commflg        ;[24] Was it depressed before
  10328.     bne    flowch        ;[24] Yes, ignore it
  10329.     inc    commflg        ;[24] Set commodore key flag
  10330.     lda    suspend        ;[24] Currently suspended?
  10331.     beq    notsus        ;[24] No
  10332.     lda    #0        ;[24] Clear suspend flag
  10333.     sta    suspend        ;[24]        ...
  10334.     beq    flowch        ;[24]
  10335. notsus:    inc    suspend        ;[24] Set suspend flag
  10336.     bne    flowch        ;[24]
  10337. nocomm:    sta    commflg        ;[24] Clear commodore key flag
  10338.  
  10339. flowch:    lda    ridbe        ;[24] Compute number of chars
  10340.     sec            ;[24]    in RS-232 buffer
  10341.     sbc    ridbs        ;[24]        ...
  10342.     lsr    a        ;[24] Divide count by 2 for accurate check
  10343.     ldx    fxoff        ;[24] Has an xoff already been sent
  10344.     bne    itsoff        ;[24] Yes
  10345.     cmp    #100        ;[24] Number chars in buffer reached 200?
  10346.     bmi    flowre        ;[24] No - no flow control necessary yet
  10347.     jsr    sxoff        ;[24] Send an xoff
  10348.     rts            ;[24] Return
  10349. itsoff:    cmp    #10        ;[24] Has backlog dropped to 20 or less?
  10350.     bpl    flowre        ;[24] No - leave input suspended
  10351.     jsr    sxon        ;[24] Send an xon
  10352. flowre:    rts            ;[24] Return
  10353.  
  10354. ;
  10355. ;    Flshin - Flush the RS232 input buffer
  10356. ;
  10357. ;    Input:
  10358. ;
  10359. ;    Output:
  10360. ;
  10361. ;    Registers Destroyed: A
  10362.  
  10363. flshin:    jsr    getrs        ;[25] Get from RS-232 buffer
  10364.     beq    flshin        ;[33] No, get more
  10365.     rts            ;[25] Yes, finish
  10366.  
  10367. ;
  10368. ;    Putrs - Send byte to RS232
  10369. ;
  10370. ;    Input:
  10371. ;
  10372. ;    Output:
  10373. ;
  10374. ;    Registers Destroyed:
  10375. ;
  10376.  
  10377. putrs:    pha              ;[DD] Save A-reg
  10378.     txa            ;[DD] Save X-reg
  10379.      pha              ;[DD]        ...
  10380.     ldx    #2        ;[DD] Change the Kernel output
  10381.     jsr    chkout        ;[DD]    channel to RS-232
  10382.     jsr    optimu        ;[24] Wait for optimum time to do RS-232 out
  10383.     pla            ;[DD] Restore X
  10384.     tax             ;[DD]        ...
  10385.     pla             ;[DD] Restore A
  10386.     jsr    chrout        ;[DD] Send the character
  10387.     rts            ;[DD] Return
  10388.  
  10389. ;
  10390. ;    Optimu - wait for optimum time to transmit an RS-232 character
  10391. ;
  10392. ;    Input:
  10393. ;
  10394. ;    Output:
  10395. ;
  10396. ;    Registers Destroyed:
  10397. ;
  10398. ;    If we are connected, we have to make sure that the modem interrupts
  10399. ;    will not collide.  We do this by waiting for the first bit of a byte
  10400. ;    to be received.  If we don't wait for a bit to be received, the
  10401. ;    transmitter interrupts will collide with the receiver interrupt.  If
  10402. ;    we don't use the very first bit, then we might not be finished
  10403. ;    transmitting when the next start bit interrupt occurs.  We never
  10404. ;    wait more than 1/120 of a second.  If nothing has happened in 1/120
  10405. ;    of a second, then we are not receiving data.
  10406. ;
  10407. ;    If we are sending a packet, we have to stretch our stop bit or some
  10408. ;    devices (notably a DH-11, and maybe many others) cannot understand
  10409. ;    what we are saying.
  10410. ;
  10411. ;    The magic stretch value is computed as follows:
  10412. ;        The "right" rate for 1200 baud transmission is $0146.
  10413. ;            (see the calculations on the bottom of page 350)
  10414. ;            (of the Programmer's Reference Guide)
  10415. ;        We choose to run with $013c.
  10416. ;        $0146-$013c = $a
  10417. ;        There are 10 bits in a byte.  There are 2 clock cycles in
  10418. ;        A count.  This means that we have to stretch our stop bit
  10419. ;        by 200 cycles.  The delay loop has 5 cycles.  (dex=2, bne=3).
  10420. ;        So we have to go through the delay loop 40 times.
  10421. ;
  10422.  
  10423. optimu:    lda    connec        ;[] Get the connect mode flag
  10424.     cmp    #true        ;[] Are we in connect mode?
  10425.     bne    opti4
  10426.     lda    #$07        ; what bit are we waiting for?
  10427. opti1:    cmp    bitci        ; if operation already in progress, wait
  10428.     beq    opti1
  10429.     jsr    opti7        ; compute loop counter. 40=slow mode. 80=fast
  10430.     lda    #$07        ; what bit are we waiting for?
  10431. opti2:    ldy    #20        ; 40 executions * 2 cycles = 80 cycles.
  10432. opti3:    cmp    bitci        ; 800 * 3 = 2400
  10433.     beq    optirt        ; 800 * 2 = 1600
  10434.     dey            ; 800 * 2 = 1600
  10435.     bne    opti3        ; 760 * 3 + 40 * 2 = 2360
  10436.     pha            ; 40 * 3 = 120
  10437.     pla            ; 40 * 4 = 160
  10438.     dex            ; 40 * 2 = 80
  10439.     bne    opti2        ; 39 * 3 + 1 * 2 = 119
  10440.     rts            ; total delay = 8521 cycles = approx /120 sec
  10441. opti4:    lda    baud        ; are we running at 1200 baud?
  10442.     cmp    #$01
  10443.     bne    optirt        ; guess not.  Don't have to kludge.
  10444.     lda    #$01        ; wait for transmission of last byte to end
  10445. opti5:    bit    $02a1
  10446.     bne    opti5
  10447.     jsr    opti7        ; compute loop counter.  40=slow mode.  80=fast
  10448. opti6:    dex
  10449.     bne    opti6
  10450. optirt:    rts
  10451. opti7:    ldx    #40        ; outer loop = 40 for slow mode
  10452.     lda    fast
  10453.     lsr    a
  10454.     bcc    opti8
  10455.     ldx    #80        ; outer loop = 80 for fast mode
  10456. opti8:    rts
  10457.  
  10458. ;
  10459. ;    Sbreak - Send a break signal
  10460. ;
  10461.  
  10462. sbreak: lda    $dd00        ;[DD] Get pa of cia
  10463.     and    #$fb        ;[DD] Zero pa2
  10464.     sta    $dd00        ;[DD]        ...
  10465.     ldy    #$00
  10466.     jsr    opti7        ; get a timing value depending on fast mode
  10467. sbdl0:    pha            ; 10240 * 3 = 30720
  10468.     pla            ; 10240 * 4 = 40960
  10469.     pha            ; 10240 * 3 = 30720
  10470.     pla            ; 10240 * 4 = 40960
  10471.     nop            ; 10240 * 2 = 20480
  10472.     nop            ; 10240 * 2 = 20480
  10473.     dey            ; 10240 * 2 = 20480
  10474.     bne    sbdl0        ; 10200 * 3 + 40 * 2 = 30680
  10475.     ldy    #51        ; 40 * 2 = 80
  10476. sbdl1:    nop            ; 2040 * 2 = 4080
  10477.     dey            ; 2040 * 2 = 4080
  10478.     bne    sbdl1        ; 2000 * 3 + 40 * 2 = 6080
  10479.     dex            ; 40 * 2 = 80
  10480.     bne    sbdl0        ; 39 * 3 + 1 * 2 = 119
  10481.     lda    $dd00        ; total = 249999 = approx 250 ms
  10482.     ora    #$04        ;[DD] Set pa2
  10483.     sta    $dd00        ;[DD]        ...
  10484.     rts            ;[DD] Return
  10485.  
  10486. ;
  10487. ;    Subroutine - send out ^Q (xon) to remote host
  10488. ;
  10489.  
  10490. sxon:    lda    #0        ;[24] Clear xoff flag
  10491.     sta    fxoff        ;[24]        ...
  10492.     lda    #$11        ;[24] Transmit ^Q
  10493.     bne    xcom        ;[24]        ...
  10494.  
  10495. ;
  10496. ;    Subroutine - send out ^S (xoff) to remote host
  10497. ;
  10498.  
  10499. sxoff:    lda    #5        ;[24] Set xoff flag
  10500.     sta    fxoff        ;[24][32]    ...
  10501.     lda    #$13        ;[24]    then, transmit ^S
  10502. xcom:    jsr    putrs        ;[24]        ...
  10503.     rts            ;[24] Return
  10504.  
  10505. ;
  10506. ;
  10507. ;   Cva2s - Convert ASCII to Speedscript (word processor)
  10508. ;
  10509. ;    Input:    Character in KERCHR
  10510. ;
  10511. ;    Output:    Converted character in KERCHR
  10512. ;
  10513. ;    Registers Destroyed: A
  10514. ;
  10515.  
  10516. cva2s:  lda    kerchr        ;[DD]
  10517.     and    #$7f        ;[DD]
  10518.     cmp    #cr        ;[DD]
  10519.     bne    cva2s1      ;[DD] Check cr
  10520.     lda    #$1f        ;[DD]
  10521. cva2s1: cmp    #$61        ;[DD]
  10522.     bcc    cva2s2        ;[DD]
  10523.     cmp    #$7b        ;[DD]
  10524.     bcs    cva2s2        ;[DD]
  10525.     and    #$1f        ;[DD] Convert lower case
  10526. cva2s2: cmp    #$5b        ;[DD]
  10527.     bcc    cva2s3        ;[DD]
  10528.     cmp    #$5f        ;[DD]
  10529.     bcs    cva2s3        ;[DD]
  10530.     and    #$1f        ;[DD]
  10531. cva2s3: sta    kerchr        ;[DD]
  10532.     rts            ;[DD]
  10533.  
  10534. ;  Convert Seedscript (word processor) to ASCII
  10535.  
  10536. cvs2a:  lda    kerchr        ;[DD]
  10537.     and    #$7f        ;[DD]
  10538. cvs2a1: cmp    #$1b        ;[DD]
  10539.     bcs    cvs2a2      ;[DD] If <$1b
  10540.     ora    #$60        ;[DD] Convert to lc
  10541. cvs2a2: cmp    #$1f        ;[DD]
  10542.     bcs    cvs2a3        ;[DD]
  10543.     ora    #$40        ;[DD]
  10544. cvs2a3: bne    cvs2a4         ;[DD] If =$1f
  10545.     lda    #cr        ;[DD] cr
  10546. cvs2a4:    sta    kerchr        ;[DD]
  10547.     rts            ;[DD]
  10548.  
  10549. .SBTTL    Spar and Rpar routines
  10550.  
  10551. ;
  10552. ;    Spar - This routine loads the data buffer with the init parameters
  10553. ;    requested for this Kermit.
  10554. ;
  10555. ;        Input:  NONE
  10556. ;
  10557. ;        Output: @Kerbf1 - Operational parameters
  10558. ;
  10559. ;        Registers destroyed:    A,Y
  10560. ;
  10561.  
  10562. spar:    ldy    #$00        ; Clear Y
  10563.     sty    datind        ; Clear datind
  10564.     lda    rpsiz        ; Fetch receive packet size
  10565.     clc            ; Clear the carry flag
  10566.     adc    #$20        ; Characterize it
  10567.     sta    (kerbf1),y    ; Stuff it in the packet buffer
  10568.     iny            ; Increment the buffer index
  10569.     lda    rtime        ; Get the timeout interval
  10570.     clc            ;        ...
  10571.     adc    #$20        ; Make that a printable character
  10572.     sta    (kerbf1),y    ;    and stuff it in the buffer
  10573.     iny            ; Advance the index
  10574.     lda    rpad        ; Get the amount of padding required
  10575.     clc            ;        ...
  10576.     adc    #$20        ; Make that printable
  10577.     sta    (kerbf1),y    ; Put it in the buffer
  10578.     iny            ; Advance index
  10579.     lda    rpadch        ; Get the padding character expected
  10580.     eor    #$40        ; Controlify it
  10581.     sta    (kerbf1),y    ; And stuff it
  10582.     iny            ; Up the packet buffer index
  10583.     lda    reol        ; Get the end-of-line expected
  10584.     clc            ;        ...
  10585.     adc    #$20        ; Characterize it
  10586.     sta    (kerbf1),y    ; Place that next in the buffer
  10587.     iny            ; Advance the index
  10588.     lda    rquote        ; Get the quote character expected
  10589.     sta    (kerbf1),y    ; Store it as-is last in the buffer
  10590.     iny            ; Advance index
  10591. ;    lda    #'Y        ;  Send 'Y' - I will support 8-bit quoting
  10592. ;    sta    (kerbf1),y    ; Stuff it into the data area
  10593.     lda    ebqmod        ;[30] Get eight-bit quoting
  10594.     cmp    #off        ;[30] Is it off?
  10595.     beq    spar1        ;[30] Yes...say we will do it if HE wants to
  10596.     lda    sebq        ;[30] Get eight-bit quote character
  10597.     sta    (kerbf1),y    ;[30] So other Kermit knows we are
  10598.     rts            ;[30]    requesting it
  10599. spar1:    lda    #'Y        ; Send 'Y' - I will support 8-bit quoting
  10600.     sta    (kerbf1),y    ; Stuff it into the data area
  10601.     rts            ;        ...
  10602.  
  10603. ;
  10604. ;
  10605. ;    Rpar - This routine sets operational parameters for the other kermit
  10606. ;    from the init packet data buffer.
  10607. ;
  10608. ;        Input:  @Kerbf1 - Operational parameters
  10609. ;
  10610. ;        Output: Operational parameters set
  10611. ;
  10612. ;        Registers destroyed:    A,Y
  10613. ;
  10614.  
  10615. rpar:    ldy    #$00        ; Start the data index at 0!
  10616.     lda    (kerbf1),y    ; Start grabbing data from packet buffer
  10617.     sec            ; Uncharacterize it
  10618.     sbc    #$20        ;        ...
  10619.     sta    spsiz        ; That must be the packet size of other Kermit
  10620.     iny            ; Increment the buffer index
  10621.     lda    (kerbf1),y    ; Get the next item
  10622.     sec            ;        ...
  10623.     sbc    #$20        ; Uncharacterize that
  10624.     sta    stime        ; Other Kermit's timeout interval
  10625.     iny            ; Up the index once again
  10626.     lda    (kerbf1),y    ; Get next char
  10627.     sec            ;        ...
  10628.     sbc    #$20        ; Restore to original value
  10629.     sta    spad        ; This is the amount of padding he wants
  10630.     iny            ; Advnace index
  10631.     lda    (kerbf1),y    ; Next item
  10632.     eor    #$40        ; Uncontrolify this one
  10633.     sta    spadch        ; That is padding character for other Kermit
  10634.     iny            ; Advance index
  10635.     lda    (kerbf1),y    ; Get next item of data
  10636.     cmp    #$00        ; If it is equal to zero
  10637.     beq    rpar2        ; Use <cr> as a default
  10638.     jmp    rpar3        ;        ...
  10639. rpar2:  lda    #cr        ; Get value of <cr>
  10640.     sta    seol        ; That will be the eol character
  10641.     jmp    rpar4        ; Continue
  10642. rpar3:  sec            ;        ...
  10643.     sbc    #$20        ; unchar the character
  10644.     sta    seol        ; That is the eol character other Kermit wants
  10645. rpar4:  iny            ; Advance the buffer index
  10646.     lda    (kerbf1),y    ; Get quoting character
  10647.     cmp    #$00        ; If that is zero
  10648.     beq    rpar5        ; Use # sign as the quote character
  10649.     jmp    rpar6        ; Otherwise, give him what he wants
  10650. rpar5:  lda    #'#        ; Load # sign
  10651. rpar6:  sta    squote        ; Make that the other Kermit's quote character
  10652.     iny            ; Advance the index
  10653.     lda    pdlen        ; Check the data length to see
  10654.     cmp    #$09        ;    if the 8-bit quote is there
  10655.     bmi    rparrt        ; If not, return
  10656.     lda    (kerbf1),y    ; Fetch the 8-bit quote
  10657.     cmp    #'N        ; Is it 'N'
  10658.     beq    rpar8        ; Yes, leave.(he doesn't support 8-bit)
  10659.     cmp    #'Y        ; Does he support 8-bit quoting?
  10660.     beq    rpar8        ; If so, leave. (we don't need it.)
  10661.     cmp    #'!        ; Now, it should be a real character
  10662.     bmi    rparrt        ;    Check if it is in range.
  10663.     cmp    #'?        ;    If so, we set the 8-bit quote char
  10664.     bmi    rpar7        ;    and set 8-bit quoting on.
  10665.     cmp    #$60        ;    If not, just leave.
  10666.     bmi    rparrt        ;        ...
  10667.     cmp    #del        ;        ...
  10668.     bpl    rparrt        ;        ...
  10669. rpar7:    sta    sebq        ; Stuff the character here
  10670.     lda    #on        ; Set 8-bit quoting on
  10671.     sta    ebqmod        ;        ...
  10672.     rts            ; Return
  10673. rpar8:    sta    sebq        ; Make sure this parm is stored
  10674.     lda    #off        ;    AND that 8-bit quoting is off.
  10675.     sta    ebqmod        ;        ...
  10676. rparrt:    rts            ; Return
  10677.  
  10678. ;
  10679. ;
  10680. ;    Nakit - sends a standard NAK packet out to the other Kermit.
  10681. ;
  10682. ;        Input:  NONE
  10683. ;
  10684. ;        Output: NONE
  10685. ;
  10686.  
  10687. nakit:  lda    #$00        ; Zero the packet data length
  10688.     sta    pdlen        ;        ...
  10689.     lda    #'N        ; Set up a nak packet type
  10690.     sta    ptype        ;        ...
  10691.     jsr    spak        ; Now, send it
  10692.     rts            ; Return
  10693.  
  10694.  
  10695. .SBTTL    Message text
  10696.  
  10697. versio1:.byte    "Commodore 64/128 Kermit version 2.2 (73)"
  10698.     .byte    cr
  10699.     .byte    0
  10700. versio2:.byte    "Type '?' for help"
  10701.     .byte    cr
  10702.     .byte    0        ; [53]
  10703.  
  10704.  
  10705. .SBTTL    Command tables and help text
  10706.  
  10707. kercmd: .byte    $10        ;[DD][EL][40][] Table length 
  10708.  
  10709. ;    .byte    $11        ; Table length with SCRATCH command installed
  10710. ;    .byte    $12        ; Table length with RENAME command installed
  10711. ;    .byte    $13        ; Table length with LOG command installed
  10712.  
  10713.     .byte    $03        ; 
  10714.     .byte    "bye"        ; 
  10715.     .byte    0        ; [53]
  10716.  
  10717.     .byte    $1E,$1E        ; 
  10718.  
  10719.     .byte    $07        ; Keyword length
  10720.     .byte    "connect"    ; Keyword terminated with a null
  10721.     .byte    0        ; [53]
  10722.  
  10723.     .byte    $00,$00        ; Two bytes of data
  10724.  
  10725.     .byte    $09        ;
  10726.     .byte    "directory"    ;
  10727.     .byte    0        ; [53]
  10728.  
  10729.     .byte    $2a,$2a        ;
  10730.  
  10731.     .byte    $04        ;
  10732.     .byte    "disk"        ;
  10733.     .byte    0        ; [53]
  10734.  
  10735.     .byte    $27,$27        ;
  10736.  
  10737.     .byte    $04        ;
  10738.     .byte    "exit"        ;
  10739.     .byte    0        ; [53]
  10740.  
  10741.     .byte    $03,$03        ;
  10742.  
  10743.     .byte    $06        ; 
  10744.     .byte    "finish"    ; 
  10745.     .byte    0        ; [53]
  10746.  
  10747.     .byte    $21,$21        ; 
  10748.  
  10749.     .byte    $03        ; 
  10750.     .byte    "get"        ; 
  10751.     .byte    0        ; [53]
  10752.  
  10753.     .byte    $24,$24        ; 
  10754.  
  10755.     .byte    $04
  10756.     .byte    "help"
  10757.     .byte    0        ; [53]
  10758.  
  10759.     .byte    $06,$06
  10760.  
  10761. ;    .byte    $03        ; NOT IMPLEMENTED YET
  10762. ;    .asciz  /LOG/
  10763. ;    .byte    $09,$09
  10764.  
  10765.     .byte    $04
  10766.     .byte    "quit"
  10767.     .byte    0        ; [53]
  10768.  
  10769.     .byte    $0C,$0C
  10770.  
  10771.     .byte    $07
  10772.     .byte    "receive"
  10773.     .byte    0        ; [53]
  10774.  
  10775.     .byte    $0F,$0F
  10776.  
  10777. ;    .byte    $06        ;[]
  10778. ;    .asciz    /RENAME/    ;[]
  10779. ;    .byte            ;[]
  10780.  
  10781.     .byte    $07        ;[47]
  10782.     .byte    "restore"    ;[47]
  10783.     .byte    0        ; [53]
  10784.  
  10785.     .byte    $30,$30        ;[47]
  10786.  
  10787.     .byte    $04        ;[47]
  10788.     .byte    "save"        ;[47]
  10789.     .byte    0        ; [53]
  10790.  
  10791.     .byte    $2d,$2d        ;[47]
  10792.  
  10793. ;    .byte    $07        ;[]
  10794. ;    .asciz    /SCRATCH/    ;[]
  10795. ;    .byte            ;[]
  10796.  
  10797.     .byte    $04
  10798.     .byte    "send"
  10799.     .byte    0        ; [53]
  10800.  
  10801.     .byte    $12,$12
  10802.  
  10803.     .byte    $03
  10804.     .byte    "set"
  10805.     .byte    0        ; [53]
  10806.  
  10807.     .byte    $15,$15
  10808.  
  10809.     .byte    $04
  10810.     .byte    "show"
  10811.     .byte    0        ; [53]
  10812.  
  10813.     .byte    $18,$18
  10814.  
  10815.     .byte    $06
  10816.     .byte    "status"
  10817.     .byte    0        ; [53]
  10818.  
  10819.     .byte    $1B,$1B
  10820.  
  10821. setcmd: .byte    $16        ;[DD][EL][17][37]
  10822.  
  10823.     .byte    $04        ;[17]
  10824.     .byte    "baud"        ;[17]
  10825.     .byte    0        ; [53]
  10826.  
  10827.     .byte    $27,$27        ;[17]
  10828.  
  10829.     .byte    $04
  10830.     .byte    "bold"
  10831.     .byte    $00
  10832.     .byte    $3c,$3c
  10833.  
  10834.     .byte    $06
  10835.     .byte    "border"
  10836.     .byte    $00
  10837.     .byte    $3f,$3f
  10838.  
  10839.     .byte    $09
  10840.     .byte    "character"
  10841.     .byte    $00
  10842.     .byte    $39,$39
  10843.  
  10844.     .byte    $0f
  10845.     .byte    "dark-background"
  10846.     .byte    $00
  10847.     .byte    $33,$33
  10848.  
  10849.     .byte    $09
  10850.     .byte    "debugging"
  10851.     .byte    0        ; [53]
  10852.  
  10853.     .byte    $18,$18
  10854.  
  10855.     .byte    $11
  10856.     .byte    "eight-bit-quoting"
  10857.     .byte    0        ; [53]
  10858.  
  10859.     .byte    $15,$15
  10860.  
  10861.     .byte    $06
  10862.     .byte    "escape"
  10863.     .byte    0        ; [53]
  10864.  
  10865.     .byte    $00,$00
  10866.  
  10867.     .byte    $0E
  10868.     .byte    "file-byte-size"
  10869.     .byte    0        ; [53]
  10870.  
  10871.     .byte    $1E,$1E
  10872.  
  10873.     .byte    $09
  10874.     .byte    "file-type"
  10875.     .byte    0        ; [53]
  10876.  
  10877.     .byte    $1B,$1B
  10878.  
  10879.     .byte    $0C
  10880.     .byte    "file-warning"
  10881.     .byte    0        ; [53]
  10882.  
  10883.     .byte    $12,$12
  10884.  
  10885.     .byte    $0C        ;[24]
  10886.     .byte    "flow-control"    ;[24]
  10887.     .byte    0        ; [53]
  10888.  
  10889.     .byte    $2d,$2d        ;[24]
  10890.  
  10891.     .byte    $03        ; 
  10892.     .byte    "ibm"        ; 
  10893.     .byte    0        ; [53]
  10894.  
  10895.     .byte    $03,$03        ; 
  10896.  
  10897.     .byte    $10
  10898.     .byte    "light-background"
  10899.     .byte    $00
  10900.     .byte    $36,$36
  10901.  
  10902.     .byte    $0A
  10903.     .byte    "local-echo"
  10904.     .byte    0        ; [53]
  10905.  
  10906.     .byte    $06,$06
  10907.  
  10908.     .byte    $06        ; 
  10909.     .byte    "parity"    ; 
  10910.     .byte    0        ; [53]
  10911.  
  10912.     .byte    $24,$24        ; 
  10913.  
  10914.     .byte    $07
  10915.     .byte    "receive"
  10916.     .byte    0        ; [53]
  10917.  
  10918.     .byte    $09,$09
  10919.  
  10920.     .byte    $0F        ;[DD]
  10921.     .byte    "rs232-registers"    ;[DD]
  10922.     .byte    0        ; [53]
  10923.  
  10924.     .byte    $21,$21        ;[DD]
  10925.  
  10926.     .byte    $04
  10927.     .byte    "send"
  10928.     .byte    0        ; [53]
  10929.  
  10930.     .byte    $0C,$0C
  10931.  
  10932.     .byte    $0d        ;[37]
  10933.     .byte    "screen-driver"    ;[37]
  10934.     .byte    0        ; [53]
  10935.  
  10936.     .byte    $30,$30        ;[37]
  10937.  
  10938.     .byte    $12
  10939.     .byte    "terminal-emulation"
  10940.     .byte    0        ; [53]
  10941.  
  10942.     .byte    $0F,$0F
  10943.  
  10944.     .byte    $09            ;[17]
  10945.     .byte    "word-size"        ;[17]
  10946.     .byte    0        ; [53]
  10947.  
  10948.     .byte    $2a,$2a
  10949.  
  10950. shocmd: .byte    $11        ;[DD][17]
  10951. ;    .byte    $12        ; Table length with DEFAULT-DISK opt included
  10952.  
  10953.     .byte    $03
  10954. shodef:    .byte    "all"
  10955.     .byte    0        ; [53]
  10956.  
  10957.     .byte    $00,$00
  10958.  
  10959.     .byte    $04        ;[17]
  10960.     .byte    "baud"        ;[17]
  10961.     .byte    0        ; [53]
  10962.  
  10963.     .byte    $7e,$7e        ;[17]
  10964.  
  10965.     .byte    $09
  10966.     .byte    "debugging"
  10967.     .byte    0        ; [53]
  10968.  
  10969.     .byte    $51,$51
  10970.  
  10971. ;    .byte    $0C
  10972. ;    .asciz    /DEFAULT-DISK/
  10973. ;    .byte    $a0,$a0
  10974.  
  10975.     .byte    $11
  10976.     .byte    "eight-bit-quoting"
  10977.     .byte    0        ; [53]
  10978.  
  10979.     .byte    $48,$48
  10980.  
  10981.     .byte    $06
  10982.     .byte    "escape"
  10983.     .byte    0        ; [53]
  10984.  
  10985.     .byte    $09,$09
  10986.  
  10987.     .byte    $0E
  10988.     .byte    "file-byte-size"
  10989.     .byte    0        ; [53]
  10990.  
  10991.     .byte    $63,$63
  10992.  
  10993.     .byte    $09
  10994.     .byte    "file-type"
  10995.     .byte    0        ; [53]
  10996.  
  10997.     .byte    $5A,$5A
  10998.  
  10999.     .byte    $0C
  11000.     .byte    "file-warning"
  11001.     .byte    0        ; [53]
  11002.  
  11003.     .byte    $3F,$3F
  11004.  
  11005.     .byte    $0C        ;[24]
  11006.     .byte    "flow-control"    ;[24]
  11007.     .byte    0        ; [53]
  11008.  
  11009.     .byte    $90,$90        ;[24]
  11010.  
  11011.     .byte    $03        ; 
  11012.     .byte    "ibm"
  11013.     .byte    0        ; [53]
  11014.  
  11015.     .byte    $12,$12
  11016.  
  11017.     .byte    $0A
  11018.     .byte    "local-echo"
  11019.     .byte    0        ; [53]
  11020.  
  11021.     .byte    $1B,$1B
  11022.  
  11023.     .byte    $06
  11024.     .byte    "parity"
  11025.     .byte    0        ; [53]
  11026.  
  11027.     .byte    $75,$75
  11028.  
  11029.     .byte    $07
  11030.     .byte    "receive"
  11031.     .byte    0        ; [53]
  11032.  
  11033.     .byte    $24,$24
  11034.  
  11035.     .byte    $0F            ;[DD]
  11036.     .byte    "rs232-registers"    ;[DD]
  11037.     .byte    0        ; [53]
  11038.  
  11039.     .byte    $6C,$6C            ;[DD]
  11040.  
  11041.     .byte    $04
  11042.     .byte    "send"
  11043.     .byte    0        ; [53]
  11044.  
  11045.     .byte    $2D,$2D
  11046.  
  11047.     .byte    $12
  11048.     .byte    "terminal-emulation"
  11049.     .byte    0        ; [53]
  11050.  
  11051.     .byte    $36,$36
  11052.  
  11053.     .byte    $09            ;[17]
  11054.     .byte    "word-size"        ;[17]
  11055.     .byte    0        ; [53]
  11056.  
  11057.     .byte    $87,$87            ;[17]
  11058.  
  11059. stscmd: .byte    $07
  11060.  
  11061.     .byte    $14
  11062.     .byte    "eight-bit-quote-char"
  11063.     .byte    0        ; [53]
  11064.  
  11065.     .byte    $06,$06
  11066.  
  11067.     .byte    $0B
  11068.     .byte    "end-of-line"
  11069.     .byte    0        ; [53]
  11070.  
  11071.     .byte    $09,$09
  11072.  
  11073.     .byte    $0D
  11074.     .byte    "packet-length"
  11075.     .byte    0        ; [53]
  11076.  
  11077.     .byte    $0C,$0C
  11078.  
  11079.     .byte    $08
  11080.     .byte    "pad-char"
  11081.     .byte    0        ; [53]
  11082.  
  11083.     .byte    $00,$00
  11084.  
  11085.     .byte    $07
  11086.     .byte    "padding"
  11087.     .byte    0        ; [53]
  11088.  
  11089.     .byte    $03,$03
  11090.  
  11091.     .byte    $0A
  11092.     .byte    "quote-char"
  11093.     .byte    0        ; [53]
  11094.  
  11095.     .byte    $0F,$0F
  11096.  
  11097.     .byte    $07
  11098.     .byte    "timeout"
  11099.     .byte    0        ; [53]
  11100.  
  11101.     .byte    $12,$12
  11102.  
  11103.  
  11104. ftcmd:  .byte    $05
  11105.  
  11106.     .byte    $05
  11107. ftcdef:    .byte    "ascii"
  11108.     .byte    0        ; [53]
  11109.  
  11110.     .byte    $00,$00
  11111.  
  11112.     .byte    $06
  11113.     .byte    "binary"
  11114.     .byte    0        ; [53]
  11115.  
  11116.     .byte    $03,$03
  11117.  
  11118.     .byte    $07
  11119.     .byte    "c-power"
  11120.     .byte    0
  11121.     .byte    $04,$04
  11122.  
  11123.     .byte    $07
  11124.     .byte    "petscii"
  11125.     .byte    0        ; [53]
  11126.  
  11127.     .byte    $01,$01
  11128.  
  11129.     .byte    $06
  11130.     .byte    "script"
  11131.     .byte    0        ; [53]
  11132.  
  11133.     .byte    $02,$02
  11134.  
  11135. parkey:    .byte    $05        ; LENGTH OF THIS TABLE IS 5
  11136.  
  11137.     .byte    $04        ;
  11138.     .byte    "even"        ;
  11139.     .byte    0        ; [53]
  11140.  
  11141.     .byte    $04,$04        ;
  11142.  
  11143.     .byte    $04        ;
  11144.     .byte    "mark"        ;
  11145.     .byte    0        ; [53]
  11146.  
  11147.     .byte    $02,$02        ;
  11148.  
  11149.     .byte    $04        ;
  11150.     .byte    "none"        ;
  11151.     .byte    0        ; [53]
  11152.  
  11153.     .byte    $00,$00        ;
  11154.  
  11155.     .byte    $03        ;
  11156.     .byte    "odd"        ;
  11157.     .byte    0        ; [53]
  11158.  
  11159.     .byte    $03,$03        ;
  11160.  
  11161.     .byte    $05        ;
  11162.     .byte    "space"        ;
  11163.     .byte    0        ; [53]
  11164.  
  11165.     .byte    $01,$01        ;
  11166.  
  11167. bdkey:    .byte    $03
  11168.  
  11169.     .byte    $03
  11170.     .byte    "300"
  11171.     .byte    0
  11172.     .byte    $00,$00
  11173.  
  11174.     .byte    $04
  11175.     .byte    "1200"
  11176.     .byte    0
  11177.     .byte    $01,$01
  11178.  
  11179.     .byte    $04
  11180.     .byte    "2400"
  11181.     .byte    0        ; [53]
  11182.     .byte    $02,$02
  11183.  
  11184. debkey:    .byte    $03        ; LENGTH OF THIS TABLE IS 3
  11185.  
  11186.     .byte    $03        ;
  11187.     .byte    "off"        ;
  11188.     .byte    0        ; [53]
  11189.  
  11190.     .byte    $00,$00        ;
  11191.  
  11192.     .byte    $05        ;
  11193.     .byte    "terse"        ;
  11194.     .byte    0        ; [53]
  11195.  
  11196.     .byte    $01,$01        ;
  11197.  
  11198.     .byte    $07        ;
  11199.     .byte    "verbose"    ;
  11200.     .byte    0        ; [53]
  11201.  
  11202.     .byte    $02,$02        ;
  11203.  
  11204. fbskey: .byte    $02
  11205.  
  11206.     .byte    $09
  11207.     .byte    "eight-bit"
  11208.     .byte    0        ; [53]
  11209.  
  11210.     .byte    $00,$00
  11211.  
  11212.     .byte    $09
  11213.     .byte    "seven-bit"
  11214.     .byte    0        ; [53]
  11215.  
  11216.     .byte    $01,$01
  11217.  
  11218. oncmd:  .byte    $02
  11219.  
  11220.     .byte    $02
  11221.     .byte    "on"
  11222.     .byte    0        ; [53]
  11223.  
  11224.     .byte    $01,$01
  11225.  
  11226.     .byte    $03
  11227.     .byte    "off"
  11228.     .byte    0        ; [53]
  11229.  
  11230.     .byte    $00,$00
  11231.  
  11232. yescmd: .byte    $02
  11233.  
  11234.     .byte    $02
  11235.     .byte    "no"
  11236.     .byte    0        ; [53]
  11237.  
  11238.     .byte    $00,$00
  11239.  
  11240.     .byte    $03
  11241.     .byte    "yes"
  11242.     .byte    0        ; [53]
  11243.  
  11244.     .byte    $01,$01
  11245.  
  11246. scrkey:    .byte    $05        ;[37]
  11247.  
  11248.     .byte    $0a        ;[37]
  11249.     .byte    "40-columns"    ;[37]
  11250.     .byte    0        ; [53]
  11251.  
  11252.     .byte    $00,$00        ;[37]
  11253.  
  11254.     .byte    $0a        ;[37]
  11255.     .byte    "80-columns"    ;[37]
  11256.     .byte    0        ; [53]
  11257.  
  11258.     .byte    $01,$01        ;[37]
  11259.  
  11260.     .byte    5
  11261.     .byte    "bi-80"
  11262.     .byte    0
  11263.  
  11264.     .byte    $03,$03
  11265.  
  11266.     .byte    $0d
  11267.     .byte    "commodore-128"
  11268.     .byte    0
  11269.  
  11270.     .byte    $02,$02
  11271.  
  11272.     .byte    $0c
  11273.     .byte    "custom-bi-80"
  11274.     .byte    0
  11275.  
  11276.     .byte    $04,$04
  11277.  
  11278. termemu:.byte    $03        ;terminal emulation may be none, vt52 or vt100
  11279.  
  11280.     .byte    $04
  11281.     .byte    "none"
  11282.     .byte    0
  11283.  
  11284.     .byte    $00,$00
  11285.  
  11286.     .byte    $06
  11287.     .byte    "vt-100"
  11288.     .byte    0
  11289.  
  11290.     .byte    $02,$02
  11291.  
  11292.     .byte    $05
  11293.     .byte    "vt-52"
  11294.     .byte    0
  11295.  
  11296.     .byte    $01,$01
  11297.  
  11298. colors:    .byte    $10        ; color names
  11299.  
  11300.     .byte    $05
  11301.     .byte    "black"
  11302.     .byte    $00
  11303.     .byte    $00,$00
  11304.  
  11305.     .byte    $04
  11306.     .byte    "blue"
  11307.     .byte    $00
  11308.     .byte    $06,$06
  11309.  
  11310.     .byte    $05
  11311.     .byte    "brown"
  11312.     .byte    $00
  11313.     .byte    $09,$09
  11314.  
  11315.     .byte    $04
  11316.     .byte    "cyan"
  11317.     .byte    $00
  11318.     .byte    $03,$03
  11319.  
  11320.     .byte    $09
  11321.     .byte    "dark-grey"
  11322.     .byte    $00
  11323.     .byte    $0b,$0b
  11324.  
  11325.     .byte    $05
  11326.     .byte    "green"
  11327.     .byte    $00
  11328.     .byte    $05,$05
  11329.  
  11330.     .byte    $0a
  11331.     .byte    "light-blue"
  11332.     .byte    $00
  11333.     .byte    $0e,$0e
  11334.  
  11335.     .byte    $0b
  11336.     .byte    "light-green"
  11337.     .byte    $00
  11338.     .byte    $0d,$0d
  11339.  
  11340.     .byte    $0a
  11341.     .byte    "light-grey"
  11342.     .byte    $00
  11343.     .byte    $0f,$0f
  11344.  
  11345.     .byte    $09
  11346.     .byte    "light-red"
  11347.     .byte    $00
  11348.     .byte    $0a,$0a
  11349.  
  11350.     .byte    $0b
  11351.     .byte    "medium-grey"
  11352.     .byte    $00
  11353.     .byte    $0c,$0c
  11354.  
  11355.     .byte    $06
  11356.     .byte    "orange"
  11357.     .byte    $00
  11358.     .byte    $08,$08
  11359.  
  11360.     .byte    $06
  11361.     .byte    "purple"
  11362.     .byte    $00
  11363.     .byte    $04,$04
  11364.  
  11365.     .byte    $03
  11366.     .byte    "red"
  11367.     .byte    $00
  11368.     .byte    $02,$02
  11369.  
  11370.     .byte    $05
  11371.     .byte    "white"
  11372.     .byte    $00
  11373.     .byte    $01,$01
  11374.  
  11375.     .byte    $06
  11376.     .byte    "yellow"
  11377.     .byte    $00
  11378.     .byte    $07,$07
  11379.  
  11380. ;ddskey:    .byte    $01
  11381.  
  11382. ;    .byte    $05
  11383. ;    .asciz    /DRIVE/
  11384. ;    .byte    $00,$00
  11385.  
  11386. kerehr:    .byte    cmcfm        ; tell them they can also confirm
  11387.     .byte    nul        ; end help command string
  11388.  
  11389. kereht:    .byte    cmtxt        ;[]
  11390.     .byte    nul
  11391.  
  11392. kerhlp: .byte    cr
  11393.     .byte    "Kermit commands for this version are:"
  11394.     .byte    cr
  11395.     .byte    cr
  11396.     .byte    "Bye       Shut  down  and  log  out  a"    ; new command
  11397.     .byte    cr                        ;
  11398.     .byte    "          remote  Kermit server,  then"    ;
  11399.     .byte    cr                        ;
  11400.     .byte    "          exit."                ;
  11401.     .byte    cr
  11402.     .byte    cr
  11403.     .byte    "Connect   Allow user to talk to remote"
  11404.     .byte    cr
  11405.     .byte    "          Kermit directly."
  11406.     .byte    cr
  11407.     .byte    cr
  11408. ;    .ascii  /dos       send dos command to disk/    ;[DD]
  11409.     .byte    "Directory List disk directory."        ;[]
  11410.     .byte    cr
  11411.     .byte    cr
  11412.     .byte    "Disk      Send command string to disk."    ;[]
  11413.     .byte    cr
  11414.     .byte    cr
  11415.     .byte    "Exit      Exit  from  Kermit  back  to"
  11416.     .byte    cr
  11417.     .byte    "          the  host operating  system."
  11418.     .byte    cr
  11419.     .byte    cr
  11420.     .byte    "Finish    Shut   down  remote   Kermit"  ; new command
  11421.     .byte    cr                      ;
  11422.     .byte    "          server  but  do not  log out"  ;
  11423.     .byte    cr                      ;
  11424.     .byte    "          remote job. Do not exit from"  ;
  11425.     .byte    cr                        ;
  11426.     .byte    "          local Kermit."            ;
  11427.     .byte    cr
  11428.     .byte    cr
  11429.     .byte    "Get       Fetch  a file from a  remote"  ; new command
  11430.     .byte    cr                        ;
  11431.     .byte    "          server Kermit.  The filename"  ;
  11432.     .byte    cr                        ;
  11433.     .byte    "          is  validated by  the remote"  ;
  11434.     .byte    cr                        ;
  11435.     .byte    "          server."                ;
  11436.     .byte    cr                        ;
  11437.     .byte    cr                        ;
  11438.     .byte    "Quit      Same as exit."
  11439.     .byte    cr
  11440.     .byte    cr
  11441.     .byte    "Receive   Receive a file or file group"
  11442.     .byte    cr
  11443.     .byte    "          from the remote host."
  11444.     .byte    cr
  11445.     .byte    cr
  11446.     .byte    "Restore   Restore  Kermit  parameters"    ;[47]
  11447.     .byte    cr
  11448.     .byte    "          from file KERMIT.INI."
  11449.     .byte    cr
  11450.     .byte    cr
  11451.     .byte    "Save      Save  Kermit  parameters in"    ;[47]
  11452.     .byte    cr
  11453.     .byte    "          file KERMIT.INI."
  11454.     .byte    cr
  11455.     .byte    cr
  11456.     .byte    "Send      Sends  a   file   from   the"
  11457.     .byte    cr
  11458.     .byte    "          Commodore  to   the   remote"
  11459.     .byte    cr
  11460.     .byte    "          host."
  11461.     .byte    cr
  11462.     .byte    cr
  11463.     .byte    "Set       Establish various parameters,"
  11464.     .byte    cr
  11465.     .byte    "          such as debugging mode,  eol"
  11466.     .byte    cr
  11467.     .byte    "          character, and  transmission"
  11468.     .byte    cr
  11469.     .byte    "          delay."
  11470.     .byte    cr
  11471.     .byte    cr
  11472.     .byte    "Show      Display  various  parameters"
  11473.     .byte    cr
  11474.     .byte    "          established   by   the   set"
  11475.     .byte    cr
  11476.     .byte    "          command."
  11477.     .byte    cr
  11478.     .byte    cr
  11479.     .byte    "Status    Give  information about  the"
  11480.     .byte    cr
  11481.     .byte    "          last file transfer."
  11482.     .byte    cr,nul
  11483.  
  11484. inthlp: .byte    "One of the following:"
  11485.     .byte    cr
  11486.     .byte    "     ? - this help message."
  11487.     .byte    cr
  11488.     .byte    "     b - send a break signal."
  11489.     .byte    cr
  11490.     .byte    "     c - close the connection."
  11491.     .byte    cr
  11492.     .byte    "     s - status of connection."
  11493.     .byte    cr
  11494.     .byte    "     0 - send a null."
  11495.     .byte    cr
  11496.     .byte    "     escape-char - transmit the escape character."
  11497.     .byte    cr,nul
  11498.  
  11499. .SBTTL    Message Text
  11500.  
  11501. ermes1: .byte    cr
  11502.     .byte    "? Unrecognized command"
  11503.     .byte    0        ; [53]
  11504.  
  11505. ermes2: .byte    cr
  11506.     .byte    "? Illegal character"
  11507.     .byte    0        ; [53]
  11508.  
  11509. ermes3: .byte    cr
  11510.     .byte    "? Not confirmed"
  11511.     .byte    0        ; [53]
  11512.  
  11513. ermes4: .byte    cr
  11514.     .byte    "? Integer out of range"
  11515.     .byte    0        ; [53]
  11516.  
  11517. ermes5: .byte    cr
  11518.     .byte    "? ASCII character is not in proper range"
  11519.     .byte    0        ; [53]
  11520.  
  11521. ermes6: .byte    cr
  11522.     .byte    "? Expecting keyword"
  11523.     .byte    0        ; [53]
  11524.  
  11525. ermes7: .byte    cr
  11526.     .byte    "? Expecting file spec"
  11527.     .byte    0        ; [53]
  11528.  
  11529. ermes8: .byte    cr
  11530.     .byte    "? Expecting integer"
  11531.     .byte    0        ; [53]
  11532.  
  11533. ermes9: .byte    cr
  11534.     .byte    "? Expecting switch"
  11535.     .byte    0        ; [53]
  11536.  
  11537. ermesa:    .byte    cr
  11538.     .byte    "?"
  11539.     .byte    0        ; [53]
  11540.  
  11541. ermesb:    .byte    cr
  11542.     .byte    "? Null string found while looking for text"
  11543.     .byte    0        ; [53]
  11544.  
  11545. ermesc:    .byte    cr
  11546.     .byte    "? Could not send generic logout packet"
  11547.     .byte    0        ; [53]
  11548.  
  11549. ermesd:    .byte    cr
  11550.     .byte    "? Could not send generic finish packet"
  11551.     .byte    0        ; [53]
  11552.  
  11553. ermesf:    .byte    cr
  11554.     .byte    "? Drive number out of range"
  11555.     .byte    0        ; [53]
  11556.  
  11557.  
  11558. erms0a: .byte    "Disk error stat =       "
  11559.     .byte    0        ; [53]
  11560.  
  11561. erms10: .byte    "Cannot receive init     "
  11562.     .byte    0        ; [53]
  11563.  
  11564. erms11: .byte    "Cannot receive file-head"
  11565.     .byte    0        ; [53]
  11566.  
  11567. erms12: .byte    "Cannot receive data     "
  11568.     .byte    0        ; [53]
  11569.  
  11570. erms14: .byte    "Max retry count exceeded"
  11571.     .byte    0        ; [53]
  11572.  
  11573. erms15: .byte    "Bad chksum:pack, actual "
  11574.     .byte    0        ; [53]
  11575.  
  11576. erms16: .byte    "Program error in rpak   "
  11577.     .byte    0        ; [53]
  11578.  
  11579. erms17: .byte    "8-bit quoting refused   "
  11580.     .byte    0        ; [53]
  11581.  
  11582. erms18: .byte    "Transfer aborted by user"
  11583.     .byte    0        ; [53]
  11584.  
  11585. erms19: .byte    "Cannot alter filename   "
  11586.     .byte    0        ; [53]
  11587.  
  11588. erms1a: .byte    "File already exists     "
  11589.     .byte    0        ; [53]
  11590.  
  11591.  
  11592. kerftp: .byte    "ascii     "
  11593.     .byte    0        ; [53]
  11594.  
  11595.     .byte    "petscii   "
  11596.     .byte    0        ; [53]
  11597.  
  11598.     .byte    "script    "
  11599.     .byte    0        ; [53]
  11600.  
  11601.     .byte    "binary    "
  11602.     .byte    0        ; [53]
  11603.  
  11604.     .byte    "c-power   "
  11605.     .byte    0
  11606.  
  11607. kerprs:    .byte    "none "        ; parity strings
  11608.     .byte    0        ; [53]
  11609.  
  11610.     .byte    "space"        ;
  11611.     .byte    0        ; [53]
  11612.  
  11613.     .byte    "mark "        ;
  11614.     .byte    0        ; [53]
  11615.  
  11616.     .byte    "odd  "        ;
  11617.     .byte    0        ; [53]
  11618.  
  11619.     .byte    "even "        ;
  11620.     .byte    0        ; [53]
  11621.  
  11622.  
  11623. parval:    .byte    $00        ;[17] None
  11624.     .byte    $e0        ;[17] Space
  11625.     .byte    $a0        ;[17] Mark
  11626.     .byte    $20        ;[17] Odd
  11627.     .byte    $60        ;[17] Even
  11628.  
  11629. kerbds:    .byte    "300 "
  11630.     .byte    0
  11631.     .byte    "1200"
  11632.     .byte    0
  11633.     .byte    "2400"
  11634.     .byte    0
  11635.  
  11636. bdval:    .word    $0645,$0645    ;  300 baud, slow + fast modes
  11637.     .word    $013c,$0148    ; 1200 baud, slow + fast modes
  11638.     .word    $0071,$0074    ; 2400 baud, doesn't work well in slow mode
  11639.  
  11640. kerdms:    .byte    "off     "    ; Debug mode strings
  11641.     .byte    0        ; [53]
  11642.  
  11643.     .byte    "terse   "    ;
  11644.     .byte    0        ; [53]
  11645.  
  11646.     .byte    "verbose "    ;
  11647.     .byte    0        ; [53]
  11648.  
  11649. kertms:    .byte    "none  "    ; terminal emulation strings
  11650.     .byte    0
  11651.  
  11652.     .byte    "vt-52 "
  11653.     .byte    0
  11654.  
  11655.     .byte    "vt-100"
  11656.     .byte    0
  11657.  
  11658.  
  11659. kerrts: .byte    "Spak:     Sending           - "
  11660.     .byte    0        ; [53]
  11661.  
  11662.     .byte    "Spakch:   Send complete     - "
  11663.     .byte    0        ; [53]
  11664.  
  11665.     .byte    "Rpak:     Trying to receive - "
  11666.     .byte    0        ; [53]
  11667.  
  11668.     .byte    "Rpkfls:   Failed to receive - "
  11669.     .byte    0        ; [53]
  11670.  
  11671.     .byte    "Rpkret:   Received          - "
  11672.     .byte    0        ; [53]
  11673.  
  11674.  
  11675. debms1: .byte    "Additional data"
  11676.     .byte    0        ; [53]
  11677.  
  11678. debms2: .byte    "     Seq number           "
  11679.     .byte    0        ; [53]
  11680.  
  11681. debms3: .byte    "     Number of data chars "
  11682.     .byte    0        ; [53]
  11683.  
  11684. debms4: .byte    "     Packet checksum      "
  11685.     .byte    0        ; [53]
  11686.  
  11687.  
  11688. snin01: .byte    "Sending: packet no. "
  11689.     .byte    0        ; [53]
  11690.  
  11691. rcin01: .byte    "Waiting: packet no. "
  11692.     .byte    0        ; [53]
  11693.  
  11694.  
  11695. shin00: .byte    "Debugging is          "
  11696.     .byte    0        ; [53]
  11697.  
  11698. shin01: .byte    "Terminal emulation is "
  11699.     .byte    0        ; [53]
  11700.  
  11701. shin02: .byte    "Ibm-mode is           "
  11702.     .byte    0        ; [53]
  11703.  
  11704. shin03: .byte    "Local-echo is         "
  11705.     .byte    0        ; [53]
  11706.  
  11707. shin04: .byte    "Eight-bit-quoting is  "
  11708.     .byte    0        ; [53]
  11709.  
  11710. shin05: .byte    "File-warning is       "
  11711.     .byte    0        ; [53]
  11712.  
  11713. shin06: .byte    "Escape character is   "
  11714.     .byte    0        ; [53]
  11715.  
  11716. shin07: .byte    "Send"
  11717.     .byte    0        ; [53]
  11718.  
  11719. shin08: .byte    "  Eight-bit-quoting char is   "
  11720.     .byte    0        ; [53]
  11721.  
  11722. shin09: .byte    "  End-of-line character is    "
  11723.     .byte    0        ; [53]
  11724.  
  11725. shin10: .byte    "  Packet-length is            "
  11726.     .byte    0        ; [53]
  11727.  
  11728. shin11: .byte    "  Padding character is        "
  11729.     .byte    0        ; [53]
  11730.  
  11731. shin12: .byte    "  Amount of padding is        "
  11732.     .byte    0        ; [53]
  11733.  
  11734. shin13: .byte    "  Quote character is          "
  11735.     .byte    0        ; [53]
  11736.  
  11737. shin14: .byte    "  Timeout character is        "
  11738.     .byte    0        ; [53]
  11739.  
  11740. shin15: .byte    "Receive"
  11741.     .byte    0        ; [53]
  11742.  
  11743. shin16: .byte    "File-type mode is     "
  11744.     .byte    0        ; [53]
  11745.  
  11746. shin17: .byte    "File-byte-size is     "
  11747.     .byte    0        ; [53]
  11748.  
  11749. shin18: .byte    "RS-232 registers =    $"
  11750.     .byte    0        ; [53]
  11751.  
  11752. shin19:    .byte    "Baud rate is          "    ;[17]
  11753.     .byte    0        ; [53]
  11754.  
  11755. shin20:    .byte    "Parity is             "    ;  FOR /SHOW PARITY/
  11756.     .byte    0        ; [53]
  11757.  
  11758. shin21:    .byte    "Word-size is          "    ;[17]
  11759.     .byte    0        ; [53]
  11760.  
  11761. shin22:    .byte    "Flow-control is       "    ;[24]
  11762.     .byte    0        ; [53]
  11763.  
  11764. shin23:    .byte    "Default-drive is      "
  11765.     .byte    0        ; [53]
  11766.  
  11767.  
  11768. shon:    .byte    "on"
  11769.     .byte    0        ; [53]
  11770.  
  11771. shoff:  .byte    "off"
  11772.     .byte    0        ; [53]
  11773.  
  11774. shsbit: .byte    "seven-bit"
  11775.     .byte    0        ; [53]
  11776.  
  11777. shebit: .byte    "eight-bit"
  11778.     .byte    0        ; [53]
  11779.  
  11780.  
  11781. sstrng:    .byte    "Sending: "            ; for terse debug
  11782.     .byte    0        ; [53]
  11783.  
  11784. rstrng:    .byte    "Received: "            ;        ...
  11785.     .byte    0        ; [53]
  11786.  
  11787.  
  11788. stin00: .byte    "Number of data chars sent is:     "
  11789.     .byte    0        ; [53]
  11790.  
  11791. stin01: .byte    "Number of data chars received is: "
  11792.     .byte    0        ; [53]
  11793.  
  11794. stin02: .byte    "Total no. of chars sent is:       "
  11795.     .byte    0        ; [53]
  11796.  
  11797. stin03: .byte    "Total no. of chars received is:   "
  11798.     .byte    0        ; [53]
  11799.  
  11800. stin04: .byte    "Overhead for send packets is:     "
  11801.     .byte    0        ; [53]
  11802.  
  11803. stin05: .byte    "Overhead for receive packets is:  "
  11804.     .byte    0        ; [53]
  11805.  
  11806. stin06: .byte    "Last error encountered is:        "
  11807.     .byte    0        ; [53]
  11808.  
  11809.  
  11810. inf01a: .byte    "[Connecting to host: type "
  11811.     .byte    0        ; [53]
  11812.  
  11813. inf01b: .byte    " c to return]"        ; second half of connect message
  11814.     .byte    0        ; [53]
  11815.  
  11816. .SBTTL    General Screen Manipulation Routines
  11817.  
  11818. ;
  11819. ;    These routines perform screen manipulation functions.  The usually
  11820. ;    call a screen driver, but some call lower-level manipulation routines.
  11821. ;
  11822. ;    These routines all turn the cursor off before calling the screen
  11823. ;    driver.
  11824. ;
  11825.  
  11826. ;
  11827. ;    scrini - call the screen drivers initilization code
  11828. ;
  11829. ;    Input:    None
  11830. ;    Output: Assorted screen parameters are set
  11831. ;
  11832. ;    Registers destroyed - A,X,Y
  11833. ;
  11834. ;    This routine initilizes some parameters and calls all of the screen
  11835. ;    drivers initilization code.
  11836. ;
  11837.  
  11838. scrini:    lda    #$00
  11839.     sta    line25        ; the 25th line is a status line
  11840.     jsr    c40ini
  11841.     jsr    c80ini
  11842.     jsr    c28ini
  11843.     jsr    b80ini
  11844.     jsr    m80ini
  11845.     rts
  11846.  
  11847. ;
  11848. ;    scrent - start up a screen driver
  11849. ;
  11850. ;    Input:    Screen type in scrtype
  11851. ;    Output: None
  11852. ;
  11853. ;    Registers destroyed - A,X,Y
  11854. ;
  11855. ;    This routine sets some parameters and then calls the screen driver to
  11856. ;    start it and set its parameters.  It then calls scred2 to erase the
  11857. ;    screen.
  11858. ;
  11859.  
  11860. scrent:    lda    #$00        ; cursor starts at row 1, column 1
  11861.     sta    cx
  11862.     sta    cy
  11863.     jsr    scrent1        ; call the screen driver
  11864.     jsr    scrtxt        ; initialize screen driver in text mode
  11865.     jsr    scrrst        ; reset parameters to normal values
  11866.     lda    line25        ; save the status of the 25th line
  11867.     pha
  11868.     lda    #$01        ; allow the 25th line to be cleared
  11869.     sta    line25
  11870.     jsr    scred2        ; clear entire screen
  11871.     pla            ; restore the status of the 25th line
  11872.     sta    line25
  11873.     rts            ; all done
  11874.  
  11875. scrent1:ldy    scrtype
  11876.     jsr    case
  11877.     .word    c40ent
  11878.     .word    c80ent
  11879.     .word    c28ent
  11880.     .word    b80ent
  11881.     .word    m80ent
  11882.  
  11883. ;
  11884. ;    scrext - exit from the screen driver
  11885. ;
  11886. ;    Input:    Screen type in scrtype
  11887. ;    Output: None
  11888. ;
  11889. ;    Registers destroyed - A,X,Y
  11890. ;
  11891. ;    This routine calls the screen driver to exit.  The hardware is returned
  11892. ;    to the state it was left in before kermit started.
  11893. ;
  11894.  
  11895. scrext:    ldy    scrtype
  11896.     jsr    case
  11897.     .word    c40ext
  11898.     .word    c80ext
  11899.     .word    c28ext
  11900.     .word    b80ext
  11901.     .word    m80ext
  11902.  
  11903. ;
  11904. ;    scrrst - reset the screen parameters to normal values
  11905. ;
  11906. ;    Input:    None
  11907. ;    Output: Assorted parameters changed.
  11908. ;
  11909. ;    Registers destroyed - A
  11910. ;
  11911. ;    This routine sets reverse mode off, flashing off, the scrolling
  11912. ;    region to full size, and many other things
  11913. ;
  11914.  
  11915. scrrst:    lda    #0        ; top of scrolling area is line 1
  11916.     sta    top
  11917.     lda    #23        ; bottom of scrolling area is line 24
  11918.     clc
  11919.     adc    line25        ; or 25
  11920.     sta    bot
  11921.     lda    #$00
  11922.     sta    underln        ; underline is off
  11923.     sta    reverse        ; reverse is off
  11924.     sta    alternt        ; alternt colors are off
  11925.     sta    flash        ; flashing is disabled
  11926.     sta    deckpam        ; keypad is numeric
  11927.     sta    decckm        ; cursor is in application mode
  11928.     sta    decrev        ; screen is not reversed
  11929.     sta    decom        ; use absolute cursor addressing. not origion
  11930.     sta    lmn        ; new line mode is clear
  11931.     sta    irm        ; insert replace mode is replace
  11932.     sta    g0        ; mount U.S. character set on g0
  11933.     sta    g1        ; mount U.S. character set on g1
  11934.     sta    gx        ; select g0
  11935.     lda    #$01
  11936.     sta    wrap        ; autowrap is on
  11937.     sta    decanm        ; vt100 is not emulating a vt52
  11938.     sta    decarm        ; keys repeat by default
  11939.     jsr    scrsav        ; make these as the saved parameters
  11940.     ldx    #79        ; set/clear the tab stops for 80 columns
  11941. scrrst1:txa
  11942.     and    #$07        ; one tab stop every 8 characters
  11943.     sta    tabs,x        ; put the entry in tabs
  11944.     dex
  11945.     bpl    scrrst1        ; repeat for every column
  11946.     jsr    scrset        ; tell the screen driver that things changed
  11947.     rts            ; all done
  11948.  
  11949. ;
  11950. ;    scrset - reset the hardware after a "set screen xxxx" command
  11951. ;
  11952. ;    Input:    Screen type in scrtype.
  11953. ;        Assorted screen parameters
  11954. ;    Output: None
  11955. ;
  11956. ;    Registers destroyed - A,X,Y
  11957. ;
  11958. ;    This routine adjusts the hardware after a set command.
  11959. ;
  11960.  
  11961. scrset:    ldy    scrtype
  11962.     jsr    case
  11963.     .word    c40set
  11964.     .word    c80set
  11965.     .word    c28set
  11966.     .word    b80set
  11967.     .word    m80set
  11968.  
  11969. ;
  11970. ;    screee - fill screen with 'E's
  11971. ;
  11972. ;    Input:    Screen type in scrtype
  11973. ;    Output:    Screen is filled with 'E's
  11974. ;
  11975. ;    This routine simply fills the screen with 'E's.  Real exciting.
  11976. ;
  11977.  
  11978. screee:    jsr    scroff        ; turn cursor off now so we can use scrput3
  11979.     lda    cx        ; save the cursor x and y coordinates
  11980.     pha
  11981.     lda    cy
  11982.     pha
  11983.     jsr    scrbot        ; determine the line number of the bottom line
  11984.     sta    cy        ; row to start filling at
  11985. screee2:jsr    scrrgh        ; determine the column number of the far right
  11986.     sta    cx
  11987.     jsr    flowch        ; kludge.  Sends XOFF when/if necessary
  11988. screee1:lda    #'E-$20        ; 'E' in funny-ascii
  11989.     jsr    scrput3        ; scrput has too much overhead.  scrput3 works
  11990.     dec    cx        ; repeat till all of this line is done
  11991.     bpl    screee1
  11992.     dec    cy        ; repeat till all lines done
  11993.     bpl    screee2
  11994.     pla            ; restore cursor x and y coordinates
  11995.     sta    cy
  11996.     pla
  11997.     sta    cx
  11998.     rts            ; all done
  11999.  
  12000. ;
  12001. ;    scrput - put a character on the screen
  12002. ;
  12003. ;    Input:    Character to put in a-reg.
  12004. ;        Screen type in scrtype.
  12005. ;    Output: Screen ram, both color rams, and cursor position are changed.
  12006. ;
  12007. ;    Registers destroyed - A,X,Y
  12008. ;
  12009. ;    This routine puts a character on the screen.  It advances the cursor
  12010. ;    and scrolls the screen when necessary.  It handels a carriage
  12011. ;    return specially.  It prints a carriage return and line feed.
  12012. ;    This can only happen in the parser since telnet handels cr and lf
  12013. ;    special.
  12014. ;
  12015.  
  12016. scrput:    cmp    #$0d        ; is it a carriage return?
  12017.     bne    scrput4        ; no
  12018.     jsr    scrcr        ; yes.  Do a carriage return and line feed
  12019.     jsr    scrlf
  12020.     rts
  12021. scrput4:ldx    irm        ; insert replace mode set?
  12022.     beq    scrput6
  12023.     pha            ; save character to print
  12024.     jsr    scrirm        ; make room for it
  12025.     pla            ; remember character to print
  12026. scrput6:cmp    #'`        ; is this different in the graphics charset
  12027.     bcc    scrput5        ; no.
  12028.     ldx    gx        ; which character set is mouned
  12029.     ldy    g0,x        ; is the mounted charset graphics
  12030.     beq    scrput5        ; no
  12031.     clc            ; if grapics, add in 31
  12032.     adc    #31
  12033. scrput5:sec            ; convert to funey-ascii by subtracting $20
  12034.     sbc    #$20
  12035.     pha            ; save the character to put
  12036.     jsr    scroff        ; cant use screen driver while cursor blinks
  12037.     ldx    cx        ; check if cursor at rightmost edge
  12038.     jsr    scrrgh
  12039.     pla            ; restore character to put
  12040.     bcc    scrput2        ; no
  12041.     ldx    wrap        ; are we in wrap mode
  12042.     beq    scrput3        ; no. do not wrap
  12043.     pha            ; save the character to put
  12044.     jsr    scrcr        ; yes. do a carriage return
  12045.     jsr    scrlf        ; and a linefeed
  12046.     pla            ; restore the character to put
  12047. scrput2:jsr    scrput3        ; call the routine to put a character.
  12048.     inc    cx
  12049.     rts    
  12050.  
  12051. scrput3:ldy    scrtype        ; call the screen driver
  12052.     jsr    case
  12053.     .word    c40put
  12054.     .word    c80put
  12055.     .word    c28put
  12056.     .word    b80put
  12057.     .word    m80put
  12058.  
  12059. ;
  12060. ;    scrirm - make room for a character in insert/replace mode
  12061. ;
  12062.  
  12063. scrirm:    jsr    scroff        ; cant use screen driver while cursor blinks
  12064.     ldy    scrtype        ; call the screen driver
  12065.     jsr    case
  12066.     .word    c40irm
  12067.     .word    c80irm
  12068.     .word    c28irm
  12069.     .word    b80irm
  12070.     .word    m80irm
  12071.  
  12072. ;
  12073. ;    scrdch - delete one or more characters
  12074. ;    Input:    Number of characters to delete in A-reg
  12075. ;        screen type in scrtype
  12076. ;
  12077.  
  12078. scrdch:    pha            ; save number of characters to delete
  12079.     jsr    scroff        ; cant use screen driver while cursor blinks
  12080.     pla
  12081.     ldy    scrtype
  12082.     jsr    case
  12083.     .word    c40dch
  12084.     .word    c80dch
  12085.     .word    c28dch
  12086.     .word    b80dch
  12087.     .word    m80dch
  12088.  
  12089. ;
  12090. ;    scral - insert one or more lines
  12091. ;
  12092. ;    Input:    Number of lines to add in A-reg
  12093. ;        Cursor position in cx, cy
  12094. ;        Dimensions of scrolling region on top, bot
  12095. ;        Screen type in scrtype
  12096. ;
  12097.  
  12098. scral:    tax            ; save number of lines to add
  12099.     ldy    bot        ; see if cursor is below scrolling region
  12100.     cpy    cy
  12101.     bcc    scral2
  12102.     ldy    cy        ; see if cursor is above scrolling region
  12103.     cpy    top
  12104.     bmi    scral2
  12105.     lda    top
  12106.     pha            ; save the top of the scrolling region
  12107.     sty    top        ; set top to cy
  12108.     txa            ; restore number of lines to add
  12109.     jsr    scral1        ; go do it
  12110.     pla
  12111.     sta    top
  12112. scral2:    rts
  12113.  
  12114. scral1:    pha
  12115.     jsr    scroff        ; cannot run screen driver with cursor on
  12116.     pla            ; restore number of lines to add
  12117.     ldy    scrtype
  12118.     jsr    case
  12119.     .word    c40ri
  12120.     .word    c80ri
  12121.     .word    c28ri
  12122.     .word    b80ri
  12123.     .word    m80ri
  12124.  
  12125. ;
  12126. ;    scrdl - delete one or more lines
  12127. ;
  12128. ;    Input:    Number of lines to delete in A-reg
  12129. ;        Cursor position in cx, cy
  12130. ;        Dimensions of scrolling region on top, bot
  12131. ;        Screen type in scrtype
  12132. ;
  12133.  
  12134. scrdl:    tax            ; save number of lines to delete
  12135.     ldy    bot        ; see if cursor is below scrolling region
  12136.     cpy    cy
  12137.     bcc    scrdl2
  12138.     ldy    cy        ; see if cursor is above scrolling region
  12139.     cpy    top
  12140.     bmi    scrdl2
  12141.     lda    top
  12142.     pha            ; save the top of the scrolling region
  12143.     sty    top        ; set top to cy
  12144.     txa            ; restore number of lines to delete
  12145.     jsr    scrdl1        ; go do it
  12146.     pla
  12147.     sta    top
  12148. scrdl2:    rts
  12149.  
  12150. scrdl1:    pha
  12151.     jsr    scroff        ; cannot run screen driver with cursor on
  12152.     pla            ; restore number of lines to delete
  12153.     ldy    scrtype
  12154.     jsr    case
  12155.     .word    c40ind
  12156.     .word    c80ind
  12157.     .word    c28ind
  12158.     .word    b80ind
  12159.     .word    m80ind
  12160.  
  12161. ;
  12162. ;    scrcr - perform a carriage return
  12163. ;
  12164. ;    Input:    Screen type in scrtype.
  12165. ;        Cursor position in cx, cy
  12166. ;
  12167. ;    Output: New new cursor column in cx.
  12168. ;
  12169. ;    Registers destroyed - A,X,Y
  12170. ;
  12171. ;    This routine performs a carriage return.
  12172. ;
  12173.  
  12174. scrcr:    ldy    cy
  12175.     ldx    #$00        ; put cursor in column zero
  12176.     jsr    scrplt        ; move the cursor there
  12177.     rts            ; all done
  12178.  
  12179. ;
  12180. ;    scrlf - perform a line feed
  12181. ;
  12182. ;    Input:    screen type in scrtype
  12183. ;        cursor column in cy
  12184. ;        cursor row in cx
  12185. ;    Output: New cursor position in cx, cy.
  12186. ;
  12187. ;    Registers destroyed - A,X,Y
  12188. ;
  12189. ;    This routine performs a line feed.
  12190. ;
  12191.  
  12192. scrlf:    ldy    cy        ; check if bottom reached
  12193.     cpy    bot
  12194.     bcc    scrlf1        ; yes. scroll screen
  12195.     jmp    scrind
  12196. scrlf1:    iny
  12197.     ldx    cx
  12198.     jsr    scrplt        ; no. move the cursor down one line.
  12199.     rts
  12200. ;
  12201. ;    scrrlf - perform a reverse line feed with scrolling
  12202. ;
  12203. ;    Input:    Type of screen in scrtype
  12204. ;        Cursor coordinates in cx, cy
  12205. ;
  12206. ;    Output: None
  12207. ;
  12208. ;    Registers Destroyed: A,X,Y
  12209. ;
  12210. ;    This routine performs a reverse line feed.  The cursor is moved up
  12211. ;    one line.  If the cursor reaches the top of the scrolling area, scrri
  12212. ;    is called to scroll the screen backwards.
  12213. ;
  12214.  
  12215. scrrlf:    ldy    cy
  12216.     cpy    top
  12217.     beq    scrrlf1        ; reached top of the screen?
  12218.     dey            ; no, just move the cursor up
  12219.     ldx    cx
  12220.     jsr    scrplt
  12221.     rts
  12222. scrrlf1:jsr    scrri        ; yes, at top of screen.  Scroll backwards
  12223.     rts
  12224.  
  12225. ;
  12226. ;    scru - move the cursor up stopping at the top of the screen
  12227. ;
  12228. ;    Input:    Type of screen in scrtype
  12229. ;        Cursor coordinates in cx, cy
  12230. ;
  12231. ;    Output: None
  12232. ;
  12233. ;    Registers Destroyed: A,X,Y
  12234. ;
  12235. ;    This routine moves the cursor up.  If the cursor reaches the top
  12236. ;    of the screen it stops.
  12237. ;
  12238.  
  12239. scru:    ldy    cy
  12240.     beq    scru1        ; at top of screen?
  12241.     dey
  12242.     ldx    cx
  12243.     jsr    scrplt        ; move the cursor to its new position
  12244. scru1:    rts
  12245.  
  12246. ;
  12247. ;    scrd - move the cursor down stopping at the bottom of the screen
  12248. ;
  12249. ;    Input:    Type of screen in scrtype
  12250. ;        Cursor coordinates in cx, cy
  12251. ;
  12252. ;    Output: None
  12253. ;
  12254. ;    Registers Destroyed: A,X,Y
  12255. ;
  12256. ;    This routine moves the cursor down.  If the cursor reaches the bottom
  12257. ;    of the screen it stops.
  12258. ;
  12259.  
  12260. scrd:    ldy    cy
  12261.     iny
  12262.     jsr    scrbot        ; test to see if cursor past bottom
  12263.     bcs    scrd2        ; if so, dont move cursor
  12264.     ldx    cx
  12265.     jsr    scrplt        ; put the cursor at its new position
  12266. scrd2:    rts            ; all done
  12267.  
  12268. ;
  12269. ;    scrl - move the cursor left stopping at the left side of the screen
  12270. ;
  12271. ;    Input:    Type of screen in scrtype
  12272. ;        Cursor coordinates in cx, cy
  12273. ;
  12274. ;    Output: New cursor coordinates in cx, cy
  12275. ;
  12276. ;    Registers Destroyed: A,X,Y
  12277. ;
  12278. ;    This routine moves the cursor left.  If the cursor reaches the left
  12279. ;    most side of the display, it stops.
  12280. ;
  12281.  
  12282. scrl:    ldx    cx
  12283.     beq    scrl1        ; at left side of screen?
  12284.     dex
  12285.     ldy    cy
  12286.     jsr    scrplt        ; move the cursor to its new position
  12287. scrl1:    rts
  12288.  
  12289. ;
  12290. ;    scrr - move the cursor right stopping at the right side of the screen
  12291. ;
  12292. ;    Input:    Type of screen in scrtype
  12293. ;        Cursor coordinates in cx, cy
  12294. ;
  12295. ;    Output: New cursor coordinates in cx, cy
  12296. ;
  12297. ;    Registers Destroyed: A,X,Y
  12298. ;
  12299. ;    This routine moves the cursor right.  If the cursor reaches the right
  12300. ;    side of the screen it stops.
  12301. ;
  12302.  
  12303. scrr:    ldx    cx
  12304. scrr1:    inx            ; move the cursor right
  12305.     jsr    scrrgh        ; check if past rightmost edge
  12306.     bcs    scrr2
  12307.     ldy    cy
  12308.     jsr    scrplt        ; move the cursor to its new position
  12309. scrr2:    rts            ; all done
  12310.  
  12311. ;
  12312. ;    scrind - perfrom the VT100 index function (scroll the screen one line)
  12313. ;
  12314. ;    Input:    Screen type in scrtype
  12315. ;    Output:    None
  12316. ;
  12317. ;    Registers destroyed - A,X,Y
  12318. ;
  12319. ;    This routine scrolls the screen down one line. It calls either c40ind,
  12320. ;    c80ind, or c28ind depending on the screen type.
  12321. ;
  12322.  
  12323. scrind:    jsr    scroff        ; cant use screen driver while cursor blinks
  12324.     ldy    scrtype
  12325.     lda    #$01
  12326.     jsr    case
  12327.     .word    c40ind
  12328.     .word    c80ind
  12329.     .word    c28ind
  12330.     .word    b80ind
  12331.     .word    m80ind
  12332.  
  12333. ;
  12334. ;    scrri - perfrom the VT100 reverse index function (scroll backwards)
  12335. ;
  12336. ;    Input:    Screen type in scrtyp
  12337. ;    Output: Screen and color rams are changed
  12338. ;
  12339. ;    Registers destroyed - A,X,Y
  12340. ;
  12341. ;    This routine scrolls the screen up one line. It calls either c40ri,
  12342. ;    c80ri, or c28ri depending on the screen type.
  12343. ;
  12344.  
  12345. scrri:    jsr    scroff        ; cant use screen driver while cursor blinks
  12346.     ldy    scrtype
  12347.     lda    #$01
  12348.     jsr    case
  12349.     .word    c40ri
  12350.     .word    c80ri
  12351.     .word    c28ri
  12352.     .word    b80ri
  12353.     .word    m80ri
  12354.  
  12355. ;
  12356. ;    scrclr - home and clear the screen
  12357. ;
  12358. ;    This routine homes the cursor and clears the screen
  12359. ;
  12360.  
  12361. scrclr:    jsr    scrhom        ; home the cursor
  12362.     jsr    scred2        ; clear the screen
  12363.     rts            ; all done
  12364.  
  12365. ;
  12366. ;    scrhom - home the cursor
  12367. ;
  12368. ;    This routine homes the cursor
  12369. ;
  12370.  
  12371. scrhom:    ldx    #$00        ; home is at 0,0
  12372.     ldy    #$00
  12373.     jsr    scrplt        ; plot the cursor
  12374.     rts            ; all done
  12375.  
  12376. ;
  12377. ;    scred0 - perform the Erase Display #0 VT100 function
  12378. ;
  12379. ;    Input: Type of screen to erase in scrtype
  12380. ;
  12381. ;    Output: None
  12382. ;
  12383. ;    Registers Destroyed: A,X,Y
  12384. ;
  12385. ;    This routine clears from the cursor position to the end of the screen.
  12386. ;    This routine works in 40 column mode, 80 column mode, or Commodore 128
  12387. ;    mode.
  12388. ;
  12389.  
  12390. scred0:    lda    cy        ; save the cursor y position
  12391.     pha
  12392.     jsr    screl0        ; erase from the cursor to the line
  12393. scred0b:inc    cy        ; do the next line
  12394.     ldy    cy
  12395.     jsr    scrbot        ; on bottom line?
  12396.     bcs    scred0a        ; yes.
  12397.     jsr    screl2        ; erase all of this line
  12398.     jmp    scred0b        ; repeat till done
  12399. scred0a:pla            ; restore cursor y position
  12400.     sta    cy
  12401.     rts            ; all done
  12402.  
  12403. ;
  12404. ;    scred1 - perform the Erase Display #1 VT100 function
  12405. ;
  12406. ;    Input: Type of screen to erase in scrtype
  12407. ;
  12408. ;    Output: None
  12409. ;
  12410. ;    Registers Destroyed: A,X,Y
  12411. ;
  12412. ;    This routine clears from the beginning of the screen to the cursor.
  12413. ;    This routine works for 40 column mode, 80 column mode, and commodore
  12414. ;    128 mode.
  12415. ;
  12416.  
  12417.  
  12418. scred1:    lda    cy        ; save the cursor y position
  12419.     pha
  12420.     jsr    screl1        ; erase from beginning of line to cursor
  12421.     dec    cy        ; go up one line
  12422.     bmi    scred1a        ; on top of screen
  12423. scred1b:jsr    screl2        ; erase all of this line
  12424.     dec    cy
  12425.     bpl    scred1b        ; repeat till done
  12426. scred1a:pla            ; restore cursor position
  12427.     sta    cy
  12428.     rts            ; all done
  12429.  
  12430. ;
  12431. ;    scred2 - perform the Erase Display #2 VT100 function (clear screen)
  12432. ;
  12433. ;    Input: Type of screen to erase in scrtype
  12434. ;
  12435. ;    Output: None
  12436. ;
  12437. ;    Registers Destroyed: A,X,Y
  12438. ;
  12439. ;    This routine clears the entire screen in either 40 column mode,
  12440. ;    80 column mode, or c128 mode.  It calls screl2 to do the dirty work.
  12441. ;
  12442.  
  12443. scred2:    lda    cy        ; save the cursor y position
  12444.     pha
  12445.     jsr    scrbot        ; get bottom of screen
  12446.     sta    cy
  12447. scred2a:jsr    screl2        ; erase the line
  12448.     dec    cy        ; do the next line
  12449.     bpl    scred2a        ; repeat till done
  12450.     pla            ; restore cursor position
  12451.     sta    cy
  12452.     rts            ; all done
  12453.  
  12454. ;
  12455. ;    screl0 - Perform the VT100 Erase Line function #0
  12456. ;
  12457. ;    Input:    Line number to erase in cy
  12458. ;        Screen type in scrtyp
  12459. ;    Output: None
  12460. ;
  12461. ;    Registers destroyed - A,X,Y
  12462. ;
  12463. ;    This routine erases from the cursor to the end of the line
  12464. ;
  12465.  
  12466. screl0:    jsr    scroff        ; cant use screen driver while curosr blinks
  12467.     ldy    scrtype        ; which routine to use
  12468.     jsr    case
  12469.     .word    c40el0
  12470.     .word    c80el0
  12471.     .word    c28el0
  12472.     .word    b80el0
  12473.     .word    m80el0
  12474.  
  12475. ;
  12476. ;    screl1 - Perform the VT100 Erase Line function #1
  12477. ;
  12478. ;    Input:    Line number to erase in cy
  12479. ;        Screen type in scrtyp
  12480. ;    Output: None
  12481. ;
  12482. ;    Registers destroyed - A,X,Y
  12483. ;
  12484. ;    This routine erases from the beginning of line to the cursor
  12485. ;
  12486.  
  12487. screl1:    jsr    scroff        ; cant use screen driver while curosr blinks
  12488.     ldy    scrtype        ; which routine to use
  12489.     jsr    case
  12490.     .word    c40el1
  12491.     .word    c80el1
  12492.     .word    c28el1
  12493.     .word    b80el1
  12494.     .word    m80el1
  12495.  
  12496. ;
  12497. ;    screl2 - Perform the VT100 Erase Line function #2
  12498. ;
  12499. ;    Input:    Line number to erase in cy
  12500. ;        Type of screen in scrtype
  12501. ;    Output:    None
  12502. ;
  12503. ;    Registers destroyed - A,X,Y
  12504. ;
  12505. ;    This routine erases one line compleatly.
  12506. ;
  12507.  
  12508. screl2:    jsr    scroff        ; cant use screen driver while cursor blinks
  12509.     ldy    scrtype        ; which routine to use to erase
  12510.     jsr    case        ; go to proper routine
  12511.     .word    c40el2        ; erase one line on 40 column screen
  12512.     .word    c80el2        ; erase one line on 80 column screen
  12513.     .word    c28el2        ; erase one line on the commodore-128 screen
  12514.     .word    b80el2        ; erase one line on the BI-80 screen
  12515.     .word    m80el2        ; erase one line on the modified BI-80 screen
  12516.  
  12517. ;
  12518. ;    scrsav - save screen attributes and cursor position
  12519. ;
  12520. ;    Input:    screen attributes and cursor position
  12521. ;
  12522. ;    Output:    save1, save2, save3, ... save6
  12523. ;
  12524. ;    This routine saves the screen attributes and cursor position
  12525. ;    
  12526.  
  12527. scrsav:    lda    cx
  12528.     sta    save1
  12529.     lda    cy
  12530.     sta    save2
  12531.     lda    alternt
  12532.     sta    save3
  12533.     lda    underln
  12534.     sta    save4
  12535.     lda    flash
  12536.     sta    save5
  12537.     lda    reverse
  12538.     sta    save6
  12539.     lda    g0
  12540.     sta    save7
  12541.     lda    g1
  12542.     sta    save8
  12543.     lda    gx
  12544.     sta    save9
  12545.     rts
  12546.  
  12547. ;
  12548. ;    scrlod - load the saved screen attributes and cursor position
  12549. ;
  12550. ;    Input:    save1, save2, save3, ... save6
  12551. ;
  12552. ;    This routine restores the saved screen attributes and cursor position
  12553. ;
  12554.  
  12555. scrlod:    ldx    save1
  12556.     ldy    save2
  12557.     jsr    scrplt
  12558.     lda    save3
  12559.     sta    alternt
  12560.     lda    save4
  12561.     sta    underln
  12562.     lda    save5
  12563.     sta    flash
  12564.     lda    save6
  12565.     sta    reverse
  12566.     lda    save7
  12567.     sta    g0
  12568.     lda    save8
  12569.     sta    g1
  12570.     lda    save9
  12571.     sta    gx
  12572.     rts
  12573.  
  12574. ;
  12575. ;    scrplt - plot the cursor
  12576. ;
  12577. ;    Input:    Cursor X position in X-reg
  12578. ;        Cursor Y position in Y-reg
  12579. ;
  12580. ;    Output: cx and cy are set.
  12581. ;
  12582. ;    Registers destroyed - A,X,Y
  12583. ;
  12584. ;    This routine puts the cursor at X,Y.
  12585. ;
  12586.  
  12587. scrplt:    tya            ; save the new y position
  12588.     pha
  12589.     txa            ; save the new x position
  12590.     pha        
  12591.     jsr    scroff        ; turn off the cursor
  12592.     pla            ; get the new x position
  12593.     sta    cx
  12594.     pla            ; get the new y position
  12595.     sta    cy
  12596. scrplt1:rts            ; all done
  12597.  
  12598. ;
  12599. ;    scroff - disable the cursor.
  12600. ;
  12601. ;    Input:    cx, cy, curstat, curabrt, scrtype
  12602. ;
  12603. ;    Output: curabrt
  12604. ;
  12605. ;    Registers destroyed - A,X,Y
  12606. ;
  12607. ;    This routine disables the cursor.  It calls the proper screen driver
  12608. ;    to do the dirty work.
  12609. ;
  12610.  
  12611. scroff:    lda    curabrt        ; is the cursor flash already aborted?
  12612.     bne    scroff1        ; yes.
  12613.     lda    curstat        ; cursor light?
  12614.     beq    scroff1        ; yes.
  12615.     sta    curabrt        ; mark cursor flash as aborted
  12616.     jsr    scrtgl        ; toggle the cursor
  12617. scroff1:rts            ; all done
  12618.  
  12619. ;
  12620. ;    scrfls - flash the screen and cursor
  12621. ;
  12622. ;    Input:    curstat - status of cursor (light or dark)
  12623. ;        curabrt - flag indicating if cursor flash was aborted early.
  12624. ;        scrtype - type of screen
  12625. ;
  12626. ;    Output: curstat - curstat is toggled if time
  12627. ;        curabrt - curabrt is always cleared
  12628. ;
  12629. ;    Registers destroyed - A,X,Y
  12630. ;
  12631. ;    This routine flashes the screen and toggles the cursor. This routine
  12632. ;    should be called a frequently as possible.
  12633. ;
  12634.  
  12635. scrfls:    lda    curabrt        ; was the cursor flash aborted early?
  12636.     beq    scrfls1        ; no.  No need to light it.
  12637.     lda    #$00        ; clear the abort flag
  12638.     sta    curabrt
  12639.     jsr    scrtgl        ; toggle the cursor
  12640. scrfls1:jsr    rdtim        ; check the time 
  12641.     tay            ; save time for later use
  12642.     sec
  12643.     sbc    cntdown
  12644.     cmp    #20        ; have  36 jiffies elapsed?
  12645.     bcs    scrfls2        ; yes they have
  12646.     rts            ; no they havent.  stop here
  12647. scrfls2:sty    cntdown        ; reset the countdown timer
  12648.     jsr    scrtgl        ; toggle the cursor status
  12649.     ldy    scrtype        ; flash the flashing characters
  12650.     jsr    case
  12651.     .word    c40fls
  12652.     .word    c80fls
  12653.     .word    c28fls
  12654.     .word    b80fls
  12655.     .word    m80fls
  12656.  
  12657. ;
  12658. ;    scrtgl - Toggle the cursor
  12659. ;
  12660. ;    Input:    cx - x coordinate of cursor
  12661. ;        cy - y coordinate of cursor
  12662. ;        Type of screen in scrtype
  12663. ;
  12664. ;    Output: None
  12665. ;
  12666. ;    Registers destroyed - A,X,Y
  12667. ;
  12668. ;    this routine calls the screen driver to toggle the cursor
  12669. ;
  12670.  
  12671. scrtgl:    lda    curstat        ; keep track if cursor is dark or light
  12672.     eor    #$01
  12673.     sta    curstat
  12674.     ldy    scrtype        ; call the screen driver
  12675.     jsr    case
  12676.     .word    c40tgl
  12677.     .word    c80tgl
  12678.     .word    c28tgl
  12679.     .word    b80tgl
  12680.     .word    m80tgl
  12681.  
  12682. ;
  12683. ;    scrbel - stop the sound of the bell
  12684. ;
  12685. ;    Input:    lpcnt - time when the bell sound started
  12686. ;
  12687. ;    Output:    wave is zeroed to stop the bell
  12688. ;
  12689. ;    This routine stops the sound of the bell if enough jiffys
  12690. ;    have elapsed since it started.
  12691. ;    This routine should be called as often as possible.
  12692. ;
  12693.  
  12694. scrbel:    jsr    rdtim        ; what time is it now?
  12695.     sec
  12696.     sbc    lpcnt        ; subtract the time the bell started
  12697.     cmp    #6        ; been 6 jiffys since it started?
  12698.     bcc    scrbel1        ; nope.  Dont stop the bell yet
  12699.     lda    #$00
  12700.     sta    wave        ; stop the bell
  12701. scrbel1:rts            ; all done
  12702.  
  12703. ;
  12704. ;    scrbot - check to see if y-reg is below bottom of screen
  12705. ;
  12706. ;    Input:    line25
  12707. ;
  12708. ;    Output:    Carry flag set if past bottom of screen
  12709. ;        A-reg holds line number of screen bottom
  12710. ;
  12711. ;    This routine checks to see if the y-reg is greater than the bottom
  12712. ;    of the screen.
  12713.  
  12714. scrbot:    lda    line25        ; check to see if the 25th line is in use
  12715.     bne    scrbot1        ; branch if it is
  12716.     lda    #23
  12717.     cpy    #24
  12718.     rts
  12719. scrbot1:lda    #24        ; 25th line is enabled
  12720.     cpy    #25        ; lines 25 and up are illegal
  12721.     rts
  12722.  
  12723. ;
  12724. ;    scrrgh - check to see if x-reg is past right margin of screen
  12725. ;
  12726. ;    Input:    scrtype
  12727. ;
  12728. ;    Output:    Carry flag set if past right margin of screen
  12729. ;        A-reg holds right margin of screen
  12730. ;
  12731. ;    This routine checks to see if the x-reg is greater than the bottom
  12732. ;    of the screen.
  12733.  
  12734. scrrgh:    lda    scrtype        ; check to see if in 40-column mode
  12735.     beq    scrrgh1        ; branch if it is
  12736.     lda    #79
  12737.     cpx    #80
  12738.     rts
  12739. scrrgh1:lda    #39        ; only 40 columns available
  12740.     cpx    #40
  12741.     rts
  12742.  
  12743. ;
  12744. ;    scrdrw - draw a character in graphics mode
  12745. ;
  12746. ;    Input:    character to draw in a-reg
  12747. ;        place to draw in tektxlo, tektxhi, tektylo, tektylo
  12748. ;        screen driver in scrtype
  12749. ;    Output:    char is drawen
  12750. ;
  12751. ;    This routine calls the screen driver to draw a character in graphics
  12752. ;    mode.
  12753. ;
  12754.  
  12755. scrdrw:    ldy    scrtype
  12756.     jsr    case
  12757.     .word    c40drw        ; 40 column mode
  12758.     .word    c80drw        ; 80 column mode
  12759.     .word    c28drw        ; commodore-128 mode
  12760.     .word    b80drw        ; batteries included
  12761.     .word    m80drw        ; modified batteries included
  12762.  
  12763. ;
  12764. ;    scrtek - go into tektronix mode
  12765. ;
  12766. ;    Input:    screen driver in scrtype
  12767. ;
  12768. ;    This routine calls the proper screen driver to start tektronix mode.
  12769. ;
  12770.  
  12771. scrtek:    ldy    scrtype
  12772.     jsr    case
  12773.     .word    c40tek        ; 40 column mode
  12774.     .word    c80tek        ; 80 column mode
  12775.     .word    c28tek        ; commodore-128 mode
  12776.     .word    b80tek        ; batteries included mode
  12777.     .word    m80tek        ; modified batteries included mode
  12778.  
  12779. ;
  12780. ;    scrtxt - return to text mode from tektronix modoe
  12781. ;
  12782. ;    Input:    screen driver in scrtype
  12783. ;
  12784. ;    This routine calls the proper screen driver to exit tektronix mode.
  12785. ;
  12786.  
  12787. scrtxt:    lda    #$00
  12788.     sta    curstat
  12789.     lda    #$01        ; mark cursor flash as aborted
  12790.     sta    curabrt        ; cursor is off but supposed to be on
  12791.     jsr    rdtim        ; set cntdown to wait the usual amount of time
  12792.     sta    cntdown
  12793.     ldy    scrtype
  12794.     jsr    case
  12795.     .word    c40txt        ; 40 column mode
  12796.     .word    c80txt        ; 80 column mode
  12797.     .word    c28txt        ; commodore-128 mode
  12798.     .word    b80txt        ; batteries included mode
  12799.     .word    m80txt        ; modified batteries included mode
  12800.  
  12801. ;
  12802. ;    scrlin - draw a line in graphics mode
  12803. ;
  12804. ;    Input:    starting point: tekfxlo, tekfxhi, tekfylo, tekfyhi
  12805. ;        ending point:   tektxlo, tektxhi, tektylo, tektyhi
  12806. ;
  12807. ;    This routine calls the proper screen driver to draw a line.
  12808. ;
  12809.  
  12810. scrlin:    ldy    scrtype
  12811.     jsr    case
  12812.     .word    c40lin        ; 40 column mode
  12813.     .word    c80lin        ; 80 column mode
  12814.     .word    c28lin        ; commodore-128 mode
  12815.     .word    b80lin        ; batteries included mode
  12816.     .word    m80lin        ; modified batteries included mode
  12817.  
  12818. ;
  12819. ;    screra - erase the graphics screen
  12820. ;
  12821. ;    This routine calls the proper screen driver to erase the graphics
  12822. ;    screen.
  12823. ;
  12824.  
  12825. screra:    ldy    scrtype
  12826.     jsr    case
  12827.     .word    c40era        ; 40 column mode
  12828.     .word    c80era        ; 80 column mode
  12829.     .word    c28era        ; commodore-128 mode
  12830.     .word    b80era        ; batteries included mode
  12831.     .word    m80era        ; modified batteries included mode
  12832.  
  12833. ;
  12834. ;    scrint - put graphics coordinate into internal form
  12835. ;
  12836. ;    Input:    tekcxlo, tekcxhi, tekcylo, tekcyhi
  12837. ;        screen driver in scrtype
  12838. ;    Output: tektxlo, tektxhi, tektylo, tektylo
  12839. ;
  12840.  
  12841. scrint:    ldy    scrtype
  12842.     jsr    case
  12843.     .word    c40int        ; 40 column mode
  12844.     .word    c80int        ; 80 column mode
  12845.     .word    c28int        ; commodore-128
  12846.     .word    b80int        ; batteries included mode
  12847.     .word    m80int        ; modified batteries included mode
  12848.     
  12849. ;
  12850. ;    scrtst - test to see if a given screen driver is present
  12851. ;
  12852. ;    Input:    Desired screen type in a-reg
  12853. ;    Output: carry clear if present, set otherwise
  12854. ;
  12855. ;    Registers destroyed - A,X,Y
  12856. ;
  12857. ;    This routine checks to see if a given screen driver is present.
  12858. ;    Currently the only one that might not be available is the
  12859. ;    Commodore 128 80-column screen.
  12860. ;
  12861.  
  12862. scrtst:    tay            ; device to test for
  12863.     jsr    case
  12864.     .word    c40tst
  12865.     .word    c80tst
  12866.     .word    c28tst
  12867.     .word    b80tst
  12868.     .word    m80tst
  12869.  
  12870. .SBTTL    Modified Batteries Included 80-column screen driver
  12871.  
  12872. ;
  12873. ;    These routines manipulate the screen using a Batteries Included
  12874. ;    80-column card with a custom ROM.
  12875. ;
  12876.  
  12877. ;
  12878. ;    The only thing different in this screen driver is that this screen
  12879. ;    driver uses the uppercase/graphics half of the character rom.  It
  12880. ;    is the half that has been modified.
  12881.  
  12882. ;
  12883. ;    m80txt - enter text mode (possibly from graphics mode)
  12884. ;
  12885. ;    If the b80flag is clear, then we are in graphics mode and must
  12886. ;    call the 80-column screen driver to leave it.  Otherwise we
  12887. ;    just call a rom routine (on the bi-80 card) to initialize things.
  12888. ;
  12889.  
  12890. m80txt:    asl    b80flag        ; test and clear the flag
  12891.     bcs    m80txt1        ; skip graphics stuff if not in graphics mode
  12892.     jsr    m80ext        ; turn off graphics.
  12893. m80txt1:lda    #$37
  12894.     sta    $01        ; turn the rom back on.
  12895.     jsr    $80f4        ; initialize 80 column display
  12896.     lda    #$36
  12897.     sta    $01        ; back to normal memory map
  12898.     lda    #$0c        ; put in upper-case/graphics mode
  12899.     sta    $df00
  12900.     lda    #$20
  12901.     sta    $df10
  12902.     rts            ; all done
  12903.  
  12904. m80ini:    jmp    b80ini
  12905. m80ent:    jmp    b80ent
  12906. m80ext:    jmp    b80ext
  12907. m80set:    jmp    b80set
  12908. m80put:    jmp    b80put
  12909. m80irm:    jmp    b80irm
  12910. m80dch:    jmp    b80dch
  12911. m80ind:    jmp    b80ind
  12912. m80ri:    jmp    b80ri
  12913. m80el0:    jmp    b80el0
  12914. m80el1:    jmp    b80el1
  12915. m80el2:    jmp    b80el2
  12916. m80fls:    jmp    b80fls
  12917. m80tgl:    jmp    b80tgl
  12918. m80tek:    jmp    b80tek
  12919. m80drw:    jmp    b80drw
  12920. m80lin:    jmp    b80lin
  12921. m80era:    jmp    b80era
  12922. m80int:    jmp    b80int
  12923. m80tst:    jmp    b80tst
  12924.  
  12925. .SBTTL    Batteries Included 80-column screen driver
  12926.  
  12927. ; 
  12928. ;     These routines manipulate the screen in Batteries Included mode
  12929. ; 
  12930.  
  12931. ; 
  12932. ;    b80ini - initialize the Batteries Included screen.
  12933. ; 
  12934. ;     Input:    None
  12935. ; 
  12936. ;     Output:    None
  12937. ; 
  12938. ;    This routine does nothing because all the hardware is initialized
  12939. ;    when the 80-column card is entered.
  12940. ;
  12941.  
  12942. b80ini:    rts
  12943.  
  12944. ;
  12945. ;    b80ent - enter the Batteries Included screen driver
  12946. ;
  12947. ;    Input:    None
  12948. ;
  12949. ;    Output:    None
  12950. ;
  12951. ;    This routine sets a flag so that b80txt knows what to do.
  12952. ;
  12953.  
  12954. b80ent:    lda    #$80
  12955.     sta    b80flag
  12956.     rts
  12957.  
  12958. ;
  12959. ;    b80ext - exit from the Batteries Included screen-driver
  12960. ;
  12961. ;    Input:    None
  12962. ;
  12963. ;    Output:    None
  12964. ;
  12965. ;    This routine calls the rom routine at $80fd to de-init the CRTC chip
  12966. ;
  12967.  
  12968. b80ext:    lda    #$37
  12969.     sta    $01        ; turn the rom back on.
  12970.     jsr    $80fd        ; de-init the 80 column display
  12971.     lda    #$36
  12972.     sta    $01        ; back to normal memory map
  12973.     lda    bordold        ; border color fouled up by BI-80
  12974.     sta    $d020
  12975.     rts            ; all done
  12976.  
  12977. ;
  12978. ;    b80set - change the hardware after a "set screen xxx" command
  12979. ;
  12980. ;    This routine does nothing because there is nothing on the B80 card
  12981. ;    that can be set.
  12982. ;
  12983.  
  12984. b80set:    rts
  12985.  
  12986. ;
  12987. ;    b80put - put a character on the Batteries Included screen
  12988. ;
  12989. ;    Input:    A-reg is the character to put
  12990. ;        cx and cy show where to put it
  12991. ;
  12992. ;    Output:    A character is displayed upon the Batteries Included screen
  12993. ;
  12994. ;    This routine prints stuff on the Batteries Included screen.  It does
  12995. ;    not advance the cursor.
  12996. ;
  12997.  
  12998. b80put:    ldx    #b80map2-b80map1; run it through the translation table
  12999. b80put1:cmp    b80map1-1,x    ; look for character less than current
  13000.     bcs    b80put2
  13001.     dex
  13002.     bne    b80put1        ; always taken
  13003. b80put2:sbc    b80map1-1,x    ; carry already set
  13004.     clc
  13005.     adc    b80map2-1,x    ; now we have a screen code
  13006.     pha
  13007.     ldx    cx
  13008.     ldy    cy
  13009.     jsr    b80adrt        ; compute the address to store char at
  13010.     pla            ; remember screen code to store
  13011.     cmp    #$20        ; is it a space?
  13012.     beq    b80put3        ; dont reverse if highlighted space
  13013.     ldx    alternt        ; in alternate color mode?
  13014.     beq    b80put3
  13015.     ora    #$80        ; yes.  Reverse will have to do....
  13016. b80put3:ldx    reverse        ; is reverse on?
  13017.     beq    b80put4        ; no.  dont reverse
  13018.     ora    #$80
  13019. b80put4:ldx    underln        ; underline on?
  13020.     beq    b80put5
  13021.     ora    #$80        ; reverse will have to do...
  13022. b80put5:ldx    flash        ; flashing on?
  13023.     beq    b80put6        ; no, dont reverse
  13024.     ora    #$80        ; reverse will have to do...
  13025. b80put6:ldy    #$00        ; finally, store the character
  13026.     sta    (dest),y
  13027.     rts            ; all done
  13028.  
  13029. ;
  13030. ;    b80irm - make space for a character if insert replace mode is insert
  13031. ;
  13032.  
  13033. b80irm:    ldx    #$00
  13034.     ldy    cy
  13035.     jsr    b80adrt
  13036.     ldy    cx
  13037. b80irm4:lda    (dest),y        ; who cares what x is the first time?
  13038.     pha
  13039.     txa
  13040.     sta    (dest),y
  13041.     pla
  13042.     tax
  13043.     iny
  13044.     cpy    #80
  13045.     bcc    b80irm4
  13046.     rts
  13047.  
  13048. ;
  13049. ;    b80dch - delete one or more characters.
  13050. ;
  13051. ;    Input:    Number of characters to delete in A-reg
  13052. ;        Cursor position in cx, cy
  13053. ;
  13054.  
  13055. b80dch:    sta    freemem            ; save number of characters to delete
  13056.     lda    cx
  13057. b80dch2:pha                ; save counter
  13058.     tax                ; compute character address
  13059.     ldy    cy
  13060.     jsr    b80adrt
  13061.     clc                ; see if this character should be blank
  13062.     pla
  13063.     pha
  13064.     adc    freemem
  13065.     cmp    #80
  13066.     lda    #$20            ; get a blank ready
  13067.     bcs    b80dch1
  13068.     ldy    freemem            ; no blank.  get another character ready
  13069.     lda    (dest),y
  13070. b80dch1:ldy    #$00
  13071.     sta    (dest),y        ; put in the character
  13072.     clc                ; now add 1 to the counter and repeat
  13073.     pla
  13074.     adc    #$01
  13075.     cmp    #80
  13076.     bcc    b80dch2            ; more characters to handle?
  13077.     rts                ; all done
  13078.  
  13079. ;
  13080. ;    b80ind - scroll the screen in Batteries Included mode
  13081. ;
  13082. ;    Input:    top, bot
  13083. ;        Number of lines to scroll in a-reg
  13084. ;    Output:    Batteries Included ram is scrolled
  13085. ;
  13086. ;    This routine scrolls the area of the Batteries Included screen that
  13087. ;    is between top and bot
  13088. ;
  13089. ;    This routine is also used by delete line.
  13090. ;
  13091.  
  13092. b80ind:    tax            ; save number of lines to scroll
  13093.     lda    cy        ; save the cursor y position
  13094.     pha
  13095.     lda    top        ; top of scrolling region
  13096.     sta    cy
  13097.     txa            ; push number of lines to scroll
  13098.     pha
  13099. b80ind1:clc
  13100.     pla
  13101.     pha
  13102.     adc    cy
  13103.     cmp    bot
  13104.     beq    b80ind3
  13105.     bcs    b80ind2
  13106. b80ind3:tay
  13107.     ldx    #$00
  13108.     jsr    b80adrt        ; calculate source address
  13109.     lda    dest        ; source address must be moved from dest
  13110.     sta    source
  13111.     lda    dest+1
  13112.     sta    source+1
  13113.     ldy    cy        ; calculate destination address
  13114.     ldx    #$00
  13115.     jsr    b80adrt
  13116.     ldx    #10        ; 10 * 8 = 80 bytes to move
  13117.     jsr    move8        ; scroll one line
  13118.     inc    cy
  13119.     jmp    b80ind1
  13120. b80ind2:jsr    b80el2        ; erase the bottom line
  13121.     inc    cy
  13122.     ldy    bot
  13123.     cpy    cy
  13124.     bcs    b80ind1
  13125.     pla            ; discard number of lines to sccroll
  13126.     pla            ; restore the cursor position
  13127.     sta    cy
  13128.     rts
  13129.     
  13130. ;
  13131. ;    b80ri - perform the VT100 reverse index function (scroll backwards)
  13132. ;
  13133. ;    Input:    Number of lines to scroll in A-reg
  13134. ;    Output: None
  13135. ;
  13136. ;    Registers destroyed - A,X,Y
  13137. ;
  13138. ;    This routine scrolls the screen upwards in Batteries Include mode.
  13139. ;    Only the area in the scrolling region is changed.
  13140. ;
  13141. ;    This routine is also used for insert line.
  13142. ;
  13143.  
  13144. b80ri:    tax            ; save number of lines to scroll
  13145.     lda    cy        ; save the cursor y position
  13146.     pha
  13147.     lda    bot        ; top of scrolling region
  13148.     sta    cy
  13149.     txa            ; put number of lines to scroll on stack
  13150.     pha
  13151. b80ri1:    sec
  13152.     pla
  13153.     pha
  13154.     eor    #$ff
  13155.     adc    cy
  13156.     cmp    top        ; have we reached the bottom of the region?
  13157.     bmi    b80ri2
  13158.     tay
  13159.     ldx    #$00
  13160.     jsr    b80adrt        ; calculate source address
  13161.     lda    dest        ; source address must be moved from dest
  13162.     sta    source
  13163.     lda    dest+1
  13164.     sta    source+1
  13165.     ldy    cy        ; calculate destination address
  13166.     ldx    #$00
  13167.     jsr    b80adrt
  13168.     ldx    #10        ; 10 * 8 = 80 bytes to move
  13169.     jsr    move8        ; scroll one line
  13170.     dec    cy
  13171.     jmp    b80ri1        ; repeat until done
  13172. b80ri2:    jsr    b80el2        ; erase the bottom line
  13173.     dec    cy
  13174.     ldy    cy
  13175.     cpy    top
  13176.     bpl    b80ri1
  13177.     pla            ; discard number of lines to scroll
  13178.     pla            ; restore the cursor position
  13179.     sta    cy
  13180.     rts
  13181.  
  13182. ;
  13183. ;    b80el0 - erase from the cursor to the end of the current line
  13184. ;
  13185. ;    Input:    Cursor y coordinate in cy
  13186. ;
  13187. ;    Output:    A line is cleared on the Batteries Included card
  13188. ;
  13189. ;    This routine erases one line starting at the cursor
  13190. ;
  13191.  
  13192. b80el0:    ldy    cy        ; compute address of line to clear
  13193.     ldx    cx
  13194.     jsr    b80adrt
  13195.     ldy    #$00
  13196.     ldx    cx
  13197.     lda    #$20        ; clear with spaces
  13198. b80el0a:sta    (dest),y
  13199.     iny
  13200.     inx
  13201.     cpx    #80
  13202.     bcc    b80el0a        ; repeat till column 80 is cleared
  13203.     rts            ; all done
  13204.  
  13205. ;
  13206. ;    b80el1 - erase from the beginning of the line to the cursor
  13207. ;
  13208. ;    Input:    cy
  13209. ;
  13210. ;    Output:    spaces written to the Batteries Included screen
  13211. ;
  13212. ;    This routine erases form the beginning of the current line to the
  13213. ;    cursor
  13214. ;
  13215.  
  13216. b80el1:    ldy    cy        ; compute address to erase
  13217.     ldx    #$00
  13218.     jsr    b80adrt
  13219.     lda    #$20
  13220.     ldy    #$00
  13221. b80el1a:sta    (dest),y    ; erase text
  13222.     iny
  13223.     cpy    cx        ; repeat till done
  13224.     bcc    b80el1a
  13225.     beq    b80el1a
  13226.     rts            ; all done
  13227.  
  13228. ;
  13229. ;    b80el2 - erase one line totally
  13230. ;
  13231. ;    Input:    line to erase in cy
  13232. ;
  13233. ;    Output:    stuff written to the Batteries Included screen
  13234. ;
  13235. ;    This routine erases one line completly from the Batteries Included
  13236. ;    screen
  13237. ;
  13238.  
  13239. b80el2:    ldy    cy        ; compute address to erase
  13240.     ldx    #$00
  13241.     jsr    b80adrt
  13242.     ldx    #10        ; 10 * 8 = 80 bytes to erase
  13243.     lda    #$20
  13244.     jsr    fill8
  13245.     rts
  13246.  
  13247. ;
  13248. ;    b80fls - flash the screen Batteries Included mode
  13249. ;
  13250. ;    Input:    None
  13251. ;
  13252. ;    Output:    None
  13253. ;
  13254. ;    This routine does nothing because it is not possible to flash the
  13255. ;    Batteries Included screen
  13256.  
  13257. b80fls:    rts
  13258.  
  13259. ;
  13260. ;    b80tgl - toggle the cursor in Batteries included mode
  13261. ;
  13262. ;    Input:    cx, cy
  13263. ;
  13264. ;    Output:    The cursor is toggled
  13265. ;
  13266. ;    This routine toggles the cursor in Batteries Included mode
  13267. ;
  13268.  
  13269. b80tgl:    ldy    cy        ; get the address to toggle
  13270.     ldx    cx
  13271.     jsr    b80adrt
  13272.     ldy    #$00        ; toggle it
  13273.     lda    (dest),y
  13274.     eor    #$80
  13275.     sta    (dest),y
  13276.     rts            ; all done
  13277.  
  13278. ;
  13279. ;    b80txt - enter text mode (possibly from graphics mode)
  13280. ;
  13281. ;    If the b80flag is clear, then we are in graphics mode and must
  13282. ;    call the 80-column screen driver to leave it.  Otherwise we
  13283. ;    just call a rom routine (on the bi-80 card) to initialize things.
  13284. ;
  13285.  
  13286. b80txt:    asl    b80flag        ; test and clear the flag
  13287.     bcs    b80txt1        ; skip graphics stuff if not in graphics mode
  13288.     jsr    b80ext        ; turn off graphics.
  13289. b80txt1:lda    #$37
  13290.     sta    $01        ; turn the rom back on.
  13291.     jsr    $80f4        ; initialize 80 column display
  13292.     lda    #$0e        ; put in uppercase/lowercase mode
  13293.     jsr    chrout
  13294.     jsr    restoi        ; restore operating system
  13295.     lda    #$36
  13296.     sta    $01        ; back to normal memory map
  13297.     rts            ; all done
  13298.  
  13299. ;
  13300. ;    b80tek - enter tektronix mode
  13301. ;
  13302. ;    Since there is no graphics support on the batteries included
  13303. ;    card, we go to 80-column mode.
  13304. ;
  13305.  
  13306. b80tek:    jsr    b80ext        ; exit b80 screen driver
  13307.     jsr    c80ent        ; enter 80 column screen driver
  13308.     jsr    c80tek        ; set up for graphics
  13309.     rts
  13310.  
  13311. ;
  13312. ;    graphics routines.
  13313. ;
  13314.  
  13315. b80drw:    jmp    c80drw
  13316. b80lin:    jmp    c80lin
  13317. b80era:    jmp    c80era
  13318. b80int:    jmp    c80int
  13319.  
  13320. ;    b80adrt - compute the text address of x,y
  13321. ;
  13322. ;    Input:    x and y coordinates in X-reg and Y-reg
  13323. ;
  13324. ;    Output:    text address in (dest)
  13325. ;
  13326. ;    This routine calculates the address of text ram associated
  13327. ;    with x,y
  13328. ;
  13329.  
  13330. b80adrt:jsr    c28adr        ; compute the base address
  13331.     clc            ; add in the address of attribute ram
  13332.     lda    dest+1
  13333.     adc    #b80text^
  13334.     sta    dest+1
  13335.     rts    
  13336.  
  13337. ; 
  13338. ;    b80tst - test to see if the Batteries Included screen driver is present
  13339. ; 
  13340. ;     Input:    None
  13341. ;
  13342. ;     Output: carry set if Battries Included 80-column display not present
  13343. ; 
  13344. ;     Registers destroyed - A, X
  13345. ; 
  13346. ;     This routine returns with the carry clear if Batteries Included
  13347. ;     screen is available.  If it isn't, it returns with the carry set
  13348. ; 
  13349.  
  13350. b80tst:    lda    #$37        ; turn on the rom before reading from it
  13351.     sta    $01
  13352.     ldx    #b80tst4-b80tst3; look for "batteries included" at $8009
  13353. b80tst2:lda    b80tst3-1,x
  13354.     cmp    $8009-1,x
  13355.     bne    b80tst1
  13356.     dex
  13357.     bne    b80tst2
  13358.     lda    #$36        ; restore ram 
  13359.     sta    $01
  13360.     clc            ; found "batteries included".  Is available
  13361.     rts
  13362. b80tst1:lda    #$36        ; restore ram 
  13363.     sta    $01
  13364.     sec            ; is not available
  13365.     rts
  13366.  
  13367. b80tst3:.byte    "BATTERIES INCLUDED"
  13368. b80tst4:
  13369.  
  13370. ;
  13371. ;    b80map - translation table.  'funky' ascii -> screen code.
  13372. ;
  13373. ;    This table translates 'funky' ascii into screen codes.
  13374. ;
  13375.  
  13376. b80map1:.byte    $00        ; ' ' to '?'
  13377.     .byte    $20        ; '@'
  13378.     .byte    $21        ; 'A' to 'Z'
  13379.     .byte    $3b        ; '['
  13380.     .byte    $3c        ; '\'
  13381.     .byte    $3d        ; ']' to '^'
  13382.     .byte    $3f        ; '_'
  13383.     .byte    $40        ; '`'
  13384.     .byte    $41        ; 'a' to 'z'
  13385.     .byte    $5b        ; '{'
  13386.     .byte    $5c        ; '|'
  13387.     .byte    $5d        ; '}'
  13388.     .byte    $5e        ; '~'
  13389.     .byte    $5f        ; diamond
  13390.     .byte    $60        ; square
  13391.     .byte    $61        ; h-t
  13392.     .byte    $62        ; f-f
  13393.     .byte    $63        ; c-r, l-f, degrees, plus/minus
  13394.     .byte    $67        ; n-l
  13395.     .byte    $68        ; v-t
  13396.     .byte    $69        ; upper-left
  13397.     .byte    $6a        ; lower-left
  13398.     .byte    $6b        ; lower-right
  13399.     .byte    $6c        ; upper-right
  13400.     .byte    $6d        ; crossed lines
  13401.     .byte    $6e        ; scan 1, scan 3, scan 5, scan 7
  13402.     .byte    $72        ; scan 9
  13403.     .byte    $73        ; middle-right
  13404.     .byte    $74        ; middle-left
  13405.     .byte    $75        ; upper-middle, lower-middle
  13406.     .byte    $77        ; vertical line
  13407.     .byte    $78        ; <=
  13408.     .byte    $79        ; >=
  13409.     .byte    $7a        ; pi
  13410.     .byte    $7b        ; !=
  13411.     .byte    $7c        ; british pund
  13412.     .byte    $7d        ; dot
  13413. b80map2:.byte    $20        ; ' ' to '?'
  13414.     .byte    $00        ; '@'
  13415.     .byte    $41        ; 'A' to 'Z'
  13416.     .byte    $1b        ; '['
  13417.     .byte    $7f        ; '\'
  13418.     .byte    $1d        ; ']' to '^'
  13419.     .byte    $64        ; '_'
  13420.     .byte    $7e        ; '`'
  13421.     .byte    $01        ; 'a' to 'z'
  13422.     .byte    $75        ; '{'
  13423.     .byte    $69        ; '|'
  13424.     .byte    $76        ; '}'
  13425.     .byte    $5f        ; '~'
  13426.     .byte    $40        ; diamond
  13427.     .byte    $66        ; square
  13428.     .byte    $5c        ; h-t
  13429.     .byte    $7c        ; f-f
  13430.     .byte    $60        ; c-r, l-f, degrees, plus/minus
  13431.     .byte    $65        ; n-l
  13432.     .byte    $67        ; v-t
  13433.     .byte    $7d        ; upper-left
  13434.     .byte    $6e        ; lower-left
  13435.     .byte    $70        ; lower-right
  13436.     .byte    $6d        ; upper-right
  13437.     .byte    $5b        ; crossed lines
  13438.     .byte    $77        ; scan 1, scan 3, scan 5, scan 7
  13439.     .byte    $6f        ; scan 9
  13440.     .byte    $6b        ; middle-right
  13441.     .byte    $73        ; middle-left
  13442.     .byte    $71        ; upper-middle, lower-middle
  13443.     .byte    $5d        ; vertical line
  13444.     .byte    $68        ; <=
  13445.     .byte    $6a        ; >=
  13446.     .byte    $5e        ; pi
  13447.     .byte    $6c        ; !=
  13448.     .byte    $1c        ; british pund
  13449.     .byte    $74        ; dot
  13450. .SBTTL    Commodore 128 screen driver
  13451.  
  13452. ; 
  13453. ;     These routines manipulate the screen in Commodore 128 mode
  13454. ; 
  13455.  
  13456. ; 
  13457. ;    c28ini - initilize the commodore-128 screen.
  13458. ; 
  13459. ;     Input:    None
  13460. ; 
  13461. ;     Output:    Commodore 128 hardware initilized
  13462. ; 
  13463. ;     This routine is called once during powerup to initilize the
  13464. ;     Commodore 128 hardware
  13465. ;
  13466. ;    Warning:  The 8563 registers must be initialized lowest to highest.
  13467. ;    If you do it any other way, you will discover an undocumented "feature"
  13468. ; 
  13469.  
  13470. c28ini:    ldy    #$47        ; init smooth scroll to $47 if rev 8 chip
  13471.     lda    $d600        ; check the revision level
  13472.     beq    c28ini1        ; oops no 8563 here
  13473.     and    #$03        ; extract revision level
  13474.     bne    c28ini2        ; new 8563
  13475.     ldy    #$40        ; init to $40 if old 8563
  13476. c28ini2:tya    
  13477.     ldx    #25        ; init reg 25
  13478.     jsr    wr8563
  13479.     ldx    #$00        ; initilize 36 regs
  13480. c28ini4:lda    in8563,x    ; get byte to init with
  13481.     cmp    #$ff        ; nothing inits to $ff
  13482.     beq    c28ini3        ; was $ff.  dont init
  13483.     jsr    wr8563
  13484. c28ini3:inx            ; repeat till done
  13485.     cpx    #37        ; there are 36 registers to initialize
  13486.     bcc    c28ini4        ; not done yet
  13487. c28ini1:lda    #$fc        ; mark us as not being in fast mode
  13488.     sta    fast
  13489.     rts    
  13490.  
  13491. ;
  13492. ;    c28ent - enter the commodore-128 80-column screen-driver
  13493. ;
  13494. ;    This routine starts the 8563 screen driver and allows the use of fast
  13495. ;    mode.
  13496. ;
  13497.  
  13498. c28ent:    lda    #$fd        ; mark us as being in fast mode
  13499.     sta    fast
  13500.     rts
  13501.  
  13502. ;
  13503. ;    c28ext - exit from the commodore-128 80-column screen-driver
  13504. ;
  13505. ;    this routine does nothing because nothing exciting has to happen
  13506. ;    to turn off the 80-column screen.
  13507. ;
  13508.  
  13509. c28ext:    lda    #$fc        ; exit from fast mode
  13510.     sta    fast
  13511.     rts            ; this routine does nothing
  13512.  
  13513. ;
  13514. ;    c28set - change the hardware after a "set screen xxx" command
  13515. ;
  13516.  
  13517. c28set:    ldx    foreclr        ; foreclr only important when entering tek
  13518.     lda    c28map,x
  13519.     asl    a
  13520.     asl    a
  13521.     asl    a
  13522.     asl    a
  13523.     ldy    decrev        ; is screen bright or dark
  13524.     ldx    backclr,y
  13525.     ora    c28map,x
  13526.     ldx    #26
  13527.     jsr    wr8563
  13528.     rts
  13529.  
  13530. ;
  13531. ;    c28put - put a character on the Commodore-128 screen
  13532. ;
  13533. ;    Input:    A-reg is the character to put
  13534. ;        cx and cy show where to put it
  13535. ;
  13536. ;    Output:    A character is displayed upon the Commodore-128 screen
  13537. ;
  13538. ;    This routine prints stuff on the Commodore-128 screen.  It does
  13539. ;    not advance the cursor.
  13540. ;
  13541.  
  13542. c28put:    pha            ; save the character to put
  13543.     ldx    cx        ; compute the address in txt8563
  13544.     ldy    cy
  13545.     jsr    c28adrt
  13546.     jsr    c28r18        ; write it to 8563 regs 18 and 19
  13547.     pla            ; remember the character to put
  13548.     ldx    #31        ; reg 31 writes to ram
  13549.     jsr    wr8563        ; write to 8563 ram
  13550.     ldx    cx        ; compute the address in alt8563
  13551.     ldy    cy
  13552.     jsr    c28adra
  13553.     jsr    c28r18        ; write the address to 8563 regs 18 and 19
  13554.     ldy    alternt        ; check the alternt flag (1 or 0)
  13555.     ldx    foreclr,y    ; get the color to use
  13556.     lda    c28map,x    ; map to commodore-128 colors from c-64 colors
  13557.     ldx    reverse        ; if reverse is set, tell the 8563 about it
  13558.     beq    c28put1
  13559.     ora    #$40
  13560. c28put1:ldx    underln        ; if underlining is on, tell the 8563 about it
  13561.     beq    c28put2
  13562.     ora    #$20
  13563. c28put2:ldx    flash        ; if character is flashing, tell the 8563.
  13564.     beq    c28put4
  13565.     ora    #$10
  13566. c28put4:ldx    #31        ; write the attribute byte into 8563 ram
  13567.     jsr    wr8563
  13568.     rts    
  13569.  
  13570. ;
  13571. ;    c28irm - make space for a character if insert replace mode is insert
  13572. ;
  13573.  
  13574. c28irm:    ldx    cx
  13575.     cpx    #79        ; if in last column, no space needed
  13576.     bcc    c28irm1
  13577.     rts
  13578. c28irm1:ldy    cy
  13579.     jsr    c28adrt
  13580.     lda    #pad8563^    ; write the msb to r18
  13581.     ldx    #18
  13582.     jsr    wr8563
  13583.     inx            ; r19 gets the lsb
  13584.     lda    #pad8563\
  13585.     jsr    wr8563
  13586.     lda    in8563+24
  13587.     ora    #$80        ; set bit 7 in register 24
  13588.     ldx    #24
  13589.     jsr    wr8563
  13590.     jsr    c28r32        ; write source address to r32
  13591.     sec
  13592.     lda    #79
  13593.     sbc    cx
  13594.     pha
  13595.     ldx    #30        ; number of bytes to copy
  13596.     jsr    wr8563        ; go copy junk into the pad area
  13597.     inc    dest
  13598.     bne    c28irm2
  13599.     inc    dest+1
  13600. c28irm2:jsr    c28r18        ; write dest address to r18
  13601.     lda    in8563+24
  13602.     ora    #$80        ; set bit 7 in register 24
  13603.     ldx    #24
  13604.     jsr    wr8563
  13605.     lda    #pad8563^    ; write the msb to r32
  13606.     ldx    #32
  13607.     jsr    wr8563
  13608.     inx            ; r33 gets the lsb
  13609.     lda    #pad8563\
  13610.     jsr    wr8563
  13611.     pla            ; number of bytes to copy
  13612.     pha
  13613.     ldx    #30        ; number of bytes to copy
  13614.     jsr    wr8563        ; go copy junk into the pad area
  13615.     ldx    cx
  13616.     ldy    cy
  13617.     jsr    c28adra
  13618.     lda    #pad8563^    ; write the msb to r18
  13619.     ldx    #18
  13620.     jsr    wr8563
  13621.     inx            ; r33 gets the lsb
  13622.     lda    #pad8563\
  13623.     jsr    wr8563
  13624.     lda    in8563+24
  13625.     ora    #$80        ; set bit 7 in register 24
  13626.     ldx    #24
  13627.     jsr    wr8563
  13628.     jsr    c28r32        ; write source address to r32
  13629.     pla
  13630.     pha
  13631.     ldx    #30        ; number of bytes to copy
  13632.     jsr    wr8563        ; go copy junk into the pad area
  13633.     inc    dest
  13634.     bne    c28irm3
  13635.     inc    dest+1
  13636. c28irm3:jsr    c28r18        ; write dest address to r18
  13637.     lda    in8563+24
  13638.     ora    #$80        ; set bit 7 in register 24
  13639.     ldx    #24
  13640.     jsr    wr8563
  13641.     lda    #pad8563^    ; write the msb to r32
  13642.     ldx    #32
  13643.     jsr    wr8563
  13644.     inx            ; r33 gets the lsb
  13645.     lda    #pad8563\
  13646.     jsr    wr8563
  13647.     pla            ; number of bytes to copy
  13648.     ldx    #30        ; number of bytes to copy
  13649.     jsr    wr8563        ; go copy junk into the pad area
  13650.     rts
  13651.  
  13652. ;
  13653. ;    c28dch - delete one or more characters
  13654. ;
  13655. ;    Input:    Number of characters to delete in A-reg
  13656. ;        Cursor position in cx, cy
  13657. ;
  13658.  
  13659. c28dch:    tax            ; save number of characters to delete
  13660.     clc
  13661.     adc    cx
  13662.     cmp    #80        ; deleting rest of line?
  13663.     bcc    c28dch3
  13664.     jmp    c28el0        ; if so, just erase rest of line
  13665. c28dch3:txa            ; remember number of characters to delete
  13666.     pha            ; save number of characters to delete
  13667.     ldx    cx        ; set up destination address
  13668.     ldy    cy
  13669.     jsr    c28adrt
  13670.     jsr    c28r18
  13671.     lda    in8563+24
  13672.     ora    #%10000000    ; set bit seven
  13673.     ldx    #24
  13674.     jsr    wr8563
  13675.     clc            ; set up source address
  13676.     pla            ; restore and save number of characters to del
  13677.     pha
  13678.     adc    cx
  13679.     pha            ; 80 - this value is number of bytes to copy
  13680.     tax
  13681.     ldy    cy
  13682.     jsr    c28adrt
  13683.     jsr    c28r32
  13684.     sec            ; compute 80 - value on stack
  13685.     pla
  13686.     eor    #$ff
  13687.     adc    #80
  13688.     ldx    #30        ; write block count to register 30
  13689.     jsr    wr8563
  13690.     lda    #$00        ; write in a space at the end of the line
  13691.     ldx    #31
  13692.     jsr    wr8563
  13693.     sec
  13694.     pla            ; restore and save number of characters to del
  13695.     pha
  13696.     sbc    #$01    
  13697.     beq    c28dch1        ; skip this if zero additional blanks needed
  13698.     pha            ; save number of characters to blank
  13699.     lda    in8563+24    ; clear bit 7 of register 24
  13700.     and    #%01111111
  13701.     ldx    #24
  13702.     jsr    wr8563
  13703.     pla            ; restore number of characters to blank
  13704.     ldx    #30        ; block copy word count
  13705.     jsr    wr8563
  13706. c28dch1:ldx    cx        ; set up destination address
  13707.     ldy    cy
  13708.     jsr    c28adra
  13709.     jsr    c28r18
  13710.     lda    in8563+24
  13711.     ora    #%10000000    ; set bit seven
  13712.     ldx    #24
  13713.     jsr    wr8563
  13714.     clc            ; set up source address
  13715.     pla            ; restore and save number of characters to del
  13716.     pha
  13717.     adc    cx
  13718.     pha            ; 80 - this value is number of bytes to copy
  13719.     tax
  13720.     ldy    cy
  13721.     jsr    c28adra
  13722.     jsr    c28r32
  13723.     sec            ; compute 80 - value on stack
  13724.     pla
  13725.     eor    #$ff
  13726.     adc    #80
  13727.     ldx    #30        ; write block count to register 30
  13728.     jsr    wr8563
  13729.     lda    #$00        ; write in a space at the end of the line
  13730.     ldx    #31
  13731.     jsr    wr8563
  13732.     sec
  13733.     pla            ; save number of characters to del
  13734.     sbc    #$01        ; we already did one
  13735.     beq    c28dch2        ; skip this if zero additional blanks needed
  13736.     pha            ; save number of characters to blank
  13737.     lda    in8563+24    ; clear bit 7 of register 24
  13738.     and    #%01111111
  13739.     ldx    #24
  13740.     jsr    wr8563
  13741.     pla            ; restore number of characters to blank
  13742.     ldx    #30        ; block copy word count
  13743.     jsr    wr8563
  13744. c28dch2:rts
  13745.  
  13746. ;    
  13747. ;
  13748. ;    c28ind - scroll the screen in commodore-128 mode
  13749. ;
  13750. ;    Input:    top, bot
  13751. ;
  13752. ;    Output:    8563 ram is scrolled
  13753. ;
  13754. ;    This routine scrolls the area of the commodore-128 screen that
  13755. ;    is between top and bot
  13756. ;
  13757. ;    This routine is also used for delete line.
  13758. ;
  13759.  
  13760. c28ind:    tax            ; save the number of lines to scroll.
  13761.     lda    cy        ; save the cursor y position
  13762.     pha
  13763.     lda    top        ; start scrolling at the top
  13764.     sta    cy
  13765.     txa            ; push number of lines to scroll
  13766.     pha
  13767. c28ind1:clc
  13768.     pla
  13769.     pha
  13770.     adc    cy        ; compute the address of this line
  13771.     cmp    bot
  13772.     beq    c28ind3
  13773.     bcs    c28ind2
  13774. c28ind3:pha            ; save this result.  Usefull later
  13775.     tay
  13776.     ldx    #$00
  13777.     jsr    c28adrt
  13778.     jsr    c28r32        ; write it into block copy source addres
  13779.     ldy    cy
  13780.     ldx    #$00
  13781.     jsr    c28adrt
  13782.     lda    in8563+24    ; set bit seven in register 24
  13783.     ora    #$80
  13784.     ldx    #24
  13785.     jsr    wr8563
  13786.     jsr    c28r18        ; write destination address to 8563
  13787.     lda    #80        ; copy 80 bytes
  13788.     ldx    #30
  13789.     jsr    wr8563
  13790.     pla
  13791.     tay
  13792.     ldx    #$00        ; compute address of this line
  13793.     jsr    c28adra
  13794.     jsr    c28r32        ; write it into block copu source address
  13795.     ldy    cy        ; compute destination address
  13796.     ldx    #$00
  13797.     jsr    c28adra
  13798.     lda    in8563+24    ; set bit seven in register 24
  13799.     ora    #$80
  13800.     ldx    #24
  13801.     jsr    wr8563
  13802.     jsr    c28r18        ; write it into the destination address
  13803.     lda    #80        ; copy 80 bytes
  13804.     ldx    #30
  13805.     jsr    wr8563
  13806.     inc    cy
  13807.     jmp    c28ind1
  13808. c28ind2:jsr    c28el2
  13809.     inc    cy
  13810.     ldy    bot
  13811.     cpy    cy
  13812.     bcs    c28ind1        ; nope
  13813.     pla            ; discard number of lines to scroll
  13814.     pla            ; restore cursor position
  13815.     sta    cy
  13816.     rts
  13817.  
  13818. ;
  13819. ;    c28ri - scroll the screen backwards in commodore 128 mode
  13820. ;
  13821. ;    Input:    top, bot
  13822. ;        Number of lines to scroll in A-reg
  13823. ;    Output:    ram in the 8563 is scrolled backwards
  13824. ;
  13825. ;    This routine scrolls the part of the screen between top and bot
  13826. ;    in commodore 128 mode
  13827. ;
  13828. ;    This routine is also used for insert line.
  13829. ;
  13830.  
  13831. c28ri:    tax            ; save number of lines to scroll
  13832.     lda    cy        ; save the cursor position
  13833.     pha
  13834.     lda    bot
  13835.     sta    cy
  13836.     txa            ; push number of lines to scroll
  13837.     pha
  13838. c28ri1:    sec            ; comput cy-top_of_stack the hard way
  13839.     pla
  13840.     pha
  13841.     eor    #$ff
  13842.     adc    cy
  13843.     cmp    top        ; see if on screen
  13844.     bmi    c28ri2
  13845.     pha            ; save this result.  It is usefull
  13846.     tay
  13847.     ldx    #$00
  13848.     jsr    c28adrt        ; compute the source address
  13849.     jsr    c28r32
  13850.     ldy    cy        ; compute the destination address
  13851.     ldx    #$00
  13852.     jsr    c28adrt
  13853.     lda    in8563+24    ; set the msb in register 24
  13854.     ora    #$80
  13855.     ldx    #24
  13856.     jsr    wr8563
  13857.     jsr    c28r18        ; write the destination in r18
  13858.     lda    #80        ; block copy 80 bytes
  13859.     ldx    #30
  13860.     jsr    wr8563
  13861.     pla
  13862.     tay
  13863.     ldx    #$00
  13864.     jsr    c28adra        ; compute the source address
  13865.     jsr    c28r32
  13866.     ldy    cy        ; now do the same thing to the attribute ram
  13867.     ldx    #$00
  13868.     jsr    c28adra
  13869.     lda    in8563+24    ; set the msb in register 24
  13870.     ora    #$80
  13871.     ldx    #24
  13872.     jsr    wr8563
  13873.     jsr    c28r18        ; write the destination in r18
  13874.     lda    #80        ; block copy 80 bytes
  13875.     ldx    #30
  13876.     jsr    wr8563
  13877.     dec    cy
  13878.     jmp    c28ri1        ; repeat till done
  13879. c28ri2:    jsr    c28el2
  13880.     dec    cy
  13881.     ldy    cy
  13882.     cpy    top
  13883.     bpl    c28ri1
  13884.     pla            ; discard number of lines to scroll
  13885.     pla            ; restore cursor position
  13886.     sta    cy
  13887.     rts
  13888.  
  13889. ;
  13890. ;    c28el0 - erase from the cursor to the end of the current line
  13891. ;
  13892. ;    Input:    Cursor y coordinate in cy
  13893. ;
  13894. ;    Output:    A line is cleared on the 8563
  13895. ;
  13896. ;    This routine erases one line starting at the cursor
  13897. ;
  13898.  
  13899. c28el0:    ldy    cy
  13900.     ldx    cx
  13901.     jsr    c28adrt        ; compute the address to start erasing at
  13902.     jsr    c28r18        ; write it to the 8563
  13903.     lda    #$00        ; write zeros over the line
  13904.     ldx    #31
  13905.     jsr    wr8563        ; write one byte
  13906.     sec            ; how many more bytes?  Compute 79-cx
  13907.     lda    #79
  13908.     sbc    cx
  13909.     pha            ; save number of bytes that need erased
  13910.     beq    c28el0a        ; maby zero more bytes
  13911.     tay            ; save the number
  13912.     lda    in8563+24    ; clear bit seven in register 24
  13913.     ldx    #24
  13914.     jsr    wr8563
  13915.     tya            ; restore the number
  13916.     ldx    #30        ; block write
  13917.     jsr    wr8563
  13918. c28el0a:ldy    cy        ; now do the attribute ram
  13919.     ldx    cx
  13920.     jsr    c28adra        ; compute the address to start erasing at
  13921.     jsr    c28r18        ; write it to the 8563
  13922.     ldx    foreclr        
  13923.     lda    c28map,x
  13924.     ldx    #31
  13925.     jsr    wr8563        ; write one byte
  13926.     pla            ; remember the number of bytes to erase
  13927.     beq    c28el0b        ; maby zero more bytes
  13928.     tay            ; save the number
  13929.     lda    in8563+24    ; clear bit seven in register 24
  13930.     ldx    #24
  13931.     jsr    wr8563
  13932.     tya            ; restore the number
  13933.     ldx    #30        ; block write
  13934.     jsr    wr8563
  13935. c28el0b:rts            ; all done
  13936.  
  13937. ;
  13938. ;    c28el1 - erase from the beginning of the line to the cursor
  13939. ;
  13940. ;    Input:    cy
  13941. ;
  13942. ;    Output:    zeros written to the 8563
  13943. ;
  13944. ;    This routine erases from the beginning of the current line to the
  13945. ;    cursor
  13946. ;
  13947.  
  13948. c28el1:    ldy    cy
  13949.     ldx    #$00
  13950.     jsr    c28adrt        ; compute the starting area
  13951.     jsr    c28r18        ; write the address to the 8563
  13952.     ldx    #31        ; write a zero here
  13953.     lda    #$00
  13954.     jsr    wr8563
  13955.     lda    cx        ; how many more zeros necessary?
  13956.     beq    c28el1a        ; maby zero
  13957.     lda    in8563+24    ; clear bit seven in register 24
  13958.     ldx    #24
  13959.     jsr    wr8563
  13960.     lda    cx
  13961.     ldx    #30        ; block copy the zeros
  13962.     jsr    wr8563
  13963. c28el1a:ldy    cy
  13964.     ldx    #$00
  13965.     jsr    c28adra        ; compute the starting address
  13966.     jsr    c28r18        ; write the address to the 8563
  13967.     ldx    foreclr
  13968.     lda    c28map,x
  13969.     ldx    #31        ; write a zero here
  13970.     jsr    wr8563
  13971.     lda    cx        ; how many more zeros necessary?
  13972.     beq    c28el1b        ; maby zero
  13973.     lda    in8563+24    ; clear bit seven in register 24
  13974.     ldx    #24
  13975.     jsr    wr8563
  13976.     lda    cx
  13977.     ldx    #30        ; block copy
  13978.     jsr    wr8563
  13979. c28el1b:rts            ; all done
  13980.  
  13981. ;
  13982. ;
  13983. ;    c28el2 - erase one line totally
  13984. ;
  13985. ;    Input:    line to erase in cy
  13986. ;
  13987. ;    Output:    stuff written to the 8563
  13988. ;
  13989. ;    This routine erases one line completly from the commodore-128 screen
  13990. ;
  13991.  
  13992. c28el2:    ldy    cy        ; compute the starting address
  13993.     ldx    #$00
  13994.     jsr    c28adrt
  13995.     jsr    c28r18
  13996.     ldx    #31        ; write a zero to 8563 ram
  13997.     lda    #$00
  13998.     jsr    wr8563
  13999.     lda    in8563+24    ; clear bit seven in register 24
  14000.     ldx    #24
  14001.     jsr    wr8563
  14002.     lda    #79        ; copy 79 more zeros
  14003.     ldx    #30
  14004.     jsr    wr8563
  14005.     ldy    cy        ; now do the same thing to attribute ram
  14006.     ldx    #$00        ; compute the starting address
  14007.     jsr    c28adra
  14008.     jsr    c28r18
  14009.     ldx    foreclr
  14010.     lda    c28map,x
  14011.     ldx    #31        ; write a $04 to 8563 ram
  14012.     jsr    wr8563
  14013.     lda    in8563+24    ; clear bit seven in register 24
  14014.     ldx    #24
  14015.     jsr    wr8563
  14016.     lda    #79        ; copy 79 more zeros
  14017.     ldx    #30
  14018.     jsr    wr8563
  14019.     rts            ; all done
  14020.  
  14021. ;    c28fls - flash the screen in commodore 128 mode
  14022. ;
  14023. ;    Input:    None
  14024. ;
  14025. ;    Output:    None
  14026. ;
  14027. ;    This routine does nothing because the 8563 will flash characters
  14028. ;    with no attention from the cpu.
  14029. ;
  14030.  
  14031. c28fls:    rts            ; this routine does nothing
  14032.  
  14033. ;
  14034. ;    c28tgl - toggle the cursor in commodore 128 mode
  14035. ;
  14036. ;    Input:    cx,cy
  14037. ;
  14038. ;    Output:    registers in the 8563 are changed
  14039. ;
  14040. ;    This routine toggles the cursor in commodore 128 mode.
  14041. ;
  14042.  
  14043. c28tgl:    lda    curabrt        ; is the cursor being turned on?
  14044.     beq    c28tgl1        ; yes
  14045.     lda    #$a0
  14046.     ldx    #10
  14047.     jsr    wr8563        ; turn cursor off
  14048.     rts            ; all done
  14049. c28tgl1:ldy    cy        ; compute the address of the cursor
  14050.     ldx    cx
  14051.     jsr    c28adrt
  14052.     lda    dest+1        ; write the high byte into r14
  14053.     ldx    #14
  14054.     jsr    wr8563
  14055.     lda    dest        ; write the lsb into r15
  14056.     ldx    #15
  14057.     jsr    wr8563
  14058.     lda    in8563+10    ; turn cursor on
  14059.     ldx    #10
  14060.     jsr    wr8563
  14061.     lda    #$01        ; KLUDGE!! Mark the cursor as always on
  14062.     sta    curstat
  14063.     rts            ; all done
  14064.  
  14065. ;
  14066. ;    c28drw - draw a character at cx, cy
  14067. ;
  14068. ;    Input:    character to put in a-reg (use funny ascii)
  14069. ;    Output: A - size of character
  14070. ;
  14071. ;    Registers destroyed - A,X,Y
  14072. ;
  14073. ;    This routine puts a character at screen position tektx, tekty and
  14074. ;    returns the size of the character.
  14075. ;
  14076.  
  14077. c28drw:    sta    source
  14078.     lda    #$00
  14079.     sta    source+1
  14080.     asl    source        ; multiplied by 2
  14081.     rol    source+1
  14082.     asl    source        ; multiplied by 4
  14083.     rol    source+1
  14084.     asl    source        ; multiplied by 8
  14085.     rol    source+1
  14086.     lda    source        ; now add in font40
  14087.     adc    #font40\    ; carry is clear
  14088.     sta    source
  14089.     lda    source+1
  14090.     adc    #font40^
  14091.     sta    source+1
  14092.     lda    tektxhi
  14093.     cmp    #80        ; see if on screen
  14094.     bcs    c28drw5
  14095.     lda    #$00
  14096.     sta    tektylo        ; so that c40sub doesnt do too much...
  14097.     ldy    #$07        ; copy the character for c40sub
  14098. c28drw1:lda    (source),y
  14099.     sta    freemem,y
  14100.     dey
  14101.     bpl    c28drw1
  14102.     jsr    c40sub        ; offset the character
  14103.     lda    tektyhi
  14104.     sta    source+1
  14105.     ldy    #$00        ; 8 scan lines in a character
  14106. c28drw2:sty    source
  14107.     ldy    source+1
  14108.     cpy    #200        ; off screen?
  14109.     bcs    c28drw5        ; if so, quit now
  14110.     ldx    tektxhi
  14111.     jsr    c28adrg
  14112.     jsr    c28r18
  14113.     ldx    #31
  14114.     jsr    rd8563
  14115.     ldy    source
  14116.     ora    freemem,y
  14117.     sta    freemem,y
  14118.     lda    tektxhi
  14119.     cmp    #79        ; if in the last column, no rightmost half
  14120.     beq    c28drw3
  14121.     jsr    rd8563
  14122.     ora    freemem+16,y
  14123.     sta    freemem+16,y
  14124. c28drw3:jsr    c28r18
  14125.     ldx    #31
  14126.     lda    freemem,y
  14127.     jsr    wr8563
  14128.     lda    tektxhi
  14129.     cmp    #79
  14130.     beq    c28drw4
  14131.     lda    freemem+16,y
  14132.     jsr    wr8563
  14133. c28drw4:inc    source+1
  14134.     iny
  14135.     cpy    #$08
  14136.     bcc    c28drw2
  14137. c28drw5:lda    #13        ; 13 pixels wide
  14138.     rts
  14139.  
  14140. ;
  14141. ;    c28tek - initialize for tektronix mode
  14142. ;
  14143. ;    This routine sets up the 8563 for bit map graphics.  Note that register
  14144. ;    25 is special.  It is initialized differently depending on the chip
  14145. ;    version level.  Also note that the foreground color used when
  14146. ;    attributes are disabled is already set for us in c40set, even though
  14147. ;    that is not necessary for the display of text.
  14148. ;
  14149.  
  14150. c28tek:    ldx    #25        ; read register 25 from 8563
  14151.     jsr    rd8563
  14152.     ora    #$80
  14153.     and    #%10111111    ; disable attributes.
  14154.     jsr    wr8563
  14155.     lda    in8563+10    ; disable cursor
  14156.     and    #%10011111
  14157.     ora    #%00100000
  14158.     ldx    #10
  14159.     jsr    wr8563
  14160.     rts
  14161.  
  14162. ;
  14163. ;    c28txt - initialize the 8563 for displaying text
  14164. ;
  14165. ;    Input:    font40
  14166. ;    Output:    chr8563 (inside the 8563 ram) gets updated
  14167. ;
  14168. ;    This routine initializes the 8563 for displaying text by copying
  14169. ;    in the character set and clearing bit 7 of register 25.  Note that
  14170. ;    register 25 is special.  it is initialized differently for different
  14171. ;    versions of the chip.
  14172.  
  14173. c28txt:    ldx    #25        ; read register 25
  14174.     jsr    rd8563
  14175.     and    #$7f        ; clear bit 7
  14176.     ora    #%01000000    ; enable attributes
  14177.     jsr    wr8563        ; write it back
  14178.     lda    in8563+10    ; restart the cursor
  14179.     ldx    #10
  14180.     jsr    wr8563
  14181.     lda    #chr8563^    ; address (in 8563) to store character set
  14182.     ldx    #18
  14183.     jsr    wr8563        ; write it in
  14184.     lda    #chr8563\
  14185.     inx
  14186.     jsr    wr8563        ; write in the high order byte too
  14187.     lda    #font40\    ; copy in character definitions to chr8563
  14188.     sta    dest
  14189.     lda    #font40^
  14190.     sta    dest+1
  14191.     ldx    #31        ; write to 8563 ram
  14192.     lda    #95+32        ; loop for 95 printable characters + 32 graphic
  14193. c28txt4:pha    
  14194.     ldy    #$00
  14195. c28txt1:lda    (dest),y    ; write 8 bytes for the character
  14196.     jsr    wr8563
  14197.     iny    
  14198.     cpy    #$08
  14199.     bcc    c28txt1
  14200.     lda    #$00        ; now pad with 8 zeros
  14201. c28txt2:jsr    wr8563
  14202.     dey    
  14203.     bne    c28txt2
  14204.     clc    
  14205.     lda    dest        ; go on to the next character
  14206.     adc    #$08
  14207.     sta    dest
  14208.     bcc    c28txt3
  14209.     inc    dest+1
  14210. c28txt3:pla            ; repeat till all 95 characters done
  14211.     sec
  14212.     sbc    #$01
  14213.     bne    c28txt4
  14214.     rts
  14215.  
  14216. ;
  14217. ;    c28lin - draw a line from the current point to the destination point
  14218. ;
  14219. ;    Input:    tekfxlo, tekfxhi    - point to draw line from (x position)
  14220. ;        tekfyhi            - point to draw line from (y position)
  14221. ;        tektxlo, tektxhi    - point to draw line to (x position)
  14222. ;        tektyhi            - point to draw line to (y position)
  14223. ;
  14224. ;    This routine draws a line.
  14225. ;
  14226. ;    It works by computing a delta.  we then add the delta to the current
  14227. ;    point and plot.  we stop only when the current point is equal to the
  14228. ;    destination point.
  14229. ;
  14230. ;    We optimize this by multiplying the delta by 2 until we know that
  14231. ;    each point plotted is at a different spot.  (We do not need to plot
  14232. ;    the same point more than once)
  14233. ;
  14234.  
  14235. c28lin:    lda    #$00        ; zero the ultra-low coordinate (no yul!!)
  14236.     sta    tekfxul
  14237.     sec            ; compute delta x
  14238.     lda    tektxlo
  14239.     sbc    tekfxlo
  14240.     sta    tekdxul
  14241.     lda    tektxhi
  14242.     sbc    tekfxhi
  14243.     sta    tekdxlo
  14244.     lda    #$00
  14245.     sbc    #$00
  14246.     sta    tekdxhi
  14247.     sec            ; compute delta y    (ylo = 0!!)
  14248.     lda    tektyhi
  14249.     sbc    tekfyhi
  14250.     sta    tekdylo
  14251.     lda    #$00
  14252.     sbc    #$00
  14253.     sta    tekdyhi
  14254.     ldx    #$08        ; dont optimize more than 8 times!!!!
  14255. c28lin2:lda    tekdxlo        ; is the x delta negative
  14256.     bpl    c28lin3
  14257.     eor    #$ff        ; get the positive equivalent
  14258. c28lin3:cmp    #$0f        ; is it big enough
  14259.     bcs    c28lin1
  14260.     lda    tekdylo        ; is the y delta negative
  14261.     ldy    tekdyhi
  14262.     bpl    c28lin4
  14263.     eor    #$ff        ; get the positive equivalent
  14264. c28lin4:cmp    #$7f        ; is it big enough
  14265.     bcs    c28lin1
  14266.     asl    tekdxul        ; multiply the x delta by two
  14267.     rol    tekdxlo
  14268.     asl    tekdylo        ; multiply the y delta by two    (no dyul)
  14269.     dex
  14270.     bne    c28lin2        ; try to optimize some more
  14271. c28lin1:jsr    c28pnt        ; now we can finally plot a point
  14272.     clc            ; add in the x delta
  14273.     lda    tekfxul
  14274.     adc    tekdxul
  14275.     sta    tekfxul
  14276.     lda    tekfxlo
  14277.     adc    tekdxlo
  14278.     sta    tekfxlo
  14279.     lda    tekfxhi
  14280.     adc    tekdxhi
  14281.     sta    tekfxhi
  14282.     clc            ; add in the y delta    (no dyul or tylo)
  14283.     lda    tekfylo
  14284.     adc    tekdylo
  14285.     sta    tekfylo
  14286.     lda    tekfyhi
  14287.     adc    tekdyhi
  14288.     sta    tekfyhi
  14289.     lda    tekfxlo        ; compare current point with destination
  14290.     cmp    tektxlo
  14291.     bne    c28lin1        ; if not the same, go plot another point
  14292.     lda    tekfxhi        ; compare current point with destination
  14293.     cmp    tektxhi
  14294.     bne    c28lin1        ; if not the same, go plot another point
  14295.     lda    tekfyhi        ; compare current point with destination
  14296.     cmp    tektyhi
  14297.     bne    c28lin1        ; if not the same, go plot another point
  14298.     rts            ; all done
  14299.  
  14300. ;
  14301. ;    c28pnt - plot a point
  14302. ;
  14303. ;    input:    point to plot in tektxlo, tektxhi, tektyhi
  14304. ;
  14305. ;    This routine plots a point on the 8563 bitmap screen
  14306. ;
  14307.  
  14308. c28pnt:    ldx    tekfxhi        ; get x coordinate of character to change
  14309.     cpx    #80        ; check to see if off screen
  14310.     bcs    c28pnt1
  14311.     ldy    tekfyhi        ; get y coordinate of character to change
  14312.     cpy    #200        ; check to see if off screen
  14313.     bcs    c28pnt1
  14314.     jsr    c28adrg        ; get address of character to change
  14315.     lda    tekfxlo        ; get the column of the character to change
  14316.     lsr    a
  14317.     lsr    a
  14318.     lsr    a
  14319.     lsr    a
  14320.     lsr    a
  14321.     tay
  14322.     jsr    c28r18
  14323.     ldx    #31
  14324.     jsr    rd8563
  14325.     ora    powers,y
  14326.     tay
  14327.     jsr    c28r18
  14328.     tya
  14329.     ldx    #31
  14330.     jsr    wr8563
  14331. c28pnt1:rts
  14332.  
  14333. ;
  14334. ;    c28era - erase the graphics screen
  14335. ;
  14336. ;    This routine erases the graphics screen by filling all 16k of 8563
  14337. ;    ram with zeros
  14338. ;
  14339.  
  14340. c28era:    lda    #$00        ; fill 8563 memory starting at $0000
  14341.     ldx    #18        ; write $0000 into registers 18 and 19
  14342.     jsr    wr8563
  14343.     inx
  14344.     jsr    wr8563
  14345.     lda    #$00        ; fill memory with zeros
  14346.     ldx    #31
  14347.     jsr    wr8563
  14348.     lda    in8563+24    ; clear bit 7 in r24 for block write
  14349.     and    #%01111111
  14350.     ldx    #24
  14351.     jsr    wr8563
  14352.     lda    #$ff        ; write the rest of the page (255 bytes left)
  14353.     ldx    #30
  14354.     jsr    wr8563
  14355.     ldy    #$3f        ; $3f pages more to zero.
  14356.     lda    #$00        ; now work with full pages.
  14357. c28era1:jsr    wr8563
  14358.     dey
  14359.     bne    c28era1
  14360.     rts
  14361.  
  14362. ;
  14363. ;    c28int - put coordinates into internal form
  14364. ;
  14365. ;    Input:    tekcxlo, tekcxhi, tekcylo, tekcyhi
  14366. ;    Output:    tektxlo, tektxhi, tektyhi
  14367. ;
  14368. ;    This routine puts coordinates into internal form by calling the
  14369. ;    (very similiar) 40-column mode routine and then doubling the x
  14370. ;    resolution.  A change to the y-coordinate is made too.  The
  14371. ;    y-coordinate is no longer split into two bytes.
  14372. ;
  14373.  
  14374. c28int:    jsr    c40int        ; call similiar 40-column routine
  14375.     asl    tektxlo        ; double x resolution.
  14376.     rol    tektxhi
  14377.     asl    tektylo        ; store the y resolution in a single byte
  14378.     rol    tektyhi
  14379.     asl    tektylo
  14380.     rol    tektyhi
  14381.     asl    tektylo        ; (tektylo now zero)
  14382.     rol    tektyhi
  14383.     rts
  14384.  
  14385. ;
  14386. ;    c28tst - test to see if the Commodore 128 screen driver is present
  14387. ; 
  14388. ;     Input:    None
  14389. ;
  14390. ;     Output: carry set if Commodore 8563 80-column display not present
  14391. ; 
  14392. ;     Registers destroyed - A
  14393. ; 
  14394. ;     This routine returns with the carry clear if Commodore-128 80-column
  14395. ;     screen is available.  If it isnt, it returns with the carry set
  14396. ; 
  14397.  
  14398. c28tst:    lda    #$00
  14399.     cmp    $d600        ; Commodore-128 available if $d600 <> $00
  14400.     rts
  14401.  
  14402. ;
  14403. ;    c28adrg - compute the address of a character in graphics mode
  14404. ;
  14405. ;    Input:    x and y coordinates in x-reg and y-reg.  Offset in a-reg
  14406. ;    Output:    address in dest
  14407. ;
  14408.  
  14409. c28adrg:sty    dest        ; put y value in dest (expand to 2 bytes)
  14410.     lda    #$00
  14411.     sta    dest+1        
  14412.     asl    dest        ; multiply by 4
  14413.     rol    dest+1
  14414.     asl    dest
  14415.     rol    dest+1
  14416.     clc            ; add in one. 4 + 1 = 5
  14417.     tya
  14418.     adc    dest
  14419.     sta    dest
  14420.     lda    dest+1
  14421.     adc    #$00
  14422.     sta    dest+1
  14423.     asl    dest        ; multiply by 16 more for a total of times 80
  14424.     rol    dest+1
  14425.     asl    dest
  14426.     rol    dest+1
  14427.     asl    dest
  14428.     rol    dest+1
  14429.     asl    dest
  14430.     rol    dest+1
  14431.     clc            ; now add in x
  14432.     txa
  14433.     adc    dest
  14434.     sta    dest
  14435.     lda    dest+1
  14436.     adc    #$00
  14437.     sta    dest+1
  14438.     rts
  14439.  
  14440. ;
  14441. ;    c28adrt - compute the text address of x,y
  14442. ;
  14443. ;    Input:    x and y coordinates in X-reg and Y-reg
  14444. ;
  14445. ;    Output:    text address in (dest)
  14446. ;
  14447. ;    This routine calculates the text address at point x,y
  14448. ;
  14449.  
  14450. c28adrt:jmp    c28adr        ; no offset necessary
  14451.  
  14452. ;
  14453. ;    c28adra - compute the alternate address of x,y
  14454. ;
  14455. ;    Input:    x and y coordinates in X-reg and Y-reg
  14456. ;
  14457. ;    Output:    attribute address in (dest)
  14458. ;
  14459. ;    This routine calculates the address of attribute ram associated
  14460. ;    with x,y
  14461. ;
  14462.  
  14463. c28adra:jsr    c28adr        ; compute the base address
  14464.     clc            ; add in the address of attribute ram
  14465.     lda    dest+1
  14466.     adc    #alt8563^
  14467.     sta    dest+1
  14468.     rts    
  14469.  
  14470. ;
  14471. ;    c28adr - compute the base address associated with x,y
  14472. ;
  14473. ;    Input:    x and y coordinates in X-reg and Y-reg
  14474. ;
  14475. ;    Output:    base address in (dest)
  14476. ;
  14477. ;    This routine calculates the base address associated with x,y
  14478. ;
  14479.  
  14480. c28adr:    cpx    #80        ; in funny column?
  14481.     bcc    c28adr1
  14482.     ldx    #79        ; if so, reduce X to far left
  14483. c28adr1:lda    #$00        ; zero dest+1 while we have a free register
  14484.     sta    dest+1
  14485.     tya            ; put y where it can be shifted
  14486.     asl    a        ; multiplied by 2
  14487.     asl    a        ; multiplied by 4
  14488.     sta    dest
  14489.     tya            ; add in y.  now multiplied by 5
  14490.     clc            ; ( 5*25 < $100.  No msb yet)
  14491.     adc    dest        ; msb in dest+1. lsb in a-reg
  14492.     asl    a        ; multipled by 10
  14493.     rol    dest+1
  14494.     asl    a        ; multiplied by 20
  14495.     rol    dest+1
  14496.     asl    a        ; multiplied by 40
  14497.     rol    dest+1
  14498.     asl    a        ; multiplied by 80
  14499.     rol    dest+1
  14500.     sta    dest
  14501.     txa            ; add in x-reg
  14502.     clc    
  14503.     adc    dest
  14504.     sta    dest
  14505.     bcc    c28adr2
  14506.     inc    dest+1
  14507. c28adr2:rts    
  14508.  
  14509. ;
  14510. ;    c28r18 - write dest and dest+1 to r18 and r19 in the 8563
  14511. ;
  14512. ;    Input:    dest and dest+1
  14513. ;
  14514. ;    Output:    r18 and r19 in the 8563
  14515. ;
  14516. ;    This routine writes the address in dest to the 8563 update location
  14517. ;
  14518.  
  14519. c28r18:    lda    dest+1        ; write the msb to r18
  14520.     ldx    #18
  14521.     jsr    wr8563
  14522.     inx            ; r19 gets the lsb
  14523.     lda    dest
  14524.     jsr    wr8563
  14525.     rts    
  14526.  
  14527. ;
  14528. ;    c28r32 - write dest and dest+1 to r32 and r33 in the 8563
  14529. ;
  14530. ;    Input:    dest and dest+1
  14531. ;
  14532. ;    Output:    r32 and r33 in the 8563
  14533. ;
  14534. ;    This routine writes the address in dest to the 8563 block copy
  14535. ;    source address
  14536. ;
  14537.  
  14538. c28r32:    lda    dest+1        ; write the msb to r32
  14539.     ldx    #32
  14540.     jsr    wr8563
  14541.     inx            ; r33 gets the lsb
  14542.     lda    dest
  14543.     jsr    wr8563
  14544.     rts            ; all done
  14545.  
  14546. ;
  14547. ;    wr8563 - write to a register in the 8563
  14548. ;
  14549. ;    Input:    register to write to in x-reg
  14550. ;        data to write in a-reg
  14551. ;
  14552. ;    Output:    a register in the 8563 is changed
  14553. ;
  14554.  
  14555. wr8563:    stx    $d600        ; tell the 8563 which reg we want to write to
  14556. wr8563a:bit    $d600        ; wait for 8563 to be ready
  14557.     bpl    wr8563a        ; not yet ready
  14558.     sta    $d601        ; is ready. write.
  14559.     rts            ; all done
  14560.  
  14561. ;
  14562. ;    rd8563 - read from a register in the 8563
  14563. ;
  14564. ;    Input:    register to read from in x-reg
  14565. ;    Output:    Data in a-reg
  14566. ;
  14567. ;    This routine reads from a register in the 8563 80-column chip.
  14568. ;
  14569.  
  14570. rd8563:    stx    $d600        ; tell the 8563 which reg we want to read from
  14571. rd8563a:bit    $d600        ; wait for the 8563 to be ready
  14572.     bpl    rd8563a        ; not yet ready
  14573.     lda    $d601        ; is ready.  read.
  14574.     rts            ; all done
  14575.  
  14576. ;
  14577. ;    in8563 - data to write to the 8563 during powerup initilization
  14578. ;
  14579. ;    The zeroth value is written to r0, the first value is written to r1,
  14580. ;    and so on.  A value of $ff is not written.
  14581. ;
  14582.  
  14583. in8563:    .byte    $7e        ; horizontal total
  14584.     .byte    $50        ; horizontal displayed
  14585.     .byte    $66        ; horizontal sync position
  14586.     .byte    $49        ; horizontal/vertical sync width
  14587.     .byte    $20        ; vertical total
  14588.     .byte    $e0        ; vertical total adjust
  14589.     .byte    $19        ; vertical displayed
  14590.     .byte    $1d        ; vertical sync position
  14591.     .byte    $fc        ; interlace mode control
  14592.     .byte    $e7        ; character total, vertical
  14593.     .byte    $e0        ; cursor start scan line/cursor mode
  14594.     .byte    $f0        ; end scan line
  14595.     .byte    $00        ; display start address (hi)
  14596.     .byte    $00        ; display start address (lo)
  14597.     .byte    $20        ; cursor position (hi)
  14598.     .byte    $00        ; cursor position (lo)
  14599.     .byte    $ff        ; light pen vertical
  14600.     .byte    $ff        ; light pen horizontal
  14601.     .byte    chr8563^    ; update location (hi)
  14602.     .byte    chr8563\    ; update location (lo)
  14603.     .byte    $08        ; attribute start address (hi)
  14604.     .byte    $00        ; attribute start address (lo)
  14605.     .byte    $78        ; character displayed, horizontal
  14606.     .byte    $e8        ; character displayed, vertical
  14607.     .byte    $20        ; vertical smooth scroll
  14608.     .byte    $ff        ; smooth horizontal scroll
  14609.     .byte    $f0        ; background/foreground r, g, b, i
  14610.     .byte    $00        ; address increment per row
  14611.     .byte    $2f        ; 8563 ram type
  14612.     .byte    $e7        ; underline scan line count
  14613.     .byte    $ff        ; block copy word count
  14614.     .byte    $ff        ; cpu data
  14615.     .byte    $ff        ; block copy source address (hi)
  14616.     .byte    $ff        ; block copy source address (lo)
  14617.     .byte    $7d        ; display enable begin
  14618.     .byte    $64        ; display enable end
  14619.     .byte    $f5        ; 8563 ram refresh/scan line
  14620.  
  14621. c28map:    .byte    $00        ; black
  14622.     .byte    $0f        ; white
  14623.     .byte    $08        ; red
  14624.     .byte    $07        ; cyan
  14625.     .byte    $0b        ; purple
  14626.     .byte    $04        ; green
  14627.     .byte    $02        ; blue
  14628.     .byte    $0d        ; yellow
  14629.     .byte    $0a        ; "orange"
  14630.     .byte    $0c        ; brown
  14631.     .byte    $09        ; light red
  14632.     .byte    $01        ; medium grey    (not according to basic rom!)
  14633.     .byte    $06        ; dark grey    (not according to basic rom!)
  14634.     .byte    $05        ; light green
  14635.     .byte    $03        ; light blue
  14636.     .byte    $0e        ; light grey
  14637. .SBTTL    80 Column screen driver
  14638.  
  14639. ;
  14640. ;    These routines manipulate the screen in 80 column mode.
  14641. ;
  14642.  
  14643. ;
  14644. ;    c80ini - initilize 80 column screen during powerup
  14645. ;
  14646. ;    Input:    None
  14647. ;    Output: scrtype set to use 80 columns
  14648. ;
  14649. ;    Registers destroyed - None
  14650. ;
  14651. ;    This routine does all of the powerup initilization necessary for
  14652. ;    80 columns that was not done in c40ini, and sets the screen type
  14653. ;    to 80 columns.
  14654. ;
  14655.  
  14656. c80ini:    rts
  14657.  
  14658. ;
  14659. ;    c80ent - enter the 80 column screen driver
  14660. ;
  14661. ;    Input:    None
  14662. ;    Output: None
  14663. ;
  14664. ;    Registers destroyed - A,X,Y
  14665. ;
  14666. ;    This routine starts the 80 column screen driver.
  14667. ;
  14668.  
  14669. c80ent:    jmp    c40ent        ; hardware is initilized the same as 40 cols
  14670.  
  14671. ;
  14672. ;    c80ext - exit the 80 column screen driver
  14673. ;
  14674. ;    Input:    None
  14675. ;    Output: None
  14676. ;
  14677. ;    Registers destroyed - A,X,Y
  14678. ;
  14679. ;    This routine starts the 80 column screen driver.
  14680. ;
  14681.  
  14682. c80ext:    jmp    c40ext        ; hardware is de-initilized the same as 40 cols
  14683.  
  14684. ;
  14685. ;    c80set - reset the hardware after a "set screen xxxx" command
  14686. ;
  14687. ;    Input:    border color in bordclr
  14688. ;    Output: None
  14689. ;
  14690. ;    Registers destroyed - A
  14691. ;
  14692. ;    This routine adjusts the hardware after a set command.
  14693. ;
  14694.  
  14695. c80set:    jmp    c40set        ; hardware is the same as 40 cols
  14696.  
  14697. ;
  14698. ;    c80put - put a character at cx, cy
  14699. ;
  14700. ;    Input:    character to put in a-reg (use funny ascii)
  14701. ;    Output: None
  14702. ;
  14703. ;    Registers destroyed - A,X,Y
  14704. ;
  14705. ;    This routine puts a character at screen position cx,cy.  This routine
  14706. ;    does not advance the cursor position.
  14707. ;
  14708.  
  14709. c80put:    pha            ; save character put
  14710.     sta    source        ; compute character*8+font80
  14711.     lda    #$00
  14712.     sta    source+1
  14713.     asl    source        ; multiplied by 2
  14714.     rol    source+1
  14715.     asl    source        ; multiplied by 4
  14716.     rol    source+1
  14717.     asl    source        ; multiplied by 8
  14718.     rol    source+1
  14719.     lda    source        ; now add in font80
  14720.     adc    #font80\    ; carry is clear
  14721.     sta    source
  14722.     lda    source+1
  14723.     adc    #font80^
  14724.     sta    source+1
  14725.     ldy    cy        ; compute the address to store at
  14726.     ldx    cx
  14727.     jsr    c80adrt        
  14728.     ldy    #$07        ; copy in 8 bytes
  14729. c80put1:lda    (dest),y    ; select hi or low half      abcdefgh
  14730.     eor    (source),y    ;                 ABCDEFGH
  14731.     and    evenodd        ;                 xxxx0000
  14732.     eor    (dest),y    ;                 ABCDefgh
  14733.     ldx    reverse        ; $01 is reverse on, $00 is reverse off
  14734.     beq    c80put7
  14735.     eor    evenodd        ; reverse the character
  14736. c80put7:sta    (dest),y
  14737.     dey
  14738.     bpl    c80put1        ; put in the entire character (8 bytes)
  14739.     lda    underln        ; $01 is underline on, $00 is underline off
  14740.     beq    c80put2        ; do not underline
  14741.     lda    reverse        ; underline and reverse
  14742.     bne    c80put6
  14743.     ldy    #$07        ; underline the last row
  14744.     lda    evenodd
  14745.     ora    (dest),y
  14746.     sta    (dest),y    ; underlined, but not reversed
  14747.     jmp    c80put2
  14748. c80put6:ldy    #$07
  14749.     lda    evenodd
  14750.     eor    #$ff
  14751.     and    (dest),y
  14752.     sta    (dest),y
  14753. c80put2:pla            ; check to see if color must be updated
  14754.     bne    c80put3        ; if character is not a space, update
  14755.     lda    reverse        ; if reverse on, update
  14756.     bne    c80put3
  14757.     lda    underln        ; if underline on, update
  14758.     beq    c80put4
  14759. c80put3:ldy    cy        ; calculate primary color address
  14760.     ldx    cx
  14761.     jsr    c80adrp
  14762.     ldx    alternt        ; 1=alternate color, 0=normal color
  14763.     lda    foreclr,x    ; get proper foreground color
  14764.     asl    a        ; put in high nybble
  14765.     asl    a
  14766.     asl    a
  14767.     asl    a
  14768.     ldx    decrev        ; is the background bright or dark
  14769.     ora    backclr,x    ; or in background color
  14770.     ldy    #$00
  14771.     sta    (dest),y    ; adjust primary color ram
  14772.     pha            ; save for future use
  14773.     ldy    cy        ; compute alternate color address
  14774.     ldx    cx
  14775.     jsr    c80adra
  14776.     pla            ; restore colors used for primary color
  14777.     ldx    flash        ; can we use it?
  14778.     beq    c80put5        ; yes.
  14779.     ldx    decrev        ; is the background bright or dark
  14780.     lda    backclr,x    ; or in background color
  14781.     asl    a        ; use background color for forground
  14782.     asl    a
  14783.     asl    a
  14784.     asl    a
  14785.     ora    backclr,x    ; or in background color
  14786. c80put5:ldy    #$00
  14787.     sta    (dest),y    ; adjust alternate color ram
  14788. c80put4:rts            ; all done.
  14789.  
  14790. ;
  14791. ;    c80irm - make space for a character if insert replace mode is insert
  14792. ;
  14793. ;    Unfortunatly, there is no way to make room for the color information.
  14794. ;
  14795.  
  14796. c80irm:    ldy    #$07
  14797.     lda    #$00
  14798. c80irm1:sta    freemem,y
  14799.     dey
  14800.     bpl    c80irm1
  14801.     ldx    cx
  14802.     ldy    cy
  14803.     jsr    c80adrt
  14804.     ldx    cx
  14805.     bit    evenodd
  14806.     bmi    c80irm2
  14807.     ldy    #$07
  14808. c80irm3:lda    (dest),y
  14809.     sta    freemem,y
  14810.     and    #$f0
  14811.     sta    (dest),y
  14812.     dey
  14813.     bpl    c80irm3
  14814. c80irm6:inx
  14815.     inx
  14816. c80irm2:cpx    #80        ; all done?
  14817.     bcs    c80irm5
  14818.     txa            ; save column number currently working on
  14819.     pha
  14820.     ldy    cy
  14821.     jsr    c80adrt
  14822.     ldx    #$07
  14823.     ldy    #$07
  14824. c80irm4:lda    (dest),y
  14825.     lsr    freemem,x
  14826.     ror    a
  14827.     ror    freemem,x
  14828.     ror    a
  14829.     ror    freemem,x
  14830.     ror    a
  14831.     ror    freemem,x
  14832.     ror    a
  14833.     ror    freemem,x
  14834.     sta    (dest),y
  14835.     lsr    freemem,x
  14836.     lsr    freemem,x
  14837.     lsr    freemem,x
  14838.     lsr    freemem,x
  14839.     dey
  14840.     dex
  14841.     bpl    c80irm4
  14842.     pla
  14843.     tax            ; remember column number working on
  14844.     jmp    c80irm6
  14845. c80irm5:rts
  14846.  
  14847. ;
  14848. ;    c80dch - delete one or more characters.
  14849. ;
  14850. ;    Input:    Number of characters to delete in A-reg
  14851. ;        Cursor position in cx, cy
  14852. ;
  14853.  
  14854. c80dch:    tay            ; save number of characters to delete
  14855.     clc            ; compute x coordinate of first char to keep
  14856.     adc    cx        
  14857.     cmp    #80        ; see if fits on screen
  14858.     bcc    c80dch1
  14859.     jmp    c80el0
  14860. c80dch1:tya            ; remember number of characters to delete
  14861.     pha            ; save number of characters to delete
  14862.     ldx    cx        ; get address of first char to write over
  14863.     ldy    cy
  14864.     jsr    c80adrt
  14865.     bit    evenodd        ; must do funny things if in odd column
  14866.     bmi    c80dch2
  14867.     lda    dest        ; copy dest to source
  14868.     sta    source
  14869.     lda    dest+1
  14870.     sta    source+1
  14871.     pla            ; set up x-register.
  14872.     pha
  14873.     clc
  14874.     adc    cx
  14875.     tax
  14876.     ldy    cy        ; x already set up....
  14877.     jsr    c80adrt        ; get address of first char to keep
  14878.     ldy    #$07        ; copy in this character
  14879. c80dch3:lda    (dest),y
  14880.     bit    evenodd
  14881.     bpl    c80dch4    
  14882.     lsr    a
  14883.     lsr    a
  14884.     lsr    a
  14885.     lsr    a
  14886. c80dch4:eor    (source),y
  14887.     and    #$0f
  14888.     eor    (source),y
  14889.     sta    (source),y
  14890.     dey
  14891.     bpl    c80dch3
  14892. c80dch2:pla            ; remember number of chars to delete
  14893.     tax            ; save number of chars to delete
  14894.     lda    cx        ; set up cx so we can use c40dch (neat!)
  14895.     pha            ; save cx
  14896.     lsr    a        ; divide by two
  14897.     adc    #$00        ; round up
  14898.     sta    cx        ; freak out c40dch
  14899.     txa            ; remember number of characters to delete    
  14900.     pha            ; on stack too
  14901.     lsr    a        ; divide by two. (round down)
  14902.     jsr    c40dch        ; freaked out
  14903.     pla            ; remember number of characters to delete
  14904.     lsr    a        ; check if even or odd
  14905.     bcc    c80dch5        ; must delete another char if odd
  14906.     lda    #$00        ; shift in a blank
  14907.     ldy    #$07
  14908. c80dch6:sta    freemem,y
  14909.     dey
  14910.     bpl    c80dch6
  14911.     ldx    #40        ; still useing 40-column stuff
  14912. c80dch8:txa            ; save current column number on stack
  14913.     pha
  14914.     ldy    cy
  14915.     jsr    c40adrt        ; stil using 40-column stuff
  14916.     ldy    #$07        ; shift one character
  14917.     ldx    #$07
  14918. c80dch7:lda    (dest),y
  14919.     asl    freemem,x
  14920.     rol    a
  14921.     rol    freemem,x
  14922.     rol    a
  14923.     rol    freemem,x
  14924.     rol    a
  14925.     rol    freemem,x
  14926.     rol    a
  14927.     rol    freemem,x
  14928.     asl    freemem,x
  14929.     asl    freemem,x
  14930.     asl    freemem,x
  14931.     asl    freemem,x
  14932.     sta    (dest),y
  14933.     dex
  14934.     dey
  14935.     bpl    c80dch7
  14936.     pla
  14937.     tax
  14938.     dex
  14939.     cpx    cx
  14940.     bpl    c80dch8
  14941. c80dch5:pla            ; restore cx.  was freaked out to use c40dch
  14942.     sta    cx
  14943.     rts
  14944.  
  14945. ;    c80ind - perform the VT100 index function (scroll the screen)
  14946. ;
  14947. ;    Input:    None
  14948. ;    Output: None
  14949. ;
  14950. ;    Registers destroyed - A,X,Y
  14951. ;
  14952. ;    This routine scrolls the screen in 80 column mode.  Only the area
  14953. ;    in the scrolling region is changed.
  14954. ;
  14955. ;    This routine is also used for delete line.
  14956. ;
  14957.  
  14958. c80ind:    jmp    c40ind        ; the 40 column routine works in 80 cols too!
  14959.  
  14960. ;
  14961. ;    c80ri - perform the VT100 reverse index function (scroll backwards)
  14962. ;
  14963. ;    Input:    None
  14964. ;    Output: None
  14965. ;
  14966. ;    Registers destroyed - A,X,Y
  14967. ;
  14968. ;    This routine scrolls the screen in 80 column mode.  Only the area
  14969. ;    in the scrolling region is changed.
  14970. ;
  14971. ;    This routine is also used for insert line.
  14972. ;
  14973.  
  14974. c80ri:    jmp    c40ri        ; the 40 column routine works in 80 cols too!
  14975.  
  14976. ;
  14977. ;    c80el0 - Perform the VT100 Erase Line function #0 on 80 column screen
  14978. ;
  14979. ;    Input:    Number of line to erase in cy
  14980. ;    Output: None
  14981. ;
  14982. ;    Registers destroyed - A,X,Y
  14983. ;
  14984. ;    This routine erases from the cursor to the end of the line
  14985. ;
  14986.  
  14987. c80el0:    ldy    cy
  14988.     ldx    cx
  14989.     jsr    c80adrt
  14990.     txa            ; evaluate 40-x
  14991.     eor    #$ff
  14992.     sec
  14993.     adc    #40
  14994.     tax            ; put 40-x back in x
  14995.     bit    evenodd
  14996.     bmi    c80el0b        ; need to erase under cursor specially
  14997.     ldy    #$07        ; yes
  14998. c80el0a:lda    (dest),y
  14999.     and    #$f0
  15000.     sta    (dest),y    ; erase under the cursor
  15001.     dey
  15002.     bpl    c80el0a
  15003.     clc
  15004.     lda    dest        ; add 8 into the address clear8 starts from
  15005.     adc    #$08
  15006.     sta    dest
  15007.     bcc    c80el0c
  15008.     inc    dest+1
  15009. c80el0c:dex
  15010.     beq    c80el0d
  15011. c80el0b:jsr    clear8        ; erase characters
  15012. c80el0d:rts            ; all done
  15013.  
  15014. ;
  15015. ;    c80el1 - Perform the VT100 Erase Line function #1 on 80 column screen
  15016. ;
  15017. ;    Input:    Number of line to erase in cy
  15018. ;    Output: None
  15019. ;
  15020. ;    Registers destroyed - A,X,Y
  15021. ;
  15022. ;    This routine erases from the beginning of line to cursor
  15023. ;
  15024.  
  15025. c80el1:    ldy    cy
  15026.     ldx    cx
  15027.     jsr    c80adrt        ; compute the cursors address
  15028.     bit    evenodd        ; must clear under cursor specially?
  15029.     bpl    c80el1b
  15030.     ldy    #$07        ; yes
  15031. c80el1a:lda    (dest),y
  15032.     and    #$0f
  15033.     sta    (dest),y    ; erase under the cursor
  15034.     dey
  15035.     bpl    c80el1a
  15036. c80el1b:ldy    cy
  15037.     ldx    #$00
  15038.     jsr    c80adrt        ; compute the address to start clearing
  15039.     ldx    cx        ; compute the number of bytes to clear
  15040.     inx            ; round up if in odd column
  15041.     txa
  15042.     lsr    a
  15043.     tax            ; x = number_of_bytes / 8
  15044.     beq    c80el1c        ; carefull! there might be 0 bytes to clear!
  15045.     jsr    clear8        ; erase characters
  15046. c80el1c:rts            ; all done
  15047.  
  15048. ;
  15049. ;    c80el2 - Perform the VT100 Erase Line function #2 on 80 column screen
  15050. ;
  15051. ;    Input:    Number of line to erase in cy
  15052. ;    Output: None
  15053. ;
  15054. ;    Registers destroyed - A,X,Y
  15055. ;
  15056. ;    This routine erases one line compleatly from the 80 column display.
  15057. ;
  15058.  
  15059. c80el2:    jmp    c40el2        ; the 40 column routine works in 80 cols too!
  15060.  
  15061. ;
  15062. ;    c80fls - flash the screen and cursor in 80 column mode
  15063. ;
  15064. ;    Input:    None
  15065. ;    Output: None
  15066. ;
  15067. ;    Registers destroyed - A
  15068. ;
  15069. ;    This routine flashes the screen in 80 column mode
  15070. ;
  15071.  
  15072. c80fls:    jmp    c40fls        ; flashing is done the same way in 40 cols
  15073.  
  15074. ;
  15075. ;    c80tgl - toggle the cursor in 80 column mode
  15076. ;
  15077. ;    Input:    None
  15078. ;    Output: None
  15079. ;
  15080. ;    Registers destroyed - A,X,Y
  15081. ;
  15082. ;    This routine toggles the cursor in 80 column mode.
  15083. ;
  15084.  
  15085. c80tgl:    ldy    cy        ; compute cursor address
  15086.     ldx    cx
  15087.     jsr    c80adrt
  15088.     ldy    #$07        ; blink the cursor
  15089. c80tgl2:lda    (dest),y
  15090.     eor    evenodd
  15091.     sta    (dest),y
  15092.     dey
  15093.     bpl    c80tgl2
  15094. c80tgl1:rts
  15095.     
  15096. ;
  15097. ;    c80drw - draw a character at cx, cy
  15098. ;
  15099. ;    Input:    character to put in a-reg (use funny ascii)
  15100. ;    Output: A - size of character
  15101. ;
  15102. ;    Registers destroyed - A,X,Y
  15103. ;
  15104. ;    This routine puts a character at screen position tektx, tekty and
  15105. ;    returns the size of the character.
  15106. ;
  15107.  
  15108. c80drw:    sta    source
  15109.     lda    #$00
  15110.     sta    source+1
  15111.     asl    source        ; multiplied by 2
  15112.     rol    source+1
  15113.     asl    source        ; multiplied by 4
  15114.     rol    source+1
  15115.     asl    source        ; multiplied by 8
  15116.     rol    source+1
  15117.     lda    source        ; now add in font80
  15118.     adc    #font80\    ; carry is clear
  15119.     sta    source
  15120.     lda    source+1
  15121.     adc    #font80^
  15122.     sta    source+1
  15123.     ldy    #$07        ; copy the character for c40sub
  15124. c80drw1:lda    (source),y
  15125.     and    #$f0
  15126.     sta    freemem,y
  15127.     dey
  15128.     bpl    c80drw1
  15129.     jsr    c40sub        ; offset the character
  15130.     ldx    tektxhi
  15131.     cpx    #40        ; skip if past right of screen
  15132.     bcs    c80drw3
  15133.     ldy    tektyhi        ; compute the address to store at
  15134.     dey
  15135.     cpy    #25        ; skip if past bottom of screen
  15136.     bcs    c80drw3
  15137.     jsr    c40adrt        
  15138.     ldy    #$07        ; copy in the upper left
  15139. c80drw2:lda    freemem,y
  15140.     ora    (dest),y
  15141.     sta    (dest),y
  15142.     dey
  15143.     bpl    c80drw2
  15144. c80drw3:ldx    tektxhi
  15145.     inx            ; put this part of the character 1 space right
  15146.     cpx    #40        ; skip if past right edge
  15147.     bcs    c80drw5
  15148.     ldy    tektyhi
  15149.     dey
  15150.     cpy    #25        ; skip if past bottom of screen
  15151.     bcs    c80drw5
  15152.     jsr    c40adrt
  15153.     ldy    #$07        ; copy in the upper right
  15154. c80drw4:lda    freemem+16,y
  15155.     ora    (dest),y
  15156.     sta    (dest),y
  15157.     dey
  15158.     bpl    c80drw4
  15159. c80drw5:ldx    tektxhi
  15160.     cpx    #40        ; skip if past right edge
  15161.     bcs    c80drw7
  15162.     ldy    tektyhi
  15163.     cpy    #25        ; skip if past bottom
  15164.     bcs    c80drw7
  15165.     jsr    c40adrt
  15166.     ldy    #$07        ; copy in the lower left
  15167. c80drw6:lda    freemem+8,y
  15168.     ora    (dest),y
  15169.     sta    (dest),y
  15170.     dey
  15171.     bpl    c80drw6
  15172. c80drw7:ldx    tektxhi
  15173.     inx            ; put this part of the character 1 space left
  15174.     cpx    #40        ; skip if past right edge
  15175.     bcs    c80drw9
  15176.     ldy    tektyhi
  15177.     cpy    #25        ; skip if past bottom
  15178.     bcs    c80drw9
  15179.     jsr    c40adrt
  15180.     ldy    #$07        ; copy in the lower right
  15181. c80drw8:lda    freemem+24,y
  15182.     ora    (dest),y
  15183.     sta    (dest),y
  15184.     dey
  15185.     bpl    c80drw8
  15186. c80drw9:lda    #13        ; move cursor 13 pixels right
  15187.     rts
  15188.  
  15189. ;
  15190. ;    graphics routines
  15191. ;
  15192.  
  15193. c80tek:    jmp    c40tek
  15194. c80txt:    jmp    c40txt
  15195. c80lin:    jmp    c40lin
  15196. c80pnt:    jmp    c40pnt
  15197. c80era:    jmp    c40era
  15198. c80int:    jmp    c40int
  15199.  
  15200. ;
  15201. ;    c80tst - test to see if the 80 column screen driver is present
  15202. ;
  15203. ;    Input:    None
  15204. ;    Output: carry always clear because 80 columns is always available
  15205. ;
  15206. ;    Registers destroyed - None
  15207. ;
  15208. ;    This routine returns with the carry clear to indicate that the 80
  15209. ;    column screen is always available.
  15210. ;
  15211.  
  15212. c80tst:    clc
  15213.     rts
  15214.  
  15215. ;
  15216. ;    c80adrt - calculate address of a text character for 80 column mode
  15217. ;
  15218. ;    Input:    x coordinate in x-reg
  15219. ;        y coordinate in y-reg
  15220. ;    Output: dest
  15221. ;
  15222. ;    Registers destroyed - A,X,Y
  15223. ;
  15224. ;    This routine calculates the address of a character at x,y in 80
  15225. ;    column mode.  It uses c80adr to set things up and c40adrt to do the
  15226. ;    dirty work
  15227. ;
  15228.  
  15229. c80adrt:jsr    c80adr        ; freak out c40adr
  15230.     jmp    c40adrt        ; do the dirty work
  15231.  
  15232.  
  15233. ;
  15234. ;    c80adrp - calculate primary color address of a character at x,y
  15235. ;
  15236. ;    Input:    x coordinate in x-reg
  15237. ;        y coordinate in y-reg
  15238. ;    Output: dest
  15239. ;
  15240. ;    Registers destroyed - A,X,Y
  15241. ;
  15242. ;    This routine calculates the address of primary color memory for a
  15243. ;    character at x,y in 80 column mode.  It uses c80adr to set things up
  15244. ;    and c40adrp to do the dirty work.
  15245. ;
  15246.  
  15247. c80adrp:jsr    c80adr        ; freak out c40adr
  15248.     jmp    c40adrp        ; do the dirty work
  15249.  
  15250.  
  15251. ;
  15252. ;    c80adra - calculate alternate color address of a character at x,y
  15253. ;
  15254. ;    Input:    x coordinate in x-reg
  15255. ;        y coordinate in y-reg
  15256. ;    Output: dest
  15257. ;
  15258. ;    Registers destroyed - A,X,Y
  15259. ;
  15260. ;    This routine calculates the address of alternate color memory for a
  15261. ;    character at x,y in 80 column mode.  It uses c80adr to set things up
  15262. ;    and c40adra to do the dirty work.
  15263. ;
  15264.  
  15265. c80adra:jsr    c80adr        ; freak out c40adr
  15266.     jmp    c40adra        ; do the dirty work
  15267.  
  15268. ;
  15269. ;    c80adr - calculate int(y/2) and y%2
  15270. ;
  15271. ;    Input:    number in y-reg
  15272. ;    Output: evenodd = $0f if y is odd, $f0 if y is even
  15273. ;        y-reg = y-reg/2
  15274. ;
  15275. ;    Registers destroyed - A,Y
  15276. ;
  15277. ;    This routine calculated int(x/2) and x % 2.  It is used to freak
  15278. ;    c40adr into calculating addresses for 80 column mode.  Real
  15279. ;    funny things happen if the x-reg is the funny column (81).
  15280. ;
  15281.  
  15282. c80adr:    cpx    #80        ; is the cursor in the funny column?
  15283.     bcc    c80adr2        ; no
  15284.     ldx    #81        ; 81 % 2 = 1
  15285. c80adr2:txa            ; divide x by two
  15286.     lsr    a
  15287.     tax            ; put result back in x-reg
  15288.     lda    #$0f        ; put $0f in evenodd if odd
  15289.     bcs    c80adr1        ; is odd
  15290.     lda    #$f0        ; put $f0 in evenodd if even
  15291. c80adr1:sta    evenodd
  15292.     rts
  15293.  
  15294. ;
  15295. ;    Font80 - Character definitions
  15296. ;
  15297. ;    this defines the shape of the characters in 80 column mode
  15298. ;    this table is in ascii sequence
  15299. ;
  15300.  
  15301. font80:    .byte $00,$00,$00,$00,$00,$00,$00,$00    ; " "
  15302.     .byte $44,$44,$44,$44,$44,$00,$44,$00    ; "!"
  15303.     .byte $aa,$aa,$00,$00,$00,$00,$00,$00    ; """
  15304.     .byte $aa,$ee,$aa,$ee,$aa,$00,$00,$00    ; "#"
  15305.     .byte $44,$66,$88,$44,$22,$ee,$44,$00    ; "$"
  15306.     .byte $00,$99,$aa,$22,$55,$99,$00,$00    ; "%"
  15307.     .byte $44,$aa,$aa,$44,$aa,$aa,$55,$00    ; "&"
  15308.     .byte $22,$44,$00,$00,$00,$00,$00,$00    ; "'"
  15309.     .byte $22,$44,$44,$44,$44,$44,$22,$00    ; "("
  15310.     .byte $44,$22,$22,$22,$22,$22,$44,$00    ; ")"
  15311.     .byte $00,$99,$66,$ff,$66,$99,$00,$00    ; "*"
  15312.     .byte $00,$00,$44,$ee,$44,$00,$00,$00    ; "+"
  15313.     .byte $00,$00,$00,$00,$00,$44,$44,$88    ; ","
  15314.     .byte $00,$00,$00,$ee,$00,$00,$00,$00    ; "-"
  15315.     .byte $00,$00,$00,$00,$00,$00,$44,$00    ; "."
  15316.     .byte $00,$22,$22,$44,$44,$88,$88,$00    ; "/"
  15317.     .byte $44,$aa,$aa,$ee,$aa,$aa,$44,$00    ; "0"
  15318.     .byte $44,$cc,$44,$44,$44,$44,$ee,$00    ; "1"
  15319.     .byte $44,$aa,$22,$44,$88,$88,$ee,$00    ; "2"
  15320.     .byte $ee,$22,$44,$22,$22,$22,$cc,$00    ; "3"
  15321.     .byte $aa,$aa,$aa,$ee,$22,$22,$22,$00    ; "4"
  15322.     .byte $ee,$88,$cc,$22,$22,$22,$cc,$00    ; "5"
  15323.     .byte $44,$88,$88,$cc,$aa,$aa,$44,$00    ; "6"
  15324.     .byte $ee,$22,$22,$44,$44,$88,$88,$00    ; "7"
  15325.     .byte $44,$aa,$aa,$44,$aa,$aa,$44,$00    ; "8"
  15326.     .byte $44,$aa,$aa,$66,$22,$44,$88,$00    ; "9"
  15327.     .byte $00,$00,$44,$00,$00,$44,$00,$00    ; ":"
  15328.     .byte $00,$00,$44,$00,$44,$44,$88,$00    ; ";"
  15329.     .byte $00,$22,$44,$88,$44,$22,$00,$00    ; "<"
  15330.     .byte $00,$00,$ee,$00,$ee,$00,$00,$00    ; "="
  15331.     .byte $00,$88,$44,$22,$44,$88,$00,$00    ; ">"
  15332.     .byte $44,$aa,$22,$44,$44,$00,$44,$00    ; "?"
  15333.     .byte $44,$ee,$aa,$aa,$88,$66,$00,$00    ; "@"
  15334.     .byte $44,$aa,$aa,$ee,$aa,$aa,$aa,$00    ; "A"
  15335.     .byte $cc,$aa,$aa,$cc,$aa,$aa,$cc,$00    ; "B"
  15336.     .byte $66,$88,$88,$88,$88,$88,$66,$00    ; "C"
  15337.     .byte $cc,$aa,$aa,$aa,$aa,$aa,$cc,$00    ; "D"
  15338.     .byte $ee,$88,$88,$cc,$88,$88,$ee,$00    ; "E"
  15339.     .byte $ee,$88,$88,$cc,$88,$88,$88,$00    ; "F"
  15340.     .byte $44,$aa,$88,$88,$aa,$aa,$44,$00    ; "G"
  15341.     .byte $aa,$aa,$aa,$ee,$aa,$aa,$aa,$00    ; "H"
  15342.     .byte $ee,$44,$44,$44,$44,$44,$ee,$00    ; "I"
  15343.     .byte $66,$22,$22,$22,$22,$aa,$44,$00    ; "J"
  15344.     .byte $aa,$aa,$aa,$cc,$aa,$aa,$aa,$00    ; "K"
  15345.     .byte $88,$88,$88,$88,$88,$88,$ee,$00    ; "L"
  15346.     .byte $aa,$ee,$aa,$aa,$aa,$aa,$aa,$00    ; "M"
  15347.     .byte $cc,$aa,$aa,$aa,$aa,$aa,$aa,$00    ; "N"
  15348.     .byte $44,$aa,$aa,$aa,$aa,$aa,$44,$00    ; "O"
  15349.     .byte $cc,$aa,$aa,$cc,$88,$88,$88,$00    ; "P"
  15350.     .byte $44,$aa,$aa,$aa,$aa,$aa,$44,$22    ; "Q"
  15351.     .byte $cc,$aa,$aa,$cc,$aa,$aa,$aa,$00    ; "R"
  15352.     .byte $66,$88,$88,$44,$22,$22,$cc,$00    ; "S"
  15353.     .byte $ee,$44,$44,$44,$44,$44,$44,$00    ; "T"
  15354.     .byte $aa,$aa,$aa,$aa,$aa,$aa,$ee,$00    ; "U"
  15355.     .byte $aa,$aa,$aa,$aa,$aa,$aa,$44,$00    ; "V"
  15356.     .byte $aa,$aa,$aa,$aa,$aa,$ee,$aa,$00    ; "W"
  15357.     .byte $aa,$aa,$aa,$44,$aa,$aa,$aa,$00    ; "X"
  15358.     .byte $aa,$aa,$aa,$44,$44,$44,$44,$00    ; "Y"
  15359.     .byte $ee,$22,$22,$44,$88,$88,$ee,$00    ; "Z"
  15360.     .byte $ee,$88,$88,$88,$88,$88,$ee,$00    ; "["
  15361.     .byte $00,$88,$88,$44,$44,$22,$22,$00    ; "\"
  15362.     .byte $ee,$22,$22,$22,$22,$22,$ee,$00    ; "]"
  15363.     .byte $44,$aa,$00,$00,$00,$00,$00,$00    ; "^"
  15364.     .byte $00,$00,$00,$00,$00,$00,$00,$ff    ; "_"
  15365.     .byte $44,$22,$00,$00,$00,$00,$00,$00    ; "`"
  15366.     .byte $00,$00,$cc,$22,$66,$aa,$ee,$00    ; "a"
  15367.     .byte $88,$88,$cc,$aa,$aa,$aa,$cc,$00    ; "b"
  15368.     .byte $00,$00,$66,$88,$88,$88,$66,$00    ; "c"
  15369.     .byte $22,$22,$66,$aa,$aa,$aa,$66,$00    ; "d"
  15370.     .byte $00,$00,$44,$aa,$ee,$88,$66,$00    ; "e"
  15371.     .byte $00,$66,$88,$cc,$88,$88,$88,$00    ; "f"
  15372.     .byte $00,$00,$44,$aa,$aa,$66,$22,$cc    ; "g"
  15373.     .byte $88,$88,$cc,$aa,$aa,$aa,$aa,$00    ; "h"
  15374.     .byte $44,$00,$44,$44,$44,$44,$44,$00    ; "i"
  15375.     .byte $22,$00,$22,$22,$22,$22,$aa,$44    ; "j"
  15376.     .byte $88,$88,$aa,$aa,$cc,$aa,$aa,$00    ; "k"
  15377.     .byte $cc,$44,$44,$44,$44,$44,$ee,$00    ; "l"
  15378.     .byte $00,$00,$aa,$ee,$aa,$aa,$aa,$00    ; "m"
  15379.     .byte $00,$00,$cc,$aa,$aa,$aa,$aa,$00    ; "n"
  15380.     .byte $00,$00,$44,$aa,$aa,$aa,$44,$00    ; "o"
  15381.     .byte $00,$00,$cc,$aa,$aa,$cc,$88,$88    ; "p"
  15382.     .byte $00,$00,$44,$aa,$aa,$66,$22,$33    ; "q"
  15383.     .byte $00,$00,$66,$88,$88,$88,$88,$00    ; "r"
  15384.     .byte $00,$00,$66,$88,$44,$22,$cc,$00    ; "s"
  15385.     .byte $00,$44,$ee,$44,$44,$44,$22,$00    ; "t"
  15386.     .byte $00,$00,$aa,$aa,$aa,$aa,$ee,$00    ; "u"
  15387.     .byte $00,$00,$aa,$aa,$aa,$aa,$44,$00    ; "v"
  15388.     .byte $00,$00,$aa,$aa,$aa,$ee,$aa,$00    ; "w"
  15389.     .byte $00,$00,$aa,$aa,$44,$aa,$aa,$00    ; "x"
  15390.     .byte $00,$00,$aa,$aa,$aa,$66,$22,$cc    ; "y"
  15391.     .byte $00,$00,$ee,$22,$44,$88,$ee,$00    ; "z"
  15392.     .byte $66,$44,$44,$cc,$44,$44,$66,$00    ; "{"
  15393.     .byte $44,$44,$44,$44,$44,$44,$44,$00    ; "|"
  15394.     .byte $66,$22,$22,$33,$22,$22,$66,$00    ; "}"
  15395.     .byte $55,$aa,$00,$00,$00,$00,$00,$00    ; "~"
  15396.     .byte $00,$00,$44,$ee,$ee,$44,$00,$00    ; (graphics) diamond
  15397.     .byte $aa,$55,$aa,$55,$aa,$55,$aa,$55    ; (graphics) square
  15398.     .byte $aa,$ee,$aa,$00,$ee,$44,$44,$00    ; (graphics) h-t
  15399.     .byte $ee,$ee,$88,$00,$ee,$ee,$88,$00    ; (graphics) f-f
  15400.     .byte $ee,$88,$ee,$ee,$aa,$cc,$aa,$00    ; (graphics) c-r
  15401.     .byte $88,$88,$cc,$00,$ee,$ee,$88,$00    ; (graphics) l-f
  15402.     .byte $44,$aa,$44,$00,$00,$00,$00,$00    ; (graphics) degrees
  15403.     .byte $00,$00,$44,$ee,$44,$ee,$00,$00    ; (graphics) plus/minus
  15404.     .byte $aa,$ee,$aa,$00,$44,$44,$66,$00    ; (graphics) n-l
  15405.     .byte $aa,$aa,$44,$00,$ee,$44,$44,$00    ; (graphics) v-t
  15406.     .byte $44,$44,$44,$cc,$00,$00,$00,$00    ; (graphics) upper-left
  15407.     .byte $00,$00,$00,$cc,$44,$44,$44,$44    ; (graphics) lower-left
  15408.     .byte $00,$00,$00,$77,$44,$44,$44,$44    ; (graphics) lower-right
  15409.     .byte $44,$44,$44,$77,$00,$00,$00,$00    ; (graphics) upper-right
  15410.     .byte $44,$44,$44,$ee,$44,$44,$44,$44    ; (graphics) crossed lines
  15411.     .byte $ff,$00,$00,$00,$00,$00,$00,$00    ; (graphics) scan 1
  15412.     .byte $00,$ff,$00,$00,$00,$00,$00,$00    ; (graphics) scan 3
  15413.     .byte $00,$00,$00,$ff,$00,$00,$00,$00    ; (graphics) scan 5
  15414.     .byte $00,$00,$00,$00,$00,$ff,$00,$00    ; (graphics) scan 7
  15415.     .byte $00,$00,$00,$00,$00,$00,$00,$ff    ; (graphics) scan 9
  15416.     .byte $44,$44,$44,$77,$44,$44,$44,$44    ; (graphics) middle-right
  15417.     .byte $44,$44,$44,$cc,$44,$44,$44,$44    ; (graphics) middle-left
  15418.     .byte $44,$44,$44,$ff,$00,$00,$00,$00    ; (graphics) upper-middle
  15419.     .byte $00,$00,$00,$ff,$44,$44,$44,$44    ; (graphics) lower-middle
  15420.     .byte $44,$44,$44,$44,$44,$44,$44,$44    ; (graphics) vertical line
  15421.     .byte $00,$22,$44,$88,$44,$22,$ee,$00    ; (graphics) <=
  15422.     .byte $00,$88,$44,$22,$44,$88,$ee,$00    ; (graphics) >=
  15423.     .byte $00,$00,$00,$ee,$aa,$aa,$00,$00    ; (graphics) pi
  15424.     .byte $00,$22,$ee,$44,$ee,$88,$00,$00    ; (graphics) !=
  15425.     .byte $00,$00,$66,$44,$66,$44,$ee,$00    ; (graphics) british-pound
  15426.     .byte $00,$00,$00,$44,$00,$00,$00,$00    ; (graphics) dot
  15427.  
  15428. .SBTTL    40 Column screen driver
  15429.  
  15430. ;
  15431. ;    These routines manipulate the screen in 40 column mode.
  15432. ;
  15433.  
  15434. ;
  15435. ;    c40ini - initilize the 40 column screen
  15436. ;
  15437. ;    Input:    None
  15438. ;
  15439. ;    Output:    font40 created
  15440. ;
  15441. ;    Registers destroyed - A,X,Y
  15442. ;
  15443. ;    this routine builds the 40 column character font from stuff in rom
  15444. ;    and ram.  it calls move8 to do the copying.  the memory locations
  15445. ;    of the characters is stored in newchar.   the vic chip is initilized
  15446. ;    and the screen is cleared.  The memory map is changed to put ram where
  15447. ;    basic is now.
  15448. ;
  15449.  
  15450. c40ini:    sei            ; cannot have interrupts without I/O
  15451.     lda    #%00110010    ; swap out the I/O. Get the character rom
  15452.     sta    $01
  15453.     ldy    #$00        ; zero the y-reg
  15454.     ldx    newchar,y    ; number of characters defined in this chunk
  15455. c40ini1:iny
  15456.     lda    newchar,y    ; source of characters (lo order)
  15457.     sta    source
  15458.     iny
  15459.     lda    newchar,y    ; source of characters (hi order)
  15460.     sta    source+1
  15461.     iny
  15462.     lda    newchar,y    ; destination of characters (lo order)
  15463.     sta    dest
  15464.     iny
  15465.     lda    newchar,y    ; destination of characters (hi order)
  15466.     sta    dest+1
  15467.     iny
  15468.     tya            ; save y-reg across call to move8
  15469.     pha
  15470.     jsr    move8
  15471.     pla            ; restore y-reg
  15472.     tay
  15473.     ldx    newchar,y    ; number of characters in this chunk (0=end)
  15474.     bne    c40ini1        ; loop until done
  15475.     lda    #%00110110    ; swap I/O back in.  We gotta have it...
  15476.     sta    $01
  15477.     lda    $d020        ; save the bordor color
  15478.     sta    bordold
  15479.     rts
  15480.  
  15481. ;
  15482. ;    c40ent - enter the 40 column screen driver
  15483. ;
  15484. ;    Input:    None
  15485. ;    Output: None
  15486. ;
  15487. ;    Registers destroyed - A,X,Y
  15488. ;
  15489. ;    This routine starts the 40 column screen driver.
  15490. ;
  15491.  
  15492. c40ent:    lda    $dd02        ; select video bank
  15493.     ora    #$03        ;     ""
  15494.     sta    $dd02        ;     ""
  15495.     lda    $dd00        ;    ""
  15496.     and    #%11111100    ;    ""
  15497.     ora    #$03-<vicbank/$4000> ;    ""
  15498.     sta    $dd00        ;    ""
  15499.     lda    $d011        ; set bit-map mode
  15500.     ora    #$20        ;    ""
  15501.     sta    $d011        ;    ""
  15502.     rts            ; all done
  15503.  
  15504. ;
  15505. ;    c40ext - exit the 40 column screen driver
  15506. ;
  15507. ;    Input:    None
  15508. ;    Output: None
  15509. ;
  15510. ;    Registers destroyed - A,X,Y
  15511. ;
  15512. ;    This routine exits from the 40 column screen driver.
  15513. ;
  15514.  
  15515. c40ext:    lda    $dd02        ; select video bank
  15516.     and    #$fc        ;     ""
  15517.     sta    $dd02        ;     ""
  15518.     lda    $dd00        ;    ""
  15519.     ora    #$03        ;    ""
  15520.     sta    $dd00        ;    ""
  15521.     lda    $d011        ; re-set bit-map mode
  15522.     and    #$df
  15523.     sta    $d011        ;    ""
  15524.     lda    $d018        ; tell vic where to find screen & color ram
  15525.     and    #vicmsk
  15526.     ora    #vicnorm
  15527.     sta    $d018        ;    ""
  15528.     lda    bordold        ; restore the old bordor color
  15529.     sta    $d020
  15530.     rts            ; all done
  15531.  
  15532. ;
  15533. ;    c40set - reset the hardware after a "set screen xxxx" command
  15534. ;
  15535. ;    Input:    border color in bordclr
  15536. ;    Output: None
  15537. ;
  15538. ;    Registers destroyed - A
  15539. ;
  15540. ;    This routine adjusts the hardware after a set command.
  15541. ;
  15542. ;
  15543.  
  15544. c40set:    lda    bordclr
  15545.     sta    $d020
  15546.     lda    #vicclr1\    ; get the address of primary color ram
  15547.     sta    source
  15548.     lda    #vicclr1^
  15549.     sta    source+1
  15550.     lda    #vicclr2\    ; get the address of alternate color ram
  15551.     sta    dest
  15552.     lda    #vicclr2^
  15553.     sta    dest+1
  15554.     ldx    decrev        ; is screen bright or dark
  15555.     lda    #25        ; do 25 lines
  15556. c40set3:pha
  15557.     ldy    #39        ; reverse 40 columns
  15558. c40set2:lda    (source),y    ; get the color in primary color memory
  15559.     cmp    (dest),y    ; character is flasing if alternate != primary
  15560.     php            ; remember if character is flashing
  15561.     and    #$f0        ; replace the upper nybble with the new backclr
  15562.     ora    backclr,x
  15563.     sta    (source),y
  15564.     plp            ; remember if character is flashing
  15565.     beq    c40set1        ; if not flashing, alternate == primary
  15566.     asl    a        ; if flashing, alternate(hi & lo) = backclr
  15567.     asl    a
  15568.     asl    a
  15569.     asl    a
  15570.     ora    backclr,x
  15571. c40set1:sta    (dest),y
  15572.     dey            ; repeat for all of the columns
  15573.     bpl    c40set2
  15574.     clc            ; go do the next row
  15575.     lda    source
  15576.     adc    #40
  15577.     sta    source
  15578.     lda    source+1
  15579.     adc    #$00
  15580.     sta    source+1
  15581.     lda    dest
  15582.     adc    #40
  15583.     sta    dest
  15584.     lda    dest+1
  15585.     adc    #$00
  15586.     sta    dest+1
  15587.     pla            ; count off 25 rows
  15588.     sec
  15589.     sbc    #$01
  15590.     bne    c40set3
  15591. c40set5:rts            ; all done
  15592.  
  15593. ;
  15594. ;    c40put - put a character at cx, cy
  15595. ;
  15596. ;    Input:    character to put in a-reg (use funny ascii)
  15597. ;    Output: None
  15598. ;
  15599. ;    Registers destroyed - A,X,Y
  15600. ;
  15601. ;    This routine puts a character at screen position cx,cy.  This routine
  15602. ;    does not advance the cursor position.
  15603. ;
  15604.  
  15605. c40put:    sta    source
  15606.     lda    #$00
  15607.     sta    source+1
  15608.     asl    source        ; multiplied by 2
  15609.     rol    source+1
  15610.     asl    source        ; multiplied by 4
  15611.     rol    source+1
  15612.     asl    source        ; multiplied by 8
  15613.     rol    source+1
  15614.     lda    source        ; now add in font40
  15615.     adc    #font40\    ; carry is clear
  15616.     sta    source
  15617.     lda    source+1
  15618.     adc    #font40^
  15619.     sta    source+1
  15620.     ldy    cy        ; compute the address to store at
  15621.     ldx    cx
  15622.     jsr    c40adrt        
  15623.     ldy    #$07        ; copy in 8 bytes
  15624. c40put1:lda    (source),y
  15625.     ldx    reverse        ; $01 is reverse on, $00 is reverse off
  15626.     beq    c40put3
  15627.     eor    #$ff
  15628. c40put3:sta    (dest),y
  15629.     dey
  15630.     bpl    c40put1        ; put in the entire character (8 bytes)
  15631.     lda    underln        ; $ff is underline on, $00 is underline off
  15632.     beq    c40put2        ; do not underline
  15633.     lda    reverse        ; underline and reverse?
  15634.     beq    c40put6        ; yes.
  15635.     lda    #$00        ; turn all the bits off
  15636.     ldy    #$07
  15637.     sta    (dest),y
  15638.     jmp    c40put2
  15639. c40put6:lda    #$ff        ; turn all the bits on
  15640.     ldy    #$07        ; underline the last row
  15641.     sta    (dest),y
  15642. c40put2:ldy    cy        ; calculate primary color address
  15643.     ldx    cx
  15644.     jsr    c40adrp
  15645.     ldx    alternt        ; 1=alternate color, 0=normal color
  15646.     lda    foreclr,x    ; get proper foreground color
  15647.     asl    a        ; put in high nybble
  15648.     asl    a
  15649.     asl    a
  15650.     asl    a
  15651.     ldx    decrev        ; is the background bright or dark
  15652.     ora    backclr,x    ; or in background color
  15653.     ldy    #$00
  15654.     sta    (dest),y    ; adjust primary color ram
  15655.     pha            ; save for future use
  15656.     ldy    cy        ; compute alternate color address
  15657.     ldx    cx
  15658.     jsr    c40adra
  15659.     pla            ; restore colors used for primary color
  15660.     ldx    flash        ; can we use it?
  15661.     beq    c40put5        ; yes.
  15662.     ldx    decrev        ; is the background bright or dark
  15663.     lda    backclr,x    ; or in background color
  15664.     asl    a        ; use background color for forground
  15665.     asl    a
  15666.     asl    a
  15667.     asl    a
  15668.     ora    backclr,x    ; or in background color
  15669. c40put5:ldy    #$00
  15670.     sta    (dest),y    ; adjust alternate color ram
  15671. c40put4:rts            ; all done.
  15672.  
  15673. ;
  15674. ;    c40irm - make space for a character if insert replace mode is insert
  15675. ;
  15676. ;    In this code, the sense of dest and source are reversed.
  15677. ;
  15678.  
  15679. c40irm:    ldx    #39
  15680.     ldy    cy
  15681.     jsr    c40adrt
  15682. c40irm2:sec
  15683.     lda    dest
  15684.     sta    source
  15685.     sbc    #$08
  15686.     sta    dest
  15687.     lda    dest+1
  15688.     sta    source+1
  15689.     sbc    #$00
  15690.     sta    dest+1
  15691.     dex
  15692.     bmi    c40irm1
  15693.     cpx    cx
  15694.     bcc    c40irm1
  15695.     ldy    #$07
  15696. c40irm3:lda    (dest),y
  15697.     sta    (source),y
  15698.     dey
  15699.     bpl    c40irm3
  15700.     bmi    c40irm2            ; always taken
  15701. c40irm1:ldx    #$00
  15702.     ldy    cy
  15703.     jsr    c40adra
  15704.     ldy    cx
  15705. c40irm4:lda    (dest),y        ; who cares what x is the first time?
  15706.     pha
  15707.     txa
  15708.     sta    (dest),y
  15709.     pla
  15710.     tax
  15711.     iny
  15712.     cpy    #40
  15713.     bcc    c40irm4
  15714.     ldx    #$00
  15715.     ldy    cy
  15716.     jsr    c40adrp
  15717.     ldy    cx
  15718. c40irm5:lda    (dest),y        ; who cares what x is the first time?
  15719.     pha
  15720.     txa
  15721.     sta    (dest),y
  15722.     pla
  15723.     tax
  15724.     iny
  15725.     cpy    #40
  15726.     bcc    c40irm5
  15727.     rts
  15728.  
  15729. ;
  15730. ;    c40dch - delete one or more characters.
  15731. ;
  15732. ;    Input:    Number of characters in A-reg
  15733. ;        Cursor position in cx, cy
  15734. ;
  15735. ;    Note that in this routine, the sense of dest and source are reversed
  15736. ;
  15737.  
  15738. c40dch:    sta    freemem            ; save number of characters to delete
  15739.     lda    cx
  15740. c40dch3:pha                ; save counter
  15741.     tax                ; address of character to cover up
  15742.     ldy    cy
  15743.     jsr    c40adrt            ; copy dest -> source
  15744.     lda    dest
  15745.     sta    source
  15746.     lda    dest+1
  15747.     sta    source+1
  15748.     clc
  15749.     pla                ; remember counter
  15750.     pha                ; save again
  15751.     adc    freemem            ; what to cover character with
  15752.     cmp    #40            ; cover with a blank?
  15753.     bcs    c40dch1
  15754.     tax                ; compute address of character to use
  15755.     ldy    cy
  15756.     jsr    c40adrt
  15757.     ldy    #$07            ; copy in 8 bytes
  15758. c40dch2:lda    (dest),y
  15759.     sta    (source),y
  15760.     dey
  15761.     bpl    c40dch2
  15762.     pla                ; remember & save counter
  15763.     pha
  15764.     tax                ; compute primary color address
  15765.     ldy    cy
  15766.     jsr    c40adrp
  15767.     ldy    freemem            ; number of characters to delele
  15768.     lda    (dest),y        ; attribute for character to use
  15769.     ldy    #$00
  15770.     sta    (dest),y        ; address of character to replace
  15771.     pla                ; remember & save counter
  15772.     pha
  15773.     tax                ; compute alternate color address
  15774.     ldy    cy
  15775.     jsr    c40adra
  15776.     ldy    freemem            ; number of characters to delele
  15777.     lda    (dest),y        ; attribute for character to use
  15778.     ldy    #$00
  15779.     sta    (dest),y        ; address of character to replace
  15780.     clc                ; now add 1 to the counter and repeat
  15781.     pla
  15782.     adc    #$01
  15783.     bcc    c40dch3            ; always taken
  15784. c40dch1:lda    #$00            ; replace character with a blank
  15785.     ldy    #$07            ; 8 bytes
  15786. c40dch4:sta    (dest),y
  15787.     dey
  15788.     bpl    c40dch4
  15789.     clc                ; now add 1 to the counter and repeat
  15790.     pla
  15791.     adc    #$01
  15792.     cmp    #40
  15793.     bcc    c40dch3
  15794.     rts                ; all done
  15795.  
  15796. ;
  15797. ;    c40drw - draw a character at cx, cy
  15798. ;
  15799. ;    Input:    character to put in a-reg (use funny ascii)
  15800. ;    Output: A - size of character
  15801. ;
  15802. ;    Registers destroyed - A,X,Y
  15803. ;
  15804. ;    This routine puts a character at screen position tektx, tekty and
  15805. ;    returns the size of the character.
  15806. ;
  15807.  
  15808. c40drw:    sta    source
  15809.     lda    #$00
  15810.     sta    source+1
  15811.     asl    source        ; multiplied by 2
  15812.     rol    source+1
  15813.     asl    source        ; multiplied by 4
  15814.     rol    source+1
  15815.     asl    source        ; multiplied by 8
  15816.     rol    source+1
  15817.     lda    source        ; now add in font40
  15818.     adc    #font40\    ; carry is clear
  15819.     sta    source
  15820.     lda    source+1
  15821.     adc    #font40^
  15822.     sta    source+1
  15823.     ldy    #$07        ; copy the character for c40sub
  15824. c40drw1:lda    (source),y
  15825.     sta    freemem,y
  15826.     dey
  15827.     bpl    c40drw1
  15828.     jsr    c40sub        ; offset the character
  15829.     ldx    tektxhi
  15830.     cpx    #40        ; skip if past right of screen
  15831.     bcs    c40drw3
  15832.     ldy    tektyhi        ; compute the address to store at
  15833.     dey
  15834.     cpy    #25        ; skip if past bottom of screen
  15835.     bcs    c40drw3
  15836.     jsr    c40adrt        
  15837.     ldy    #$07        ; copy in the upper left
  15838. c40drw2:lda    freemem,y
  15839.     ora    (dest),y
  15840.     sta    (dest),y
  15841.     dey
  15842.     bpl    c40drw2
  15843. c40drw3:ldx    tektxhi
  15844.     inx            ; put this part of the character 1 space right
  15845.     cpx    #40        ; skip if past right edge
  15846.     bcs    c40drw5
  15847.     ldy    tektyhi
  15848.     dey
  15849.     cpy    #25        ; skip if past bottom of screen
  15850.     bcs    c40drw5
  15851.     jsr    c40adrt
  15852.     ldy    #$07        ; copy in the upper right
  15853. c40drw4:lda    freemem+16,y
  15854.     ora    (dest),y
  15855.     sta    (dest),y
  15856.     dey
  15857.     bpl    c40drw4
  15858. c40drw5:ldx    tektxhi
  15859.     cpx    #40        ; skip if past right edge
  15860.     bcs    c40drw7
  15861.     ldy    tektyhi
  15862.     cpy    #25        ; skip if past bottom
  15863.     bcs    c40drw7
  15864.     jsr    c40adrt
  15865.     ldy    #$07        ; copy in the lower left
  15866. c40drw6:lda    freemem+8,y
  15867.     ora    (dest),y
  15868.     sta    (dest),y
  15869.     dey
  15870.     bpl    c40drw6
  15871. c40drw7:ldx    tektxhi
  15872.     inx            ; put this part of the character 1 space left
  15873.     cpx    #40        ; skip if past right edge
  15874.     bcs    c40drw9
  15875.     ldy    tektyhi
  15876.     cpy    #25        ; skip if past bottom
  15877.     bcs    c40drw9
  15878.     jsr    c40adrt
  15879.     ldy    #$07        ; copy in the lower right
  15880. c40drw8:lda    freemem+24,y
  15881.     ora    (dest),y
  15882.     sta    (dest),y
  15883.     dey
  15884.     bpl    c40drw8
  15885. c40drw9:lda    #26        ; move cursor 26 pixels right
  15886.     rts
  15887.  
  15888. ;
  15889. ;    freemem        |    freemem + 16
  15890. ;    ------------------------------------
  15891. ;    freemem + 8    |    freemem + 24
  15892. ;
  15893.  
  15894. c40sub:    ldy    #$17        ; zero 24 bytes at freemem+8
  15895.     lda    #$00
  15896. c40sub1:sta    freemem+8,y
  15897.     dey
  15898.     bpl    c40sub1
  15899.     lda    tektylo        ; how far to offset down?
  15900.     lsr    a        ; divide by 2
  15901.     lsr    a        ; divide by 4
  15902.     lsr    a        ; divide by 8
  15903.     lsr    a        ; divide by 16
  15904.     lsr    a        ; divide by 32
  15905.     beq    c40sub5        ; skip this if zero
  15906.     tay            ; remember how may bits to sift
  15907. c40sub3:ldx    #$0e        ; shift down
  15908. c40sub4:lda    freemem,x
  15909.     sta    freemem+1,x
  15910.     dex
  15911.     bpl    c40sub4
  15912.     lda    #$00
  15913.     sta    freemem
  15914.     dey
  15915.     bne    c40sub3
  15916. c40sub5:lda    tektxlo        ; how far to offset left?
  15917.     lsr    a        ; divide by 2
  15918.     lsr    a        ; divide by 4
  15919.     lsr    a        ; divide by 8
  15920.     lsr    a        ; divide by 16
  15921.     lsr    a        ; divide by 32
  15922.     beq    c40sub6        ; skip this if zero
  15923.     tay            ; remember
  15924. c40sub7:ldx    #$0f
  15925. c40sub8:lsr    freemem,x
  15926.     ror    freemem+16,x
  15927.     dex
  15928.     bpl    c40sub8
  15929.     dey
  15930.     bne    c40sub7
  15931. c40sub6:rts
  15932.  
  15933. ;
  15934. ;    c40ind - perform the VT100 index function (scroll the screen)
  15935. ;
  15936. ;    Input:    number of lines to scroll in A-reg
  15937. ;    Output: None
  15938. ;
  15939. ;    Registers destroyed - A,X,Y
  15940. ;
  15941. ;    This routine scrolls the screen in 40 column mode.  Only the area
  15942. ;    in the scrolling region is changed.
  15943. ;
  15944. ;    This routine is also used for delete line.
  15945. ;
  15946.  
  15947. c40ind:    tax            ; save number of lines to delete
  15948.     lda    cy        ; save the cursor y position
  15949.     pha
  15950.     lda    top        ; top of scrolling region
  15951.     sta    cy
  15952.     txa            ; put number of liens to delete on stack
  15953.     pha
  15954. c40ind1:clc            ; get source line
  15955.     pla
  15956.     pha
  15957.     adc    cy
  15958.     cmp    bot        ; see if this line is on the scrolling area
  15959.     beq    c40ind3
  15960.     bcs    c40ind2
  15961. c40ind3:pha            ; save this result -- useful later
  15962.     tay
  15963.     ldx    #$00
  15964.     jsr    c40adrt        ; calculate source address
  15965.     lda    dest        ; source address must be moved from dest
  15966.     sta    source
  15967.     lda    dest+1
  15968.     sta    source+1
  15969.     ldy    cy        ; calculate destination address
  15970.     ldx    #$00
  15971.     jsr    c40adrt
  15972.     ldx    #40        ; 40 * 8 = 320 bytes to move
  15973.     jsr    move8        ; scroll one line
  15974.     pla            ; source line numver
  15975.     pha
  15976.     tay
  15977.     ldx    #$00
  15978.     jsr    c40adrp        ; calculate source address
  15979.     lda    dest        ; source address must be moved from dest
  15980.     sta    source
  15981.     lda    dest+1
  15982.     sta    source+1
  15983.     ldy    cy        ; calculate destination address
  15984.     ldx    #$00
  15985.     jsr    c40adrp
  15986.     ldx    #5        ; 5 * 8 = 40 bytes to move
  15987.     jsr    move8        ; scroll one line
  15988.     pla
  15989.     tay
  15990.     ldx    #$00
  15991.     jsr    c40adra        ; calculate source address
  15992.     lda    dest        ; source address must be moved from dest
  15993.     sta    source
  15994.     lda    dest+1
  15995.     sta    source+1
  15996.     ldy    cy        ; calculate destination address
  15997.     ldx    #$00
  15998.     jsr    c40adra
  15999.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16000.     jsr    move8        ; scroll one line
  16001.     inc    cy        ; no do the next line
  16002.     jmp    c40ind1
  16003. c40ind2:jsr    c40el2        ; whoops...  Clear a line at bottom of area
  16004.     inc    cy        ; go do the next line
  16005.     ldy    bot
  16006.     cpy    cy
  16007.     bcs    c40ind1
  16008.     pla            ; discard number of lines to scroll
  16009.     pla            ; restore the cursor position
  16010.     sta    cy
  16011.     rts
  16012.     
  16013. ;
  16014. ;    c40ri - perform the VT100 reverse index function (scroll backwards)
  16015. ;
  16016. ;    Input:    Number of lines to scroll in A-reg.
  16017. ;    Output: None
  16018. ;
  16019. ;    Registers destroyed - A,X,Y
  16020. ;
  16021. ;    This routine scrolls the screen upwards in 40 column mode.  Only the
  16022. ;    area in the scrolling region is changed.
  16023. ;
  16024. ;    This routine is also used for insert line.
  16025. ;
  16026.  
  16027. c40ri:    tax            ; save numver of lines to delete
  16028.     lda    cy        ; save the cursor y position
  16029.     pha
  16030.     lda    bot        ; top of scrolling region
  16031.     sta    cy
  16032.     txa            ; put number of lines to delete on stack
  16033.     pha
  16034. c40ri1:    sec            ; compute cy-top_of_stack the hard way
  16035.     pla
  16036.     pha
  16037.     eor    #$ff
  16038.     adc    cy
  16039.     cmp    top
  16040.     bmi    c40ri2        ; ran off the top of the scrolling region
  16041.     pha            ; save this results.  Useful later
  16042.     tay
  16043.     ldx    #$00
  16044.     jsr    c40adrt        ; calculate source address
  16045.     lda    dest        ; source address must be moved from dest
  16046.     sta    source
  16047.     lda    dest+1
  16048.     sta    source+1
  16049.     ldy    cy        ; calculate destination address
  16050.     ldx    #$00
  16051.     jsr    c40adrt
  16052.     ldx    #40        ; 40 * 8 = 320 bytes to move
  16053.     jsr    move8        ; scroll one line
  16054.     pla
  16055.     pha
  16056.     tay
  16057.     ldx    #$00
  16058.     jsr    c40adrp        ; calculate source address
  16059.     lda    dest        ; source address must be moved from dest
  16060.     sta    source
  16061.     lda    dest+1
  16062.     sta    source+1
  16063.     ldy    cy        ; calculate destination address
  16064.     ldx    #$00
  16065.     jsr    c40adrp
  16066.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16067.     jsr    move8        ; scroll one line
  16068.     pla
  16069.     tay
  16070.     ldx    #$00
  16071.     jsr    c40adra        ; calculate source address
  16072.     lda    dest        ; source address must be moved from dest
  16073.     sta    source
  16074.     lda    dest+1
  16075.     sta    source+1
  16076.     ldy    cy        ; calculate destination address
  16077.     ldx    #$00
  16078.     jsr    c40adra
  16079.     ldx    #5        ; 5 * 8 = 40 bytes to move
  16080.     jsr    move8        ; scroll one line
  16081.     dec    cy
  16082.     jmp    c40ri1        ; repeat until done
  16083. c40ri2:    jsr    c40el2        ; erase the bottom line
  16084.     dec    cy
  16085.     ldy    cy
  16086.     cpy    top
  16087.     bpl    c40ri1
  16088.     pla            ; discard number of lines to delete
  16089.     pla            ; restore the cursor position
  16090.     sta    cy
  16091.     rts
  16092.     
  16093. ;
  16094. ;    c40el0 - Perform the VT100 Erase Line function #0 on 40 column screen
  16095. ;
  16096. ;    Input:    Number of line to erase in cy
  16097. ;    Output: None
  16098. ;
  16099. ;    Registers destroyed - A,X,Y
  16100. ;
  16101. ;    This routine erases from the cursor to the end of the line
  16102. ;
  16103.  
  16104. c40el0:    ldy    cy
  16105.     ldx    cx
  16106.     jsr    c40adrt        ; find address to clear
  16107.     lda    #40
  16108.     sec
  16109.     sbc    cx        ; number of characters to erase
  16110.     tax
  16111.     jsr    clear8        ; zero some memory
  16112.     rts
  16113.  
  16114. ;
  16115. ;    c40el1 - Perform the VT100 Erase Line function #1 on 40 column screen
  16116. ;
  16117. ;    Input:    Number of line to erase in cy
  16118. ;    Output: None
  16119. ;
  16120. ;    Registers destroyed - A,X,Y
  16121. ;
  16122. ;    This routine erases from the beginning of line to cursor
  16123. ;
  16124.  
  16125. c40el1:    ldy    cy
  16126.     ldx    #$00
  16127.     jsr    c40adrt        ; find address to clear
  16128.     ldx    cx
  16129.     jsr    clear8        ; zero some memory
  16130.     rts
  16131.  
  16132. ;
  16133. ;    c40el2 - Perform the VT100 Erase Line function #2 on 40 column screen
  16134. ;
  16135. ;    Input:    Number of line to erase in cy
  16136. ;    Output: None
  16137. ;
  16138. ;    Registers destroyed - A,X,Y
  16139. ;
  16140. ;    This routine erases one line compleatly from the 40 column display.
  16141. ;
  16142.  
  16143. c40el2:    ldy    cy        ; get line to erase
  16144.     ldx    #$00        ; start erasing at start of line
  16145.     jsr    c40adrt        ; put address of text to erase in dest
  16146.     ldx    #40        ; number of bytes to erase (320 / 8 = 40)
  16147.     jsr    clear8
  16148.     ldy    cy        ; erase the color ram too
  16149.     ldx    #$00
  16150.     jsr    c40adrp
  16151.     lda    foreclr        ; get proper foreground color
  16152.     asl    a        ; put in high nybble
  16153.     asl    a
  16154.     asl    a
  16155.     asl    a
  16156.     ldx    decrev        ; is the background bright or dark
  16157.     ora    backclr,x    ; or in background color
  16158.     pha            ; save color stuff for secondary color ram
  16159.     ldx    #5        ; number of bytes to fill (40 / 8 = 5)
  16160.     jsr    fill8        ; erase one line
  16161.     ldy    cy        ; erase secondary color ram
  16162.     ldx    #$00
  16163.     jsr    c40adra
  16164.     pla            ; remember what to erase it with
  16165.     ldx    #5        ; number of bytes to fill (40 / 8 = 5)
  16166.     jsr    fill8        ; erase one line
  16167.     rts            ; all done
  16168.  
  16169. ;
  16170. ;    c40int - convert tektronix coordinates into internal form
  16171. ;
  16172. ;    Input:    tekcxlo, tekcxhi
  16173. ;        tekcylo, tekcyhi
  16174. ;    Output:    tektxlo, tektxhi
  16175. ;        tektylo, tektyhi
  16176. ;
  16177. ;    This routine converts tektronix coordinates into internal form
  16178. ;
  16179. ;    In tektronix form, there is a 10 bit number in tekcxlo, tekcxhi 
  16180. ;    representing the distance from the left edge.
  16181. ;
  16182. ;    In internal form, there is a number in tektxhi between 0 and 39
  16183. ;    representing the number of characters between the left edge and the
  16184. ;    point in ;    question.  There is a number
  16185. ;    (one of 0,32,64,96,...,224) in tekcxlo representing a fraction of
  16186. ;    a character.
  16187. ;
  16188. ;    In tektronix form, there is a 10 bit number in tekcylo, tekcyhi
  16189. ;    representing the distance from the _bottom_ of the screen.
  16190. ;
  16191. ;    In internal form, there is a number in tektyhi between 0 and 24
  16192. ;    representing the distance from the _top_ of the screen in characters.
  16193. ;    The fractional part of a character is stored in tektylo.  It will
  16194. ;    be one of these numbers: 0,32,64,96,...,224.
  16195. ;
  16196.  
  16197. c40int:    lda    tekcxlo        ; get the current x coordinate
  16198.     sta    tektxlo
  16199.     lda    tekcxhi
  16200.     sta    tektxhi
  16201.     asl    tektxlo        ; multiply x coordinate by 4
  16202.     rol    tektxhi
  16203.     asl    tektxlo
  16204.     rol    tektxhi
  16205.     clc            ; add in one.  Now multiplied by 5
  16206.     lda    tektxlo
  16207.     adc    tekcxlo
  16208.     sta    tektxlo
  16209.     lda    tektxhi
  16210.     adc    tekcxhi
  16211.     sta    tektxhi
  16212.     asl    tektxlo        ; multiply by 2 more for a total of 10. done.
  16213.     rol    tektxhi
  16214.     sec            ; invert the sence of y coordinate (799 - y)
  16215.     lda    #779\
  16216.     sbc    tekcylo
  16217.     sta    tektylo
  16218.     lda    #779^
  16219.     sbc    tekcyhi
  16220.     sta    tektyhi
  16221.     asl    tektylo        ; multiply by 8 (800 * 8 / 256 = 25)
  16222.     rol    tektyhi        ; now multiplied by 2
  16223.     asl    tektylo
  16224.     rol    tektyhi        ; now multiplied by 4
  16225.     asl    tektylo
  16226.     rol    tektyhi        ; now multiplied by 8
  16227.     rts
  16228.  
  16229. ;
  16230. ;    c40lin - draw a line from the current point to the destination point
  16231. ;
  16232. ;    Input:    tekfxlo, tekfxhi    - point to draw line from (x position)
  16233. ;        tekfylo, tekfyhi    - point to draw line from (y position)
  16234. ;        tektxlo, tektxhi    - point to draw line to (x position)
  16235. ;        tektylo, tektyhi    - point to draw line to (y position)
  16236. ;
  16237. ;    This routine draws a line.
  16238. ;
  16239. ;    It works by computing a delta.  we then add the delta to the current
  16240. ;    point and plot.  we stop only when the current point is equal to the
  16241. ;    destination point.
  16242. ;
  16243. ;    We optimize this by multiplying the delta by 2 until we know that
  16244. ;    each point plotted is at a different spot.  (We do not need to plot
  16245. ;    the same point more than once)
  16246. ;
  16247.  
  16248. c40lin:    lda    #$00        ; zero the ultra-low coordinate
  16249.     sta    tekfxul
  16250.     sta    tekfyul
  16251.     sec            ; compute delta x
  16252.     lda    tektxlo
  16253.     sbc    tekfxlo
  16254.     sta    tekdxul
  16255.     lda    tektxhi
  16256.     sbc    tekfxhi
  16257.     sta    tekdxlo
  16258.     lda    #$00
  16259.     sbc    #$00
  16260.     sta    tekdxhi
  16261.     sec            ; compute delta y
  16262.     lda    tektylo
  16263.     sbc    tekfylo
  16264.     sta    tekdyul
  16265.     lda    tektyhi
  16266.     sbc    tekfyhi
  16267.     sta    tekdylo
  16268.     lda    #$00
  16269.     sbc    #$00
  16270.     sta    tekdyhi
  16271.     ldx    #$08        ; dont optimize more than 8 times!!!!
  16272. c40lin2:lda    tekdxlo        ; is the x delta negative
  16273.     bpl    c40lin3
  16274.     eor    #$ff        ; get the positive equivalent
  16275. c40lin3:cmp    #$0f        ; is it big enough
  16276.     bcs    c40lin1
  16277.     lda    tekdylo        ; is the y delta negative
  16278.     bpl    c40lin4
  16279.     eor    #$ff        ; get the positive equivalent
  16280. c40lin4:cmp    #$0f        ; is it big enough
  16281.     bcs    c40lin1
  16282.     asl    tekdxul        ; multiply the x delta by two
  16283.     rol    tekdxlo
  16284.     asl    tekdyul        ; multiply the y delta by two
  16285.     rol    tekdylo
  16286.     dex
  16287.     bne    c40lin2        ; try to optimize some more
  16288. c40lin1:jsr    c40pnt        ; now we can finally plot a point
  16289.     clc            ; add in the x delta
  16290.     lda    tekfxul
  16291.     adc    tekdxul
  16292.     sta    tekfxul
  16293.     lda    tekfxlo
  16294.     adc    tekdxlo
  16295.     sta    tekfxlo
  16296.     lda    tekfxhi
  16297.     adc    tekdxhi
  16298.     sta    tekfxhi
  16299.     clc            ; add in the y delta
  16300.     lda    tekfyul
  16301.     adc    tekdyul
  16302.     sta    tekfyul
  16303.     lda    tekfylo
  16304.     adc    tekdylo
  16305.     sta    tekfylo
  16306.     lda    tekfyhi
  16307.     adc    tekdyhi
  16308.     sta    tekfyhi
  16309.     lda    tekfxlo        ; compare current point with destination
  16310.     cmp    tektxlo
  16311.     bne    c40lin1        ; if not the same, go plot another point
  16312.     lda    tekfxhi        ; compare current point with destination
  16313.     cmp    tektxhi
  16314.     bne    c40lin1        ; if not the same, go plot another point
  16315.     lda    tekfylo        ; compare current point with destination
  16316.     cmp    tektylo
  16317.     bne    c40lin1        ; if not the same, go plot another point
  16318.     lda    tekfyhi        ; compare current point with destination
  16319.     cmp    tektyhi
  16320.     bne    c40lin1        ; if not the same, go plot another point
  16321.     rts            ; all done
  16322.  
  16323. ;
  16324. ;    c40pnt - plot a point
  16325. ;
  16326. ;    input:    point to plot in tektxlo, tektxhi, tektylo, tektyhi
  16327. ;
  16328. ;    This routine plots a point in 40 column mode
  16329. ;
  16330.  
  16331. c40pnt:    ldx    tekfxhi        ; get x coordinate of character to change
  16332.     cpx    #40        ; check to see if off screen
  16333.     bcs    c40pnt1
  16334.     ldy    tekfyhi        ; get y coordinate of character to change
  16335.     cpy    #25        ; check to see if off screen
  16336.     bcs    c40pnt1
  16337.     jsr    c40adrt        ; get address of character to change
  16338.     lda    tekfylo        ; get the row of the character to change
  16339.     lsr    a
  16340.     lsr    a
  16341.     lsr    a
  16342.     lsr    a
  16343.     lsr    a
  16344.     tay
  16345.     lda    tekfxlo        ; get the column of the character to change
  16346.     lsr    a
  16347.     lsr    a
  16348.     lsr    a
  16349.     lsr    a
  16350.     lsr    a
  16351.     tax
  16352.     lda    powers,x
  16353.     ora    (dest),y    ; plot the character
  16354.     sta    (dest),y
  16355. c40pnt1:rts
  16356.  
  16357. ;
  16358. ;    c40era - erase the graphics screen in tektronix mode
  16359. ;
  16360.  
  16361. c40era:    jmp    c40clr        ; just like erasing in text mode
  16362.  
  16363. ;
  16364. ;    c40txt - show the text screen
  16365. ;
  16366. ;    This routine swaps the text and graphics screens
  16367. ;
  16368.  
  16369. c40txt:    lda    $d018        ; tell vic where to find screen & color ram
  16370.     and    #vicmsk
  16371.     ora    #vicdat1
  16372.     sta    $d018        ;    ""
  16373.     rts
  16374.  
  16375. ;
  16376. ;    c40tek - show the graphics screen
  16377. ;
  16378. ;    This routine swaps the current screen in underneath the kernal and IO,
  16379. ;    and swaps the hidden screen back out.
  16380. ;
  16381.  
  16382. c40tek:    lda    $d018        ; tell vic where to find screen & color ram
  16383.     and    #vicmsk
  16384.     ora    #vicdat1
  16385.     sta    $d018
  16386.     lda    #vicclr1\    ; fill the color ram
  16387.     sta    dest
  16388.     lda    #vicclr1^
  16389.     sta    dest+1
  16390.     lda    foreclr
  16391.     asl    a
  16392.     asl    a
  16393.     asl    a
  16394.     asl    a
  16395.     ora    backclr
  16396.     ldx    #$400/$08
  16397.     jsr    fill8
  16398.     rts
  16399.  
  16400. ;
  16401. ;    c40clr - clear the graphics screen in 40 column mode
  16402. ;
  16403.  
  16404. c40clr:    lda    #victext\
  16405.     sta    dest
  16406.     lda    #victext^
  16407.     sta    dest+1
  16408.     jsr    clr8k
  16409.     rts
  16410.  
  16411. ;
  16412. ;    c40fls - flash the screen in 40 column mode
  16413. ;
  16414. ;    Input:    None
  16415. ;    Output: None
  16416. ;
  16417. ;    Registers destroyed - A,X,Y
  16418. ;
  16419. ;    This routine flashes the screen in 40 column mode
  16420. ;
  16421.  
  16422. c40fls:    lda    $d018        ; swap between primary color ram and alternate
  16423.     eor    #vicswap
  16424.     sta    $d018
  16425.     rts            ; all done
  16426.  
  16427. ;
  16428. ;    c40tgl - toggle the cursor in 40 column mode
  16429. ;
  16430. ;    Input:    None
  16431. ;    Output: None
  16432. ;
  16433. ;    Registers destroyed - A,X,Y
  16434. ;
  16435. ;    This routine toggles the cursor in 40 column mode.
  16436. ;
  16437.  
  16438. c40tgl:    ldy    cy        ; compute cursor address
  16439.     ldx    cx
  16440.     jsr    c40adrt
  16441.     ldy    #$07        ; blink the cursor
  16442. c40tgl2:lda    (dest),y
  16443.     eor    #$ff
  16444.     sta    (dest),y
  16445.     dey
  16446.     bpl    c40tgl2
  16447. c40tgl1:rts
  16448.     
  16449. ;
  16450. ;    c40tst - test to see if the 40 column screen driver is present
  16451. ;
  16452. ;    Input:    None
  16453. ;    Output: carry always clear because 40 columns is always available
  16454. ;
  16455. ;    Registers destroyed - None
  16456. ;
  16457. ;    This routine returns with the carry clear to indicate that the 40
  16458. ;    column screen is always available.
  16459. ;
  16460.  
  16461. c40tst:    clc
  16462.     rts
  16463.  
  16464. ;
  16465. ;    c40adrt - Compute the address of 40 column text
  16466. ;
  16467. ;    Input:    Line number to y-reg
  16468. ;        Column number in  x-reg
  16469. ;    Output: Address stored in dest
  16470. ;
  16471. ;    Registers destroyed - A,X,Y
  16472. ;
  16473. ;    This routine calculates the memory address of a character in 40 column
  16474. ;    mode.
  16475. ;
  16476.  
  16477. c40adrt:jsr    c40adr        ; compute 40*y+x
  16478.     asl    dest        ; multiply by 2
  16479.     rol    dest+1
  16480.     asl    dest        ; multiply by 4
  16481.     rol    dest+1
  16482.     asl    dest        ; multiply by 8
  16483.     rol    dest+1
  16484.     lda    dest        ; add in start of screen
  16485.     adc    #victext\    ; carry already clear
  16486.     sta    dest
  16487.     lda    dest+1
  16488.     adc    #victext^
  16489.     sta    dest+1
  16490.     rts
  16491.  
  16492. ;
  16493. ;    c40adrp - Compute the address of 40 column primary color ram
  16494. ;
  16495. ;    Input:    Line number to y-reg
  16496. ;        Column number in  x-reg
  16497. ;    Output: Address stored in dest
  16498. ;
  16499. ;    Registers destroyed - A,X,Y
  16500. ;
  16501. ;    This routine calculates the memory address of a character in 40 column
  16502. ;    mode.   The address returned is the address of the primary color ram.
  16503. ;
  16504.  
  16505. c40adrp:jsr    c40adr        ; compute base address
  16506.     clc            ; add in vicclr1
  16507.     lda    dest
  16508.     adc    #vicclr1\
  16509.     sta    dest
  16510.     lda    dest+1
  16511.     adc    #vicclr1^
  16512.     sta    dest+1
  16513.     rts
  16514.  
  16515. ;
  16516. ;    c40adra - Compute the address of 40 column alternate color ram
  16517. ;
  16518. ;    Input:    Line number to y-reg
  16519. ;        Column number in  x-reg
  16520. ;    Output: Address stored in dest
  16521. ;
  16522. ;    Registers destroyed - A,X,Y
  16523. ;
  16524. ;    This routine calculates the memory address of a character in 40 column
  16525. ;    mode.  The address returned is the address of the alternate color ram.
  16526. ;
  16527.  
  16528. c40adra:jsr    c40adr        ; compute base address
  16529.     clc            ; add in vicclr1
  16530.     lda    dest
  16531.     adc    #vicclr2\
  16532.     sta    dest
  16533.     lda    dest+1
  16534.     adc    #vicclr2^
  16535.     sta    dest+1
  16536.     rts
  16537.  
  16538. ;
  16539. ;    c40adr - calculate 40*y+x
  16540. ;
  16541. ;    Input:    numbers in x-reg and y-reg
  16542. ;    Output: dest
  16543. ;
  16544. ;    Registers destroyed - A,Y
  16545. ;
  16546. ;    This routine calculates 40*y+x and puts the result in dest.  If x > 40,
  16547. ;    one is subtracted first.  This will happen after a character is printed
  16548. ;    on the last character on a line.  This routine is for calculating
  16549. ;    screen addresses.
  16550. ;
  16551.  
  16552. c40adr:    sty    dest        ; put y-reg in dest
  16553.     lda    #$00        ; zero extend
  16554.     sta    dest+1
  16555.     asl    dest        ; multiplied by 2
  16556.     rol    dest+1
  16557.     asl    dest        ; multiplied by 4
  16558.     rol    dest+1
  16559.     tya            ; add in y to get 5*y
  16560.     adc    dest        ; carry is clear
  16561.     sta    dest
  16562.     bcc    c40adr1
  16563.     inc    dest+1
  16564. c40adr1:asl    dest        ; multiplied by 10
  16565.     rol    dest+1
  16566.     asl    dest        ; multiplied by 20
  16567.     rol    dest+1
  16568.     asl    dest        ; multiplied by 40
  16569.     rol    dest+1
  16570.     cpx    #40        ; are we in the funny row?
  16571.     bcc    c40adr2        ; no
  16572.     ldx    #39
  16573. c40adr2:txa            ; add in x-reg
  16574.     clc
  16575.     adc    dest
  16576.     sta    dest
  16577.     bcc    c40adr3
  16578.     inc    dest+1
  16579. c40adr3:rts            ; all done
  16580.  
  16581. ;
  16582. ;    Newchar - character mapping table
  16583. ;
  16584. ;    This table is used to define the 80 column and 40 column character sets
  16585. ;    The format of this table is:
  16586. ;        Number of characters to copy    (byte)
  16587. ;        Source of characters        (word)
  16588. ;        Destination for characters    (word)
  16589. ;
  16590.  
  16591. newchar:.byte 32    ; <space> - ?
  16592.     .word $d000+<32*8>
  16593.     .word font40+<00*8>
  16594.  
  16595.     .byte 28    ; @ A-Z [
  16596.     .word $d000+<00*8>
  16597.     .word font40+<32*8>
  16598.  
  16599.     .byte 1        ; \
  16600.     .word char92
  16601.     .word font40+<60*8>
  16602.  
  16603.     .byte 1        ; ]
  16604.     .word $d000+<29*8>
  16605.     .word font40+<61*8>
  16606.  
  16607.     .byte 3        ; ^ _ `
  16608.     .word char94
  16609.     .word font40+<62*8>
  16610.  
  16611.     .byte 26    ; a-z
  16612.     .word $d800+<01*8>
  16613.     .word font40+<65*8>
  16614.  
  16615.     .byte 4        ; { | } ~
  16616.     .word char123
  16617.     .word font40+<91*8>
  16618.  
  16619.     .byte 1        ; diamond 
  16620.     .word $d000+<90*8>
  16621.     .word font40+<95*8>
  16622.  
  16623.     .byte 1        ; square
  16624.     .word $d000+<102*8>
  16625.     .word font40+<96*8>
  16626.  
  16627.     .byte 8        ; h-t, f-f, c-r, l-f, degrees, plus/minus, n-l, v-t
  16628.     .word char129
  16629.     .word font40+<97*8>
  16630.  
  16631.     .byte 1        ; upper-left
  16632.     .word $d000+<125*8>
  16633.     .word font40+<105*8>
  16634.  
  16635.     .byte 1        ; lower-left
  16636.     .word $d000+<110*8>
  16637.     .word font40+<106*8>
  16638.  
  16639.     .byte 1        ; lower-right
  16640.     .word $d000+<112*8>
  16641.     .word font40+<107*8>
  16642.  
  16643.     .byte 1        ; upper-right
  16644.     .word $d000+<109*8>
  16645.     .word font40+<108*8>
  16646.  
  16647.     .byte 1        ; crossed lines
  16648.     .word $d000+<91*8>
  16649.     .word font40+<109*8>
  16650.  
  16651.     .byte 1        ; scan 1
  16652.     .word $d000+<119*8>
  16653.     .word font40+<110*8>
  16654.  
  16655.     .byte 1        ; scan 3
  16656.     .word $d000+<69*8>
  16657.     .word font40+<111*8>
  16658.  
  16659.     .byte 1        ; scan 5
  16660.     .word $d000+<67*8>
  16661.     .word font40+<112*8>
  16662.  
  16663.     .byte 1        ; scan 7
  16664.     .word $d000+<82*8>
  16665.     .word font40+<113*8>
  16666.  
  16667.     .byte 1        ; scan 9
  16668.     .word $d000+<111*8>
  16669.     .word font40+<114*8>
  16670.  
  16671.     .byte 1        ; middle-right
  16672.     .word $d000+<107*8>
  16673.     .word font40+<115*8>
  16674.  
  16675.     .byte 1        ; middle-left
  16676.     .word $d000+<115*8>
  16677.     .word font40+<116*8>
  16678.  
  16679.     .byte 2        ; upper-middle, lower-middle
  16680.     .word $d000+<113*8>
  16681.     .word font40+<117*8>
  16682.  
  16683.     .byte 1        ; vertical line
  16684.     .word $d000+<93*8>
  16685.     .word font40+<119*8>
  16686.  
  16687.     .byte 2        ; <=, >=
  16688.     .word char152
  16689.     .word font40+<120*8>
  16690.  
  16691.     .byte 1        ; pi
  16692.     .word $d000+<94*8>
  16693.     .word font40+<122*8>
  16694.  
  16695.     .byte 1        ; !=
  16696.     .word char155
  16697.     .word font40+<123*8>
  16698.  
  16699.     .byte 1        ; british pound
  16700.     .word $d000+<28*8>
  16701.     .word font40+<124*8>
  16702.  
  16703.     .byte 1        ; dot
  16704.     .word char157
  16705.     .word font40+<125*8>
  16706.  
  16707.     .byte 0        ; end of table
  16708.  
  16709.     .byte    *-newchar    ; abort assembly if table too long
  16710.  
  16711. ;
  16712. ;    charXXX - 40 column character definitions not available in rom
  16713. ;
  16714.  
  16715. char92:    .byte    $00,$60,$30,$18,$0c,$06,$03,$00    ; \
  16716. char94:    .byte    $00,$00,$18,$3c,$66,$00,$00,$00    ; ^
  16717.     .byte    $00,$00,$00,$00,$00,$00,$00,$7f    ; _
  16718.     .byte    $30,$18,$0c,$00,$00,$00,$00,$00    ; `
  16719. char123:.byte    $0e,$18,$08,$3c,$08,$18,$0e,$00    ; {
  16720.     .byte    $18,$18,$18,$00,$18,$18,$18,$00 ; |
  16721.     .byte    $70,$18,$10,$3c,$10,$18,$70,$00    ; }
  16722.     .byte    $00,$00,$3b,$6e,$00,$00,$00,$00    ; ~
  16723. char129:.byte    $a0,$a0,$e0,$ae,$a4,$04,$04,$00 ; (graphics) h-t
  16724.     .byte    $e0,$80,$ee,$88,$8e,$08,$08,$00 ; (graphics) f-f
  16725.     .byte    $60,$80,$8c,$6a,$0c,$0a,$0a,$00 ; (graphics) c-r
  16726.     .byte    $80,$80,$8e,$88,$ee,$08,$08,$00 ; (graphics) l-f
  16727.     .byte    $18,$24,$24,$18,$00,$00,$00,$00 ; (graphics) degrees
  16728.     .byte    $00,$18,$7e,$18,$7e,$00,$00,$00 ; (graphics) plus/minus
  16729.     .byte    $a0,$e0,$e8,$e8,$a8,$08,$0e,$00 ; (graphics) n-l
  16730.     .byte    $a0,$a0,$a0,$4e,$04,$04,$04,$00 ; (graphics) v-t
  16731. char152:.byte    $06,$18,$30,$18,$06,$00,$7e,$00 ; (graphics) <=
  16732.     .byte    $60,$18,$06,$18,$60,$00,$7e,$00 ; (graphics) >=
  16733. char155:.byte    $00,$03,$7e,$0c,$7e,$30,$60,$00 ; (graphics) !=
  16734. char157:.byte    $00,$00,$00,$18,$18,$00,$00,$00 ; (graphics) dot
  16735.  
  16736. .SBTTL    Miscellaneous routines
  16737.  
  16738. ;
  16739. ;    These are miscellaneous routines used in many different places
  16740. ;
  16741.  
  16742. ;
  16743. ;    Move8 - move x-reg 8-byte chunks of memory
  16744. ;
  16745. ;    Input: X - Number of 8-byte chunks of memory to move
  16746. ;           (source) - address of source of memory move
  16747. ;           (dest) - address of destination of memory move
  16748. ;
  16749. ;    Output: Memory is moved
  16750. ;
  16751. ;    Registers Destroyed: A,X,Y
  16752. ;
  16753.  
  16754. move8:    ldy    #$00        ; zero y-reg
  16755. move8a:    lda    (source),y    ; get one byte to move
  16756.     sta    (dest),y    ; move it
  16757.     iny            ; go on to the next byte
  16758.     lda    (source),y    ; duplicated for speed
  16759.     sta    (dest),y
  16760.     iny
  16761.     lda    (source),y    ; duplicated for speed
  16762.     sta    (dest),y
  16763.     iny
  16764.     lda    (source),y    ; duplicated for speed
  16765.     sta    (dest),y
  16766.     iny
  16767.     lda    (source),y    ; duplicated for speed
  16768.     sta    (dest),y
  16769.     iny
  16770.     lda    (source),y    ; duplicated for speed
  16771.     sta    (dest),y
  16772.     iny
  16773.     lda    (source),y    ; duplicated for speed
  16774.     sta    (dest),y
  16775.     iny
  16776.     lda    (source),y    ; duplicated for speed
  16777.     sta    (dest),y
  16778.     iny
  16779.     bne    move8b        ; crossed page boundry?
  16780.     inc    source+1
  16781.     inc    dest+1
  16782. move8b:    dex            ; anything more to move?
  16783.     bne    move8a        ; yes, move it.
  16784.     rts
  16785.     
  16786. ;
  16787. ;    clr8k -    clear 8000 (not 8192!) bytes of memory
  16788. ;
  16789.  
  16790. clr8k:    lda    #4        ; loop through 4 times
  16791. clr8k1:    pha    
  16792.     lda    dest+1
  16793.     pha    
  16794.     lda    dest
  16795.     pha    
  16796.     ldx    #250        ; clear 2000 bytes  (250 * 8 = 2000)
  16797.     jsr    clear8
  16798.     pla    
  16799.     clc    
  16800.     adc    #2000\
  16801.     sta    dest
  16802.     pla    
  16803.     adc    #2000^
  16804.     sta    dest+1
  16805.     pla    
  16806.     sec    
  16807.     sbc    #$01
  16808.     bne    clr8k1
  16809.     rts    
  16810.  
  16811. ;
  16812. ;    Clear8 - clear x-reg 8-byte chunks of memory
  16813. ;
  16814. ;    Input: X - Number of 8-byte chunks of memory to clear
  16815. ;           (dest) - address of destination of memory move
  16816. ;
  16817. ;    Output: Memory is cleared
  16818. ;
  16819. ;    Registers Destroyed: A,X,Y
  16820. ;
  16821.  
  16822. clear8:    lda #$00        ; clear memory by filling with $00
  16823.     jsr fill8
  16824.     rts
  16825.     
  16826. ;
  16827. ;    Fill8 - fill x-reg 8-byte chunks of memory with a-reg
  16828. ;
  16829. ;    Input: X - Number of 8-byte chunks of memory to fill
  16830. ;           A - Byte to fill memory with
  16831. ;           (dest) - address of destination of memory move
  16832. ;
  16833. ;    Output: Memory is filled
  16834. ;
  16835. ;    Registers Destroyed: A,X,Y
  16836. ;
  16837.  
  16838. fill8:    ldy    #$00        ; zero y-reg
  16839. fill8a:    sta    (dest),y    ; fill it
  16840.     iny            ; go on to the next byte
  16841.     sta    (dest),y    ; duplicated for speed
  16842.     iny
  16843.     sta    (dest),y    ; duplicated for speed
  16844.     iny
  16845.     sta    (dest),y    ; duplicated for speed
  16846.     iny
  16847.     sta    (dest),y    ; duplicated for speed
  16848.     iny
  16849.     sta    (dest),y    ; duplicated for speed
  16850.     iny
  16851.     sta    (dest),y    ; duplicated for speed
  16852.     iny
  16853.     sta    (dest),y    ; duplicated for speed
  16854.     iny
  16855.     bne    fill8b        ; crossed page boundry?
  16856.     inc    dest+1
  16857. fill8b:    dex            ; anything more to fill?
  16858.     bne    fill8a        ; yes, fill it.
  16859.     rts
  16860.  
  16861. ;
  16862. ;    Case - Pascal like case function
  16863. ;
  16864. ;    Input: Y - Case statement to select
  16865. ;               The addresses of the routines to select are compiled inline
  16866. ;
  16867. ;    Registers Destroyed: X, Y
  16868. ;
  16869. ;    this routine transfers controll to a routine selected by the Y register
  16870. ;
  16871.  
  16872. case:    tax            ; preserve a-reg across case statement
  16873.     pla            ; get lo bype of case list
  16874.     sta source        ; save it
  16875.     pla            ; get hi byte of case list
  16876.     sta source+1        ; save it
  16877.     tya            ; put case selector into a-reg
  16878.     sec            ; add one half
  16879.     rol a            ; and multiply by two
  16880.     tay            ; put (2*case_selector)+1 into y-reg
  16881.     lda (source),y        ; get lo byte of routine to go to
  16882.     sta dest        ; save it
  16883.     iny            ; prepare to get hi byte of routines address
  16884.     lda (source),y        ; get hi byte of routines address
  16885.     sta dest+1        ; save it
  16886.     txa            ; preserve a-reg across case statement
  16887.     jmp (dest)        ; go to appropriate
  16888.  
  16889. ;
  16890. ;    powers - powers of 2
  16891. ;
  16892.  
  16893. powers:    .byte    $80
  16894.     .byte    $40
  16895.     .byte    $20
  16896.     .byte    $10
  16897.     .byte    $08
  16898.     .byte    $04
  16899.     .byte    $02
  16900.     .byte    $01
  16901.  
  16902. anyrts:    rts            ; a handy return from subroutine instruction
  16903. anybrk:    brk            ; a handy break instruction
  16904.  
  16905. end.asm:=    *
  16906.  
  16907. .SBTTL    Data for the screen package
  16908.  
  16909. fast:    .byte    $ff    ; flag for fast mode.  Copied to $d030.
  16910. b80flag:.byte    $ff    ; flag for b80.  set if initializing. clear otherwise
  16911. bordold:.byte    $ff    ; saved bordor color
  16912. line25:    .byte    $ff    ; $01=use 25th line, $00=keep line as blank or sysline
  16913. top:    .byte    $ff    ; top of scrolling area
  16914. bot:    .byte    $ff    ; bottom of scrolling area
  16915. cx:    .byte    $ff    ; cursor x coordinate
  16916. cy:    .byte    $ff    ; cursor y coordinate
  16917. cntdown:.byte    $ff    ; countdown timer
  16918. curabrt:.byte    $ff    ; $00=cursor disabled.  Incremented & decremented.
  16919. curstat:.byte    $ff    ; $00=cursor light now, $01=cursor dark now
  16920. evenodd:.byte    $ff    ; $f0=cursor on even column, $0f=cursor on odd column
  16921. save1:    .byte    $ff    ; screen save area #1
  16922. save2:    .byte    $ff    ; screen save area #2
  16923. save3:    .byte    $ff    ; screen save area #3
  16924. save4:    .byte    $ff    ; screen save area #4
  16925. save5:    .byte    $ff    ; screen save area #5
  16926. save6:    .byte    $ff    ; screen save area #6
  16927. save7:    .byte    $ff    ; screen save area #7
  16928. save8:    .byte    $ff    ; screen save area #8
  16929. save9:    .byte    $ff    ; screen save area #9
  16930.  
  16931. vt100gs    =    8    ; there are seven graphic rendition parameters
  16932. vt100gr    .blkb    vt100gs    ; graphic rendition params for vt100 emulation
  16933. alternt    =    vt100gr+1; $00=normal color, $01=alternate color
  16934. underln    =    vt100gr+4; $00=underline off, $ff=underline on
  16935. flash    =    vt100gr+5; $00=normal text, $01=flashing text
  16936. reverse    =    vt100gr+7; $00=reverse off, $ff=reverse on
  16937.  
  16938. vt100ss    =    10    ; there are nine settable switches
  16939. vt100sw:.blkb    vt100ss    ; vt100 switches
  16940. decckm    =    vt100sw+1; $01=cursor keys in application mode
  16941. decanm    =    vt100sw+2; $01=normal emulation, $00=vt100 emulating vt52
  16942. decrev    =    vt100sw+5; $01=screen reversed, $00=screen normal
  16943. decom    =    vt100sw+6; $01=relative, $00=absolute
  16944. wrap    =    vt100sw+7; $01=automatic wrapping, $00=no automatic wrapping
  16945. decarm    =    vt100sw+8; $01=automatic key repeat, $00=no automatic repeat
  16946. deckpam    .byte    $ff    ; $00 = use numeric keypad, $01=use alternat keypad
  16947. lmn:    .byte    $ff    ; $00 = new line mode clear, $01 = new line mode set
  16948. irm:    .byte    $ff    ; $00 = insert/replace mode = replace, $01 = insert
  16949. g0:    .byte    $ff    ; $00 = U.S. charset on g0, $01 = graphics on g0
  16950. g1:    .byte    $ff    ; $00 = U.S. charset on g1, $01 = graphics on g1
  16951. gx:    .byte    $ff    ; $00 = g0 selected, $01 = g1 selected
  16952.  
  16953. .SBTTL    Data for the key scanner
  16954.  
  16955. keylast:.byte    $ff
  16956. keyrept:.byte    $ff
  16957. keytime:.byte    $ff
  16958. keycol:    .byte    $ff
  16959. keycol1:.byte    $ff
  16960.  
  16961. .SBTTL    Data for the vt100 emulation package
  16962.  
  16963. vt100st:.byte    $ff    ; parser state
  16964. vt100pt:.byte    $ff    ; parameter pointer
  16965. tekmode:.byte    $ff    ; mode of the tektronics PLOT10 command parser
  16966. tekpen:    .byte    $ff    ; $00 = pen up, $01 = pen down
  16967. tekrxlo:.byte    $ff    ; tektronix receive buffer
  16968. tekrxhi:.byte    $ff
  16969. tekrylo:.byte    $ff
  16970. tekryhi:.byte    $ff
  16971. tekcxlo:.byte    $ff    ; tektronix cursor (tektronix format)
  16972. tekcxhi:.byte    $ff
  16973. tekcylo:.byte    $ff
  16974.  
  16975. tekcyhi:.byte    $ff
  16976. tekfxlo:.byte    $ff    ; tektronix 'from point' (screen driver format)
  16977. tekfxhi:.byte    $ff
  16978. tekfylo:.byte    $ff
  16979. tekfyhi:.byte    $ff
  16980. tektxlo:.byte    $ff    ; tektronix 'to point' (screen driver fromat)
  16981. tektxhi:.byte    $ff
  16982. tektylo:.byte    $ff
  16983. tektyhi:.byte    $ff
  16984. tekdxlo:.byte    $ff    ; tektronix 'delta' for line drawing
  16985. tekdxhi:.byte    $ff
  16986. tekdylo:.byte    $ff
  16987. tekdyhi:.byte    $ff
  16988. tekfxul:.byte    $ff    ; ultra-low from point (only used in line drawing)
  16989. tekfyul:.byte    $ff    ; ultra-low from point (only used in line drawing)
  16990. tekdxul:.byte    $ff    ; ultra-low delta point (only used in line drawing)
  16991. tekdyul:.byte    $ff    ; ultra-low delta point (only used in line drawing)
  16992.  
  16993. .SBTTL    Scratch area
  16994.  
  16995. freesiz    =    $20
  16996. freemem:.blkb    freesiz
  16997. tabs:    .blkb    81    ; tab stops
  16998.     .blkb    $100    ; safe and documented area for binary patches.
  16999. ;    cmbuf, atmbuf and plnbuf transplanted so that end of program does not
  17000. ;    go past $8000.
  17001. cmbuf:  .blkb    $100        ; Input command buffer
  17002. atmbuf:    .blkb    $100        ; Atombuffer, (for cmtxt and cmifil)
  17003. plnbuf: .blkb    $100        ;[DD] Port line buffer
  17004. font40:    =    *
  17005.