home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / QB4WIN32.ZIP / W32.BAS < prev    next >
BASIC Source File  |  1980-01-02  |  53KB  |  1,665 lines
  1. DECLARE SUB logo () : DECLARE SUB TextMode () : DECLARE SUB GraphicsMode () : DECLARE SUB DefaultMode () : DECLARE SUB GraphicsDemo () : DECLARE SUB MemoryDump () : DECLARE SUB attributes () : DECLARE SUB Diversion () : DECLARE SUB Fill () : DECLARE _
  2.  SUB k () : DECLARE SUB machine () : DECLARE SUB PrintxDemo () : DECLARE SUB train () : DECLARE SUB VgaSetDefaultReg () : DECLARE SUB VgaViewReg () : DECLARE SUB Window1 () : DECLARE SUB Window2 () : DECLARE SUB Window3 () : DECLARE SUB  _
  3. PrintMainMenu () : DECLARE SUB Copyright () : DECLARE SUB Pause (n!) : DECLARE SUB configure () : DECLARE SUB MemoryScroll () : DECLARE SUB DBox (Msg$, f$) : DECLARE SUB dec (n) : DECLARE SUB inc (n) : DECLARE SUB VGARead16ColReg (ColorReg$) :  _
  4. DECLARE SUB VGAReadFile (File$, RGB$) : DECLARE SUB VGAReadPalReg (palette$) : DECLARE SUB VGASet16ColReg (RGB$) : DECLARE SUB VGASet1ColReg (reg!, red!, green!, blue!)
  5. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  6. '       Here is a list of all the VGA calls (these are subs in W32.BAS)
  7. '       The calls to read or set 16 registers use strings,
  8. '       those to read or set one register use numbers.
  9.  
  10. 'VGARead16ColReg (RGB$)
  11. '        returns a 49 byte string with contents of 16 color registers
  12. '        and the overscan register.
  13. 'VGARead1ColReg (Register,Red,Green,Blue)
  14. '        reads a single color register
  15. 'VGAReadFile (filename$,RGB$)
  16. '        reads a file created by VPT.EXE into a 49 byte string
  17. 'VGAReadPalReg (Palette$)
  18. '        Reads the 16 palette registers and overscan attribute into
  19. '        a 17 byte string
  20. 'VGASet16ColReg
  21. '        Sets 16 color registers from a 48 or 49 byte string.  Can use the
  22. '        string returned by VGARead16ColReg or VGAReadFile.
  23. 'VGASet1ColReg (Register,Red,Green,Blue)          [Red Green & Blue = 0 to 63]
  24. '        sets a single color register.
  25.  
  26. 'VGASetDefaultReg
  27. '        Sets the 16 palette and color registers to their defaults, except
  28. '        for color 7 which is set to green instead of white.
  29. 'VGASetOverScanReg (n)        [n = 0 to 15]
  30. '        sets the attribute for the overscan register.
  31.  
  32. '       Th]re is no separate call to read the attribute of the overscan
  33. '       register, but it is the last byte of the string returned
  34. '        by ReadPalReg, ReadFile, or Read16ColReg.
  35.  
  36. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  37.  
  38. '   These statements are in a file called W32.DEC and should be merged
  39. '   or included ( use REM $INCLUDE:'W32.DEC') with any program using the
  40. '   W32 library.  Programs load slower with INCLUDE statements but are easier
  41. '   to update.
  42. DECLARE SUB Adapter (a%) : 'returns active adapter  0\mono 1\cga 2\ega 3\vga
  43. DECLARE SUB Border (BYVAL b%)
  44. DECLARE SUB CloseLastW ()
  45. DECLARE SUB CloseW (BYVAL segment%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  46. DECLARE SUB CloseWgra (BYVAL segment%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  47. DECLARE SUB ConvertTG (tr%, lc%, br%, rc%)
  48. DECLARE SUB DebugW ()
  49. DECLARE SUB DefBorder (x$)
  50. DECLARE SUB Dump1 (BYVAL segment%, BYVAL offset%, BYVAL attr%, BYVAL NLines%, BYVAL Row%)
  51. DECLARE SUB FillW (BYVAL offset%, BYVAL stringAddress%)
  52. DECLARE SUB InitW (RR%, CC%)
  53. DECLARE SUB Int10 (ax%, bx%, cx%, dx%)
  54. DECLARE SUB Int3
  55. DECLARE SUB KLS
  56. DECLARE SUB Kolor (BYVAL fore%, BYVAL back%)
  57. DECLARE SUB Lokate (BYVAL r%, BYVAL c%)
  58. DECLARE SUB MapMask (BYVAL m%)
  59. DECLARE SUB Monochrome ()
  60. DECLARE SUB OpenW (BYVAL segment%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  61. DECLARE SUB Prnt (a$)
  62. DECLARE SUB Printt (a$, BYVAL attr%, BYVAL r%, BYVAL c%)
  63. DECLARE SUB PrntW (a$)
  64. DECLARE SUB PrintW (a$, BYVAL attr%, BYVAL r%, BYVAL c%)
  65. DECLARE SUB PrntS (BYVAL i!)
  66. DECLARE SUB PrntUsingS (Mask$, BYVAL i!)
  67. DECLARE SUB ReadScreen (a$, BYVAL r%, BYVAL c%)
  68. DECLARE SUB Refresh ()
  69. DECLARE SUB SaveW (BYVAL segment%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  70. DECLARE SUB SaveWgra (BYVAL segment%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  71. DECLARE SUB ScrollD (BYVAL Lines%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  72. DECLARE SUB ScrollL (BYVAL cols%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  73. DECLARE SUB ScrollR (BYVAL cols%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  74. DECLARE SUB scrollU (BYVAL Lines%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  75. DECLARE SUB SetViewPage (BYVAL p%)
  76. DECLARE SUB SetViewW (BYVAL Page%, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  77. DECLARE SUB SnowCheckingOn
  78. DECLARE SUB SnowCheckingOff
  79. DECLARE SUB Tabb (BYVAL Col%)
  80. DECLARE SUB WSize (Bytes&, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  81. DECLARE SUB WSizeGra (Bytes&, BYVAL tr%, BYVAL lc%, BYVAL br%, BYVAL rc%)
  82. '$DYNAMIC
  83. COMMON SHARED RR AS INTEGER, CC AS INTEGER
  84. 'InitW RR, CC
  85. '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  86.        
  87.     OPTION BASE 1
  88.        
  89.     COMMON SHARED EE: 'result of On Error Goto
  90.  
  91.     COMMON SHARED Mode, Lines, Columns: 'Screen mode and lines and
  92.                         'columns of text being displayed
  93.        
  94.     COMMON SHARED i$: 'Result of a keypress from the sub K
  95.        
  96.     COMMON SHARED Monitor AS INTEGER, MDump AS INTEGER
  97.           'Monitor is set by DefaultMode & Configure.
  98.        
  99.      MDump = 1: 'determines whether the sub MemoryDump
  100.     'will print to the MDA or the CGA-VGA.  Can be changed by
  101.     'the sub Configure
  102.        
  103.     CALL DefaultMode: ' sets display to SCREEN 0, 25 lines & 80 columns
  104.        
  105.     clock2 = 1:         'flag to toggle displaytime on & off
  106.  
  107.     Speed = 1:          'used by  Pause
  108.  
  109.     CALL Copyright
  110.  
  111. 'initialize some strings for PrintxDemo
  112.     REDIM e$(30): OPEN "i", #3, "W32.dec"
  113.     FOR x = 1 TO 30: LINE INPUT #3, e$(x): NEXT: CLOSE
  114.  
  115. '===========================================================================
  116. start:
  117.       CALL PrintMainMenu:
  118.       CALL k: i$ = LCASE$(i$)
  119.  
  120. SELECT CASE i$
  121.     CASE "w": CALL Window1: CALL Window2: CALL Window3
  122.     CASE "s": CALL train: CALL machine: CALL GraphicsDemo
  123.     CASE "f": CALL Fill
  124.     CASE "d": CALL DebugW
  125.     CASE "p": CALL PrintxDemo
  126.     CASE "c": CALL configure
  127.     CASE "q": PLAY OFF: CALL DefaultMode: CALL Copyright: END
  128.     CASE "g": CALL GraphicsMode
  129.     CASE "t": CALL TextMode
  130.     CASE "x": IF Mode = 0 THEN CALL MemoryDump ELSE BEEP
  131.     CASE "h": SWAP Clock1, clock2:
  132.         IF Clock1 = 1 THEN
  133.         ON TIMER(1) GOSUB DisplayTime: TIMER ON
  134.         ELSE TIMER OFF
  135.         END IF
  136.     CASE "r": CALL Diversion
  137.     CASE "m": CALL MemoryScroll
  138.     CASE ELSE
  139. END SELECT: GOTO start
  140. '==========================================================================
  141. ResumeNext: EE = ERR: RESUME NEXT
  142. DisplayTime:
  143.     cccR = CSRLIN: cccC = POS(x)
  144.     LOCATE 2, 60: PRINT "FRE(1) ="; FRE(1);
  145.     LOCATE 1, 60: PRINT TIME$;
  146.     LOCATE cccR, cccC: 'restore cursor position
  147.     RETURN
  148.  
  149. MemDump:
  150. 'This is a sort of multi-tasking and yes, I got the idea from PC Magazine.
  151.     PLAY "MB N0"
  152.     CALL Refresh
  153.     RETURN
  154.  
  155. REM $STATIC
  156. SUB configure STATIC
  157.     SHARED Speed: 'shared with 'Pause'
  158.     IF Columns <> 80 THEN CALL DefaultMode
  159. BeginC:
  160.     IF Mode = 0 THEN COLOR 2, 0
  161.     IF Mode = 12 THEN COLOR 2
  162.     CLS : Border 1: OpenW 0, 1, 1, 15, 80
  163. SC:
  164. LOCATE 2, 2: PRINT "          M    Print to the monochrome monitor"
  165. LOCATE 3, 2: PRINT "          C    Print to the CGA,EGA or VGA monitor"
  166. LOCATE 5, 2: PRINT "          S    Enable snow checking"
  167. LOCATE 6, 2: PRINT "          D    Disable snow checking"
  168. LOCATE 8, 2: PRINT "          1-8  Speed (determines the length of pauses in this demo)"
  169. LOCATE 9, 2: PRINT "               1 - fastest   8 - slowest"
  170. LOCATE 11, 2: PRINT "          X    Memory Dump prints to the CGA/EGA/VGA"
  171. LOCATE 12, 2: PRINT "          Y    Memory Dump prints to the monochrome monitor"
  172. LOCATE &O16, 2: PRINT "          ESC  Exit"
  173.     IF Monitor THEN LOCATE 3, 9: PRINT "**" ELSE LOCATE 2, 9: PRINT "**";
  174.     IF snow THEN LOCATE 5, 9: PRINT "**" ELSE LOCATE 6, 9: PRINT "**";
  175.     LOCATE 8, 8: PRINT Speed;
  176.     IF MDump THEN LOCATE 11, 9: PRINT "**" ELSE LOCATE 12, 9: PRINT "**";
  177.     LOCATE 20, 10: PRINT "M and C do not change the active monitor.  If "
  178.     LOCATE 21, 10: PRINT "your computer has two monitors, this program"
  179.     LOCATE 22, 10: PRINT "can print to both a MDA and CGA/EGA/VGA  "
  180.     LOCATE 23, 10: PRINT "regardless of which is active.  However, the"
  181.     LOCATE 24, 10: PRINT "cursor will move only on the active monitor";
  182.     CALL k: i$ = LCASE$(i$): SELECT CASE i$
  183.     CASE "m": Monitor = 0: CALL Monochrome: Lines = 25: Columns = 80: Mode = 0
  184.     CASE "c": Monitor = 1: CALL DefaultMode: GOTO BeginC
  185.     CASE "s": snow = -1: CALL SnowCheckingOn
  186.     CASE "d": snow = 0: CALL SnowCheckingOff
  187.     CASE "1", "2", "3", "4", "5", "6", "7", "8": Speed = VAL(i$)
  188.     CASE "x": MDump = 1
  189.     CASE "y": MDump = 0
  190.     CASE ELSE: EXIT SUB
  191.     END SELECT: GOTO SC
  192.  
  193. END SUB
  194.  
  195. SUB Copyright
  196.     Kolor 3, 0
  197.     CALL Monochrome: GOSUB CR2:    'Print on the MDA monitor
  198.     InitW RR, CC: GOSUB CR2:       'and on the VGA monitor
  199.     Pause 700: EXIT SUB
  200. '-------------------------------
  201. CR2:
  202.     Border 3: KLS
  203. 'draw 4 boxes for a border
  204.     Kolor 5, 0: OpenW 0, 2, 2, 3, 79: 'top
  205.     Kolor 3, 0: OpenW 0, 1, 76, 25, 77: 'right
  206.     Kolor 6, 0: OpenW 0, 23, 1, 24, 79: 'bottom
  207.     'Attribute 4 won't show up on a monochrome monitor
  208.     CALL Adapter(a%): IF a% < 2 THEN Kolor 3, 0 ELSE Kolor 4, 0
  209.     OpenW 0, 1, 3, 25, 4: 'left
  210.        
  211. 'Put a border around the text window
  212.     Border 1: Kolor 3, 0: OpenW 0, 7, 18, 18, 62
  213.     Printt "QuickBasic Windows Library", 3, 9, 20
  214.     Printt "Version 3.2  Sept 15, 1990", 3, 10, 20
  215.     Printt "By Jim Paisley", 3, 12, 24
  216.     Printt "10690 Allen Rd", 3, 13, 24
  217.     Printt "Washington C.H., Oh 43160", 3, 14, 24
  218.     Printt "Copyright 1990", 3, 16, 24
  219.     RETURN
  220. END SUB
  221.  
  222. SUB DBox (Msg$, f$)
  223.     '$DYNAMIC
  224.     'QuickBasic's famous box-in-a-box.  Called by FILL
  225.  
  226.        tr = 5: lc = 15:     'Box location
  227.     c1 = 10: c2 = 4:     'color
  228. '--------------------------------------------
  229.     attr = c1 + c2 * 16
  230.     br = tr + 13: rc = lc + 50
  231.     WSize Bytes&, tr, lc, br, rc
  232.     REDIM box(Bytes& / 2) AS INTEGER
  233.     Border 1: Kolor c1, c2: OpenW VARSEG(box(1)), tr, lc, br, rc
  234.        
  235.     OpenW 0, tr + 4, lc + 6, tr + 6, lc + 44
  236.     Printt Msg$, attr, tr + 3, lc + 7
  237.        
  238.     Border 2
  239.     OpenW 0, tr + 8, lc + 13, tr + 10, lc + 18
  240.     Printt "OK", attr, tr + 9, lc + 15
  241.       
  242.     Border 1
  243.     OpenW 0, tr + 8, lc + 28, tr + 10, lc + 37
  244.     Printt "Cancel", attr, tr + 9, lc + 30
  245.        
  246.     IF Mode = 0 THEN COLOR c1, c1
  247.     IF Mode = 12 THEN COLOR c1
  248.     LOCATE tr + 5, lc + 8, 1
  249.     INPUT "", f$: ' comma suppresses the '?'
  250.  
  251. 'We only saved 1 window to an array, but have to close the other 3 to
  252. 'pop them off the CloseLastW stack
  253.     FOR x = 1 TO 4: CALL CloseLastW: NEXT
  254.     ERASE box
  255. END SUB
  256.  
  257. REM $STATIC
  258. SUB dec (n) STATIC
  259.     n = n - 1
  260. END SUB
  261.  
  262. SUB DefaultMode
  263.     SHARED Clock1
  264.        
  265.     PALETTE:                'default palette
  266.        
  267.        
  268.     Mode = 0: Lines = 25: Columns = 80: Page = 0
  269.        
  270.     SCREEN Mode, 1, Page, Page
  271.  
  272. 'If you quit this program while in a 132 column mode and start it again,
  273. 'the WIDTH 80,25 will not change it back to 80 columns unless preceded
  274. 'by the WIDTH 40,25 command.  You must not let the timer call DisplayTime
  275. 'while in the 40 column mode.
  276.            TIMER OFF: WIDTH 40, 25
  277.            IF Clock1 = 1 THEN ON TIMER(1) GOSUB DisplayTime: TIMER ON
  278.            WIDTH Columns, Lines
  279.  
  280.     CALL Adapter(Monitor): '''IF Monitor > 1 THEN CALL vgasetdefaultreg
  281.     'Monitor determines whether this program will print to the MDA
  282.     'or the CGA-VGA.  It can be changed by the sub Configure.
  283.        
  284.     LOCATE , , 1, 5, 7:     'visible thick line cursor
  285.        
  286.     InitW RR, CC:           ' initialize W32
  287.  
  288. END SUB
  289.  
  290. SUB Diversion
  291.     '$DYNAMIC
  292.     CALL Adapter(a%): IF a% <> 3 THEN BEEP: EXIT SUB
  293.     Kolor 2, 0
  294.  
  295.     'view current colors
  296.     KLS
  297.     CALL VgaViewReg
  298.  
  299.     'save current colors
  300.     CALL VGARead16ColReg(SaveReg$)
  301.  
  302.     'read new colors from a file
  303.     Printt "Press a key to load colors from the file W32.VPT... ", 2, 22, 1: k
  304.     CALL VGAReadFile("W32.VPT", RGB$)
  305.  
  306.     'set the VGA to these new colors
  307.     IF LEN(RGB$) <> 0 THEN
  308.         CALL VGASet16ColReg(RGB$)
  309.  
  310.     'if the file wasn't found, set 4 registers individually
  311.     ELSE
  312.         red = 0: green = 0: blue = 0: reg = 0
  313.         CALL VGASet1ColReg(reg, red, green, blue)
  314.          
  315.         red = 63: green = 10: blue = 10: reg = 1
  316.         CALL VGASet1ColReg(reg, red, green, blue)
  317.          
  318.         red = 63: green = 48: blue = 7: reg = 2
  319.         CALL VGASet1ColReg(reg, red, green, blue)
  320.          
  321.         red = 30: green = 49: blue = 63: reg = 3
  322.         CALL VGASet1ColReg(reg, red, green, blue)
  323.     END IF
  324.  
  325.     'view the new colors:
  326.     CALL VgaViewReg: Kolor 2, 0
  327.  
  328.     'restore the original colors
  329.     Printt "Press any key to set the colors to their defaults...", 2, 22, 1: k
  330.     CALL VgaSetDefaultReg
  331.  
  332.     CALL VgaViewReg
  333.     Printt "Press any key ...                                    ", 2, 22, 1: k
  334. END SUB
  335.  
  336. SUB Fill STATIC
  337.     f$ = "W32.doc": 'name of a text file to view
  338.     CALL KLS
  339. StartFillDemo:
  340. '---------------------------------------------------------------------------
  341.     'initialize the editing keys
  342.     PgUp$ = CHR$(0) + CHR$(73): PgDn$ = CHR$(0) + CHR$(81)
  343.     up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80)
  344.     Lft$ = CHR$(0) + CHR$(75): rght$ = CHR$(0) + CHR$(77)
  345.     Ins$ = CHR$(0) + CHR$(82): del$ = CHR$(0) + CHR$(83)
  346.     backspace$ = CHR$(0) + CHR$(8): ShiftTab$ = CHR$(0) + CHR$(15)
  347.     Home$ = CHR$(0) + CHR$(71): end$ = CHR$(0) + CHR$(79)
  348.     cr$ = CHR$(13): ESC$ = CHR$(27): tab$ = CHR$(9): eol$ = CHR$(10)
  349.  
  350. '--------------------INITIALIZE THE DATA-------------------------------
  351.     REDIM a%(75 * 132): 'array used to save the screen
  352.     NStrings = FRE(1) / 50:
  353.     REDIM a$(NStrings): 'array holds the strings to be viewed
  354.     IF fore = 0 THEN fore = 15: back = 5: 'initial colors
  355.     e$ = "L32ege": 'play  when scrolling hits the end
  356.     SIZE = 2: 'initial size of the window
  357.     n = 0: 'initial string offset (increase n to scroll left)
  358.     L = 1: 'a$(L) is the string at the top of the window
  359.     FBorder = 2: CALL Border(FBorder): 'initial border, a double line
  360.     CALL DefBorder(CHR$(220) + CHR$(220) + CHR$(220) + CHR$(221) + CHR$(32) + CHR$(222) + CHR$(223) + CHR$(223) + CHR$(223))
  361.     CenterRow = INT(Lines / 2): CenterColumn = INT(Columns / 2)
  362.     tr = CenterRow - 4: br = tr + 8: lc = CenterColumn - 16: rc = lc + 32
  363. '-------------------------Open a text file ---------------------------------
  364. OpenFile:
  365.     EE = 0: ON ERROR GOTO ResumeNext
  366.     CLOSE : OPEN "i", #3, f$
  367.     ON ERROR GOTO 0
  368.     IF EE = 0 GOTO ReadFile
  369.     CALL DBox("Name of a text file to view:", f$)
  370.     IF f$ = "" GOTO ExitFillDemo ELSE GOTO OpenFile
  371.  
  372. '-------------------------Read the file into A$() -----------------------
  373. ReadFile:
  374.     Printt "Loading " + f$, 2, 10, 30
  375.     Printt "Press <Esc> to stop", 2, 12, 30
  376.     LastLine = 1: 'number of strings used in a$()
  377. DO UNTIL EOF(3): LINE INPUT #3, a$(LastLine)
  378.     Lokate 9, 40: PrntUsingS "####", LastLine
  379.     
  380.     IF FRE(x$) < 2000 OR LastLine > NStrings THEN
  381.          Lokate 13, 40: Prnt "Not enough room...": PLAY e$: CALL k
  382.          EXIT DO
  383.          END IF
  384.  
  385.     inc LastLine
  386.     i$ = INKEY$: IF i$ = ESC$ THEN EXIT DO
  387.     LOOP: CLOSE #3
  388.  
  389. '------------Clear the screen and print a help menu --------------------------
  390. DrawScreen:
  391.     Kolor 2, 0: KLS
  392.     Kolor 6, 0: OpenW 0, 1, 1, 24, 24: Lokate 1, 1: 'draw a box
  393.     Kolor 12, 0: PrntW "Keys to scroll:" + cr$
  394.     Kolor 6, 0
  395.     PrntW " " + CHR$(25) + " " + CHR$(26) + " " + CHR$(27) + " " + CHR$(24) + cr$
  396.     PrntW " PageUp PageDown  " + cr$
  397.     PrntW " Home  End" + cr$
  398.     PrntW " tab  shift/tab" + cr$
  399.     Kolor 6, 0: PrntW "______________________": PrntW cr$
  400.     Kolor 12, 0: PrntW "Change the display:" + cr$: Kolor 6, 0
  401.     PrntW "b     Border" + cr$
  402.     PrntW "f     New file" + cr$
  403.     PrntW "+ -   Window size" + cr$
  404.     PrntW "1,2   Foreground color" + cr$
  405.     PrntW "9,0   Background color" + cr$
  406.     PrntW "t     Select text mode" + cr$
  407.     PrntW "g     Select graphics" + cr$
  408.     PrntW "      mode" + cr$
  409.     PrntW "<esc> Quit" + cr$
  410.     Kolor 6, 0: PrntW "______________________": PrntW cr$
  411.     Kolor 12, 0: PrntW "Current colors:" + cr$:
  412.     Kolor 6, 0
  413.     PrntW "   Foreground  " + cr$
  414.     PrntW "   Background  "
  415.       
  416. '-------------------------Set up a window-----------------------------------
  417. OpenWindow:
  418.     Kolor 12, 0
  419.     Lokate 22, 17: PrntUsingS "###", fore
  420.     Lokate 23, 17: PrntUsingS "###", back
  421.     Kolor fore, back
  422.     IF tr < 1 THEN tr = 1
  423.     IF tr > CenterRow - 2 THEN tr = CenterRow - 2
  424.     IF br > Lines THEN br = Lines: IF br < tr + 8 THEN br = tr + 8
  425.     IF br < CenterRow + 2 THEN br = CenterRow + 2
  426.        
  427.     IF lc < 1 THEN lc = 1
  428.     IF lc > CenterColumn - 12 THEN lc = CenterColumn - 12
  429.        
  430.     IF rc > Columns THEN rc = Columns:
  431.     IF rc < lc + 24 THEN rc = lc + 24
  432.  
  433.     IF Mode = 0 THEN OpenW VARSEG(a%(1)), tr, lc, br, rc
  434.     IF Mode > 0 THEN OpenW 0, tr, lc, br, rc
  435.  
  436. '-------------------------Print the file in the window----------------------
  437. PrintWindow:
  438.     IF L > LastLine - CenterRow THEN L = LastLine - CenterRow: PLAY e$
  439.     IF L < 1 THEN L = 1: PLAY e$
  440.     IF n < 0 THEN n = 0: PLAY e$
  441.     IF n > 80 THEN n = 80: PLAY e$
  442.     FillW n, VARPTR(a$(L))
  443.  
  444. '-----------------------Wait for instructions-------------------------------
  445.     CALL k
  446. SELECT CASE i$
  447.     CASE ESC$: GOTO ExitFillDemo
  448.     CASE "f", "F": f$ = "":  GOTO StartFillDemo
  449.        
  450.     CASE up$: dec L: GOTO PrintWindow
  451.     CASE down$: inc L: GOTO PrintWindow
  452.     CASE Lft$: inc n: GOTO PrintWindow
  453.     CASE rght$: dec n: GOTO PrintWindow
  454.     CASE tab$: n = n + 5: GOTO PrintWindow
  455.     CASE ShiftTab$: n = n - 5: GOTO PrintWindow
  456.     CASE PgUp$: L = L - (br - tr): GOTO PrintWindow
  457.     CASE PgDn$: L = L + (br - tr): GOTO PrintWindow
  458.     CASE Home$: n = 0: L = 1: GOTO PrintWindow
  459.     CASE end$: L = 9999: GOTO PrintWindow
  460.  
  461.     CASE "-": tr = tr + 2: br = br - 2: lc = lc + 6: rc = rc - 6
  462.     CASE "+": tr = tr - 2: br = br + 2: lc = lc - 6: rc = rc + 6
  463.     CASE "t":  CALL TextMode
  464.     CASE "g": CALL GraphicsMode
  465.     CASE "1": fore = fore + 1: IF fore > 15 THEN fore = 0
  466.     CASE "9": back = back + 1: IF back > 7 THEN back = 0
  467.     CASE "2": fore = fore - 1: IF fore < 0 THEN fore = 15
  468.     CASE "0": back = back - 1: IF back < 0 THEN back = 7
  469.     CASE "b": inc FBorder: FBorder = FBorder MOD 4: CALL Border(FBorder)
  470.     CASE ELSE
  471. END SELECT
  472.     IF Mode = 0 THEN CloseLastW: GOTO OpenWindow ELSE GOTO DrawScreen
  473. ExitFillDemo:
  474.     ERASE a%: ERASE a$
  475.  
  476. END SUB
  477.  
  478. REM $STATIC
  479. SUB GraphicsDemo
  480.     IF Monitor = 0 THEN EXIT SUB
  481. '----------------------------- move balls -----------------------------
  482.     CALL Adapter(a%)
  483. SELECT CASE a%
  484.     CASE IS > 1:                'EGA or VGA
  485.  
  486.     SCREEN 12, , 0, 0: COLOR 1
  487.     CLS :
  488.     CIRCLE (559, 350), 30:
  489.     FOR y = 1 TO 66: CALL ScrollL(5, 320, 0, 380, 639): NEXT
  490.  
  491.     CIRCLE (559, 350), 30:
  492.     FOR y = 1 TO 56: CALL ScrollL(4, 320, 80, 380, 639): NEXT
  493.      
  494.     CIRCLE (559, 350), 30:
  495.     FOR y = 1 TO 46: CALL ScrollL(3, 320, 160, 380, 639): NEXT
  496.      
  497.     CIRCLE (559, 350), 30:
  498.     FOR y = 1 TO 36: CALL ScrollL(2, 320, 240, 380, 639): NEXT
  499.        
  500. '--------------------- move a triangle wave ----------------------------
  501.        
  502.     COLOR 4: i$ = ""
  503.     IF a% > 1 THEN
  504.     LOCATE 3, 21: PRINT "It is possible to scroll"
  505.     LOCATE 4, 21: PRINT "selected colors only by"
  506.     LOCATE 5, 21: PRINT "calling MapMask"
  507.     COLOR 11
  508.     END IF
  509.  
  510.     tr = 24: lc = 0: br = 87: rc = 639
  511.  
  512.     y = 86: z = -1: LINE (0, 23)-(639, 23): LINE (0, 88)-(639, 88)
  513.  
  514. DO UNTIL i$ <> ""
  515.             
  516.     'draw part of the graph
  517.     FOR x = 632 TO 639
  518.     PSET (x, y): y = y + z
  519.     IF y < 32 THEN z = 1 ELSE IF y > 86 THEN z = -1
  520.     NEXT x
  521.  
  522.     'scroll left
  523.     MapMask 11: CALL ScrollL(8, tr, lc, br, rc)
  524.  
  525.     i$ = INKEY$
  526. LOOP
  527.  
  528. '------------------- Scroll with the cursor keys -------------------------
  529.  
  530.     LOCATE 10, 1: COLOR 2: PRINT "Scroll L-R and U-D with the cursor keys"
  531.     LOCATE 16, 1: PRINT "-------------------------------------------------------------------------------"
  532.     up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80)
  533.     Lft$ = CHR$(0) + CHR$(75): rght$ = CHR$(0) + CHR$(77)
  534.     DO
  535.     i$ = INKEY$
  536.     SELECT CASE i$
  537.     CASE Lft$: MapMask 11: ScrollL 1, tr, lc, br, rc
  538.     CASE rght$: MapMask 11: ScrollR 1, tr, lc, br, rc
  539.     CASE up$: MapMask 4: scrollU 1, 0, 160, 255, 360:   'up 1 line
  540.     CASE down$: MapMask 4: ScrollD 4, 0, 160, 255, 360: 'down 4 lines
  541.     CASE ""
  542.     CASE ELSE: EXIT DO
  543.     END SELECT
  544.     LOOP
  545. '---------------------- Restore the defaults ---------------------------
  546.     MapMask 15: CALL DefaultMode
  547.  
  548. CASE 1:       'CGA
  549.  
  550. SCREEN 0, 1, 0, 0
  551. SCREEN 2: CLS
  552.        
  553.     CIRCLE (559, 50), 30
  554.     FOR y = 1 TO 66: ScrollL 8, 20, 0, 80, 639: NEXT
  555.  
  556.     CIRCLE (559, 50), 30
  557.     FOR y = 1 TO 56: ScrollL 8, 20, 80, 80, 639: NEXT
  558.        
  559.     CIRCLE (559, 50), 30
  560.     FOR y = 1 TO 46: ScrollL 8, 20, 160, 80, 639: NEXT
  561.        
  562.     CIRCLE (559, 50), 30
  563.     FOR y = 1 TO 36: ScrollL 8, 20, 240, 80, 639: NEXT
  564.  
  565.     CALL DefaultMode
  566. CASE ELSE
  567. END SELECT
  568.  
  569. END SUB
  570.  
  571. SUB GraphicsMode
  572.     'Rows, Columns and Mode are COMMON SHARED
  573.     SHARED Trap1, Trap2
  574.     h = 1: 't$ that is highlighted
  575. StartGraMode:
  576.  
  577.     '$DYNAMIC
  578.     REDIM t$(1 TO 2)
  579.     t$(1) = "SCREEN 2"
  580.     t$(2) = "SCREEN 12"
  581.     up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80)
  582.     c1 = 3: c2 = 4: IF Mode = 2 THEN c1 = 4: c2 = 0
  583.     Kolor c1, c2: 'window colors
  584.     tr = 8: lc = 45:
  585. '------------------------------------------------------------------------
  586. 'Print a help menu
  587.     Border 3: Kolor c1, c2:
  588.     OpenW 0, 3, 4, 11, 30: Lokate 1, 1
  589.     PrntW CHR$(24) + " " + CHR$(25) + "     Select mode" + CHR$(13)
  590.     PrntW "<Enter> Change mode" + CHR$(13)
  591.     PrntW "<Esc>   Exit" + CHR$(13)
  592.     PrntW "C       Count " + CHR$(13)
  593.     PrntW CHR$(13)
  594.     PrntW "Current Mode: "
  595.     IF Mode = 0 THEN
  596.         PrntW "Text" + CHR$(13):
  597.         PrntW "        " + STR$(Lines) + " x" + STR$(Columns)
  598.         END IF
  599.     IF Mode = 2 THEN
  600.         PrntW "Graphics" + CHR$(13)
  601.         PrntW "  SCREEN 2    25 x 80"
  602.         END IF
  603.     IF Mode = 12 THEN
  604.         PrntW "Graphics" + CHR$(13):
  605.            PrntW "  SCREEN 12   30 x 80"
  606.         END IF
  607.  
  608. '------------------------------------------------------------------------
  609. 'Print the possible modes in a window
  610.     Border 1: Kolor c1, c2
  611.     OpenW 0, tr, lc, tr + 3, lc + 12: 'draw a box, don't save
  612.     FOR x = 1 TO 2: PrntW t$(x) + CHR$(10): NEXT
  613. '-------------------------------------------------------------------------
  614. gTL:
  615.     Lokate tr + h, lc + 11: Prnt CHR$(27): 'highlight selection
  616.     CALL k
  617.  
  618. SELECT CASE i$
  619.       
  620. CASE up$
  621.     Lokate tr + h, lc + 11: Prnt " "
  622.     h = h - 1: IF h = 0 THEN h = 2
  623.     Lokate tr + h, lc + 11: Prnt " "
  624.     GOTO gTL
  625.  
  626. CASE down$
  627.     Lokate tr + h, lc + 11: Prnt " "
  628.     h = h + 1: IF h = 3 THEN h = 1
  629.     Lokate tr + h, lc + 11: Prnt " "
  630.     GOTO gTL
  631.  
  632. CASE CHR$(13)
  633.  
  634.     IF h = 2 THEN
  635.         EE = 0: ON ERROR GOTO ResumeNext: SCREEN 12: ON ERROR GOTO 0
  636.         IF EE = 0 THEN
  637.             Columns = 80: Lines = 30:
  638.              Mode = 12: WIDTH Columns, Lines
  639.              'don't use MemoryDump in graphics modes:
  640.             IF Trap1 = 1 THEN PLAY OFF: SWAP Trap1, Trap2
  641.             InitW RR, CC
  642.             ELSE BEEP
  643.             END IF
  644.         END IF
  645.     IF h = 1 THEN
  646.         Mode = 2: Columns = 80: Lines = 25
  647.         SCREEN Mode: WIDTH Columns, Lines
  648.         InitW RR, CC
  649.         IF Trap1 = 1 THEN PLAY OFF: SWAP Trap1, Trap2
  650.         END IF
  651.     GOTO StartGraMode
  652.  
  653. CASE CHR$(27)
  654.     EXIT SUB
  655.       
  656. CASE ELSE
  657.     GOTO gTL
  658. END SELECT
  659. END SUB
  660.  
  661. REM $STATIC
  662. SUB inc (n) STATIC
  663.     n = n + 1
  664. END SUB
  665.  
  666. SUB k
  667. k:       i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: LOOP:
  668.  
  669. END SUB
  670.  
  671. SUB logo
  672. IF Mode <> 12 THEN EXIT SUB
  673. 'Circle   (Column, Row) , radius , color, start, end
  674. 'start is  + - 2 pi radians                   0-pi top
  675. 'C 0 to 639
  676. 'R 0 to 479
  677.  
  678.        r = 18 * 16: c = 408
  679.        c2 = c + 88
  680.        radius = 16
  681.        start = 3.14 / 2
  682.        eend = 3.14 * 1.5
  683.        COLOR 4
  684.  
  685.     CIRCLE (c - 248, r), radius, 4, start, eend
  686.     LINE (c - 248, r - radius)-(c2 - 248, r - radius)
  687.     LINE (c - 248, r + radius)-(c2 - 248, r + radius)
  688.     CIRCLE (c2 - 248, r), radius, 4, eend, start
  689.  
  690.     COLOR 1
  691.     'FOR x = 1 TO 200: PRINT "1234567890"; : NEXT
  692.     LOCATE (r + radius - 1) / 16 - 8, c / 8 + 1: PRINT "VGA Version"
  693.     FOR n = 1 TO 31
  694.     MapMask 4
  695.     ScrollR 8, r - radius, c - 248 - radius, r + radius, c2 + radius
  696.     MapMask 1
  697.     ScrollD 4, (r + radius - 1) - 192, c - radius, r + radius, c2 + radius
  698.     Pause 2
  699.     NEXT
  700.       
  701.     MapMask 15
  702. END SUB
  703.  
  704. REM $DYNAMIC
  705. '===========================================================================
  706.  SUB machine STATIC
  707.     CALL KLS
  708. SELECT CASE Mode
  709. CASE 0
  710.     c1 = 0: c2 = 6: attr = c1 + c2 * 16: 'color to use here
  711.     CLS : Kolor c1, c2: KLS
  712.  
  713.     'this sub is too slow with snow checking on.  Variables are
  714.     'a little faster than passing constants
  715.     L = 1: tr = 3: lc = 44: br = 23: rc = 53
  716.        
  717.     cr$ = CHR$(13): Lokate 5, 1
  718.     Prnt "     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + cr$
  719.     Prnt "   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + cr$
  720.     Prnt " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + cr$
  721.     Prnt " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx     "
  722.     REDIM c%(800)
  723.     CALL SaveW(VARSEG(c%(1)), 3, 5, 9, 40)
  724.  
  725.     Lokate 3, 1
  726.     Prnt "                                   xxxxxxxxxxxx" + cr$
  727.     Prnt "                      xxxxxxxxxxxxxxxxxxxxxx   " + cr$
  728.     Prnt "                xxxxxxxxxxxxxxxxxxxxxxxxx   " + cr$
  729.     Prnt "           xxxxxxxxxxxxxxxxxxxxxxxx         " + cr$
  730.     Prnt "      xxxxxxxxxxxxxxxxxxxxxxx                " + cr$
  731.     Prnt "   xxxxxxxxxxxxxxxxxxxx                      " + cr$
  732.     Prnt "xxxxxxxxxxxxx                                            " + cr$
  733.     REDIM ccc%(800)
  734.     CALL SaveW(VARSEG(ccc%(1)), 3, 5, 9, 40)
  735.     KLS
  736.     'Draw a black box (attribute is 0)
  737.     Kolor 0, 0: IF Monitor = 0 THEN Kolor 3, 0
  738.     CALL OpenW(0, 10, 51, 23, 53): Kolor c1, c2
  739.     Printt "A B C D E F G H I J K L M N O", attr, 24, 51: ' A at 51, O is at 79
  740.     y = 97: DO UNTIL y = 123
  741.     i$ = INKEY$: IF i$ <> "" THEN EXIT DO
  742.  
  743.     '----go left and up
  744.     Pause 10
  745.     FOR x = 1 TO 7: ScrollL L, tr, lc, br, rc: NEXT
  746.     CALL CloseW(VARSEG(ccc%(1)), 3, 5, 9, 40): 'print arm in up position
  747.     FOR x = 1 TO 10:  scrollU L, tr, lc, br, rc: NEXT
  748.  
  749.     '---go right and down
  750.     Pause 10
  751.     FOR x = 1 TO 7:  ScrollR L, tr, lc, br, rc: NEXT
  752.     CALL CloseW(VARSEG(c%(1)), 3, 5, 8, 40): 'print arm in down position
  753.     FOR x = 1 TO 10: ScrollD L, tr, lc, br, rc: NEXT
  754.  
  755.     'scroll the letters
  756.     ScrollL 2, 24, 1, 25, 79
  757.     Printt CHR$(y), attr, 24, 49: ' small letter
  758.     IF y < 108 THEN Printt CHR$(y - 17), attr, 24, 79: 'capital letter
  759.  
  760.     inc y: LOOP
  761.     COLOR 2, 0
  762. CASE 2
  763.     Kolor 4, 0: CALL OpenW(0, 14, 50, 23, 53): Kolor 6, 0
  764.     Printt "A B C D E F G H I J K L M N O", 6, 24, 51: ' A at 51, O is at 79
  765.      tr = 5 * 8: lc = 43 * 8: br = (23 * 8) - 1: rc = 52 * 8
  766.  
  767.     y = ASC("a"): DO UNTIL y = ASC("z")
  768.     i$ = INKEY$: IF i$ <> "" THEN EXIT DO
  769.  
  770.     '----move the hammermill left and up
  771.     'FOR x = 1 TO 6: ScrollL 8, TR, LC, BR, RC: NEXT
  772.     FOR x = 1 TO 8:  scrollU 8, tr, lc, br, rc: NEXT
  773.     '---move the hammer right and down
  774.     'FOR x = 1 TO 6:  ScrollR 8, TR, LC, BR, RC: NEXT
  775.     FOR x = 1 TO 8: ScrollD 8, tr, lc, br, rc: NEXT
  776.  
  777.     'scroll the letters
  778.     ScrollL 16, 23 * 8, 0, (24 * 8) - 1, 639
  779.     Printt CHR$(y), 6, 24, 49: ' small letter
  780.     IF y < 108 THEN Printt CHR$(y - 17), 6, 24, 79: 'capital letter
  781.  
  782.     inc y: LOOP
  783.  
  784. CASE 12
  785.     Kolor 4, 0: CALL OpenW(0, 14, 51, 23, 52): Kolor 6, 0
  786.     Printt "A B C D E F G H I J K L M N O", 6, 24, 51: ' A at 51, O is at 79
  787.      tr = 5 * 16: lc = 43 * 8: br = (23 * 16) - 1: rc = 52 * 8
  788.  
  789.     y = ASC("a"): DO UNTIL y = ASC("z")
  790.     i$ = INKEY$: IF i$ <> "" THEN EXIT DO
  791.  
  792.     '----move the hammermill up and down
  793.     'FOR x = 1 TO 6: ScrollL 8, TR, LC, BR, RC: NEXT
  794.     FOR x = 1 TO 8:  scrollU 16, tr, lc, br, rc: NEXT
  795.     'FOR x = 1 TO 6:  ScrollR 8, TR, LC, BR, RC: NEXT
  796.     FOR x = 1 TO 8: ScrollD 16, tr, lc, br, rc: NEXT
  797.  
  798.     'scroll the letters
  799.     ScrollL 16, 23 * 16, 0, (24 * 16) - 1, 639
  800.     Printt CHR$(y), 6, 24, 49: ' small letter
  801.     IF y < 108 THEN Printt CHR$(y - 17), 6, 24, 79: 'capital letter
  802.  
  803.     inc y: LOOP
  804.  
  805. END SELECT
  806.     Pause 250
  807.     ERASE c%: ERASE ccc%
  808.     END SUB
  809.  
  810. REM $STATIC
  811. SUB MemoryDump STATIC
  812. 'Share flags so MemoryScroll can turn this off, monitor to restore it
  813.     SHARED Trap1, Trap2
  814.  
  815. 'MDump determines which monitor this sub prints to  (0/MDA  1/CGA)
  816. 'Monitor determines which monitor the rest of the program is using (0/MDA...)
  817.  
  818. 'initialize flags the first time thru
  819.     IF Trap1 + Trap2 = 0 THEN Trap2 = 1: cr$ = CHR$(13)
  820. 'Toggle the flag
  821.     SWAP Trap1, Trap2
  822.  
  823.     IF Trap1 = 0 THEN PLAY OFF: EXIT SUB
  824.        
  825.     CALL KLS: Prnt "This uses the routine 'Dump1' to do a debug-style memory dump.  The area        currently being viewed is that of the keyboard buffer.  Press keys not used by   the main menu to see it change.  Press any key to continue....." _
  826. : CALL k
  827.  
  828.         PLAY ON
  829.         PLAY "MB T120 L16 N0"
  830.         ON PLAY(1) GOSUB MemDump: ' MemDump is at the end of the
  831.                       ' main part of this program
  832.  
  833.     IF MDump = 0 THEN CALL Monochrome ELSE CALL CGA
  834.     '          seg  off attr lines row
  835.     CALL Dump1(&H40, &H10, 3, 6, 18)
  836.     IF Monitor = 0 THEN CALL Monochrome ELSE CALL CGA
  837. END SUB
  838.  
  839. SUB MemoryScroll STATIC
  840.     '$DYNAMIC
  841.  
  842.     'Turn off the XRay-type memory dump:
  843.     SHARED Trap1, Trap2
  844.     Trap1 = 0: Trap2 = 1
  845.     PLAY OFF
  846.  
  847.     Lokate 1, 1:
  848.     Prnt "Scroll - PgUp & PgDn          Exit - Esc  " + CHR$(13)
  849.  
  850.        
  851.     PgUp$ = CHR$(0) + CHR$(73): PgDn$ = CHR$(0) + CHR$(81)
  852.     up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80): ESC$ = CHR$(27)
  853.     offset = &H3B60: ds = VARSEG(PgUp$)
  854. '--------------------------------------------------------------------------
  855.  
  856. DO UNTIL i$ = ESC$
  857.  
  858.      Dump1 ds, offset, &H5F, Lines - 4, 2
  859.        
  860.     'put refresh in the inkey$ loop so it displays data that changes
  861.     i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: Refresh: LOOP
  862.        
  863.     IF i$ = PgUp$ THEN offset = offset - (Lines - 3) * 16
  864.     IF i$ = PgDn$ THEN offset = offset + (Lines - 3) * 16
  865.     IF offset < -32767 THEN offset = offset + 65536
  866.     IF offset > 32767 THEN offset = offset - 65536
  867.  
  868. LOOP
  869.  
  870. END SUB
  871.  
  872. '===========================================================================
  873. SUB NewBorders STATIC
  874.     Kolor 3, 0: KLS: Lokate 10, 1: Prnt "Pattern:"
  875.     Lokate 12, 1: x$ = "123456789": Prnt x$
  876.     CALL DefBorder(x$): Border 4: Kolor 3, 0
  877.     OpenW 0, 4, 2, 8, 11
  878.        
  879.     Lokate 12, 21: x$ = CHR$(220) + CHR$(220) + CHR$(220)
  880.     x$ = x$ + CHR$(221) + CHR$(32) + CHR$(222)
  881.     x$ = x$ + CHR$(223) + CHR$(223) + CHR$(223)
  882.     Prnt x$
  883.     CALL DefBorder(x$):
  884.     OpenW 0, 4, 22, 8, 31
  885.        
  886.     Lokate 12, 41: x$ = CHR$(236) + CHR$(240) + CHR$(236)
  887.     x$ = x$ + CHR$(177) + CHR$(32) + CHR$(177)
  888.     x$ = x$ + CHR$(236) + CHR$(240) + CHR$(236)
  889.     Prnt x$
  890.     CALL DefBorder(x$):
  891.     OpenW 0, 4, 42, 8, 51
  892.       
  893.     Lokate 12, 61: x$ = CHR$(176) + CHR$(176) + CHR$(176)
  894.     x$ = x$ + CHR$(219) + CHR$(32) + CHR$(219)
  895.     x$ = x$ + CHR$(176) + CHR$(176) + CHR$(176)
  896.     Prnt x$
  897.     CALL DefBorder(x$):
  898.     OpenW 0, 4, 62, 8, 71
  899.       
  900. CALL k
  901. END SUB
  902.  
  903. REM $STATIC
  904. SUB pages STATIC
  905.     '$DYNAMIC
  906. 'tests if printx prints to correct pages
  907.  
  908. 'find # rows and columns being displayed
  909.     DEF SEG = 0: pagesize = PEEK(&H44C) + PEEK(&H44D) * 256
  910.     ppages = 16384 / pagesize
  911.     IF ppages = 1 THEN EXIT SUB: 'only 1 page is possible
  912.  
  913. FOR p = 0 TO ppages - 1
  914. SCREEN , , p, p: CALL SetViewPage(p): KLS
  915. Border 2: Kolor 7, 7: OpenW 0, 5 + p, 5 + p * 4, 20 + p, 40 + p * 4
  916. PrntW "This was printed on page ": PrntS p
  917. NEXT p
  918.  
  919. 'view each page
  920.     FOR x = 0 TO ppages - 1: SCREEN , , x, x: SetViewPage x
  921.     Printt "Viewing page ", 4, x * 2, 60: PrntS x:
  922.     CALL k: NEXT
  923.     FOR x = 0 TO ppages - 1: SCREEN , , x, x: SetViewPage x
  924.     CALL k: NEXT
  925.  
  926. SCREEN , , 0, 0: SetViewPage (0)
  927. END SUB
  928.  
  929. REM $STATIC
  930. SUB Pause (n!)
  931.     SHARED Speed
  932.     FOR x = 1 TO n * Speed: NEXT
  933. END SUB
  934.  
  935. SUB PrintMainMenu STATIC
  936.     '$DYNAMIC
  937. 'This sub prints the main menu, and illustrates the use of FillW
  938.  
  939. '----Initialize the data for the main menu----
  940.     IF items = 0 THEN
  941.         REDIM m$(20)
  942.         items = 15: tr = 4: lc = 10: '# items in window & its location
  943.         m$(2) = "   Examples"
  944.         m$(3) = "     T  Set Text Mode"
  945.         m$(4) = "     G  Set Graphics Mode"
  946.         m$(5) = "     S  Scrolling"
  947.         m$(6) = "     F  Fill Window"
  948.         m$(7) = "     W  Windows & Borders"
  949.         m$(8) = "     D  Call DebugW   "
  950.         m$(9) = "     C  Configure this program"
  951.         m$(10) = "     P  Printx Demo  "
  952.         m$(11) = "     H  Display time on/off"
  953.         m$(12) = "     X  Memory Dump on/off (text modes only)"
  954.         m$(13) = "     R  Color Registers (VGA only)"
  955.         m$(14) = "     M  Scroll thru memory"
  956.         m$(15) = "     Q  Quit"
  957.         END IF
  958. 'draw the window for the menu
  959.     Kolor 3, 0: IF Mode = 12 THEN Kolor 2, 0
  960.     CALL KLS:
  961.     Border 2
  962.     OpenW 0, tr, lc, tr + items + 2, lc + 60
  963.     'the window is drawn but not saved if segment = 0
  964.  
  965. 'QuickPrint the menu - fills the window with strings from M$()
  966.     FillW 0, VARPTR(m$(1))
  967.     CALL logo
  968. END SUB
  969.  
  970. REM $STATIC
  971. SUB PrintxDemo STATIC
  972.     '$DYNAMIC
  973. CLS : LOCATE 1, 1, 1, 1, 12: 'block cursor
  974.     SHARED e$()
  975.     cr$ = CHR$(13)
  976. FOR px = 1 TO 3: 'demo's for PrntW, PrntW + CR$ and PrntW + EOL$
  977.  
  978. '---------------------------initialize the screen--------------------
  979.     
  980.     Kolor 2, 0: KLS: 'color for text and window
  981.     'print a ruler below and left of the window:
  982.         FOR x = 1 TO 16: Lokate x, 6: PrntS x: NEXT
  983.         Lokate 17, 1: FOR x = 1 TO 6: Prnt "1234567890": NEXT
  984.      Kolor 7, 0: OpenW 0, 4, 10, 16, 66
  985.     Printt " Call to PrintW ", 7, 4, 25
  986.     Printt "Next string to print is", 7, 18, 1
  987.     IF px = 2 THEN Printt " + chr$(13) ", 7, 4, 40
  988.     IF px = 3 THEN Printt " + chr$(10) ", 7, 4, 40
  989.  
  990.  
  991. '---------------------print 13 strings, each a different color --------------
  992.     Lokate 1, 1: 'top left of the window
  993.     attr = 32: 'imit val of color to print strings
  994.  
  995. x = 1:
  996. PDemoLoop: IF x = 16 GOTO PDemoD: '
  997.     at = at + &H10: 'print each string a diff. color
  998.     IF at = &H40 THEN at = &H50: '40h not visible on mono monitor
  999.     IF at = &H80 THEN at = &H20
  1000.     attr = at
  1001.     IF Mode = 12 THEN attr = attr \ 16
  1002.  
  1003. '-------------print RR & CC------------------------------
  1004.     nr = RR: nc = CC: 'save cursor loc
  1005.     'Lokate 1, 40: Prnt "RR = ": PrntS nr: Prnt "   CC = ": PrntS nc
  1006.        
  1007. '------print the next string to be printed (below the window) -----
  1008.     Lokate 19, 1
  1009.     Printt e$(x), attr, RR, CC
  1010.     Printt CHR$(13), &H7, RR, CC: 'and 2 blank lines to erase the
  1011.     Printt CHR$(13), &H7, RR, CC: 'last string
  1012.  
  1013.     'try to explain how eol$ and cr$ work
  1014.     IF nr = 16 OR nc = 66 THEN
  1015.     Lokate 22, 1: Prnt "Note the cursor goes out of bounds instead "
  1016.               Prnt "of scrolling the last line"
  1017.             END IF
  1018. '----------------locate the cursor, make it visible-------
  1019.     RR = nr: CC = nc: 'restore the cursor location
  1020.     Lokate RR, CC:    'block cursor
  1021.        
  1022. '------------------------Pause, then make the call to PrintW---------------
  1023.     CALL k: IF i$ = CHR$(27) THEN EXIT SUB
  1024.     IF px = 1 THEN PrintW e$(x), attr, RR, CC
  1025.     IF px = 2 THEN PrintW e$(x) + CHR$(13), attr, RR, CC
  1026.     IF px = 3 THEN PrintW e$(x) + CHR$(10), attr, RR, CC
  1027. inc x: GOTO PDemoLoop
  1028.  
  1029. PDemoD: NEXT px
  1030. END SUB
  1031.  
  1032. REM $STATIC
  1033. SUB TextMode
  1034.     'Rows, Columns and Mode are COMMON SHARED
  1035.     CALL KLS
  1036.  
  1037.     '$DYNAMIC
  1038.     REDIM t$(13)
  1039.     t$(1) = "25 x  80"
  1040.     t$(2) = "25 x 132"
  1041.     t$(3) = "34 x  80"
  1042.     t$(4) = "37 x 100"
  1043.     t$(5) = "34 x 132"
  1044.     t$(6) = "43 x  80"
  1045.     t$(7) = "42 x 100"
  1046.     t$(8) = "43 x 132"
  1047.     t$(9) = "50 x  80"
  1048.     t$(10) = "50 x 132"
  1049.     t$(11) = "60 x  80"
  1050.     t$(12) = "75 x 100"
  1051.     t$(13) = "60 x 132"
  1052.     up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80)
  1053.     c1 = 3: c2 = 4: Kolor c1, c2: 'window colors
  1054.     tr = 8: lc = 45:
  1055.     h = 1: 't$ that is highlighted
  1056. '------------------------------------------------------------------------
  1057. StartTextMode:
  1058.  
  1059. 'Print a help menu
  1060.     Border 3: Kolor c1, c2: OpenW 0, 3, 6, 11, 32: Lokate 1, 1
  1061.     PrntW CHR$(24) + " " + CHR$(25) + "     Select mode" + CHR$(13)
  1062.     PrntW "<Enter> Change mode" + CHR$(13)
  1063.     PrntW "<Esc>   Exit" + CHR$(13)
  1064.     PrntW "C       Count " + CHR$(13)
  1065.     PrntW CHR$(13)
  1066.     PrntW "Current Mode: "
  1067.     IF Mode = 0 AND Monitor = 0 THEN
  1068.         PrntW "Monochrome" + CHR$(13):
  1069.         PrntW "    25 x 80"
  1070.         END IF
  1071.     IF Mode = 0 AND Monitor > 0 THEN
  1072.         PrntW "Text" + CHR$(13):
  1073.         PrntW "        " + STR$(Lines) + " x" + STR$(Columns)
  1074.         END IF
  1075.  
  1076.     IF Mode = 2 THEN
  1077.         PrntW "Graphics" + CHR$(13)
  1078.         PrntW "  SCREEN 2    25 x 80"
  1079.         END IF
  1080.     IF Mode = 12 THEN
  1081.         PrntW "Graphics" + CHR$(13):
  1082.         PrntW "  SCREEN 12   30 x 80"
  1083.         END IF
  1084. '------------------------------------------------------------------------
  1085. 'Print the possible modes in a window
  1086.     Border 1: Kolor c1, c2: Lokate 1, 1
  1087.     OpenW 0, tr, lc, tr + 14, lc + 12: 'draw a box, don't save
  1088.      FOR x = 1 TO 13: PrntW t$(x) + CHR$(10): NEXT
  1089.  
  1090. '---------- Highlight the selected mode, wait for a keypress --------------
  1091. TL:     GOSUB HighLight
  1092.     CALL k
  1093.  
  1094. SELECT CASE i$
  1095.        
  1096. CASE up$
  1097.     GOSUB UnHighlight
  1098.     h = h - 1: IF h = 0 THEN h = 13
  1099.     GOSUB HighLight
  1100.     GOTO TL
  1101.  
  1102. CASE down$
  1103.     GOSUB UnHighlight
  1104.     h = h + 1: IF h = 14 THEN h = 1
  1105.     GOSUB HighLight
  1106.     GOTO TL
  1107. CASE CHR$(13)
  1108. 'if in graphics mode, change to text mode:
  1109.     IF Mode <> 0 THEN CALL DefaultMode
  1110.     IF h = 1 THEN ScanLines = &H1202: ExtMode = &H0: Font = &H1114
  1111.     IF h = 2 THEN ScanLines = &H1202: ExtMode = &H17: Font = &H1114
  1112.     IF h = 3 THEN ScanLines = &H1203: ExtMode = &H1111: Font = &H0
  1113.     IF h = 4 THEN ScanLines = &H1201: ExtMode = &H1F: Font = &H1114
  1114.     IF h = 5 THEN ScanLines = &H1203: ExtMode = &H17: Font = &H1111
  1115.     IF h = 6 THEN ScanLines = &H1201: ExtMode = &H0: Font = &H1112
  1116.     IF h = 7 THEN ScanLines = &H0: ExtMode = &H1F: Font = &H1111
  1117.     IF h = 8 THEN ScanLines = &H1201: ExtMode = &H17: Font = &H1112
  1118.     IF h = 9 THEN ScanLines = &H1202: ExtMode = &H0: Font = &H1112
  1119.     IF h = 10 THEN ScanLines = &H1202: ExtMode = &H17: Font = &H1112
  1120.     IF h = 11 THEN ScanLines = &H1203: ExtMode = &H0: Font = &H1112
  1121.     IF h = 12 THEN ScanLines = &H0: ExtMode = &H1F: Font = &H1112
  1122.     IF h = 13 THEN ScanLines = &H1203: ExtMode = &H17: Font = &H1112
  1123.  
  1124.  
  1125.      
  1126.     'set number of scan lines: al= 0/200 1/350 2/400 3/480
  1127.     'On return, if AL <> 12h, the call was invalid, meaning the adapter
  1128.     'is not a VGA or could be a VGA in CGA mode.  This test is skipped
  1129.     'in the 100-column modes because setting the number of scan lines
  1130.     'is not needed.
  1131.       
  1132.     ax% = ScanLines: bx% = &H30
  1133.     IF ax% <> 0 THEN
  1134.     CALL Int10(ax%, bx%, cx%, dx%)
  1135.     IF ax% MOD 256 <> &H12 THEN e$ = "L32ege": PLAY e$: GOTO StartTextMode
  1136.         END IF
  1137.  
  1138.     'Set text mode
  1139.     ax% = 3: bx% = 0
  1140.     CALL Int10(ax%, bx%, cx%, dx%)
  1141.  
  1142.     'change to the extended mode
  1143.     ax% = ExtMode: bx% = 0
  1144.     IF ax% <> 0 THEN CALL Int10(ax%, bx%, cx%, dx%)
  1145.      
  1146.     'load a character set into the first font area
  1147.     ax% = Font: bx% = 0:
  1148.     IF ax% <> 0 THEN CALL Int10(ax%, bx%, cx%, dx%)
  1149.  
  1150.     Lines = VAL(LEFT$(t$(h), 3))
  1151.     Columns = VAL(RIGHT$(t$(h), 3))
  1152.     InitW RR, CC
  1153.     CALL Adapter(Monitor)
  1154.     GOTO StartTextMode
  1155.  
  1156.        
  1157. CASE "C", "c"
  1158.     'print a 'ruler' to check # of rows & columns
  1159.     Kolor 4, 0: Lokate 1, 1
  1160.     FOR x = 10 TO Columns STEP 10
  1161.     PrntUsingS "##########", x: NEXT
  1162.     FOR x = 1 TO Lines: Lokate x, 1:
  1163.     PrntUsingS "#####", x: NEXT
  1164.     GOTO TL
  1165.  
  1166. CASE CHR$(27)
  1167.     EXIT SUB
  1168.        
  1169. CASE ELSE
  1170.     GOTO TL
  1171. END SELECT
  1172.  
  1173. '------------------------------------------------------------------------
  1174. UnHighlight:
  1175.     IF Mode = 0 AND Monitor <> 0 THEN
  1176.     Lokate tr + h, 1: Kolor c1, c2: PrntW t$(h) + CHR$(10)
  1177.     ELSE Lokate tr + h, lc + 11: Prnt " "
  1178.     END IF
  1179.     RETURN
  1180. HighLight:
  1181.     IF Mode = 0 AND Monitor <> 0 THEN
  1182.     Kolor c2, c1: Lokate tr + h, lc + 1: PrntW t$(h) + CHR$(10)
  1183.     ELSE Lokate tr + h, lc + 11: Prnt CHR$(27)
  1184.     END IF
  1185.     RETURN
  1186. END SUB
  1187.  
  1188. SUB train STATIC
  1189.  
  1190.     Delay = 4: Kolor 3, 0: KLS
  1191.     Lokate 1, 1: Prnt "     f/faster   s/slower  esc/quit          delay ="
  1192.     Lokate 1, 60: PrntUsingS "###", Delay
  1193.     x$ = ".eiee[] o---o o---o o---o o---o o---o o---o eee[]e"
  1194. SELECT CASE Mode
  1195.     CASE 0
  1196.     'run onto the screen
  1197.     FOR x = 1 TO LEN(x$)
  1198.         Printt MID$(x$, x, 1), 3, 16, 1
  1199.         ScrollR 1, 16, 1, 16, 80
  1200.         scrollU 1, 10, 80, 16, 80
  1201.         ScrollL 1, 10, 1, 10, 80
  1202.         ScrollD 1, 10, 1, 16, 1
  1203.         NEXT
  1204.        
  1205.     'run around until a keypress
  1206.     DO
  1207.         ScrollR 1, 16, 1, 16, 80
  1208.         scrollU 1, 10, 80, 16, 80
  1209.         ScrollL 1, 10, 1, 10, 80
  1210.         ScrollD 1, 10, 1, 16, 1
  1211.        
  1212.     Pause Delay
  1213.     i$ = INKEY$: IF i$ = CHR$(27) THEN EXIT DO
  1214.     IF i$ <> "" THEN GOSUB TrainKeyPress
  1215.     LOOP
  1216.  
  1217. 'To run off the screen, stop scrolling up when the '.' gets to the BR corner.
  1218. FOR x = 1 TO 350
  1219.     IF SCREEN(16, 79) = 46 THEN x = 200
  1220.        
  1221.         ScrollR 1, 16, 1, 16, 80
  1222.         IF x < 199 THEN scrollU 1, 10, 80, 16, 80
  1223.         ScrollL 1, 10, 1, 10, 80
  1224.         ScrollD 1, 10, 1, 16, 1
  1225.         Pause Delay
  1226.     NEXT
  1227.  
  1228.     CASE 2
  1229.     Lokate 10, 1: Prnt x$
  1230.     
  1231.     'run around until a keypress
  1232.     DO
  1233.         ScrollR 8, 120, 0, 127, 639
  1234.         scrollU 8, 72, 632, 127, 639
  1235.         ScrollL 8, 72, 0, 79, 639
  1236.         ScrollD 8, 72, 0, 127, 7
  1237.     i$ = INKEY$: IF i$ = CHR$(27) THEN EXIT DO
  1238.     LOOP
  1239.  
  1240.  
  1241.     CASE 12
  1242.        
  1243.     Lokate 10, 1: Prnt x$
  1244.     DO
  1245.         ScrollR 8, 240, 0, 255, 639
  1246.         scrollU 16, 144, 632, 255, 639
  1247.         ScrollL 8, 144, 0, 159, 639
  1248.         ScrollD 16, 144, 0, 255, 7
  1249.     i$ = INKEY$: IF i$ = CHR$(27) THEN EXIT DO
  1250.     LOOP
  1251. END SELECT
  1252. EXIT SUB
  1253. '-----------------------------------------------------------
  1254. TrainKeyPress:
  1255.     IF i$ = "f" AND Delay > 0 THEN dec Delay
  1256.     IF i$ = "s" AND Delay < 80 THEN inc Delay: inc Delay
  1257.     Lokate 1, 60: PrntUsingS "###", Delay
  1258.     RETURN
  1259.  
  1260.  
  1261. END SUB
  1262.  
  1263. REM $STATIC
  1264. SUB VGARead16ColReg (ColorReg$) STATIC
  1265. 'Save the state of 16 color registers and the overscan register.  On
  1266. 'return, Palette$ is 49 bytes long and contains the values of the 16
  1267. 'color registers currently in use, plus one byte for the overscan register.
  1268.  
  1269. '''It would have been easier and more reliable to just save all 256 but
  1270. '''this is compatible with VPT.EXE
  1271.        
  1272.     'Read the current palette registers to see
  1273.     'which color registers they are mapped to.
  1274.     CALL VGAReadPalReg(palette$)
  1275.  
  1276.     'Read each color register into a string
  1277.     ColorReg$ = STRING$(49, " ")
  1278.     
  1279.     FOR n = 1 TO 16
  1280.     ax% = &H1017
  1281.     bx% = ASC(MID$(palette$, n, 1)):    'first register to read
  1282.     cx% = 1:                            'number of registers to read
  1283.     dx% = SADD(ColorReg$) + (n - 1) * 3: 'string at es:dx
  1284.     Int10 ax%, bx%, cx%, dx%
  1285.     NEXT
  1286.     'This function reads cx registers into a string at es:dx, starting
  1287.     'with register number bx. You may read up to 255 reg at once with
  1288.     'this call.  Each takes 3 bytes, the order is Red-Green-Blue.
  1289.     'If you wish to read the registers into numeric arrays or
  1290.     'variables instead of a string, VGARead1ColReg may be easier.
  1291.  
  1292.     'overscan reg goes in the last byte
  1293.     MID$(ColorReg$, 49, 1) = MID$(palette$, 17, 1)
  1294.  
  1295. END SUB
  1296.  
  1297. SUB VGARead1ColReg (reg, red, green, blue)
  1298. 'Reads the current values for one color register.
  1299. 'The default registers for VGA are:
  1300. '       Color   Register
  1301. '         0        0
  1302. '         1        1
  1303. '         2        2
  1304. '         3        3
  1305. '         4        4
  1306. '         5        5
  1307. '         6       20
  1308. '         7        7
  1309. '         8       56
  1310. '         9       57
  1311. '        10       58
  1312. '        11       59
  1313. '        12       60
  1314. '        13       61
  1315. '        14       62
  1316. '        15       63
  1317. 'Ex. to change the color displayed by the QB statement COLOR 8,0, change
  1318. 'the values in register 56
  1319. '
  1320.  
  1321.     IF reg < 0 OR reg > 255 THEN STOP
  1322.     ax% = &H1015
  1323.     bx% = reg: 'register you wish to read, 0 to 255
  1324.     Int10 ax%, bx%, cx%, dx%
  1325.  
  1326.     'results:
  1327.     red = dx% \ 256
  1328.     blue = cx% \ 256
  1329.     green = cx% MOD 256
  1330.  
  1331. END SUB
  1332.  
  1333. SUB VGAReadFile (File$, RGB$) STATIC
  1334. ' loads a file created by VPT.EXE into RBG$
  1335.  
  1336. ' on exit, RGB$ is 49 bytes, ***or a null string if an error occurred***
  1337.  
  1338.     ' VPT.EXE is a very nice editor for the vga color registers
  1339.     ' and may be found on the EXEC-PC bulletin board.
  1340.  
  1341.     'save a window, print message
  1342.     Border 2: Kolor 2, 0
  1343.     WSize Bytes&, 10, 30, 12, 60
  1344.     REDIM t(Bytes& / 2) AS INTEGER
  1345.     OpenW VARSEG(t(1)), 10, 30, 12, 60
  1346.     Lokate 1, 1: PrntW "Loading " + File$
  1347.  
  1348.     RGB$ = SPACE$(49)
  1349. '       Be sure the file exists!
  1350.         ON ERROR GOTO ResumeNext
  1351.         OPEN File$ FOR RANDOM AS #1
  1352.         ON ERROR GOTO 0
  1353.         FileLength = LOF(1)
  1354.         CLOSE
  1355.  
  1356.     IF FileLength = 49 THEN
  1357.         OPEN File$ FOR BINARY AS #3: GET #3, , RGB$
  1358.         ELSE RGB$ = "": PrintW File$ + " not found", 2, 1, 1
  1359.         END IF
  1360. 'Be sure the file exists because OPEN FOR BINARY will create a file by
  1361. 'this name with 0 length, ON ERROR will not trap the error, and RGB$
  1362. 'will be a string of 49 zero's. That would make for a very black monitor.
  1363.  
  1364. FOR x = 1 TO 300: NEXT: 'time to read the message
  1365. CALL CloseLastW: ERASE t
  1366. END SUB
  1367.  
  1368. SUB VGAReadPalReg (palette$) STATIC
  1369.     'Reads the state of 16 palette registers and
  1370.     'the overscan register into a 17 byte string
  1371.  
  1372.     palette$ = STRING$(17, " ")
  1373.     Int10 &H1009, 0, 0, SADD(palette$)
  1374. END SUB
  1375.  
  1376. SUB VGASet16ColReg (RGB$) STATIC
  1377. 'set all 16 color registers from a 48 or 49 byte string
  1378.  
  1379. 'Get a list of the color registers being displayed
  1380.     CALL VGAReadPalReg(palette$)
  1381.  
  1382. 'Be sure we are not calling with a null or blank string:
  1383.     IF RGB$ <> SPACE$(49) AND (LEN(RGB$) = 49 OR LEN(RGB$) = 48) THEN
  1384.     FOR n = 1 TO 15
  1385.     ax% = &H1012
  1386.     bx% = ASC(MID$(palette$, n, 1)):    'first register to write
  1387.     cx% = 1:                            'number of registers to write
  1388.     dx% = SADD(RGB$) + (n - 1) * 3: 'string at es:dx
  1389.     Int10 ax%, bx%, cx%, dx%
  1390.     NEXT
  1391.      
  1392.     END IF
  1393.  
  1394. END SUB
  1395.  
  1396. SUB VGASet1ColReg (reg, red, green, blue) STATIC
  1397.  
  1398.     IF reg < 0 OR reg > 255 THEN STOP
  1399.     IF red < 0 OR red > 63 THEN STOP
  1400.     IF green < 0 OR red > 63 THEN STOP
  1401.     IF blue < 0 OR red > 63 THEN STOP
  1402.     ax% = &H1010
  1403.     bx% = reg
  1404.     cx% = green * 256 + blue
  1405.     dx% = red * 256
  1406.     Int10 ax%, bx%, cx%, dx%
  1407.  
  1408. END SUB
  1409.  
  1410. SUB VgaSetDefaultReg STATIC
  1411. ' set the palette and color registers to their default state
  1412.     REDIM reg(0 TO 63, 1 TO 3) AS INTEGER
  1413.     red = 1: green = 2: blue = 3
  1414.        
  1415.     'Default values for COLOR 7 are 42, 42 & 42, but
  1416.     'I usually change it to 0, 63, 0 so the DOS prompt is green
  1417.  
  1418.     reg(0, red) = 0: reg(0, green) = 0: reg(0, blue) = 0
  1419.     reg(1, red) = 0: reg(1, green) = 0: reg(1, blue) = 42
  1420.     reg(2, red) = 0: reg(2, green) = 42: reg(2, blue) = 0
  1421.     reg(3, red) = 0: reg(3, green) = 42: reg(3, blue) = 42
  1422.     reg(4, red) = 42: reg(4, green) = 0: reg(4, blue) = 0
  1423.     reg(5, red) = 42: reg(5, green) = 0: reg(5, blue) = 42
  1424.     reg(20, red) = 42: reg(20, green) = 21: reg(20, blue) = 0
  1425.     reg(7, red) = 0: reg(7, green) = 63: reg(7, blue) = 0
  1426.     reg(56, red) = 21: reg(56, green) = 21: reg(56, blue) = 21
  1427.     reg(57, red) = 21: reg(57, green) = 21: reg(57, blue) = 63
  1428.     reg(58, red) = 21: reg(58, green) = 63: reg(58, blue) = 21
  1429.     reg(59, red) = 21: reg(59, green) = 63: reg(59, blue) = 63
  1430.     reg(60, red) = 63: reg(60, green) = 21: reg(60, blue) = 21
  1431.     reg(61, red) = 63: reg(61, green) = 21: reg(61, blue) = 63
  1432.     reg(62, red) = 63: reg(62, green) = 63: reg(62, blue) = 21
  1433.     reg(63, red) = 63: reg(63, green) = 63: reg(63, blue) = 63
  1434.  
  1435.     REDIM PalReg(0 TO 16) AS INTEGER
  1436.     '0-15 are  Palette registers, 16 is the overscan register
  1437.     FOR n = 0 TO 7: PalReg(n) = n: NEXT
  1438.     FOR n = 8 TO 15: PalReg(n) = n + 48: NEXT
  1439.     PalReg(6) = 20: ' one oddball
  1440.     PalReg(16) = 0: 'overscan register
  1441.  
  1442. 'set the palette register
  1443.     FOR n = 0 TO 15
  1444.     'ax = 1000
  1445.     'bh = color reg value
  1446.     'bl = palette reg
  1447.     Int10 &H1000, PalReg(n) * 256 + n, 0, 0
  1448.  
  1449. 'set the corresponding color register
  1450.     'ax=1010
  1451.     'bx = register
  1452.     'ch = green
  1453.     'cl = blue
  1454.     'dh = red
  1455. 'PRINT &H1010, PalReg(n), HEX$(reg(PalReg(n), green) * 256 + reg(PalReg(n), blue)), HEX$(reg(PalReg(n), red) * 256)
  1456. Int10 &H1010, PalReg(n), reg(PalReg(n), green) * 256 + reg(PalReg(n), blue), reg(PalReg(n), red) * 256
  1457.     NEXT
  1458.       
  1459.     'set the overscan register to zero
  1460.     Int10 &H1001, PalReg(16) * 256, 0, 0
  1461.  
  1462.     ERASE reg: ERASE PalReg
  1463. END SUB
  1464.  
  1465. SUB VGASetOverScanReg (n) STATIC
  1466.     IF n < 0 OR n > 15 THEN STOP
  1467.     ax% = &H1001
  1468.     bx% = n
  1469.     Int10 ax%, bx%, cx%, dx%
  1470.  
  1471. END SUB
  1472.  
  1473. SUB VgaViewReg STATIC
  1474.     CALL VGARead16ColReg(V$)
  1475.     CALL VGAReadPalReg(palette$)
  1476.  
  1477.     Lokate 1, 1: 'CALL KLS
  1478.     Black$ = CHR$(0) + CHR$(0) + CHR$(0): cr$ = CHR$(13)
  1479.     Prnt "          Current colors" + cr$: Prnt cr$
  1480.     Prnt "     Color  Register       Red     Green      Blue" + cr$
  1481.     FOR x = 1 TO 46 STEP 3
  1482.     c = (x - 1) / 3
  1483.     IF MID$(V$, x, 3) = Black$ THEN Kolor 7, 0 ELSE Kolor c, 0
  1484.     PrntUsingS "##########", c
  1485.     PrntUsingS "##########", ASC(MID$(palette$, c + 1, 1))
  1486.     FOR y = 0 TO 2
  1487.         PrntUsingS "##########", ASC(MID$(V$, x + y, 1))
  1488.         NEXT
  1489.     IF MID$(V$, x, 3) = Black$ THEN
  1490.         Prnt "  (Black)" + cr$
  1491.         ELSE Prnt "   " + CHR$(219) + CHR$(219) + CHR$(219) + cr$
  1492.         END IF
  1493.     NEXT
  1494.     Kolor 2, 0
  1495.     Prnt "Overscan is color ": PrntS ASC(RIGHT$(V$, 1))
  1496.  
  1497. END SUB
  1498.  
  1499. SUB Window1
  1500.     '$DYNAMIC
  1501. 'this sub draws several windows, illustrates CloseLastW, zooming, and DBox
  1502. SELECT CASE Mode
  1503. CASE 0
  1504.     'zoom this one
  1505.     WSize Bytes&, 12, 30, 24, 80: : REDIM t4%(Bytes& / 2)
  1506.     SaveW VARSEG(t4%(1)), 12, 30, 24, 80:  'note SaveW, not OpenW
  1507.     FOR x = 80 TO 30 STEP -1
  1508.     Kolor 0, 6: OpenW 0, 12, x, 24, 80
  1509.     Pause 1
  1510.     NEXT
  1511.        
  1512.     WSize Bytes&, 2, 2, 7, 79: REDIM t1%(Bytes& / 2): Pause 50
  1513.     Kolor 0, 2: OpenW VARSEG(t1%(1)), 2, 2, 7, 79
  1514.        
  1515.     WSize Bytes&, 1, 70, 25, 77: REDIM t2%(Bytes& / 2): Pause 50
  1516.     Border 3: Kolor 0, 3: OpenW VARSEG(t2%(1)), 1, 70, 25, 77
  1517.  
  1518.  
  1519.     WSize Bytes&, 6, 12, 20, 35: REDIM t3%(Bytes& / 2): Pause 50
  1520.     Kolor 0, 3: OpenW VARSEG(t3%(1)), 6, 12, 20, 35
  1521.  
  1522.     Lokate 3, 3: Kolor 3, 0:
  1523.     Prnt "Restoring the screen is as easy as calling 'CloseLastW'."
  1524.        
  1525. 'the last box to draw is in the QBasic sub DBox
  1526.     Pause 50
  1527.     CALL DBox("Press <Enter> to continue.....", "")
  1528.     Pause 50
  1529.        
  1530. 'now erase the boxes
  1531.     FOR x = 1 TO 3: CloseLastW:  Pause 100: NEXT
  1532. 'WATCH OUT - that zooming effectively trashes the CloseLastW Stack
  1533. 'so close the last one with CloseW
  1534.     CloseW VARSEG(t4%(1)), 12, 30, 24, 80
  1535.     Pause 200
  1536.     ERASE t4%: ERASE t3%: ERASE t2%: ERASE t1%
  1537.  
  1538. CASE 2
  1539.     'zoom this one
  1540.     WSize Bytes&, 12, 30, 24, 80: : REDIM t4%(Bytes& / 2)
  1541.     SaveW VARSEG(t4%(1)), 12, 30, 24, 80:  'note SaveW, not OpenW
  1542.     FOR x = 80 TO 30 STEP -1
  1543.     Kolor 0, 6: OpenW 0, 12, x, 24, 80
  1544.     Pause 1
  1545.     NEXT
  1546.       
  1547.     WSize Bytes&, 2, 2, 7, 79: REDIM t1%(Bytes& / 2): Pause 50
  1548.     Kolor 0, 2: OpenW VARSEG(t1%(1)), 2, 2, 7, 79
  1549.       
  1550.     WSize Bytes&, 1, 70, 25, 77: REDIM t2%(Bytes& / 2): Pause 50
  1551.     Border 3: Kolor 0, 3: OpenW VARSEG(t2%(1)), 1, 70, 25, 77
  1552.  
  1553.  
  1554.     WSize Bytes&, 6, 12, 20, 35: REDIM t3%(Bytes& / 2): Pause 50
  1555.     Kolor 0, 3: OpenW VARSEG(t3%(1)), 6, 12, 20, 35
  1556.  
  1557.     Lokate 3, 3: Kolor 3, 0:
  1558.     Prnt "Restoring the screen is as easy as calling 'CloseLastW'."
  1559.       
  1560. 'the last box to draw is in the QBasic sub DBox
  1561.     Pause 50
  1562.     CALL DBox("Press <Enter> to continue.....", "")
  1563.       
  1564. 'now erase the boxes
  1565.     FOR x = 1 TO 3: CloseLastW:  Pause 200: NEXT
  1566. 'WATCH OUT - that zooming effectively trashes the CloseLastW Stack
  1567. 'so close the last one with CloseW
  1568.     CloseW VARSEG(t4%(1)), 12, 30, 24, 80
  1569.     Pause 200
  1570.     ERASE t4%: ERASE t3%: ERASE t2%: ERASE t1%
  1571.  
  1572. CASE 12
  1573.     FOR x = 80 TO 30 STEP -1
  1574.     Kolor 6, 0: OpenW 0, 12, x, 24, 80
  1575.     Pause 1
  1576.     NEXT
  1577.       
  1578.     Kolor 2, 0: OpenW 0, 2, 2, 7, 79
  1579.     Border 3: Kolor 3, 0: OpenW 0, 1, 70, 25, 77
  1580.     Kolor 3, 0: OpenW 0, 6, 12, 20, 35
  1581.     Pause 250
  1582.  
  1583. END SELECT
  1584. END SUB
  1585.  
  1586. REM $STATIC
  1587. SUB Window2
  1588.     '$DYNAMIC
  1589. 'This demo uses OpenW with user-defined borders to draw a background and
  1590. 'prints a window with a shadow
  1591.  
  1592. 'defborder (x$)          string of 9 char for user defined borders
  1593.     Bd$ = "": FOR x = 1 TO 9: Bd$ = Bd$ + CHR$(176): NEXT
  1594. DefBorder Bd$: Border 4
  1595.  
  1596. KLS
  1597. 'draw the background
  1598.     Kolor 2, 0: OpenW 0, 1, 1, 25, 15
  1599.     Kolor 3, 0: OpenW 0, 1, 16, 25, 29
  1600.     Kolor 5, 0: OpenW 0, 1, 30, 25, 47
  1601.     Kolor 6, 0: OpenW 0, 1, 48, 25, 63
  1602.     Kolor 2, 0: OpenW 0, 1, 64, 25, 80
  1603.  
  1604. 'draw the shadow of the window
  1605.     tr = 8: br = 16: lc = 20: rc = 60
  1606.     Kolor 0, 0: OpenW 0, tr + 1, lc - 1, br + 1, rc - 1
  1607.  
  1608. 'draw the window
  1609.     Kolor 0, 3: Border 2: OpenW 0, tr, lc, br, rc
  1610.     Lokate 1, 1: Kolor 3, 0:
  1611.     PrntW "Illustrates shadows and backgrounds.   Press any key..."
  1612.  
  1613. CALL k: CALL KLS
  1614. '-------------------------------------------------------------------------
  1615. END SUB
  1616.  
  1617. REM $STATIC
  1618. SUB Window3
  1619. '$DYNAMIC
  1620.     IF Mode <> 0 THEN EXIT SUB
  1621.      Kolor 0, 6: KLS: REDIM temp%(500)
  1622.      Lokate 1, 1: Prnt "This demonstrates the error checking that occurs (in text modes only)"
  1623.      Lokate 2, 1: Prnt "when window coordinates are outside the viewing area"
  1624.     up$ = CHR$(0) + CHR$(72): down$ = CHR$(0) + CHR$(80)
  1625.     Lft$ = CHR$(0) + CHR$(75): rght$ = CHR$(0) + CHR$(77)
  1626.     tr = 8: lc = 40: br = 15: rc = 62
  1627.     WSize Bytes&, tr, lc, br, rc: REDIM temp%(Bytes& / 2)
  1628.     i$ = ""
  1629.        
  1630. DO
  1631. 'print the coordinates
  1632.     Lokate 5, 5: Prnt "TR ": PrntS tr
  1633.     IF tr < 1 THEN Prnt " " + CHR$(27) ELSE Prnt "    "
  1634.     Lokate 6, 5: Prnt "LC ": PrntS lc
  1635.     IF lc < 1 THEN Prnt " " + CHR$(27) ELSE Prnt "    "
  1636.     Lokate 7, 5: Prnt "BR ": PrntS br
  1637.     IF br > 25 THEN Prnt " " + CHR$(27) ELSE Prnt "    "
  1638.     Lokate 8, 5: Prnt "RC ": PrntS rc
  1639.     IF rc > 80 THEN Prnt " " + CHR$(27) ELSE Prnt "    "
  1640.        
  1641. 'print the box
  1642.     Border 0: Kolor 0, 7: OpenW VARSEG(temp%(1)), tr, lc, br, rc
  1643.     Lokate 1, 1
  1644.     PrntW "Move this box " + CHR$(13)
  1645.     PrntW "off the screen " + CHR$(13)
  1646.     PrntW "with the cursor keys." + CHR$(13)
  1647.     PrntW "Press ESC to quit"
  1648.  
  1649. 'wait for a keypress, then drag the window around the screen using the
  1650. 'cursor keys
  1651.     i$ = "": DO UNTIL i$ <> "": i$ = INKEY$: LOOP
  1652.     SELECT CASE i$
  1653.     CASE up$: tr = tr - 1: br = br - 1
  1654.     CASE down$: tr = tr + 1: br = br + 1
  1655.     CASE Lft$: lc = lc - 1: rc = rc - 1
  1656.     CASE rght$: lc = lc + 1: rc = rc + 1
  1657.     CASE ELSE: EXIT DO
  1658.     END SELECT
  1659.  
  1660.     CALL CloseLastW
  1661. LOOP
  1662.     ERASE temp%
  1663. END SUB
  1664.  
  1665.