home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library6 / rats.bas < prev    next >
BASIC Source File  |  1990-09-15  |  14KB  |  504 lines
  1. ' The following is a program I wrote to teach myself how to program the mouse.
  2. ' It doesn't use all of the mouse functions but I think the ones it does use
  3. ' will handle about any task you will need if kept simple.
  4. '
  5. ' If you have any questions you can drop me a line.
  6. ' Not that I can answer them, but you can still ask.    John Watts
  7. '                                            73760,751
  8. ' NOTE:                                        PCVENB LIB 12 Spectra
  9. ' Set TAB's to five (5) ... Alt-O E T 5 <Enter>
  10.  
  11. gosub setup                    ' Set up some variables
  12.  
  13. '──────────────────────────────────────────┐
  14. mode% = fVideoMode%                       '│   This function & routine will
  15.                                   '│   determine whether you are
  16. select case mode%                         '│   running a color or monochrome
  17.     case 3                               '│   monitor and set the foreground
  18.         foreground% = 14    'CGA/EGA/VGA │   color for the work area.
  19.         videobufferabs& = &hb800 * 16   '│   The foreground color must be
  20.     case 7                               '│   set   ──┐
  21.         foreground% = 7    'MONO/HERC   │           │  NOTE: This is for
  22.         videobufferabs& = &hb000 * 16   '│           │        monochrome
  23. end select                                '│           │        compatibility
  24. '──────────────────────────────────────────┘           │
  25. call MainScreen                                '│
  26. color foreground%,0 '──────────────────────────────────┴─before you initilize
  27. locate 4,1                                            '  the mouse.──┐
  28.                                                        '│
  29. for x% = 1 to 13                                                    '│
  30.         print scrn$(x%);                                          '│
  31. next x%                                                             '│
  32.                                                        '│
  33. call rat.init(m%,b%) '───────────────────────────────────────────────┘
  34. if not m% then print "Mouse not installed":end
  35.  
  36. call rat.min.max.vert(24,176)
  37.  
  38. call rat.show
  39.  
  40. first.loop:
  41.  
  42. call rat.min.max.vert(24,176)
  43.  
  44. call rat.min.max.horz(0,632)
  45.  
  46. do
  47.     call rat.pos.but(but.status%,row%,col%)
  48.  
  49.     if (row% > 120) and (but.status% = 0) then goto skip
  50.     locate 2,9
  51.  
  52.     r% = ((row% + l% ) / 8) + (tl% - 1)
  53.     c% = (col% + 8 ) / 8
  54.     print using "###";r%;
  55.     locate ,21
  56.     print using "###";c%;
  57.  
  58.     if but.status% then
  59.         but% = -1
  60.         select case but.status%
  61.  
  62.         case 1
  63.             locate 2,75
  64.             print chr$(219);
  65.             gosub place.character
  66.             goto skip
  67.         case 2
  68.             locate 2,79
  69.             print chr$(219);
  70.             gosub scroll.up
  71.         case 4
  72.             locate 2,77
  73.             print chr$(219);
  74.             gosub scroll.down
  75.         case 3
  76.             locate 2,75
  77.             print chr$(219);
  78.             locate ,79
  79.             print chr$(219)
  80.             gosub place.character
  81.             gosub scroll.up
  82.         case 5
  83.             locate 2,75
  84.             print chr$(219);
  85.             locate ,77
  86.             print chr$(219)
  87.             gosub place.character
  88.             gosub scroll.down
  89.  
  90.         end select
  91.  
  92.     elseif but% then
  93.         locate 2,75
  94.         print "L";
  95.         locate ,77
  96.         print "M";
  97.         locate ,79
  98.         print "R";
  99.         but% = 0
  100.     end if
  101. skip:
  102.     if row% > 120 then
  103.         select case col%
  104.         case 0 to 416
  105.             if but% then exit if
  106.             goto second.loop
  107.         case 424 to 632
  108.             if but% then exit if
  109.             goto third.loop
  110.         end select
  111.     end if
  112.  
  113. loop while not instat
  114.  
  115. goto finish
  116.  
  117. second.loop:
  118. locate 25,1
  119. print "Select character";string$(40,32);
  120. call rat.min.max.horz(0,416)
  121.  
  122. do
  123.  
  124.     call rat.pos.but(but.status%,row%,col%)
  125.  
  126.  
  127.     if row% < 128 then
  128.         locate 25,1
  129.         print "Place character";string$(40,32);
  130.         goto first.loop
  131.     end if
  132.  
  133.     if but.status% and row% > 128 then
  134.         char.selected% = screen((row%+8)/8,(col%+8)/8)
  135.         select case char.selected%
  136.         case 69,84,88
  137.             gosub text
  138.         case else
  139.             locate 23,77
  140.             print chr$(char.selected%);
  141.         end select
  142.     end if
  143. loop while not instat
  144.  
  145. goto finish
  146.  
  147. third.loop:
  148.  
  149. call rat.min.max.vert(24,136)
  150.  
  151. call rat.min.max.horz(432,624)
  152.  
  153.         locate 25,1
  154.         print "Select task";string$(40,32);
  155.  
  156. do
  157.  
  158.     call rat.pos.but(but.status%,row%,col%)
  159.  
  160.     if row% < 128 then
  161.         locate 25,1
  162.         print "Place character";string$(40,32);
  163.         goto first.loop
  164.     end if
  165.  
  166.     if but.status% then
  167.         select case col%
  168.  
  169.         case 432 to 472                'Save screen
  170.             open "o", 1, "tbscreen.fil"
  171.             for x% = 1 to 25
  172.                 write #1,scrn$(x%)
  173.             next x%
  174.             close #1
  175.  
  176.         case 480 to 520                'Load screen
  177.             open "i", 1, "tbscreen.fil"
  178.             for x% = 1 to 25
  179.                 input #1,scrn$(x%)
  180.             next x%
  181.             close  #1
  182.             locate 4,1
  183.             for x% = 1 to 13
  184.                 print scrn$(x%);
  185.             next x%
  186.  
  187.         case 528 to 568                    'View screen
  188.             call rat.hide
  189.             call SaveScreen
  190.             cls
  191.             for x% = 1 to 24
  192.                 print scrn$(x%);
  193.             next x%
  194.             locate 25,1
  195.             print "Press any key to continue.";
  196.             while not instat:wend
  197.             cls
  198.             call RestoreScreen
  199.             call rat.show
  200.  
  201.         case 576 to 624                'Clear screen
  202.             for x% = 1 to 25
  203.                 scrn$(x%) = string$(80,32)
  204.             next x%
  205.             locate 4,1
  206.             for x% = 1 to 13
  207.                 print scrn$(x%);
  208.             next x%
  209.  
  210.         end select
  211.     end if
  212. loop while not instat
  213.  
  214. goto finish
  215.  
  216. '********************************** sub-routines *****************************
  217.  
  218. place.character:
  219.     if row% > 120 then return second.loop
  220.     locate (row%+8)/8,c%
  221.     call rat.hide
  222.     print chr$(char.selected%);
  223.     call rat.show
  224.     mid$(scrn$(r%),c%,1) = chr$(char.selected%)
  225. return
  226.  
  227. scroll.up:
  228.     if bl% = 25 then beep:delay 1:return
  229.     call rat.hide
  230.     call scroll(1,4,1,16,80,7,-1)
  231.     incr tl%
  232.     incr bl%
  233.     locate 16,1
  234.     print scrn$(bl%);
  235.     call rat.show
  236.     delay .1                        ' You may want to change this delay
  237. return                            ' or even remove it
  238.  
  239. scroll.down:
  240.     if tl% = 1 then beep:delay 1:return
  241.     call rat.hide
  242.     call scroll(1,4,1,16,80,7,0)
  243.     decr tl%
  244.     decr bl%
  245.     locate 4,1
  246.     print scrn$(tl%);
  247.     call rat.show
  248.     delay .1                        ' Same here
  249. return
  250.  
  251. text:
  252.     locate 25,1
  253.     print "Position cursor and type.   Press Esc to exit.";
  254.  
  255.     call rat.min.max.vert(24,120)
  256.     call rat.min.max.horz( 0,632)
  257.  
  258.     do
  259.         while not instat
  260.             call rat.pos.but(b%,row%,col%)
  261.             r% = ((row% + l% ) / 8) + (tl% - 1)
  262.             c% = (col% + 8 ) / 8
  263.             locate 2,9
  264.             print using "###";r%;
  265.             locate ,21
  266.             print using "###";c%;
  267.         wend
  268.         txt$ = inkey$
  269.         if txt$ = chr$(27) then
  270.             char.selected% = 32
  271.             call rat.min.max.vert(24,176)
  272.             return
  273.         end if
  274.         locate (row% + 8) / 8,(col% + 8) / 8
  275.         call rat.hide
  276.         print txt$;
  277.         mid$(scrn$(r%),c%,1) = txt$
  278.         call rat.move(row%,col%+8)
  279.         call rat.show
  280.     loop
  281. return
  282.  
  283. setup:
  284. dim scrn$(1:25)
  285. '─────────────────────────────────────────────────────────────┐ Set up a
  286. screenbuffer$ = string$(4000,32)                             '│ string to
  287. screenbufferseg& = strseg(screenbuffer$)                     '│hold the video
  288. screenbufferofs& = strptr(screenbuffer$)                     '│buffer and get
  289. screenbufferabs& = screenbufferseg& * 16 + screenbufferofs&  '│20 bit address
  290. '─────────────────────────────────────────────────────────────┘ of string
  291. for x% = 1 to 25
  292.     scrn$(x%) = string$(80,32)
  293. next x%
  294.  
  295. l% = -16
  296. tl% = 1
  297. bl% = 13
  298. return
  299.  
  300. finish:
  301.     while instat:ans$ = inkey$:wend
  302.     select case ans$
  303.         case chr$(27)                ' If Esc key is pressed
  304.             call rat.hide
  305.             cls
  306.             end
  307.         case chr$(0)+chr$(59)        ' If F1 key is pressed ( HELP )
  308.             call rat.hide
  309.             call SaveScreen
  310.             call Help
  311.             cls
  312.             call RestoreScreen
  313.             call rat.show
  314.             goto skip
  315.         case chr$(0)+chr$(72)        ' Alternate scroll down
  316.             gosub scroll.down
  317.             goto skip
  318.         case chr$(0)+chr$(80)        ' Alternate scroll up
  319.             gosub scroll.up
  320.             goto skip
  321.     end select
  322. goto skip
  323. '*****************************************************************************
  324.  
  325. sub MainScreen
  326. cls
  327. color 15,1,1
  328.  
  329. print "┌─────┬─────┬─────┬─────┬────────────────────────────────────────────────┬─┬─┬─┐";
  330. print "│ Row │     │ Col │     │   SCREEN BUILDER                               │L│M│R│";
  331. print "└─────┴─────┴─────┴─────┴────────────────────────────────────────────────┴─┴─┴─┘";
  332. locate 17,1
  333. color 0,7
  334. print "┌────────────────────────────────────────────────────┬─────────────────────────┐";
  335. print "│ ┌  ┬  ┐   ╒  ╤  ╕   ╓  ╥  ╖     ╔  ╦  ╗    ░  ▒  ▓ │ Save  Load  View  Clear │";
  336. print "│                                                    ├─────────────────────────┤";
  337. print "│ ├  ┼  ┤ │ ╞  ╪  ╡   ╟  ╫  ╢  ║  ╠  ╬  ╣    █  ▄  ▌ │ Written by:             │";
  338. print "│         │                    ║                     │ John T. Watts           │";
  339. print "│ └  ┴  ┘   ╘  ╧  ╛   ╙  ╨  ╜     ╚  ╩  ╝    ▐  ▀  ■ │ 2027 Saturn Dr.         │";
  340. print "│   ───       ═══       TEXT        ═══              │ Bastrop, La. 71220      │";
  341. print "└────────────────────────────────────────────────────┴─────────────────────────┘";
  342. end sub
  343.  
  344. 'rat.init(mouse%,button%)
  345.  
  346. 'rat.show
  347.  
  348. 'rat.hide
  349.  
  350. 'rat.pos.but(but.status%,row%,col%)
  351.  
  352. 'rat.move(row%,col%)
  353.  
  354. 'rat.move(row%,col%)
  355.  
  356. 'rat.min.max.horz(min%,max%)
  357.  
  358. 'rat.min.max.vert(min%,max%)
  359.  
  360.  
  361.  
  362. sub rat.init(mouse%,button%)
  363.     reg 1,&h3533                    ' Make DOS call to see if mouse driver
  364.     call interrupt &h21                ' is installed
  365.  
  366.     if reg(9) and reg(2) then        ' YES
  367.         mouse% = -1
  368.     else                            ' NO
  369.         mouse% = 0
  370.         exit sub
  371.     end if
  372.  
  373.     reg 1,0                        ' From now on you can talk to the mouse
  374.     call interrupt &h33                ' by loading reg 1 (REG AX) with the
  375.     mouse% = reg(1)                ' mouse function and making a call to
  376.     button% = reg(2)                ' the mouse driver (interrupt &h33).
  377. end sub                            ' Function 0 initilizes and returns
  378.                                 ' the number of buttons on the mouse.
  379.  
  380. sub rat.show                            ' Function 1 unhides the cursor
  381.     reg 1,1
  382.     call interrupt &H33
  383. end sub
  384.  
  385. sub rat.hide                        ' Function 2 hides the cursor
  386.     reg 1,2
  387.     call interrupt &h33
  388. end sub
  389.  
  390. sub rat.pos.but(but.status%,row%,col%)    ' Function 3 tells you if a button
  391.     reg 1,3                        ' is down and where the cursor is
  392.     call interrupt &h33
  393.     but.status% = reg(2)
  394.     col% = reg(3)
  395.     row% = reg(4)
  396. end sub
  397.  
  398. sub rat.move(row%,col%)                ' Function 4 will relocate the cursor
  399.     reg 1,4
  400.     reg 3,col%
  401.     reg 4,row%
  402.     call interrupt &h33
  403. end sub
  404.  
  405. sub rat.min.max.horz(hmin%,hmax%)        ' Function 7 sets horizonal boundries.
  406.     reg 1,7                        ' The cursor will be restricted to
  407.     reg 3,hmin%                    ' the boundries set here. RIGHT/LEFT
  408.     reg 4,hmax%
  409.     call interrupt &h33
  410. end sub
  411.  
  412. sub rat.min.max.vert(vmin%,vmax%)        ' Function 8 sets vertical boundries.
  413.     reg 1,8                        ' Same as above except UP/DOWN
  414.     reg 3,vmin%
  415.     reg 4,vmax%
  416.     call interrupt &h33
  417. end sub
  418.  
  419. '───────────────────────────────────────────────────────────────────────────┐
  420. ' The following routine allows you to scroll the screen up and down.         │
  421. ' This is another example of the power of PowerBasic.  To easily make Dos   │
  422. ' calls gives the PowerBasic programer easy access to all DOS functions.     │
  423. '───────────────────────────────────────────────────────────────────────────┘
  424.  
  425.  
  426. 'L%  = Number of lines to scroll ( usually set to one )
  427. 'TR% = Top row of scrolling area
  428. 'LC% = Left column of scrolling area
  429. 'BR% = Bottom row of scrolling area
  430. 'RC% = Right column of scrolling area
  431. 'A%  = Attribute of characters on blank line
  432. 'UP% = -1 if you want to scroll up    0 to scroll down
  433.  
  434. SUB SCROLL (L%,TR%,LC%,BR%,RC%,A%,UP%)
  435. LOCAL UD%
  436.     %AX = 1
  437.     %BX = 2
  438.     %CX = 3
  439.     %DX = 4
  440.     %H  = 256
  441.  
  442.     IF UP% THEN UD% = 6 : ELSE UD% = 7
  443.  
  444.     REG %AX, L% + %H * UD%
  445.     REG %BX, A% * %H
  446.     REG %CX, (LC%-1) + %H * (TR%-1)
  447.     REG %DX, (RC%-1) + %H * (BR%-1)
  448.  
  449.     CALL INTERRUPT &H10
  450.  
  451.     IF UD% = 6 THEN LOCATE BR%,LC% : ELSE LOCATE TR%,LC%
  452.  
  453. END SUB
  454.  
  455. function fVideoMode%
  456.     reg 1,&h0f00
  457.     call interrupt &h10
  458.     fVideoMode% = reg(1) and &b0000000011111111
  459. end function
  460.  
  461. '───────────────────────────────────────────────────────────────────────────┐
  462. ' The following two subs save and restore the screen.  In CGA/EGA/VGA we     │
  463. ' could just change pages, but HERC boards have only one page in test mode. │
  464. ' Study these routines to see the power of PowerBasic 2.x.                 │
  465. '───────────────────────────────────────────────────────────────────────────┘
  466.  
  467. sub SaveScreen
  468.     shared videobufferabs&,screenbufferabs&
  469.     def seg = 0
  470.     poke$ screenbufferabs&, peek$(videobufferabs&,4000)
  471.     def seg
  472. end sub
  473.  
  474. sub RestoreScreen
  475.     shared videobufferabs&,screenbufferabs&
  476.     def seg = 0
  477.     poke$ videobufferabs&, peek$(screenbufferabs&,4000)
  478.     def seg
  479. end sub
  480.  
  481. ' The following sub displays help
  482.  
  483. sub Help
  484.     locate 3,1
  485.     Print "┌────────────────────────────────────────────────────────────────┐"
  486.     print "│                             HELP                               │"
  487.     print "│                                                                │"
  488.     print "│ Left Button   - Select and place    Right Button - Scroll up   │"
  489.     print "│ Middle Button - Scroll down(if you haven't up graded from the  │"
  490.     print "│ Micro Soft two button mouse all is not lost, you can use the   │"
  491.     print "│ up and down arrow keys.)                                       │"
  492.     print "│ Button combinations are possible- Place character and scroll   │"
  493.     print "│                                   at the same time-Left & Right│"
  494.     print "│ F1 - gives you this page                                       │"
  495.     print "│ Esc - to exit                                                  │"
  496.     print "│                                                                │"
  497.     print "│ To type text- place cursor on the word TEXT & press left button│"
  498.     print "│               then position cursor where you want the text to  │"
  499.     print "│               be and start typing.                             │"
  500.     print "│                    PRESS ANY KEY TO CONTINUE                   │"
  501.     print "└────────────────────────────────────────────────────────────────┘"
  502.     while not instat:wend
  503.     junk$ = inkey$
  504. end sub