'---------------------------------------------------------------------------
'
'                     QBASWIN II DEMONSTRATION PROGRAM
'                         written by John Strong
'                              July 1992
'
'  THIS IS PUBLIC DOMAIN SOFTWARE.  YOU MAY FREELY DISTRIBUTE THIS PROGRAM
'  ONLY IN ITS ORIGINAL FORM.  MODIFIED VERSIONS ARE NOT TO BE DISTRIBUTED.
'
'  For more information on QuickBASIC programming libraries or if you have
'  any questions about QBASWIN II, you may contact the author, John Strong,
'  at Strongsoft, 3155 SW 178th Avenue, Aloha, OR 97006. (203)436-2836
'
'  To create your own program using QBASWIN II, refer to file QBASWIN2.TMP
'---------------------------------------------------------------------------

DECLARE SUB Background ()
DECLARE SUB BlatantAd ()
DECLARE SUB Delay (n%)
DECLARE SUB GoodBye ()
DECLARE SUB HowToUse ()
DECLARE SUB InitWindow (mem%)
DECLARE SUB Intro ()
DECLARE SUB PopDown ()
DECLARE SUB PopUp (ulr%, ulc%, lrr%, lrc%, attr%, frame%, shadow%, saveit%)
DECLARE SUB Stacker ()
DECLARE SUB WhatsNew ()
DECLARE SUB ZoomDown (snd%, zooms%)
DECLARE SUB ZoomUp (ulr%, ulc%, lrr%, lrc%, attr%, frame%, shadow%, saveit%, snd%, zooms%)
REDIM SHARED work%(0), winmem%(0)  'InitWindow will redim these

winmem% = 32766                    'window memory buffer size at maximum
InitWindow winmem%                 'this must be done first!

'--------------------------------------------------------------------------

Background                         'create background pattern
Intro                              'do snazzy intro           
WhatsNew                           'text on the new features of QBASWIN II
Stacker                            'demo on stacking windows
HowToUse                           'tutorial on using QBASWIN II
BlatantAd                          'I gotta plug my own software!
GoodBye                            'I'm outta here

END

whatsnewtext:
DATA "QBASWIN II is the latest incarnation of a windowing utility I wrote a little"
DATA "over a year ago called QBASWIN.BAS.  QBASWIN proved to be a very popular"
DATA "little program that gave Microsoft QBASIC, a non-compiling version of"
DATA "QuickBASIC, pop-up window capability.  QBASWIN.BAS contained a small"
DATA "machine-language program that allowed even the novice QBASIC programmer to"
DATA "supercharge the ho-hum menus typical of non-compiled BASIC."
DATA ""
DATA "So what's different with QBASWIN II?  Glad you asked!  The ability to create"
DATA "create super-fast pop-up windows is surely a great addition to QBASIC, but"
DATA "what about when you want to erase a window?  Users wanted to pop up a window"
DATA "and then pop it down again without disturbing the screen underneath, which"
DATA "QBASWIN couldn't do.  But QBASWIN II does!"
DATA ""
DATA "In fact, QBASWIN II will allow you to pop and unpop windows, stack and"
DATA "unstack windows, even create zooming windows!  As with the previous version,"
DATA "QBASWIN II features transparent shadowing and frame."
DATA " "
DATA "I hereby put QBASWIN II in the public domain -- it can be freely distributed"
DATA "as long as it remains in its original form and is not modified in any way."
DATA " "
DATA "                Hit any key to see the window stacking demo!"
                       
UsingText:
DATA "Using QBASWIN II is even easier than using QBASWIN I!
DATA " "
DATA "Accompanying this demo program is a file called QBASWIN2.TMP, which is a"
DATA "template on which to build your QBASIC programs using QBASWIN II.  Merely"
DATA "copy the template file to a .BAS file, i.e., COPY QBASWIN2.TMP MYPROG.BAS,"
DATA "load up the newly created .BAS file into QBASIC and start programming!"
DATA "The window routines are already set up and are ready to go."
DATA ""
DATA "There are four window routines that you can use - PopUp, PopDown, ZoomUp,"
DATA "and ZoomDown.  PopUp will create a window and optionally preserve the"
DATA "underlying screen, and PopDown will restore the most recently saved window."
DATA "Similarly, ZoomUp will create an exploding window effect, and ZoomDown will"
DATA "restore the most recently saved zoomed windows."
DATA ""
DATA "The syntax for PopUp is:"
DATA "         CALL PopUp(ulr%,ulc%,lrr%,lrc%,attr%,frame%,shadow%,saveit%)"
DATA "where:"
DATA "        ulr% - upper left row         attr%   - color scheme"
DATA "        ulc% - upper left column      frame%  - frame switch, 1 or 0"
DATA "        lrr% - lower right row        shadow% - shadow switch, 1 or 0"
DATA "        lrc% - lower right column     saveit% - window save switch, 1 or 0"
DATA "                             (Hit any key)"

DATA "The arguments ulr%, ulc%, lrr%, and lrc% are fairly self-explanatory."
DATA "However, the next four might need a little clarification."
DATA " "
DATA "attr%:   This is a color attribute, a number than contains both foreground"
DATA "         and background color information.  The attribute is the background"
DATA "         color times 16 plus the foreground color.  So, for white (7) on"
DATA "         blue (1), the attribute would be (1 * 16) + 7 = 23."
DATA ""
DATA "frame%:  Setting this to 1 will result in a frame around the window, while"
DATA "         setting it to 0 will prevent a frame from being displayed."
DATA " "
DATA "shadow%: Setting this to 1 will result in a transparent shadow underneath"
DATA "         the window, while setting it to 0 will result in no shadow."
DATA " "
DATA "saveit%: The underlying screen will be saved if this is set to 1, allowing"
DATA "         it to be restored later.  No screen save will occur if this is"
DATA "         set to 0."
DATA ""
DATA "The syntax for PopDown is:"
DATA "                             CALL PopDown
DATA "(pretty simple, huh?)"
DATA "                             (Hit any key)"

DATA "Using ZoomUp and ZoomDown is much the same, except that there are two"
DATA "extra arguments in ZoomUp and two arguments in ZoomDown."
DATA " "
DATA "The syntax for ZoomUp is:"
DATA "  CALL ZoomUp(ulr%,ulc%,lrr%,lrc%,attr%,frame%,shadow%,saveit%,snd%,zooms%)"
DATA "where:"
DATA "         snd% - sound switch           zooms% - number of saves"
DATA " "
DATA "snd%:    Setting this to 1 will enable sound effects."
DATA " "
DATA "zooms%:  This argument is used between the ZoomUp and ZoomDown routines"
DATA "         and is not an input; it just needs to be in the argument list."
DATA "         It tells the ZoomDown routine how many screen restores need to be"
DATA "         done to zoom down a zoomed window.
DATA ""
DATA "The syntax for ZoomDown is:"
DATA "                      CALL ZoomDown(snd%,zooms%)
DATA "where snd% is used as in ZoomUp and zooms% is as described above.  Once"
DATA "again, zooms% is not an input, it just needs to be there.  Trust me!"
DATA " "
DATA "                             (Hit any key)"
DATA " "

BlatantText:
DATA "OK, here's the part where I get to plug my shareware library!  If you've"
DATA "liked how QBASWIN II can supercharge a user interface in QBASIC, then you"
DATA "ought to take a look at
DATA " "
DATA "       *******    EZ-Windows Volume I,  from Strongsoft  *******
DATA " "
DATA "a user interface toolkit for QuickBASIC 4.5 and PDS 7.x.  This library "
DATA "allows the QB programmer to create slick front ends to their programs and"
DATA "forever do away with those choose-by-number menus.  Pulldown menus, pop-up"
DATA "windows with *many* frame and shadow options, scrolling and tagging menus,"
DATA "input routines, dialogue boxes, and much more are included.  And all"
DATA "routines support a mouse!"
DATA " "
DATA "Look for the file EZW1V30A.ZIP on your local BBS, or contact the author"
DATA "(John Strong) to receive the shareware library.  I can be reached at:
DATA " "
DATA "                        Strongsoft"
DATA "                        3155 SW 178th Avenue"
DATA "                        Aloha, OR 97006"
DATA "                        (203) 436-2836 (current number)
DATA " "
DATA "                        (Hit any key to end demo)"


'-------------------- Machine Language Program Data ------------------------
prog:
DATA 55,8B,EC,83,EC,10,53,51,6,57,56,B9,8,0,BF,0,0,8B,5B,6,8B,7,48,89
DATA 43,F0,47,47,E2,F3,FF,46,F6,FF,46,F4,FF,46,F2,FF,46,F0,BB,0,B0,A1,10,0
DATA 25,30,0,3D,30,0,74,3,BB,0,B8,8E,C3,8B,5E,FE,B8,A0,0,F7,E3,8B,5E,FC
DATA D1,E3,3,C3,8B,F8,57,8B,46,F8,8B,5E,FC,2B,C3,40,8B,D8,53,8B,46,FA,8B,56
DATA FE,2B,C2,40,8B,C8,51,8B,46,F6,3D,0,0,7F,5B,F7,D0,40,89,46,F6,1E,6,57
DATA 51,53,8B,F7,6,8B,46,F0,8E,C0,1F,26,8B,3E,0,0,83,C7,A,57,41,43,51,51
DATA 8B,CB,F3,A5,59,2B,F3,2B,F3,81,C6,A0,0,E2,F0,59,26,89,3E,0,0,8B,46,FE
DATA 26,89,5,8B,46,FC,26,89,45,2,8B,46,FA,26,89,45,4,8B,46,F8,26,89,45,6
DATA 58,26,89,45,8,5B,59,5F,7,1F,BA,0,0,8A,66,F6,B0,20,83,7E,F4,0,74,5
DATA B0,C4,BA,1,0,51,8B,CB,83,7E,F4,0,74,8,50,B0,B3,AB,83,E9,1,58,F3,AB
DATA 83,7E,F4,0,74,8,50,83,EF,2,B0,B3,AB,58,83,FA,0,75,E,83,7E,F2,0,74
DATA 8,50,B0,8,47,AA,4F,4F,58,2B,FB,2B,FB,81,C7,A0,0,59,B0,20,83,7E,F4,0
DATA 74,7,83,F9,2,75,2,B0,C4,BA,0,0,E2,AF,83,7E,F2,0,74,B,8B,CB,B0,8
DATA 83,C7,2,47,AA,E2,FC,83,7E,F4,0,74,27,59,5B,5F,B0,DA,AB,3,FB,3,FB,83
DATA EF,4,B0,BF,AB,50,B8,A0,0,49,F7,E1,3,F8,58,83,EF,2,B0,D9,AB,2B,FB,2B
DATA FB,B0,C0,AB,5E,5F,7,59,5B,8B,E5,5D,CA,10,0
DATA 55,8B,EC,53,51,52,6,57,56,1E,BB,0,B0,A1,10,0,25,30,0,3D,30,0,74,5
DATA BB,0,B8,8E,C3,8B,76,6,8E,1C,8B,36,0,0,83,FE,0,74,44,8B,1C,B8,A0,0
DATA F7,E3,8B,5C,2,D1,E3,3,C3,8B,F8,8B,44,6,8B,5C,2,2B,C3,40,8B,D8,8B,44
DATA 4,8B,14,2B,C2,40,8B,C8,8B,74,8,83,EE,A,89,36,0,0,83,C6,A,41,43,51
DATA 8B,CB,F3,A5,59,2B,FB,2B,FB,81,C7,A0,0,E2,F0,1F,5E,5F,7,5A,59,5B,8B,E5
DATA 5D,CA,2,0

DEFINT A-Z
SUB Background
    
     COLOR 3, 1                              'cyan on blue
     CLS
     LOCATE 2, 1
     fill$ = "     ** Strongsoft **     "
     FOR j = 1 TO 11
          FOR k = 1 TO 3
               PRINT fill$;
          NEXT
          PRINT "             ";
          FOR k = 1 TO 2
               PRINT fill$;
          NEXT
     NEXT
     Delay 100
END SUB

SUB BlatantAd
    
     attr = 6 * 16 + 14
     ZoomUp 1, 1, 25, 80, attr, 1, 0, 1, 1, zooms1
     COLOR 14, 6
     LOCATE 1, 28
     PRINT "[ Blatant Advertisement ]"
    
     RESTORE BlatantText
     FOR i = 1 TO 22
          READ a$
          IF a$ = "" THEN Delay 1000
          LOCATE i + 2, 3: PRINT a$;
     NEXT
    
     Delay 10000
     ZoomDown 1, zooms1


END SUB

SUB Delay (n)
     n! = n / 100
     IF n! < 0 THEN n! = -n!
     x! = TIMER
     WHILE TIMER < x! + n!
          IF n > 0 THEN
               IF INKEY$ <> "" THEN EXIT SUB
          END IF
     WEND
END SUB

SUB GoodBye

     Delay 100
     attr = 1 * 16 + 7
     ZoomUp 2, 2, 24, 79, attr, 0, 0, 0, 0, zooms0
     COLOR 7, 0
     Delay 100
     CLS

END SUB

SUB HowToUse
    
     attr = 5 * 16 + 14
     ZoomUp 1, 1, 25, 80, attr, 1, 0, 1, 1, zooms1
     COLOR 14, 5
     LOCATE 1, 31
     PRINT "[ Using QBASWIN II ]"
    
     RESTORE UsingText
     FOR j = 1 TO 3
          GOSUB clearscreen
          FOR i = 1 TO 22
               READ a$
               IF a$ = "" THEN Delay 1000
               LOCATE i + 2, 3: PRINT a$;
          NEXT
          Delay 10000
     NEXT
    
     ZoomDown 1, zooms1
     EXIT SUB

clearscreen:
     attr = 5 * 16 + 14
     ZoomUp 2, 2, 24, 79, attr, 0, 0, 0, 0, zooms0
     RETURN

END SUB

SUB InitWindow (mem)
     'work() holds the program
     REDIM work(250)
     DEF SEG = VARSEG(work(0))
     RESTORE prog
     FOR i = 1 TO 499
        READ D$
        POKE i - 1, VAL("&H" + D$)
     NEXT
     DEF SEG
     REDIM winmem(mem)
END SUB

SUB Intro

     attr = 2 * 16 + 14
     ZoomUp 2, 2, 24, 79, attr, 1, 0, 1, 1, zooms1
    
     Delay 25
     attr = 1 * 16 + 15
     ZoomUp 5, 5, 15, 40, attr, 1, 1, 1, 1, zooms2
     COLOR 15, 1
     LOCATE 7, 12: PRINT "Strongsoft Presents..."
     LOCATE 10, 15: PRINT "QBASWIN II !!!"
     LOCATE 12, 17: PRINT "July, 1992"
    
     Delay 200
     attr = 4 * 16 + 14
     PopUp 11, 30, 17, 55, attr, 1, 1, 1
     COLOR 14, 4
     LOCATE 13, 36: PRINT "For DOS 5.0's"
     LOCATE 15, 37: PRINT "QBASIC 1.0"
    
     Delay 200
     attr = 6 * 16
     PopUp 16, 45, 20, 75, attr, 1, 1, 1
     COLOR 0, 6
     LOCATE 18, 47: PRINT "Works with QuickBASIC, too!"
     LOCATE 23, 14
     COLOR 14, 2
     PRINT "(Hit a key at any time to accelerate through the demo)"

     Delay 350
    
     FOR i = 1 TO 2
          PopDown
          Delay 50
     NEXT
     ZoomDown 1, zooms2
     Delay 50
     ZoomDown 1, zooms1

END SUB

SUB PopDown
     DEF SEG = VARSEG(work(0))
     winseg = VARSEG(winmem(0))
     CALL absolute(winseg, 375)
     DEF SEG
END SUB

SUB PopUp (ulr, ulc, lrr, lrc, attr, frame, shadow, saveit)
     IF ulr < lrr AND ulc < lrc THEN
          DEF SEG = VARSEG(work(0))
          winseg = VARSEG(winmem(0))
          IF saveit THEN newattr = -attr ELSE newattr = attr
          CALL absolute(ulr, ulc, lrr, lrc, newattr, frame, shadow, winseg, 0)
          DEF SEG
     END IF
END SUB

SUB Stacker

     frame = 1
     shadow = 1
     saveit = 1
     DEF SEG = 0
     POKE 1050, PEEK(1052)
     DEF SEG
     DO
          FOR i = 1 TO 50
               DEF SEG = 0
               IF PEEK(1050) <> PEEK(1052) THEN ecode = 1: EXIT DO
               DEF SEG
               bg = RND * 7
               fg = RND * 16
               attr = bg * 16 + fg
               ulr = 15 * RND + 1
               lrr = ulr + 8
               ulc = 45 * RND + 1
               lrc = ulc + 33
               PopUp ulr, ulc, lrr, lrc, attr, frame, shadow, saveit
               Delay -1
          NEXT
          COLOR fg, bg
          LOCATE ulr + 4, ulc + 5
          PRINT "Hit any key to continue"
          Delay 100
          FOR i = 1 TO 50
               DEF SEG = 0
               IF PEEK(1050) <> PEEK(1052) THEN ecode = 2
               DEF SEG
               PopDown
               Delay -1
          NEXT
          IF ecode THEN EXIT DO
     LOOP
     IF ecode = 1 THEN
          FOR j = 1 TO i
               PopDown
               Delay -1
          NEXT
     END IF
     DEF SEG = 0
     POKE 1050, PEEK(1052)
     DEF SEG




END SUB

SUB WhatsNew
    
     attr = 3 * 16 + 1
     ZoomUp 1, 1, 25, 80, attr, 1, 0, 1, 1, zooms
     COLOR 3, 1
     LOCATE 1, 35: PRINT " What's New "
     COLOR 1, 3

     RESTORE whatsnewtext
     FOR i = 1 TO 21
          READ a$
          IF a$ = "" THEN Delay 1000
          LOCATE i + 2, 3: PRINT a$
     NEXT

     Delay 10000
     ZoomDown 1, zooms

END SUB

SUB ZoomDown (snd, zooms)
    
     FOR i = 49 TO zooms + 1 STEP -1
          IF snd THEN SOUND i * 110 + 440, .05 ELSE SOUND 0, .08
     NEXT
     FOR i = 1 TO zooms
          PopDown
          IF snd THEN SOUND (zooms - i) * 110 + 440, .08 ELSE SOUND 0, .08
     NEXT
     zooms = 0

END SUB

SUB ZoomUp (ulr, ulc, lrr, lrc, attr, frame, shadow, saveit, snd, zooms)
    
     IF ulr < lrr AND ulc < lrc THEN
          DEF SEG = VARSEG(work(0))
          winseg = VARSEG(winmem(0))
         
          crow = (ulr + lrr) / 2
          ccol = (ulc + lrc) / 2
          IF lrr - ulr > lrc - ulc THEN
               dc = 1
               dr = INT((lrr - ulr) / (lrc - ulc))
          ELSE
               dr = 1
               dc = INT((lrc - ulc) / (lrr - ulr))
          END IF

          ulr0 = crow - 1
          lrr0 = crow + 1
          ulc0 = ccol - 1
          lrc0 = ccol + 1
          c = 0
          z = 1
         
          IF saveit = 1 THEN newattr = -attr ELSE newattr = attr
          DO
               z = z + 2
               CALL absolute(ulr0, ulc0, lrr0, lrc0, newattr, frame, 0, winseg, 0)
               ulr0 = ulr0 - dr
               ulc0 = ulc0 - dc
               CALL absolute(ulr0, ulc0, lrr0, lrc0, newattr, frame, 0, winseg, 0)
               lrr0 = lrr0 + dr
               lrc0 = lrc0 + dc
               IF snd THEN SOUND z * 110 + 440, .08 ELSE SOUND 0, .08
          LOOP UNTIL lrr0 >= lrr OR lrc0 >= lrc
          z2 = z
          CALL absolute(ulr, ulc, lrr, lrc, newattr, frame, shadow, winseg, 0)
                   
          DO UNTIL z2 > 49
               z2 = z2 + 2
               IF snd THEN SOUND z2 * 110 + 440, .08 ELSE SOUND 0, .08
          LOOP

          DEF SEG
     END IF
     zooms = -(saveit = 1) * z

END SUB