home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / basic1 / pro9 / glibdemo.bas < prev    next >
Encoding:
BASIC Source File  |  1987-07-31  |  33.7 KB  |  1,053 lines
  1. '*************************
  2. '* GLIBDEMO
  3. '*
  4. '* Demo of key routines in GIZLIB
  5. '* (C) InfoSoft 1986, 1987
  6. '*************************
  7. ' This demo will demonstrate some of the
  8. ' routines of the QuickBASIC GIZLIB that
  9. ' should accompany it.
  10. ' Additionally it will augment the DOCs with its actual use.
  11. '**************************
  12. CLEAR
  13. DEFINT a-z
  14. OPTION BASE 1
  15.  
  16. quote$=CHR$(34) : clr$=SPACE$(78)
  17.  
  18. 'make sure it is set up right
  19.  
  20. chkset:
  21. CLS : SOUND 750,2 : LOCATE 5,5
  22. PRINT "Depending on your display, you may want to restart this demo"
  23. LOCATE 7,5
  24. PRINT "with the command line parameter [/CMD /NC] or [/CMD /C]. /NC for"
  25. LOCATE 9,5
  26. PRINT "No Color, /C for color version.   This should be noted in DEMO.BAT"
  27. LOCATE 13,5
  28. PRINT "Tap `S' to stop the demo, any other key to continue."
  29.  
  30. ky$=INKEY$
  31. WHILE ky$=""
  32.   ky$=INKEY$
  33. WEND
  34. print KY$
  35.  
  36. IF ky$="S" OR ky$="s" THEN
  37.    ky$=""
  38.    GOTO extt
  39. END IF
  40.  
  41. '*********** get command line parms and set colors
  42. DIM arg$(6) : q%=0
  43.  
  44. FOR x=1 TO 6
  45.   arg$(x)=SPACE$(LEN(COMMAND$)/2)
  46. NEXT x
  47. CALL cmdline(arg$(),q%)
  48.  
  49. IF arg$(1)="/NC" THEN
  50.    cmode=0
  51.    fg=7:bg=0
  52.    fge=15:bge=0
  53.    fgw=0:bgw=7
  54.    fgs=7:bgs=0
  55.    fgt=15 : fgd=15
  56. ELSE
  57.    cmode=1
  58.    fg=3:bg=0
  59.    fge=12:bge=3
  60.    fgw=14:bgw=4
  61.    fgs=11:bgs=0
  62.    fgt=10 : fgd=14
  63. END IF
  64.  
  65. eattr=(bge*16)+fge
  66. wattr=(bgw*16)+fgw
  67. attr=(bg*16)+fg
  68.  
  69. IF q=0 THEN
  70.      arg$(2)="No command line entered."
  71. END IF
  72.  
  73. COLOR fg,bg
  74. CLS
  75. GOSUB title
  76. COLOR fgs,bgs
  77.  
  78.  
  79.  
  80. ' start with the easy ones
  81. dosver:         '*************************************
  82.     dos%=0
  83.     CALL dosv(dos%)
  84.     'the dos version * 100 will return in DOS variable
  85.  
  86.     LOCATE 5,15:PRINT "Function: DOSV  - Get DOS version."
  87.     LOCATE 6,15:PRINT "Syntax: dos%=0: CALL dosv(dos%)"
  88.  
  89.  
  90.     LOCATE 10,5:COLOR fg,bg
  91.  
  92.     PRINT "Like most other QB libs, GIZLIB contains a routine to fetch the"
  93.     LOCATE 11,5:PRINT "DOS version number.  Unlike most others, it returns"
  94.     LOCATE 12,5:PRINT "a single whole number rather than a MAJOR and MINOR version."
  95.     LOCATE 14,5:PRINT "On your machine, DOSV returned ";:COLOR fgs,0 : PRINT dos
  96.     COLOR fg,bg
  97.     LOCATE 16,5:PRINT "This makes it a little more workable and fewer variables."
  98.     LOCATE 17,5:PRINT "Simply divide by 100 to get a legitimate number: ";:
  99.     COLOR fgs,0 : PRINT dos/100 : COLOR fg,bg
  100.  
  101.     GOSUB wait.key
  102.     CLS:GOSUB title
  103.  
  104.  
  105. dspace:          '************************
  106.      a%=0:b%=0:c%=0:d%=0         'initialize vars for the call
  107.                      ' a is drive to poll:
  108.                      ' 1=A, 2=B etc 0=Default
  109.  
  110.      CALL drvspace(a%,b%,c%,d%)      ' get drive and free space
  111.      total#=CDBL(a%)*CDBL(c%)*CDBL(d%)
  112.      free#=CDBL(a%)*CDBL(c%)*CDBL(b%)
  113.  
  114.      LOCATE 5,15:PRINT"Function: DRVSPACE - Get drive info."
  115.      LOCATE 6,15: PRINT "Syntax:   a%=0:b%=0:c%=0:d%=0 : CALL drvspace(a%,b%,c%,d%) "
  116.  
  117.      COLOR fg,bg
  118.  
  119.  
  120.      LOCATE 10,5:PRINT" Also like other LIBs, we can get the size of a drive"
  121.      LOCATE 11,5:PRINT" and/or free space."
  122.      LOCATE 13,5:PRINT" We have already done it to find:"
  123.      LOCATE 15,10:PRINT" Total drive space is: ";: COLOR fgs,0 : PRINT total#
  124.      COLOR fg,bg
  125.      LOCATE 16,10:PRINT" Free space is: ";: COLOR fgs,0 : PRINT free#
  126.  
  127.      GOSUB wait.key
  128.      CLS:GOSUB title
  129.  
  130.  
  131. sysinfo:        '*************************
  132.   ram%=0:ser%=0:par%=0
  133.   CALL sinfo(ram%,ser%,par%,ega%)
  134.  
  135.   LOCATE 5,15 : PRINT "Function: SINFO - Get peripheral info "
  136.   LOCATE 6,15 : PRINT "Syntax: ram%=0 : ser%=0 : par%=0"
  137.   LOCATE 7,15 : PRINT "CALL sinfo(ram%,ser%,par%,ega%)"
  138.   COLOR fg,bg
  139.  
  140.   LOCATE 9,10:PRINT "Also we can poll the machine to get some hardware"
  141.   LOCATE 10,10:PRINT "and peripheral info:"
  142.   LOCATE 12,10:PRINT "RAM installed: ";: COLOR fgs,0 : PRINT ram% : COLOR fg,0
  143.   LOCATE 13,10:PRINT "# Serial ports:";: COLOR fgs,0 : PRINT ser% : COLOR fg,0
  144.   LOCATE 14,10:PRINT "Parallel ports:";: COLOR fgs,0 : PRINT par% : COLOR fg,0
  145.   LOCATE 15,10:PRINT "EGA memory    : ";: COLOR fgs,0
  146.   SELECT CASE ega%
  147.     CASE 1 : PRINT "64k"
  148.     CASE 2 : PRINT "128k"
  149.     CASE 3 : PRINT "256k"
  150.     CASE ELSE : PRINT "None"
  151.   END SELECT
  152.   COLOR fg,0
  153.  
  154.   LOCATE 16,5:PRINT "If your system is an AT, a separate routine returns any ";
  155.        PRINT "installed"
  156.   LOCATE 17,5:PRINT "Extended memory.
  157.  
  158.   GOSUB wait.key
  159.   CLS:GOSUB title
  160.  
  161.  
  162. dformat:
  163.   LOCATE 5,15 : PRINT "Function: DFRMAT - Formats a date."
  164.   LOCATE 6,15 : PRINT "Syntax: m=[1-12] : d=[1-31] : y=[1800+] "
  165.   LOCATE 7,15 : PRINT "CALL dfrmat(m%, d%, yr%, nudate$)"
  166.   COLOR fg,bg : m=0 : d=0 : y=0 : dow=0
  167.   CALL date(m%, d%, yr%, dow%)
  168.   CALL dfrmat(m%, d%, yr%, nudate$)
  169.  
  170.   LOCATE 9,10 : PRINT "This simply allows you to easily put a more friendly face"
  171.   LOCATE 10,10 : PRINT "on BASIC's rather unfreindly DATE$, by formatting the"
  172.   LOCATE 11,10 : PRINT "system date, or any other date with the month name etc."
  173.  
  174.   LOCATE 13,10 : PRINT "Today's DATE$ is ";DATE$
  175.   LOCATE 14,10 : PRINT "DFRMAT freshens it to :";:COLOR fgs,0:PRINT nudate$
  176.   COLOR fg,bg
  177.   LOCATE 16,10 : PRINT "Since DFRMAT works off integers, you can easily format a"
  178.   LOCATE 17,10 : PRINT "string for days gone by, and to easily and quickly get todays"
  179.   LOCATE 18,10 : PRINT "date in integer format, the routine DATE returns the day,"
  180.   LOCATE 19,10 : PRINT "month and year as well as the day of the week as integers."
  181.  
  182.   GOSUB wait.key
  183.   CLS:GOSUB title
  184.  
  185.  
  186. tformat:
  187.   LOCATE 5,15 : PRINT "Function: TFRMAT - Format BASIC's TIME$"
  188.   LOCATE 6,15 : PRINT "Syntax: label%=[0/1] : nutime$=TIME$"
  189.   LOCATE 7,15 : PRINT "CALL tfrmat(label%,nutime$)"
  190.   COLOR fg,bg
  191.   nutime0$=TIME$ : CALL tfrmat(0,nutime0$)
  192.   nutime1$=TIME$ : CALL tfrmat(1,nutime1$)
  193.  
  194.  
  195.   LOCATE 9,10  : PRINT " Likewise we can cleanup BASIC's time output to a cleaner,";
  196.   LOCATE 10,10 : PRINT " more professional display with simple call."
  197.  
  198.   LOCATE 12,10:PRINT "The current time is: ";TIME$
  199.   LOCATE 13,10:PRINT "TFRMAT freshens it to :"; : COLOR fgs,0 : PRINT nutime0$
  200.   COLOR fg, bg : LOCATE 14,10 : PRINT "Or to ";:COLOR fgs, 0 : PRINT nutime1$
  201.   COLOR fg, bg : LOCATE 16,10 : PRINT "Notice the option of an am/pm label."
  202.  
  203.   GOSUB wait.key
  204.   CLS:GOSUB title
  205.  
  206.  
  207. ucase:
  208.   LOCATE 5,15:PRINT "Function: UCASE, LCASE, PCASE - Input characters formatting."
  209.   LOCATE 6,15:PRINT "Syntax: "
  210.   LOCATE 7,15:PRINT "CALL ucase(text$) : CALL lcase(test$) : CALL pcase(text$)"
  211.   COLOR fg,bg : ky$="" : text$=""
  212.  
  213.   LOCATE 9,10 : PRINT "These routines convert incoming or other text to Upper Case,"
  214.   LOCATE 10,10 : PRINT "lower case or Proper Case (first letter each word)."
  215.  
  216.   LOCATE 13,1 : PRINT "Please type in a few words of text and tap ENTER. "
  217.  
  218.   lin=14 : max=25 : GOSUB get.string
  219.  
  220.   COLOR fg, bg
  221.   CALL ucase(text$)                         ' convert to upper
  222.   LOCATE 18,5 : PRINT "Output from UCASE: ";: COLOR fgs,0 : PRINT text$ : COLOR fg,bg
  223.  
  224.   CALL lcase(text$)                         ' convert to lower
  225.   LOCATE 19,5 : PRINT "Output from LCASE: ";: COLOR fgs,0 : PRINT text$ : COLOR fg,bg
  226.   t$=text$
  227.  
  228.   CALL pcase(text$)                         ' convert to Proper Case
  229.   LOCATE 20,5 : PRINT "Output from PCASE: ";: COLOR fgs,0 : PRINT text$ : COLOR fg,bg
  230.  
  231.   LOCATE 22,5 : PRINT "These leave non alpha characters alone, and do NOT choke on Null strings."
  232.  
  233.   GOSUB wait.key
  234.   CLS:GOSUB title
  235.  
  236.  
  237. err.msg:
  238.   LOCATE 5,15 : PRINT "Function: ERRMSG - Allows you to 'flash' a message to the screen."
  239.   LOCATE 6,15 : PRINT "Syntax: emsg$="+quote$+"Text to display. "+quote$+" emsgline=[any line]"
  240.   LOCATE 7,15 : PRINT "        emsgattr=[(fore*16) + back ] : emsgsnd=[0/1]"
  241.   LOCATE 8,15 : PRINT "CALL errmsg(emsg$, emsgline, emsgattr, emsgsnd)"
  242.   COLOR fg,bg : eml=22 : ems%=2 : max=35
  243.  
  244.   LOCATE 10,10 : PRINT "What ERRMSG does, is save the display on the screen, display"
  245.   LOCATE 11,10 : PRINT "your message, centered, on the line you tell it, sounds a low "
  246.   LOCATE 12,10 : PRINT "tone if you desire, waits 2 secs, then pops the original display"
  247.   LOCATE 13,10 : PRINT "back onto the screen without you having to redraw it."
  248.  
  249.   LOCATE 15,5 : PRINT "Type in a line to use as an error message or <ENTER> for the demo's own."
  250.   lin=16 '*******************************************
  251.   GOSUB get.string
  252.   IF LEN(text$) < 2 THEN text$=" Ooops, an error! - You entered no text!"
  253.   CALL errmsg(text$, eml%, eattr%, ems%)
  254.  
  255.   GOSUB wait.key
  256.   CLS : GOSUB title
  257.  
  258.  
  259.  
  260. dollarf:
  261.   LOCATE 4,15 : PRINT "Function: DLRFRMAT - Format numeric strings from blind input."
  262.   LOCATE 5,15 : PRINT "Syntax:  dollarsgn%=[0/1/2/3] : decimals%=[0/2/3] "
  263.   LOCATE 6,15 : PRINT "CALL dlrfrmat(number$, dollarsign%, decimals%)"
  264.  
  265.   COLOR fg,bg : ky$="" : num$=""
  266.  
  267.   LOCATE 9,10 : PRINT "This routine is helpful in formatting numeric input to a KNOWN format."
  268.   PRINT TAB(10) ; "The DECIMALS switch will return the string formatted to 2 or 3"
  269.   PRINT TAB(10) ; "decimals, 0 mode forces automatic dollar format if no '.' is entered."
  270.   PRINT TAB(10) ; "With the dollarsign switch, we tell DLRFRMAT whether or not we want a"
  271.   PRINT TAB(10) ; "'$' on the returned string and whether or not to demand a decimal."
  272.   PRINT TAB(10) ; "This is useful in dollar value i/o from the keyboard or random files.";
  273.  
  274. inpt1:
  275.   LOCATE 16,5 : PRINT "Please type in a number under $10.00 (include the decimal !). "
  276.   lin=17 : max=6 : GOSUB get.string
  277.  
  278.   PRINT
  279.   num$=text$ : m=0 : p=2         ' save a copy for multiple calls
  280.   CALL dlrfrmat(text$, m, p)
  281.   IF m=0 THEN            ' if they trick me, M indicates an error
  282.      COLOR fg,bg : PRINT "Formatted to 2 decimals, no $: ";: COLOR fgs,bgs :
  283.      PRINT text$
  284.   ELSE
  285.      CALL errmsg(text$,eml,eattr, ems)
  286.      LOCATE 17,1 : PRINT clr$;
  287.      GOTO inpt1
  288.   END IF
  289.  
  290.  
  291.   m=1 : p=2                           ' reset pointers
  292.   text$=num$
  293.   CALL dlrfrmat(text$, m, p)
  294.  
  295.   COLOR fg,bg : PRINT "Formatted to 2 decimals, with $: ";: COLOR fgs,bgs :
  296.   PRINT text$
  297.  
  298.   GOSUB wait.key
  299.  
  300.   FOR x=15 TO 23                      ' clear lower (demo) portion of screen
  301.      LOCATE x,1
  302.      PRINT clr$;
  303.   NEXT
  304.  
  305.  
  306.   LOCATE 16,5 : PRINT "Please type in a number under $10.00 (DO NOT include the decimal !). "
  307.   lin=17 : max=6 : GOSUB get.string
  308.  
  309.   PRINT
  310.   m=1 : p=0
  311.   CALL dlrfrmat(text$, m, p)
  312.   COLOR fg,bg : PRINT "Formatted in auto mode, with $: ";: COLOR fgs,bgs :
  313.   PRINT text$
  314.  
  315.   GOSUB wait.key
  316.  
  317.   FOR x=9 TO 23        ' clear lower (demo) portion of screen
  318.      LOCATE x,1
  319.      PRINT clr$;
  320.   NEXT
  321.  
  322.   LOCATE 10,5 : PRINT "You really need to toy with this one as it is VERY powerful, more"
  323.   PRINT TAB(5) ; "so than this demo shows.  The auto mode would take input of '2' and"
  324.   PRINT TAB(5) ; "ouput is either $.02 or .02 depending on what you set the dollar sign"
  325.   PRINT TAB(5) ; "switch to.  You can also force a decimal to be entered, if the user"
  326.   PRINT TAB(5) ; "does not, dollarsgn returns an error condition, and number$ returns
  327.   PRINT TAB(5) ; "a message directly usable in ERRMSG (which you may have seen).  In
  328.   PRINT TAB(5) ; "the case of invalid characters like A-z, [{*&^, the decimals%
  329.   PRINT TAB(5) ; "parameter points to the invalid character."
  330.  
  331.  
  332.   GOSUB wait.key
  333.   CLS:GOSUB title
  334.  
  335. keylox:
  336.   LOCATE 5,15 : PRINT "Function: KEYLOCKS - Allows you to toggle the NumLock,"
  337.   LOCATE 6,15 : PRINT "          CapsLock and Scroll Lock Keys"
  338.   LOCATE 7,15 : PRINT "Syntax: CALL NLON, NLOFF, CLON, CLOFF, SCRLON or SCRLOFF "
  339.  
  340.   COLOR fg,bg
  341.  
  342.   LOCATE 9,10 : PRINT "Go ahead and type a few keys to see the effect: "
  343.   LOCATE 10,10 : PRINT "Demo will abort after 10 keypresses or with <ESC>."
  344.   PRINT : PRINT : COLOR fgs,0 : y=1 : ky$="" : l=5 : h=13
  345.  
  346.   FOR x=1 TO 10
  347.     WHILE ky$=""
  348.       ky$=INKEY$
  349.     WEND
  350.     LOCATE h,l
  351.     IF ky$=CHR$(27) THEN GOTO keylox.end
  352.     PRINT ky$;"    ";
  353.     h=CSRLIN : l=POS(0)
  354.      IF y=1 THEN
  355.     CALL nlon
  356.     CALL clon
  357.     y=0
  358.     LOCATE 24, 45 : PRINT "Nums ON     Caps ON ";
  359.      ELSE
  360.     CALL nloff
  361.     CALL cloff
  362.     y=1
  363.     LOCATE 24, 45 : PRINT "Nums OFF    Caps OFF";
  364.      END IF
  365.      ky$=""
  366.   NEXT x
  367.  
  368. keylox.end:
  369.   COLOR fg,bg : CALL nloff : CALL clon
  370.   BEEP
  371.   LOCATE 24,1 : PRINT SPACE$(79);
  372.   GOSUB wait.key
  373.   CLS:GOSUB title
  374.  
  375.  
  376. kb.loop:
  377.   LOCATE 5,15 : PRINT "Function: KBLOOP - Allows you to loop thru other functions while"
  378.   LOCATE 6,15 : PRINT "          waiting for keyboard input."
  379.   LOCATE 7,15 : PRINT "Syntax: kbin$=SPACE$(x) : time.to.loop%=30 : no$=CHR$(224)"
  380.   LOCATE 8,15 : PRINT "CALL kbloop(kbin$, time.to.loop%, no$)"
  381.  
  382.   COLOR fg,bg
  383.   LOCATE 10,10 : PRINT "The string variable kbin$ will convert to upper case and return"
  384.   PRINT TAB(10) ; "the actual string of keys pressed.  Predefine it to the length you"
  385.   PRINT TAB(10) ; "want to collect: if you start it as SPACE$(1) it will return 1 key,"
  386.   PRINT TAB(10) ; "SPACE$(3) will return a string of 3 keys etc.  The time integer tells"
  387.   PRINT TAB(10) ; "KBLOOP how long to loop internally - make sure the time is long enough"
  388.   PRINT TAB(10) ; "to collect the entire string."
  389.   PRINT TAB(10) ; "If the routine times out, kbin$ returns as no$ to indicate a timeout"
  390.   PRINT TAB(10) ; "has occurred whereby you could execute any routines such as time"
  391.   PRINT TAB(10) ; "display refreshes.  Also useful in security routines"
  392.  
  393.   LOCATE 20,20 : PRINT "Press any key for demo "
  394.   GOSUB waitK2
  395.   LOCATE 20,20 : PRINT "Third keypress or run thru loop terminates."
  396.   x=1 : t=1 : no$="" : n$=CHR$(224) : keycount=0
  397.   COLOR fgs,0
  398.  
  399.  
  400. kb.demo:
  401.   FOR x=1 TO 3
  402.      kbin$=" "
  403.      CALL kbloop(kbin$, t%, no$)
  404.      IF kbin$=no$ THEN
  405.     PRINT TAB(15) ; "No K.B. entry loop number ";x;".  Time refresh: "TIME$;
  406.      ELSE
  407.     PRINT TAB(20); "Key pressed: ";kbin$;
  408.      END IF
  409.      t=3
  410.   NEXT x
  411.  
  412.   BEEP
  413.   GOSUB wait.key
  414.   CLS:GOSUB title
  415.  
  416.  
  417. num.frmat:
  418.   LOCATE 5,15 : PRINT "Function: NFRMAT - Allows you to formatting of numeric strings."
  419.   PRINT TAB(15) ; "          Formats to phone and social security number formats."
  420.   LOCATE 7,15 : PRINT "Syntax: num$=";quote$;12345;quote$;" : mode%=[0|1|2|3|4|5|6]"
  421.   LOCATE 8,15 : PRINT "        p=<place to put '-' in mode 6>"
  422.  
  423.   COLOR fg,bg
  424.   LOCATE 10,10 : PRINT "Mode 0 - Disallows '-' as an element.'
  425.   PRINT TAB(10) ; "Mode 1 - allows '-' as an element."
  426.   PRINT TAB(10) ; "Mode 2 - formats to 7 digit phone: xxx-xxxx"
  427.   PRINT TAB(10) ; "Mode 3 - formats to 10 digit phone: xxx-xxx-xxxx"
  428.   PRINT TAB(10) ; "Mode 4 - formats to social security format: xxx-xx-xxxx"
  429.   PRINT TAB(10) ; "Mode 5 - extarcts numbers from string - no exclusions."
  430.   PRINT TAB(10) ; "Mode 6 - formats to account number style."
  431.   PRINT TAB(10) ; "         p points to location of '-' in returned string."
  432.  
  433.   LOCATE 19,10 : PRINT "Enter seven digits for a phone number:      "
  434.   max=15 : lin=20
  435.   GOSUB get.string
  436.   m=2 : mm=2
  437.   GOSUB nflabel
  438.  
  439.   LOCATE 19,10 : PRINT "Enter 10 digits for a phone number:          "
  440.   GOSUB get.string
  441.   m=3 : mm=3
  442.   GOSUB nflabel
  443.  
  444.   LOCATE 19,10 : PRINT "Enter 11 digits for a social security number:"
  445.   GOSUB get.string
  446.   m=4 : mm=4
  447.   GOSUB nflabel
  448.  
  449.   LOCATE 19,10 : PRINT "Enter some digits as if an account number:   "
  450.   GOSUB get.string
  451.   m=6 : mm=6 : p=3
  452.   GOSUB nflabel
  453.  
  454.   GOTO nf.end
  455.  
  456. nflabel:
  457.   CALL nfrmat(text$,m,p)
  458.   IF m=mm THEN
  459.      LOCATE 20,20 : PRINT "Mode ";m;" output ";text$
  460.   ELSE
  461.      CALL errmsg(text$, 24, eattr, 2)
  462.      LOCATE lin,1 : PRINT clr$;
  463.      text$=""
  464.   END IF
  465.   GOSUB wait.key
  466.   FOR x=19 TO 21
  467.      LOCATE x,1
  468.      PRINT clr$;
  469.   NEXT x
  470.   RETURN
  471.  
  472. nf.end:
  473.   BEEP
  474.   GOSUB wait.key
  475.   CLS : GOSUB title
  476.  
  477.  
  478. chrp.dly:
  479.   LOCATE 5,15 : PRINT "Function: CHRP - Produces a simple Chirp."
  480.   LOCATE 6,15 : PRINT "          0-descending 1-ascending."
  481.   LOCATE 7,15 : PRINT "Syntax: CALL chrp(1) <or> CALL chrp(0) "
  482.   LOCATE 8,15 : PRINT "        Alternative: n=[0 | 1] : CALL chrp(n%) "
  483.  
  484.   LOCATE 11,15 : PRINT "Function: DLY - Produce a delay for x seconds."
  485.   LOCATE 12,15 : PRINT "Syntax: CALL dly(1)"
  486.   LOCATE 13,15 : PRINT "        Alternative: n=13 : CALL dly(n%) "
  487.  
  488.   COLOR fg, bg
  489.   LOCATE 15,10 : PRINT "These are used by other routines, but can be used alone."
  490.   COLOR fgs, 0
  491.  
  492.   y=1 : LOCATE 16, 10
  493.   FOR x= 1 TO 5
  494.      LOCATE 16+x, 10 : PRINT "Delaying ";x;" seconds."
  495.      CALL dly(x)
  496.      IF y=1 THEN y=0 ELSE y=1
  497.      CALL chrp(y)
  498.   NEXT x
  499.  
  500.   GOSUB wait.key
  501.   CLS:GOSUB title
  502.  
  503.  
  504. graf:
  505.   LOCATE 5,15 : PRINT "Function: GRAPH - Produce a Horizontal or Vertical bar graph"
  506.   LOCATE 6,15 : PRINT "          on up to 10 elements"
  507.   LOCATE 7,15 : PRINT "Syntax: CALL hgraph(elements%(), bas%, label$(), title$)"
  508.   LOCATE 8,15 : PRINT "        CALL vgraph(elements%(), bas%, label$(), title$)"
  509.  
  510.   COLOR fg,bg
  511.   LOCATE 10,10 : PRINT "Elements%() holds the values to graph, label$() is another array"
  512.   PRINT TAB(10) ; "holding a set of labels relating to the elements. Base is the divisor"
  513.   PRINT TAB(10) ; "to use for percentage labels (which may or may not be the sum of the"
  514.   PRINT TAB(10) ; "elements).
  515.  
  516.   DIM elmts(10), label$(10)
  517.   elmts(1)=7 : elmts(2)=2 : elmts(3)=9 : elmts(4)=10 : elmts(5)=5
  518.   elmts(6)=4 : elmts(7)=12 : elmts(8)=8 : elmts(9)=75 : elmts(10)=10
  519.   bas=0
  520.   FOR x=1 TO 10
  521.       x$=STR$(x)
  522.       CALL stripl(x$)
  523.       label$(x)="L"+x$
  524.       bas=bas+elmts(X)
  525.   NEXT x
  526.  
  527.   title$="Vertical Graph Demo"
  528.  
  529.   LOCATE 22, 25 : PRINT " Press any key for VERTICAL demo"
  530.   ky$=""
  531.   WHILE ky$=""
  532.     ky$=INKEY$
  533.   WEND
  534.   CLS
  535.   CALL chrp(1)
  536.   CALL vgraph(elmts%(), bas%, label$(), title$)
  537.   DEF SEG = &HB800
  538.   BSAVE "glib.bin",0,4000
  539.   CALL dly(3)
  540.   GOSUB wait.key
  541.   title$="Horizontal Graph Demo"
  542.  
  543.   CLS
  544.   CALL chrp(1)
  545.   CALL hgraph(elmts%(), bas%, label$(), title$)
  546.   CALL dly(3)
  547.   GOSUB wait.key
  548.  
  549.   CLS
  550.   LOCATE 10,5 : PRINT "   HGRAPH and VGRAPH only allow 10 elements to be graphed,"
  551.   PRINT TAB(5) ; "due to the screen size, but they do adequately adjust the spacing"
  552.   PRINT TAB(5) ; "accordingly.  Unfortunately, at the current time the labeling you"
  553.   PRINT TAB(5) ; "saw at the bottom of the screen, is limited to 3 characters."
  554.   PRINT TAB(5) ; "The upside is that the entire algorithm to plot it out, print the"
  555.   PRINT TAB(5) ; "actual count for each element has been worked out for you."
  556.  
  557.   GOSUB wait.key
  558.   CLS:GOSUB title
  559.  
  560. qprt:
  561.   LOCATE 5,15 : PRINT "Function: QUIKPRT - Replacement for BASICA's terribly slow"
  562.   LOCATE 6,15 : PRINT "          PRINT statement."
  563.   LOCATE 7,15 : PRINT "Syntax: msg$=";quote$;"Thing to print";quote$;" : row=x : col=y : attr=(fg*16)+bg)"
  564.   LOCATE 8,15 : PRINT "        CALL quikprt(msg$, row%, col%, attr%) "
  565.  
  566.   COLOR fg,bg
  567.  
  568.   LOCATE 10,10 : PRINT "This is used quite a bit in other routines, but is just as handy
  569.   PRINT TAB(10) ; "used on its own.  Since there is a fair amount of set up for this"
  570.   PRINT TAB(10) ; "routine, it is not given to character based routines, but for string"
  571.   PRINT TAB(10) ; "routines, it can speed things immensely."
  572.   PRINT TAB(10) ; "The attribute parameter is caluculated via the formula:"
  573.   PRINT TAB(10) ; "(FOREGROUND * 16) + BACKGROUND" : COLOR fgs,0
  574.   PRINT TAB(10) ; "The major source for this was in BYTE magazine a few years ago."
  575.   PRINT : COLOR fg,bg
  576.   PRINT TAB(10) ; "To demo this, we will fill the screen with characters 10 times using"
  577.   PRINT TAB(10) ; "PRINT then again using QUIKPRT and then compare the times."
  578.  
  579.   GOSUB wait.key
  580.   CLS
  581.   pstart!=TIMER
  582.   FOR z=1 TO 10
  583.       FOR x=1 TO 24
  584.       PRINT STRING$(80,CHR$(47+z))
  585.       NEXT x
  586.   NEXT z
  587.   pend!=TIMER
  588.  
  589.   CLS : BEEP
  590.  
  591.   qstart!=TIMER
  592.   FOR z=1 TO 10
  593.       FOR x=1 TO 24
  594.     CALL quikprt(STRING$(80,CHR$(47+z)), x, 1, attr%)
  595.       NEXT x
  596.   NEXT z
  597.   qend!=TIMER
  598.  
  599.   pelaps!=pend!-pstart!
  600.   qelaps!=qend!-qstart!
  601.   CLS : LOCATE 10,1
  602.   PRINT "Elapsed time for PRINT ";pelaps!
  603.   PRINT "Elapsed time for QUIKPRT ";qelaps!
  604.  
  605.   GOSUB wait.key
  606.   CLS:GOSUB title
  607.  
  608.  
  609. pscrn:
  610.   LOCATE 5,15 : PRINT "Function: PRTSCRN - Send current display to printer."
  611.   LOCATE 6,15 : PRINT "Syntax:   CALL prtscrn "
  612.  
  613.   COLOR fg,bg : ky$=""
  614.  
  615.   LOCATE 9,10 : PRINT "We can re-display one of the graphs we had earlier and"
  616.   PRINT TAB(10) ; "demo the PRTSCRN function provided you have a printer."
  617.   LOCATE 12, 10 : INPUT "Perform PRTSCRN demo? (Y/n) ",ky$
  618.   CALL ucase(ky$)
  619.   IF ky$="N" THEN GOTO pscrn.end
  620.  
  621.   DEF SEG = &HB800
  622.   BLOAD "glib.bin",0
  623.   CALL prtscrn
  624.  
  625. pscrn.end:
  626.   GOSUB wait.key
  627.   CLS:GOSUB title
  628.  
  629.  
  630. sdump:
  631.   LOCATE 5,15 : PRINT "Function: SCRNDUMP - Send current display to disk."
  632.   LOCATE 6,15 : PRINT "Syntax:   fil.num=x : CALL prtscrn(fil.num%) "
  633.  
  634.  
  635.   LOCATE 9,10 : COLOR fg,bg
  636.   PRINT "   With SCRNDUMP, you can dump the screen display to disk."
  637.   PRINT TAB(10) ; "SCRNDUMP is very versatile in that by passing the file number,"
  638.   PRINT TAB(10) ; "you have control over whether the display is APPENDed to a file"
  639.   PRINT TAB(10) ; "already open or whether a new file is started with the SCRNDUMP."
  640.  
  641.   LOCATE 14,20 : PRINT "Examples of APPEND and non APPEND mode: "
  642.   LOCATE 15,10 : PRINT "210: OPEN ";quote$;"SCREEN.FIL";quote$;"FOR APPEND AS #3   <or> "
  643.   LOCATE 16,10 : PRINT "210: OPEN ";quote$;"SCREEN.FIL";quote$;"FOR OUTPUT AS #3"
  644.   PRINT TAB(10) ; "220: CALL prtscrn(3) "
  645.  
  646.   PRINT : ky$=""
  647.   PRINT TAB(10) ; "Press any key, we will again reload the Vertical Graph and do a
  648.   PRINT TAB(10) ; "PRTSCRN to a file called SCRNDUMP.FIL, you can examine later."
  649.   WHILE ky$=""
  650.     ky$=INKEY$
  651.   WEND
  652.  
  653.   DEF SEG = &HB800
  654.   BLOAD "glib.bin",0
  655.   OPEN "scrndump.fil" FOR OUTPUT AS #1
  656.   BEEP : CALL scrndump(1)
  657.   CLOSE #1
  658.   COLOR fgs, bgs
  659.   LOCATE 10,15 : PRINT "SCRNDUMP.FIL contains the screendump just executed."
  660.  
  661.   GOSUB wait.key
  662.   CLS:GOSUB title
  663.  
  664.  
  665. cmdl:
  666.   LOCATE 5,15 : PRINT "Function: CMDLINE  - Retrieve and parse any command line"
  667.   LOCATE 6,15 : PRINT "                     parameters."
  668.   LOCATE 7,15 : PRINT "Syntax:   DIM arg$(x) : q=y "
  669.   LOCATE 8,15 : PRINT "          CALL cmdline(arg$(),q%) "
  670.  
  671.   COLOR fg,bg
  672.   LOCATE 10,10 : PRINT "DIMension the array that will hold the arguments preferably to"
  673.   PRINT TAB(10) ; "a size one or 2 larger than the total number of arguments your program"
  674.   PRINT TAB(10) ; "expects or allows.  Q is set to 0 or 1 depending on your OPTION BASE"
  675.   PRINT TAB(10) ; "to tell CMDLINE where to put the first argument, element 0 or 1. OPTION"
  676.   PRINT TAB(10) ; "BASE 1 can be emulated here by setting Q to 1; Q returns the actual"
  677.   PRINT TAB(10) ; "number passed, to aid in FOR...NEXT loop analysis in your program."
  678.   PRINT
  679.   PRINT TAB(10) ; "If you started this demo from the batch file provided, the demo of this"
  680.   PRINT TAB(10) ; "routine will display the first 6 command line parameters passed from"
  681.   PRINT TAB(10) ; "that batch file (that is all I expect)."
  682.  
  683.   ' DIM arg$(6) : q=6             (this was already done and read
  684.   ' CALL cmdline(arg$(),q)        earlier - see the code at the start)
  685.  
  686.   GOSUB wait.key
  687.   CLS
  688.  
  689.   IF q > 0 THEN        ' in case they were removed
  690.      LOCATE 10,10 : PRINT "Actual number of arguments present: ";q
  691.      LOCATE 11,10 : PRINT "(This count is only accurate with OPTION BASE 1 !)
  692.      PRINT
  693.      PRINT TAB(10) ; "Arguments passed:"
  694.      FOR x=1 TO q
  695.     PRINT TAB(15) ; "Argument ";x;": ";arg$(x)
  696.      NEXT
  697.   END IF
  698.  
  699.   GOSUB wait.key
  700.   CLS:GOSUB title
  701.  
  702.  
  703. xscrn:
  704.   LOCATE 5,15 : PRINT "Function: SVSCRN, RSTSCRN - Save the current video display to"
  705.   LOCATE 6,15 : PRINT "          an integer array and Restore it later when desired."
  706.   LOCATE 7,15 : PRINT "Syntax:   DIM scrn.arry%(2000) : pointer%=VARPTR(scrn.arry%(1)"
  707.   LOCATE 8,15 : PRINT "          CALL svscrn(pointer%) <or> CALL rstscrn(pointer%)"
  708.  
  709.   COLOR fg,bg
  710.   LOCATE 10,5 : PRINT "These two routines also have ancient roots in BYTE magazine."
  711.   PRINT TAB(5) ; "If you are not familiar with VARPTR, or the screen save-restore technique,"
  712.   PRINT TAB(5) ; "you may want to study the docs carefully before using this, but briefly:"
  713.   PRINT TAB(5) ; "Each screen to save will require 2000 bytes in the array, so to save 3, DIM"
  714.   PRINT TAB(5) ; "it to 6000 bytes.  VARPTR is used to point to the first array element for"
  715.   PRINT TAB(5) ; "the first screen ala' ptr%=VARPTR(scrnarry(0)) (or 1 if using OPTION BASE"
  716.   PRINT TAB(5) ; "1), and ptr3%=VARPTR(scrnarry%(3000)) points to the 1st element of the third"
  717.   PRINT TAB(5) ; "screen.  Once the pointer is set for the first element of the desired "
  718.   PRINT TAB(5) ; "screen, issue the call to save or restore the screen passing the pointer:"
  719.   PRINT TAB(5) ; "CALL svscrn(ptr%)         ' saves current screen to wherever ptr points to"
  720.   PRINT TAB(5) ; "CALL rstscrn(ptr3%)       ' restores a screen from wherever ptr3 points to"
  721.   PRINT
  722.   PRINT TAB(5) ; "The actual demo for this is integrated into the next demo but examine feel"
  723.   PRINT TAB(5) ; "free to examine this code for additional info."
  724.  
  725.   GOSUB wait.key
  726.   CLS:GOSUB title
  727.  
  728.  
  729. wdws:
  730.   LOCATE 5,15 : PRINT "Function: WDW - Pop a window to the screen with sound "
  731.   LOCATE 6,15 : PRINT "                and color control."
  732.   LOCATE 7,15 : PRINT "Syntax: top=x : rt=x : btm=x : lft=x : snd=x : gro=x : frame=x"
  733.   LOCATE 8,15 : PRINT "        attr=(fg*16)+bg : label$=";quote$;"Window Label";quote$
  734.   LOCATE 9,15 : PRINT "       CALL wdw(top%, lft%, btm%, rt%, snd%, gro%, fr%, attr%, l$)"
  735.  
  736.   COLOR fg,bg
  737.   LOCATE 11,10 : PRINT "The first parameters define the perimeter of the window, while"
  738.   PRINT TAB(10) ; "SND and GRO are 0/1 switches that determine if there is to be sound"
  739.   PRINT TAB(10) ; "or if the window is to grow.  The attribute is determined in the same"
  740.   PRINT TAB(10) ; "manner as it is in QUIKPRT (I find this preferable to passing the 2"
  741.   PRINT TAB(10) ; "parameters of fore and back), frame is your choice of frame style,"
  742.   PRINT TAB(10) ; "(see the docs for full information). Finally, LABEL$ is a label to"
  743.   PRINT TAB(10) ; "center across the top of the window (which can be omitted)."
  744.  
  745.   GOSUB wait.key
  746.   wattr2%=(1*16)+15 : wattr3%=(2*16)+15 : wattr4%=(0*16)+11 : wattr5=(3*16)+0
  747.   wattr6%=(5*16)+14
  748.  
  749.   DIM sarry%(14000)            ' array to save screns to: hold
  750.                     ' be sure to DIM array as static !!!
  751.  
  752.   sptr1%=VARPTR(sarry%(1))         ' we are on OPTION BASE 1
  753.   sptr2%=VARPTR(sarry%(2001))         ' points to start of 2nd screen
  754.   sptr3%=VARPTR(sarry(4001))         ' points to 3rd screen
  755.  
  756.   sptr4%=VARPTR(sarry%(6001))         ' points to 4th
  757.   sptr5%=VARPTR(sarry%(8001))         ' points to 5th
  758.   sptr6%=VARPTR(sarry%(10001))         ' points to 6th
  759.   sptr7%=VARPTR(sarry%(12001))         ' points to 7th
  760.  
  761.   CALL svscrn(sptr1%)               ' now we have the screen with text
  762.                        ' captured in array
  763.   CALL wdw(2,2,15,55,1,1,1,wattr%,"Window 1")
  764.   CALL svscrn(sptr2%)               ' capturd one with window one on it
  765.  
  766.   CALL wdw(12,5,23,30,0,0,2,wattr2%,"Window 2")
  767.   CALL svscrn(sptr3%)
  768.  
  769.   CALL wdw(2,42,13,75,1,1,3,wattr3%,"Window 3")
  770.   CALL svscrn(sptr4%)
  771.  
  772.   CALL wdw(5,52,23,75,0,0,4,wattr4%,"Window 4")
  773.   CALL svscrn(sptr5%)
  774.  
  775.   CALL wdw(15,32,24,52,0,0,4,wattr5%,"Window 5")
  776.   CALL svscrn(sptr6%)
  777.  
  778.   CALL wdw(2,2,6,22,1,1,3,wattr6%,"Window 6")
  779.   CALL svscrn(sptr7%)
  780.  
  781.   COLOR 15,1
  782.   LOCATE 13,6 : PRINT "With SVSCRN and RSTSCRN"
  783.   LOCATE 14,6 : PRINT "we can back up one "
  784.   LOCATE 15,6 : PRINT "layer at a time..."
  785.   LOCATE 17,6 : PRINT "I have added a 1 sec"
  786.   LOCATE 18,6 : PRINT "delay so you see what"
  787.   LOCATE 19,6 : PRINT "is going on."
  788.   GOSUB wait.key
  789.  
  790.   CALL rstscrn(sptr6%)            ' pops them back one at a time
  791.   CALL dly(1)
  792.   CALL rstscrn(sptr5%)
  793.   CALL dly(1)
  794.   CALL rstscrn(sptr4%)
  795.   CALL dly(1)
  796.   CALL rstscrn(sptr3%)
  797.   CALL dly(1)
  798.   CALL rstscrn(sptr2%)
  799.   CALL dly(1)
  800.   CALL rstscrn(sptr1%)
  801.  
  802.   COLOR 15,1
  803.   CALL wdw(12,5,23,30,0,0,2,wattr2%,"Window 2")
  804.   LOCATE 13,6 : PRINT "We still have each level"
  805.   LOCATE 14,6 : PRINT "of screen in memory, and"
  806.   LOCATE 15,6 : PRINT "could recall any level "
  807.   LOCATE 16,6 : PRINT "we chose! "
  808.   LOCATE 17,6 : PRINT "Now let's peel them back"
  809.   LOCATE 18,6 : PRINT "with sound."
  810.  
  811.   GOSUB wait.key
  812.  
  813.   CALL rstscrn(sptr6%)               ' no window level
  814.   CALL chrp(0)
  815.   CALL dly(1)
  816.  
  817.   CALL rstscrn(sptr5%)
  818.   CALL chrp(0)
  819.   CALL dly(1)
  820.  
  821.   CALL rstscrn(sptr4%)
  822.   CALL chrp(0)
  823.   CALL dly(1)
  824.  
  825.   CALL rstscrn(sptr3%)
  826.   CALL chrp(0)
  827.   CALL dly(1)
  828.  
  829.   CALL rstscrn(sptr2%)
  830.   CALL chrp(0)
  831.   CALL dly(1)
  832.  
  833.   CALL rstscrn(sptr1%)
  834.   CALL chrp(0)
  835.  
  836.  
  837.   GOSUB wait.key
  838.   CLS:GOSUB title
  839.  
  840.  
  841. bxs:
  842.   LOCATE 5,15 : PRINT "Function: BOXES - Pops a frame onto the screen as you might"
  843.   LOCATE 6,15 : PRINT "          for a menu."
  844.   LOCATE 7,15 : PRINT "Syntax: box=x : frame=x : foreground=x "
  845.   LOCATE 8,15 : PRINT "        CALL boxes(box%, frame%, foreground%)
  846.  
  847.   COLOR fg,bg
  848.  
  849.   LOCATE 10, 10 : PRINT "This is really an attempt on my part to make WDW depend more"
  850.   PRINT TAB(10) ; "dependant on asm routines, but even though I am not done with it, I"
  851.   PRINT TAB(10) ; "have found a few uses for it.  At point it worked out great for a "
  852.   PRINT TAB(10) ; "split screen application I wrote."
  853.   PRINT TAB(10) ; "Regardless, less coding and code space is consumed with an ASM CALL"
  854.   PRINT TAB(10) ; "even with what is left for you to finish."
  855.   PRINT
  856.   PRINT TAB(10) ; "There are 5 boxes, tap <Enter> at the BEEP to move thru them..."
  857.  
  858.   GOSUB wait.key
  859.   CLS
  860.   CALL boxes(1,1,15)
  861.   BEEP
  862.   GOSUB waitk2
  863.   CLS
  864.   CALL boxes(2,2,14)
  865.   BEEP
  866.   GOSUB waitk2
  867.   CLS
  868.   CALL boxes(3,3,3)
  869.   BEEP
  870.   GOSUB waitk2
  871.   CLS
  872.   CALL boxes(4,4,4)
  873.   BEEP
  874.   GOSUB waitk2
  875.   CLS
  876.   CALL boxes(5,1,11)
  877.   BEEP
  878.   GOSUB waitk2
  879.   CALL boxes(3,4,2)
  880.   CALL boxes(4,4,2)
  881.  
  882.   COLOR fg,bg
  883.   LOCATE 2,3 : PRINT "You can probably imagine how this came in handy on a "
  884.   LOCATE 3,3 : PRINT  "split screen application..."
  885.  
  886.   LOCATE 14,3 : PRINT "Yes I can!!"
  887.  
  888.   GOSUB wait.key
  889.   CLS:GOSUB title
  890.  
  891.  
  892. scrl:
  893.   LOCATE 5,15 : PRINT "Function: USCROLL, DSCROLL - Scroll the display up or down"
  894.   LOCATE 6,15 : PRINT "          a given number of lines."
  895.   LOCATE 7,15 : PRINT "Syntax: Num lines [1-24] to scroll and use legal coordinates"
  896.   LOCATE 8,15 : PRINT "        CALL USCROLL(num%, top%, lft%, bttm%, rght%)
  897.   LOCATE 9,15 : PRINT "        CALL DSCROLL(num%, top%, lft%, bttm%, rght%)
  898.  
  899.   COLOR fg,bg
  900.   LOCATE 11,10 : PRINT "This allows us to scroll any legal window any number of lines."
  901.   PRINT TAB(10) ; "We will fill the screen with a test pattern and then scroll a window"
  902.   PRINT TAB(10) ; "of text within it to demonstrate one of the more impressive aspects of"
  903.   PRINT TAB(10) ; "this routine.  A second demo does a screen shift routine."
  904.   PRINT TAB(10) ; "The area of the screen to be scrooled and the number of lines to"
  905.   PRINT TAB(10) ; "scroll is fully user definable."
  906.  
  907.   GOSUB wait.key
  908.   CLS
  909.  
  910.   COLOR fgt,0
  911.   FOR x=1 TO 24
  912.       PRINT STRING$(80,CHR$(x+96));
  913.   NEXT x
  914.  
  915.   BEEP :  CALL svscrn(sptr1%)                   ' save the test pattern
  916.   COLOR fgd,0
  917.  
  918.   FOR X= 1 TO 15
  919.     CALL uscroll(1,5,20,19,59)
  920.     LOCATE 19, 22
  921.     PRINT "Scroll Up Line # ";x;
  922.   NEXT x
  923.  
  924.   COLOR fgt,0 : LOCATE 15,44 : PRINT "Slow now, w/"
  925.   LOCATE 16, 44 : PRINT "frame (from WDW)!"
  926.  
  927.   GOSUB wait.key
  928.  
  929.   CALL rstscrn(sptr1%)
  930.  
  931.   CALL wdw(6,30,16,50,0,0,2,(0*16)+14,"15 Lines")        ' could be done with box #6 too
  932.  
  933.   COLOR fgd,0
  934.   FOR X= 1 TO 15
  935.     CALL dscroll(1,6,30,16,50)
  936.     LOCATE 6, 31
  937.     IF cmode THEN COLOR x,0 : ELSE COLOR 15,0
  938.     PRINT "Scroll Dn Line #";x;
  939.     CALL dly(1)
  940.   NEXT x
  941.  
  942.   BEEP
  943.   FOR X= 1 TO 15
  944.     CALL uscroll(1,6,30,16,50)
  945.     CALL dly(.5)                      ' not really a half sec delay
  946.   NEXT x                                  ' goes out to DLY and returns
  947.  
  948.   CLS : LOCATE 10,12
  949.   PRINT "Now a simpler implementation, shifting a portion out of the way."
  950.  
  951.   GOSUB wait.key
  952.  
  953.   BEEP : CALL rstscrn(sptr1%)           ' restore test pattern
  954.   CALL uscroll(12,0,0,12,80)            ' scroll bottom part to top
  955.   CALL dly(1)                           ' let em see it
  956.  
  957.   FOR X=1 TO 5                           ' 'bounce' bottom part
  958.       CALL dscroll (11,1,1,25,80)
  959.       CALL dly(1)
  960.       CALL uscroll (11,1,1,25,80)
  961.   NEXT X
  962.  
  963.   BEEP
  964.  
  965.   FOR X=1 TO 15                           ' now FAST
  966.       CALL dscroll (11,1,1,25,80)
  967.       CALL uscroll (11,1,1,25,80)
  968.   NEXT X
  969.  
  970.   GOSUB wait.key
  971.   CLS:GOSUB title
  972.  
  973. fad:
  974.   LOCATE 5,15 : PRINT "Function: FADE - Clears the screen as if disintegating."
  975.   LOCATE 6,15 : PRINT "Syntax:   CALL fade"
  976.  
  977.  
  978.   LOCATE 10,10 : PRINT "   To demo this we will put some test on the screen, then"
  979.   PRINT TAB(10);"call fade to disolve it."
  980.   GOSUB wait.key
  981.   CLS
  982.   SHELL "dir /w"
  983.   CALL dly(1)                               ' wait a sec
  984.   CALL fade                                 ' waste it
  985.  
  986.  
  987.  
  988.  
  989.   GOSUB wait.key
  990.   CLS
  991.  
  992. the.end:
  993.   CALL wdw(10,10,20,70,1,1,1,wattr%,"The End")
  994.   x=11 : y=15 : COLOR fgw,bgw
  995.   LOCATE x,y
  996.   PRINT "      Thanks for your time and interest in GIZLIB."
  997.   x=x+2
  998.   LOCATE x,y :         PRINT "This demo is meant to demonstrate the use and"
  999.   x=x+1 : LOCATE x,y : PRINT "implementation of some of the routines, and not"
  1000.   x=x+1 : LOCATE x,y : PRINT "a complete tutorial on using GIZLIB.  All the"
  1001.   x=x+1 : LOCATE x,y : PRINT "routines available are not even demonstrated! "
  1002.   x=x+2 : LOCATE x,y : PRINT "Refer to the documentation for complete details on"
  1003.   x=x+1 : LOCATE x,y : PRINT "usage and implementation."
  1004.  
  1005.  
  1006. extt:
  1007.      SYSTEM
  1008.  
  1009.  
  1010. '---------------------[subroutines]-----------------
  1011. title:                    '********************
  1012. COLOR fgt,0
  1013. LOCATE 2,25:PRINT "GIZLIB 1.0 Demo of QB Routines. "
  1014. COLOR fgs,bgs
  1015. RETURN
  1016.  
  1017.  
  1018. wait.key:               '***********************
  1019. LOCATE 24,25
  1020. COLOR 14,0:PRINT "Press any key to continue.";
  1021.  
  1022. waitk2:
  1023. cont$=INKEY$
  1024.   WHILE cont$=""
  1025.      cont$=INKEY$
  1026.   WEND
  1027. LOCATE 23,25:PRINT SPACE$(50);
  1028.  
  1029. COLOR fg,bg
  1030.  
  1031. RETURN
  1032.  
  1033.  
  1034. get.string:
  1035.   COLOR fgt,0 : LOCATE lin,1 : PRINT "=> ";: COLOR fgs,0
  1036.   ky$="" : text$=""
  1037.   ky$=INKEY$
  1038.   DO UNTIL ky$ = CHR$(13) OR LEN(text$) => max        'this is new to QB 3.0
  1039.       ky$=INKEY$
  1040.       IF ky$ => CHR$(32) THEN
  1041.      PRINT ky$;
  1042.      text$=text$+ky$
  1043.       ELSEIF ky$ = CHR$(8) AND LEN(text$)>=1 THEN
  1044.      PRINT CHR$(29)+CHR$(32)+CHR$(29);
  1045.      text$=LEFT$(text$,LEN(text$)-1)
  1046.       END IF
  1047.   LOOP
  1048.   IF text$=CHR$(13) THEN GOTO get.string
  1049. RETURN
  1050.  
  1051.  
  1052.  
  1053.