_ALGORITHM ALLEY COLUMN_
edited Tom Swan
written this month by Ernie Deel


Listing One

'*** BASIC Adaptive Block Coded (ABC) Image Compression
'*** (c)1993, E.F.Deel, CIS 72627,3026
'*** PCX2ABC.BAS - Compression Demo Module, displays PCX to simulate video
'*** camera output, captures image from screen, compresses & stores.
'*** Link with compression module, COMP.BAS
'*** NOTE: VGA is required and assumed

DEFINT A-Z

'--- Include declarations for compression module
'$INCLUDE: 'COMP.DCL'

'--- BASIC DOS/BIOS Interrupt routine
DECLARE SUB InterruptX (IntNumber, Registers AS ANY)

'--- External assembler components from Graphics WorkShop by
'    Crescent Software, used to display PCX and work with palette
DECLARE SUB SetPaletteEGA (BYVAL PalReg%, BYVAL Value%)
DECLARE SUB SetPalTripleVGA (BYVAL PalReg%, BYVAL Red%, BYVAL Green%, BYVAL Blue%)
DECLARE SUB DispPCXVE (BYVAL Display%)
DECLARE FUNCTION OpenPCXFile% (Filename$, Header$)

'--- BASIC sub-program to handle palette and display PCX
DECLARE SUB ShowPCX (Filein$, XSize, YSize)

'--- Share compression statistics among modules (optional)
COMMON noc, hrc, vrc, pcc, zlc, zrc, vlc, bct&, pct&, plt&, GPDat%()

TYPE RegType
     AX        AS INTEGER
     BX        AS INTEGER
     CX        AS INTEGER
     DX        AS INTEGER
     BP        AS INTEGER
     SI        AS INTEGER
     DI        AS INTEGER
     FL        AS INTEGER
     DS        AS INTEGER
     ES        AS INTEGER
     SS        AS INTEGER
     SP        AS INTEGER
     BusyFlag  AS INTEGER
     Address   AS INTEGER
     Segment   AS INTEGER
     ProcAdr   AS INTEGER
     ProcSeg   AS INTEGER
     IntNum    AS INTEGER
END TYPE

DIM SHARED Registers AS RegType
Filein$ = COMMAND$
IF LEN(Filein$) = 0 THEN
   CLS
   PRINT "SYNTAX: PCX2ABC Filename.PCX  [-]"
   PRINT "        - = Use lossy preprocessor"
   PRINT "        Output written to Filename.ABC"
   END 1
END IF
x = INSTR(Filein$, "-")
IF x THEN
   Lossy = -1
   Filein$ = LEFT$(Filein$, x - 1)
END IF
FileOut$ = Filein$
x = INSTR(FileOut$, ".")
IF x THEN FileOut$ = LEFT$(FileOut$, x - 1)
FileOut$ = FileOut$ + ".ABC"

CALL ShowPCX(Filein$, XSize, YSize)
CALL Compress(0, 0, XSize, YSize, Lossy, rsize&, csize&)

IF csize& < 0 THEN
   Registers.AX = &H3                 'switch to text mode
   CALL InterruptX(&H10, Registers)
   PRINT "ERROR! Out of memory."
   END 1
END IF

CALL SaveABC(FileOut$, XSize, YSize)

Registers.AX = &H3                 'switch to text mode
CALL InterruptX(&H10, Registers)

'--- Print compression statistics
PRINT "Raw image size    = "; rsize&; "bytes ("; XSize; "X "; YSize; "pixels)"
PRINT "Compressed image  = "; csize&; "bytes"
PRINT "Compression Ratio = 0."; csize& * 100 \ rsize&
PRINT
PRINT "Pattern        #Blks"
PRINT "--------------------"
PRINT "None         = "; noc
PRINT "Horiz. Run   = "; hrc
PRINT "Vert.  Run   = "; vrc
PRINT "Prime Color  = "; pcc
PRINT "ZigZag Left  = "; zlc
PRINT "ZigZag Right = "; zrc
PRINT "Vari. Length = "; vlc
PRINT

END 0                      '-------------- End Program -----------

SUB ShowPCX (Filein$, XSize, YSize)
   Hdr$ = SPACE$(68 + 768)
   IF NOT OpenPCXFile(Filein$, Hdr$) THEN
      PRINT "File Not Found"
      END 1
   END IF
   XMin = CVI(MID$(Hdr$, 5, 2))
   YMin = CVI(MID$(Hdr$, 7, 2))
   XMax = CVI(MID$(Hdr$, 9, 2))
   YMax = CVI(MID$(Hdr$, 11, 2))
   XSize = XMax - XMin + 1
   YSize = YMax - YMin + 1
   NumPlanes = ASC(MID$(Hdr$, 66, 1))
   PixelBits = ASC(MID$(Hdr$, 4, 1))
   IF (NumPlanes < 2) OR (PixelBits = 2) OR (PixelBits = 8) THEN
      PRINT "PCX must be 640x480x16"
      END 1
   END IF

   Registers.AX = &H12                       'Switch to graphics
   CALL InterruptX(&H10, Registers)

   i = 17
   FOR k = 0 TO 15
      CALL SetPaletteEGA(k, k)
      t$ = MID$(Hdr$, i, 1)
      r = ASC(t$) \ 4
      i = i + 1
      t$ = MID$(Hdr$, i, 1)
      g = ASC(t$) \ 4
      i = i + 1
      t$ = MID$(Hdr$, i, 1)
      b = ASC(t$) \ 4
      i = i + 1
      CALL SetPalTripleVGA(k, r, g, b)
   NEXT
   CALL DispPCXVE(0)

END SUB




Listing Two 

'*** BASIC Adaptive Block Coded (ABC) Image Compression
'*** (c)1993, E.F.Deel, CIS 72627,3026
'*** SHOWABC.BAS - Demo De-Compression Module, re-displays
'*** compressed images from disk.
'*** Link with de-compression module, DECOMP.BAS

DEFINT A-Z

DECLARE SUB InterruptX (IntNumber, Registers AS ANY)

'$INCLUDE: 'DECOMP.DCL'

TYPE RegType
   AX        AS INTEGER
   BX        AS INTEGER
   CX        AS INTEGER
   DX        AS INTEGER
   BP        AS INTEGER
   SI        AS INTEGER
   DI        AS INTEGER
   FL        AS INTEGER
   DS        AS INTEGER
   ES        AS INTEGER
   SS        AS INTEGER
   SP        AS INTEGER
   BusyFlag  AS INTEGER
   Address   AS INTEGER
   Segment   AS INTEGER
   ProcAdr   AS INTEGER
   ProcSeg   AS INTEGER
   IntNum    AS INTEGER
END TYPE

DIM Registers AS RegType

FileIn$ = COMMAND$
IF LEN(FileIn$) = 0 THEN
   CLS
   PRINT "SYNTAX: ShowABC Filename"
   END 1
END IF

Registers.AX = &H12                  'Switch to graphics
CALL InterruptX(&H10, Registers)

CALL DeCompress(FileIn$, 0, 0, OK)    'Decompress & display file

IF OK THEN
   DO: LOOP UNTIL LEN(INKEY$)        'wait for keypress
   Registers.AX = &H3                'switch to text
   CALL InterruptX(&H10, Registers)
   END 0
ELSE
   Registers.AX = &H3                'switch to text
   CALL InterruptX(&H10, Registers)
   PRINT "ERROR! Invalid file/file not found."
   END 1
END IF

END



Listing Three 

'*** ABC Compression Module Declarations

'--- External components from Graphics WorkShop by Crescent Software
DECLARE SUB GMove4VE (BYVAL FromCol%, BYVAL FromLine%, BYVAL Cols%, BYVAL Lines%, BYVAL DestSegment%, BYVAL Direction%)
DECLARE SUB LineBF2VE (BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL LineColor%)
DECLARE SUB GetPalTripleVGA (BYVAL PalReg%, Red%, Green%, Blue%)

'--- BASIC Compression/Decompression SubRoutines
DECLARE SUB Compress (BYVAL X%, BYVAL Y%, BYVAL XSize%, BYVAL YSize%, BYVAL Lossy%, rsize&, csize&)
DECLARE SUB ShrinkArray (BYVAL Segment%, BYVAL Addr%, nobytes&, noblks%)

'--- BASIC File Output Routine
DECLARE SUB SaveABC(Filename$, XSize, YSize)

'--- Internal BASIC Block File Read/Write Routines
DECLARE SUB BlkGet ALIAS "B$GET3" (BYVAL FileNum%, BYVAL Segment%, BYVAL Addr%, BYVAL Bytes%)
DECLARE SUB BlkPut ALIAS "B$PUT3" (BYVAL FileNum%, BYVAL Segment%, BYVAL Addr%, BYVAL Bytes%)



Listing Four

'*** ABC De-Compression Module Declarations

'--- External assembler "components" from Graphics WorkShop
DECLARE SUB GMove4VE (BYVAL FromCol%, BYVAL FromLine%, BYVAL Cols%, BYVAL Lines%, BYVAL DestSegment%, BYVAL Direction%)
DECLARE SUB SetPaletteEGA (BYVAL PalReg%, BYVAL Value%)
DECLARE SUB SetPalTripleVGA (BYVAL PalReg%, BYVAL Red%, BYVAL Green%, BYVAL Blue%)

'--- External assembler component by Doug Herr
'    Displays pixel block taken from a BASIC integer array
DECLARE SUB PutI(BYVAL segment%, BYVAL Addr%, BYVAL x%, BYVAL y%, BYVAL wide%, BYVAL high%)

'--- Internal BASIC Block File Access Routines
DECLARE SUB BlkGet ALIAS "B$GET3" (BYVAL Filenum%, BYVAL Segment%, BYVAL Addr%, BYVAL Bytes%)
DECLARE SUB BlkPut ALIAS "B$PUT3" (BYVAL Filenum%, BYVAL Segment%, BYVAL Addr%, BYVAL Bytes%)

'--- BASIC Compression/Decompression Routines
DECLARE SUB DeCompress (FileIn$, BYVAL X%, BYVAL Y%, OK%)
DECLARE SUB ExpandArray (BYVAL inseg%, BYVAL inptr%, bytesz&, NoBlk%)