$A+ B- D+ E+ F- G- I+ L+ N- O- P- Q+ R+ S+ T- V- X+ Y+ $M 4096 0 655360 PROGRAM ADF_TO_XBIN_Converter (***************************************************************************** ADF to XBIN conversion program ADF2XBIN converts an ADF file to a fully compliant compressed XBIN file Compression routine is identical to the BIN2XBIN compression ADF is always 80 characters wide which makes memory management somewhat simpler compared to the BIN2XBIN utility Any SAUCE info is stripped from the ADF As such SAUCEd ADF files should properly convert to XBIN Alternate palette and Font information is copied into the XBIN as-is No checking is performed to see if the used palette and or font match the default If default font and or palette are indeed used they could be stripped out of the XBIN *****************************************************************************) USES CRT DOS STM TYPE Char2 = ARRAY 0 1 OF Char Char4 = ARRAY 0 3 OF Char Char5 = ARRAY 0 4 OF Char Char8 = ARRAY 0 7 OF Char Char20 = ARRAY 0 19 OF Char Char35 = ARRAY 0 34 OF Char Char64 = ARRAY 0 63 OF Char ================================= SAUCE ================================= Const SAUCE_ID Char5 = SAUCE CMT_ID Char5 = COMNT TYPE SAUCERec = RECORD Implemented in Version ID Char5 00 SAUCE Version Char2 00 00 Title Char35 00 Title of the file Author Char20 00 Creator of the file Group Char20 00 Group creator belongs to Date Char8 00 CCYYMMDD FileSize Longint 00 Original FileSize DataType Byte 00 Type of Data FileType Byte 00 What type of file is it TInfo1 Word 00 TInfo2 Word 00 Type Info Zone TInfo3 Word 00 TInfo4 Word 00 Comments Byte 00 Number of Comment lines Flags Byte 00* Bit flags Filler Array 1 22 of Char END ================================== XBIN ================================= CONST XB_ID Char4 = XBIN TYPE XB_Header = RECORD ID Char4 EofChar Byte Width Word Height Word FontSize Byte Flags Byte END BINChr = RECORD BIN Character Attribute pair CASE Boolean OF TRUE ( CharAttr Word ) FALSE ( Character Byte Attribute Byte ) END BINChrAry = ARRAY 0 79 OF BINChr This size is different from BIN2XBI N Conversion table for converting an EGA to VGA palette CONST STD_EGA_TO_VGA_PAL ARRAY 0 15 OF BYTE = (0 1 2 3 4 5 20 7 56 57 58 59 60 61 62 63) VAR XBHdr XB_Header SAUCE SauceRec CMT Char5 ErrCode Integer XB ADF STREAM File stream see STM unit Lines Word ADFSize Longint ADFFont ARRAY 0 4095 OF CHAR ADFPal ARRAY 0 191 OF CHAR BIN BinChrAry Counter Integer ABORT Execution and display error message PROCEDURE Abort (Str String) BEGIN WriteLn WriteLn( ADF2XBIN V1 00 Execution aborted ) WriteLn WriteLn(Str) WriteLn Halt(2) END Display command syntax and abort PROCEDURE HelpText BEGIN WriteLn( ADF2XBIN converts ADF files to XBIN ) WriteLn WriteLn( Correct Syntax ADF2XBIN ADFFILE XBINFILE ) WriteLn Halt(1) END Return size of File in Bytes or -1 if it does not exist or can t determine size FUNCTION FileExist (FName String) LongInt VAR F FILE BEGIN $i- ASSIGN(F FName) RESET(F 1) IF (IOResult=0) THEN BEGIN FileExist = FileSize(F) Return Size of file IF (IOResult 0) THEN FileExist =-1 Return -1 File not Found Close(F) END ELSE FileExist =-1 Return -1 File not Found $i+ END XBIN Compression START Introductory note The XBIN compression used here is a single step compression algorythm What this means is that we will compress the data one character attribute pair at a time letting that char attr pass through all the necessary conditions until it has been decided what has to be done with it While not being the fastest or most compact algorythm available it does make the algorythm a lot easier to understand This XBIN compression routine uses a temporary buffer (an array) to hold the current run-count and compressed data Since the maximum run-count is 64 this buffer only needs to be 129 bytes in size (1 byte for the run-count and 64 times a char attr pair when no compression is taking place The overall idea behind this routine is pretty simple here s the rough outline WHILE (Still_characters_to_process) IF (A_run_is_busy) IF (Stop_this_run_for_whatever_reason) Write_run_to_disk ENDIF ENDIF IF (Run_is_still_busy) add_current_char attr_pair_to_run ELSE start_a_new_run_with_char attr_pair ENDIF ENDWHILE IF (A_run_is_busy) Write_run_to_disk ENDIF It looks simple but implementing it effectively is tricky The most involving part will be the Stop_this_run_for_whatever_reason routine There are several reasons for wishing to stop the run 1) The current run is 64 characters wide thus another char attr pair can t be added 2) The current compression can no longer be maintained as the new char attr pair does not match 3) Aborting the run prematurely offers a possibility to restart using a better compression method Reasons 1 and 2 are easy enough to deal with the third provides the path to optimal compression The better the conditions are made for aborting in favour of a better compression method the better compression will be Enough about theory on to the actual code PROCEDURE XBIN_Compress (VAR BIN BINChrAry BIN_Width WORD) CONST NO_COMP = $00 CHAR_COMP = $40 ATTR_COMP = $80 CHARATTR_COMP = $C0 VAR CompressBuf Array 0 2*64 of Byte RunCount Word RunMode Byte RunChar BINChr CB_Index Word Index into CompressBuf BIN_Index Word Index into BIN_Line EndRun Boolean BEGIN RunCount = 0 There s no run busy BIN_Index = 0 WHILE (BIN_Index BIN_Width) DO BEGIN Still characters to process IF (RunCount 0) THEN BEGIN A run is busy EndRun = FALSE Assume we won t need to end the run IF (RunCount=64) THEN BEGIN We reached the longest possible run EndRun =TRUE Yes end the current run END ELSE BEGIN A run is currently busy Check to see if we can will continue CASE RunMode OF NO_COMP BEGIN No compression can always continue since it does not require on the character and or attribute to match its predecessor === No compression run Aborting this will only have benefit if we can start a run of at least 3 character or attribute compression OR a run of at least 2 char attr compression The required run of 3 (2) takes into account the fact that a run must be re-issued if no more than 3 (2) BIN pairs can be compressed IF (BIN_Width-BIN_Index =2) AND (BIN BIN_Index CharAttr=BIN BIN_Index+1 CharAttr) THEN BEGI N EndRun =TRUE END ELSE IF (BIN_Width-BIN_Index =3) AND (BIN BIN_Index Character=BIN BIN_Index+1 Character) AN D (BIN BIN_Index Character=BIN BIN_Index+2 Character) TH EN BEGIN EndRun =TRUE END ELSE IF (BIN_Width-BIN_Index =3) AND (BIN BIN_Index Attribute=BIN BIN_Index+1 Attribute) AN D (BIN BIN_Index Attribute=BIN BIN_Index+2 Attribute) TH EN BEGIN EndRun =TRUE END END CHAR_COMP BEGIN Character compression needs to be ended when the new character no longer matches the run-character IF (BIN BIN_Index Character RunChar Character) THEN BEGIN EndRun =TRUE END === Aborting an character compression run will only have benefit if we can start a run of at least 3 char attr pairs ELSE IF (BIN_Width-BIN_Index =3) AND (BIN BIN_Index CharAttr=BIN BIN_Index+1 CharAttr) AND (BIN BIN_Index CharAttr=BIN BIN_Index+2 CharAttr) THEN BEGIN EndRun =TRUE END END ATTR_COMP BEGIN Attribute compression needs to be ended when the new attribute no longer matches the run-attribute IF (BIN BIN_Index Attribute RunChar Attribute) THEN BEGIN EndRun =TRUE END === Aborting an attribute compression run will only have benefit if we can start a run of at least 3 char attr pairs ELSE IF (BIN_Width-BIN_Index =3) AND (BIN BIN_Index CharAttr=BIN BIN_Index+1 CharAttr) AND (BIN BIN_Index CharAttr=BIN BIN_Index+2 CharAttr) THEN BEGIN EndRun =TRUE END END CHARATTR_COMP BEGIN Character Attribute compression needs to be ended when the new char attr no longer matches the run-char attr IF (BIN BIN_Index CharAttr RunChar CharAttr) THEN BEGIN EndRun =TRUE END === Aborting a char attr compression will never yield any benefit END END CASE END IF IF EndRun THEN BEGIN CompressBuf 0 = RunMode + (RunCount-1) STM_Write(XB CompressBuf CB_Index) IF (XB LastErr STM_OK) THEN Abort( Error Writing File ) RunCount =0 Run no longer busy END IF END IF IF (RunCount 0) THEN BEGIN Run is still busy === Add new char attr to current run as appropriate for compression method in use CASE RunMode OF NO_COMP BEGIN Store Char Attr pair CompressBuf CB_Index =BIN BIN_Index Character CompressBuf CB_Index+1 =BIN BIN_Index Attribute Inc(CB_Index 2) END CHAR_COMP BEGIN Store Attribute CompressBuf CB_Index =BIN BIN_Index Attribute Inc(CB_Index) END ATTR_COMP BEGIN Store character CompressBuf CB_Index =BIN BIN_Index Character Inc(CB_Index) END CHARATTR_COMP BEGIN Nothing to change only RunCount ever changes END END END ELSE BEGIN Run not busy Start a new one CB_Index = 1 Skip index 0 (for run-count byte) IF (BIN_Width-BIN_Index =2) THEN BEGIN At least 2 more to do IF (BIN BIN_Index CharAttr=BIN BIN_Index+1 CharAttr) THEN === We can use char attr compression RunMode =CHARATTR_COMP ELSE IF (BIN BIN_Index Character=BIN BIN_Index+1 Character) THEN === We can use character compression RunMode =CHAR_COMP ELSE IF (BIN BIN_Index Attribute=BIN BIN_Index+1 Attribute) THEN === We can use attribute compression RunMode =ATTR_COMP ELSE === We can t use any compression RunMode =NO_COMP END ELSE Last character use no-compression RunMode =NO_COMP IF (RunMode=ATTR_COMP) THEN BEGIN Attr compression has Attr first !! CompressBuf CB_Index =BIN BIN_Index Attribute CompressBuf CB_Index+1 =BIN BIN_Index Character END ELSE BEGIN CompressBuf CB_Index =BIN BIN_Index Character CompressBuf CB_Index+1 =BIN BIN_Index Attribute END Inc(CB_Index 2) RunChar CharAttr =BIN BIN_Index CharAttr END IF Inc(RunCount) RunCount is now one more Inc(BIN_Index) One char attr pair processed END IF (RunCount 0) THEN BEGIN CompressBuf 0 = RunMode + (RunCount-1) STM_Write(XB CompressBuf CB_Index) IF (XB LastErr STM_OK) THEN Abort( Error Writing File ) END END XBIN Compression END BEGIN *** MAIN *** WriteLn ( ADF TO XBIN Converter V1 00 ) WriteLn ( Coded by Tasmaniac ACiD ) WriteLn ( Sourcecode placed into the public domain use and modify freely ) WriteLn --- Check passed parameter ------------------------------------------- IF (ParamCount 2) THEN HelpText --- Open ADF --------------------------------------------------------- WriteLn ( Opening ADF ) STM_Open(ADF ParamStr(1) NOCREATE) IF (ADF LastErr STM_OK) THEN Abort( Error opening ADF file +ParamStr(1)) --- Determine size of unSAUCED ADF ----------------------------------- WriteLn ( Determining actual size of ADF ) ADFSize = STM_GetSize(ADF) IF (ADF LastErr STM_OK) THEN Abort( Error determinig size of ADF file ) STM_Goto(ADF ADFSize-Sizeof(SAUCE)) IF (ADF LastErr STM_OK) THEN Abort( Error seeking SAUCE info in ADF file ) STM_Read(ADF SAUCE sizeof(SAUCE)) IF (ADF LastErr STM_OK) THEN Abort( Error reading SAUCE info from ADF file ) IF (SAUCE ID=SAUCE_ID) THEN BEGIN Dec(ADFSize sizeof(SAUCE)) Reduce ADF size accounting for SAUCE IF (SAUCE Comments 0) THEN BEGIN Commentblock added to Sauce check if it s valid STM_Goto(ADF ADFSize-(SAUCE Comments*64)-5) IF (ADF LastErr STM_OK) THEN Abort( Error seeking SAUCE COMMENT info in ADF file ) STM_Read(ADF CMT sizeof(CMT)) IF (ADF LastErr STM_OK) THEN Abort( Error reading SAUCE info from ADF f ile ) IF (CMT CMT_ID) THEN Abort( Invalid SAUCE COMMENT block in ADF ) DEC(ADFSize (SAUCE Comments*64)+5) Adjust to account for comments END Dec(ADFSize) Account for EOF character preceding Sauce & comment IF (SAUCE FileSize ADFSize) THEN Abort( Calculated size of ADF and size according to SAUCE don t match ) END Lines = (ADFSize - 1 - 192 - 4000) DIV 160 Number lines in ADF STM_Goto(ADF 1) Start of ADF skip version byte IF (ADF LastErr STM_OK) THEN Abort( Error seeking to start of ADF ) =========================== CREATE XBIN ============================ WriteLn ( Creating XBIN ) STM_Create(XB Paramstr(2)) IF (XB LastErr STM_OK) THEN Abort( Error creating XBIN file +ParamStr(2)) --- Write Header ----------------------------------------------------- WriteLn ( Writing XBIN header ) XBHdr ID = XB_ID XBIN ID XBHdr EofChar = 26 Mark EOF when TYPEing XBIN XBHDr Width = 80 ADF is always 80 wide XBHdr Height = Lines This is what we just calculated XBHdr FontSize = 16 Fonts in ADF are 16 pixels high XBHdr Flags = $0F Palette present Font present Compresed Non-Blinking (ADF doesn t have blinking) 256 character font STM_Write(XB XBHdr Sizeof(XBHdr)) IF (XB LastErr STM_OK) THEN Abort( Error writing XBIN file ) --- Copy Palette ----------------------------------------------------- WriteLn ( Copying palette from ADF to XBIN ) STM_Read (ADF ADFPal sizeof(ADFPal)) IF (ADF LastErr STM_OK) THEN Abort( Error reading palette from ADF file ) For some reason ADF stores 64 palette values while only 16 colors can be active at any one time Copy the relevant portion of this palette to the XBIN FOR Counter =0 TO 15 DO BEGIN STM_Write(XB ADFPal STD_EGA_TO_VGA_PAL Counter *3 3) IF (XB LastErr STM_OK) THEN Abort( Error writing palette in XBIN file ) END --- Copy Font -------------------------------------------------------- WriteLn ( Copying font from ADF to XBIN ) STM_Read (ADF ADFFont sizeof(ADFFont)) IF (ADF LastErr STM_OK) THEN Abort( Error reading font from ADF file ) STM_Write(XB ADFFont sizeof(ADFFont)) IF (XB LastErr STM_OK) THEN Abort( Error writing font in XBIN file ) --- Write image data ------------------------------------------------- WriteLn( Converting image data from ADF to XBIN ) FOR Lines =1 to XBHdr Height DO BEGIN STM_Read (ADF BIN 160) Read one screen line IF (ADF LastErr STM_OK) THEN Abort( Error reading image date from ADF file ) Write(Lines XBHdr Height #13) XBIN_Compress(BIN XBHdr Width) END Write( 79 #13) STM_Close(ADF) STM_Close(XB) WriteLn ( Conversion complete ) END