home *** CD-ROM | disk | FTP | other *** search
/ The Best of Mecomp Multimedia 2 / MECOMP-CD-II.iso / amiga / emulation / qlsource / romsrc / kbd / kbd_asm
Encoding:
Text File  |  1998-02-23  |  34.7 KB  |  1,843 lines

  1.     SECTION    KBD
  2.  
  3.     INCLUDE    '/INC/QDOS_inc'
  4.     INCLUDE    '/INC/AMIGA_inc'
  5.     INCLUDE    '/INC/AMIGQDOS_inc'
  6.  
  7. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. ; KBD1_asm - Keyboard routines
  9. ;      - last modified 22/02/98
  10.  
  11. ; These are all the necessary keyboard related sources, required
  12. ; to implement QDOS keyboard routines on the Amiga computer.
  13.  
  14. ; Amiga-QDOS sources by Rainer Kowallik
  15. ;  ...latest changes by Mark J Swift
  16.  
  17. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  18. ;  ROM header
  19.  
  20. BASE:
  21.     dc.l    $4AFB0001    ; ROM recognition code
  22.     dc.w    PROC_DEF-BASE    ; add BASIC procs here
  23.     dc.w    ROM_START-BASE
  24.     dc.b    0,36,'Amiga-QDOS KEYBOARD routines v1.33 ',$A
  25.  
  26. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  27. ;  start of ROM code
  28.  
  29. ROM_START:
  30.     movem.l    d0-d3/a0-a3,-(a7)
  31.  
  32. ; --------------------------------------------------------------
  33. ;  allocate memory for keyboard variables
  34.  
  35.     move.l    #KV_LEN,d1
  36.     moveq    #MT.ALCHP,d0
  37.     moveq    #0,d2
  38.     trap    #1
  39.  
  40. ; --------------------------------------------------------------
  41. ;  address of keyboard variables
  42.  
  43.     move.l    a0,AV.KEYV
  44.     move.l    a0,a3
  45.  
  46. ; --------------------------------------------------------------
  47. ;  enter supervisor mode and disable interrupts
  48.  
  49.     trap    #0
  50.  
  51.     ori.w    #$0700,sr    ; disable interrupts
  52.  
  53. ; --------------------------------------------------------------
  54. ;  link a custom routine into level 7 interrupt server
  55.  
  56.     lea    AV.LVL7link,a1
  57.     lea    KV.LVL7link(a3),a2
  58.  
  59.     move.l    (a1),(a2)
  60.     move.l    a2,(a1)
  61.  
  62.     lea    MY_LVL7(pc),a1
  63.     move.l    a1,$04(a2)
  64.  
  65. ; --------------------------------------------------------------
  66. ;  link a custom routine into Trap #1 exception
  67.  
  68.     lea    AV.TRP1link,a1
  69.     lea    KV.TRP1link(a3),a2
  70.  
  71.     move.l    (a1),(a2)
  72.     move.l    a2,(a1)
  73.  
  74.     lea    MY_TRP1(pc),a1
  75.     move.l    a1,$04(a2)
  76.  
  77. ; --------------------------------------------------------------
  78. ;  initialise relevant hardware
  79.  
  80.     bsr    INIT_HW
  81.  
  82. ; -------------------------------------------------------------
  83. ; link in external interrupt to act on keyboard press
  84.  
  85.     lea    XINT_SERver(pc),a1 ; address of routine
  86.     lea    KV.XINTLink(a3),a0
  87.     move.l    a1,4(a0)
  88.     moveq    #MT.LXINT,d0
  89.     trap    #1
  90.  
  91. ; --------------------------------------------------------------
  92. ;  link in polled task routine to handle keyboard
  93.  
  94.     lea    POLL_SERver(pc),a1 ; address of routine
  95.     lea    KV.POLLLink(a3),a0
  96.     move.l    a1,4(a0)     ; address of polled task
  97.     moveq    #MT.LPOLL,d0
  98.     trap    #1
  99.  
  100. ; --------------------------------------------------------------
  101. ;  enable interrupts and re-enter user mode
  102.  
  103.     andi.w    #$D8FF,sr
  104.  
  105. ; --------------------------------------------------------------
  106. ROM_EXIT:
  107.     movem.l    (a7)+,d0-d3/a0-a3
  108.     rts
  109.  
  110. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  111. ;  initialise keyboard for use.
  112.  
  113. INIT_HW:
  114.     movem.l    d0-d2/a0/a3,-(a7)
  115.  
  116. ; --------------------------------------------------------------
  117. ;  set ASCII table and clear actual key.
  118.  
  119.     move.l    AV.KEYV,a3    ; address of keyboard vars
  120.  
  121.     lea    QLASCII(pc),a0
  122.     move.l    a0,KV.QLASCtbl(a3)
  123.  
  124.     clr.w    KV.ACTKEy(a3)    ; reset actual key
  125.  
  126.     move.w    #0,KV.PTRMINX(a3)
  127.     move.w    #0,KV.PTRMINY(a3)
  128.     move.w    #255,KV.PTRMAXX(a3)
  129.     move.w    #255,KV.PTRMAXY(a3)
  130.  
  131.     move.w    #0,KV.PTROLDX(a3)
  132.     move.w    #0,KV.PTROLDY(a3)
  133.  
  134.     move.w    #0,KV.PTRX(a3)
  135.     move.w    #0,KV.PTRY(a3)
  136.  
  137.     move.w    #4,KV.PTRINCX(a3)
  138.     move.w    #8,KV.PTRINCY(a3)
  139.  
  140.     move.w    JOY0DAT,KV.STOMOuse(a3)
  141.  
  142.     sf    KV.QIMIFLG(a3)
  143. ; --------------------------------------------------------------
  144. ;  initialise hardware
  145.  
  146.     move.b    CIAA_ICR,d0    ; read & clear CIA-A ICR
  147.     or.b    AV.CIAA_ICR,d0
  148.     bclr    #3,d0        ; clear SP bit
  149.     move.b    d0,AV.CIAA_ICR    ; store for another program
  150.  
  151.     move.w    #%0000000000001000,INTREQ ; clear and enable
  152.     move.w    #%1000000000001000,INTENA ; CIA-A interrupts
  153.  
  154.     move.b    #%10001000,CIAA_ICR ; enable SP interrupt
  155.  
  156.     ori.b    #%00001000,AV.CIAA_MSK ; take note
  157.  
  158.     movem.l    (a7)+,d0-d2/a0/a3
  159.     rts
  160.  
  161. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  162. ;  external interrupt server
  163.  
  164. XINT_SERver:
  165.     movem.l    d7/a0,-(a7)
  166.  
  167. XINT_TST:
  168.     move.w    INTENAR,d7    ; read interrupt enable reg
  169.     btst    #3,d7        ; branch if ints not on
  170.     beq    XINT_OTHer
  171.  
  172.     move.w    INTREQR,d7    ; read interrupt request reg
  173.     btst    #3,d7        ; branch if from CIA-A or
  174.     bne    CIAA_SERV    ; expansion ports
  175.  
  176. ; --------------------------------------------------------------
  177. ;  otherwise let another external interrupt server handle it
  178.  
  179. XINT_OTHer:
  180.     movem.l    (a7)+,d7/a0
  181.     rts
  182.  
  183. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  184. ;  Interrupt from CIA-A or expansion port
  185.  
  186. CIAA_SERV:
  187.     move.b    CIAA_ICR,d7    ; read CIA-A ICR
  188.     or.b    AV.CIAA_ICR,d7
  189.     move.b    d7,AV.CIAA_ICR    ; store for another program
  190.  
  191.     bclr    #3,d7        ; keyboard? (SP bit=1)
  192.     beq    XINT_OTHer    ; no
  193.  
  194. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  195. ; external interrupt server for acting on an a key press.
  196. ; The Result is stored in KV.ACTKEy (word) (MSB=ASCII,LSB=ALT)
  197.  
  198. RDKEYB:
  199.     move.b    d7,AV.CIAA_ICR
  200.  
  201.     and.b    AV.CIAA_MSK,d7    ; don't clear intreq if
  202.     bne.s    RDKEYB0        ; other CIAA ints occured
  203.  
  204.     move.w    #%0000000000001000,INTREQ ; clear interrupts
  205.  
  206. ; --------------------------------------------------------------
  207. RDKEYB0:
  208.     movem.l    d0/a0/a3,-(a7)
  209.  
  210.     move.l    AV.KEYV,a3    ; address of keyboard vars
  211.  
  212.     BSR    KEYread
  213.  
  214.     tst.b    KV.ACTKEy+1(a3)
  215.     beq    RDKEYBX
  216.  
  217. ; --------------------------------------------------------------
  218. ;  Check for CTRL-ALT-2 and simulate a level 2 interrupt
  219.  
  220. RDKEYB1:
  221.     move.w    KV.ACTKEy(a3),d0
  222.     cmp.w    #$92FF,d0    ; CTRL 2/ALT ?
  223.     bne.s    RDKEYB2
  224.  
  225.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  226.  
  227.     ori.w    #$0700,sr    ; mask out all interrupts
  228.  
  229.     move.w    #$8000,d7
  230.  
  231. WAITABIT2:
  232.     move.w    #RED,COLOR00    ; signal forced interrupt
  233.     move.w    #0,COLOR00    ; via DMA-test pattern
  234.     dbra    d7,WAITABIT2
  235.  
  236.     adda.l    #$24,a7        ;*/note JS specific
  237.     movem.l    (a7)+,d0-d6/a0-a4 ; drop out of external
  238.     movem.l    (a7)+,d7/a5/a6    ; interrupt call
  239.  
  240.     subq.l    #4,a7
  241.     movem.l    a3,-(a7)
  242.     move.l    AV.MAINlink,a3
  243.     move.l    4(a3),4(a7)    ; address of 1st routine
  244.     movem.l    (a7)+,a3
  245.     rts            ; jump to routine
  246.  
  247. ; --------------------------------------------------------------
  248. ;  Check for CTRL-ALT-5 and simulate a level 5 interrupt
  249.  
  250. RDKEYB2:
  251.     move.w    KV.ACTKEy(a3),d0
  252.     cmp.w    #$95FF,d0    ; CTRL 5/ALT ?
  253.     bne.s    RDKEYB3
  254.  
  255.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  256.  
  257.     ori.w    #$0700,sr    ; mask out all interrupts
  258.  
  259.     move.w    #$8000,d7
  260.  
  261. WAITABIT5:
  262.     move.w    #CYAN,COLOR00    ; signal forced interrupt
  263.     move.w    #0,COLOR00    ; via DMA-test pattern
  264.     dbra    d7,WAITABIT5
  265.  
  266.     adda.l    #$24,a7        ;*/note JS specific
  267.     movem.l    (a7)+,d0-d6/a0-a4 ; drop out of external
  268.     movem.l    (a7)+,d7/a5/a6    ; interrupt call
  269.  
  270.     subq.l    #4,a7
  271.     movem.l    a3,-(a7)
  272.     move.l    AV.LVL5link,a3
  273.     move.l    4(a3),4(a7)    ; address of 1st routine
  274.     movem.l    (a7)+,a3
  275.     rts            ; jump to routine
  276.  
  277. ; --------------------------------------------------------------
  278. ;  Check for CTRL-ALT-7 and simulate a level 7 interrupt
  279.  
  280. RDKEYB3:
  281.     move.w    KV.ACTKEy(a3),d0
  282.     cmp.w    #$97FF,d0    ; CTRL 7/ALT ?
  283.     bne.s    RDKEYB4
  284.  
  285.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  286.  
  287.     ori.w    #$0700,sr    ; mask out all interrupts
  288.  
  289.     move.b    #$7F,CIAA_ICR    ; no ints from CIA-A
  290.     move.b    #$7F,CIAB_ICR    ; no ints from CIA-B
  291.     move.w    #$7FFF,INTREQ    ; clear interrupt requests
  292.     move.w    #$7FFF,INTENA    ; disable interrupts
  293.  
  294. ALT7_BZY:
  295.     btst    #6,DMACONR    ; wait for blitter
  296.     bne.s    ALT7_BZY
  297.  
  298.     move.w    #$07FF,DMACON    ; no DMA, no blitter prio'ty
  299.  
  300.     move.w    #$8000,d7
  301.  
  302. WAITABIT7:
  303.     move.w    #WHITE,COLOR00    ; signal forced interrupt
  304.     move.w    #0,COLOR00    ; via DMA-test pattern
  305.     dbra    d7,WAITABIT7
  306.  
  307.     adda.l    #$24,a7        ;*/note JS specific
  308.     movem.l    (a7)+,d0-d6/a0-a4 ; drop out of external
  309.     movem.l    (a7)+,d7/a5/a6    ; interrupt call
  310.  
  311.     subq.l    #4,a7
  312.     movem.l    a3,-(a7)
  313.     move.l    AV.LVL7link,a3
  314.     move.l    4(a3),4(a7)    ; address of 1st routine
  315.     movem.l    (a7)+,a3
  316.     rts            ; jump to routine
  317.  
  318. ; --------------------------------------------------------------
  319. ;  Check for CTRL-SHIFT-ALT-TAB and perform a reset
  320.  
  321. RDKEYB4:
  322.     move.l    KV.SHIFTflg(a3),d0
  323.     cmp.l    #(%00000111<<24)|$09FF,d0 ; ALT/CTRL/SHIFT/TAB/ALT
  324.     bne    RDKEYB5
  325.  
  326.     clr.w    KV.ACTKEy(a3)    ; reset keypress
  327.  
  328.     ori.w    #$0700,sr    ; mask out all interrupts
  329.  
  330.     move.b    #$7F,CIAA_ICR    ; no ints from CIA-A
  331.     move.b    #$7F,CIAB_ICR    ; no ints from CIA-B
  332.     move.w    #$7FFF,INTREQ    ; clear interrupt requests
  333.     move.w    #$7FFF,INTENA    ; disable interrupts
  334.  
  335. ALTT_BZY:
  336.     btst    #6,DMACONR    ; wait for blitter
  337.     bne.s    ALTT_BZY
  338.  
  339.     move.w    #$07FF,DMACON    ; no DMA, no blitter prio'ty
  340.  
  341.     movem.l    d0-d1/a6,-(a7)
  342.  
  343.     move.l    a7,d1        Calculate start of
  344.     andi.w    #-$8000,d1    system variables
  345.     move.l    d1,a6
  346.  
  347.     cmpi.b    #$10,$A1(a6)
  348.     bls.s    DOCACHX        exit if 010 or less
  349.  
  350.     dc.w    $4E7A,$0002    movec    cacr,d0
  351.     move.l    #$0808,d1    clear/disable caches
  352.  
  353.     cmpi.b    #$30,$A1(a6)
  354.     bls.s    DOCACHSET
  355.  
  356.     tst.w    d0        check 040 bits
  357.     bpl.s    DOCACHDCHK    branch if instruction cache off
  358.     dc.w    $F4B8        cpusha    ic
  359.                 ; otherwise update memory from cache
  360.  
  361. DOCACHDCHK:
  362.     tst.l    d0        check 040 bits
  363.     bpl.s    DOCACHINV    branch if data cache off
  364.     dc.w    $F478        cpusha    dc
  365.                 ; otherwise update memory from cache
  366.  
  367. DOCACHINV:
  368.     dc.w    $F4D8        cinva    ic/dc
  369.                 ; invalidate caches
  370.  
  371. DOCACHSET:
  372.     dc.w    $4E7B,$1002    movec    d1,cacr
  373.                 ; set the cache
  374.  
  375. DOCACHX:
  376.     movem.l    (a7)+,d0/a0/a3
  377.  
  378.     movem.l    (a7)+,d7
  379.  
  380.     move.l    $0,a7        ; reset supervisor stack
  381.  
  382.     move.l    $4,-(a7)     ; call first reset routine
  383.     rts
  384.  
  385. ; --------------------------------------------------------------
  386. RDKEYB5:
  387.  
  388. RDKEYBX:
  389.     movem.l    (a7)+,d0/a0/a3
  390.  
  391. ; -------------------------------------------------------------
  392. XINT_EXIt:
  393.  
  394. *     bra     XINT_TST
  395.     bra    XINT_OTHer
  396.  
  397. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  398. ;  Subroutine to read keyboard value from hardware
  399.  
  400. KEYread:
  401.     movem.l    d0-d3/a0/a3,-(a7)
  402.  
  403.     move.l    AV.KEYV,a3    ; address of keyboard vars
  404.  
  405.     lea    CIAA,a0        ; now implement Keyboard
  406.     moveq    #0,d0        ; handshake according to
  407.     move.b    d0,CRA(a0)    ; ROM listing ($FE5478)
  408.     move.b    d0,CRA(a0)
  409.     move.b    #$40,CRA(a0)    ; switch off keyboard
  410.  
  411.     move.b    CIAA_SP,d0    ; read raw key code
  412.  
  413.     move.l    #$40,d2
  414. WTKEYB0:
  415.     nop
  416.     dbra    d2,WTKEYB0
  417.  
  418.     move.b    #$0,CIAA_CRA    ; switch on keyboard again
  419.  
  420.     MOVE.L    #255,D1
  421.     SUB.B    D0,D1        ; calculate key stroke
  422.     LSR.B    #1,D1
  423.     AND.W    #1,D0        ; only press/release bit
  424.  
  425. ; --------------------------------------------------------------
  426. ; first convert to QL raw key code
  427.  
  428.     LEA    QLRAWKEY(PC),A0
  429.     MOVEQ    #0,D2
  430.     MOVE.B    0(A0,D1.W),D2    ; get row and bit number
  431.     bge.s    KEYrd2b        ; branch on valid key
  432.  
  433.     clr.w    KV.ACTKEy(a3)    ; otherwise, reset actual key
  434.  
  435.     lea    KV.STORAwkey(a3),a0
  436.     clr.l    (a0)+
  437.     clr.l    (a0)+        ; invalidate KEYROW bits
  438.     clr.l    (a0)+
  439.     clr.l    (a0)+
  440.  
  441.     clr.w    $90(a6)        ; disable key repeat
  442.     bra    KEYrdX1
  443.  
  444. KEYrd2b:
  445.     MOVE.L    D2,D3
  446.     LSR.L    #4,D3        ; extract row number -> D3
  447.     AND.W    #$7,D3
  448.     AND.B    #$07,D2        ; extract bit number -> D2
  449.     lea    KV.STORAwkey(a3),a0
  450.     BSET    D2,0(A0,D3.W)
  451.     CMP.B    #1,D0        ; press or release ?
  452.     BEQ.S    KEYCVASC
  453.     BCLR    D2,0(A0,D3.W)
  454.  
  455. ; --------------------------------------------------------------
  456. ; now convert to ASCII
  457.  
  458. KEYCVASC:
  459.     MOVE.W    #$FFFE,D2    ; mask for AND
  460.     CMP.B    #$60,D1        ; shift/alt/amiga ?
  461.     BLT.S    KEYrd2        ; ...nope
  462.     CMP.B    #$62,D1        ; Caps lock ?
  463.     BNE.S    KEYrd2a          ...nope
  464.     CMP.B    #1,D0        ; Caps on or off ?
  465.     SEQ    D0
  466.     lea    SV_CAPS(a6),A0    ; address $28088
  467.     MOVE.B    D0,(A0)        ; set CAPS flag
  468.     BRA    KEYrdX
  469.  
  470. KEYrd2a:
  471.     AND.B    #$7E,D1        ; Don't distinguish
  472.                 ; right/left
  473.     CMP.B    #$60,D1        ; Shift ?
  474.     BEQ.S    KEYrd1
  475.     LSL.W    #1,D0        ; Bit 0 for Shift, 1 for
  476.                 ; ctrl
  477.     ROL.W    #1,D2
  478.     CMP.B    #$62,D1        ; CTRL ?
  479.     BEQ.S    KEYrd1
  480.     LSL.W    #1,D0        ; Bit 2 for Alt, 3 for Amiga
  481.     ROL.W    #1,D2
  482.     CMP.B    #$64,D1        ; ALT ?
  483.     BEQ.S    KEYrd1
  484.     LSL.W    #1,D0
  485.     ROL.W    #1,D2
  486.     CMP.B    #$66,D1        ; AMIGA ?
  487.     bne    KEYrdX        ; should never happen!
  488. KEYrd1:
  489.     lea    KV.SHIFTflg(a3),a0 ; get address of flag
  490.     AND.B    D2,(A0)        ; clear old status bit
  491.     OR.B    D0,(A0)        ; and set new status
  492.     andi.w    #$0F00,(a0)    ; only keep modifiers
  493.  
  494.     clr.w    KV.ACTKEy(a3)    ; reset actual key
  495.  
  496.     BRA    KEYrdX
  497.  
  498. ; --------------------------------------------------------------
  499. ;  convert keycode (D1) and write result to ACTkey
  500.  
  501. KEYrd2:
  502.     CMP.B    #1,D0        ; press or just release ?
  503.     BEQ.S    KEYrd3
  504.     clr.w    KV.ACTKEy(a3)    ; reset actual key
  505.     bra    KEYrdX
  506. KEYrd3:
  507.     lea    KV.SHIFTflg(a3),a0
  508.     MOVE.B    (A0),D2        ; get current status of
  509.                 ; Shift
  510.     MOVE.B    D2,D0        ; store for ALT check
  511.     AND.B    #$3,D2        ; don't bother with Alt or
  512.                 ; Amiga
  513.     move.l    KV.QLASCtbl(a3),a0 ; first try no shifts
  514.     CMP.B    #0,D2
  515.     BEQ.S    KEYrd4
  516.  
  517.     lea    $60(a0),a0    ; next try Shift only
  518.     CMP.B    #1,D2
  519.     BEQ.S    KEYrd4
  520.  
  521.     lea    $60(a0),a0    ; now try ctrl only
  522.     CMP.B    #2,D2
  523.     BEQ.S    KEYrd4
  524.  
  525.     lea    $60(a0),a0    ; must be <Ctrl>+<Shift>
  526.  
  527. KEYrd4:
  528.     andi.b    #%01111111,d0    ; assume 'special'
  529.     cmp.b    #$40,d1
  530.     bge.s    KEYrd5        ; ...skip if so
  531.  
  532.     ori.b    #%10000000,d0    ; indicate a-z, 0-9
  533.  
  534. KEYrd5:
  535.     move.b    d0,KV.SHIFTflg(a3)
  536.  
  537.     MOVE.B    0(A0,D1.W),D1    ; get ASCII value
  538.     lea    SV_CAPS(a6),a0    ; address $28088
  539.     TST.B    (A0)        ; check for CAPS lock
  540.     BEQ.S    KEYrd6
  541.     CMP.B    #'a',D1        ; check for lower case
  542.                 ; letter
  543.     BLT.S    KEYrd6
  544.     CMP.B    #'z',D1
  545.     BGT.S    KEYrd6
  546.     SUB.B    #32,D1        ; change to upper case
  547.                 ; letter
  548. KEYrd6:
  549.     lea    KV.ACTKEy(a3),a0
  550.     MOVE.B    D1,(A0)        ; Store new key
  551.     BTST    #2,D0        ; ALT flag set ?
  552.     SNE    D0
  553.     MOVE.B    D0,1(A0)     ; store ALT flag
  554.     MOVE.W    (A0),D0        ; check for ALT and cursor
  555.                 ; key
  556.     AND.W    #$E0FF,D0    ; don't bother with
  557.                 ; up,right,left,down
  558.     CMP.W    #$C0FF,D0    ; check for cursor key
  559.     BNE.S    KEYrd7
  560.     ADD.B    #1,(A0)        ; now make correct key code
  561.     CLR.B    1(A0)        ; and clear ALT flag
  562.  
  563. KEYrd7:
  564.     move.w    KV.ACTKEy(a3),d0
  565.     cmpi.b    #$FF,d0        ; if part of ALT combination
  566.     beq.s    KEYrdX        ; exit now & let polled int
  567.                 ; put key into Q
  568.  
  569.     bsr    POLL_K        ; otherwise put into Q
  570.  
  571. KEYrdX:
  572.     MOVE.W    $8C(A6),$90(A6)    ; delay -> count
  573.  
  574. KEYrdX1:
  575.     movem.l    (a7)+,d0-d3/a0/a3
  576.     RTS
  577.  
  578. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  579. ;  Polled interrupt routine to read the keyboard
  580.  
  581. POLL_SERver:
  582.  
  583.     move.l    AV.KEYV,a3    ; address of keyboard vars
  584.  
  585.     move.w    JOY0DAT,d0    ; get counter
  586.     move.w    KV.STOMOuse(a3),d5
  587.     move.w    d0,KV.STOMOuse(a3); store for next time
  588.  
  589.     tst.b    KV.QIMIFLG(a3)
  590.     bne.s    POLL_a
  591.  
  592.     cmp.w    d5,d0
  593.     beq.s    POLL_K
  594.  
  595.     move.w    KV.PTRX(a3),d1
  596.     move.w    KV.PTRY(a3),d2
  597.     move.w    KV.PTRERRX(a3),d3
  598.     move.w    KV.PTRERRY(a3),d4
  599.  
  600.     bra.s    POLL_c
  601.  
  602. POLL_a:
  603.     MOVE.L    SV_CHBAS(A6),A4    ; Lese PTR
  604.     MOVE.L    (A4),A4        ; 'Con' Treiber
  605.     MOVE.L    4(A4),A4     ; nach A4
  606.  
  607.     move.w    $20(a4),d1    ; QIMI X
  608.     lsr.w    #1,d1
  609.     move.w    $22(a4),d2    ; QIMI Y
  610.  
  611.     moveq    #0,d3
  612.     moveq    #0,d4
  613.  
  614.     cmp.w    d5,d0
  615.     beq.s    POLL_e
  616.  
  617. POLL_c:
  618.     sub.b    d5,d0
  619.     move.b    d0,d6
  620.     ext.w    d6
  621.     add.w    d6,d1
  622.  
  623.     bsr    PTR_CLPX
  624.  
  625.     ror.w    #8,d0
  626.     ror.w    #8,d5
  627.  
  628.     sub.b    d5,d0
  629.     move.b    d0,d6
  630.     ext.w    d6
  631.     add.w    d6,d2
  632.  
  633.     bsr    PTR_CLPY
  634.  
  635.     tst.b    KV.QIMIFLG(a3)
  636.     beq.s    POLL_e
  637.  
  638.     lsl.w    #1,d1
  639.     move.w    d1,$20(a4)    ; QIMI X
  640.     move.w    d2,$22(a4)    ; QIMI Y
  641.     move.b    #0,$16(a4)    ; QIMI accumulator
  642.     lsr.w    #1,d1
  643.  
  644. POLL_e:
  645.     move.w    d1,KV.PTRX(a3)
  646.     move.w    d2,KV.PTRY(a3)
  647.  
  648.     move.w    d3,KV.PTRERRX(a3)
  649.     move.w    d4,KV.PTRERRY(a3)
  650.  
  651.     bsr    PTR_POS
  652.  
  653. POLL_K:
  654.     MOVEA.L    $4C(A6),A2    ; SV.KEYQ Pointer to a
  655.                 ; keyboard queue
  656.  
  657.     MOVE.L    A2,D0
  658.     beq.s    POLL_EXIt    ; no con_ open
  659.  
  660.     tst.b    (a2)
  661.     blt.s    POLL_EXIt    ; eof
  662.  
  663. POLL_3:
  664.     move.l    KV.SHIFTflg(a3),d1 ; read Shift flags and
  665.                  ; ACTkey
  666.  
  667.     ROR.W    #8,D1        ; rotate ascii in position
  668.     cmp.b    #0,d1        ; any key pressed ?
  669.     bne.s    L02EEC        ; yup!
  670.  
  671. NOKEY:
  672.     CLR.W    $8A(A6)        ; reset Autorepeat buffer
  673.  
  674. POLL_EXIt:
  675.     rts
  676.  
  677. ; --------------------------------------------------------------
  678. L02EEC:
  679.     CMP.L    #(%00000010<<24)|$0020,D1 ; <CTL><SPC> ?
  680.     BEQ    DO_BREAK
  681.  
  682.     CMPI.W    #$00F9,D1    ; = <CTL><F5> freeze
  683.     BEQ    FREEZE
  684.  
  685.     SF    $33(A6)        ; screen status
  686.     CMP.W    $92(A6),D1    ; SV.CQCH Keyboard change
  687.     BEQ    CTRL_C        ; queue character code
  688.  
  689.     CMP.W    $8A(A6),D1    ; New Key ?
  690.     BEQ.S    AREPOLD
  691.  
  692.     MOVE.W    D1,$8A(A6)    ; store Key
  693.     MOVE.W    $8C(A6),$90(A6)    ; delay -> count
  694.     BRA.S    AREPDO
  695.  
  696. ; --------------------------------------------------------------
  697. AREPOLD:
  698.     cmp.w    #1,SV_POLLM(a6)    ; no key repeat if part of
  699.     bgt    POLL_EXIt    ; a 'poll miss' time-slice
  700.  
  701.     MOVE.W    $90(A6),D2    ; get actual count
  702.     tst.w    d2
  703.     beq.s    POLL_EXIt    ; exit if key-repeat disabled
  704.  
  705.     SUBQ.W    #1,D2        ; decrement count
  706.     MOVE.W    D2,$90(A6)    ; and store new value
  707.     TST.W    D2        ; 0 reached ?
  708.     bne    POLL_EXIt    ; do nothing if not
  709.  
  710.     MOVE.W    $8E(A6),$90(A6)    ; SV.ARFRQ Autorepeat
  711.                 ; 1/frequency
  712.  
  713.     move.l    d1,d3        ; save key-stroke
  714.     move.w    IO.QTEST,a3
  715.     jsr    (a3)
  716.     beq    POLL_EXIt    ; exit if queue not empty
  717.  
  718.     move.l    d3,d1        ; restore key-stroke
  719.  
  720. ; --------------------------------------------------------------
  721. AREPDO:
  722.     cmpi.w    #$FF0A,d1    ; <ALT>-<RTN>
  723.     beq.s    DO_HISTORY
  724.  
  725.     cmpi.l    #(%00000010<<24)|$0009,d1 ; <CTL>-<TAB>
  726.     beq.s    DO_FLIP
  727.  
  728.     ror.w    #8,d1
  729.  
  730.     CMPI.B    #$FF,D1        ; <ALT> key ?
  731.     BNE.S    L02F36
  732.  
  733.     SWAP    D1
  734.     move.w    IO.QTEST,a3
  735.     jsr    (a3)
  736.  
  737.     CMPI.W    #2,D2
  738.     BLT    POLL_EXIt
  739.  
  740.     SWAP    D1
  741.     move.w    IO.QIN,a3    ; put a byte (D1) into a
  742.     jsr    (a3)        ; queue (A2)
  743.  
  744. L02F36:
  745.     LSR.W    #8,D1
  746.     move.w    IO.QIN,a3    ; put a byte (D1) into a
  747.     jsr    (a3)        ; queue (A2)
  748.  
  749.     bra    POLL_EXIt
  750.  
  751. ; --------------------------------------------------------------
  752. DO_HISTORY:
  753.  
  754.     move.l    Q_NEXTIN(a2),a3
  755.     cmp.l    Q_NXTOUT(a2),a3
  756.     bne    POLL_EXIt
  757.  
  758.     lea    $10(a2),a4
  759.  
  760. DO_HLUP1:
  761.     cmp.l    a4,a3
  762.     bne.s    DO_HIS1
  763.  
  764.     move.l    Q_END(a2),a3
  765.  
  766. DO_HIS1:
  767.     cmp.b    #$0A,-(a3)
  768.     beq.s    DO_HIS2
  769.  
  770.     cmp.l    Q_NXTOUT(a2),a3
  771.     bne.s    DO_HLUP1
  772.  
  773.     bra    POLL_EXIt
  774.  
  775. DO_HIS2:
  776.     move.l    a3,Q_NEXTIN(a2)
  777.     move.l    a3,Q_NXTOUT(a2)
  778.  
  779. DO_HLUP2:
  780.     cmp.l    a4,a3
  781.     bne.s    DO_HIS3
  782.  
  783.     move.l    Q_END(a2),a3
  784.  
  785. DO_HIS3:
  786.     cmp.b    #$0A,-(a3)
  787.     bne.s    DO_HLUP2
  788.  
  789. DO_HIS4:
  790.     addq.l    #1,a3
  791.     cmpa.l    Q_END(a2),a3
  792.     blt.s    DO_HIS5
  793.  
  794.     lea    $10(a2),a3
  795.  
  796. DO_HIS5:
  797.     move.l    a3,Q_NXTOUT(a2)
  798.  
  799.     bra    POLL_EXIt
  800.  
  801. ; --------------------------------------------------------------
  802. DO_FLIP:
  803.     bsr    FLIPIT
  804.     bra    POLL_EXIt
  805.  
  806. FLIPIT:
  807.     moveq    #0,d0
  808.     move.b    SV_MCSTA(a6),d0
  809.  
  810.     swap    d1
  811.     lsl.w    #4,d0
  812.     move.b    d0,d1
  813.     andi.b    #%10100000,d1
  814.     lsr.b    #2,d1
  815.     andi.b    #%01010000,d0
  816.     or.b    d1,d0
  817.     lsl.b    #1,d0
  818.     lsr.w    #4,d0
  819.     swap    d1
  820.  
  821.     eori.b    #1<<MC..SCRN,d0    ; flip between screen 1/2
  822.     move.b    d0,SV_MCSTA(a6)
  823.     andi.b    #%10001010,d0
  824.     move.b    d0,MC_STAT    ; switch screen if necessary
  825.  
  826.     rts
  827.  
  828. ; --------------------------------------------------------------
  829. DO_BREAK:
  830.     CLR.W    KV.ACTKEy(A3)    ; reset BREAK request
  831.     SF    $33(A6)        ; screen status
  832.  
  833.     MOVEA.L    $68(A6),A3    ; SV.JBBAS Pointer to base of
  834.                 ; job table
  835.     MOVEA.L    (A3),A3
  836.     SF    $F7(A3)
  837.     MOVE.W    $14(A3),D0    ; job status (BASIC)
  838.     BEQ.S    L02EEA        ; not suspended
  839.     MOVE.B    $13(A3),D0    ; priority of BASIC
  840.     BNE.S    BRECON1
  841.     MOVE.B    #$20,$13(A3)    ; set priority to 32 if it
  842.                 ; was set to 0
  843. BRECON1:
  844.     CLR.W    $14(A3)        ; release job
  845.     MOVE.L    $0C(A3),D0    ; pointer to byte which will
  846.                 ; be cleared when job relea
  847.     BEQ.S    L02EEA
  848.     MOVEA.L    D0,A3        ; clear this byte
  849.     SF    (A3)
  850.  
  851. L02EEA:
  852.     bra    POLL_EXIt
  853.  
  854. ; --------------------------------------------------------------
  855. FREEZE:
  856.     CLR.W    KV.ACTKEy(A3)    ; reset FREEZE request
  857.     NOT.B    $33(A6)        ; Screen status
  858.  
  859.     bra    POLL_EXIt
  860.  
  861. ; --------------------------------------------------------------
  862. CTRL_C:
  863.     CLR.W    KV.ACTKEy(A3)    ; reset CTRL_C request
  864.  
  865. SWITCHQ:
  866.     bsr    FNDCHN        ; find channel base/ID
  867.  
  868.     TST.B    SD_CURF(A1)    ; queue waiting ?
  869.     BGE.S    L02F54        ; cursor active
  870.  
  871.     BSR    SD_CURE        ; reactivate cursor
  872.  
  873. L02F54:
  874.     MOVEA.L    (A2),A2        ; next queue
  875.  
  876.     bsr    FNDCHN        ; find channel base/ID
  877.  
  878.     TST.B    SD_CURF(A1)    ; next queue active ?
  879.     BNE.S    CTRLC0        ; yup, continue
  880.  
  881.     CMPA.L    SV_KEYQ(A6),A2    ; Current key Q
  882.     BNE.S    L02F54        ; next Q <> this Q
  883.  
  884. CTRLC0:
  885.     move.b    SV_MCSTA(a6),d0
  886.  
  887.     cmp.l    #$20000,SD_SCRB(a1)
  888.     bne.s    CTRLC1
  889.  
  890.     andi.b    #$FF-(1<<MC..SCRN),d0
  891.     bra.s    CTRLC2
  892.  
  893. CTRLC1:
  894.     cmp.l    #$28000,SD_SCRB(a1)
  895.     bne.s    CTRLC3
  896.  
  897.     ori.b    #1<<MC..SCRN,d0
  898.  
  899. CTRLC2:
  900.     cmp.b    SV_MCSTA(a6),d0
  901.     beq.s    CTRLC3
  902.  
  903.     bsr    FLIPIT        ; switch screen if necessary
  904.  
  905. CTRLC3:
  906.     MOVE.L    A2,SV_KEYQ(A6)    ; set current keyboard queue
  907.     CLR.W    $AA(A6)        ; flashing cursor status
  908.                 ; (word)
  909.     MOVEQ    #6,D6
  910.  
  911.     bra    POLL_EXIt
  912.  
  913. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  914. SD_CURE:
  915. ;     movem.l  d0-d1/d3/a0-a2,-(a7)
  916.  
  917. ;     move.l     a1,a0
  918. ;     jsr     $1B86
  919.  
  920. ;     movem.l  (a7)+,d0-d1/d3/a0-a2
  921. ;     rts
  922.  
  923. ;     movem.l  d0-d1/d3/a1-a2,-(a7)
  924.  
  925. ;     moveq     #-1,d3
  926. ;     moveq     #SD.CURE,d0
  927. ;     trap     #3
  928.  
  929. ;     movem.l  (a7)+,d0-d1/d3/a1-a2
  930.     rts
  931.  
  932. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  933. ; Entry: A2 = pointer to keyboard queue
  934.  
  935. ; Exit:    A0 = Channel ID
  936. ;    A1 = Channel base
  937.  
  938. FNDCHN:
  939.     movem.l    d0-d1/a3-a4,-(a7)
  940.  
  941.     move.l    SV_CHBAS(a6),a0
  942.     move.l    SV_CHTOP(a6),a4
  943.     moveq    #0,d0
  944.  
  945. FNDLUP:
  946.     move.l    (a0),a1        ; channel vars?
  947.     cmpa.l    a1,a2
  948.     blt.s    FNDCNT
  949.  
  950.     move.l    (a1),d1
  951.     lea    0(a1,d1.w),a3
  952.     cmpa.l    a3,a2
  953.     blt.s    FNDDUN
  954.  
  955. FNDCNT:
  956.     addq.w    #1,d0
  957.     addq.l    #4,a0
  958.     cmp.l    a0,a4
  959.     bgt.s    FNDLUP
  960.  
  961.     suba.l    a1,a1
  962.     moveq    #0,d0
  963.     bra.s    FNDXIT        ; not found!
  964.  
  965. FNDDUN:
  966.     swap    d0
  967.     move.w    CH_TAG(a1),d0
  968.     swap    d0
  969.  
  970. FNDXIT:
  971.     move.l    d0,a0        ; channel ID
  972.  
  973.     movem.l    (a7)+,d0-d1/a3-a4
  974.  
  975.     rts
  976.  
  977. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  978. ;  Custom LVL7 routine to initialise hardware
  979.  
  980. MY_LVL7:
  981.     bsr    INIT_HW
  982.  
  983.     subq.l    #4,a7
  984.     movem.l    a3,-(a7)
  985.     move.l    AV.KEYV,a3
  986.     move.l    KV.LVL7link(a3),a3
  987.     move.l    4(a3),4(a7)    ; address of next routine
  988.     movem.l    (a7)+,a3
  989.  
  990.     rts
  991.  
  992. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  993. ;  A patch to replace TRAP#1 calls to: MT_IPCOM (d0=$11)
  994. ;  and to add the new routine MT_ASC (d0=$27)
  995.  
  996. MY_TRP1:
  997.     bsr    INI_A5A6
  998.  
  999.     cmp.b    #$11,d0
  1000.     beq    MT_IPCOM
  1001.  
  1002.     cmp.b    #$27,d0
  1003.     beq    MT_ASC
  1004.  
  1005. MY_TRP1X:
  1006.     movem.l    (a7)+,d7/a5/a6    ; restore registers
  1007.  
  1008.     subq.l    #4,a7
  1009.     movem.l    a3,-(a7)
  1010.     move.l    AV.KEYV,a3
  1011.     move.l    KV.TRP1link(a3),a3
  1012.     move.l    4(a3),4(a7)    ; address of next routine
  1013.     movem.l    (a7)+,a3
  1014.  
  1015.     rts
  1016.  
  1017. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1018. ; initialise A5 and A6 prior to performing a TRAP routine
  1019.  
  1020. INI_A5A6
  1021.     SUBQ.L    #8,A7
  1022.     MOVE.L    8(A7),-(A7)
  1023.     MOVEM.L    D7/A5/A6,4(A7)
  1024.  
  1025.     move.l    a7,d7
  1026.     andi.l    #$FFFF8000,d7
  1027.     move.l    d7,a6        ; Calc address of sys vars
  1028.  
  1029.     LEA    4(A7),A5     ; A5 points to saved
  1030.                 ; Registers D7,A5,A6
  1031.     MOVEQ    #$7F,D7
  1032.     AND.L    D7,D0
  1033.     RTS
  1034.  
  1035. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1036. ;  TRAP #1 with D0=$11
  1037.  
  1038. MT_IPCOM:
  1039.     cmp.b    #9,(a3)        ; is IPC command keyrow ?
  1040.     bne    MY_TRP1X
  1041.  
  1042.     MOVEM.L    D4/D6-D7/A0-A1/A3,-(A7)
  1043.  
  1044.     MOVE.B    6(A3),D7     ; get row number
  1045.     AND.W    #$7,D7        ; only 0..7 are valid
  1046.     BSR    KEYROW
  1047.     CMP.B    #1,D7        ; row 1 ? (contains arrows,
  1048.                 ; space and enter)
  1049.     bne    IPCOM_EX
  1050.     TST.B    D1        ; any key pressed ?
  1051.     beq    IPCOM_MO     ; no
  1052.  
  1053.     move.b    d1,d0
  1054.     andi.b    #$96,d0
  1055.     beq    IPCOM_EX
  1056.  
  1057.     movem.l    d1-d6/a3,-(a7)
  1058.  
  1059.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1060.  
  1061.     move.w    KV.PTRX(a3),d1
  1062.     move.w    KV.PTRY(a3),d2
  1063.  
  1064.     tst.b    KV.QIMIFLG(a3)
  1065.     bne    IPCOM_X
  1066.  
  1067.     move.w    KV.PTROLDX(a3),d5
  1068.     move.w    KV.PTROLDY(a3),d6
  1069.  
  1070.     btst.b    #4,d0
  1071.     beq.s    IPCOM_1
  1072.     add.w    KV.PTRINCX(a3),d1
  1073.     add.w    KV.PTRINCX(a3),d5
  1074.  
  1075. IPCOM_1:
  1076.     btst.b    #1,d0
  1077.     beq.s    IPCOM_2
  1078.     sub.w    KV.PTRINCX(a3),d1
  1079.     sub.w    KV.PTRINCX(a3),d5
  1080.  
  1081. IPCOM_2:
  1082.     btst.b    #7,d0
  1083.     beq.s    IPCOM_3
  1084.     add.w    KV.PTRINCY(a3),d2
  1085.     add.w    KV.PTRINCY(a3),d6
  1086.  
  1087. IPCOM_3:
  1088.     btst.b    #2,d0
  1089.     beq.s    IPCOM_4
  1090.     sub.w    KV.PTRINCY(a3),d2
  1091.     sub.w    KV.PTRINCY(a3),d6
  1092.  
  1093. IPCOM_4:
  1094.     bsr    PTR_CLPX
  1095.     bsr    PTR_CLPY
  1096.  
  1097.     move.w    d1,KV.PTRX(a3)
  1098.     move.w    d2,KV.PTRY(a3)
  1099.  
  1100. ;     bsr     PTR_POS
  1101.  
  1102.     move.w    d5,d1
  1103.     move.w    d6,d2
  1104.  
  1105.     bsr    PTR_CLPX
  1106.     bsr    PTR_CLPY
  1107.  
  1108. IPCOM_X:
  1109.     move.w    d1,KV.PTROLDX(a3)
  1110.     move.w    d2,KV.PTROLDY(a3)
  1111.  
  1112.     movem.l    (a7)+,d1-d6/a3
  1113.  
  1114.     bra.s    IPCOM_EX
  1115.  
  1116. IPCOM_MO:
  1117.     BSR    MOUSE
  1118.  
  1119. IPCOM_EX:
  1120.     MOVEM.L    (A7)+,D4/D6-D7/A0-A1/A3
  1121.     moveq    #0,d0
  1122.     bra    TRAP1_X
  1123.  
  1124. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1125. ;  KEYROW emulation (row number in D7, -> Columns in D1)
  1126.  
  1127. KEYROW:
  1128.     MOVEM.L    A0,-(A7)
  1129.  
  1130.     move.l    AV.KEYV,a0    ; address of keyboard vars
  1131.     lea    KV.STORAwkey(a0),a0
  1132.     AND.W    #$0F,D7
  1133.     MOVE.B    0(A0,D7.W),D1
  1134.  
  1135.     MOVEM.L    (A7)+,A0
  1136.     RTS
  1137.  
  1138. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1139. ; read mouse port and generate corresponding keydepression -> D1
  1140.  
  1141. MOUSE:
  1142.     MOVEM.L    D0/D2-D5/A0,-(A7)
  1143.  
  1144.     move.l    AV.KEYV,a0    ; address of keyboard vars
  1145.  
  1146.     clr.b    d1        ; preset 'no key'
  1147.  
  1148. ; --------------------------------------------------------------
  1149.     tst.b    KV.QIMIFLG(a0)
  1150.     bne    MOUSBUTS
  1151.  
  1152.     moveq    #0,d5
  1153.     move.w    KV.PTRINCX(a0),d5
  1154.  
  1155.     move.w    KV.PTRX(a0),d0
  1156.     sub.w    KV.PTRMINX(a0),d0
  1157.     add.w    KV.PTRERRX(a0),d0
  1158.     ext.l    d0
  1159.     bmi.s    MOUS1
  1160.  
  1161.     divu    d5,d0
  1162.     bra.s    MOUS2
  1163.  
  1164. MOUS1:
  1165.     neg.w    d0
  1166.     divu    d5,d0
  1167.     addq.w    #1,d0
  1168.     neg.w    d0
  1169.  
  1170. MOUS2:
  1171.     move.w    KV.PTROLDX(a0),d4
  1172.     sub.w    KV.PTRMINX(a0),d4
  1173.     ext.l    d4
  1174.     divu    d5,d4
  1175.  
  1176.     cmp.w    d4,d0        ; more or less ?
  1177.  
  1178.     bmi.s    MOUS3
  1179.     beq.s    MOUS4
  1180.  
  1181.     ori.b    #$10,d1        ; right
  1182.     addq.w    #1,d4
  1183.     bra.s    MOUS4
  1184.  
  1185. MOUS3:
  1186.     ori.b    #$02,d1        ; left
  1187.     subq.w    #1,d4
  1188.  
  1189. MOUS4:
  1190.     mulu    d5,d4
  1191.     add.w    KV.PTRMINX(a0),d4
  1192.     move.w    d4,KV.PTROLDX(a0)
  1193.  
  1194. ; --------------------------------------------------------------
  1195.     moveq    #0,d6
  1196.     move.w    KV.PTRINCY(a0),d6
  1197.  
  1198.     move.w    KV.PTRY(a0),d0
  1199.     sub.w    KV.PTRMINY(a0),d0
  1200.     add.w    KV.PTRERRY(a0),d0
  1201.     ext.l    d0
  1202.     bmi.s    MOUS5
  1203.  
  1204.     divu    d6,d0
  1205.     bra.s    MOUS6
  1206.  
  1207. MOUS5:
  1208.     neg.w    d0
  1209.     divu    d6,d0
  1210.     addq.w    #1,d0
  1211.     neg.w    d0
  1212.  
  1213. MOUS6:
  1214.     move.w    KV.PTROLDY(a0),d4
  1215.     sub.w    KV.PTRMINY(a0),d4
  1216.     ext.l    d4
  1217.     divu    d6,d4
  1218.  
  1219.     cmp.w    d4,d0        ; more or less ?
  1220.  
  1221.     bmi.s    MOUS7
  1222.     beq.s    MOUS8
  1223.  
  1224.     ori.b    #$80,d1        ; down
  1225.     addq.w    #1,d4
  1226.     bra.s    MOUS8
  1227.  
  1228. MOUS7:
  1229.     ori.b    #$04,d1        ; up
  1230.     subq.w    #1,d4
  1231.  
  1232. MOUS8:
  1233.     mulu    d6,d4
  1234.     add.w    KV.PTRMINY(a0),d4
  1235.     move.w    d4,KV.PTROLDY(a0)
  1236.  
  1237. ; --------------------------------------------------------------
  1238.     movem.l    d1/d3-d4,-(a7)
  1239.  
  1240.     move.w    KV.PTROLDX(a0),d1
  1241.     move.w    KV.PTROLDY(a0),d2
  1242.     move.w    #0,d3
  1243.     move.w    #0,d4
  1244.     bsr    PTR_CLPX
  1245.     bsr    PTR_CLPY
  1246.  
  1247.     sub.w    KV.PTRMINX(a0),d1
  1248.     ext.l    d1
  1249.     divu    d5,d1
  1250.     mulu    d5,d1
  1251.     add.w    KV.PTRMINX(a0),d1
  1252.  
  1253.     sub.w    KV.PTRMINY(a0),d2
  1254.     ext.l    d2
  1255.     divu    d6,d2
  1256.     mulu    d6,d2
  1257.     add.w    KV.PTRMINY(a0),d2
  1258.  
  1259.     move.w    KV.PTROLDX(a0),d3
  1260.     move.w    KV.PTROLDY(a0),d4
  1261.     sub.w    d1,d3
  1262.     sub.w    d2,d4
  1263.     move.w    d1,KV.PTROLDX(a0)
  1264.     move.w    d2,KV.PTROLDY(a0)
  1265.     sub.w    d3,KV.PTRERRX(a0)
  1266.     sub.w    d4,KV.PTRERRY(a0)
  1267.  
  1268.     movem.l    (a7)+,d1/d3-d4
  1269.  
  1270. ; --------------------------------------------------------------
  1271. MOUSBUTS:
  1272.     BTST    #6,CIAA_PRA    ; left mouse button
  1273.     BNE.S    MOUS9
  1274.     BSET    #6,D1        ; set  space
  1275. MOUS9:
  1276.     MOVE.W    POTGOR,D0
  1277.     AND.W    #$0400,D0    ; right mouse button
  1278.     BNE.S    MOUS10
  1279.     BSET    #0,D1        ; set enter
  1280.  
  1281. MOUS10:
  1282.     MOVEM.L    (A7)+,D0/D2-D5/A0
  1283.     RTS
  1284.  
  1285. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1286. ; Here  we start with the rawkey conversion table
  1287. ; which    is used for the KEYROW function.
  1288. ; The organization is Rownumber,Bitnumber in order
  1289. ; of the Amiga rawkeys
  1290.  
  1291. QLRAWKEY:
  1292.     DC.B    $27,$43,$61,$41,$06,$02,$62,$07
  1293.     DC.B    $60,$50,$65,$55,$35,$15,$FF,$65
  1294.     DC.B    $63,$51,$64,$54,$66,$21,$67,$52
  1295.     DC.B    $57,$45,$30,$20,$FF,$43,$61,$41
  1296.     DC.B    $44,$33,$46,$34,$36,$42,$47,$32
  1297.     DC.B    $40,$37,$27,$10,$FF,$06,$02,$62
  1298.     DC.B    $22,$56,$73,$23,$74,$24,$76,$26
  1299.     DC.B    $76,$22,$75,$FF,$FF,$07,$60,$50
  1300.     DC.B    $16,$11,$53,$10,$10,$13,$11,$FF
  1301.     DC.B    $FF,$FF,$55,$FF,$12,$17,$14,$11
  1302.     DC.B    $01,$03,$04,$00,$05,$01,$03,$04
  1303.     DC.B    $FF,$05,$30,$20,$75,$60,$35,$01
  1304.     DC.B    $70,$70,$31,$71,$72,$72,$71,$71
  1305.     DC.B    $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
  1306.     DC.B    $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
  1307.     DC.B    $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
  1308.  
  1309. QLRAWEND:
  1310.  
  1311. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1312. ;  TRAP #1 with D0=$27 (New to QDOS 3.10 on Amiga)
  1313. ;  D1=address of new QLASCII table
  1314. ;  this is the recommended way to implement foreign
  1315. ;  Language keybords tables!
  1316.  
  1317. MT_ASC:
  1318.     movem.l    a3,-(a7)
  1319.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1320.     move.l    d1,KV.QLASCtbl(a3)
  1321.     movem.l    (a7)+,a3
  1322.  
  1323.     moveq    #0,d0
  1324.  
  1325. ; --------------------------------------------------------------
  1326. ;  exit from TRAP call
  1327.  
  1328. TRAP1_X    movem.l    (a7)+,d7/a5/a6    ; exit from exception
  1329.     rte
  1330.  
  1331. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1332. ; conversion table for translating rawkeycode to ASCII code (QL)
  1333. ; 1) subtract raw key code from 255 (255-(CIAA_SP))
  1334. ; 2) Shift right the result by 1
  1335. ; 3) take QLASCII for no shift mode, QLASC_SH for <Shift>,
  1336. ;    QLASC_CT for <Ctrl>, QLASC_SC for <Shift>+<Ctrl>
  1337. ; 4) read related ASCII code (QL) from table at this offset
  1338.  
  1339. QLASCII:
  1340.  DC.B '`','1','2','3','4','5','6','7','8','9','0',156,39,'\',0,'0'
  1341.  DC.B 'q','w','e','r','t','z','u','i','o','p',135,'+',0,'1','2','3'
  1342.  DC.B 'a','s','d','f','g','h','j','k','l',132,128,'#',0,'4','5','6'
  1343.  DC.B '<','y','x','c','v','b','n','m',44,'.','-',0,0,'7','8','9'
  1344.  DC.B ' ',194,9,10,10,27,202,0,0,0,'-',0,208,216,200,192
  1345.  DC.B 232,236,240,244,248,234,238,242,246,250,91,93,'/','*','+',0
  1346.  
  1347. QLASC_SH:
  1348.  DC.B '~','!','"',182,'$','%','&','/','(',')','=','?','^','|',0,'0'
  1349.  DC.B 'Q','W','E','R','T','Z','U','I','O','P',167,'*',0,'1','2','3'
  1350.  DC.B 'A','S','D','F','G','H','J','K','L',164,160,'^',0,'4','5','6'
  1351.  DC.B '>','Y','X','C','V','B','N','M',';',':','_',0,0,'7','8','9'
  1352.  DC.B 252,194,253,254,254,127,202,0,0,0,'-',0,212,220,204,196
  1353.  DC.B 234,238,242,246,250,232,236,240,244,248,'{','}','/','*','+',0
  1354.  
  1355. QLASC_CT:
  1356.  DC.B 0,145,146,147,148,149,150,151,152,153,144,0,0,188,0,'0'
  1357.  DC.B 17,23,5,18,20,26,21,9,15,16,0,0,0,'1','2','3'
  1358.  DC.B 1,19,4,6,7,8,10,11,12,0,0,0,0,'4','5','6'
  1359.  DC.B 0,25,24,3,22,2,14,13,140,142,141,0,0,'7','8','9'
  1360.  DC.B ' ',194,9,10,10,128,202,0,0,0,'-',0,210,218,202,194
  1361.  DC.B 233,237,241,245,249,235,239,243,247,251,91,93,'/','*','+',0
  1362.  
  1363. QLASC_SC:
  1364.  DC.B '`',129,160,131,132,133,0,0,138,136,137,0,0,28,0,'0'
  1365.  DC.B 177,183,165,178,180,186,181,169,175,176,0,0,0,'1','2','3'
  1366.  DC.B 161,179,164,166,167,168,170,171,172,0,0,0,0,'4','5','6'
  1367.  DC.B 0,185,184,163,182,162,174,173,156,158,0,0,0,'7','8','9'
  1368.  DC.B ' ',194,9,10,10,27,202,0,0,0,'-',0,214,222,206,198
  1369.  DC.B 235,239,243,247,251,233,237,241,245,249,91,93,'/','*','+',0
  1370.  
  1371. QLASCEND:
  1372.  
  1373. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1374. ;  BASIC extensions specific to AMIGA QDOS
  1375.  
  1376. PROC_DEF:
  1377.     dc.w    9
  1378.     dc.w    B_KEYDT-*
  1379.     dc.b    5,'KEYDT'
  1380.     dc.w    B_PTR_POS-*
  1381.     dc.b    7,'PTR_POS'
  1382.     dc.w    B_PTR_INC-*
  1383.     dc.b    7,'PTR_INC'
  1384.     dc.w    B_PTR_LIMITS-*
  1385.     dc.b    10,'PTR_LIMITS',0
  1386.     dc.w    B_QIMI_MOUSE-*
  1387.     dc.b    10,'QIMI_MOUSE',0
  1388.     dc.w    B_CURSOR_MOUSE-*
  1389.     dc.b    12,'CURSOR_MOUSE',0
  1390.     dc.w    0
  1391.  
  1392.     dc.w    2
  1393.     dc.w    B_PTR_X-*
  1394.     dc.b    6,'PTR_X%',0
  1395.     dc.w    B_PTR_Y-*
  1396.     dc.b    6,'PTR_Y%',0
  1397.  
  1398.     dc.w    0
  1399.  
  1400. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1401. ;  BASIC proc to link in German keymap again, should it become
  1402. ;  dislocated for some reason.
  1403.  
  1404. B_KEYDT:
  1405.     lea    QLASCII(pc),a0    ; address of keyboard table
  1406.     move.l    a0,d1        ; in d1
  1407.     moveq    #$27,d0        ; MT_ASC (Amiga-QDOS 3.10
  1408.     trap    #1        ; and later, only)
  1409.     rts
  1410.  
  1411. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1412. B_QIMI_MOUSE:
  1413.     SUBA.L    A0,A0
  1414.     MOVEQ    #-1,D3
  1415.     MOVEQ    #$70,D0        ;PT_INFO
  1416.     TRAP    #3
  1417.     TST.B    D0
  1418.     BEQ.S    B_QIMI_START
  1419.     LEA.L    NO_PTR(pc),A1
  1420.     MOVE.W    UT.MTEXT,A2
  1421.     JMP    (A2)
  1422.  
  1423. NO_PTR    DC.W    30
  1424.     DC.B    'Pointer Interface not present',10
  1425.  
  1426. B_QIMI_START:
  1427.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1428.     st    KV.QIMIFLG(a3)
  1429.  
  1430.     move.w    #0,KV.PTRMINX(a3) ; reset PTR limits
  1431.     move.w    #0,KV.PTRMINY(a3)
  1432.     move.w    #255,KV.PTRMAXX(a3)
  1433.     move.w    #255,KV.PTRMAXY(a3)
  1434.  
  1435.     moveq    #0,d0
  1436.     rts
  1437.  
  1438. B_CURSOR_MOUSE:
  1439.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1440.     sf    KV.QIMIFLG(a3)
  1441.     moveq    #0,d0
  1442.     rts
  1443.  
  1444. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1445. B_PTR_LIMITS:
  1446.     moveq    #0,d2
  1447.     moveq    #0,d3
  1448.     move.w    #255,d4
  1449.     move.w    #255,d5
  1450.     cmp.l    a3,a5
  1451.     beq.s    PTR_LIMITS
  1452.  
  1453.     bsr    FETCH_W
  1454.     bne    B_PTRLIMX
  1455.  
  1456.     cmp.w    #0,d1
  1457.     blt    RPRT_BP
  1458.  
  1459.     move.w    d1,d2        ; min X
  1460.  
  1461.     bsr    FETCH_W
  1462.     bne    B_PTRLIMX
  1463.  
  1464.     cmp.w    #0,d1
  1465.     blt    RPRT_BP
  1466.  
  1467.     move.w    d1,d3        ; min Y
  1468.  
  1469.     bsr    FETCH_W
  1470.     bne    B_PTRLIMX
  1471.  
  1472.     cmp.w    #255,d1
  1473.     bgt    RPRT_BP
  1474.  
  1475.     move.w    d1,d4        ; max X
  1476.  
  1477.     bsr    FETCH_W
  1478.     bne    B_PTRLIMX
  1479.  
  1480.     cmp.w    #255,d1
  1481.     bgt    RPRT_BP
  1482.  
  1483.     move.w    d1,d5        ; max Y
  1484.  
  1485.     cmp.l    a3,a5
  1486.     bne    RPRT_BP
  1487.  
  1488. PTR_LIMITS:
  1489.     cmp.w    d2,d4
  1490.     ble    RPRT_BP
  1491.  
  1492.     cmp.w    d3,d5
  1493.     ble    RPRT_BP
  1494.  
  1495.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1496.  
  1497.     move.w    d2,KV.PTRMINX(a3)
  1498.     move.w    d3,KV.PTRMINY(a3)
  1499.     move.w    d4,KV.PTRMAXX(a3)
  1500.     move.w    d5,KV.PTRMAXY(a3)
  1501.  
  1502.     sub.w    d2,d4
  1503.     addq.w    #1,d4
  1504.     lsr.w    #1,d4
  1505.  
  1506.     move.w    KV.PTRINCX(a3),d0
  1507.     cmp.w    d4,d0
  1508.     ble.s    B_PTRLIM1
  1509.  
  1510.     move.w    d4,KV.PTRINCX(a3)
  1511.  
  1512. B_PTRLIM1:
  1513.     sub.w    d3,d5
  1514.     addq.w    #1,d5
  1515.     lsr.w    #1,d5
  1516.  
  1517.     move.w    KV.PTRINCY(a3),d0
  1518.     cmp.w    d5,d0
  1519.     ble.s    B_PTRLIM2
  1520.  
  1521.     move.w    d4,KV.PTRINCY(a3)
  1522.  
  1523. B_PTRLIM2:
  1524.     move.w    KV.PTRX(a3),d1
  1525.     move.w    KV.PTRY(a3),d2
  1526.  
  1527.     bsr    PTR_CLPX
  1528.     bsr    PTR_CLPY
  1529.  
  1530.     move.w    d1,KV.PTRX(a3)
  1531.     move.w    d2,KV.PTRY(a3)
  1532.  
  1533.     bsr    PTR_POS
  1534.  
  1535.     move.w    d1,KV.PTROLDX(a3)
  1536.     move.w    d2,KV.PTROLDY(a3)
  1537.  
  1538.     move.w    #0,KV.PTRERRX(a3)
  1539.     move.w    #0,KV.PTRERRY(a3)
  1540.  
  1541.     moveq    #0,d0
  1542.  
  1543. B_PTRLIMX:
  1544.     rts
  1545.  
  1546. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1547. B_PTR_POS:
  1548.     moveq    #0,d1
  1549.     moveq    #0,d2
  1550.     cmp.l    a3,a5
  1551.     beq.s    B_PTR_POS1
  1552.  
  1553.     bsr    FETCH_W
  1554.     bne.s    B_PTR_POSX
  1555.  
  1556.     move.w    d1,d2
  1557.  
  1558.     bsr    FETCH_W
  1559.     bne.s    B_PTR_POSX
  1560.  
  1561.     cmp.l    a3,a5
  1562.     bne    RPRT_BP
  1563.  
  1564.     exg    d1,d2
  1565.  
  1566. B_PTR_POS1:
  1567.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1568.  
  1569.     bsr    PTR_CLPX
  1570.     bsr    PTR_CLPY
  1571.  
  1572.     move.w    d1,KV.PTRX(a3)
  1573.     move.w    d2,KV.PTRY(a3)
  1574.  
  1575.     bsr    PTR_POS
  1576.  
  1577.     move.w    d1,KV.PTROLDX(a3)
  1578.     move.w    d2,KV.PTROLDY(a3)
  1579.  
  1580.     move.w    #0,KV.PTRERRX(a3)
  1581.     move.w    #0,KV.PTRERRY(a3)
  1582.  
  1583.     moveq    #0,d0
  1584.  
  1585. B_PTR_POSX:
  1586.     rts
  1587.  
  1588. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1589. B_PTR_INC:
  1590.     moveq    #4,d1
  1591.     moveq    #8,d2
  1592.     cmp.l    a3,a5
  1593.     beq.s    B_PTR_INC1
  1594.  
  1595.     bsr    FETCH_W
  1596.     bne.s    B_PTR_INCX
  1597.  
  1598.     move.w    d1,d2
  1599.  
  1600.     bsr    FETCH_W
  1601.     bne.s    B_PTR_INCX
  1602.  
  1603.     cmp.l    a3,a5
  1604.     bne    RPRT_BP
  1605.  
  1606.     exg    d1,d2
  1607.  
  1608. B_PTR_INC1:
  1609.     bsr    PTR_INC
  1610.  
  1611.     moveq    #0,d0
  1612.  
  1613. B_PTR_INCX:
  1614.     rts
  1615.  
  1616. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1617. B_PTR_X:
  1618.     cmp.l    a3,a5
  1619.     bne    RPRT_BP
  1620.  
  1621.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1622.  
  1623.     move.w    KV.PTRX(a3),d1
  1624.  
  1625.     bra    RET_W
  1626.  
  1627. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1628. B_PTR_Y:
  1629.     cmp.l    a3,a5
  1630.     bne    RPRT_BP
  1631.  
  1632.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1633.  
  1634.     move.w    KV.PTRY(a3),d1
  1635.  
  1636.     bra    RET_W
  1637.  
  1638. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1639. PTR_POS:
  1640.     movem.l    d1-d3/a4,-(a7)
  1641.  
  1642.     add.w    #$2C,d2        ; Y offset $2C
  1643.     andi.w    #$1FF,d2     ; Y within range
  1644.     move.w    d2,d3
  1645.     lsl.l    #8,d3
  1646.     lsl.l    #1,d3
  1647.     addi.w    #$A0,d1        ; X offset $A0
  1648.     andi.w    #$1FF,d1     ; X within range
  1649.     or.w    d1,d3
  1650.     ror.l    #1,d3
  1651.     swap    d3
  1652.     addi.w    #$10,d2        ; Height $10
  1653.     lsl.w    #8,d2
  1654.     roxl.w    #1,d3
  1655.     roxl.w    #1,d3
  1656.     or.w    d2,d3
  1657.  
  1658.     move.l    d3,SPRLST
  1659.  
  1660.     movem.l    (a7)+,d1-d3/a4
  1661.  
  1662. PTR_POSX:
  1663.     rts
  1664.  
  1665. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1666. PTR_CLPX:
  1667.     movem.l    d5/a3,-(a7)
  1668.  
  1669.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1670.  
  1671.     move.w    KV.PTRMINX(a3),d5
  1672.     cmp.w    d5,d1
  1673.     blt.s    PTR_CLP1
  1674.  
  1675.     move.w    KV.PTRMAXX(a3),d5
  1676.     cmp.w    d5,d1
  1677.     bgt.s    PTR_CLP1
  1678.  
  1679.     moveq    #0,d3
  1680.     bra.s    PTR_CLP2
  1681.  
  1682. PTR_CLP1:
  1683.     add.w    d1,d3
  1684.     sub.w    d5,d3
  1685.  
  1686.     move.w    d5,d1
  1687.  
  1688. PTR_CLP2:
  1689.     movem.l    (a7)+,d5/a3
  1690.     rts
  1691.  
  1692. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1693. PTR_CLPY:
  1694.     movem.l    d5/a3,-(a7)
  1695.  
  1696.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1697.  
  1698.     move.w    KV.PTRMINY(a3),d5
  1699.     cmp.w    d5,d2
  1700.     blt.s    PTR_CLP3
  1701.  
  1702.     move.w    KV.PTRMAXY(a3),d5
  1703.     cmp.w    d5,d2
  1704.     bgt.s    PTR_CLP3
  1705.  
  1706.     moveq    #0,d4
  1707.     bra.s    PTR_CLP4
  1708.  
  1709. PTR_CLP3:
  1710.     add.w    d2,d4
  1711.     sub.w    d5,d4
  1712.  
  1713.     move.w    d5,d2
  1714.  
  1715. PTR_CLP4:
  1716.     movem.l    (a7)+,d5/a3
  1717.     rts
  1718.  
  1719. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1720. PTR_INC:
  1721.     move.l    AV.KEYV,a3    ; address of keyboard vars
  1722.  
  1723.     tst.w    d1
  1724.     beq.s    PTR_INCX
  1725.  
  1726.     move.w    KV.PTRMAXX(a3),d0
  1727.     sub.w    KV.PTRMINX(a3),d0
  1728.     addq.w    #1,d0
  1729.     lsr.w    #1,d0
  1730.  
  1731.     cmp.w    d0,d1
  1732.     bgt.s    PTR_INCX
  1733.  
  1734. PTR_INC1:
  1735.     tst.w    d2
  1736.     beq.s    PTR_INCX
  1737.  
  1738.     move.w    KV.PTRMAXY(a3),d0
  1739.     sub.w    KV.PTRMINY(a3),d0
  1740.     addq.w    #1,d0
  1741.     lsr.w    #1,d0
  1742.  
  1743.     cmp.w    d0,d2
  1744.     bgt.s    PTR_INCX
  1745.  
  1746.     move.w    d1,KV.PTRINCX(a3)
  1747.     move.w    d2,KV.PTRINCY(a3)
  1748.  
  1749. PTR_INCX:
  1750.     moveq    #0,d0
  1751.  
  1752.     rts
  1753.  
  1754. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1755. ; Fetch one Word
  1756.  
  1757. FETCH_W:
  1758.     movem.l    a2,-(a7)
  1759.  
  1760.     move.w    CA.GTINT,a2
  1761.     bsr.s    GET_ONE
  1762.     bne.s    FETCH_WX
  1763.  
  1764.     move.l    a1,BV_RIP(a6)
  1765.     moveq    #0,d1
  1766.     move.w    0(a6,a1.l),d1
  1767.     addq.l    #2,BV_RIP(a6)
  1768.  
  1769. FETCH_WX:
  1770.     movem.l    (a7)+,a2
  1771.     tst.l    d0
  1772.     rts
  1773.  
  1774. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1775. ;  This routine gets one parameter and returns it on the maths
  1776. ;  stack, pointed to by (A1).
  1777. ;
  1778. ; Entry: A2.L   routine to call (i.e. CA.GTINT)
  1779. ;    A3.L   pointer to first parameter
  1780. ;    A5.L   pointer to last parameter
  1781. ;
  1782. ; Exit:    A3.L   updated
  1783. ;    A5.L   updated
  1784. ;    A1.L   updated pointer to top of maths stack
  1785. ;    D0.L   error code
  1786.  
  1787. GET_ONE:
  1788.     movem.l    d1-d6/a0/a2,-(a7)
  1789.  
  1790.     lea    8(a3),a0
  1791.     cmp.l    a0,a5
  1792.     blt.s    GET_ONEBp
  1793.  
  1794.     move.l    BV_RIP(a6),a1
  1795.     move.l    a5,-(a7)
  1796.     move.l    a0,a5
  1797.     move.l    a5,-(a7)
  1798.     jsr    (a2)
  1799.     movem.l    (a7)+,a0/a5
  1800.  
  1801.     tst.l    d0
  1802.     bne.s    GET_ONEX
  1803.  
  1804.     move.l    a0,a3
  1805.     move.l    a1,BV_RIP(a6)
  1806.  
  1807.     bra.s    GET_ONEX
  1808.  
  1809. GET_ONEBp:
  1810.     moveq    #ERR.BP,d0
  1811.  
  1812. GET_ONEX:
  1813.     movem.l    (a7)+,d1-d6/a0/a2
  1814.     tst.l    d0
  1815.     rts
  1816.  
  1817. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1818. ;  Return word d1.w to BASIC
  1819.  
  1820. RET_W:
  1821.     move.l    d1,d4
  1822.     moveq.l    #2,d1
  1823.     move.w    BV.CHRIX,a2
  1824.     jsr    (a2)
  1825.     move.l    d4,d1
  1826.  
  1827.     move.l    BV_RIP(a6),a1    ; Get arith stack pointer
  1828.     subq.l    #2,a1        ; room for 2 bytes
  1829.     move.l    a1,BV_RIP(a6)
  1830.     move.w    d1,0(a6,a1.l)    ; Put int number on stack
  1831.     moveq.l    #3,d4        ; set Integer type
  1832.  
  1833.     moveq.l    #ERR.OK,d0    ; no errors
  1834.     rts
  1835.  
  1836. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1837. RPRT_BP:
  1838.     moveq    #ERR.BP,d0
  1839.     rts
  1840.  
  1841. ; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1842.     END
  1843.