'********************************PIANO2.BAS******************************** 'A mousable program that was written for GWBASIC.EXE. I can't make it work 'in that variety as it turns on my printer and prints rather than activating 'the mouse. BUT it does work in QuickBASIC 4.5 with a little tweaking. ' 'All line numbers have been removed except those acting as LABELS ' 'The key SUB is: MouseFunction(m1%,m2%,m3%,m4%) described (sort of) in my 'file set 2PAWS.EXE. '1/3/93 ' 'John De Palma on CompuServe 76076,571 ' DEFINT A-Z CONST False = 0 CONST True = NOT False 'interrupt call for both INTERRUPT and INTERRUPTX TYPE RegType ax AS INTEGER bx AS INTEGER cx AS INTEGER dx AS INTEGER bp AS INTEGER si AS INTEGER di AS INTEGER flags AS INTEGER ds AS INTEGER es AS INTEGER END TYPE 'Routine name describes purpose and function DECLARE SUB MouseFunction (M1%, M2%, M3%, M4%) DECLARE SUB Pause (Seconds!) DECLARE SUB LocateIt (Row%, text$) DEF FnCenter (text$) = 21 - (LEN(text$) \ 2) ' ' THE VIRTUAL PIANO ' ' COPYRIGHT (C) 1983 BY MICROSOFT CORPORATION ' WRITTEN BY CHRIS PETERS ' '----------------------------------------------- ' ' I N I T I A L I Z E ' DEFINT A-Z DIM CURSOR(15, 1), FREQ(27, 2), MICROSOFT(839) KEY OFF 'JRD NOTE: next line was changed to make it work PLAY "p32" SCREEN 1 COLOR 1, 1 CLS 'JRD NOTE: 'next line was added to give this programmer the credit due him. text$ = "Programmed By: Chris Peters - 1983" CALL LocateIt(11, text$) text$ = "Edited: - John De Palma - 1994" CALL LocateIt(15, text$) CALL Pause(1.5) PLAY "p32" ' ' Read in the flat, normal, and sharp note frequencies ' FOR J = 0 TO 2 FOR I = 0 TO 6 READ K FREQ(I, J) = K: FREQ(I + 7, J) = K * 2: FREQ(I + 14, J) = K * 4: FREQ(I + 21, J) = K * 8 NEXT NEXT ' ' Determine mouse driver location; if not found, quit ' DEF SEG = 0 'JRD NOTE: get overflow error unless numbers are SINGLE 'can't use LONG in GWBASIC.EXE 'The variable "Mul" is the one that causes the problem, try 'running this program by using the number "256" in its place. 'Heh...heh....heh.... DIM MSEG AS SINGLE DIM Mouse AS SINGLE DIM Mul AS SINGLE Mul = 256 MSEG = Mul * PEEK(51 * 4 + 3) + PEEK(51 * 4 + 2)' Get mouse segment Mouse = Mul * PEEK(51 * 4 + 1) + PEEK(51 * 4)' Get mouse offset IF MSEG OR (Mouse - 2) THEN 1370 1330 PRINT "Mouse driver not found" ' Not found, so print error PRINT PRINT "Press any key to return to system" 1360 I$ = INKEY$: IF I$ = "" THEN 1360 ELSE SYSTEM 1370 DEF SEG = MSEG: Mouse = Mouse + 2 ' Set mouse segment IF PEEK(Mouse - 2) = 207 THEN 1330 ' 207 is iret ' Mouse driver is there M1 = 0: CALL MouseFunction(M1, M2, M3, M4) ' Initialize the mouse IF M1 = 0 THEN PRINT "Mouse not found": END ' ' Set mouse sensitivity ' M1 = 15: M3 = 4: M4 = 8 CALL MouseFunction(M1, M2, M3, M4) ' ' Define the "logical and" cursor mask ' CURSOR(0, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(1, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(2, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(3, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(4, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(5, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(6, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(7, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(8, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(9, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(10, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(11, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(12, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(13, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(14, 0) = &HFFFF ' Binary 1111111111111111 CURSOR(15, 0) = &HFFFF ' Binary 1111111111111111 ' ' Define the "exclusive or" cursor mask ' CURSOR(0, 1) = &H300 ' Binary 0000001100000000 CURSOR(1, 1) = &H300 ' Binary 0000001100000000 CURSOR(2, 1) = &HFC0 ' Binary 0000111111000000 CURSOR(3, 1) = &HFC0 ' Binary 0000111111000000 CURSOR(4, 1) = &H3FF0 ' Binary 0011111111110000 CURSOR(5, 1) = &H3FF0 ' Binary 0011111111110000 CURSOR(6, 1) = &HFCFC ' Binary 1111110011111100 CURSOR(7, 1) = &HC00C ' Binary 1100000000001100 CURSOR(8, 1) = &H0 ' Binary 0000000000000000 CURSOR(9, 1) = &H0 ' Binary 0000000000000000 CURSOR(10, 1) = &H0 ' Binary 0000000000000000 CURSOR(11, 1) = &H0 ' Binary 0000000000000000 CURSOR(12, 1) = &H0 ' Binary 0000000000000000 CURSOR(13, 1) = &H0 ' Binary 0000000000000000 CURSOR(14, 1) = &H0 ' Binary 0000000000000000 CURSOR(15, 1) = &H0 ' Binary 0000000000000000 ' ' Set the mouse cursor shape ' M1 = 9: M2 = 6: M3 = 0 'Call MouseFunction(M1,M2,M3,CURSOR(0,0)) ' Mouse driver < 6.25 M4 = VARPTR(CURSOR(0, 0)): CALL MouseFunction(M1, M2, M3, M4)' Mouse driver 6.25+ ' ' Draw the MICROSOFT logo from precalculated data ' FOR I = 0 TO 779 READ MICROSOFT(I) NEXT PUT (62, 0), MICROSOFT, PSET ' ' Initialize keyboard size parameters ' YL = 60: WKL = 80: BKL = 45: KW = 15: WKN = 21 XL = 320 - KW * WKN: YH = YL + WKL: XH = 319: BKW2 = KW \ 3 QX = 272: QY = 176 ' ' Draw the white keys ' LINE (XL, YL)-(XH, YH), 3, BF FOR I = XL TO XH STEP KW LINE (I, YL)-(I, YH), 0 NEXT ' ' Draw the black keys ' C = 6 FOR X = XL TO XH STEP KW C = C + 1: IF C = 7 THEN C = 0 IF C = 0 OR C = 3 THEN 2150 LINE (X - BKW2, YL)-(X + BKW2, YL + BKL), 2, BF 2150 NEXT ' ' Draw the quit box ' LINE (QX, QY)-(319, 199), 3, B LOCATE 24, 36: PRINT "Quit"; ' 'JRD NOTE: added the next line of information text$ = "Low Octave - Click L Button over key" CALL LocateIt(20, text$) text$ = "High Octave - Click R Button over key" CALL LocateIt(22, text$) ' Set mouse cursor location, then turn on cursor ' 'JRD NOTE: I put the cursor over the keys so you could see it 'SCREEN 1 is supposed to be 320x200 (?) pixels and 40 col by 25 rows Row% = 10: Col% = 20 'about center Horizontal% = (Col% - 1) * 16 '0,0 is left upper corner Vertical% = (Row% - 1) * 8 'M1 = 4: M3 = 320: M4 = 160: 'this was original M1 = 4: M3 = Horizontal%: M4 = Vertical% CALL MouseFunction(M1, M2, M3, M4) 'show mouse cursor M1 = 1: CALL MouseFunction(M1, M2, M3, M4) 'STOP ' ' M A I N L O O P ' 2290 M1 = 3: CALL MouseFunction(M1, BT, MX, MY)' Get mouse location and button status IF (BT AND 2) THEN OTV = 7: GOTO 2340' If right button down, set high octave IF (BT AND 1) THEN OTV = 0: GOTO 2340' If left button down, set lower octave 2320 SOUND 442, 0 ' If both buttons up, turn off sound GOTO 2290 ' Keep looping... 2340 MX = MX \ 2 ' Correct for medium resolution screen IF MX <= XL OR MY < YL THEN 2320 ' If above keyboard, turn off sound IF MY <= YH THEN 2470 ' If on keyboard, play sound IF MY < QY OR MX < QX THEN 2320 ' If above quit box, turn off sound ' ' Button down inside the quit box ' M1 = 2: CALL MouseFunction(M1, M2, M3, M4)' Turn off mouse cursor CLS ' Clear screen END ' quit ' ' Button down over keyboard, determine which key ' 2470 WKY = (MX - XL) \ KW + OTV: R = 1 ' Get which white key cursor is over IF MY > YL + BKL THEN 2560 ' Is it lower than the black keys? MK = (MX - XL) MOD KW ' No, get which side of key IF MK <= BKW2 THEN R = 0: GOTO 2560' Is it the left black key? IF MK >= KW - BKW2 THEN R = 2 ' Is it the right black key? ' ' Play the note. For BASIC interpreter duration = 2 ' For BASIC compiler duration = 1 ' 2560 SOUND FREQ(WKY, R), 2 GOTO 2290 ' Continue looping ' ' Musical note frequencies ' DATA 131,139,156,175,185,208,233 DATA 131,147,165,175,196,220,247 DATA 139,156,165,185,208,233,247 ' ' Data to draw the MICROSOFT logo ' DATA 462,28,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 DATA 0,0,0,-193,240,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 DATA 0,0,0,0,0,768,-1,0,0,0,0,3840,-1,-16129,0,-253,0,0,-193,240 DATA 0,0,0,0,0,0,0,0,0,-193,0,16128,4095,252,16128,-1,240,-256,-769,0 DATA 0,0,0,0,-193,240,768,-1,255,768,-1,1023,-1,-1,240,0,0,0,-193,192 DATA -256,4095,252,-253,-1,255,-256,-1,240,-253,-1,-1,768,-1,255,16128,-1,-3841,768,-1 DATA 1023,-1,-1,240,0,0,0,-193,192,-256,4095,252,-193,-1,-3841,-256,-1,252,-1009,0 DATA -256,4032,-1,-16129,-253,-1,-1,768,-1,1023,-1,-1,240,0,0,0,-193,240,-253,4095 DATA 252,-3841,0,-961,-256,-1,255,0,0,0,3840,-1,-16129,-241,0,-253,960,-1,1023,-1 DATA -1,240,0,0,0,-193,240,-253,4095,1020,255,0,-253,-256,4032,-16129,-1,-1,-1,4092 DATA 4095,-16129,-4033,0,16128,1008,-1,1023,-1,-1,240,0,0,0,-193,252,-241,4095,1020,252 DATA 0,-256,-256,960,-15361,252,0,0,4095,1023,-16129,-16321,0,3840,1008,255,0,3840,252,0 DATA 0,0,0,-193,252,-241,4095,4092,240,0,16128,-64,192,-16129,0,0,0,3840,255,0 DATA 255,0,768,1020,255,0,3840,252,0,0,0,0,-193,255,-193,4095,4092,240,0,16128 DATA -64,192,-12289,-1,192,-241,-12289,-3841,0,255,0,768,1020,255,0,3840,252,0,0,0 DATA 0,-193,255,-193,4095,16380,192,0,3840,-16,960,-12289,240,0,0,-15553,-1,768,252,0 DATA 0,1023,255,0,3840,252,0,0,0,0,-193,-16129,-1,4095,16380,192,0,0,-256,4032 DATA -16129,0,0,0,768,-1,1008,252,0,0,1023,-1,255,3840,252,0,0,0,0,-3265 DATA -16129,-3073,4095,16380,192,0,0,-256,-1,4095,-1,0,-253,-16129,-1,1020,252,0,0,1023 DATA -1,255,3840,252,0,0,0,0,-3265,-3073,-3073,4095,16380,192,0,0,-256,-1,4095,240 DATA 0,0,-16321,-241,1023,252,0,0,1023,-1,255,3840,252,0,0,0,0,-4033,-3073,-15361 DATA 4095,16380,192,0,0,-256,-1,252,0,0,0,0,16128,-15361,252,0,0,1023,-1,255 DATA 3840,252,0,0,0,0,-4033,-1,-15361,4095,16380,192,0,0,-256,-1,4092,240,0,0 DATA -16321,768,-3073,252,0,0,1023,255,0,3840,252,0,0,0,0,-4033,-193,1023,4095,4092 DATA 240,0,0,-256,-64,4092,-1,192,-241,-16129,0,-3841,255,0,768,1020,255,0,3840,252 DATA 0,0,0,0,-4033,-193,1023,4095,4092,240,0,16128,-64,4032,255,0,0,0,16128,252 DATA -3841,255,0,768,1020,255,0,3840,252,0,0,0,0,-4033,-241,1020,4095,1020,252,0 DATA -256,-256,960,1023,252,0,0,16383,1023,-3841,-16321,0,3840,1008,255,0,3840,252,0,0 DATA 0,0,-4033,-241,1020,4095,1020,255,0,-253,-256,960,-16129,-1,-1,-1,16380,-1,-3841,-4033 DATA 0,16128,1008,255,0,3840,252,0,0,0,0,-4033,-253,1008,4095,252,-3841,0,-961,-256 DATA 192,-16129,0,0,0,3840,-1,-16129,-241,0,-253,960,255,0,3840,252,0,0,0,0 DATA -4033,-253,1008,4095,252,-193,768,-3841,-256,192,-16129,-1009,0,-256,4032,-1,255,-253,240,-193 DATA 768,255,0,3840,252,0,0,0,0,-4033,-256,960,4095,252,-253,-1,255,-256,192,-16129 DATA -253,-1,-1,768,-1,252,16128,-1,-3841,768,255,0,3840,252,0,0,0,0,-4033,-256 DATA 960,4095,252,16128,-1,240,-256,192,-16129,0,0,0,0,-193,192,768,-1,255,768,255 DATA 0,3840,252,0,0,0,0,0,0,0,0,0,768,-1,0,0,0,0,3840,-1 DATA -16129,0,0,0,0,-193,240,0,0,0,0,0,0,0,0,0,0,0,0,0 DATA 0,0,0,0,0,0,0,0,-193,240,0,0,0,0,0,0,0,0,0,0 SUB LocateIt (Row%, text$) LOCATE Row%, FnCenter(text$) PRINT text$; END SUB SUB MouseFunction (M1%, M2%, M3%, M4%) DEFINT A-Z DIM Regs AS RegType Regs.ax = M1 Regs.bx = M2 Regs.cx = M3 Regs.dx = M4 CALL INTERRUPT(&H33, Regs, Regs) M1 = Regs.ax M2 = Regs.bx M3 = Regs.cx M4 = Regs.dx END SUB 'Have to use single precision number for fractions of a second pause SUB Pause (Seconds!) Start! = TIMER WHILE Start! + Seconds! > TIMER WEND END SUB