        nolist

        write     "cliffcde.bin"
;
; This code uses KL BANK SWITCH and KL SCAN NEEDED which are only present in
; f/w V1.2 and greater (6128) - you have been warned !
;
; Apologies for some of this code, but most of it was written one Sunday in
; a bit of a rush.
;
; P.S. Have a close look at the Supertest screens, they were saved onto an
; Arnold disk from a Spectrum and converted to Arnold format with a very
; short program that appeared in the July 86 issue of ACU.
;

txtoutput       equ       #bb5a
scrsetmode      equ       #bc0e
kllogext        equ       #bcd1
scrmodeclear    equ       #bdeb
klnewfastticker equ       #bce0
kldelfastticker equ       #bce6
mcwaitflyback   equ       #bd19
mcsetmode       equ       #bd1c
mcsetinks       equ       #bd25

        ;cseg

        org     #a000             ;anywhere in central 32k

        jp      logrsxs           ;logon the RSXs for multi mode
        jp      showscr           ;show/clear screen from top down
        jp      upscrn            ;ditto from bottom up
        jp      setram            ;switch in parm. RAM page
        jp      unpack            ;unpack Art Sutdio screen at #2000 to page parm.

logrsxs:
;
; RSX routines to allow setting of various modes/inks down screen
;
;               by Cliff Lawson 1985/86
;
; There are 4 areas within the main display area so that
;
; |MODES,m1,m2,m3,m4
;
; will set these four areas. mn is 0..2 obviously (other value
; means no change). The other 2 of the possible 6 are just about in
; the top and bottom border so are set to m1 and m4 resp.
;
;
; |INKS,s,ib,i0,i1,i2,..,i14,i15
;
; This allows the inks in section s to be set to i0..i15. The border for that
; section is set by ib. If a section is in MODE 1 then only ib and i0..i3 need
; be specified and in MODE 2 only ib,i0,i1. There are 6 sections visible, 
; including two areas within the top and bottom border. A value greater than
; 26 for ib or i0..i15 means leave that ink as it is so for example :
;
;  |INKS,3,99,99,99,99,17
;
; will set ink 4 in section 3 to 17 (like INK 4,17).
;
;
; |NORMAL,m
;
; removes events and puts screen back to normal in MODE m (or MODE 2 if no m
; is given).
;

        ld      hl,work
        ld      bc,comtab
        jp      kllogext          ;add the RSX commands

comtab:
        defw    namtab
        jp      modset
        jp      offev
        jp      setinks
namtab:
        defb    'MODE','S'+#80
        defb    'NORMA','L'+#80
        defb    'INK','S'+#80
        defb    0

warn1:                            ;remind syntax if 4 parms not given
        ld      hl,modemess
        jp      pmess

modset:
        cp      4
        jr      nz,warn1          ;always takes 4 parameters otherwise warn.
 
        call    remove            ;just in case |MODES is already in effect
        ld      hl,modevec
        ld      (hl),0
        ld      de,modevec+1
        ld      bc,5
        ldir                      ;reset list of modes (6, but just 4 visible)

        ld      b,6
        ld      hl,modevec+4      ;work backwards from +4 to +1
cjl:
        ld      a,(ix+0)          ;get RSX parameter
        ld      (hl),a            ;store in mode vector
        dec     hl
        inc     ix
        inc     ix
        djnz    cjl               ;fill in middle 4 of 6 mode sections

        ld      a,(modevec+1)
        ld      (modevec),a       ;make 0 and 1 the same
        ld      a,(modevec+4)
        ld      (modevec+5),a     ;make 4 and 5 the same

        ld      a,#c9
        ld      (scrmodeclear),a  ;so MODE wont clear the screen
        ld      a,0
        ld      (section),a       ;initialise section counter

        di
        ld      bc,#f500          ;want to sync addition of event to known pnt.
waitnoff:
        in      a,(c)
        bit     0,a
        jr      nz,waitnoff
waitff:
        in      a,(c)
        bit     0,a
        jr      z,waitff
;
;Gets here as soon as it goes into next frame flyback.
;
        call    #b92a             ;KL SCAN NEEDED
        ld      hl,evblk
        ld      b,#81
        ld      de,evrout
        jp      klnewfastticker   ;add the 300th sec event

evrout:
;
; this is run every 300th of a second allowing 6 changes in the 50th
; of a second that it takes to scan the screen
;
        ld      a,(section)       ;section counter
        inc     a
        cp      6                 ;0..5
        ld      (section),a
        jr      nz,skip
        xor     a
        ld      (section),a
skip:
        push    af
        ld      hl,modevec
        ld      d,0
        ld      e,a
        add     hl,de             ;add section number (section) onto base of vec list
        ld      a,(hl)
        call    mcsetmode
        pop     af                ;get section number back
        call    mult17            ;convert to absolute table address in DE
        call    mcsetinks         ;set new inks palette
        ret

mult17:
;
; multiply A by 17 to make offset in ink vector table
;
; return table address in DE
; corrupts hl and af
;
        cp      6                 ;section numbers only go up to 5
        jr      nc,warn3
        ld      e,a               ;hold onto 1*a
        sla     a
        sla     a
        sla     a
        sla     a                 ;a*16
        add     e                 ;a*16+a*1=a*17
        ld      hl,ivecs
        ld      d,0
        ld      e,a
        add     hl,de
        push    hl
        pop     de                ;de points at 17 bytes of ink vector.
        ret

warn3:
        ld      hl,sectmess
        jp      pmess

offev:
;
; reset screen mode clear indrection so that MODE now clears the screen
; finally pick up parameter and switch to that mode (or 2 if no parm)
;
        push    af
        call    remove
        pop     af
        or      a
        jr      nz,eric
        ld      a,2
        jp      scrsetmode
eric
        ld      a,(ix+0)
        jp      scrsetmode

remove:
        ld      a,#c3
        ld      (scrmodeclear),a
        ld      hl,evblk
        jp      kldelfastticker

setinks:
;
; set the inks and border colours for a particular section
;
; as always, on entry A holds the N, the number of parameters and IX points
; to the stacked parameters. That is
;
;  (IX+0/1)        holds ink N
;  (IX+2/3)        holds ink N-1
;     :              :     :
;  (IX+2N-5/2N-6)  holds ink 1
;  (IX+2N-3/2N-2)  holds border colour
;  (IX+2N-1/2N)    holds section number
;
        or      a                 ;set flags
        jr      z,warn2           ;if no parms then give syntax
        ld      b,a               ;put number of parms somewhere useful
        sla     a                 ;2N
        dec     a                 ;2N-1 (point at low byte of section word)
        push    ix
        pop     hl                ;about to calculate section parm address
        ld      e,a
        ld      d,0
        add     hl,de             ;hl=ix+2N-1
        dec     hl                ;fiddle factor
        ld      a,(hl)            ;get section number
        push    hl
        call    mult17            ;make addr for ivecs table in DE
        pop     hl
        dec     b                 ;going to loop for all but section number
fred:
        dec     hl
        dec     hl                ;double dec because they are words
        ld      a,(hl)            ;get parameter
        cp      27
        jr      nc,same           ;if ink given is >26 then leave it the same
        call    convert
        ld      (de),a            ;set ink to new value
same
        inc     de                ;step inks pointer on
        djnz    fred
        ret

warn2:
        ld      hl,inksmess
        jp      pmess

pmess:
;
; Print message pointed at by HL and ended with a dollar sign (a la CPM 9)
;
        ld      a,(hl)
        cp      "$"
        ret     z
        inc     hl
        call    txtoutput
        jr      pmess

convert:
;
; convert from grey scale number to h/w colour number
;
        push    hl
        push    de
        ld      e,a
        ld      d,0
        ld      hl,convtable
        add     hl,de
        ld      a,(hl)
        pop     de
        pop     hl
        ret

        ;dseg

modemess
        defb    10,'|MODES,m1,m2,m3,m4',13,10,10
        defb    'sets the mode for 4 visible sections$'
inksmess
        defb    10,'|INKS,s,b,i0,..,i15',13,10,10
        defb    'sets the border (b) and inks (i0 up to',13,10
        defb    'i15) for section s (0..5)$'
sectmess
        defb    10,'Are you sure, my mum always told me',13,10
        defb    'that section numbers were from 0 to 5$'

evblk   defs    9                 ;event block

section defb    1                 ;current screen section (0..5)
modevec defs    6                 ;6 bytes to hold mode for each section
work    defs    4                 ;system work space for RSX commands

ivecs                             ;table of 6 palettes (1 border and 16 inks)
        defb    20,20,18,12,21,0,2,3,4,5,6,7,10,11,12,13,14
        defb    20,20,18,12,21,0,2,3,4,5,6,7,10,11,12,13,14
        defb    20,20,18,12,21,0,2,3,4,5,6,7,10,11,12,13,14
        defb    20,20,18,12,21,0,2,3,4,5,6,7,10,11,12,13,14
        defb    20,20,18,12,21,0,2,3,4,5,6,7,10,11,12,13,14
        defb    20,20,18,12,21,0,2,3,4,5,6,7,10,11,12,13,14

convtable                         ;conversion table from h/w to grey number
        defb    20,4,21,28,24,29,12,5,13,22,6,23,30,0,31,14
        defb    7,15,18,2,19,26,25,27,10,3,11

        defb    "The above code is as per an article by me, Cliff "
        defb    "Lawson that appeared in ACU. The following are "
        defb    "the routines to draw the screen from top to "
        defb    "bottom and bottom to top - rather than Venetian "
        defb    "blind style. There is also a routine to unpack "
        defb    "Art Studio pictures. For all this and more, see "
        defb    "CLIFFCDE.TXT - a Maxam source file somewhere on"
        defb    "one of these two disks"


showscr:
;
;used in the form CALL entry,0 or 1 (0 means clear. 1 means draw from #4000)
;(from top down)
;
        ld      a,(ix+0)  ;get parameter
        ld      (blkbyt),a
        ld      hl,#c000  ;screen start
ssfred:
        ld      b,#50     ;bytes per line
        push    hl
sseric:
        ld      a,(blkbyt)
        or      a
        jr      z,fillzero
        push    hl
;        ld      de,#8000  ;going to pick up piccky from #4000... (c000-8000)
;        xor     a
;        sbc     hl,de     ;make source addr
        res     7,h
        ld      a,(hl)    ;get byte
        pop     hl        ;recover destn addr
fillzero:
        ld      (hl),a    ;show the byte
        inc     hl
        djnz    sseric
        pop     hl
        ld      de,#800
        add     hl,de
        jr      nc,ssfred
        ld      de,#c050
        add     hl,de
        push    hl
        ld      de,#c5A0  ;down to line 18
        xor     a
        sbc     hl,de
        pop     hl
        jr      z,theend
        jr      ssfred
theend:
        ret

blkbyt: defb    0

upscrn:
;
;used in the form CALL entry,0 or 1 (0 means clear. 1 means draw from #4000)
;(from bottom up)
;
        ld      a,(ix+0)
        ld      (blkbyt),a
        ld      hl,#c5a0
usfred:
        ld      b,#50     ;bytes per line
        push    hl
useric:
        ld      a,(blkbyt)
        or      a
        jr      z,ufllzero
        push    hl
;        ld      de,#8000  ;going to pick up piccky from #4000... (c000-8000)
;        xor     a
;        sbc     hl,de     ;make source addr
        res     7,h
        ld      a,(hl)    ;get byte
        pop     hl        ;recover destn addr
ufllzero:
        ld      (hl),a    ;show the byte
        inc     hl
        djnz    useric
        pop     hl
        ld      de,#800
        xor     a
        sbc     hl,de     ;go up a pixel line
        push    hl        ;save new addr
        ld      de,#c000
        xor     a
        sbc     hl,de     ;carry set if gone below #c000
        pop     hl        ;restore current addr
        jr      z,atstart ;addr is #c000 so at top screen
        jr      nc,notbelow
        ld      de,#3fb0
        add     hl,de     ;keep within #c000..#ffff
notbelow:
        jr      usfred
atstart:                  ;the following tidies up the top line
        ld      b,#50
enderic:
        ld      a,(blkbyt)
        or      a
        jr      z,endzero
        push    hl
        ld      de,#8000  ;going to pick up piccky from #4000... (c000-8000)
        xor     a
        sbc     hl,de     ;make source addr
        ld      a,(hl)    ;get byte
        pop     hl        ;recover destn addr
endzero:
        ld      (hl),a    ;show the byte
        inc     hl
        djnz    enderic
        ret

setram:
;
; used in the form CALL entry,RAM page for #4000
;
        ld      a,(ix+0)
        jp      #bd5b

unpack:
;
;used in the form CALL entry,RAM page for screen that is unpacked from #2000
;
        ld      a,(ix+0)
        ld      (membank),a ;save memory bank parameter
        ld      hl,#2005  ;+5 to get past the MJH 00 10
        ld      de,#6000
uploop:
        ld      a,(hl)    ;get packed byte
        cp      1
        jr      nz,simple ;if it isn't one then just store and loop
        inc     hl
        ld      b,(hl)    ;get number to use
        inc     hl
        ld      a,(hl)    ;get byte to use
        inc     hl        ;point at next source for next go
ufredlp:
        ld      (de),a
        inc     de
        djnz    ufredlp
        jr      chkend

simple:
        cp      "M"
        jr      nz,reallysimp
        push    hl
        inc     hl
        ld      a,(hl)
        cp      "J"
        jr      nz,popsimp
        inc     hl
        ld      a,(hl)
        cp      "H"
        jr      nz,popsimp
        inc     hl
        ld      a,(hl)
        inc     hl
        cp      0
        jr      nz,popsimp
;
;just found MJH(0) - skipped it.
;
        pop     af        ;waste the stored HL
        dec     de
        jr      uploop

popsimp:
        pop     hl
reallysimp:
        ld      (de),a
        inc     hl        ;step source
        inc     de        ;step destn
chkend:
        push    hl        ;save source
        ld      hl,#a000  ;last byte
        xor     a
        sbc     hl,de     ;has destn reached the end yet
        pop     hl        ;recover source
        jr      nc,uploop
        ld      hl,#6000
        ld      de,#2000
        ld      bc,#2000
        ldir              ;move half below switched memory area
        ld      a,(membank)
        call    #bd5b     ;switch in destn memory bank @4000..8000
        ld      hl,#2000
        ld      de,#4000
        ld      bc,#2000
        ldir              ;move lower half in place
        ld      hl,#8000
        ld      de,#6000
        ld      bc,#2000
        ldir              ;mover upper half in place
        ret

        list
membank:
        defb    0


        end
KL SCAN NEEDED which are only present