The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 


  << Previous Topic | Next Topic >>Return to Index  

schallmaske sound

December 2 2010 at 4:04 AM
Anonymous  (no login)

 


DEFINT A-Z
DECLARE FUNCTION MULTIKEY (t)
SCREEN 12
CLS
div = 12
FOR y = 2 TO 25
LOCATE y, 1
PRINT y
NEXT
LOCATE 1, 1: COLOR 2: PRINT "............secunde......terts..kwart........kwint......sext.......septiem": COLOR 15
LINE (129, 0)-(129, 479), 2
LINE (223, 0)-(223, 479), 2
LINE (280, 0)-(280, 479), 2
LINE (384, 0)-(384, 479), 2
LINE (477, 0)-(477, 479), 2
LINE (582, 0)-(582, 479), 2
FOR y = 1 TO 24
LINE (25, y * 16 + 8)-(639, y * 16 + 8)
LINE (25, y * 16 + 5)-(25, y * 16 + 11)
LINE (639, y * 16 + 5)-(639, y * 16 + 11)
FOR x = 1 TO y
xx = 25 + 614 / (y + 1) * x
LINE (xx, y * 16 + 5)-(xx, y * 16 + 11)
NEXT
NEXT
LINE (0, div * 16 - 16)-(639, div * 16), 10, B
DIM k(53)
FOR k = 0 TO 53
k(k) = -1
NEXT
FOR k = 16 TO 25 '0 to 9
k(k) = k - 16
NEXT
FOR k = 30 TO 38 '10 to 18
k(k) = k - 20
NEXT
FOR k = 44 TO 50 '19 to 25
k(k) = k - 25
NEXT
DIM freq(25) AS SINGLE
FOR f = 0 TO 25
freq(f) = 440 * (2 ^ (f / div))
IF div = 2 AND f > 12 THEN freq(f) = 28160
IF div = 3 AND f > 18 THEN freq(f) = 28160
IF div = 4 AND f > 24 THEN freq(f) = 28160
NEXT
z = MULTIKEY(-1)
DO UNTIL MULTIKEY(1) = 1
a = -1
B = -1
FOR k = 0 TO 53
IF MULTIKEY(k) = 1 AND k(k) > -1 THEN a = k(k): B = a
NEXT
IF B > -1 AND B < lb THEN
s = B MOD div
xx = 25 + 614 / (div) * s
LINE (xx, (div - 1) * 16 + 5)-(xx, (div - 1) * 16 + 11), 2
IF lb < -1 THEN
s = lb MOD div
xx = 25 + 614 / (div) * s
LINE (xx, (div - 1) * 16 + 5)-(xx, (div - 1) * 16 + 11), 15
PSET (xx, (div - 1) * 16 + 8), 15
END IF
END IF
IF lb > -1 AND B = -1 THEN
s = lb MOD div
xx = 25 + 614 / (div) * s
LINE (xx, (div - 1) * 16 + 5)-(xx, (div - 1) * 16 + 11), 15
PSET (xx, (div - 1) * 16 + 8), 15
END IF
lb = B
IF MULTIKEY(80) = 1 AND ld = 0 AND div < 25 THEN
LINE (0, div * 16 - 16)-(639, div * 16), 0, B
LINE (639, div * 16 - 16)-(639, div * 16), 15
PSET (582, div * 16 - 16), 2
PSET (582, div * 16), 2
PSET (477, div * 16 - 16), 2
PSET (477, div * 16), 2
PSET (384, div * 16 - 16), 2
PSET (384, div * 16), 2
PSET (280, div * 16 - 16), 2
PSET (280, div * 16), 2
PSET (223, div * 16 - 16), 2
PSET (223, div * 16), 2
PSET (129, div * 16 - 16), 2
PSET (129, div * 16), 2
div = div + 1
LINE (0, div * 16 - 16)-(639, div * 16), 10, B
FOR f = 0 TO 25
freq(f) = 440 * (2 ^ (f / div))
IF div = 2 AND f > 12 THEN freq(f) = 28160
IF div = 3 AND f > 18 THEN freq(f) = 28160
IF div = 4 AND f > 24 THEN freq(f) = 28160
NEXT
ld = 1
ELSE
ld = 0
END IF
IF MULTIKEY(72) = 1 AND lu = 0 AND div > 2 THEN
LINE (0, div * 16 - 16)-(639, div * 16), 0, B
LINE (639, div * 16 - 16)-(639, div * 16), 15
PSET (582, div * 16 - 16), 2
PSET (582, div * 16), 2
PSET (477, div * 16 - 16), 2
PSET (477, div * 16), 2
PSET (384, div * 16 - 16), 2
PSET (384, div * 16), 2
PSET (280, div * 16 - 16), 2
PSET (280, div * 16), 2
PSET (223, div * 16 - 16), 2
PSET (223, div * 16), 2
PSET (129, div * 16 - 16), 2
PSET (129, div * 16), 2
div = div - 1
LINE (0, div * 16 - 16)-(639, div * 16), 10, B
FOR f = 0 TO 25
freq(f) = 440 * (2 ^ (f / div))
IF div = 2 AND f > 12 THEN freq(f) = 28160
IF div = 3 AND f > 18 THEN freq(f) = 28160
IF div = 4 AND f > 24 THEN freq(f) = 28160
NEXT
lu = 1
ELSE
lu = 0
END IF
IF a > -1 AND a < 26 THEN SOUND freq(a), 1
t! = TIMER: DO UNTIL t! < TIMER: LOOP
LOOP
z = MULTIKEY(-2)

FUNCTION MULTIKEY (t)
STATIC kbcontrol%(), kbmatrix%(), Firsttime, StatusFlag
IF Firsttime = 0 THEN 'Initalize
DIM kbcontrol%(128)
DIM kbmatrix%(128)
code$ = ""
code$ = code$ + "E91D00E93C00000000000000000000000000000000000000000000000000"
code$ = code$ + "00001E31C08ED8BE24000E07BF1400FCA5A58CC38EC0BF2400B85600FAAB"
code$ = code$ + "89D8ABFB1FCB1E31C08EC0BF2400BE14000E1FFCFAA5A5FB1FCBFB9C5053"
code$ = code$ + "51521E560657E460B401A8807404B400247FD0E088C3B700B0002E031E12"
code$ = code$ + "002E8E1E100086E08907E4610C82E661247FE661B020E6205F075E1F5A59"
code$ = code$ + "5B589DCF"
DEF SEG = VARSEG(kbcontrol%(0))
FOR I% = 0 TO 155 ' Load ASM
d% = VAL("&h" + MID$(code$, I% * 2 + 1, 2))
POKE VARPTR(kbcontrol%(0)) + I%, d%
NEXT I%
I& = 16 ' I think this stuff connects the interrupt with kbmatrix%()
N& = VARSEG(kbmatrix%(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2
N& = VARPTR(kbmatrix%(0)): l& = N& AND 255: h& = ((N& AND &HFF00) \ 256): POKE I&, l&: POKE I& + 1, h&: I& = I& + 2
DEF SEG
Firsttime = 1
END IF
SELECT CASE t
CASE -1
IF StatusFlag = 0 THEN
DEF SEG = VARSEG(kbcontrol%(0))
CALL ABSOLUTE(0) ' Run interrupt
DEF SEG
StatusFlag = 1
END IF
CASE -2
IF StatusFlag = 1 THEN
DEF SEG = VARSEG(kbcontrol%(0)) ' Turn off interrupt
CALL ABSOLUTE(3)
DEF SEG
StatusFlag = 0
END IF
CASE 1 TO 128
MULTIKEY = kbmatrix%(t) ' Return status
CASE ELSE
MULTIKEY = 0 ' User Supidity Error
END SELECT
END FUNCTION



 
 Respond to this message   
 
  << Previous Topic | Next Topic >>Return to Index  
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums