***************************************************************************** * * * 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: this is a special-version to use with MAXON-Pascal * * the arguments will be removed, the return-value (word) * * is at the top of the stack * * * * 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 * * * ***************************************************************************** GLOBAL 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.s 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.s 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.s stat_6 move.w D2,D0 ;remember position move.w 0(A1,D2.w),D1 ;...and the quantity beq.s stat_7 ;number=0 => exit loop stat_6: subq.w #2,D2 ;next counter bpl.s 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.s stat_9 move.w D2,D0 move.w 0(A1,D2.w),D1 beq.s stat_a stat_9: subq.w #2,D2 bpl.s 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.s h_pack ;pack horizontal move.w D0,D7 ;remember length (horiz.) bsr.s v_pack ;pack vertical cmp.w D7,D0 ;vertical smaller? bls.s check ;yes -> everything ok bsr.s h_pack ;no -> pack again horizontal check: cmpi.w #32000,D0 ;is the packed picture really blo.s 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 movea.l (SP)+,A0 ;return-adress addq.l #8,SP ;skip arguments move.w D0,(SP) ;store return-value jmp (A0) ;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.s emit ;write code and terminate cmpi.w #255,D1 ;max. seq.-length? beq.s h_pack_3 ;write code and start new sequence cmp.b 0(A0,D6.w),D2 ;next source-byte <> seq.byte? bne.s h_pack_3 ;write code and start new sequence addq.w #1,D1 ;increment length bra.s h_pack_2 ;and read next... h_pack_3: bsr.s emit ;store sequence bra.s 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.s v_pack_3 ;no subi.w #31999,D6 ;else start new column cmpi.w #80,D6 ;everything done? beq.s emit ;write code and terminate v_pack_3: cmpi.w #255,D1 ;max. length of sequence? beq.s v_pack_4 ;write code and start new sequence cmp.b 0(A0,D6.w),D2 ;next source-byte <> seq.byte? bne.s v_pack_4 ;write code and start new sequence addq.w #1,D1 ;increment length bra.s v_pack_2 ;and read next... v_pack_4: bsr.s emit ;write code bra.s 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.s emit_2 ;then code cmp.b D2,D4 ;seq.byte = ID-Byte ? beq.s emit_3 ;then code anyway cmp.b D2,D5 ;seq.byte = SPEC-Byte ? beq.s 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.s 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