'===========================================================================
' Subject: TEXT-BOXES W/BACKGROUND SAVES     Date: 02-23-98 (15:08)       
' Author:  Jonathan L. Leger                 Code: QB, QBasic, PDS        
' Origin:  leger@earthlink.net             Packet: TEXT.ABC
'===========================================================================
'*****************************************
'*** WINDOWS.BAS *** by Jonathan Leger ***   2/23/98
'********************************************************************
'*** I got back to the All BASIC Code Home Page a few days ago    ***
'*** and noticed some text-box routines out there.  They worked,  ***
'*** but were awfully slow and didn't seem to offer and saving/   ***
'*** restoring of the text behind the window options.  Well, here ***
'*** are some 100% QBASIC code routines for doing just that--and  ***
'*** very quickly, I might add. =)                                ***
'*** These windows also give the option of a shadow.  The shadow  ***
'*** actually shadows the character underneath the window (I did  ***
'*** notice one of the box routines also did this, but it was     ***
'*** pretty lethargic about it).                                  ***
'********************************************************************
'*** First, use ReadBuffer() to save what's behind the window you ***
'*** intend to open.                                              ***
'*** Next, use OpenWindow() to open that window.                  ***
'*** Finally, use WriteBuffer() to restore what was behind the    ***
'*** window you opened.                                           ***
'********************************************************************
'
'
'**********************************************************************
'*** As always, this code is freely released to the public.  Please ***
'*** give credit where credit is due if you use these routines. Any ***
'*** questions or comments can be directed to me at:                ***
'***                                                                ***
'***              leger@earthlink.net                               ***
'***                                                                ***
'***           Once again, thanks for keeping BASIC alive!          ***
'**********************************************************************

DEFINT A-Z

DECLARE SUB OpenWindow (style, x1, y1, x2, y2, fore, back, shadow)
DECLARE SUB ReadBuffer (x1, y1, x2, y2, buffer() AS INTEGER)
DECLARE SUB WriteBuffer (x1, y1, x2, y2, buffer() AS INTEGER)

'*** I went ahead and made the buffer large enough to store the
'*** entire screen's contents, though this is hardly necessary.
'*** The buffer must be setup like this: BUF([X WIDTH],[Y WIDTH],1 TO 2)
'*** The buffer routines check if you used the an option base of 1 or 0,
'*** so don't sweat that. BUF(X,Y,1) is the character, BUF(X,Y,2) is the
'*** color code.
DIM buffer(1 TO 80, 1 TO 25, 1 TO 2)

CLS
WIDTH 80, 25
VIEW PRINT 1 TO 25

COLOR 7, 0
COLOR 15, 1: LOCATE 1, 1: PRINT STRING$(80, " ");
LOCATE 1, 30: PRINT "Fast Windows in QBasic"
LOCATE 25, 1: PRINT STRING$(80, " ");
LOCATE 25, 18: PRINT "Press ESC to Abort/Any Other Key for New Window";

COLOR 3, 0
FOR y = 2 TO 24
   LOCATE y, 1: PRINT STRING$(80, "#");
NEXT y
COLOR 7
LOCATE 5, 5: PRINT " Notice how the background is restored. "
LOCATE 10, 25: PRINT " Notice how the background is restored. "
LOCATE 15, 5: PRINT " Notice how the background is restored. "
LOCATE 20, 25: PRINT " Notice how the background is restored. "

'*** Let's put up some random windows.
RANDOMIZE TIMER
DO
 
  x1 = INT(RND * 50) + 1
  y1 = INT(RND * 5) + 2
  x2 = INT(RND * 15) + 65
  y2 = INT(RND * 15) + 9
  fore = 15
  back = 1
  style = INT(RND * 5) + 1
  shadow = INT(RND * 2)

  '*** Store what's behind the window
  ReadBuffer x1, y1, x2, y2, buffer()

  '*** Open the window
  OpenWindow style, x1, y1, x2, y2, fore, back, 1  'shadow

  '*** Wait for a keypress
  z$ = ""
  DO WHILE z$ = ""
   z$ = INKEY$
  LOOP

  '*** Restore the background
  WriteBuffer x1, y1, x2, y2, buffer()

LOOP UNTIL z$ = CHR$(27)   '*** ESCAPE key?  If not, new window...

'******************************************
'*** OpenWindow() *** by Jonathan Leger ***
'************************************************************************
'*** I've seen some text-window routines in the All Basic Code page   ***
'*** lately that, although they did the job, they did it hideously    ***
'*** slowly.  So here's a sub that draws your windows quickly, with   ***
'*** or without a shadow (which shadows characters already on-screen) ***
'*** and with 5 styles available--see below for style info.           ***
'************************************************************************
'*** Syntax:
'***     OpenWindow style, x1, y1, x2, y2, fore, back, shadow
'***                  ^     ^   ^   ^   ^     ^     ^      ^
'***  window          |     |   |   |   |     |     |      |
'***  style # (1-5)---+     |   |   |   |     |     |      |
'***  (see below)           |   |   |   |     |     |      |
'***                        |   |   |   |     |     |      |
'***                        |   |   |   |     |     |      |
'***  top left coordinates -+---+   |   |     |     |      |
'***                                |   |     |     |      |
'***  bottom right coordinates -----+---+     |     |      |
'***                                          |     |      |
'***  foreground & background colors ---------+-----+      |
'***                                                       |
'***  use shadow (1) no shadow (0) ------------------------+
'***
SUB OpenWindow (style, x1, y1, x2, y2, fore, back, shadow)

COLOR fore, back

SELECT CASE style
   CASE 1
        'ÚÄÄÄ¿
        '³   ³
        'ÀÄÄÄÙ
        to$ = CHR$(218) + STRING$((x2 - x1) - shadow - 2, 196) + CHR$(191)
        mi$ = CHR$(179) + STRING$((x2 - x1) - shadow - 2, " ") + CHR$(179)
        bo$ = CHR$(192) + STRING$((x2 - x1) - shadow - 2, 196) + CHR$(217)
   CASE 2
        'ÉÍÍÍ»
        'º   º
        'ÈÍÍͼ
        to$ = CHR$(201) + STRING$((x2 - x1) - shadow - 2, 205) + CHR$(187)
        mi$ = CHR$(186) + STRING$((x2 - x1) - shadow - 2, " ") + CHR$(186)
        bo$ = CHR$(200) + STRING$((x2 - x1) - shadow - 2, 205) + CHR$(188)
   CASE 3
        'ÕÍÍ͸
        '³   ³
        'ÔÍÍ;
        to$ = CHR$(213) + STRING$((x2 - x1) - shadow - 2, 205) + CHR$(184)
        mi$ = CHR$(179) + STRING$((x2 - x1) - shadow - 2, " ") + CHR$(179)
        bo$ = CHR$(212) + STRING$((x2 - x1) - shadow - 2, 205) + CHR$(190)
   CASE 4
        'ÖÄÄÄ·
        'º   º
        'ÓÄÄĽ
        to$ = CHR$(214) + STRING$((x2 - x1) - shadow - 2, 196) + CHR$(183)
        mi$ = CHR$(186) + STRING$((x2 - x1) - shadow - 2, " ") + CHR$(186)
        bo$ = CHR$(211) + STRING$((x2 - x1) - shadow - 2, 196) + CHR$(189)
   CASE 5
        'ÛÛÛÛÛ
        'ÛÛÛÛÛ
        'ÛÛÛÛÛ
        to$ = STRING$((x2 - x1) - shadow, " ")
        mi$ = STRING$((x2 - x1) - shadow, " ")
        bo$ = STRING$((x2 - x1) - shadow, " ")
END SELECT

LOCATE y1, x1: PRINT to$
FOR y = (y1 + 1) TO (y2 - (1 + shadow))
   LOCATE y, x1: PRINT mi$;
   IF (y - y1) >= shadow THEN
      FOR s = 1 TO shadow
         clr = SCREEN(y, x2 - shadow + s, 1) MOD 16
         bkg = SCREEN(y, x2 - shadow + s, 1) / 16
         char$ = CHR$(SCREEN(y, x2 - shadow + s))
         IF bkg > 7 THEN
            clr = 24
         ELSE
            clr = 8
         END IF
         COLOR clr, 0
         PRINT char$;
      NEXT s
      COLOR fore, back
   END IF
NEXT y

LOCATE (y2 - shadow), x1: PRINT bo$;
FOR s = 1 TO shadow
   clr = SCREEN(y, x2 - shadow + s, 1) MOD 16
   bkg = SCREEN(y, x2 - shadow + s, 1) / 16
   char$ = CHR$(SCREEN(y, x2 - shadow + s))
   IF bkg > 7 THEN
      clr = 24
   ELSE
      clr = 8
   END IF
   COLOR clr, 0
   PRINT char$;
NEXT s
COLOR fore, back

IF shadow > 0 THEN
   FOR l = 1 TO shadow
      LOCATE (y2 - shadow + l), (x1 + shadow)
      FOR s = 1 TO (x2 - x1 - shadow)
         clr = SCREEN(y2 - shadow + l, x2 - shadow, 1) MOD 16
         bkg = SCREEN(y2 - shadow + l, x2 - shadow, 1) / 16
         char$ = CHR$(SCREEN(y2 - shadow + l, x1 + s))
         IF bkg > 7 THEN
            clr = 24
         ELSE
            clr = 8
         END IF
         COLOR clr, 0
         PRINT char$;
      NEXT s
      COLOR fore, back
   NEXT l
END IF

END SUB

'******************************************
'*** ReadBuffer() *** by Jonathan Leger ***
'******************************************
'*** Reads a block of text & color info ***
'*** off the screen to save the text    ***
'*** behind where a window is going to  ***
'*** be put.                            ***
'******************************************
SUB ReadBuffer (x1, y1, x2, y2, buffer() AS INTEGER)

'*** I used PEEKs here (and POKEs in WriteBuffer()) because
'*** they are so much faster than LOCATE and the SCREEN()
'*** function.

DEF SEG = &HB800           '*** Screen 0 segment

buf = LBOUND(buffer)
char = 1
FOR y = y1 TO y2
   FOR x = x1 TO x2
      buffer(char, buf, 1) = PEEK(((y - 1) * 160) + ((x - 1) * 2))
      buffer(char, buf, 2) = PEEK(((y - 1) * 160) + ((x - 1) * 2) - 1)
      char = char + 1
   NEXT x
   char = 1
   buf = buf + 1
NEXT y

DEF SEG                    '*** Reset to BASIC default segment

END SUB

'*******************************************
'*** WriteBuffer() *** by Jonathan Leger ***
'*******************************************
'*** Writes a block of text & color info ***
'*** onto the screen to restore the text ***
'*** behind where a window was put.      ***
'*******************************************
SUB WriteBuffer (x1, y1, x2, y2, buffer() AS INTEGER)

'*** I used POKEs here (and PEEKs in ReadBuffer()) because
'*** they are so much faster than LOCATE and the SCREEN()
'*** function.

DEF SEG = &HB800        '*** Screen 0 segment

buf = LBOUND(buffer)
char = 1
FOR y = y1 TO y2
   FOR x = x1 TO x2
      POKE ((y - 1) * 160) + ((x - 1) * 2) - 1, buffer(char, buf, 2)
      POKE ((y - 1) * 160) + ((x - 1) * 2), buffer(char, buf, 1)
      char = char + 1
   NEXT x
   buf = buf + 1
   char = 1
NEXT y

DEF SEG                 '*** Reset segment to BASIC default

END SUB