'===========================================================================
' Subject: SAVE SCREEN 13 AS PCX V0.2        Date: 04-23-99 (18:32)       
' Author:  Yousuf Philips                    Code: QB, QBasic, PDS        
' Origin:  philipz@emirates.net.ae         Packet: GRAPHICS.ABC
'===========================================================================
''''''''''''''''''''''''''''''''''''''
' Program    : Save Screen 13 as PCX '
' Name       : SAVERLE Version 0.2   '
' Programmer : Yousuf Philips        '
' Company    : Y P I                 '
' Updated On : 8th of July 1998      '
' Email - [philipz85@hotmail.com]    '
' [http://members.xoom.com/Philipz/] '
''''''''''''''''''''''''''''''''''''''

'/*               Do not edit this file if you distribute it.              */'
'/*  (c) Copyrighted by YPI in 1998 | All Rights Reserved | Public Domain  */'

'/* The SAVEPCX SUB is able to save any portion of screen 13 as a PCX.     */'
'/* The SAVEPCX SUB was tested on a Pentium 100MHz and it was able save the*/'
'/* whole of screen 13 in 1.49 seconds.                                    */'

'/* If you use any of this code in your program then you must credit YPI.  */'

DECLARE SUB SavePCX (FileName$, MinX!, MinY!, MaxX!, MaxY!)
'/* FileName$ - The filename of the file that the saved screen is to be put*/'
'/* MinX - The starting x position                                         */'
'/* MinY - The starting y position                                         */'
'/* MaxX - The ending x position                                           */'
'/* MaxY - The ending y position                                           */'

SCREEN 13
FOR Circles = 1 TO 100
   CIRCLE (RND * 320, RND * 200), RND * 100, RND * 256
NEXT Circles
PRINT " Created By YPI (c) 1998"

t = TIMER
CALL SavePCX("YPI.pcx", 0, 0, 319, 199)
PRINT " Time Taken To Save Screen -"; TIMER - t

SUB SavePCX (FileName$, MinX, MinY, MaxX, MaxY)

OPEN FileName$ FOR BINARY AS #255
IF LOF(255) <> 0 THEN
   '/* If the file is not empty then it is deleted */'
   CLOSE #255
   KILL FileName$
   OPEN FileName$ FOR BINARY AS #255
END IF

ValidPCX1$ = CHR$(10): PCXVersion$ = CHR$(5): ValidPCX2$ = CHR$(1)
BitsPerPixel$ = CHR$(8)
ScreenMinX$ = MKI$(MinX): ScreenMinY$ = MKI$(MinY)
ScreenMaxX$ = MKI$(MaxX): ScreenMaxY$ = MKI$(MaxY)
PixelWidth$ = MKI$((MaxX - MinX) + 1): PixelHeight$ = MKI$((MaxY - MinY) + 1)
Palette4Bit$ = SPACE$(48): Reserved$ = CHR$(0): NoOfPlanes$ = CHR$(1)
BytesPerLine$ = PixelWidth$: PaletteInfo$ = CHR$(1): FillHeader$ = STRING$(59, 0)
ValidPCX3$ = CHR$(12)

'/*  ------ Header Info -------- */'
'/* The first Byte of a PCX is chr$(10) */'
PUT #255, , ValidPCX1$
'/* The PCX Version is from 2.5 - 3 | We are using Version 3 */'
PUT #255, , PCXVersion$
'/* The PCX has a reserved byte of chr$(1) */'
PUT #255, , ValidPCX2$
'/* No of Bits per Pixel */'
PUT #255, , BitsPerPixel$
'/* The Screen Ranges */'
PUT #255, , ScreenMinX$
PUT #255, , ScreenMinY$
PUT #255, , ScreenMaxX$
PUT #255, , ScreenMaxY$
'/* The Image Width and Height */'
PUT #255, , PixelWidth$
PUT #255, , PixelHeight$
'/* The Palette for 4-Bit images */'
PUT #255, , Palette4Bit$
'/* Reserved byte of chr$(0)
PUT #255, , Reserved$
'/* Number of Planes, always 1 */'
PUT #255, , NoOfPlanes$
'/* Bytes per line */'
PUT #255, , BytesPerLine$
'/* Palette type 0-2 */'
PUT #255, , PaletteInfo$
'/* Header fill to fill the first 128 bytes of the file */'
PUT #255, , FillHeader$

'/*  ------ Picture Data -------- */'

'SCREEN 13
'/* Saves the screen into BSAVE format */'
DIM Image%(1 TO 32767)
GET (MinX, MinY)-(MaxX, MaxY), Image%
ImageVarSeg = VARSEG(Image%(1))
ImageVarOffset = VARPTR(Image%(1))
DEF SEG = ImageVarSeg
BSAVE "temp.fil", ImageOffset, 65535

Bytes11$ = SPACE$(11)
OPEN "temp.fil" FOR BINARY AS #254
'/* Extract the unnecessary bytes from the Bsave file */'
GET #254, , Bytes11$

LineExtract$ = SPACE$(CVI(PixelWidth$))
FOR Yaxis% = MinY TO MaxY
   GET #254, , LineExtract$
   LINE (MinX, Yaxis%)-(MaxX, Yaxis%), 0
  
   XPixel% = 1: NewLine$ = ""
   DO
      PixelColor$ = MID$(LineExtract$, XPixel%, 1)
      IF MID$(LineExtract$, XPixel% + 1, 1) = PixelColor$ THEN
         XPixel% = XPixel% + 2
         SamePixels = 2
         DO
         IF MID$(LineExtract$, XPixel%, 1) = PixelColor$ THEN
            SamePixels = SamePixels + 1
            XPixel% = XPixel% + 1
         ELSE
            EXIT DO
         END IF
         LOOP UNTIL SamePixels = 63
         NewLine$ = NewLine$ + CHR$(SamePixels + 192) + PixelColor$
      ELSE
         IF ASC(PixelColor$) > 191 THEN
            NewLine$ = NewLine$ + CHR$(193)
         END IF
         NewLine$ = NewLine$ + PixelColor$
         XPixel% = XPixel% + 1
      END IF
   LOOP UNTIL XPixel% > LEN(LineExtract$)
   PUT #255, , NewLine$
NEXT Yaxis%
CLOSE #254: KILL "temp.fil"

'/*  ------ Palette Data -------- */'
PUT #255, , ValidPCX3$
FOR Colors% = 0 TO 255
   '/* Extracts the Palette of each of the 256 colors into a red, green and blue */'
   '/* sections and places them into their corresponding variables */'
   OUT &H3C6, &HFF
   OUT &H3C7, Colors%
   Red$ = CHR$(INP(&H3C9) * 4): Green$ = CHR$(INP(&H3C9) * 4): Blue$ = CHR$(INP(&H3C9) * 4)
   '/* Places the extracted colors into the given file */'
   PUT #255, , Red$
   PUT #255, , Green$
   PUT #255, , Blue$
NEXT Colors%

END SUB