* GREY GROB ENCODER, RANDY DING, 11/1993
* TAKES A 3,7,11 FRAME GREY GROB
* GIVES BACK AN ENCODED GREY GROB OF 2,3,4 FRAMES RESPECTIVELY
* 2 FRAME ENCODED GREY GROB IS 2_1 ENCODED, 2 IS FIRST FRAME 1 IS SECOND
* 3 FRAME, 4_2_1 ENCODED
* 4 FRAME, 4_4_2_1 ENCODED, NOTE FIRST TWO FRAMES HAVE EQUAL WEIGHT (4)
*     FOR A MAX OF 11 SHADES IN THIS CASE

ASSEMBLE
           NIBASC  /HPHP48-E/
RPL

::
 CK1NOLASTWD
 CK&DISPATCH1 TWELVE           ( *grob object* )
 ::
  SKIP
  $ "v1.0 11/93 R Ding"
  CKREF
  DUPGROBDIM                   ( *must be 131 x 64*n grob* )
  BINT_131d #<> SWAP
  SIXTYFOUR                    ( *calculate number of frames* )
  #/                           ( *grobYsize / 64 -> remain, quotient* )
  SWAP
  #0<>                         ( *if remainder <> 0 then bad* )
  ROT OR
  OVER THREE #<>               ( *bad if not 3,7 or 11 frames* )
  3PICK SEVEN #<>
  AND 3PICK ELEVEN #<>
  AND OR
  case DROP                    ( *drop size and skip code if bad* )
  CODE
           GOSBVL  =POP#       pop number of frames from RPL stack
           R1=A.F  A           save number of frames
           GOSBVL  =SAVPTR     save registers
           P=      0
           A=DAT1  A           D1 -> grob object now on top of stack
           C=0     A
           LC(2)   20          skip 20 nib prolog
           A=A+C   A
           R0=A.F  A           save pointer to data grob first line
           ?ABIT=0 0           even address?
           GOYES   :EVEN       skip if grob data is allready byte alligned

           LC(1)   #C          1100b, [disp on: b3] & [offset: b2 b1 b0]
           D0=(5)  #00100      display bit offset address
           DAT0=C  1           shift display left 4 pixels
           D0=(2)  #25         line byte offset addr, nibs skipped per line
           LC(3)   #FFE        signed number with bit 0 ignored
           DAT0=C  X           make byte offset = -2 nibs (1 byte)

:EVEN      D0=(5)  #128        display line counter addr
           D1=(5)  #120        display start addr
           LC(2)   63
           DAT0=C  B           make line counter 63
           C=R0.F  A           copy address of data grob to display address
           DAT1=C  A

* count up number of times each pixel is on in all the frames
* works on one nibble at a time
* counters are in Breg, nib 0 for bit 0 ... nib 3 for bit 3

           LA(5)   64*34-1     size of one 131x64 grob in nibs -1
           R2=A.F  A           init nibble counter, also offset into grob
:NIBLOOP   C=R1.F  B           # frames
           C=C-1   B
           D=C     B           frame counter
           B=0     A           clear bit counters
           A=R0.F  A           -> data
           C=R2.F  A
           A=A+C   A
           D0=A                -> nib
           LC(5)   64*34
:FRAMELOOP A=DAT0  1
:BITLOOP   SB=0
           ASRB.F  B
           ?SB=0
           GOYES   :NOINC
           B=B+1   P
:NOINC     P=P+1
           ?P#     4
           GOYES   :BITLOOP
           P=      0
           AD0EX               advance pointer to next frame
           A=A+C   A
           D0=A
           D=D-1   B           decr frame counter
           GONC    :FRAMELOOP

* copy bit 3 of each counter over to bit 2
* this is for 4_4_2_1 encoding when given an 11 frame grey grob
* does nothing when encoding 3 or 7 frame because bit 3 is always 0, ie <=7

           LA(5)   #8888
           A=A&B   A
           ASRB.F  A
           C=A     A
           B=B!C   A

* step 2 of encoding, The Bit Twiddling!
* takes the bits from the counter in Breg and does this....
* Breg = abcd efgh ijkl mnop --> Dreg = dhlp cgko bfjn aeim

           LC(2)   3           decode 4 bits, counts thru 0
:DECODELUP RSTK=C              keep counter on cpu return stack
           DSL     A           shift and make room for new decode
           A=B     A           read counters in B
           LC(5)   #1111       mask off unwanted bits
           C=C&A   A
           A=C     A
:DEC1LOOP  ASR     A           shift right 3 bits and OR together
           ?A=0    A           done yet?
           GOYES   :DEC1LUP1
           A=A+A   A
           C=C!A   A
           GOTO    :DEC1LOOP
:DEC1LUP1  D=C     P
           BSRB.F  A           setup to work on next bit of counter
           C=RSTK
           C=C-1   B
           GONC    :DECODELUP

* last step, overwrite the nibs in Dreg into the top frames of the grob
* back where they were read from.  The unused lower frames will be
* hacked off at the end in sysrpl by subgrob.

           A=R0.F  A           -> data
           C=R2.F  A           offset into grob
           A=A+C   A
           D0=A                -> nib
           LA(5)   64*34
           B=A     A           size of a grob in nibs for incrimenting
           A=R1.F  B           number of frames to write into
           LC(2)   11
           ?A#C    B
           GOYES   :NOT11
           P=      3           have 4 frames to write
           GOTO    :DROP0NIBS  don't drop any, will be writing all 4 nibs
:NOT11     LC(2)   7
           ?A#C    B
           GOYES   :NOT7
           P=      2           have only 3 frames to write
           GOTO    :DROP1NIBS
:NOT7      P=      1           have only 2 frames to write
           DSR     A           drop 2 nibs
:DROP1NIBS DSR     A
:DROP0NIBS C=D     A
:WRITENIB  DAT0=C  1
           AD0EX
           A=A+B   A           incr to next frame for writing next nib
           D0=A
           CSR     A
           P=P-1
           GONC    :WRITENIB
           P=      0

* this completes processing of 1 nib, now have to repeat for all nibs.

           A=R2.F  A           dec nibble counter
           A=A-1   A
           R2=A.F  A
           GOC     :EXIT
           GOTO    :NIBLOOP    repeat until last nibble is encoded

* reset display stuff and cleanup before exiting.

:EXIT      D0=(5)  #128        display line counter addr
           D1=(5)  #120        display start addr
           LA(2)   63-8        assuming menu row was originally on, no scroll
           DAT0=A  B           reset line counter
           GOSBVL  =D0->Row1   get --> original display address, no scroll
           AD0EX
           DAT1=A  A           reset display address
           ?ABIT=0 0           check for even address, this should be norm
           GOYES   :EXITEVEN
           LA(1)   #C          1100b, [disp on: b3] & [offset: b2 b1 b0]
           LC(3)   #FFE        signed number with bit 0 ignored
           GOTO    :EXIT01
:EXITEVEN  LA(1)   #8
           LC(3)   #0
:EXIT01    D1=(2)  #0          reset bit offset
           DAT1=A  1
           D1=(2)  #25         reset line byte offset
           DAT1=C  X
           A=R1.F  A           put back # of frames on stack
           GOVLNG  =PUSH#ALOOP
  ENDCODE
  #5+ SIXTEEN #*               ( *hack off unused frames from bottom* )
  BINT_131d SWAP
  ZEROZERO 2SWAP
  SUBGROB
 ;
;