ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/MBUG/MBUG094.ARC/FIX-256.ARC/ROUTINES.PAK

Text File | 1988-06-14 | 14.3 KB | 813 lines

; Collection of routines from the Programming Notes
;  compiled by Vaughan Clarkson, '88

;----------------<ROUTINE to CHECK BIOS NUMBER>-----------------

biosvct    equ    0001h

Check_BIOS:
; Check_BIOS checks the BIOS version number to find out whether
; the BIOS supports XBIOS subset 'C'.  It uses this logic:
; IF Bios_Type IS
;   > 1 and < 17h and <> 6 or
;   > 1Dh and < 2Fh or
;   > 43h and < BFh
; THEN XBIOS subset 'C' is supported
; ELSE subset 'C' is not supported (see notes below for this case)
; If XBIOS is supported then the Z flag will be set

    push    de
    push    hl
    lΣ    hl,(biosvct⌐    ╗ warφ star⌠ entr∙ (BIO╙ ½ 3)
    ld    de,30h
    add    hl,de        ╗ (BIO╙ ½ 33h⌐ ╜ BIOS_TYPE
    ld    e,a
    ld    a,(hl)
    ld    d,0        ; set flag to true
    cp    2        ; check version numbers
    jr    c,xbfail
    cp    6
    jr    z,xbfail
    cp    17h
    jr    c,use_xb
    cp    1Eh
    jr    c,xbfail
    cp    2Fh
    jr    c,use_xb
    cp    44h
    jr    c,xbfail
    cp    0BFh
    jr    c,use_xb
xbfail║    lΣ    d,-▒        ╗ flag=falsσ (incorrec⌠ XBIOS)
use_xb:    ld    a,d
    or    a        ; test flag
    ld    a,e
    pop    hl
    pop    de
    ret


;------------------<CLEAR QUEUE after KB_TEST>-------------------

bdos    equ    0005h        ; BDOS jump vector
dconio    equ    6        ; BDOS direct console in/out

clr_queue:
; Clears console queue for normal keyboard use after kb_test
    ld    e,-1           ; signal console inè    ld    c,dconio
    call    bdos
    or    a
    jr    nz,clr_queue
    ret


;-----------------------<CHECK if 256TC>------------------------

rom_end    equ    0EFFFh

is_256TC:
; Routine to test which keyboard is being used.
; Z indicates new keyboard, NZ indicates the old.
; Corrupts AF.
    push    hl
    ld    hl,rom_end-2
    ld    a,'2'
    cp    (hl)
    jr    nz,not256
    inc    hl
    ld    a,'5'
    cp    (hl)
    jr    nz,not256
    inc    hl
    ld    a,'6'
    cp    (hl)
not256:    pop    hl
    ret


;------------------------<Get KEY DATA>--------------------------

key_data:
╗ Thi≤ routinσ return≤ ßn ┌ flaτ iµ n∩ changσ iε keyboarΣ statu≤
; or an NZ flag and appropriate data in the accumlator otherwise.
; Note: this routine is only suitable for 256TC keyboards.
    in    a,(2)        ; check for change in status
    bit    1,a
    ret    z
    in    a,(18h)        ; get data
    ret


;----------------------<CLEAR KEY BUFFER>------------------------

clr_kbuf:
; Clear the keyboard buffer of all data.
; Corrupts AF.
    in    a,(2)
    and    2
    ret    z
    in    a,(18h)
    jr    clr_kbuf


;--------------------------<IS_CLOSED>---------------------------

isclsd:
; This routine checks if the key whose code is given in the
; accumulator is being pressed.  An NZ flag is returned if it
; is down and a Z flag if it is not.  The codes used in this
; routine are identical to those given for the XBIOS function
; kb_test (details above).
; Note:- this routine works only on the old keyboard.
    push    bc
    ld    c,a
    ld    b,a
close1:    ld    a,12h
    out    (0Ch),a
    ld    a,b
    rrca
    rrca
    rrca
    rrca
    and    3
    out    (0Dh),a
    ld    a,13h
    out    (0Ch),a
    ld    a,b
    rlcaè    rlca
    rlca
    rlca
    out    (0Dh),a
    ld    a,1
    out    (0Bh),a
    ld    a,10h
    out    (0Ch),a
    in    a,(0Dh)
la52f:    ld    a,1Fh
    out    (0Ch),a
    out    (0Dh),a
la535:    in    a,(0Ch)
    bit    7,a
    jr    z,la535
    in    a,(0Ch)
    cpl
    bit    6,a
    ld    a,0
    out    (0Bh),a
    ld    a,c
    pop    bc
    ret


;---------------------<IS_CLOSED for 256TC>----------------------

isclsd:
; Routine to emulate isclsd on old keyboards.
; Note that this routine works only for 256TC keyboards.
; Also provided is case, which contains the status of the
; SHIFT, ALT and CTRL keys in bits 2, 1 and 0 respectively
; at the time of the last call to isclsd.
    push    bc
    push    de
    push    hl
    ld    b,a
    call    key_3        ; * (these lines removed in in-
    ld    a,b        ; * terrupt version, see below)
    cp    3Fh        ; SHIFT?
    jr    z,tishift
    cp    39h        ; CTRL?
    jr    z,tisctrl
    cp    40h        ; ALT?
    jr    z,tisalt
    cp    64h
    jr    nc,tistbigè    cp    20h
    jr    c,tnorm
    cp    30h
    jr    nc,tnorm
    sub    20h
    add    a,a        ; check exceptions table
    ld    hl,itt_ex
    ld    e,a
    ld    d,0
    add    hl,de
    ld    a,(hl)
    inc    a
    jr    z,isret
    call    ischck
    jr    nz,isret
    inc    hl
    jr    chk2nd

tnorm║    lΣ    hl,ittab∞    ╗ conver⌠ t∩ natura∞ 256T├ codes
    ld    e,a
    ld    d,0
    add    hl,de
chk2nd:    ld    a,(hl)
    inc    a
    jr    z,isret
    call    ischck
    jr    isret

tistbig:xor    a
    jr    isret

tishift:ld    a,(case)
    and    4
    jr    isret

tisalt:    ld    a,(case)
    and    2
    jr    isret

tisctrl:ld    a,(case)
    and    1
isret:    ld    a,b
    pop    hl
    pop    de
    push    af
    pop    bc
    ld    a,c
    and    0feh            ; scf, ccf
    xor    40h            ; toggle z flag
    ld    c,a
    push    bc
    pop    af
    pop    bc
    ret
èischck:    push    hl
    dec    a
    ld    hl,isctbl
    ld    e,a
    ld    d,0
    add    hl,de
    ld    a,(hl)
    and    80h
    pop    hl
    ret

key_3:    xor    a
    out    (0Bh),a
    in    a,(2)        ;check port 2, bit 1 for key
    and    2
    ret    z
    in    a,(18h)        ;read port 18h for key code
    ld    d,a
    ld    hl,case        ;check for SHIFT, CTRL, and ALT
    res    7,a
    cp    67h        ;check SHIFT
    jr    nz,ctrl
    bit    7,d        ;is SHIFT up or down?
    res    2,(hl)
    ret    z
    set    2,(hl)
    ret

ctrl:    cp    6Fh        ;check CTRL
    jr    nz,alt
    bit    7,d        ;is CTRL up or down?
    res    0,(hl)
    ret    z
    set    0,(hl)
    ret

alt:    cp    77h        ;check ALT
    ld    a,d        ;signal no special key
    jr    nz,setist    ; and return with key code, if not ALT
    bit    7,d        ;is ALT up or down?
    set    1,(hl)
    ret    nz
    res    1,(hl)
    ret

setist:    ld    hl,isctbl    ;signal key up/down on isctbl
    and    7Fh
    push    bc
    ld    c,a
    ld    b,0
    add    hl,bc
    pop    bc
    ld    a,d
    and    80h
    res    7,(hl)è    ret    z
    set    7,(hl)
    ret

case║    dΓ    ░        ╗ inf∩ oε CTRL¼ AL╘ anΣ SHIFT
isctbl:    ds    60h,0        ; table of keys down

; table of code conversions from isclsd codes to natural codes
; for the 256TC keyboard (-1 means code not used)
ittabl║    dΓ    5Bh,0Bh,37h,27h,1Bh,1Ah,23h,2Bh
    db    33h,42h,3Bh,43h,4Bh,47h,3Fh,4Ah
    db    52h,0Ah,22h,13h,2Ah,3Ah,2Fh,12h
    db    1Fh,32h,17h,5Ah,56h,5Eh,55h,54h
    db    -1,-1,-1,-1,-1,-1,-1,-1
    db    -1,-1,-1,-1,-1,-1,-1,-1
    db    1,4Dh,2,0Eh,4Eh,0Dh,3,7
    db    46h,-1,35h,3Dh,-1,-1,36h,-1
    db    -1,0,8,10h,18h,20h,28h,30h
    db    38h,40h,48h,50h,58h,1,46h,0Fh
    db    54h,3Dh,35h,36h,3,2Ch,25h,26h
    db    34h,2Eh,1Dh,1Eh,24h,2Dh,15h,16h
    db    1Ch,5,6,14h

; exception table for ittable, for those isclsd codes which
; correspond to two keys on the new keyboard (eg. the code 20h
; corresponds to the 1 key, of which there are two, and whose
; codes are 51h and 5)
itt_ex:    db    51h,5,9,2Dh,11h,15h,19h,16h,21h,2Eh
    db    29h,1Dh,31h,1Eh,39h,2Ch,41h,25h,49h,26h
    db    59h,24h,53h,14h,4Fh,-1,5Dh,1Ch,57h,6
    db    5Fh,34h


;--------------------<SET INTERRUPT VECTORS>---------------------

; The interrupt vectors below have been chosen arbitrarily.  Any
; convenient memory location will do.  Note, however, that both
; interrupt vectors must be contained in the same page of memory,
; ie. the same 100h block.
vect_a    equ    4000h        ; interrupt vector for PIO port A
vect_b    equ    vect_a+2    ; interrupt vector for PIO port B

set_int:
; This routine sets up the PIO so that the keyboard drives anè; interrupt.
; Note: this routine works only with the 256TC keyboard.
    push    af
    push    bc
    push    de
    push    hl
    ld    hl,eireti    ; see new version of key_3, below
    ld    (vect_a),hl
    ld    hl,key_3
    ld    (vect_b),hl
    di            ╗ disablσ interrupt≤
    ld    hl,iotabl
do_pio:    ld    a,(hl)
    or    a
    jr    z,enabli
    ld    b,a
    inc    hl
    ld    c,(hl)
    inc    hl
    otir
    jr    do_pio

enabli:    im    2        ; set interrupt mode 2
    ld    a,HIGH vect_a    ╗ or 40h iµ HIG╚ i≤ supporteΣ
    ld    i,a
    ei            ; reenable interrupts
    pop    hl
    pop    de
    pop    bc
    pop    af
    ret

; If LOW is not supported on your assembler, substitute
; 0 for LOW vect_a and 2 for LOW vect_b
; Note: HIGH and LOW mean high order and low order 8 bits,
; respectively.
iotabl:    db    5,1,LOW vect_a,0CFh,-1,97h,-1
    db    5,3,LOW vect_b,-1,9Bh,0B7h,0EDh
    db    0


;------------------<KEY_3: INTERRUPT VERSION>--------------------

key_3:    push    af
    push    bc
    push    de
    push    hl
    in    a,(2)        ;check port 2, bit 1 for keyè    and    2
    jr    z,retk3
    in    a,(18h)        ;read port 18h for key code
    ld    d,a
    ld    hl,case        ;check for SHIFT, CTRL, and ALT
    res    7,a
    cp    67h        ;check SHIFT
    jr    nz,ctrl
    bit    7,d        ;is SHIFT up or down?
    res    2,(hl)
    jr    z,retk3
    set    2,(hl)
    jr    retk3

ctrl:    cp    6Fh        ;check CTRL
    jr    nz,alt
    bit    7,d        ;is CTRL up or down?
    res    0,(hl)
    jr    z,retk3
    set    0,(hl)
    jr    retk3

alt:    cp    77h        ;check ALT
    ld    a,d        ;signal no special key
    jr    nz,setist    ; and return with key code, if not ALT
    bit    7,d        ;is ALT up or down?
    set    1,(hl)
    jr    nz,retk3
    res    1,(hl)
    jr    retk3

setist:    ld    hl,isctbl    ;signal key up/down on isctbl
    and    7Fh
    push    bc
    ld    c,a
    ld    b,0
    add    hl,bc
    pop    bc
    ld    a,d
    and    80h
    res    7,(hl)
    jr    z,retk3
    set    7,(hl)
retk3:    pop    hl
    pop    de
    pop    bc
    pop    af
eireti:    ei
    reti


;-----------------------<EXAMINE SYSTEM>-------------------------

screen    equ    0F000h        ; char and att memory
grafix    equ    0F800h        ; PCG and colour memory
vmlatch    equ    1Ch        ; video memory latch port
attrib    equ    144        ; attribute switch
c_port    equ    8        ; colour port
c_swtch    equ    40h        ; colour port switch
row    equ    64        ; no of characters per row

examine:
; This routine examines the system to determine whether it
; (i) has colour (if not, colour is set to -1)
; (ii) is a Premium (if not, prmium is set to -1) and
; {iii} is a 256TC (if not, tc256 is set to -1)
╗ Note║ iµ thσ systeφ i≤ ß Premium¼ theε i⌠ i≤ als∩ colour¼ and
; if it is a 256TC, then it is also a Premium and colour, for
; the purposes of this routine.
; Corrupts AF and HL.
    call    is_256TC    ; see above for this routine
    ret    z
    ld    a,-1
    ld    (tc256),a
    ld    hl,screen+32*row-1
    ld    (hl),0è    ld    a,attrib
    out    (vmlatch),a
    ld    (hl),-1
    ld    a,80h
    out    (vmlatch),a
    ld    a,(hl)
    ld    (prmium),a
    or    a
    ret    z
    ld    hl,grafix+32*row-1
    ld    (hl),0
    ld    a,c_swtch
    out    (c_port),a
    ld    (hl),7
    xor    a
    out    (c_port),a
    ld    a,(hl)
    or    a
    ret    z
    ld    a,-1
    ld    (colour),a
    ret

colour:    db    0        ; 0 = colour
prmium:    db    0        ; 0 = Premium series or later
tc256:    db    0        ; 0 = 256TC


;--------------------<SET SCREEN to HIRES2>----------------------

initcol    equ    2        ; green on black

set_scn:
; Set up the screen in a rough equivalent to the HIRES2 command
; of MicroWorld BASIC.  Clears the screen, sets 64x16 video mode
╗ set≤ thσ screeε colou≥ t∩ initco∞ anΣ fill≤ thσ screeε froφ
; left to right, top to bottom with PCG, starting in the top left
; with character 80h, bank 0, and ending in the bottom right with
; character FFh, bank 7.
; Corrupts all registers.
; Returns c flag if error (ie. not Premium)
    ld    a,(prmium)    ; see examine routine above
    or    a
    scf
    ret    z
    ld    hl,screen    ; clear the screen
    ld    (hl),' '
    ld    de,screen+1
    ld    bc,32*row-1
    ldir
    call    reform        ; set 64x16 mode
    ld    bc,0
rfwait:    dec    bcè    ld    a,b
    or    c
    jp    nz,rfwait
    ld    b,8
    ld    a,80h
clgrfx:    push    bc
    out    (vmlatch),a
    ld    hl,grafix
    ld    (hl),0
    ld    de,grafix+1
    ld    bc,128*char
    ldir
    inc    a
    pop    bc
    djnz    clgrfx
    ld    a,c_swtch        ; set up initial screen colour
    out    (c_port),a
    ld    hl,grafix
    ld    (hl),initcol
    ld    de,grafix+1
    ld    bc,16*row-1
    ldir
    xor    a
    out    (c_port),a
    ld    b,8            ; set up screen & attributes
    ld    hl,screen
    ld    de,screen+1
    ld    a,attrib
    out    (vmlatch),a
    xor    a
setatt:    push    bc
    ld    bc,2*row
    ld    (hl),a
    ldir
    inc    a
    pop    bc
    djnz    setatt
    ld    a,80h
    out    (vmlatch),a
    ld    hl,screen
    ld    c,8
setscn:    ld    b,2*row
    ld    a,80h
setrow:    ld    (hl),a
    inc    a
    inc    hl
    djnz    setrow
    dec    c
    jr    nz,setscn
    re⌠                ╗ π flaτ i≤ rese⌠

reform:    ld    hl,v_64+15        ; routine to set up 64*16
refrm2:    push    bc
    push    hl
    ld    b,10hèformat:    ld    a,b
    dec    a
    out    (0ch),a
    ld    a,(hl)
    out    (0dh),a
    dec    hl
    djnz    format
    ld    b,4Bh
    call    leee3
    pop    hl
    pop    bc
    ret

leee3:    push    hl            ; routine for 64*16
leee4:    ld    hl,007Ah
leee7:    dec    hl
    ld    a,h
    or    l
    jr    nz,leee7
    djnz    leee4
    pop    hl
    ret

v_64:    db    6Bh,64,51h,37h,12h,9,16,12h,48h,0Fh,2Fh,0Fh,0,0,0,0


;------------------------<LINE DRAWING>--------------------------

line:
; This routine is used in conjunction with hires2 above and
; draws a straight line from (from_x, from_y) to (to_x, to_y).
; Corrupts all registers, including IY and alternative regs.
    call    calcxy
    ex    af,af'
    ld    a,(set)
    ex    af,af'
    ld    hl,(from_x)
    ld    de,(to_x)
    call    subabs
    ld    b,h
    ld    c,l
    ld    hl,pix_lt
    jp    nc,cupok
    ld    hl,pix_rt
cupok:    ld    (vect_1),hl
    ld    hl,(from_y)
    ld    de,(to_y)
    call    subabs
    ld    d,h
    ld    e,l
    ld    hl,pix_up
    jp    nc,crtok
    ld    hl,pix_dnècrtok:    ld    (vect_2),hl
    ld    h,b
    ld    l,c
    or    a
    sbc    hl,de
    jp    nc,swaphd
    ld    hl,(vect_1)
    ld    iy,(vect_2)
    ld    (vect_2),hl
    ld    (vect_1),iy
    ld    h,b
    ld    l,c
    ex    de,hl
    ld    b,h
    ld    c,l
swaphd:    push    bc
    push    bc
    ld    hl,0
    srl    b
    rr    c
    or    a
    sbc    hl,bc
    push    hl
    pop    iy
    dec    iy
    pop    bc
    ld    hl,0
    or    a
    sbc    hl,bc
    ld    b,h
    ld    c,l
    pop    hl
    ld    a,h
    or    l
    jr    z,conend
smline:    exx
    call    c_plot
smmove:    call    pix_rt
    exx
    add    iy,de
    jp    nc,endmov
    add    iy,bc
    exx
bgmove:    call    pix_dn
    exx
endmov:    dec    hl
    ld    a,h
    or    l
    jp    nz,smline
conend:    exx
    call    c_plot
    exx
    ret

vect_1    equ    smmove+1èvect_2    equ    bgmove+1

calcxy:    exx
    lΣ    hl,(from_x⌐    ╗ calculatσ initia∞ datß fo≥ linσ
    ld    a,7
    and    l
    ld    b,a
    ld    a,80h
    jr    z,noshft
shftpx:    srl    a
    djnz    shftpx
noshft:    ld    c,a
    ld    a,0F8h
    and    l
    ld    l,a
    add    hl,hl
    ex    de,hl
    ld    hl,(from_y)
    ld    a,15
    and    l
    ld    b,a
    ld    a,0E0h
    and    l
    rlca
    rlca
    rlca
    ld    (bank),a
    or    80h
    out    (vmlatch),a
    bit    4,l
    ld    l,b
    ld    h,0
    jr    z,hlfblk
    ld    h,4
hlfblk:    add    hl,de
    ld    de,grafix
    add    hl,de
    exx
    ret

╗ Thσ nex⌠ tw∩ routine≤ se⌠ anΣ rese⌠ thσ pixe∞ a⌠ thσ curren⌠
; location

c_plot:    ex    af,af'
    or    a
    jp    z,creset
    ex    af,af'
    ld    a,c
    or    (hl)
    ld    (hl),a
    ret

creset:    ex    af,af'
    ld    a,c
    or    (hl)è    xor    c
    ld    (hl),a
    ret

╗ Thσ followinτ routines¼ pix_lt¼ pix_rt¼ pix_up¼ pix_dn¼ movσ
╗ thσ curren⌠ pixe∞ locatioε left¼ right¼ u≡ anΣ dowε
; respectively

pix_lt:    sla    c
    ret    nc
    ld    c,1
    ld    de,-char
    add    hl,de
    ret

pix_rt:    srl    c
    ret    nc
    ld    c,80h
    ld    de,char
    add    hl,de
    ret

pix_up:    ld    a,b
    or    a
    jr    z,chr_up
    dec    b
    dec    hl
    ret

chr_up:    ld    de,char-1
    ld    b,e
    add    hl,de
    ld    a,4
    xor    h
    ld    h,a
    bit    2,h
    ret    z
    ld    a,(bank)
    dec    a
    ld    (bank),a
    or    80h
    out    (vmlatch),a
    ret

pix_dn:    ld    a,b
    inc    a
    cp    char
    jr    nc,chr_dn
    ld    b,a
    inc    hl
    ret

chr_dn:    xor    a
    ld    b,a
    ld    de,-char+1è    add    hl,de
    ld    a,4
    xor    h
    ld    h,a
    bit    2,h
    ret    nz
    ld    a,(bank)
    inc    a
    ld    (bank),a
    or    80h
    out    (vmlatch),a
    ret

subabs:    ld    a,h        ;perform absolute of hl - de
    cp    d
    jp    c,abshls
    jp    nz,absdes
    ld    a,l
    cp    e
    jp    c,abshls
absdes:    or    a
    sbc    hl,de
    ret
abshls:    ex    de,hl
    or    a
    sbc    hl,de
    scf
    ret

from_x:    dw    0
from_y:    dw    0
to_x:    dw    0
to_y:    dw    0
bank:    db    0
set:    db    0