5748176 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n rec1.bas
   1: DECLARE SUB WriteDSP (byte!, BP!)
   2: DECLARE FUNCTION SampleByte! (BP!)
   3: DECLARE SUB DETERMIN ()
   4: DECLARE SUB SAVEME (SBV$)
   5: DECLARE SUB LOAD (SBV$)
   6: DECLARE SUB DIRECT ()
   7: DECLARE SUB NEWFILE (SBV$)
   8: DECLARE SUB SECTOFOR (T1!, K!)
   9: DECLARE SUB SAYSELECT (FILE$)
  10: DECLARE SUB PLAYBACK ()
  11: DECLARE SUB RECORD ()
  12: DECLARE SUB MARK1 (Y!)
  13: DECLARE SUB MARK2 (Y2!)
  14: DECLARE SUB OSC (A%)
  15: DECLARE SUB DIGITS (D1!, D2!, D3)
  16: DECLARE SUB BOX (BX, BY, EX, EY, T)
  17: DECLARE SUB SETUP ()
  18: DECLARE SUB sbreset (BP%)
  19: DIM SHARED LS%, LS2%, LS3%, T1, K, DIR$, Y, Y2, VOC, VOC2
  20: DIM SHARED SMP(16383)
  21: DIM SHARED SM%(32766)
  22: DIM SHARED SM2%(327)
  23: CONST BP% = &H220
  24: CALL sbreset(BP%)
  25: CONST UP = 1
  26: CONST DOWN = 2
  27: DIR$ = "H:\BAS" '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(CSNG(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(CSNG(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: CLS
 262: FOR T% = 1 TO LS%
 263:         SMP(T%) = SampleByte(BP%)
 264:         'IF SMP(T%) > 254 THEN BEEP
 265:         FOR U% = 1 TO VOC: NEXT U%
 266:         LINE (2 + (T% MOD 640), 128)-(2 + (T% MOD 640), SMP(T%)), 2
 267:         'PRINT (T% MOD 640)
 268:         IF (T% MOD 640) = 0 THEN CLS
 269: NEXT T%
 270: FOR T% = 1 TO LS2%
 271:         SM%(T%) = SampleByte(BP%)
 272:         FOR U% = 1 TO 40 + VOC: NEXT U%
 273: '        PRINT SM%(T%)
 274: NEXT T%
 275: FOR T% = 1 TO LS3%
 276:         SM2%(T%) = SampleByte(BP%)
 277:         FOR U% = 1 TO 40 + VOC: NEXT U%
 278: '        PRINT SM2%(T%)
 279: NEXT T%
 280: BEEP
 281: DIGITS 0, 0, 10
 282: END SUB
 283: 
 284: FUNCTION SampleByte (BP)
 285: CALL WriteDSP(&H20, BP)
 286: 'datavail = BP + 14
 287: 'dly:
 288: '        IF INP(datavail) AND &H80 = 0 THEN GOTO dly
 289: datread = BP + 10
 290: bt = INP(datread)
 291: SampleByte = bt
 292: 
 293: END FUNCTION
 294: 
 295: SUB SAVEME (SBV$)
 296: NEWFILE SBV$
 297: OPEN DIR$ + "\" + SBV$ + ".SBV" FOR OUTPUT AS #1
 298: PRINT #1, LS%: PRINT #1, LS2%: PRINT #1, LS3%
 299: FOR I% = 1 TO LS%
 300: PRINT #1, CHR$(SMP(I%))
 301: NEXT
 302: FOR I% = 1 TO LS2%
 303: PRINT #1, CHR$(SM%(I%))
 304: NEXT
 305: FOR I% = 1 TO LS3%
 306: PRINT #1, CHR$(SM2%(I%))
 307: NEXT
 308: CLOSE
 309: END SUB
 310: 
 311: SUB SAYSELECT (FILE$)
 312: CALL WriteDSP(&HD1, BP%)
 313: OPEN FILE$ FOR INPUT AS #1
 314: FOR I% = 1 TO 8000
 315: LINE INPUT #1, A$
 316: SMP(I%) = ASC(A$)
 317: NEXT
 318: CLOSE
 319: FOR T% = 1 TO 8000
 320:         CALL WriteDSP(&H10, BP%)
 321:         CALL WriteDSP(SMP(T%), BP%)
 322: NEXT T%
 323: CALL WriteDSP(&HD3, BP%)
 324: END SUB
 325: 
 326: SUB sbreset (BP%)
 327: dspreset% = BP% + 6
 328: OUT dspreset%, 1
 329: FOR T% = 1 TO 10
 330:         A% = INP(dspreset%)
 331: NEXT T%
 332: OUT dspreset%, 0
 333: dspread% = BP% + 10
 334: FOR T% = 1 TO 10
 335:         A% = INP(dspread%)
 336: NEXT T%
 337: END SUB
 338: 
 339: SUB SECTOFOR (T1, K)
 340: IF T1 = 1 AND K = 0 THEN LS% = 32766: LS2% = 21844
 341: IF T1 = 1 AND K = 1 THEN LS% = 32766: LS2% = 27305
 342: IF T1 = 1 AND K = 2 THEN LS% = 32766: LS2% = 32766
 343: IF T1 = 1 AND K = 3 THEN LS% = 32766: LS2% = 32766: LS3% = 5461
 344: IF T1 = 1 AND K = 4 THEN LS% = 32766: LS2% = 32766: LS3% = 10922
 345: IF T1 = 1 AND K = 5 THEN LS% = 32766: LS2% = 32766: LS3% = 16383
 346: IF T1 = 1 AND K = 6 THEN LS% = 32766: LS2% = 32766: LS3% = 21844
 347: IF T1 = 1 AND K = 7 THEN LS% = 32766: LS2% = 32766: LS3% = 27305
 348: IF T1 = 1 AND K = 8 THEN LS% = 32766: LS2% = 32766: LS3% = 32766
 349: IF T1 = 0 AND K = 1 THEN LS% = 5461
 350: IF T1 = 0 AND K = 2 THEN LS% = 10922
 351: IF T1 = 0 AND K = 3 THEN LS% = 16383
 352: IF T1 = 0 AND K = 4 THEN LS% = 21844
 353: IF T1 = 0 AND K = 5 THEN LS% = 27305
 354: IF T1 = 0 AND K = 6 THEN LS% = 32766
 355: IF T1 = 0 AND K = 7 THEN LS% = 32766: LS2% = 5461
 356: IF T1 = 0 AND K = 8 THEN LS% = 32766: LS2% = 10922
 357: IF T1 = 0 AND K = 9 THEN LS% = 32766: LS2% = 16383
 358: END SUB
 359: 
 360: SUB SETUP
 361: BOX 5, 5, 634, 55, UP
 362: BOX 10, 10, 629, 50, DOWN
 363: COLOR 10
 364: LOCATE 2, 3: PRINT "Load           Save         Directory          Exit"
 365: BOX 10, 60, 250, 100, DOWN
 366: PALETTE 6, 0
 367: LINE (12, 62)-(248, 98), 6, BF
 368: FOR I = 1 TO 50 STEP 12
 369: LINE (17 + I, 69)-(26 + I, 78), 2, BF
 370: LINE (17 + I, 85)-(26 + I, 94), 2, BF
 371: NEXT
 372: FOR I = 1 TO 40 STEP 12
 373: LINE (80 + I, 69)-(89 + I, 78), 4, BF
 374: LINE (80 + I, 85)-(89 + I, 94), 4, BF
 375: NEXT
 376: FOR I = 1 TO 30 STEP 12
 377: LINE (130 + I, 69)-(139 + I, 78), 1, BF
 378: LINE (130 + I, 85)-(139 + I, 94), 1, BF
 379: NEXT
 380: BOX 300, 60, 610, 200, UP
 381: BOX 350, 70, 420, 180, UP
 382: BOX 421, 70, 491, 180, UP
 383: BOX 380, 75, 381, 175, DOWN
 384: BOX 451, 75, 452, 175, DOWN
 385: FOR I = 75 TO 175 STEP 20
 386: LINE (370, I)-(374, I), 15
 387: LINE (369, I + 1)-(373, I + 1), 8
 388: LINE (441, I)-(445, I), 15
 389: LINE (440, I + 1)-(444, I + 1), 8
 390: NEXT
 391: BOX 50, 250, 100, 290, UP
 392: BOX 120, 250, 170, 290, UP
 393: BOX 190, 250, 240, 290, UP
 394: BOX 40, 240, 250, 300, UP
 395: BOX 45, 245, 245, 295, DOWN
 396: LINE (55, 251)-(98, 272), 6
 397: LINE (98, 272)-(55, 290), 6
 398: LINE (55, 251)-(55, 290), 6
 399: PAINT (56, 259), 6
 400: CIRCLE (145, 270), 20, 6
 401: PAINT (145, 270), 6
 402: LINE (195, 255)-(235, 285), 4, BF
 403: BOX 5, 110, 280, 200, DOWN
 404: LINE (7, 112)-(278, 198), 6, BF
 405: PALETTE 3, 24
 406: FOR I = 1 TO 200 STEP 50
 407: LINE (19 + I, 120)-(19 + I, 155), 3
 408: LINE (19 + I, 157)-(19 + I, 192), 3
 409: LINE (21 + I, 120)-(69 + I, 120), 3
 410: LINE (21 + I, 192)-(69 + I, 192), 3
 411: LINE (23, 155)-(66, 155), 3
 412: LINE (123, 155)-(166, 155), 3
 413: LINE (69, 120)-(119, 120), 6
 414: LINE (170, 120)-(250, 120), 6
 415: LINE (69, 192)-(119, 192), 6
 416: LINE (170, 192)-(250, 192), 6
 417: NEXT
 418: LINE (240, 120)-(260, 140), 3
 419: LINE (260, 140)-(240, 160), 3
 420: LINE (240, 160)-(240, 120), 3: PAINT (241, 150), 3
 421: CIRCLE (220, 140), 15, 3: PAINT (220, 140), 3
 422: LINE (180, 130)-(200, 150), 3, BF
 423: DIGITS 0, 0, 10
 424: LINE (99, 120)-(99, 150), 11
 425: LINE (99, 160)-(99, 192), 11
 426: DIGITS 0, 0, 10
 427: BOX 350, 220, 620, 270, UP: BOX 355, 225, 615, 265, DOWN
 428: BOX 350, 280, 620, 330, UP: BOX 355, 285, 615, 325, DOWN
 429: COLOR 6
 430: LOCATE 22, 50: PRINT "Current filename:"
 431: LOCATE 18, 46: PRINT "Load from/Save to:"
 432: LOCATE 6, 63: PRINT "Left: During"
 433: LOCATE 7, 63: PRINT "Recording only"
 434: LOCATE 9, 63: PRINT "Right: During"
 435: LOCATE 10, 63: PRINT "Playback only"
 436: DIGITS 0, 0, 10
 437: COLOR 12
 438: LOCATE 6, 24: PRINT "G.P.S"
 439: BOX 184, 70, 224, 84, UP
 440: END SUB
 441: 
 442: SUB WriteDSP (byte, BP)
 443: dspcmd = BP + 12
 444: FOR T% = 1 TO 8
 445:         q = INP(dspcmd)
 446: NEXT T%
 447: OUT dspcmd, byte
 448: END SUB
 449: 
5748177 [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:08:26