Mercurial > hg > Members > kono > nitros9-code

view 3rdparty/utils/view/view_pals.a @ 3210:6353bb024571

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Created makefile and defsfile for NoCan RAMMER module driver and descriptor Updated rammer.asm in the NoCan driver folder to build the NoCan version of the Driver Updated r0.asm file to create the 6MB version of the descriptor. The makefile creates a disk image with two sets of the required drivers for the 6309 and 6809's in their respective module folders. /NITROS9/6309_L2/MODULES/RBF for the 6309 files and /NITROS9/6809_L2/MODULES/RBF for the 6809 files. This will make it easier for doing a dsave from this disk image into a normal distro disk image so people have these drivers ready for when new memory upgrades allow compatible usage of the NoCan registers.
author David Ladd <drencor-xeen@users.sourceforge.net>
date Wed, 20 Dec 2017 15:15:49 -0600
parents 37fd74e6fad8
children
line wrap: on
line source

*
* Palette operations:
*
*    palconv:  16 3-byte palette specs (R, G, B for each color)
*              is converted into CoCo format palette info.
*    palscale: 16 3-byte palette specs are scaled so largest coordinate
*              is 255.
*    setpals:  Set palettes from data in "palette" global buffer
*    docycle:  Cycle palettes
*    dorotate: Rotate through one palette slot
*    cmpconv:  Convert "palette" buffer from Composite color to RGB color
*
  ifp1
  use os9defs.d
  endc

StdOut equ 1

  psect view_pals_a,0,0,0,0,0

scaletable
  fcb $00,$ff,$80,$55
  fcb $40,$33,$2b,$24
  fcb $20,$1c,$1a,$17
  fcb $15,$14,$12,$11

palscale:
 pshs a,b,x,y,u
palscale1
 bsr  findmax   First, rotate down so largest is <16
 cmpa #15
 bls  palscale2
 bsr  divide
 bra  palscale1
palscale2

 leax scaletable,pcr  Get multiplier for scaling.
 ldb  a,x
 pshs b

 leax palette,y     Now scale each 4-bit palette value to 8 bits.
 ldb  #48           The chosen multiplier should make the highest
 pshs b                   palette value be 255 (or at least close).
palscale3
 ldb  ,x
 lda  1,s
 mul
 cmpd #$100    Truncate to $ff.
 blo  palscale4
 ldb  #$ff
palscale4
 stb  ,x+
 dec  ,s
 bne  palscale3
 puls d          Clean up stack.
 puls a,b,x,y,u,pc

* Divide each palette coordinate by 2
divide
 pshs b,x
 leax palette,y
 ldb  #48
divide1
 lda  ,x
 lsra
 sta  ,x+
 decb
 bne  divide1
 puls b,x,pc

* Return largest palette coordinate in A.
findmax
 pshs b,x
 leax palette,y
 ldb  #48
 clra
findmax1
 cmpa ,x+
 bhs  findmax2
 lda  -1,x
findmax2
 decb
 bne  findmax1
 puls b,x,pc

palconv:
  pshs a,b,x,u,y
  leax palette,y
  leau pctable,pcr
  leay palette,y
  ldb  #16  Number of bytes to deal with
palconvloop
  clra
  bsr  pcsub  Add one color component into A.
  bsr  pcsub
  bsr  pcsub
  sta  ,y+
  decb
  bne  palconvloop
  puls a,b,x,u,y,pc
pctable
  fcb 0,1,8,9

pcsub
  pshs b
  pshs a
  clrb
  pshs b
  ldb  ,x+
  clra
pcsloop
  cmpd #42
  ble  pcsend
  inc  ,s
  subd #85
  bra  pcsloop
pcsend
  puls b
  puls a
  lsla
  ora  b,u
  puls b,pc

*
* Set up palette registers
*
setpals:
 pshs x
 leax palette,y
 bsr  setpal
 puls x,pc

 vsect dp
currot rmb 1
 endsect

 vsect
setpCom rmb 64  Space for 16 Set Palette commands.
curpals rmb 16
 endsect

setpal
 pshs a,b,x,y,u
 leau curpals,y
 leay setpCom,y
 pshs y
 clrb
setloop
 lda  #$1b
 sta  ,y+  Set palette command is $1b $31 <pal#> <value>
 lda  #$31
 sta  ,y+
 stb  ,y+  Put palette number in.
 lda  ,x+  Get palette value.
 sta  ,u+  Copy it to curpals storage.
 sta  ,y+  Put palette value in.
 incb
 cmpb #16
 bne setloop
 puls x        Pull address of command string.
 lda  <outpath
 ldy  #64
 OS9  I$Write
 lbcs _error
 puls a,b,x,y,u,pc

*
* Rotate palletes down, from cyclestart to cycleend
*

docycle:
 pshs  a,b,x
 leax  curpals,y
 ldb   <cycleend
 cmpb  <cyclestart
 bls   rollcycle     Unreasonable limits?  If so, end.
 leax  b,x
 lda   ,x
 pshs  a
rollloop
 lda   ,-x
 sta   1,x
 decb
 cmpb  <cyclestart
 bne   rollloop
 puls  a
 sta   ,x
 leax  curpals,y
 bsr   setpal
rollcycle
 puls  a,b,x,pc

 vsect
onepal fcb $1b,$31,0,0
 endsect

dorotate:
 pshs  a,b,x,y,u
 leax  onepal,y
 ldb   <extranum    If no extra pals to rotate, don't
 beq   dorotend
 ldb   currot       Get current rotation value.
 incb
 cmpb  <extranum    Should we wrap?
 blo   dorot
 clrb               Yes, wrap to zero.
dorot
 stb   currot

 leau  extrapals,y  Get new palette value.
 lda   b,u

 ldb   <extraslot   Set up palette command.
 stb   2,x          Store palette number
 sta   3,x          Store color

 leau  curpals,y    Store it into correct palette slot.
 sta   b,u

 ldy   #4
 lda   <outpath
 os9   I$Write 
 lbcs  _error
dorotend
 puls a,b,x,y,u,pc

cmpconv:
 pshs a,b,x,u
 leax palette,y
 leau cmptable,pcr
 ldb  #16
cmploop
 lda  ,x
 lda  a,u
 sta  ,x+
 decb
 bne  cmploop
 puls a,b,x,u,pc

cmptable
 fcb 00,02,02,06,00,04,33,32   From Greg Law.
 fcb 32,45,05,09,13,08,01,00
 fcb 07,16,18,21,20,34,38,36
 fcb 37,44,40,42,11,15,10,27
 fcb 56,23,19,49,48,55,38,39
 fcb 37,46,47,41,11,25,24,26
 fcb 58,63,50,51,62,52,53,60
 fcb 60,46,61,61,57,59,58,63

 endsect