;--------------------------------------------------------------------------- :Program. Assembler - Sources for CPicSupport.mod :Contents. Assembler Procedures to decrunch and draw pictures in the :Contents. CPic - Format. :Author. Thomas Zipproth :Address. Dr. Jochner Weg 10, 8948 Mindelheim, Germany :Phone. 08261/4838 :Copyright. Shareware (refer to CPic.doc) :Language. 68000-Assembler :Translator. DevPac :History. V1.0 [thz] 10.5.90 :History V1.1 [thz] 12.8.90 Added Crunch - procedure in Assembler ;--------------------------------------------------------------------------- PROCEDURE RectToString(a{8},b{9} : ADDRESS; c{0},d{1},e{2} : LONGINT); SUBQ.L #1,D0 A0 : Address of Byte - String (Destination) SUBQ.L #1,D1 A1 : Address of left upper Byte of the lab1: MOVE.L D1,D3 Rectangle in the Bitplane (Source) MOVE.L A1,A2 D0 : Width of CPic in Byte (ci.PicX) lab2: MOVE.B (A2),(A0)+ D1 : Height of CPic in Pixel (ci.PicY) ADDA.L D2,A2 D2 : Height of Screen (ci.Height) DBRA D3,lab2 Changes a rectangle in a Bitmap in a ADDQ.L #1,A1 sequence of bytes, starting in left upper DBRA D0,lab1 corner (byte) of the rectangle first from RTS up to down, then from left to right. PROCEDURE StringToRect(a{8},b{9} : ADDRESS; c{0},d{1},e{2} : LONGINT); SUBQ.L #1,D0 exactly the same as RectToString with SUBQ.L #1,D1 other direction. (Source and destination lab1: MOVE.L D1,D3 have changed). MOVE.L A1,A2 lab2: MOVE.B (A0)+,(A2) <- Here is the only difference ADDA.L D2,A2 DBRA D3,lab2 ADDQ.L #1,A1 DBRA D0,lab1 RTS PROCEDURE SetRect(b{9} : ADDRESS; c{0},d{1},e{2} : LONGINT; f{3} : UByte); SUBQ.L #1,D0 SUBQ.L #1,D1 A1 : Address of left upper Byte of the lab1: MOVE.L D1,D4 rectangle in the bitplane (Destination) MOVE.L A1,A2 D0 : Width of CPic in Byte (ci.PicX) lab2: MOVE.B D3,(A2) D1 : Height of CPic in Pixel (ci.PicY) ADDA.L D2,A2 D2 : Height of Screen (ci.Height) DBRA D4,lab2 ADDQ.L #1,A1 all bytes in the rectangle are set to the DBRA D0,lab1 value of D3. RTS PROCEDURE Decrunch(a{8} : ADDRESS; b{9} : ADDRESS; c{0} : LONGINT) : LONGINT; MOVE.L A0,D7 Save startadress MOVE.L A1,A2 A0 Address of Source (first Byte) ADDA.L D0,A2 A1 Address of Destination (first Byte) MOVEQ #0,D1 D0 Number of decrunched (!) Bytes MOVEQ #0,D2 (= Length of decrunched Bitplane) MOVE.B #32,D3 0-31 <=> 0 - Bytes MOVE.B #128,D4 32-127 <=> uncrunched Bytes MOVE.B #160,D5 128-159 <=> 255 - Bytes MOVE.B #255,D6 160-255 <=> other crunched Bytes LOOP: MOVEQ #0,D0 MOVE.B (A0)+,D0 Read Information - Byte (unsigned 0-255) CMP.B D3,D0 Check for 0 BCC.S m1 s1: MOVE.B D2,(A1)+ Decrunch 0 - Bytes DBRA D0,s1 BRA.S End m1: CMP.B D4,D0 Check if not crunched BCC.S m2 SUB.B D3,D0 s2: MOVE.B (A0)+,(A1)+ Write not Crunched Bytes DBRA D0,s2 BRA.S End m2: CMP.B D5,D0 Check for 255 BCC.S m3 SUB.B D4,D0 s3: MOVE.B D6,(A1)+ Decrunch 255 - Bytes DBRA D0,s3 BRA.S End m3: MOVE.B (A0)+,D1 Read value of equal Bytes to decrunch SUB.B D5,D0 s4: MOVE.B D1,(A1)+ Decrunch equal Bytes (not 0 or 255) DBRA D0,s4 End: CMPA.L A1,A2 Check if length of Bitplane BGT.S LOOP reached. MOVE.L A0,D0 SUB.L D7,D0 Return number of decrunched bytes RTS PROCEDURE Crunch(S{8},D{9} : ADDRESS; l{0} : LONGINT) : LONGINT; MOVE.L A0,A6 SUBQ.L #1,D0 ADD.L D0,A6 Save Source - End MOVEA.L A1,A3 Save Dest - Start MOVEA.L A0,A2 s:=1 MOVEQ.L #1,D2 k:=1 MOVEQ.L #3,D4 (for IF k>2, IF k=3) MOVEQ.L #96,D5 MOVEQ.L #1,D6 (for IF le=1) MOVEQ.L #33,D7 (for IF k<33) TST.L D0 IF length = 1 BNE.S if1 MOVEQ.L #1,D3 BSR.S Take BRA.S fi4 if1: MOVE.B (A0)+,D1 IF S^[i]=S^[i-1] CMP.B (A0),D1 BNE.S if10 ELSE.. ADDQ.L #1,D2 THEN INC(k) CMP.L D4,D2 IF k=3 BNE.S fi3 ELSE.. MOVE.L A0,D3 THEN le:=i-s-2; SUB.L A2,D3 SUBQ.L #2,D3 IF le>0 (CMP #2,D3) BLS.S fi3 ELSE.. BSR.S Take (Take) BRA.S fi3 if10: CMP.L D4,D2 IF k>2 BCS.S fi10 ELSE.. MOVE.L A0,A2 THEN s:=i BSR.S Comp (Comp) fi10: MOVEQ.L #1,D2 k:=1; fi3: CMP.L A0,A6 BHI.S if1 REPEAT - UNTIL i>length; CMP.L D4,D2 IF k>2 BCS.S el4 ELSE.. BSR.S Comp (Comp) BRA.S fi4 el4: MOVE.L A0,D3 le:=i-s; SUB.L A2,D3 (le:=i+1-s because not INC(i)) ADDQ.L #1,D3 BSR.S Take (Take) fi4: MOVE.L A1,D0 SUB.L A3,D0 Return crunched length RTS Comp: CMP.L D5,D2 WHILE k>96 DO BLS.S C2 MOVE.B #255,(A1)+ MOVE.B D1,(A1)+ SUB.L D5,D2 BRA.S Comp END (While) C2: CMP.L D7,D2 IF k<33 BCC.S C3 TST.B D1 IF byte=0 BNE.S C4 SUBQ.L #1,D2 MOVE.B D2,(A1)+ RTS C4: CMPI.B #255,D1 IF byte=255 BNE.S C3 ADDI.B #127,D2 MOVE.B D2,(A1)+ RTS C3: ADDI.B #159,D2 MOVE.B D2,(A1)+ MOVE.B D1,(A1)+ RTS Take: CMP.L D6,D3 IF le=1 BNE.S T3 MOVE.B (A2),D0 byte=S^[s] TST.B D0 IF byte=0 BNE.S T4 CLR.B (A1)+ RTS T4: CMPI.B #255,D0 IF byte=255 BNE.S T3 MOVE.B #128,(A1)+ RTS T3: CMP.L D5,D3 WHILE le>96 DO BLS.S T2 MOVE.B #127,(A1)+ MOVEQ.L #23,D0 Copy1: MOVE.B (A2)+,(A1)+ MOVE.B (A2)+,(A1)+ MOVE.B (A2)+,(A1)+ MOVE.B (A2)+,(A1)+ DBRA D0,Copy1 SUB.L D5,D3 BRA.S T3 T2: MOVEQ.L #31,D0 ADD.B D3,D0 MOVE.B D0,(A1)+ SUBQ.B #1,D3 Copy2: MOVE.B (A2)+,(A1)+ DBRA D3,Copy2 RTS ------------------------------------------------------------------------- For people who are interested in converting time - or space critical Modula - procedures into assembler : Here is the crunch - procedure in Modula. Converting it into assembler makes it about 4 times shorter and 4 times faster. ------------------------------------------------------------------------- PROCEDURE Crunch(Source,Dest : ADDRESS; length : LONGINT) : LONGINT; VAR S,D : POINTER TO ARRAY[1..1200000] OF UByte; s,i,j,k,cp,le : LONGINT; byte : UByte; PROCEDURE Comp; BEGIN byte:=S^[i-1]; WHILE k>96 DO D^[cp]:=255; D^[cp+1]:=byte; INC(cp,2); DEC(k,96); END; IF k<33 THEN IF byte=0 THEN D^[cp]:=k-1; INC(cp); RETURN END; IF byte=255 THEN D^[cp]:=127+k; INC(cp); RETURN END; END; D^[cp]:=159+k; D^[cp+1]:=byte; INC(cp,2); END Comp; PROCEDURE Take; BEGIN IF le=1 THEN byte:=S^[s]; IF byte=0 THEN D^[cp]:=0; INC(cp); RETURN END; IF byte=255 THEN D^[cp]:=128; INC(cp); RETURN END; END; DEC(s); WHILE le>96 DO D^[cp]:=127; FOR j:=1 TO 96 DO D^[cp+j]:=S^[s+j] END; INC(cp,97); DEC(le,96); INC(s,96); END; D^[cp]:=31+le; FOR j:=1 TO le DO D^[cp+j]:=S^[s+j] END; INC(cp,le+1); END Take; BEGIN s:=1; i:=2; k:=1; cp:=1; S:=Source; D:=Dest; IF length>1 THEN REPEAT IF S^[i]=S^[i-1] THEN INC(k); IF k=3 THEN le:=i-s-2; IF le>0 THEN Take END; END; ELSE IF k>2 THEN s:=i; Comp END; k:=1; END; INC(i); UNTIL i>length; IF k>2 THEN Comp ELSE le:=i-s; Take END; RETURN cp-1; ELSE le:=1;Take; RETURN cp-1; END; END Crunch;