'note from Mallard (mallard@qbasic.com): I added a delay. delay = 1000 'Hardware Warning: This programme was tested on an I586/100. It may perform 'poorly on lower-rated machines. Try compilation if all else fails. ' ************************************* ' * Drago the Graphical Hunter * ' * April, 1997 * ' * FoulDragon@aol.com * ' *members.aol.com/fouldragon/home.htm* ' ************************************* ' Press Shift/F5 to begin; Escape ends. 'The plot: There is none. Drago likes the mouse pointer, the brightly 'coloured circle. He chases it, and if he catches it, he turns its colour 'and goes to 'sleep.' Press the mouse button to change the circle's colour. 'My motivation: I wanted a mouse 'toy' like Windows users can enjoy, but I 'wanted something less tame than the bunnies and dogs offered. Also, I have 'no Windows development tools. After searching the shareware archives of 'this world for a good RPG, I noticed how stereotypically the dragon characters 'were portrayed. Not being able to write a whole game, I settled for this to 'try and make a better image for fire-breathing reptiles everywhere. Use, 'share and enjoy, but think twice before your electronic alter-ego lifts their 'broadsword! 'Programmer's Note: The graphics aren't too good, and the speed is slow, but 'at least the code is hard to modify! :{> '****************************************************************************** 'Proudly incorporating routines from: ' ******************************************** ' * QMouse.BAS * ' * Mouse Routine for MS-QBasic/IBM-QBasic * ' * 1 9 9 5 * ' ******************************************** ' Robert Wolf TV & Radio Service '********************************* INI ************************************* DEFINT A-Z DECLARE SUB mouse (cx, dx, bx) DECLARE SUB mousepointer (SW) DIM SHARED A(9) 'Set up array for code DEF SEG = VARSEG(A(0)) 'Get array segment (nnnn: ) ' (two 8 bit) FOR i = 0 TO 17 'length of DATA to READ r 'read POKE VARPTR(A(0)) + i, r 'into array/2 (nnnn:iiii) (one 8 bit) NEXT i 'until 17 '**************************** Machine Code ********************************* DATA &HB8,&H00,&H00 : ' mov AX,[n] [Swap code-(L),(H)] in AX DATA &H55 : ' push BP Save BP DATA &H8B,&HEC : ' mov BP,SP Get BP to c Seg DATA &HCD,&H33 : ' int 33 Interrupt 33 DATA &H92 : ' xchg AX,[reg] [Swap code-reg] in AX DATA &H8B,&H5E,&H06 : ' mov BX,[BP+6] Point to (variable) DATA &H89,&H07 : ' mov [BX],AX Put AX in (variable) DATA &H5D : ' pop BP Restore BP DATA &HCA,&H02,&H00 : ' ret 2 Far return sva = 20 del = 2 SCREEN 12 mousepointer 0: mousepointer 3: x = 160: y = 100: sd = 1: dsd = 15 WHILE INKEY$ <> CHR$(27) COLOR 0: PSET (x, y) CIRCLE (mx, my), 2, 0: CALL mouse(my, mx, mz): CIRCLE (mx, my), 2, sd: COLOR 15: IF mz THEN sd = (sd + 1) MOD 15 + 1 60 IF SQR((my - y) ^ 2 + (mx - x) ^ 2) > 25 THEN y = y + 1 * SGN(my - y) x = x + 1 * SGN(mx - x) dx = 1: ELSE dx = 11: dsd = sd: 'sleeping END IF COLOR dsd: PSET (x, y) IF dx = 1 THEN GOSUB 100 ', 200, 300, 400, 500 IF dx = 11 THEN LINE (x - 30, y - 30)-(x + 30, y + 30), 0, BF: PSET (x, y), dsd: DRAW "TA" + STR$(offset) + "u9e1h1g1f1d18g6e6f6h6d15u15u9e8d8u8g8h8d8u8f8" WEND: END 100 LINE (x - 30, y - 30)-(x + 30, y + 30), 0, BF PSET (x, y), dsd IF ABS(mx - x) <> 0 THEN IF SGN(my - y) = 1 THEN offset = 180: TAG = 1 ELSE offset = 0: TAG = 0 ELSE offset = 180 * TAG END IF IF ABS(mx - x) <> 0 AND offset = 0 THEN offset = offset - 90 * SGN(mx - x) ELSE offset = offset + 90 * SGN(mx - x) IF ABS(mx - x) <> 0 AND ABS(my - y) <> 0 THEN offset = offset + (((TAG = 1) * 45) + ((TAG = 0) * -45)) * SGN(mx - x) offset = offset MOD 360 DRAW "TA" + STR$(offset) + "u9e1h1g1f1d18g6e6f6h6ta" + STR$(offset + sva - 20) + "d15u15ta" + STR$(offset) + "u9" FOR ssi = 1 TO 5 XX = 45 + offset DRAW "ta" + STR$((XX) MOD 360) + "U8" DRAW "TA" + STR$((XX - ssi * sva) MOD 360) DRAW "d8;u8" PSET (x, y), dsd NEXT DRAW "TA" + STR$((offset + 315) MOD 360) + "U8" XX = 315 + offset FOR ssi = 1 TO 5 DRAW "TA" + STR$((XX + ssi * sva) MOD 360) DRAW "d8;u8" NEXT 102 IF sva > 40 THEN del = -2 101 IF sva < 5 THEN del = 2 sva = sva + del FOR k = 1 TO delay: NEXT RETURN '***************************************************************************** REM ark: The subroutine @ 100 is where the sorcery happens. Just take that REM routine as is, and feed it a mouse X and Y (mx,my) and the dragon's X,Y REM (x,y) Del is the speed of the wings flapping, and will have to be changed REM in 101 and 102 as well, while SVA is a measure of how far the wings are REM spread. The test at line 60 is saying [if you haven't taken Geometry yet] REM 'if the mouse is within 25 pixels, go to sleep, else move in the direction REM that will get us closer' If DX=11 then it sleeps, and if 1 it moves. REM This works in all graphics modes save 0,1,2,11,10 and possibly the non-IBM REM modes [3/4- I can't test them.] Please don't complain about my coding- I REM learned to programme on an Apple IIe and 386SX/16, and I never learned REM 'structured' technique, or how to clean up messy code. SUB mouse (cx, dx, bx) POKE VARPTR(A(4)), &H92 'Swap code,Get CX setup CALL absolute(cx, VARPTR(A(0))) 'Run Code 'Adjust 25x80 POKE VARPTR(A(4)), &H91 'Swap code,Get DX setup CALL absolute(dx, VARPTR(A(0))) 'Run Code 'Adjust 25x80 POKE VARPTR(A(4)), &H93 'Swap code,Get BX setup CALL absolute(bx, VARPTR(A(0))) 'Run Code 'Note : 'Remove the /8 'for graphics modes. END SUB SUB mousepointer (SW) POKE VARPTR(A(0)) + 1, SW 'Swap code,Set AX = (SW) CALL absolute(c, VARPTR(A(0))) 'Run Code 'Note: 'SW = 0-reset 'SW = 1-on 'SW = 2-off 'SW = 3-coordinates END SUB