home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / utilitys / gpatch.arc / GNEW.Z80 < prev    next >
Text File  |  1990-07-21  |  22KB  |  1,109 lines
  1. ;Replacement routines for GBASIC to work on the Starcard. K.C.M. Lau Jan 87.
  2. ;Assem with ZASM (Cromemco). Overlay HEX file with offset 5500h from DDT.
  3. ;Also overlay GVEC.HEX
  4.  
  5.     org    1000h
  6.  
  7. newlen    equ    0800h    ;maximum space allocated to these routines
  8.             ;should match newlen in GVEC
  9.  
  10. error    equ    34D0h
  11. evalbyt    equ    4097h
  12. hevalxy    equ    4B20h
  13. printa    equ    6613h
  14.  
  15. ;Interpretor vectors
  16. newst    jp    ihgr    ;+00h hires
  17.     jp    ihcolr    ;+03h set hcolor
  18.     jp    ihplot    ;+06h hplot dots and lines
  19.     jp    fhcolr    ;+09h function hcolor
  20.     jp    fhscrn    ;+0Ch function hscrn
  21.     jp    itext    ;+0Fh shows text page
  22.  
  23.     jp    igr    ;+12h lores
  24.     jp    icolor    ;+15h set color
  25.     jp    iplot    ;+18h plot dot
  26.     jp    fcolor    ;+1Bh function color
  27.     jp    fscrn    ;+1Eh function status of point
  28.     jp    ihlin    ;+21h plot horiz line
  29.     jp    ivlin    ;+24h plot vert line
  30.  
  31.     jp    fpdl    ;+27h function pdl (n)
  32.     jp    fbutton    ;+2Ah function button (n)
  33.     jp    ibeep    ;+2Dh beep pitch,duration
  34.  
  35.     jp    icall    ;+30h call% ()
  36.     jp    edit    ;+33h edit n
  37.  
  38. ;-------- PEEKPOKE --------
  39. ;Starcard/Apple interface. Jan 86. K.C.M. Lau.
  40. ;Main routines : AINP, AOUT, AOUTHL, APEEK, APOKE, APOKEBL, ACALLFN, ACALL
  41.  
  42. PREG DB 0
  43. AREG DB 0
  44. XREG DB 0
  45. YREG DB 0
  46.  
  47. ;Input byte from Apple/Starcard port --> [A]
  48. AINP IN A,(40h)
  49.  RLCA
  50.  JR   NC,AINP
  51.  IN   A,(20h)
  52.  RET
  53.  
  54. ;Output [A] --> Apple/Starcard port
  55. AOUT PUSH AF
  56. AOUT1 IN A,(40h)
  57.  RRCA
  58.  JR  C,AOUT1
  59.  POP AF
  60.  OUT (0),A
  61.  RET
  62.  
  63. ;Output HL --> Apple/Starcard port
  64. AOUTHL PUSH AF
  65.  LD   A,L
  66.  CALL AOUT
  67.  LD   A,H
  68.  CALL AOUT
  69.  POP  AF
  70.  RET
  71.  
  72. ;Returns contents of 6502 location HL --> A
  73. APEEK LD A,6
  74.  CALL AOUT
  75.  CALL AOUTHL
  76.  JR   AINP
  77.  
  78. ;Write A --> 6502 location HL.
  79. APOKE PUSH AF
  80.  LD   A,7
  81.  CALL AOUT
  82.  CALL AOUTHL
  83.  POP  AF
  84.  JR   AOUT
  85.  
  86. ;{ Peek a double byte }
  87. ;function peekword (a : integer) : integer;
  88. ;  begin
  89. ;    peekword := peek (a) or (peek (a + 1) shl 8)
  90. ;  end;
  91.  
  92. ;{ Poke a double byte }
  93. ;procedure pokeword (a : integer; w : integer);
  94. ;  begin
  95. ;    poke (a, lo (w)); poke (a + 1, hi (w))
  96. ;  end;
  97.  
  98. ;Transfer a block to 6502 memory. HL=src. DE=dest. BC=len.
  99. APOKEBL LD A,2 ;Command code
  100.  CALL AOUT
  101.  LD   A,E ;Dest start
  102.  CALL AOUT
  103.  LD   A,D
  104.  CALL AOUT
  105.  LD   A,C ;Length
  106.  CALL AOUT
  107.  LD   A,B
  108.  CALL AOUT
  109. POKEBL1 LD A,(HL)
  110.  CALL AOUT
  111.  INC  HL
  112.  DEC  BC
  113.  LD   A,B
  114.  OR   C
  115.  JR   NZ,POKEBL1
  116.  RET
  117.  
  118. ;ACALLFN:Call 6502 subroutine at HL.
  119. ;Pass values in areg, xreg, etc. (to and from)
  120.  
  121. CALFST EQU 8C00h
  122. CALFFT DB 1
  123. CALFCD DB 8,32,9,176,141,32,140,32,9,176,141,33,140,32,9,176,72,32,9,176
  124.  DB 72,32,9,176,168,32,9,176,170,104,40,32,255,255,8,142,62,140,140,63
  125.  DB 140,32,12,176,104,32,12,176,173,62,140,32,12,176,173,63,140,32,12,176
  126.  DB 40,96,0,0
  127. CALFCDE EQU $
  128.  
  129. POKECLF PUSH HL
  130.  LD   HL,CALFCD
  131.  LD   DE,CALFST
  132.  LD   BC,CALFCDE-CALFCD
  133.  CALL APOKEBL
  134.  LD   A,0
  135.  LD   (CALFFT),A
  136.  POP  HL
  137.  RET
  138.  
  139. ACALLFN LD A,(CALFFT) ;If first time then pokecall
  140.  OR   A
  141.  CALL NZ,POKECLF
  142.  LD   A,3 ;Activate receiving routine
  143.  CALL AOUT
  144.  LD   A,CALFST % 100h
  145.  CALL AOUT
  146.  LD   A,CALFST / 100h
  147.  CALL AOUT
  148.  CALL AOUTHL ;Call addr
  149.  LD   A,(PREG) ;Pass regs to routine
  150.  CALL AOUT
  151.  LD   A,(AREG)
  152.  CALL AOUT
  153.  LD   A,(YREG)
  154.  CALL AOUT
  155.  LD   A,(XREG)
  156.  CALL AOUT
  157.  CALL AINP ;Receive results in regs
  158.  LD   (AREG),A
  159.  CALL AINP
  160.  LD   (PREG),A
  161.  CALL AINP
  162.  LD   (XREG),A
  163.  CALL AINP
  164.  LD   (YREG),A
  165.  RET
  166.  
  167. ;ACALL:Call 6502 subroutine. Pass values in areg, xreg, etc. (to only)
  168.  
  169. CALLST EQU 8C80h
  170. CALLFT DB 1
  171. CALLCD DB 8,32,9,176,141,160,140,32,9,176,141,161,140,32,9,176,72,32,9,176
  172.  DB 72,32,9,176,168,32,9,176,170,104,40,32,255,255,40,96
  173. CALLCDE EQU $
  174.  
  175. POKECL PUSH HL
  176.  LD   HL,CALLCD
  177.  LD   DE,CALLST
  178.  LD   BC,CALLCDE-CALLCD
  179.  CALL APOKEBL
  180.  LD   A,0
  181.  LD   (CALLFT),A
  182.  POP  HL
  183.  RET
  184.  
  185. ACALL LD A,(CALLFT) ;If first time then pokecall
  186.  OR   A
  187.  CALL NZ,POKECL
  188.  LD   A,3 ;Activate receiving routine
  189.  CALL AOUT
  190.  LD   A,CALLST % 100h
  191.  CALL AOUT
  192.  LD   A,CALLST / 100h
  193.  CALL AOUT
  194.  CALL AOUTHL ;Call addr
  195.  LD   A,(PREG) ;Pass regs to routine
  196.  CALL AOUT
  197.  LD   A,(AREG)
  198.  CALL AOUT
  199.  LD   A,(YREG)
  200.  CALL AOUT
  201.  LD   A,(XREG)
  202.  JP   AOUT
  203.  
  204. ;-------- HIRES --------
  205. ;Hires graphics module for STARCARD. Jan 87. K.C.M. Lau
  206. ;Use with PEEKPOKE
  207. ;Main routines : HGR, TEXT, HCOLOR, HPLOT, HPLOTTO, HLINE
  208.  
  209. ;Prepare for mixed screen page 1 hires graphics
  210. HGR LD A,60h ;Disconnect Applesoft
  211.  LD   HL,00B7h
  212.  CALL APOKE
  213.  LD   HL,0C05Fh ;Double res off
  214.  CALL APEEK
  215.  LD   HL,0F3E2h
  216.  JP   ACALL
  217.  
  218. ;Exit hires graphics mode
  219. TEXT LD HL,0C054h
  220.  CALL APEEK
  221.  LD   HL,0C051h
  222.  CALL APEEK
  223.  LD   HL,0C056h
  224.  CALL APEEK
  225.  LD   HL,0C00Dh ;80 columns
  226.  CALL APOKE
  227.  LD   HL,0C001h ;80 store on
  228.  CALL APOKE
  229.  LD   A,0CFh ;Turn on dev video
  230.  CALL AOUT
  231.  LD   A,2
  232.  CALL AOUT
  233.  JP   AINP
  234.  
  235. ;Set hires color to [A] (0..7)
  236. HCOLOR LD (XREG),A
  237.  LD HL,0F6F0h
  238.  JP ACALL
  239.  
  240. ;Plot single point. HL=x. DE=y.
  241. HPLOT LD A,E
  242.  LD (AREG),A
  243.  LD A,L
  244.  LD (XREG),A
  245.  LD A,H
  246.  LD (YREG),A
  247.  LD HL,0F457h
  248.  JP ACALL
  249.  
  250. ;Plot line from last point to HL,DE
  251. HPLOTTO LD A,L
  252.  LD (AREG),A
  253.  LD A,H
  254.  LD (XREG),A
  255.  LD A,E
  256.  LD (YREG),A
  257.  LD HL,0F53Ah
  258.  JP ACALL
  259.  
  260. ;Plot line from HL,DE to IX,IY
  261. HLINE CALL HPLOT
  262.  PUSH IX
  263.  POP  HL
  264.  PUSH IY
  265.  POP  HL
  266.  JP   HPLOTTO
  267.  
  268.  
  269.  
  270. ;-------- NEW CODE --------
  271. ;Vars
  272. ihcolrt    db    0    ;0..13 hcolor temp
  273. gflag    db    0    ;0=text or hires, NZ=lores
  274. beepft    db    0FFh    ;nz=first time
  275. chkft    db    0FFh    ;nz=first time
  276.  
  277. ;Prints string at after CALL until 0. All regs preserved
  278. prmsg    ex    (sp),hl    ;hl --> stack
  279.     push    af    ;af --> stack
  280. prmsg1    ld    a,(hl)    ;fetch next char
  281.     inc    hl
  282.     or    a    ;check for end of string marker
  283.     jr    z,prmsg2
  284.     call    printa    ;print char
  285.     jr    prmsg1
  286. prmsg2    pop    af    ;stack --> af
  287.     ex    (sp),hl    ;stack --> hl
  288.     ret
  289.  
  290. ;Check if FREEHGR.DVR is installed. If not error routine. All regs preserved.
  291. chkdvr    push    af
  292.     ld    a,(chkft)    ;skip if check OK before
  293.     or    a
  294.     jr    z,chkdvr2
  295.     push    bc        ;save regs
  296.     push    de
  297.     push    hl
  298.  
  299.     ld    hl,0010h    ;peek (10/11), NEXTFREE --> HL
  300.     call    apeek
  301.     ld    c,a
  302.     inc    hl
  303.     call    apeek
  304.     ld    h,a
  305.     ld    l,c
  306.     ld    de,6000h    ;cmp NEXTFREE - 6000h
  307.     and    a
  308.     sbc    hl,de
  309.     jr    c,chkerr    ;if NEXTFREE < 6000h then not installed err
  310.     
  311.     ld    hl,6017h    ;check for correct driver name
  312.     ld    de,dvrname
  313.     ld    b,4
  314. chkdvr1    call    apeek
  315.     ex    de,hl
  316.     cp    (hl)
  317.     jr    nz,chkerr
  318.     ex    de,hl
  319.     inc    hl
  320.     inc    de
  321.     djnz    chkdvr1
  322.     
  323.     xor    a        ;clear first time flag
  324.     ld    (chkft),a
  325.     pop    hl        ;restore regs
  326.     pop    de
  327.     pop    bc
  328. chkdvr2    pop    af
  329.     ret
  330.  
  331. chkerr    call    prmsg
  332.     db    'Starcard driver FREEHGR.DVR not installed on boot disk,'
  333.     db    0
  334.     pop    hl    ;dispose regs
  335.     pop    de
  336.     pop    bc
  337.     pop    af
  338.     pop    af    ;dispose return addr
  339.     jp    error    ;error
  340.  
  341. dvrname    db    'FREE'    ;correct driver name (leftstr only)
  342.  
  343. ;Interprets HGR <screen no>,<color no>
  344. ihgr    call    chkdvr        ;check for driver installed
  345.     ld    a,0        ;default screen 0
  346.     call    nz,evalbyt    ;eval screen no --> A
  347.     cp    4
  348.     jp    nc,error    ;error if screen no >= 4
  349.     push    af
  350.     ld    a,(hl)    ;check for comma
  351.     cp    ','
  352.     ld    a,0    ;default color
  353.     jr    nz,ihgr1 ;branch if no color specfied
  354.     inc    hl    ;skip comma
  355.     call    evalbyt    ;eval color no
  356. ihgr1    call    ihcolr1 ;set color
  357.     pop    af
  358.     push    hl
  359.     push    af
  360.     ld    hl,0C053h    ;flick mixed/full
  361.     rra
  362.     jr    nc,ihgr2
  363.     dec    l
  364. ihgr2    call    apeek
  365.     ld    hl,0C057h    ;flick hires
  366.     call    apeek
  367.     ld    hl,0C050h    ;flick graphics
  368.     call    apeek
  369.     ld    hl,0C05Fh    ;flick dbl hires off
  370.     call    apeek
  371.     ld    hl,00B7h    ;disconnect Applesoft
  372.     ld    a,60h
  373.     call    apoke
  374.     ld    hl,00E6h    ;set hpag
  375.     ld    a,20h
  376.     call    apoke
  377.     pop    af
  378.     and    2        ;fill screen for 2 and 3
  379.     call    z,gclr
  380.     pop    hl
  381.     ret
  382.  
  383. ;Clear screen to current color. Resets internal cursor to 0,0
  384. gclr    ld    hl,0        ;plot point (0,0)
  385.     ld    de,0
  386.     call    hplot
  387.     ld    hl,0F3F6h    ;fill background
  388.     jp    acall
  389.  
  390. ;Interprets HCOLOR n
  391. ihcolr    call    6925h    ;skip '='
  392.     db    0F0h
  393.     call    evalbyt    ;eval color
  394. ihcolr1    cp    13    ;error if color >= 13
  395.     jp    nc,error
  396.     ld    (ihcolrt),a ;save color
  397.     push    hl
  398.     cp    8    ;color < 8 preserved. Translate the rest
  399.     jr    c,ihcolr2
  400.     sub    8
  401.     ld    b,a
  402.     ld    a,0    ;8 --> 0
  403.     jr    z,ihcolr2
  404.     ld    a,3    ;9 --> 3
  405.     dec    b
  406.     jr    z,ihcolr2
  407.     ld    a,4    ;10 --> 4
  408.     dec    b
  409.     jr    z,ihcolr2
  410.     ld    a,7    ;11 --> 7
  411.     dec    b
  412.     jr    z,ihcolr2
  413.     ld    a,3    ;12 --> 3
  414. ihcolr2    call    hcolor    ;set color 0..7
  415.     pop    hl
  416.     ret
  417.  
  418. ;Interprets HPLOT, HPLOTTO
  419. ihplot    cp    0DDh    ;TO token
  420.     jr    z,ihploto
  421.     call    hevalxy    ;eval x,y --> DE,C
  422.     push    hl
  423.     ex    de,hl
  424.     ld    e,c
  425.     call    hplot    ;plot point
  426.     pop    hl
  427.     call    33CAh    ;fetch next char
  428.     ret    z    ;exit if end of statement
  429.  
  430. ihploto    call    33C9h    ;skip TO
  431.     call    hevalxy    ;eval x,y --> DE,C
  432.     push    hl
  433.     ex    de,hl
  434.     ld    e,c
  435.     call    hplotto    ;plot line
  436.     pop    hl
  437.     ld    a,(hl)    ;loop back if TO continuation
  438.     cp    0DDh
  439.     jr    z,ihploto
  440.     ret
  441.  
  442. ;Interprets function HCOLOR
  443. fhcolr    call    33C9h    ;skip token and spaces
  444.     ld    a,(ihcolrt)
  445.     push    hl
  446.     call    3E32h    ;store result
  447.     pop    hl
  448.     ret
  449.  
  450. ;Interprets HSCRN (x,y)
  451. fhscrn    call    33C9h    ;skip token and spaces
  452.     call    6925h    ;skip open bracket
  453.     db    '('
  454.     call    hevalxy    ;x,y --> DE,C
  455.     call    6925h    ;skip close bracket
  456.     db    ')'
  457.     push    hl
  458.     ld    a,c    ;HPOSN (x,y)
  459.     ld    (areg),a
  460.     ld    a,e
  461.     ld    (xreg),a
  462.     ld    a,d
  463.     ld    (yreg),a
  464.     ld    hl,0F411h
  465.     call    acall
  466.     ld    hl,0026h ;GBASE --> DE
  467.     call    apeek
  468.     ld    e,a
  469.     inc    hl
  470.     call    apeek
  471.     ld    d,a
  472.     ld    hl,00E5h ;column --> HL
  473.     call    apeek
  474.     ld    l,a
  475.     ld    h,0
  476.     add    hl,de    ;screen addr --> HL
  477.     call    apeek    ;screen contents --> B
  478.     ld    b,a
  479.     ld    hl,0030h ;bit mask --> A
  480.     call    apeek
  481.     and    a,b    ;select bit
  482.     add    a,a    ;remove color bit
  483.     jr    z,fhscrn1 ;make NZ = 0FFh
  484.     ld    a,0FFh
  485. fhscrn1    call    46E7h    ;store result
  486.     pop    hl
  487.     ret
  488.  
  489. ;Interprets TEXT
  490. itext    push    hl
  491.     ld    a,(083Ch) ;set gotoxy coords
  492.     dec    a
  493.     ld    h,a
  494.     ld    l,0
  495.     ld    (0B11h),hl
  496.     call    text    ;flick to text page
  497.     ld    a,(gflag)
  498.     or    a
  499.     jr    z,itext1 ;skip next instr if not lores
  500.     call    45A8h    ;clear screen (HOME)
  501. itext1    xor    a    ;reset gflag to indicate text
  502.     ld    (gflag),a
  503.     call    4554h    ;gotoxy
  504.     pop    hl
  505.     ret
  506.  
  507. ;Intepret GR <screen no>, <color>
  508. igr    ld    a,0        ;default screen no = 0
  509.     call    nz,evalbyt    ;eval screen no if present
  510.     cp    2
  511.     jp    nc,error    ;error if screen no >= 2
  512.     push    hl
  513.     push    af
  514.     ld    a,20        ;set top of window to line 20
  515.     ld    hl,0022h
  516.     call    apoke
  517.     ld    hl,1700h    ;gotoxy (0,23)
  518.     ld    (0B11h),hl
  519.     call    4554h
  520.     ld    hl,0C056h    ;flick LORES on
  521.     call    apeek
  522.     ld    hl,0C050h    ;flick GRAPHICS on
  523.     call    apeek
  524.     ld    hl,0C053h
  525.     pop    af        ;screen no --> A
  526.     rra            ;calc no. of lines to clear --> stack
  527.     ld    d,40
  528.     jr    nc,igr1
  529.     dec    l
  530.     ld    d,48
  531. igr1    call    apeek        ;flick page 1/2
  532.     pop    hl
  533.     ld    a,(hl)        ;fetch next char
  534.     cp    ','
  535.     push    de
  536.     ld    e,0        ;assume color = 0
  537.     jr    nz,igr2        ;branch if no color specified
  538.     inc    hl        ;skip comma
  539.     call    evalbyt
  540. igr2    call    icolor1        ;copy to hi nibble and store in ZP color
  541.     pop    bc        ;no. of lines to clear --> D
  542.     push    hl
  543.     ld    a,39        ;right most column to clear for HLIN
  544.     ld    hl,002Ch
  545.     call    apoke
  546. igr3    xor    a
  547.     ld    (yreg),a    ;leftmost y=0 --> YREG
  548.     ld    a,b
  549.     dec    a
  550.     ld    (areg),a    ;line to clear --> AREG
  551.     ld    hl,0F819h    ;call HLIN rom routine
  552.     push    bc
  553.     call    acall
  554.     pop    bc
  555.     djnz    igr3        ;repeat for line count
  556.     ld    a,0FFh        ;indicate GR on
  557.     ld    (gflag),a
  558.     pop    hl
  559.     ret
  560.  
  561. ;Interpret COLOR = 0..15
  562. icolor    call    6925h    ;skip '='
  563.     db    0F0h
  564.     call    evalbyt    ;eval color --> A
  565. icolor1    ld    a,e
  566.     cp    16
  567.     jp    nc,error ;error if color >= 16
  568.     add    a,a    ;copy to hi nibble also
  569.     add    a,a
  570.     add    a,a
  571.     add    a,a
  572.     or    e
  573.     push    hl
  574.     ld    hl,0030h ;store in color ZP location
  575.     call    apoke
  576.     pop    hl
  577.     ret
  578.  
  579. ;Eval lores x,y --> YREG,AREG
  580. prepxy    call    46A6h    ;eval x,y --> E,A
  581.     cp    48    ;check for y in range
  582.     jp    nc,error
  583.     ld    (areg),a ;y --> AREG
  584.     ld    a,e
  585.     cp    40    ;check for x in range
  586.     jp    nc,error
  587.     ld    (yreg),a
  588.     ret
  589.  
  590. ;Interpret PLOT x,y
  591. iplot    call    prepxy    ;eval x,y --> YREG, AREG
  592.     push    hl
  593.     ld    hl,0F800h ;call PLOT rom routine
  594.     call    acall
  595.     pop    hl
  596.     ret
  597.  
  598. ;Function COLOR
  599. fcolor    call    33C9h    ;skip spaces
  600.     push    hl
  601.     ld    hl,0030h ;peek COLOR zp loc
  602.     call    apeek
  603.     pop    hl
  604.     jp    46F0h    ;store result and return
  605.  
  606. ;Function SCRN
  607. fscrn    call    33C9h    ;skip spaces
  608.     call    6925h    ;skip opening bracket
  609.     db    '('
  610.     call    prepxy    ;eval x,y --> YREG, AREG
  611.     call    6925h    ;skip closing bracket
  612.     db    ')'
  613.     push    hl
  614.     ld    hl,0F871h ;call SCRN rom routine
  615.     call    acallfn
  616.     ld    a,(areg) ;color of point --> A
  617.     jp    46F1h    ;store result, pop hl, return
  618.  
  619. ;Evaluate: x1,x2 AT y --> D,E,A. If x1>x2 then swap x1,x2.
  620. ;Entry: C=xmax+1, B=ymax+1. Replaces routine at 4657h
  621. evalxxy    push    bc
  622.     call    46A6h    ;eval x1,x2 --> E,A
  623.     pop    bc
  624.     cp    e    ;if x1>x2 then swap x1,x2
  625.     call    c,swapae
  626.     cp    b    ;check for x in range
  627.     jp    nc,error
  628.     ld    d,a
  629.     push    de
  630.     push    bc
  631.     call    6925h    ;skip AT
  632.     db    'A'
  633.     call    6925h
  634.     db    'T'
  635.     call    evalbyt    ;eval y --> A
  636.     pop    bc
  637.     cp    c    ;check for y in range
  638.     jp    nc,error
  639.     pop    de
  640.     ret
  641.  
  642. ;Swap regs A <--> E
  643. swapae    ld    (swapaet),de
  644.     ld    e,a
  645.     ld    a,(swapaet)
  646.     ret
  647.  
  648. swapaet    dw    0FFFFh    ;temp
  649.  
  650. ;Interpret HLIN x1,x2 AT y
  651. ihlin    ld    bc,2830h    ;limits of x,y = 40,48
  652.     call    evalxxy        ;eval x1,x2 at y --> D,E,A
  653.     ld    (areg),A    ;y --> AREG
  654.     ld    a,e
  655.     ld    (yreg),a    ;x1 --> YREG
  656.     ld    a,d
  657.     push    hl
  658.     ld    hl,002Ch    ;x2 --> (002Ch)
  659.     call    apoke
  660.     ld    hl,0F819h    ;call HLIN rom routine
  661.     call    acall
  662.     pop    hl
  663.     ret
  664.  
  665. ;Interpret VLIN y1, y2 AT x
  666. ivlin    ld    bc,3028h    ;limits of y,x = 48,40
  667.     call    evalxxy        ;eval y1,y2 at x --> D,E,A
  668.     ld    (yreg),a    ;x --> YREG
  669.     ld    a,e
  670.     ld    (areg),a    ;y1 --> AREG
  671.     ld    a,d
  672.     push    hl
  673.     ld    hl,002Dh    ;y2 --> (002Dh)
  674.     call    apoke
  675.     ld    hl,0F828h    ;call VLIN rom routine
  676.     call    acall
  677.     pop    hl
  678.     ret
  679.  
  680. ;Function PDL (0..3)
  681. fpdl    call    409Ah    ;eval paddle no --> DE
  682.     ld    a,e
  683.     cp    4    ;check in range
  684.     jp    nc,error
  685.     ld    (xreg),a ;paddle no --> XREG
  686.     push    hl
  687.     ld    hl,0FB1Eh ;call PREAD rom routine
  688.     call    acallfn
  689.     pop    hl
  690.     ld    a,(YREG) ;paddle reading --> A
  691.     jp    3E32h    ;store result and return
  692.  
  693. ;Function BUTTON (0..2)
  694. fbutton    call    409Ah    ;eval paddle no --> DE
  695.     ld    a,e
  696.     cp    3    ;check in range
  697.     jp    nc,error
  698.     ld    a,d
  699.     or    a
  700.     jp    nz,error
  701.     push    hl
  702.     ld    hl,0C061h ;base addr of button softswitches
  703.     add    hl,de    ;add button no
  704.     call    apeek
  705.     pop    hl
  706.     rla        ;if bit 7 = 0 then HL = 0 else HL = 0FFFFh
  707.     sbc    a,a
  708.     ld    l,a
  709.     ld    h,a
  710.     jp    4FD7h    ;store fn result and return
  711.  
  712. ;Interprets BEEP <pitch>,<duration>
  713. ibeep    call    46A6h        ;eval pitch,duration --> E,A
  714.     inc    a
  715.     ld    (areg),a    ;duration + 1 --> AREG
  716.     ld    a,e
  717.     inc    a
  718.     ld    (xreg),a    ;pitch + 1 --> XREG
  719.     push    hl
  720.     ld    a,(beepft)    ;if first time poke 6502 routine to Apple ram
  721.     or    a
  722.     call    nz,pkbeep
  723.     ld    hl,beepst    ;call 6502 routine
  724.     call    acall
  725.     pop    hl
  726.     ret
  727.  
  728. pkbeep    ld    hl,beep65    ;poke 6502 beep routine --> Apple ram
  729.     ld    de,beepst
  730.     ld    bc,beeplen
  731.     call    apokebl
  732.     xor    a        ;first time = false
  733.     ld    (beepft),a
  734.     ret
  735.  
  736. beepst    equ    08B00h        ;6502 addr of beep65 routine
  737.  
  738. beep65    db    085h,045h    ;STA $45
  739.     db    086h,046h    ;STX $46
  740.     db    0A0h,000h    ;LDY #0
  741. beep65a    db    0ADh,030h,0C0h    ;LDA $C030
  742. beep65b    db    088h        ;DEY
  743.     db    0D0h,004h    ;BNE beep65c
  744.     db    0C6h,045h    ;DEC $45
  745.     db    0F0h,00Ch    ;BNE beep65q
  746. beep65c    db    020h,057h,0FFh    ;JSR $FF57
  747.     db    0CAh        ;DEX
  748.     db    0D0h,0F3h    ;BNE beep65b
  749.     db    0A6h,046h    ;LDX $46
  750.     db    0D0h,0ECh    ;BNE beep65a
  751.     db    0F0h,0EAh    ;BEQ beep65a
  752. beep65q    db    060h        ;RTS
  753.  
  754. beeplen    equ    $-beep65
  755.  
  756. ;Patch for CALL% var (parm1, parm2, parm3)
  757. icall    call    prmsg
  758.     db    'CALL% not implemented on Starcard version,',0
  759.     jp    error
  760.  
  761. ;Replacement line editor
  762. ;Entry: HL=buf start, B=buf index, C=buf index of terminating 0
  763. prchar    equ    6704h    ;print a, no regs affected
  764.  
  765. edit    ld    a,0    ;display rest of line from HL, ie. whole line
  766.     call    showrst
  767. edit1    call    675Ch    ;wait for key --> A (BIOS CONIN)
  768.     call    editbr    ;branch to subr
  769.     jr    edit1    ;keep looping
  770.  
  771. editbr    cp    7Fh    ;del (delete char to right)
  772.     jp    z,dellt
  773.     cp    ' '    ;non-ctrl chars (insert chars)
  774.     jp    nc,ins
  775.     cp    'S'-40h    ;ctrl-S (cursor left 1)
  776.     jp    z,curslt
  777.     cp    8    ;left arrow (alt)
  778.     jp    z,curslt
  779.     cp    'D'-40h    ;ctrl-D (cursor right 1)
  780.     jp    z,cursrt
  781.     cp    15h    ;right arrow (alt)
  782.     jp    z,cursrt
  783.     cp    'A'-40h    ;ctrl-A (cursor word left)
  784.     jp    z,wordlt
  785.     cp    'F'-40h    ;ctrl-F (cursor word right)
  786.     jp    z,wordrt
  787.     cp    09h    ;tab (alt)
  788.     jp    z,wordrt
  789.     cp    'R'-40h    ;ctrl-R (move to start of line)
  790.     jp    z,cursst
  791.     cp    0Bh    ;up arrow (alt)
  792.     jp    z,cursst
  793.     cp    'B'-40h    ;ctrl-B (alt)
  794.     jp    z,cursst
  795.     cp    'C'-40h    ;ctrl-C (move to end of line)
  796.     jp    z,cursend
  797.     cp    0Ah    ;down arrow (alt)
  798.     jp    z,cursend
  799.     cp    'N'-40h    ;ctrl-N (alt)
  800.     jp    z,cursend
  801.     cp    'P'-40h    ;ctrl-P (insert ctrl char)
  802.     jp    z,insctrl
  803.     cp    'G'-40h    ;ctrl-G (delete char under cursor)
  804.     jp    z,delrt
  805.     cp    'T'-40h    ;ctrl-T (delete word right)
  806.     jp    z,delword
  807.     cp    'Y'-40h    ;ctrl-Y (delete rest of line)
  808.     jp    z,delrst
  809.     cp    'Q'-40h    ;ctrl-Q (leave line unchanged)
  810.     jp    z,abort
  811.     cp    0Dh    ;cr (accept line)
  812.     jp    z,editcr
  813.     ret        ;ignore other control chars
  814.  
  815. ;Print screen code from screen table
  816. ;Entry A=fn#. Exit=af corrupted
  817. prscrn    push    hl
  818.     push    de
  819.     ld    e,a
  820.     call    4575h
  821.     pop    de
  822.     pop    hl
  823.     ret
  824.  
  825. ;Print any char in A. Ctrl chars inversed
  826. prany    cp    ' '
  827.     jp    nc,prchar    ;not fall thru for ctrl chars
  828.  
  829. ;Print ctrl-char in A inversed;
  830. prctrl    push    af
  831.     ld    a,5    ;inverse
  832.     call    prscrn
  833.     pop    af
  834.     push    af
  835.     add    a,'A'-1    ;print ctrl chars in inverse
  836.     call    prchar
  837.     ld    a,4    ;normal
  838.     call    prscrn
  839.     pop    af
  840.     ret
  841.  
  842. ;Reshow rest of line from hl inclusive. Leave cursor where it was.
  843. ;Entry: hl points to first char, a = no of trailing blanks
  844. ;Exit : af corrupted
  845. showrst    push    hl
  846.     push    bc
  847.     push    af    ;no of trailing spaces --> spaces
  848.     ld    b,1    ;cursor count + 1
  849.     ld    a,(hl)
  850.     or    a
  851.     jp    z,showrs3
  852.     ld    c,' '    ;asc space constant kept in reg for speed
  853.  
  854. showrs1    inc    hl    ;print rest of line until 0
  855.     inc    b
  856.     cp    c    ;space in c
  857.     call    c,prctrl ;if ctrl char then print it in inverse
  858.     call    nc,prchar
  859.     ld    a,(hl)
  860.     or    a
  861.     jp    nz,showrs1
  862.  
  863. showrs3    pop    af    ;print trailing spaces (a org has been saved on stack)
  864.     or    a
  865.     jp    z,showrs5
  866.     ld    c,a
  867.     ld    a,' '
  868.  
  869. showrs4    call    prchar
  870.     inc    b
  871.     dec    c
  872.     jp    nz,showrs4
  873.  
  874. showrs5    ld    a,8    ;move cursor back to before
  875.     dec    b
  876.     jr    z,showrs7
  877. showrs6    call    prchar
  878.     djnz    showrs6
  879.  
  880. showrs7    pop    bc
  881.     pop    hl
  882.     ret
  883.  
  884. ;Move cursor left. Exit: flag Z set if at start of line
  885. curslt    inc    b
  886.     dec    b
  887.     ret    z    ;ignore if at start of line
  888.     ld    a,8    ;move cursor left
  889.     call    prchar
  890.     dec    hl
  891.     dec    b    ;dec buf index
  892.     ret
  893.  
  894. ;Move cursor right
  895. cursrt    ld    a,(hl)
  896.     or    a
  897.     ret    z    ;ignore if at end of line
  898.     call    prany    ;move cursor by reprinting char
  899.     inc    hl    ;inc buf ptr
  900.     inc    b    ;inc buf index
  901.     ret
  902.  
  903. ;Check A is letter or number. Exit: Z set if so. Other regs preserved
  904. cmpalp    call    cmplet
  905.     ret    z    ;note fall thru to cmpnum if not letter
  906.  
  907. ;Check A is a number. Exit: Z set if so. Other regs preserved
  908. cmpnum    cp    '0'
  909.     ret    c
  910.     cp    '9'+1
  911.     jr    c,cmplet1    ;branch if 0..9 to set Z flag and ret
  912.     or    a        ;set NZ
  913.     ret
  914.  
  915. ;Check A is a letter. Exit: Z set if so. Other regs preserved
  916. cmplet    cp    'A'
  917.     ret    c
  918.     cp    'Z'+1
  919.     jr    c,cmplet1    ;branch if A..Z
  920.     cp    'a'
  921.     ret    c
  922.     cp    'z'+1
  923.     jr    c,cmplet1    ;branch if a..z
  924.     or    a        ;set    NZ
  925.     ret
  926.  
  927. cmplet1    cp    a        ;set Z
  928.     ret
  929.  
  930. ;Move cursor left to start of left word
  931. wordlt    call    curslt    ;move cursor to non-letter|letter boundary
  932.     ret    z
  933.     ld    a,(hl)
  934.     call    cmpalp
  935.     jr    nz,wordlt
  936.     dec    hl
  937.     ld    a,(hl)
  938.     inc    hl
  939.     call    cmpalp
  940.     jr    z,wordlt
  941.     ret
  942.  
  943. ;Move cursor right to start of next word
  944. wordrt    call    cursrt    ;move cursor to non-letter|letter boundary
  945.     ld    a,(hl)
  946.     or    a
  947.     ret    z
  948.     call    cmpalp
  949.     jr    nz,wordrt
  950.     dec    hl
  951.     ld    a,(hl)
  952.     inc    hl
  953.     call    cmpalp
  954.     jr    z,wordrt
  955.     ret
  956.  
  957. ;Move cursor to end of line
  958. cursend    call    cursrt
  959.     ld    a,(hl)
  960.     or    a
  961.     jp    nz,cursend
  962.     ret
  963.  
  964. ;Move cursor to start of line
  965. cursst    call    curslt
  966.     jp    nz,cursst
  967.     ret
  968.  
  969. ;Insert char in A
  970. ins    push    af    ;save char to be inserted
  971.     ld    a,c
  972.     cp    255
  973.     jr    c,ins1    ;branch if line len < 255 chars (ok)
  974.     ld    a,7    ;bell
  975.     call    prchar
  976.     pop    af
  977.     ret
  978.  
  979. ins1    sub    b    ;chars left to right --> B
  980.     inc    c    ;inc buf len
  981.     inc    b    ;inc buf index
  982.     push    bc
  983.     ex    de,hl    ;calculate various blk move pointers --> BC,HL,DE
  984.     ld    l,a
  985.     ld    h,0
  986.     add    hl,de
  987.     ld    b,h
  988.     ld    c,l
  989.     inc    hl
  990.     call    6814h    ;block move 1 char right
  991.     pop    bc
  992.     pop    af    ;char to be inserted --> A
  993.     ld    (hl),a    ;store it
  994.     ld    a,0
  995.     call    showrst    ;reprint rest of line
  996.     ld    a,(hl)     ;advance cursor
  997.     call    prany
  998.     inc    hl    ;bump buf ptr
  999.     ret
  1000.  
  1001. ;Insert ctrl char
  1002. insctrl    call    675Ch
  1003.     cp    0Ah
  1004.     jp    z,ins
  1005.     cp    07h
  1006.     jp    z,ins
  1007.     cp    09h
  1008.     jp    z,ins
  1009.     ret
  1010.  
  1011. ;Delete char to left of cursor
  1012. dellt    ld    a,b
  1013.     or    a
  1014.     ret    z    ;ignore it at first char of line
  1015.     call    curslt    ;move cursor left
  1016.  
  1017. ;Delete char under cursor
  1018. delrt    ld    a,(hl)
  1019.     or    a
  1020.     ret    z    ;ignore if at end of line
  1021.     call    63EAh    ;blk move 1 char left
  1022.     ld    a,1
  1023.     call    showrst    ;reprint line
  1024.     ret
  1025.  
  1026. ;If char in A is a letter then let A = 'A'
  1027. ;else if char in A is a number then let A = '0'
  1028. normalp    call    cmplet
  1029.     jr    z,normal1    ;branch if 'A'..'Z'
  1030.     call    cmpnum
  1031.     ret    nz        ;exit if not letter nor number
  1032.     ld    a,'9'
  1033.     ret
  1034.  
  1035. normal1    ld    a,'A'
  1036.     ret
  1037.  
  1038. ;Delete word to right
  1039. delword    push    hl
  1040.     push    bc
  1041.     ld    d,h    ;buf ptr --> de (dest of blk move)
  1042.     ld    e,l
  1043.     ld    a,(hl)    ;fetch first char
  1044.     or    a
  1045.     jr    z,delw2
  1046.     call    normalp    ;  make all letters become 'A' and number become '0'
  1047.     ld    b,a
  1048. delw1    inc    hl    ;scan for boundaries (ie changes)
  1049.     ex    (sp),hl    ;  inc buf ptr (src of blk move)
  1050.     dec    l    ;  dec buf len
  1051.     ex    (sp),hl
  1052.     ld    a,(hl)
  1053.     call    normalp
  1054.     cp    b    ;  compare this char with first char
  1055.     jr    z,delw1    ;  repeat until this char <> first char
  1056.     pop    bc    ;buf len - buf index + 1 --> bc (byte count)
  1057.     push    bc
  1058.     ld    a,c
  1059.     sub    b
  1060.     inc    a
  1061.     ld    c,a
  1062.     ld    b,0
  1063.     push    hl    ;bytes to blank --> a
  1064.     and    a
  1065.     sbc    hl,de
  1066.     ld    a,l
  1067.     pop    hl
  1068.     ldir        ;block move chars to left
  1069. delw2    pop    bc
  1070.     pop    hl
  1071.     jp    showrst    ;display rest of line with tailing blanks
  1072.  
  1073. ;Delete rest of line
  1074. delrst    ld    a,c    ;no of chars to blank from screen --> A
  1075.     sub    b
  1076.     ld    (hl),0    ;store terminator
  1077.     ret    z    ;if at end of line already then exit
  1078.     ld    c,b    ;buf index --> buf len
  1079.     jp    showrst    ;print A spaces (blank rest of line)
  1080.  
  1081. ;Abort edit (leave line unchanged)
  1082. abort    call    cursend    ;print rest of line
  1083.     ld    a,'\'    ;print reverse slash
  1084.     call    prchar
  1085.     jp    644Dh    ;old 'Q' routine
  1086.  
  1087. ;Finish editing
  1088. editcr    call    cursend
  1089. editcr1    ld    a,b
  1090.     or    a
  1091.     jr    z,editcr2
  1092.     dec    hl
  1093.     ld    a,(hl)
  1094.     inc    hl
  1095.     cp    ' '
  1096.     jr    nz,editcr2
  1097.     call    dellt
  1098.     jr    editcr1
  1099.  
  1100. editcr2    jp    643Bh
  1101.  
  1102. ;Check that routines fit space allocated
  1103.     if    ($-newst) > newlen
  1104.     conmsg    WARNING:Code exceeds space allocated; adjust newlen.
  1105.  
  1106.     end
  1107. at routines fit space allocated
  1108.     if    ($-newst) > newlen
  1109.     conmsg    WARNING:Code exceeds s