home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / baswiz19 / examples / g2lodpcx.bas < prev    next >
Encoding:
BASIC Source File  |  1993-01-29  |  2.4 KB  |  88 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
  4. '   |                                                                      |
  5. '   |                      The BASIC Wizard's Library                      |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE FUNCTION GetBit0% (BYVAL ASeg%, BYVAL AOfs%, BitNr&)
  10.    DECLARE SUB SetBit0 (BYVAL ASeg%, BYVAL AOfs%, BitNr&, BYVAL BitVal%)
  11.  
  12.    DEFINT A-Z
  13.  
  14. SUB G2LoadPCX (File$, Image(), ErrCode)
  15.    DIM SByte AS STRING * 1
  16.  
  17.    ErrCode = 0
  18.    IF INSTR(File$, ".") THEN
  19.       FileName$ = File$
  20.    ELSE
  21.       FileName$ = File$ + ".PCX"
  22.    END IF
  23.    FileNr = FREEFILE
  24.  
  25.    OPEN FileName$ FOR BINARY AS FileNr LEN = 1024
  26.    GET FileNr, 1, SByte
  27.    IF ASC(SByte) <> 10 THEN               ' make sure it's PCX
  28.       ErrCode = -1
  29.       CLOSE FileNr
  30.       EXIT SUB
  31.    END IF
  32.    GET FileNr, 66, SByte
  33.    Planes = ASC(SByte)
  34.    IF Planes > 1 THEN                     ' must be single plane for SCREEN 2
  35.       ErrCode = 2
  36.       CLOSE FileNr
  37.       EXIT SUB
  38.    END IF
  39.    GET FileNr, 5, X1
  40.    GET FileNr, , Y1
  41.    GET FileNr, , X2
  42.    GET FileNr, , Y2
  43.    DX = X2 - X1 + 1
  44.    DY = Y2 - Y1 + 1
  45.    IF DX < 1 OR DX > 640 OR DY < 1 OR DY > 200 THEN      ' check picture size
  46.       ErrCode = 1
  47.       CLOSE FileNr
  48.       EXIT SUB
  49.    END IF
  50.  
  51.    REDIM Image(1 TO (5 + DX * DY) \ 2)
  52.    Image(1) = DX
  53.    Image(2) = DY
  54.    X = 0
  55.    Y = 0
  56.    BitNr& = 0&
  57.    GET FileNr, 128, SByte
  58.    CSeg = VARSEG(Colour)
  59.    COfs = VARPTR(Colour)
  60.    ASeg = VARSEG(Image(3))
  61.    AOfs = VARPTR(Image(3))
  62.  
  63.    DO
  64.       GET FileNr, , SByte
  65.       Colour = ASC(SByte)
  66.       IF Colour >= &HC0 THEN
  67.          RepeatCount = (Colour AND &H3F)
  68.          GET FileNr, , SByte
  69.          Colour = ASC(SByte)
  70.       ELSE
  71.          RepeatCount = 1
  72.       END IF
  73.       FOR Dupe = 0 TO RepeatCount * 8 - 1
  74.          Bit = GetBit0(CSeg, COfs, CLNG(Dupe AND 7))
  75.          SetBit0 ASeg, AOfs, BitNr&, Bit
  76.          BitNr& = BitNr& + 1&
  77.          X = X + 1
  78.          IF X >= DX THEN EXIT FOR
  79.       NEXT
  80.       IF X >= DX THEN
  81.          BitNr& = ((BitNr& + 7&) AND &HFFFFFFF8)
  82.          X = 0
  83.          Y = Y + 1
  84.       END IF
  85.    LOOP UNTIL Y >= DY
  86.    CLOSE FileNr
  87. END SUB
  88.