'===========================================================================
' Subject: PCX VIEWER                        Date: Unknown Date (00:00:00)
' Author:  Unknown Author(s)                 Code: QB, QBasic             
' Keys:    PCX,VIEWER                      Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB SetPalette (pcxpal$)
DECLARE SUB SelectScreen ()
DECLARE SUB ReadPCXLine (PCXFile%, TotalBytes%, ScanLine%())
DECLARE SUB ReadPCXByte (PCXFile%, value%)
DECLARE SUB OpenPCXFile (PCXname$, xsize%, ysize%, TotalBytes%, pcxpal$)
DEFINT A-Z
TYPE PCXHeaderStruc
    Manufacxturer AS STRING * 1
    version AS STRING * 1
    Encoding AS STRING * 1
    BitsPerPixel AS STRING * 1
    xmin AS INTEGER
    ymin AS INTEGER
    xmax AS INTEGER
    ymax AS INTEGER
    Hres AS INTEGER
    Vres AS INTEGER
    ColorMap AS STRING * 48
    Reserved1 AS STRING * 1
    NumPlanes AS STRING * 1
    BytesPerLine AS INTEGER
    PaletteType AS INTEGER
    HScrSize AS INTEGER
    VScrSize AS INTEGER
    Resreved2 AS STRING * 54
END TYPE
DIM SHARED PCXheader AS PCXHeaderStruc
DIM SHARED PCXFile
DIM SHARED ScrMode, ScrMaxX, ScrMaxY
DIM SHARED ScrMaxColor, ScrBitsPerPixel
DIM SHARED byte AS STRING * 1
DO
   SCREEN 0
   WIDTH 80
   LINE INPUT "PCX filename: "; PCXname$
   IF PCXname$ = "" THEN EXIT DO
   OpenPCXFile PCXname$, xsize, ysize, TotalBytes, pcxpal$
   SEEK #PCXFile, LEN(PCXheader) + 1
   SelectScreen
   SCREEN ScrMode
   SetPalette pcxpal$
   REDIM ScanLine(TotalBytes + 1)
   pbits = xsize * ASC(PCXheader.BitsPerPixel)
   sbits = ScrMaxX * ScrBitsPerPixel
   IF pbits > sbits THEN
      ScanLine(0) = sbits + 1
   ELSE
      ScanLine(1) = pbits
   END IF
   ScanLine(1) = 1
   y = 0
   DO
      ReadPCXLine PCXFile, TotalBytes, ScanLine()
      PUT (0, y), ScanLine
      y = y + 1
   LOOP WHILE y < ysize OR y < ScrMaxY
   CLOSE #PCXPile
   BEEP
   i$ = INPUT$(1)
LOOP
END

SUB OpenPCXFile (PCXname$, xsize, ysize, TotalBytes, pcxpal$)
PCXFile = FREEFILE
OPEN PCXname$ + ".pcx" FOR BINARY AS #PCXFile
GET #PCXFile, 1, PCXheader
pcxpal$ = LEFT$(PCXheader.ColorMap + STRING$(768, 0), 768)
IF ASC(PCXheader.version) = 5 THEN
   SEEK #PCXFile, LOF(PCXFile) - 768&
   GET #PCXFile, , byte
   IF ASC(byte) = 12 THEN GET #PCXFile, , pcxpal$
END IF


xsize = PCXheader.xmax - PCXheader.xmin + 1
ysize = PCXheader.ymax - PCXheader.ymin + 1
TotalBytes = ASC(PCXheader.NumPlanes) * PCXheader.BytesPerLine
END SUB

SUB ReadPCXByte (PCXFile, value)
STATIC count, CountValue, BufferLOC, Buffer$

IF count > 0 THEN
   value = CountValue
   count = count - 1
ELSE
   IF BufferLOC > LEN(Buffer$) OR LEN(Buffer$) = 0 THEN
      BufferLEN& = LOF(PCXFile) - LOC(PCXFile)
      IF BufferLEN& > 15000 THEN
         BufferLEN& = 15000
      END IF
      IF BufferLEN& <= 0 OR EOF(PCXFile) THEN
         EXIT SUB
      END IF
      Buffer$ = SPACE$(BufferLEN&)
      GET #PCXFile, , Buffer$
      BufferLOC = 1
   END IF
   value = ASC(MID$(Buffer$, BufferLOC, 1))
   BufferLOC = BufferLOC + 1
   IF value >= 192 THEN
      count = value - 193
      IF BufferLOC >= LEN(Buffer$) THEN
         BufferLEN& = LOF(PCXFile) - LOC(PCXFile)
         IF BufferLEN& > 15000 THEN
            BufferLEN& = 15000
         END IF
         IF BufferLEN& <= 0 OR EOF(PCXFile) THEN
            EXIT SUB
         END IF
         Buffer$ = SPACE$(BufferLEN&)
         GET #PCXFile, , Buffer$
         BufferLOC = 1
      END IF
      CountValue = ASC(MID$(Buffer$, BufferLOC, 1))
      BufferLOC = BufferLOC + 1
      value = CountValue
   END IF
END IF

END SUB

SUB ReadPCXLine (PCXFile, TotalBytes, ScanLine())
zero$ = CHR$(0)
index = LBOUND(ScanLine) + 2
count = 0
DO
   ReadPCXByte PCXFile, pixels
   ScanLine(index) = pixels
   IF count = TotalBytes THEN EXIT DO
   ReadPCXByte PCXFile, pixels
   ScanLine(index) = ScanLine(index) + CVI(zero$ + CHR$(pixels))
   count = count + 2
   index = index + 1
LOOP WHILE count < TotalBytes
END SUB

SUB SelectScreen
SELECT CASE ASC(PCXheader.BitsPerPixel)
   CASE 1
      IF ASC(PCXheader.NumPlanes) = 4 THEN
         ScrMode = 12
         ScrMaxX = 639
         ScrMaxY = 479
         ScrMaxColor = 15
         ScrBitsPerPixel = 1
      ELSE
         ScrMode = 11
         ScrMaxX = 639
         ScrMaxY = 479
         ScrMaxColor = 1
         ScrBitsPerPixel = 1
      END IF
   CASE 2
      ScrMode = 1
      ScrMaxX = 319
      ScrMaxY = 199
      ScrMaxColor = 3
      ScrBitsPerPixel = 2
   CASE 8
      ScrMode = 13
      ScrMaxX = 319
      ScrMaxY = 199
      ScrMaxColor = 255
      ScrBitsPerPixel = 8
END SELECT
END SUB

SUB SetPalette (pcxpal$)
version = ASC(PCXheader.version)
IF version = 5 AND ScrMode = 13 THEN
   FOR i = 0 TO ScrMaxColor
      r = ASC(MID$(pcxpal$, i * 3 + 1, 1)) \ 4
      g = ASC(MID$(pcxpal$, i * 3 + 2, 1)) \ 4
      b = ASC(MID$(pcxpal$, i * 3 + 3, 1)) \ 4
      PALETTE i, b * 65536 + g * 256 + r
   NEXT i
ELSE
   PALETTE
END IF
END SUB