'===========================================================================
' Subject: VIEW .PKG FILES                   Date: 12-11-97 (00:34)       
' Author:  John Charles Bull III             Code: QB, QBasic, PDS        
' Origin:  vividbarrier@hotmail.com        Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB VLOAD (FileName$, Picture%, XRes%, YRes%)
DECLARE SUB VPAL (FileName$)
DECLARE SUB WriteRGB (red%, grn%, blu%, slot%)
DEFINT A-Z
' /........................\ Vivid Barrier Software 1997
' |.oO..oOo.oOo..vivid.....| QBasic 4.5x Useful SUB Procedures
' |.oO.oOo..oOo....barrier.| by John Charles Bull III
' |.oO.oOo..oOOOOo..=O97O=.|
' |.oOoOo...oOo.oOo........|
' |.oOOo....oOOOOo.........|
' \......................../
'
' This is an example of how to put an PKG image onto the screen
' Use this source code to load PKG files and palettes created with
' vEDIT (http://pages/prodigy.net/wyzel/)

SCREEN 13
VPAL "title.pal"
VLOAD "pkg\title.pkg", 1, 135, 80

SUB VLOAD (FileName$, Picture, XRes, YRes)

if$ = FileName$
ib = Picture
OPEN if$ FOR BINARY AS #1

GET #1, 1, iv
GET #1, 3, ia

'        IF ib > ia THEN EXIT SUB
       
        d = 5: in$ = ""
        DO
                a = a + 1
                z$ = RIGHT$(LEFT$(in$, a), 1)
                GET #1, d, b
                in$ = in$ + CHR$(b)
                d = d + 2
        LOOP UNTIL a = 30

in$ = LEFT$(in$, 21)

d! = ib * 4 + 66 'caculate where to get resulution

GET #1, d!, ix          'xres
GET #1, d! + 2, iy      'yres
 
a! = ib - 1 'image number
b! = 7200   'image length
c! = 150    'added from above

d! = a! * b! + c!  'caculate where to start getting gfx data
a = XRes: b = YRes: c = 0: d = 0

DO
        GET #1, d!, c
        IF c = 0 THEN
        ELSE

                IF b >= 100 THEN
                        DEF SEG = &HA7D0
                        POKE ((b - 100) * 320 + a), c
                ELSE
                        DEF SEG = &HA000
                        POKE (b * 320 + a), c
                END IF
     
        END IF
        d! = d! + 2
        a = a + 1: IF a = ix + XRes THEN a = XRes: b = b + 1
LOOP UNTIL b = iy + YRes

CLOSE #1

iy = iy - 1
ix = ix - 1

END SUB

SUB VPAL (FileName$)

OPEN FileName$ FOR BINARY AS #1
 
        DO
                b = b + 1: GET #1, b, red%
                b = b + 1: GET #1, b, grn%
                b = b + 1: GET #1, b, blu%
                CALL WriteRGB(red%, grn%, blu%, a): a = a + 1
        LOOP UNTIL a = 249

CLOSE #1

END SUB

SUB WriteRGB (red%, grn%, blu%, slot%)
  '
  OUT &H3C8, slot% ' Write RGB values to slot
  '
  OUT &H3C9, red%
  OUT &H3C9, grn%
  OUT &H3C9, blu%
  '
END SUB