home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 2.ddi / MOUSGCRS.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  14.0 KB  |  460 lines
  1.   ' ************************************************
  2.   ' **  Name:          MOUSGCRS                   **
  3.   ' **  Type:          Program                    **
  4.   ' **  Module:        MOUSGCRS.BAS               **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   '
  8.   ' Program for the interactive design of graphics-
  9.   ' mode mouse cursor subroutines.
  10.   '
  11.   ' USAGE:          No command line parameters
  12.   ' REQUIREMENTS:   CGA
  13.   '                 MIXED.QLB/.LIB
  14.   '                 Mouse
  15.   ' .MAK FILE:      MOUSGCRS.BAS
  16.   '                 BITS.BAS
  17.   '                 MOUSSUBS.BAS
  18.   ' PARAMETERS:     (none)
  19.   ' VARIABLES:      curs$()       Array of binary cursor string data
  20.   '                 defaultMask$  Pattern mask for the default cursor
  21.   '                 xdef%         Default hot spot X value
  22.   '                 ydef%         Default hot spot Y value
  23.   '                 mask$         Pattern mask for a cursor
  24.   '                 xHot%         Hot spot X value
  25.   '                 yHot%         Hot spot Y value
  26.   '                 maskChr%      Index into the pattern mask
  27.   '                 maskPtr%      Index to the background or foreground mask
  28.   '                               pattern
  29.   '                 y%            Cursor bit pointer, vertical
  30.   '                 x%            Cursor bit pointer, horizontal
  31.   '                 xbox%         X location on screen for cursor bit box
  32.   '                 ybox%         Y location on screen for cursor bit box
  33.   '                 xh%           Screen X location for hot spot
  34.   '                 yh%           Screen Y location for hot spot
  35.   '                 click$        DRAW string for creating the click boxes
  36.   '                 quitFlag%     Indication that user wants to quit
  37.   '                 t$            Copy of TIME$
  38.   '                 toggle%       Once per second toggle for hot spot visibility
  39.   '                 pxl%          Pixel value at the hot spot
  40.   '                 leftButton%   Current state of the left mouse button
  41.   '                 rightButton%  Current state of the right mouse button
  42.   '                 resetBox%     Indicates cursor is in the "Try standard
  43.   '                               cursors" box
  44.   '                 tryBox%       Indicates cursor is in the "Try new cursor"
  45.   '                               box
  46.   '                 subBox%       Indicates cursor is in the "Create cursor
  47.   '                               subroutine" box
  48.   '                 quitBox%      Indicates cursor is in the "Quit" box
  49.   '                 xold%         X location of just-modified pixel box
  50.   '                 yold%         Y location of just-modified pixel box
  51.   '                 ix%           X bit pointer for pixel change
  52.   '                 iy%           Y bit pointer for pixel change
  53.   '                 q$            Double-quote character
  54.   
  55.   ' Define constants
  56.     CONST FALSE = 0
  57.     CONST TRUE = NOT FALSE
  58.   
  59.   ' Subprograms
  60.     DECLARE SUB Cursdflt (mask$, xHot%, yHot%)
  61.     DECLARE SUB Curschek (mask$, xHot%, yHot%)
  62.     DECLARE SUB Curshand (mask$, xHot%, yHot%)
  63.     DECLARE SUB Curshour (mask$, xHot%, yHot%)
  64.     DECLARE SUB Cursjet (mask$, xHot%, yHot%)
  65.     DECLARE SUB Cursleft (mask$, xHot%, yHot%)
  66.     DECLARE SUB Cursplus (mask$, xHot%, yHot%)
  67.     DECLARE SUB Cursup (mask$, xHot%, yHot%)
  68.     DECLARE SUB Cursx (mask$, xHot%, yHot%)
  69.     DECLARE SUB MouseShow ()
  70.     DECLARE SUB MouseNow (lbutton%, rbutton%, xMouse%, yMouse%)
  71.     DECLARE SUB MouseHide ()
  72.     DECLARE SUB MouseMaskTranslate (mask$, xHot%, yHot%, cursor$)
  73.     DECLARE SUB MouseSetGcursor (cursor$)
  74.   
  75.   ' Arrays
  76.     DIM curs$(0 TO 8)
  77.   
  78.   ' Initialization
  79.     SCREEN 2
  80.     CLS
  81.   
  82.   ' Create set of cursors
  83.     Cursdflt defaultMask$, xdef%, ydef%
  84.     MouseMaskTranslate defaultMask$, xdef%, ydef%, curs$(0)
  85.   
  86.     Curschek mask$, xHot%, yHot%
  87.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(1)
  88.   
  89.     Curshand mask$, xHot%, yHot%
  90.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(2)
  91.   
  92.     Curshour mask$, xHot%, yHot%
  93.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(3)
  94.   
  95.     Cursjet mask$, xHot%, yHot%
  96.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(4)
  97.   
  98.     Cursleft mask$, xHot%, yHot%
  99.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(5)
  100.   
  101.     Cursplus mask$, xHot%, yHot%
  102.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(6)
  103.   
  104.     Cursup mask$, xHot%, yHot%
  105.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(7)
  106.   
  107.     Cursx mask$, xHot%, yHot%
  108.     MouseMaskTranslate mask$, xHot%, yHot%, curs$(8)
  109.   
  110.   ' Set the default cursor
  111.     MouseSetGcursor curs$(0)
  112.   
  113.   ' Make the default cursor the starting point for editing
  114.     mask$ = defaultMask$
  115.     xHot% = xdef%
  116.     yHot% = ydef%
  117.   
  118.   ' Place titles above pixel boxes
  119.     LOCATE 2, 22, 0
  120.     PRINT "Screen mask";
  121.     LOCATE 2, 50, 0
  122.     PRINT "Cursor mask";
  123.   
  124.   ' Outline the pixel boxes, filling the "ones" using the Mask$
  125.     maskChr% = 0
  126.     FOR maskPtr% = 0 TO 1
  127.         FOR y% = 1 TO 16
  128.             FOR x% = 1 TO 16
  129.                 xbox% = x% * 12 + maskPtr% * 222 + 107
  130.                 ybox% = y% * 9 + 10
  131.                 maskChr% = maskChr% + 1
  132.                 LINE (xbox%, ybox%)-(xbox% + 12, ybox% + 9), 1, B
  133.                 IF MID$(mask$, maskChr%, 1) = "1" THEN
  134.                     LINE (xbox% + 3, ybox% + 2)-(xbox% + 9, ybox% + 7), 1, BF
  135.                 END IF
  136.                 IF maskPtr% = 0 THEN
  137.                     IF x% = xHot% + 1 AND y% = yHot% + 1 THEN
  138.                         xh% = xbox%
  139.                         yh% = ybox%
  140.                     END IF
  141.                 END IF
  142.             NEXT x%
  143.         NEXT y%
  144.     NEXT maskPtr%
  145.   
  146.   ' Instruction text at bottom of display
  147.     LOCATE 23, 1
  148.     PRINT TAB(16); "Left button       Right button         Both buttons"
  149.     PRINT TAB(16); "to set pixel      to clear pixel       for hot spot";
  150.   
  151.   ' Print menu items
  152.     LOCATE 3, 2, 0
  153.     PRINT "Try";
  154.     LOCATE 4, 2, 0
  155.     PRINT "standard";
  156.     LOCATE 5, 2, 0
  157.     PRINT "cursors";
  158.     LOCATE 9, 2, 0
  159.     PRINT "Try new";
  160.     LOCATE 10, 2, 0
  161.     PRINT "cursor";
  162.     LOCATE 14, 2, 0
  163.     PRINT "Create"
  164.     LOCATE 15, 2, 0
  165.     PRINT "cursor";
  166.     LOCATE 16, 2, 0
  167.     PRINT "subroutine";
  168.     LOCATE 16, 74, 0
  169.     PRINT "Quit";
  170.   
  171.   ' Make click box draw string
  172.     click$ = "R20D10L20U10BF5BR1F3E6"
  173.   
  174.   ' Draw the click boxes
  175.     DRAW "BM20,45" + click$
  176.     DRAW "BM20,85" + click$
  177.     DRAW "BM20,132" + click$
  178.     DRAW "BM592,132" + click$
  179.   
  180.   ' Make a white cursor testing area
  181.     LOCATE 5, 71
  182.     PRINT "Cursor";
  183.     LOCATE 6, 71
  184.     PRINT "viewing";
  185.     LOCATE 7, 71
  186.     PRINT "area";
  187.     LINE (560, 60)-(610, 100), 1, BF
  188.   
  189.   ' Turn on the mouse
  190.     MouseShow
  191.   
  192.   ' Main processing loop control
  193.     DO
  194.         GOSUB MainLoop
  195.     LOOP UNTIL quitFlag%
  196.   
  197.   ' Exit the loop and end program because Quitflag% has been set
  198.     CLS
  199.     SYSTEM
  200.   
  201.   
  202.   ' Main processing loop
  203. MainLoop:
  204.   
  205.   ' Toggle the hot spot once per second
  206.     IF t$ <> TIME$ THEN
  207.         t$ = TIME$
  208.         IF toggle% = 1 THEN
  209.             toggle% = 0
  210.         ELSE
  211.             toggle% = 1
  212.         END IF
  213.         pxl% = POINT(xh% + 3, yh% + 2) XOR toggle%
  214.         LINE (xh% + 5, yh% + 3)-(xh% + 7, yh% + 6), pxl%, BF
  215.         pxl% = POINT(xh% + 3 + 222, yh% + 2) XOR toggle%
  216.         LINE (xh% + 5 + 222, yh% + 3)-(xh% + 7 + 222, yh% + 6), pxl%, BF
  217.     END IF
  218.   
  219.   ' What is the mouse location and button state right now?
  220.     MouseNow leftButton%, rightButton%, x%, y%
  221.   
  222.   ' Are both buttons being pressed right now?
  223.     IF leftButton% AND rightButton% THEN
  224.         GOSUB WhichBox
  225.         IF xbox% THEN
  226.             GOSUB SetHotSpot
  227.         END IF
  228.     END IF
  229.   
  230.   ' Are we traversing the "Try standard cursors" click box?
  231.     IF x% > 20 AND x% < 40 AND y% > 45 AND y% < 55 THEN
  232.         IF resetBox% = 0 THEN
  233.             MouseHide
  234.             resetBox% = 1
  235.             LINE (17, 43)-(43, 57), 1, B
  236.             MouseShow
  237.         END IF
  238.     ELSE
  239.         IF resetBox% = 1 THEN
  240.             MouseHide
  241.             resetBox% = 0
  242.             LINE (17, 43)-(43, 57), 0, B
  243.             MouseShow
  244.         END IF
  245.     END IF
  246.   
  247.   ' Are we traversing the "Try new cursor" click box?
  248.     IF x% > 20 AND x% < 40 AND y% > 85 AND y% < 95 THEN
  249.         IF tryBox% = 0 THEN
  250.             MouseHide
  251.             tryBox% = 1
  252.             LINE (17, 83)-(43, 97), 1, B
  253.             MouseShow
  254.         END IF
  255.     ELSE
  256.         IF tryBox% = 1 THEN
  257.             MouseHide
  258.             tryBox% = 0
  259.             LINE (17, 83)-(43, 97), 0, B
  260.             MouseShow
  261.         END IF
  262.     END IF
  263.   
  264.   ' Are we traversing the "Create cursor subroutine" click box?
  265.     IF x% > 20 AND x% < 40 AND y% > 132 AND y% < 142 THEN
  266.         IF subBox% = 0 THEN
  267.             MouseHide
  268.             subBox% = 1
  269.             LINE (17, 130)-(43, 144), 1, B
  270.             MouseShow
  271.         END IF
  272.     ELSE
  273.         IF subBox% = 1 THEN
  274.             MouseHide
  275.             subBox% = 0
  276.             LINE (17, 130)-(43, 144), 0, B
  277.             MouseShow
  278.         END IF
  279.     END IF
  280.   
  281.   ' Are we traversing the "Quit" click box?
  282.     IF x% > 592 AND x% < 612 AND y% > 132 AND y% < 142 THEN
  283.         IF quitBox% = 0 THEN
  284.             MouseHide
  285.             quitBox% = 1
  286.             LINE (589, 130)-(615, 144), 1, B
  287.             MouseShow
  288.         END IF
  289.     ELSE
  290.         IF quitBox% = 1 THEN
  291.             MouseHide
  292.             quitBox% = 0
  293.             LINE (589, 130)-(615, 144), 0, B
  294.             MouseShow
  295.         END IF
  296.     END IF
  297.   
  298.   ' If just one button or the other is pressed, then check further
  299.     IF leftButton% XOR rightButton% THEN
  300.         GOSUB ButtonWasPressed
  301.     ELSE
  302.         xold% = 0
  303.         yold% = 0
  304.     END IF
  305.   
  306.   ' End of main loop
  307.     RETURN
  308.   
  309.   
  310.   ' Is the mouse currently pointing at a pixel box?
  311. WhichBox:
  312.     IF x% > 320 THEN
  313.         maskPtr% = 1
  314.         x% = x% - 222
  315.     ELSE
  316.         maskPtr% = 0
  317.     END IF
  318.     ix% = (x% - 107) \ 12
  319.     iy% = (y% - 10) \ 9
  320.     xbox% = 0
  321.     ybox% = 0
  322.     IF ix% >= 1 AND ix% <= 16 THEN
  323.         IF iy% >= 1 AND iy% <= 16 THEN
  324.             xbox% = ix% * 12 + maskPtr% * 222 + 107
  325.             ybox% = iy% * 9 + 10
  326.         END IF
  327.     END IF
  328.     RETURN
  329.   
  330.   
  331.   ' Move the hot spot to the current pixel box
  332. SetHotSpot:
  333.     IF (xbox% <> xh% AND xbox% - 222 <> xh%) OR ybox% <> yh% THEN
  334.         MouseHide
  335.         pxl% = POINT(xh% + 3, yh% + 2)
  336.         LINE (xh% + 5, yh% + 3)-(xh% + 7, yh% + 6), pxl%, BF
  337.         pxl% = POINT(xh% + 3 + 222, yh% + 2)
  338.         LINE (xh% + 5 + 222, yh% + 3)-(xh% + 7 + 222, yh% + 6), pxl%, BF
  339.         MouseShow
  340.         IF xbox% > 320 THEN
  341.             xh% = xbox% - 222
  342.         ELSE
  343.             xh% = xbox%
  344.         END IF
  345.         yh% = ybox%
  346.     END IF
  347.     RETURN
  348.   
  349.   
  350.   ' Process the button press depending on mouse location
  351. ButtonWasPressed:
  352.     IF quitBox% THEN
  353.         GOSUB DoQuitBox
  354.     ELSEIF resetBox% THEN
  355.         GOSUB DoResetCursor
  356.     ELSEIF tryBox% THEN
  357.         GOSUB DoSetNewCursor
  358.     ELSEIF subBox% THEN
  359.         GOSUB DoSetNewCursor
  360.         GOSUB DoCreateSub
  361.     ELSE
  362.         GOSUB DoPixelControl
  363.     END IF
  364.     RETURN
  365.   
  366.   
  367.   ' Button was pressed while mouse was in the "Quit" box
  368. DoQuitBox:
  369.     MouseHide
  370.     quitFlag% = TRUE
  371.     RETURN
  372.   
  373.   
  374.   ' Button was pressed while mouse was in the "Try new cursor" box
  375. DoSetNewCursor:
  376.     MouseHide
  377.     maskChr% = 0
  378.     FOR maskPtr% = 0 TO 1
  379.         FOR y% = 1 TO 16
  380.             FOR x% = 1 TO 16
  381.                 xbox% = x% * 12 + maskPtr% * 222 + 107
  382.                 ybox% = y% * 9 + 10
  383.                 maskChr% = maskChr% + 1
  384.                 IF POINT(xbox% + 3, ybox% + 2) THEN
  385.                     MID$(mask$, maskChr%, 1) = "1"
  386.                 ELSE
  387.                     MID$(mask$, maskChr%, 1) = "0"
  388.                 END IF
  389.                 IF xbox% = xh% AND ybox% = yh% THEN
  390.                     xHot% = x% - 1
  391.                     yHot% = y% - 1
  392.                 END IF
  393.             NEXT x%
  394.         NEXT y%
  395.     NEXT maskPtr%
  396.     MouseMaskTranslate mask$, xHot%, yHot%, cursor$
  397.     MouseSetGcursor cursor$
  398.     MouseShow
  399.     RETURN
  400.   
  401.   ' Button was pressed while mouse was in the "Try standard cursors" box
  402. DoResetCursor:
  403.     MouseHide
  404.     cursorIndex% = (cursorIndex% + 1) MOD 9
  405.     MouseSetGcursor curs$(cursorIndex%)
  406.     MouseShow
  407.     DO
  408.         MouseNow leftButton%, rightButton%, xMouse%, yMouse%
  409.     LOOP UNTIL leftButton% = 0 AND rightButton% = 0
  410.     RETURN
  411.   
  412.   ' Button was pressed while mouse was in the "Create cursor subroutine" box
  413. DoCreateSub:
  414.     q$ = CHR$(34)
  415.     OPEN "GCURSOR.BAS" FOR OUTPUT AS #1
  416.     PRINT #1, "   ' ************************************************"
  417.     PRINT #1, "   ' **  Name:          Gcursor                    **"
  418.     PRINT #1, "   ' **  Type:          Subprogram                 **"
  419.     PRINT #1, "   ' **  Module:        GCURSOR.BAS                **"
  420.     PRINT #1, "   ' **  Language:      Microsoft QuickBASIC 4.00  **"
  421.     PRINT #1, "   ' ************************************************"
  422.     PRINT #1, "   '"
  423.     PRINT #1, "   SUB Gcursor (mask$, xHot%, yHot%) STATIC"
  424.     PRINT #1, ""
  425.     PRINT #1, "       mask$ = "; q$; q$
  426.     FOR i% = 0 TO 31
  427.         PRINT #1, "       mask$ = mask$ + ";
  428.         PRINT #1, q$; MID$(mask$, 16 * i% + 1, 16); q$
  429.         IF i% = 15 THEN
  430.             PRINT #1, ""
  431.         END IF
  432.     NEXT i%
  433.     PRINT #1, ""
  434.     PRINT #1, "       xHot% ="; STR$(xHot%)
  435.     PRINT #1, "       yHot% ="; STR$(yHot%)
  436.     PRINT #1, ""
  437.     PRINT #1, "   END SUB"
  438.     RETURN
  439.   
  440.   
  441.   ' Set or clear pixel box if mouse is on one
  442. DoPixelControl:
  443.     GOSUB WhichBox
  444.     IF xbox% THEN
  445.         IF xold% <> xbox% OR yold% <> ybox% THEN
  446.             xold% = xbox%
  447.             yold% = ybox%
  448.             MouseHide
  449.             IF leftButton% THEN
  450.                 LINE (xbox% + 3, ybox% + 2)-(xbox% + 9, ybox% + 7), 1, BF
  451.             ELSE
  452.                 LINE (xbox% + 3, ybox% + 2)-(xbox% + 9, ybox% + 7), 0, BF
  453.             END IF
  454.             MouseShow
  455.         END IF
  456.     END IF
  457.     RETURN
  458.   
  459.  
  460.