modules/qbExt/mousedrv.bas

   1 ' Mouse demo\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2004.01\r
   4 ' Homepage: http://svjatoslav.eu\r
   5  \r
   6 DECLARE SUB mousedemo ()\r
   7 DECLARE SUB putword (addr!, dat!)\r
   8 DECLARE FUNCTION getword! (addr!)\r
   9 DECLARE FUNCTION getbyte! (addr!)\r
  10 DECLARE SUB start ()\r
  11 \r
  12 DIM SHARED extSEG, extADDR\r
  13 \r
  14 start\r
  15 \r
  16 \r
  17 mousedemo\r
  18 \r
  19 FUNCTION getbyte (addr)\r
  20 getbyte = PEEK(extADDR + addr)\r
  21 END FUNCTION\r
  22 \r
  23 FUNCTION getword (addr)\r
  24 a = PEEK(extADDR + addr)\r
  25 b = PEEK(extADDR + addr + 1)\r
  26 \r
  27 \r
  28 c$ = HEX$(a)\r
  29 IF LEN(c$) = 1 THEN c$ = "0" + c$\r
  30 IF LEN(c$) = 0 THEN c$ = "00"\r
  31 \r
  32 \r
  33 c = VAL("&H" + HEX$(b) + c$)\r
  34 \r
  35 getword = c\r
  36 END FUNCTION\r
  37 \r
  38 SUB mousedemo\r
  39 \r
  40 \r
  41 \r
  42 cx = 150\r
  43 cy = 100\r
  44 maxmove = 50\r
  45 1\r
  46 frm = frm + 1\r
  47 \r
  48 \r
  49 LOCATE 1, 1\r
  50 PRINT cx, cy\r
  51 PRINT frm\r
  52 \r
  53 CIRCLE (cx, cy), 10, 0\r
  54 xp = getword(2)\r
  55 putword 2, 0\r
  56 yp = getword(4)\r
  57 putword 4, 0\r
  58 \r
  59 butt = getword(6)\r
  60 putword 6, 0\r
  61 \r
  62 IF butt <> 0 THEN\r
  63 LOCATE 5\r
  64 PRINT butt\r
  65 END IF\r
  66 \r
  67 IF xp < -maxmove THEN xp = -maxmove\r
  68 IF xp > maxmove THEN xp = maxmove\r
  69 cx = cx + xp\r
  70 \r
  71 IF yp < -maxmove THEN yp = -maxmove\r
  72 IF yp > maxmove THEN yp = maxmove\r
  73 cy = cy + yp\r
  74 \r
  75 \r
  76 CIRCLE (cx, cy), 10, 10\r
  77 \r
  78 \r
  79 \r
  80 SOUND 0, .05\r
  81 GOTO 1\r
  82 \r
  83 \r
  84 END SUB\r
  85 \r
  86 SUB putword (addr, dat)\r
  87 \r
  88 b$ = HEX$(dat)\r
  89 \r
  90 2\r
  91 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
  92 \r
  93 n1 = VAL("&H" + LEFT$(b$, 2))\r
  94 n2 = VAL("&H" + RIGHT$(b$, 2))\r
  95 \r
  96 \r
  97 POKE (extADDR + addr), n2\r
  98 POKE (extADDR + addr + 1), n1\r
  99 \r
 100 END SUB\r
 101 \r
 102 SUB start\r
 103 SCREEN 13\r
 104 \r
 105 DEF SEG = 0     ' read first from interrupt table\r
 106 \r
 107 extSEG = PEEK(&H79 * 4 + 3) * 256\r
 108 extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
 109 \r
 110 PRINT "Segment is: " + HEX$(extSEG)\r
 111 \r
 112 extADDR = PEEK(&H79 * 4 + 1) * 256\r
 113 extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
 114 \r
 115 PRINT "relative address is:"; extADDR\r
 116 \r
 117 DEF SEG = extSEG\r
 118 \r
 119 IF getword(0) <> 1983 THEN\r
 120   PRINT "FATAL ERROR:  you must load"\r
 121   PRINT "QBasic extension TSR first!"\r
 122   SYSTEM\r
 123 END IF\r
 124 \r
 125 END SUB\r
 126 \r