*****************************************************************************
*                                                                           *
* Ass-Subroutine to convert a 32k-picture (screenformat) to a packed        *
* STAD-format.                                                              *
*                                                                           *
* params:   (sp) LONG  return-adress                                        *
*          4(sp) LONG  source-adress (32k buffer)                           *
*          8(sp) LONG  dest-adress of STAD-pic (33k buffer)                 *
*                                                                           *
* returns:   do  WORD  length of packed STAD-picture                        *
*                                                                           *
* important: the two adresses are not removed from the stack (like trap)    *
*                                                                           *
* History:                                                                  *
* Version 1.0   01.06.1991  Wolfgang Ley                                    *
*                           - first version                                 *
* Version 1.1   03.06.1991  Wolfgang Ley                                    *
*                           - saving registers                              *
*                           - improved statistics                           *
*                           - no extra statistics-buffer anymore            *
* Version 1.2   05.06.1991  Wolfgang Ley                                    *
*                           - extra counter in v_pack removed               *
* Version 1.3   25.06.1992  Jens Dittmer                                    *
*                           - bug in h_pack removed (header)                *
* Version 1.4   29.06.1992  Jens Dittmer                                    *
*                           - algorithm improved -> much smaller code       *
* Version 1.5   01.07.1992  Jens Dittmer                                    *
*                           - improved statistics                           *
* Version 1.5b  11.07.1992  Wolfgang Ley                                    *
*                           - extra rts removed                             *
*                                                                           *
*****************************************************************************

                GLOBL tostad

                TEXT

tostad:         movem.l D1-A1,-(SP)     ;save registers

                movea.l 40(SP),A0       ;adress of 32k-picture
                movea.l 44(SP),A1       ;adress of packes STAD-picture

;----------------------------------------------------------------------------
; make some staticts (get most frequently used and the two less used bytes)
; --> choose PACK-/ID-/SPECIAL-byte
;----------------------------------------------------------------------------

                move.w  #511,D0         ;index-register
stat_1:         clr.b   0(A1,D0.w)      ;clear byte-counters
                dbra    D0,stat_1

                move.w  #31999,D0       ;pointer within the picture
stat_2:         move.b  0(A0,D0.w),D1   ;get byte
                add.w   D1,D1           ;double it
                andi.w  #$01FF,D1       ;clear the rest
                addq.w  #1,0(A1,D1.w)   ;and count byte
                dbra    D0,stat_2       ;and so on...

                move.w  #510,D0         ;most frequently used byte till now
                move.w  0(A1,D0.w),D1   ;get quantity
                move.w  #508,D2         ;counter to the rest
stat_3:         cmp.w   0(A1,D2.w),D1   ;compare
                bhs.b   stat_4
                move.w  D2,D0           ;remember position
                move.w  0(A1,D2.w),D1   ;and remember the quantity
stat_4:         subq.w  #2,D2           ;next entry
                bpl.b   stat_3          ;and again...
                lsr.w   #1,D0           ;that's the PACK-byte
                move.b  D0,D3           ;PACK-byte to D3

                move.w  #510,D0         ;less used byte till now
                move.w  0(A1,D0.w),D1   ;get quantity
                move.w  #508,D2         ;counter to the rest
stat_5:         cmp.w   0(A1,D2.w),D1   ;compare
                blo.b   stat_6
                move.w  D2,D0           ;remember position
                move.w  0(A1,D2.w),D1   ;...and the quantity
                beq.b   stat_7          ;number=0 => exit loop
stat_6:         subq.w  #2,D2           ;next counter
                bpl.b   stat_5          ;and continue...
stat_7:         move.w  #32001,0(A1,D0.w) ;"clear" entry
                lsr.w   #1,D0           ;that's the ID-bByte
                move.b  D0,D4           ;ID-byte to D4

                move.w  #510,D0         ;like above...
                move.w  0(A1,D0.w),D1
                move.w  #508,D2         
stat_8:         cmp.w   0(A1,D2.w),D1
                blo.b   stat_9
                move.w  D2,D0
                move.w  0(A1,D2.w),D1
                beq.b   stat_a
stat_9:         subq.w  #2,D2
                bpl.b   stat_8
stat_a:         lsr.w   #1,D0           ;that's the SPEC-byte
                move.b  D0,D5           ;SPEC-Byte to D5

;----------------------------------------------------------------------------
; pack horizontal and vertical, use smaller one as STAD-picture
; (validate if the compressed picture is really smaller - if not, use the
;  uncompressed picture)
;----------------------------------------------------------------------------

                clr.w   D0              ;clear offset
                move.b  #'p',0(A1,D0.w) ;write header #'pM85'
                move.b  #'M',1(A1,D0.w) ;(bytes, because address may be odd)
                move.b  #'8',2(A1,D0.w) ;'5' or '6' is appended at packing
                move.b  D4,4(A1,D0.w)   ;write ID-Byte
                move.b  D3,5(A1,D0.w)   ;write PACK-Byte
                move.b  D5,6(A1,D0.w)   ;write SPEC-Byte

                bsr.b   h_pack          ;pack horizontal
                move.w  D0,D7           ;remember length (horiz.)
                bsr.b   v_pack          ;pack vertical
                cmp.w   D7,D0           ;vertical smaller?
                bls.b   check           ;yes -> everything ok
                bsr.b   h_pack          ;no  -> pack again horizontal
check:          cmpi.w  #32000,D0       ;is the packed picture really
                blo.b   exit            ;smaller?
                move.w  #31999,D0       ;if not, copy original 32k-pic
copy:           move.b  (A0)+,(A1)+    
                dbra    D0,copy
                move.w  #32000,D0       ;length is 32000 bytes
exit:           movem.l (SP)+,D1-A1     ;restore registers
                rts                     ;that's it

;----------------------------------------------------------------------------
; horizontal compress
;----------------------------------------------------------------------------

h_pack:         clr.w   D6              ;source-index
                moveq   #7,D0           ;length of header
                move.b  #'5',3(A1,D6.w)
h_pack_1:       clr.w   D1              ;sequence-length 0
                move.b  0(A0,D6.w),D2   ;read byte
h_pack_2:       addq.w  #1,D6           ;next column
                cmpi.w  #32000,D6       ;ready?
                beq.b   emit            ;write code and terminate
                cmpi.w  #255,D1         ;max. seq.-length?
                beq.b   h_pack_3        ;write code and start new sequence
                cmp.b   0(A0,D6.w),D2   ;next source-byte <> seq.byte?
                bne.b   h_pack_3        ;write code and start new sequence
                addq.w  #1,D1           ;increment length
                bra.b   h_pack_2        ;and read next...
h_pack_3:       bsr.b   emit            ;store sequence
                bra.b   h_pack_1        ;and start new sequence

;----------------------------------------------------------------------------
; vertical compress
;----------------------------------------------------------------------------

v_pack:         clr.w   D6              ;source-byte index
                moveq   #7,D0           ;length of header
                move.b  #'6',3(A1,D6.w)
v_pack_1:       clr.w   D1              ;clear length of sequence
                move.b  0(A0,D6.w),D2   ;read byte
v_pack_2:       addi.w  #80,D6          ;next row
                cmpi.w  #32000,D6       ;row complete?
                blo.b   v_pack_3        ;no
                subi.w  #31999,D6       ;else start new column
                cmpi.w  #80,D6          ;everything done?
                beq.b   emit            ;write code and terminate
v_pack_3:       cmpi.w  #255,D1         ;max. length of sequence?
                beq.b   v_pack_4        ;write code and start new sequence
                cmp.b   0(A0,D6.w),D2   ;next source-byte <> seq.byte?
                bne.b   v_pack_4        ;write code and start new sequence
                addq.w  #1,D1           ;increment length
                bra.b   v_pack_2        ;and read next...
v_pack_4:       bsr.b   emit            ;write code
                bra.b   v_pack_1        ;start new sequence

;----------------------------------------------------------------------------
; write recognized byte-sequence
; params:    D1 = length of sequence
;            D2 = byte of sequence
;----------------------------------------------------------------------------

emit:           cmpi.b  #1,D1           ;length > 1 ?
                bhi.b   emit_2          ;then code
                cmp.b   D2,D4           ;seq.byte = ID-Byte ?
                beq.b   emit_3          ;then code anyway
                cmp.b   D2,D5           ;seq.byte = SPEC-Byte ?
                beq.b   emit_3          ;then code anyway
emit_1:         move.b  D2,0(A1,D0.w)   ;write byte "as is"
                addq.w  #1,D0           ;1 byte written
                dbra    D1,emit_1       ;maybe one more byte...
                rts
emit_2:         cmp.b   D2,D3           ;pack PACK-byte?
                bne.b   emit_3          ;no
                move.b  D4,0(A1,D0.w)   ;write ID-byte
                move.b  D1,1(A1,D0.w)   ;and write seq.length
                addq.w  #2,D0           ;2 bytes written
                rts
emit_3:         move.b  D5,0(A1,D0.w)   ;write SPEC-byte
                move.b  D2,1(A1,D0.w)   ;write seq.byte
                move.b  D1,2(A1,D0.w)   ;write seq.length
                addq.w  #3,D0           ;3 bytes written
                rts


                END
