5748400 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n sbvoive.bas
   1: DECLARE SUB DETERMIN ()
   2: DECLARE SUB SAVEME (SBV$)
   3: DECLARE SUB LOAD (SBV$)
   4: DECLARE SUB DIRECT ()
   5: DECLARE SUB NEWFILE (SBV$)
   6: DECLARE SUB SECTOFOR (T1!, K!)
   7: DECLARE SUB SAYSELECT (FILE$)
   8: DECLARE SUB PLAYBACK ()
   9: DECLARE SUB RECORD ()
  10: DECLARE SUB MARK1 (Y!)
  11: DECLARE SUB MARK2 (Y2!)
  12: DECLARE SUB OSC (A%)
  13: DECLARE SUB DIGITS (D1!, D2!, D3)
  14: DECLARE SUB BOX (BX, BY, EX, EY, T)
  15: DECLARE SUB SETUP ()
  16: DECLARE FUNCTION samplebyte% (BP%)
  17: DECLARE SUB writedsp (byte%, BP%)
  18: DECLARE SUB sbreset (BP%)
  19: DIM SHARED LS%, LS2%, LS3%, T1, K, DIR$, Y, Y2, VOC, VOC2
  20: DIM SHARED SMP%(32766)
  21: DIM SHARED SM%(32766)
  22: DIM SHARED SM2%(32766)
  23: CONST BP% = &H220
  24: CALL sbreset(BP%)
  25: CONST UP = 1
  26: CONST DOWN = 2
  27: DIR$ = "C:\QB45" 'Set your default directory hear"
  28: SCREEN 9:  COLOR 0, 7: CLS : SETUP
  29: PALETTE 3, 59: SLEEP 2: PALETTE 3, 24
  30: COLOR 12: LOCATE 18, 65: PRINT DIR$
  31: Y = 0: Y2 = -50
  32: MARK1 Y: MARK2 Y2
  33: IN:
  34: K$ = INKEY$
  35: A% = samplebyte%(BP%)
  36: IF K$ = "7" THEN GOSUB Y1: MARK1 Y
  37: IF K$ = "1" THEN GOSUB YY1: MARK1 Y
  38: IF K$ = "9" THEN GOSUB Y2: MARK2 Y2
  39: IF K$ = "3" THEN GOSUB YY2: MARK2 Y2
  40: IF K$ = "R" OR K$ = "r" THEN RECORD
  41: IF K$ = "P" OR K$ = "p" THEN PLAYBACK
  42: IF K$ = "L" OR K$ = "l" THEN LOAD "SAMPLE.SBV"
  43: IF K$ = "S" OR K$ = "s" THEN SAVEME SBV$
  44: IF K$ = "D" OR K$ = "d" THEN DIRECT
  45: IF K$ <> CHR$(27) THEN GOTO IN
  46: SYSTEM
  47: Y1:
  48: LINE (382, 125 + Y)-(415, 140 + Y), 7, BF
  49: Y = Y - 10
  50: IF Y = -60 THEN Y = -50
  51: RETURN
  52: YY1:
  53: LINE (382, 125 + Y)-(415, 140 + Y), 7, BF
  54: Y = Y + 10
  55: IF Y = 50 THEN Y = 40
  56: RETURN
  57: Y2:
  58: LINE (453, 125 + Y2)-(481, 140 + Y2), 7, BF
  59: Y2 = Y2 - 10
  60: IF Y2 = -60 THEN Y2 = -50
  61: RETURN
  62: YY2:
  63: LINE (453, 125 + Y2)-(481, 140 + Y2), 7, BF
  64: Y2 = Y2 + 10
  65: IF Y2 = 50 THEN Y2 = 40
  66: RETURN
  67: 
  68: SUB adjust1
  69: END SUB
  70: 
  71: SUB BOX (BX, BY, EX, EY, T)
  72: SELECT CASE T
  73: CASE 1
  74: LINE (BX, BY)-(EX, BY), 15
  75: LINE (BX, BY)-(BX, EY), 15
  76: LINE (BX, EY)-(EX, EY), 8
  77: LINE (EX, BY)-(EX, EY), 8
  78: CASE 2
  79: LINE (BX, BY)-(EX, BY), 8
  80: LINE (BX, BY)-(BX, EY), 8
  81: LINE (BX, EY)-(EX, EY), 15
  82: LINE (EX, BY)-(EX, EY), 15
  83: END SELECT
  84: END SUB
  85: 
  86: SUB DETERMIN
  87: IF Y = -50 THEN VOC = 80
  88: IF Y = -40 THEN VOC = 70
  89: IF Y = -30 THEN VOC = 60
  90: IF Y = -10 THEN VOC = 50
  91: IF Y = 0 THEN VOC = 40
  92: IF Y = 10 THEN VOC = 16
  93: IF Y = 20 THEN VOC = 22
  94: IF Y = 30 THEN VOC = 28
  95: IF Y = 40 THEN VOC = 34
  96: 
  97: IF Y2 = -50 THEN VOC2 = 0
  98: IF Y2 = -40 THEN VOC2 = 1
  99: IF Y2 = -30 THEN VOC2 = 2
 100: IF Y2 = -20 THEN VOC2 = 3
 101: IF Y2 = -10 THEN VOC2 = 4
 102: IF Y2 = 0 THEN VOC2 = 5
 103: IF Y2 = 10 THEN VOC2 = 6
 104: IF Y2 = 20 THEN VOC2 = 7
 105: IF Y2 = 30 THEN VOC2 = 8
 106: IF Y2 = 40 THEN VOC2 = 9
 107: END SUB
 108: 
 109: SUB DIGITS (D1, D2, D3)
 110: PALETTE 11, 59
 111: SELECT CASE D1
 112: CASE 0
 113: L1 = 11: L2 = 11: L3 = 11: L4 = 11: L5 = 11: L6 = 11: L7 = 3
 114: CASE 1
 115: L1 = 3: L2 = 3: L3 = 3: L4 = 3: L5 = 11: L6 = 11: L7 = 3
 116: CASE 2
 117: L1 = 3: L2 = 11: L3 = 11: L4 = 11: L5 = 11: L6 = 3: L7 = 11
 118: END SELECT
 119: SELECT CASE D2
 120: CASE 0
 121: LL1 = 11: LL2 = 11: LL3 = 11: LL4 = 11: LL5 = 11: LL6 = 11: LL7 = 3
 122: CASE 1
 123: LL1 = 3: LL2 = 3: LL3 = 3: LL4 = 3: LL5 = 11: LL6 = 11: LL7 = 3
 124: CASE 2
 125: LL1 = 3: LL2 = 11: LL3 = 11: LL4 = 11: LL5 = 11: LL6 = 3: LL7 = 11
 126: CASE 3
 127: LL1 = 3: LL2 = 3: LL3 = 11: LL4 = 11: LL5 = 11: LL6 = 11: LL7 = 11
 128: CASE 4
 129: LL1 = 11: LL2 = 3: LL3 = 3: LL4 = 3: LL5 = 11: LL6 = 11: LL7 = 11
 130: CASE 5
 131: LL1 = 11: LL2 = 3: LL3 = 11: LL4 = 11: LL5 = 3: LL6 = 11: LL7 = 11
 132: CASE 6
 133: LL1 = 11: LL2 = 11: LL3 = 11: LL4 = 11: LL5 = 3: LL6 = 11: LL7 = 11
 134: CASE 7
 135: LL1 = 3: LL2 = 3: LL3 = 11: LL4 = 3: LL5 = 11: LL6 = 11: LL7 = 3
 136: CASE 8
 137: LL1 = 11: LL2 = 11: LL3 = 11: LL4 = 11: LL5 = 11: LL6 = 11: LL7 = 11
 138: CASE 9
 139: LL1 = 11: LL2 = 3: LL3 = 11: LL4 = 3: LL5 = 11: LL6 = 11: LL7 = 11
 140: END SELECT
 141: SELECT CASE D3
 142: CASE 10
 143: stopp = 11: rec = 3: playy = 3
 144: CASE 11
 145: rec = 11: stopp = 3: playy = 3
 146: CASE 12
 147: playy = 11: stopp = 3: rec = 3
 148: END SELECT
 149: LINE (240, 120)-(260, 140), playy
 150: LINE (260, 140)-(240, 160), playy
 151: LINE (240, 160)-(240, 120), playy: PAINT (241, 150), playy
 152: LINE (180, 130)-(200, 150), rec, BF
 153: CIRCLE (220, 140), 15, stopp: PAINT (220, 140), stopp
 154: LINE (19, 120)-(19, 155), L1
 155: LINE (19, 157)-(19, 192), L2
 156: LINE (21, 120)-(69, 120), L3
 157: LINE (21, 192)-(69, 192), L4
 158: LINE (70, 120)-(70, 155), L5
 159: LINE (70, 157)-(70, 192), L6
 160: LINE (21, 155)-(66, 155), L7
 161: LINE (119, 120)-(119, 155), LL1
 162: LINE (119, 157)-(119, 192), LL2
 163: LINE (121, 120)-(169, 120), LL3
 164: LINE (121, 192)-(169, 192), LL4
 165: LINE (170, 120)-(170, 155), LL5
 166: LINE (170, 157)-(170, 192), LL6
 167: LINE (123, 155)-(166, 155), LL7
 168: LINE (69, 120)-(119, 120), 6
 169: LINE (170, 120)-(250, 120), 6
 170: LINE (69, 192)-(119, 192), 6
 171: LINE (170, 192)-(250, 192), 6
 172: END SUB
 173: 
 174: SUB DIRECT
 175: LOCATE 18, 64: INPUT "", DIR$
 176: END SUB
 177: 
 178: SUB LOAD (SBV$)
 179: NEWFILE SBV$
 180: OPEN DIR$ + "\" + SBV$ + ".SBV" FOR INPUT AS #1
 181: INPUT #1, LS%: INPUT #1, LS2%: INPUT #1, LS3%
 182: FOR I% = 1 TO LS%
 183: LINE INPUT #1, A$: B = ASC(A$): SMP%(I%) = B
 184: NEXT
 185: FOR I% = 1 TO LS2%
 186: LINE INPUT #1, A$: B = ASC(A$): SM%(I%) = B
 187: NEXT
 188: FOR I% = 1 TO LS3%
 189: LINE INPUT #1, A$: B = ASC(A$): SM2%(I%) = B
 190: NEXT
 191: CLOSE
 192: END SUB
 193: 
 194: SUB MARK1 (Y)
 195: LINE (382, 130 + Y)-(395, 125 + Y), 15
 196: LINE (395, 125 + Y)-(395, 130 + Y), 15
 197: LINE (395, 130 + Y)-(410, 130 + Y), 15
 198: LINE (410, 130 + Y)-(410, 135 + Y), 8
 199: LINE (410, 135 + Y)-(395, 135 + Y), 8
 200: LINE (395, 135 + Y)-(395, 140 + Y), 8
 201: LINE (395, 140 + Y)-(382, 130 + Y), 8
 202: END SUB
 203: 
 204: SUB MARK2 (Y2)
 205: LINE (453, 130 + Y2)-(466, 125 + Y2), 15
 206: LINE (466, 125 + Y2)-(466, 130 + Y2), 15
 207: LINE (466, 130 + Y2)-(481, 130 + Y2), 15
 208: LINE (481, 130 + Y2)-(481, 135 + Y2), 8
 209: LINE (481, 135 + Y2)-(466, 135 + Y2), 8
 210: LINE (466, 135 + Y2)-(466, 140 + Y2), 8
 211: LINE (466, 140 + Y2)-(453, 130 + Y2), 8
 212: END SUB
 213: 
 214: SUB NEWFILE (SBV$)
 215: LOCATE 23, 50: INPUT "", SBV$
 216: END SUB
 217: 
 218: SUB PLAYBACK
 219: DIGITS T1, K, 12
 220: DETERMIN
 221: CALL writedsp(&HD1, BP%)  'Turn speaker on
 222: FOR T% = 1 TO LS%
 223:         CALL writedsp(&H10, BP%)
 224:         CALL writedsp(SMP%(T%), BP%)
 225:         FOR I = 1 TO VOC2: NEXT
 226: NEXT T%
 227: FOR T% = 1 TO LS2%
 228:         CALL writedsp(&H10, BP%)
 229:         CALL writedsp(SM%(T%), BP%)
 230:         FOR I = 1 TO VOC2: NEXT
 231: NEXT T%
 232: FOR T% = 1 TO LS3%
 233:         CALL writedsp(&H10, BP%)
 234:         CALL writedsp(SM2%(T%), BP%)
 235:         FOR I = 1 TO VOC2: NEXT
 236: NEXT T%
 237: CALL writedsp(&HD3, BP%)  'Turn speaker off
 238: DIGITS T1, K, 10
 239: END SUB
 240: 
 241: SUB RECORD
 242: LINE (21, 194)-(69, 194), 12
 243: 1 K$ = INKEY$
 244: IF K$ = "0" THEN T1 = VAL(K$): GOTO 10
 245: IF K$ = "1" THEN T1 = VAL(K$): GOTO 10
 246: GOTO 1
 247: 10 DIGITS T1, 0, 10: LINE (21, 194)-(69, 194), 6
 248: LINE (121, 194)-(169, 194), 12
 249: 11 K$ = INKEY$
 250: K = VAL(K$)
 251: FOR I = 1 TO 9
 252: IF K = I OR K$ = "0" THEN GOTO 20
 253: NEXT
 254: GOTO 11
 255: 20
 256: LINE (121, 194)-(169, 194), 6
 257: SECTOFOR T1, K
 258: IF K$ = "0" THEN K = 0
 259: DIGITS T1, K, 11
 260: DETERMIN
 261: FOR T% = 1 TO LS%
 262:         SMP%(T%) = samplebyte(BP%)
 263:         IF SMP%(T%) > 254 THEN BEEP
 264:         FOR U% = 1 TO VOC: NEXT U%
 265: NEXT T%
 266: FOR T% = 1 TO LS2%
 267:         SM%(T%) = samplebyte(BP%)
 268:         FOR U% = 1 TO 40 + VOC: NEXT U%
 269: NEXT T%
 270: FOR T% = 1 TO LS3%
 271:         SM2%(T%) = samplebyte(BP%)
 272:         FOR U% = 1 TO 40 + VOC: NEXT U%
 273: NEXT T%
 274: BEEP
 275: DIGITS 0, 0, 10
 276: END SUB
 277: 
 278: FUNCTION samplebyte% (BP%)
 279: CALL writedsp(&H20, BP%)
 280: datavail% = BP% + 14
 281: dly:
 282:         IF INP(datavail%) AND &H80 = 0 THEN GOTO dly
 283: datread% = BP% + 10
 284: bt% = INP(datread%)
 285: samplebyte% = bt%
 286: 
 287: END FUNCTION
 288: 
 289: SUB SAVEME (SBV$)
 290: NEWFILE SBV$
 291: OPEN DIR$ + "\" + SBV$ + ".SBV" FOR OUTPUT AS #1
 292: PRINT #1, LS%: PRINT #1, LS2%: PRINT #1, LS3%
 293: FOR I% = 1 TO LS%
 294: PRINT #1, CHR$(SMP%(I%))
 295: NEXT
 296: FOR I% = 1 TO LS2%
 297: PRINT #1, CHR$(SM%(I%))
 298: NEXT
 299: FOR I% = 1 TO LS3%
 300: PRINT #1, CHR$(SM2%(I%))
 301: NEXT
 302: CLOSE
 303: END SUB
 304: 
 305: SUB SAYSELECT (FILE$)
 306: CALL writedsp(&HD1, BP%)
 307: OPEN FILE$ FOR INPUT AS #1
 308: FOR I% = 1 TO 8000
 309: LINE INPUT #1, A$
 310: SMP%(I%) = ASC(A$)
 311: NEXT
 312: CLOSE
 313: FOR T% = 1 TO 8000
 314:         CALL writedsp(&H10, BP%)
 315:         CALL writedsp(SMP%(T%), BP%)
 316: NEXT T%
 317: CALL writedsp(&HD3, BP%)
 318: END SUB
 319: 
 320: SUB sbreset (BP%)
 321: dspreset% = BP% + 6
 322: OUT dspreset%, 1
 323: FOR T% = 1 TO 10
 324:         A% = INP(dspreset%)
 325: NEXT T%
 326: OUT dspreset%, 0
 327: dspread% = BP% + 10
 328: FOR T% = 1 TO 10
 329:         A% = INP(dspread%)
 330: NEXT T%
 331: END SUB
 332: 
 333: SUB SECTOFOR (T1, K)
 334: IF T1 = 1 AND K = 0 THEN LS% = 32766: LS2% = 21844
 335: IF T1 = 1 AND K = 1 THEN LS% = 32766: LS2% = 27305
 336: IF T1 = 1 AND K = 2 THEN LS% = 32766: LS2% = 32766
 337: IF T1 = 1 AND K = 3 THEN LS% = 32766: LS2% = 32766: LS3% = 5461
 338: IF T1 = 1 AND K = 4 THEN LS% = 32766: LS2% = 32766: LS3% = 10922
 339: IF T1 = 1 AND K = 5 THEN LS% = 32766: LS2% = 32766: LS3% = 16383
 340: IF T1 = 1 AND K = 6 THEN LS% = 32766: LS2% = 32766: LS3% = 21844
 341: IF T1 = 1 AND K = 7 THEN LS% = 32766: LS2% = 32766: LS3% = 27305
 342: IF T1 = 1 AND K = 8 THEN LS% = 32766: LS2% = 32766: LS3% = 32766
 343: IF T1 = 0 AND K = 1 THEN LS% = 5461
 344: IF T1 = 0 AND K = 2 THEN LS% = 10922
 345: IF T1 = 0 AND K = 3 THEN LS% = 16383
 346: IF T1 = 0 AND K = 4 THEN LS% = 21844
 347: IF T1 = 0 AND K = 5 THEN LS% = 27305
 348: IF T1 = 0 AND K = 6 THEN LS% = 32766
 349: IF T1 = 0 AND K = 7 THEN LS% = 32766: LS2% = 5461
 350: IF T1 = 0 AND K = 8 THEN LS% = 32766: LS2% = 10922
 351: IF T1 = 0 AND K = 9 THEN LS% = 32766: LS2% = 16383
 352: END SUB
 353: 
 354: SUB SETUP
 355: BOX 5, 5, 634, 55, UP
 356: BOX 10, 10, 629, 50, DOWN
 357: COLOR 10
 358: LOCATE 2, 3: PRINT "Load           Save         Directory          Exit"
 359: BOX 10, 60, 250, 100, DOWN
 360: PALETTE 6, 0
 361: LINE (12, 62)-(248, 98), 6, BF
 362: FOR I = 1 TO 50 STEP 12
 363: LINE (17 + I, 69)-(26 + I, 78), 2, BF
 364: LINE (17 + I, 85)-(26 + I, 94), 2, BF
 365: NEXT
 366: FOR I = 1 TO 40 STEP 12
 367: LINE (80 + I, 69)-(89 + I, 78), 4, BF
 368: LINE (80 + I, 85)-(89 + I, 94), 4, BF
 369: NEXT
 370: FOR I = 1 TO 30 STEP 12
 371: LINE (130 + I, 69)-(139 + I, 78), 1, BF
 372: LINE (130 + I, 85)-(139 + I, 94), 1, BF
 373: NEXT
 374: BOX 300, 60, 610, 200, UP
 375: BOX 350, 70, 420, 180, UP
 376: BOX 421, 70, 491, 180, UP
 377: BOX 380, 75, 381, 175, DOWN
 378: BOX 451, 75, 452, 175, DOWN
 379: FOR I = 75 TO 175 STEP 20
 380: LINE (370, I)-(374, I), 15
 381: LINE (369, I + 1)-(373, I + 1), 8
 382: LINE (441, I)-(445, I), 15
 383: LINE (440, I + 1)-(444, I + 1), 8
 384: NEXT
 385: BOX 50, 250, 100, 290, UP
 386: BOX 120, 250, 170, 290, UP
 387: BOX 190, 250, 240, 290, UP
 388: BOX 40, 240, 250, 300, UP
 389: BOX 45, 245, 245, 295, DOWN
 390: LINE (55, 251)-(98, 272), 6
 391: LINE (98, 272)-(55, 290), 6
 392: LINE (55, 251)-(55, 290), 6
 393: PAINT (56, 259), 6
 394: CIRCLE (145, 270), 20, 6
 395: PAINT (145, 270), 6
 396: LINE (195, 255)-(235, 285), 4, BF
 397: BOX 5, 110, 280, 200, DOWN
 398: LINE (7, 112)-(278, 198), 6, BF
 399: PALETTE 3, 24
 400: FOR I = 1 TO 200 STEP 50
 401: LINE (19 + I, 120)-(19 + I, 155), 3
 402: LINE (19 + I, 157)-(19 + I, 192), 3
 403: LINE (21 + I, 120)-(69 + I, 120), 3
 404: LINE (21 + I, 192)-(69 + I, 192), 3
 405: LINE (23, 155)-(66, 155), 3
 406: LINE (123, 155)-(166, 155), 3
 407: LINE (69, 120)-(119, 120), 6
 408: LINE (170, 120)-(250, 120), 6
 409: LINE (69, 192)-(119, 192), 6
 410: LINE (170, 192)-(250, 192), 6
 411: NEXT
 412: LINE (240, 120)-(260, 140), 3
 413: LINE (260, 140)-(240, 160), 3
 414: LINE (240, 160)-(240, 120), 3: PAINT (241, 150), 3
 415: CIRCLE (220, 140), 15, 3: PAINT (220, 140), 3
 416: LINE (180, 130)-(200, 150), 3, BF
 417: DIGITS 0, 0, 10
 418: LINE (99, 120)-(99, 150), 11
 419: LINE (99, 160)-(99, 192), 11
 420: DIGITS 0, 0, 10
 421: BOX 350, 220, 620, 270, UP: BOX 355, 225, 615, 265, DOWN
 422: BOX 350, 280, 620, 330, UP: BOX 355, 285, 615, 325, DOWN
 423: COLOR 6
 424: LOCATE 22, 50: PRINT "Current filename:"
 425: LOCATE 18, 46: PRINT "Load from/Save to:"
 426: LOCATE 6, 63: PRINT "Left: During"
 427: LOCATE 7, 63: PRINT "Recording only"
 428: LOCATE 9, 63: PRINT "Right: During"
 429: LOCATE 10, 63: PRINT "Playback only"
 430: DIGITS 0, 0, 10
 431: COLOR 12
 432: LOCATE 6, 24: PRINT "G.P.S"
 433: BOX 184, 70, 224, 84, UP
 434: END SUB
 435: 
 436: SUB writedsp (byte%, BP%)
 437: dspcmd% = BP% + 12
 438: FOR T% = 1 TO 8
 439:         q% = INP(dspcmd%)
 440: NEXT T%
 441: OUT dspcmd%, byte%
 442: END SUB
 443: 
5748401 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:09:18