=
'//MODEXPCX.BAS -- CREATED IN QBASIC 1.1 BY STEVEN SENSARN
'//SPEED HAS BEEN COMPROMISED FOR SIZE
'//FUNCTION PROTOTYPES
DECLARE SUB X.PLANE (P AS INTEGER) 'USE THIS TO CHANGE PLANES
DECLARE SUB X.PIXEL (X AS LONG, Y AS LONG, CLR AS INTEGER) 'PLOTS PIXEL
DECLARE SUB MODEX () 'CHANGES TO MODE X 320x240x256
DECLARE SUB WAIT.KEY () 'PRESS ANY KEY TO CONTINUE
DECLARE SUB OPEN.FILE () 'USED TO LOAD THE PCX FILE
'//STRUCTURES
TYPE THEADER
MAN AS STRING * 1 'MANUFACTURER -- 10
VER AS STRING * 1 'VERSION -- 5+
ENC AS STRING * 1 'ENCODING -- 1 (RLE)
BPP AS STRING * 1 'BITS PER PIXEL PER PLANE -- 8
MNX AS INTEGER 'MINIMUM X SIZE
MNY AS INTEGER 'MINIMUM Y SIZE
MAX AS INTEGER 'MAXIMUM X SIZE
MAY AS INTEGER 'MAXIMUM Y SIZE
HRS AS INTEGER 'HORIZONTAL RESOLUTION
VRS AS INTEGER 'VERTICAL RESOLUTION
COL AS STRING * 48 'EGA COLOR PALETTE -- IGNORE
RES AS STRING * 1 'RESERVED
NMP AS STRING * 1 'NUMBER OF PLANES -- 1
BPL AS INTEGER 'BYTES PER SCANLINE
PAL AS INTEGER 'PALETTE INFO -- IGNORE
FIL AS STRING * 58 'FILLUP SPACE
END TYPE
'//VARIABLE DECLARATIONS
DIM BYTE AS STRING * 1 'USED TO READ BYTES
DIM HEADER AS THEADER 'USED FOR HEADER INFORMATION
DIM SHARED FILE AS STRING * 50 'USED TO HOLD FILE NAME
DIM INDEX AS LONG 'USED TO CONTROL DECODING
DIM SIZE AS LONG 'USED TO CONTROL DECODING
DIM XSIZE AS INTEGER, YSIZE AS INTEGER 'USED TO MEASURE IMAGE
DIM TOTALBYTES AS INTEGER 'USED TO MEASUER SCAN LINES
DIM VALUE AS INTEGER 'USED FOR CONVERTING CHAR TO INT
DIM RLP 'USED FOR RUN LENGTH LOOP
DIM X AS LONG, Y AS LONG 'USED FOR PIXEL TRACKING
'//VARIABLE INITIALIZATIONS
INDEX = 1 'BE ON THE SAFE SIDE
'//MAIN
ON ERROR GOTO ERROR.HANDLER 'JUST IN CASE...
CLS
CALL OPEN.FILE 'OPEN THE FILE
GET #1, 1, HEADER 'LOAD HEADER
'//BASIC TEST (NOT FOOL-PROOF) -- REQUIREMENTS
IF ASC(HEADER.MAN) <> 10 THEN CLOSE #1: END 'NOT PCX
IF ASC(HEADER.VER) < 5 THEN CLOSE #1: END 'NOT 256 COLOR
IF ASC(HEADER.ENC) <> 1 THEN CLOSE #1: END 'NOT RLE
IF ASC(HEADER.NMP) <> 1 THEN CLOSE #1: END 'NOT SUPPORTIVE OF MODE X PLANES
'//LOAD WHILE LOOP INFORMATION
XSIZE = HEADER.MAX - HEADER.MNX + 1 'LOAD HORIZONTAL GRAPHIC SIZE
YSIZE = HEADER.MAY - HEADER.MNY + 1 'LOAD VERTICAL GRAPHIC SIZE
TOTALBYTES = HEADER.BPL 'USED TO TRACK END-OF-SCANLINE
SIZE = 1& * XSIZE * YSIZE 'LOAD SIZE -- FORCE LONG
IF SIZE > 76800 THEN CLOSE : END 'GRAPHIC TOO LARGE -- WON'T FIT ON SCREEN
'//DISPLAY STATUS TO THE USER
CLS : SCREEN 0: WIDTH 80
PRINT "FILENAME: ", , " "; FILE: PRINT
PRINT "MANUFACTURER: ", ASC(HEADER.MAN)
PRINT "VERSION: ", , ASC(HEADER.VER)
PRINT "RLE ENCODING: ", ASC(HEADER.ENC)
PRINT "BITS PER PIXEL PER PLANE: ", ASC(HEADER.BPP)
PRINT "WINDOW X MIN: ", HEADER.MNX
PRINT "WINDOW Y MIN: ", HEADER.MNY
PRINT "WINDOW X MAX: ", HEADER.MAX
PRINT "WINDOW Y MAX: ", HEADER.MAY
PRINT "HORIZONTAL RESOLUTION: ", HEADER.HRS
PRINT "VERTICAL RESOLUTION: ", HEADER.VRS
PRINT "NUMBER OF PLANES: ", ASC(HEADER.NMP)
PRINT "BYTES PER LINE: ", HEADER.BPL
PRINT
IF NOT HEADER.HRS / 320 = INT(HEADER.HRS / 320) THEN
PRINT "ASPECT RATIO MISMATCH ", " -- X AXIS" 'WARPED IMAGE -- NO BIG
DEAL
ELSE
PRINT
END IF
IF NOT HEADER.VRS / 240 = INT(HEADER.VRS / 240) THEN
PRINT "ASPECT RATIO MISMATCH ", " -- Y AXIS" 'WARPED IMAGE -- NO BIG
DEAL
END IF
WAIT.KEY 'PRESS ANY KEY TO CONTINUE
MODEX 'SWITCH TO MODE X -- 320x240x256
DEF SEG = &HA000 'VIDEO MEMORY ACCESS
'//DECODE AND DISPLAY
WHILE INDEX <= SIZE 'WHILE PICTURE ISN'T DONE LOADING...
GET #1, , BYTE 'READ BYTE
IF (ASC(BYTE) AND &HC0) = &HC0 THEN 'TEST TOP TWO BITS FOR 1'S
RLP = ASC(BYTE) AND &H3F 'SET RUN LENGTH
GET #1, , BYTE 'READ DATA BYTE
WHILE RLP > 0 'WHILE RUN LENGTH HAS NOT YET FINISHED DUPLICATION
IF NOT X > XSIZE THEN CALL X.PIXEL(X, Y, ASC(BYTE)) 'PLOT PIXEL
X = X + 1 'RENEW PIXEL POSITION
IF X >= TOTALBYTES THEN X = 0: Y = Y + 1 'TEST FOR END OF SCANLINE
RLP = RLP - 1 'REDUCE RUN LENGTH LOOP VARIABLE
INDEX = INDEX + 1 'INCREASE TOTAL
WEND
ELSE 'IF THE BYTE IS NOT ENCODED
IF NOT X > XSIZE THEN CALL X.PIXEL(X, Y, ASC(BYTE)) 'PLOT PIXEL
X = X + 1 'RENEW PIXEL POSITION
IF X >= TOTALBYTES THEN X = 0: Y = Y + 1 'TEST FOR END OF SCANLINE
INDEX = INDEX + 1 'INCREASE TOTAL
END IF
WEND
'//CHANGE PALETTE
GET #1, LOF(1) - 768, BYTE
IF ASC(BYTE) <> 12 THEN CLOSE : END 'NO 256 COLOR PALETTE
FOR INDEX = 0 TO 255
OUT &H3C6, &HFF 'INITIALIZE VGA PALETTE
OUT &H3C8, INDEX 'SELECT COLOR INDEX
GET #1, , BYTE
OUT &H3C9, INT(ASC(BYTE) / 4) 'SEND RED VALUE -- ONLY NEED TOP 6 BITS
GET #1, , BYTE
OUT &H3C9, INT(ASC(BYTE) / 4) 'SEND GREEN VALUE -- ONLY NEED TOP 6 BITS
GET #1, , BYTE
OUT &H3C9, INT(ASC(BYTE) / 4) 'SEND BLUE VALUE -- ONLY NEED TOP 6 BITS
NEXT INDEX
SOUND 3000, .25 'DONE -- YOU WILL NOT SEE THE 'PRESS ANY KEY TO CONTINUE'
END
'//ERRORS
ERROR.HANDLER:
SCREEN 0: WIDTH 80
CLS
PRINT : PRINT "SOMETHING HAS OCCURED IN THE PROGRAM THAT HAS"
PRINT "CAUSED IT TO HALT. TERMINATING..."
WAIT.KEY
END
'//DONE
CLOSE #1 'CLOSE THE FILE
SOUND 3000, .25 'SIGNAL USER
END 'END THE PROGRAM
'//NOTICE
'I HAVE ABSOLUTELY NO EXPERIENCE WITH PLANE BASED PCX FILES BECAUSE I USE
'MICROSOFT WINDOWS 3.1 PAINTBRUSH AND I CAN'T SEEM TO CREATE ONE. IF
'ANYBODY WOULD BE WILLING TO DRAW ME ONE THAT USES PLANES, I WOULD GREATLY
SUB MODEX
SCREEN 13
DEF SEG = &HA000
OUT &H3C4, &H4
OUT &H3C5, &H6
OUT &H3C4, &H2
OUT &H3C5, &HF
CLS
OUT &H3D4, &H14
OUT &H3D5, &H0
OUT &H3D4, &H17
OUT &H3D5, &HE3
OUT &H3C2, &HE3
OUT &H3D4, &H11
OUT &H3D5, &H2C
OUT &H3D4, &H6
OUT &H3D5, &HD
OUT &H3D4, &H7
OUT &H3D5, &H3E
OUT &H3D4, &H10
OUT &H3D5, &HEA
OUT &H3D4, &H11
OUT &H3D5, &HAC
OUT &H3D4, &H12
OUT &H3D5, &HDF
OUT &H3D4, &H15
OUT &H3D5, &HE7
OUT &H3D4, &H16
OUT &H3D5, &H6
END SUB
SUB OPEN.FILE
PRINT
"<>/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\<>"
PRINT "<> PLEASE NOTE THAT THE FILE THAT IS TO BE LOADED MUST HAVE A
<>"
PRINT "<> SIZE NO LARGER THAN 320x240. IF YOU WOULD LIKE TO TERMINATE
<>"
PRINT "<> THIS PROGRAM, DO SO ENTERING AN EMPTY FILENAME.
<>"
PRINT
"<>\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/<>"
PRINT
INPUT "FILENAME: ", FILE
FILE = RTRIM$(FILE)
FILE = UCASE$(FILE)
IF NOT RIGHT$(RTRIM$(FILE), 4) = ".PCX" THEN END 'NO VALID EXTENSION
OPEN FILE FOR BINARY AS #1
IF LOF(1) = 0 THEN CLOSE #1: KILL FILE: END 'FILE EMPTY OR NOT FOUND
END SUB
SUB WAIT.KEY
WHILE LEN(INKEY$) = 0: WEND
END SUB
'//ASSUMING CURRENT SEGMENT IS A000:0000H
SUB X.PIXEL (X AS LONG, Y AS LONG, CLR AS INTEGER)
CALL X.PLANE(X AND 3)
POKE INT(Y * 80 + X / 4), CLR
END SUB
'//USED TO CHANGE PLANE
SUB X.PLANE (P AS INTEGER)
OUT &H3C4, 2
OUT &H3C5, 2 ^ P
END SUB
--
Marc van den Dikkenberg
-----------------------
The PowerBasic Archives
http://www.xs4all.nl/~excel/pb.html
page flipping with SCREEN 13