AuroraMSX found this small package in the deep dark dungeons of his mailbox. It contains a color fade routine for GraphSaurus PLx palettes to be used in BASIC. Source code and an example is included, so give it a spin!

AttachmentSizeDownloadsLast download
color-fade.zip17.82 KB2142 days 22 hours ago

Comments (6)

By AuroraMSX

Paragon (1902)

AuroraMSX's picture

29-01-2016, 12:24

Ah, forgot to tell that it also shows:
- how to load a file in DOS1
- how to install a USR routine from ASM
- how to handle USR() parameters of different types (USR0(0), USR0(1) or USR0("FILENAMEEXT"))
So it has some educational value as well Hannibal

By KdL

Paragon (1485)

KdL's picture

29-01-2016, 21:44

thanx for sharing!! Smile

; palette fader - AuroraMSX - 2005
; --------------------------------
; Coded in TeddyWareZ' Chaos Assembler 3
; --------------------------------------
;
; defines USR0("FILENAMEEXT") to load a target palette
;         USR0(0)             to fade out to black
;         USR0(1)             to fade in to the target palette
;
; Notice that the filename string must be exactly 11 characters long
; and does not contain a '.' between the filename and file extension.
; Shorter filenames or file extension must be padded with spaces to
; fit 8 characters for the file name and 3 for the extension.
;
; So: to load palette file "GRAPHICS.PL5" use USR0("GRAPHICSPL5")
;     to load palette file "GFX.PL"       use USR0("GFX     PL ")
;     Using some weird text like USR0("A B C D E F") will probably
;     burn your MSX ^_^
;
; Also, it is not possible to specify a drive - the file will be read
; from the currently active drive!
;
; /me is lazy programmer - shoot me ^_^


USRTAB  .equ    $F39A           ; System vars for handling USR()
DAC     .equ    $F7F6
VALTYP  .equ    $F663

CINT    .equ    $2F8A           ; BASIC CINT() - convert DAC to integer

BDOS    .equ    $F37D           ; BDOS routines
OPEN    .equ    $0F
CLOSE   .equ    $10
RBLKRD  .equ    $27
SETDTA  .equ    $1A

ERROR   .equ    $406F           ; BASIC error routine, code in E
EFNAME  .equ    56              ; "Bad file name"  -> filename incorrect
ENTFND  .equ    53              ; "File not found" -> obvious :-)
EDSKIO  .equ    69              ; "Disk I/O error" -> couldn't read data

; BLOAD header
        .org    $C000-7

        .db     $FE
        .dw     _start
        .dw     _end
        .dw     _exec
        
_start:

; -- data -----------------------------
speed:
        .db     1               ; nr of ints to wait after a palette update
palette:
        .ds     16*2            ; the current palette
target:
        .ds     16*2            ; the target palette for fade-in
fcb:
        .ds     40              ; FCB
        
; -- execute --------------------------
; set up DEFUSR0() and return to BASIC
_exec:
        ld      hl,usr0
        ld      (USRTAB),hl
        ret

; -- entry for USR0() -----------------
; Check type and value of argument
usr0:
;       ld      a,(VALTYP)      ; check argument type
        cp      3               ; is string?
        jp      z,loadplt       ;   Y -> load palet [USR("FILENAMEEXT")]
        call    CINT            ; convert to integer
        ld      a,h             ; is 0?
        or      l
        jr      z,fadout        ;   Y -> fade out   [USR(0)]

; -- fade in --------------------------
fadin:                          ; fade in           [USR(1)]
        ld      c,8             ; max 8 steps
finlp:
        ld      b,32            ; 32 bytes in a palette
        ld      hl,palette
        push    hl
        ld      hl,target
finlp2:
        ld      e,(hl)          ; target value
        inc     hl
        ex      (sp),hl
        ld      a,(hl)
        call    dofade
        ld      (hl),a
        inc     hl
        ex      (sp),hl
        djnz    finlp2
        
        pop     hl
        ld      hl,palette
        call    setplt          ; set new palette
        dec     c               ; repeat until ready
        jr      nz,finlp
        jp      retbas
        
; -- fade out -------------------------
fadout:
        ld      c,8             ; max 8 steps
foutlp:
        ld      b,32            ; 32 bytes in a palette
        ld      hl,palette
foutlp2:                        ; fade out
        ld      e,0             ; calculate new palette
        ld      a,(hl)
        call    dofade
        ld      (hl),a
        inc     hl
        djnz    foutlp2

        ld      hl,palette
        call    setplt          ; set the new palette
        dec     c               ; repeat until completely faded out
        jr      nz,foutlp
        jp      retbas          ; back to BASIC
        
; -- do fade --------------------------
; fade A one step towards E
dofade:
        ld      d,a
        push    de
        
        ld      a,e             ; first, fade high nibble
        and     $F0
        ld      e,a
        ld      a,d
        and     $F0
        cp      e
        jr      z,fdhiok        ; .equal? -> nothing to do
        jr      c,inchi         ; Carry?
        sub     $10             ; not set -> E < A -> decrease A
        jr      fdhiok
inchi:  add     a,$10           ; set -> E > A -> increase A
fdhiok:
        ld      (tmp),a         ; save intermediate result

        pop     de              ; get old values

        ld      a,e             ; fade low nibble
        and     $0F
        ld      e,a
        ld      a,d
        and     $0F
        cp      e
        jr      z,fdlook        ; .equal? -> nothing to do
        jr      c,inclo         ; Carry? 
        dec     a               ; not set -> E < A -> decrease A
        jr      fdlook
inclo:  inc     a               ; set -> E > A -> increase A
fdlook:
        push    hl
        ld      hl,tmp
        or      (hl)            ; include high nibble
        pop     hl
        ret                     ; done

tmp:    .ds     1

; -- set palette ----------------------
setplt:
        push    bc              ; save BC
        
        di                      ; output data to palette port
        ld      c,$99
        xor     a
        out     (c),a
        ld      a,$90
        out     (c),a
        inc     c
        ld      b,32
        otir                    ; output new palette

        ld      a,(speed)       ; wait a while?
        or      a
        jr      z,nowait
        
        ld      b,a
waitlp:
        ei
        halt
        djnz    waitlp

nowait:
        pop     bc              ; restore BC
        ret

; -- load palet -----------------------
loadplt:
        ex      de,hl
        ld      a,(hl)          ; get string length
        cp      11              ; 8+3?
        ld      e,EFNAME        ; Illegal filename...
        jp      nz,ERROR        ; output error if filename is not 11 chars

        inc     hl              ; let HL point to string start
        ld      a,(hl)
        inc     hl
        ld      h,(hl)
        ld      l,a
        
        ld      de,fcb          ; set up FCB
        xor     a               ; - default drive
        ld      (de),a
        inc     de
        ld      bc,11           ; - file name and extension
        ldir
        ld      (de),a          ; - clear the rest
        ld      h,d
        ld      l,e
        inc     de
        ld      bc,23
        ldir
        
        ld      de,target       ; set DTA
        ld      c,SETDTA
        call    BDOS            ; we'll just assume that this can't fail :-)

        ld      de,fcb          ; open file
        ld      c,OPEN
        call    BDOS
        ld      e,ENTFND
        or      a
        jp      nz,ERROR
        ld      hl,0
        ld      (fcb+12),hl     ; clear record stuff
        ld      (fcb+33),hl
        ld      (fcb+35),hl
        inc     hl              ; set record size
        ld      (fcb+14),hl
        
        ld      de,fcb          ; load 32 bytes from opened file
        ld      hl,32
        ld      c,RBLKRD
        call    BDOS
        ld      e,EDSKIO
        or      a
        jp      nz,ERROR

        xor     a               ; close file
        ld      de,fcb
        ld      c,CLOSE
        call    BDOS            ; assume this will not fail

; -- return to BASIC ------------------
retbas:
        ld      a,2             ; INT type
        ld      (VALTYP),a
        ld      de,0            ; return value is 0
        ld      (DAC+2),de
        ld      hl,DAC          ; hl points to DAC
        ret                     ; fun is over
_end:
        nop

.end

By AuroraMSX

Paragon (1902)

AuroraMSX's picture

29-01-2016, 22:33

You're welcome. But if you quote the source code then please don't add nonsense like

; Coded in TeddyWareZ' Chaos Assembler 3
; --------------------------------------

coz that is just not true. I've never used that tool Running Naked in a Field of Flowers

By KdL

Paragon (1485)

KdL's picture

30-01-2016, 15:04

Hi! ...but it is so!! Wink
This is an adaption of source code for the Chaos Assembler 3
Pls, check the differences Smile Smile

By snout

Ascended (15187)

snout's picture

30-01-2016, 16:35

I guess you adapted it' KdL? Would you mind me adding a line 'adapted for Chaos Assembler by Kdl' or smth to you comment?

By KdL

Paragon (1485)

KdL's picture

30-01-2016, 23:39

yes. you can add Smile
thanx!