* QL WORLD DIY TOOLKIT - pixel graphics function
* Version 0.9, Copyright 1989,90 Simon N Goodwin.
* Modified 10/9/89 to support Thor XVI MODE 12.
* Modified 18/7/90 to suit Metacomco's Assembler.
*
start      lea.l    define,a1
           move.w   $110,a2         BP.INIT vector
           jmp      (a2)
*
* PIXEL%  code - process 2 or 3 parameters
*
pixel      move.w   $112,a2         Vector to get integers
           jsr      (a2)            CA.GTINT
           bne.s    bad_exit
           moveq    #1,d0           Assume channel 1 for now
           subq.w   #2,d3           At least 2 parameters?
           beq.s    get_coords      Exactly 2,  use #1
           bmi.s    bad_param       Less than 2: an error  
           subq.w   #1,d3           Only one extra parameter?
           bne.s    bad_param       No, more than 3, complain
           move.w   0(a1,a6.l),d0   Get BASIC channel number
           addq.l   #2,a1           Discard channel parameter
*
get_coords move.w   0(a1,a6.l),d1   Get X co-ordinate
           move.w   2(a1,a6.l),d2   Get Y co-ordinate
           addq.l   #2,a1           Leave room for one INT
           move.l   a1,$58(a6)      Set maths stack pointer
*
* Check and convert channel number in D0 to ID in A0
*
chan_sel   mulu     #40,d0          Channel table size
           add.l    $30(a6),d0      Add base offset
           cmp.l    $34(a6),d0 
           bge.s    what_chan       Past end of table?
           move.l   0(a6,d0.l),d0
           bpl.s    chan_open       Negative if closed
*
* Error return points
*
what_chan  moveq    #-6,d0          CHANNEL NOT OPEN error
bad_exit   rts                      Error code is in D0
bad_param  moveq    #-15,d0         BAD PARAMETER error
           rts
range_err  moveq    #-4,d0          Out of Range report code
           rts
*
* Call EXTOP routine passing A0, D1 and D2
*
chan_open  movea.l  d0,a0           A0 is channel ID
           lea.l    pixtop,a2       Address of routine
           moveq    #-1,d3          Allow infinite time
           moveq    #9,d0           SD.EXTOP key
           trap     #3              Call the device driver
           movea.l  $58(a6),a1      Retrieve maths stack pointer
*
return_int move.w   d1,0(a1,a6.l)   Put result in space
           moveq    #3,d4           Indicate type is INT
           rts                      Return EXTOP error code
*
* PIxel eXTended OPeration routine: reads pixel data.
* D1.W is the X co-ordinate, D2.W is the Y co-ordinate
* The result is returned in D1, or error code -4 in D0
*
pixtop     tst.w    d2              Check Y >= 0
           bmi.s    range_err
           cmp.w    30(a0),d2       Check Y < CH.HEIGHT 
           bcc.s    range_err
           tst.w    d1              Check X >= 0
           bmi.s    range_err
           cmp.w    28(a0),d1       Check X < CH.WIDTH
           bcc.s    range_err
           add.w    24(a0),d1       Add window offset to X
           add.w    26(a0),d2       Add window offset to Y
*      
* Find the relevant word in video memory
*
mode4      movea.l  50(a0),a2       Get screen base address       
           lsl.w    #7,d2           1 line uses 2^7 = 128 bytes
           adda.w   d2,a2           Get address of start of line
           move.w   d1,d2           Save original X co-ordinate
           lsr.w    #2,d1				Get word offset on line
           and.w    #126,d1         Ensure offset is even, 0-126
           adda.w   d1,a2           A2 -> relevant screen word
           move.w   (a2),d1         D1.W is the video word      
           and.w    #7,d2           D2 = pixel offset in word, 0-7
*
* Extract the pixel in mode 4, 8 or 12
*
           btst     #3,52(a6)       Check mode
           bne.s    mode8           Process 8 or 16 colours
           moveq    #7,d0
           sub.w    d2,d0           Reverse offset to 7-0
           lsr.w    d0,d1           Move pixel data to LS bits
           and.w    #257,d1         Mask for 4 colours
           add.b    d1,d1           Double red bit weight
           move.w   d1,d2           D2 = 0000000G 000000R0
           lsr.w    #6,d2           D2.B =  00000G00
           or.b     d2,d1           D1.B =  00000GR0
           cmp.b    #6,d1           Conventional value 0, 2, 4 ?
           bne.s    got_value
           addq.b   #1,d1           Translate 6 to 7 (White)
           bra.s    got_value
*
mode12     and.w    #771,d1         Mask for 16 colours
           move.w   d1,d2           D2 = 000000GI  000000RB
           lsr.w    #7,d2           D2.B =  00000GI0
           bclr     #1,d2           Set if Std. Intensity
           bne.s    mix_bytes       Return as for MODE 8
           bset     #3,d1           Dim; add 8 to colour
           bra.s    mix_bytes       D1.B =  0000IGRB
*
mode8      moveq    #6,d0
           bclr     #0,d2           Ensure even X in MODE 8
           sub.w    d2,d0           Reverse offset to 6-0
           lsr.w    d0,d1           Move pixel data to LS bits
           btst     #2,52(a6)       Check for MODE 12
           bne.s    mode12
           and.w    #515,d1         Mask for 8 colours
           move.w   d1,d2           D2 = 000000G0  000000RB
           lsr.w    #7,d2           D2.B =  00000G00
mix_bytes  or.b     d2,d1           D1.B =  00000GRB
got_value  ext.w    d1               
           moveq    #0,d0           Signal no error
           rts
*
define     dc.w     0,0             No procedures
           dc.w     1               One function
           dc.w     pixel-*
           dc.b     6,'PIXEL%'
           ds.w     0
           dc.w     0               End of list
*
            end