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