Advertisement
Guest User

sources frrom pc underground part 2

a guest
Jun 30th, 2023
63
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 289.58 KB | Software | 0 0
  1. .386p
  2.  
  3. .MODEL TPASCAL
  4. .DATA
  5.  
  6. oldint3 dd ?
  7. alter_interrupt3 dd ?
  8. .CODE
  9.  
  10. public protected_stopping
  11. protected_stopping proc pascal
  12. pusha
  13. cli ; Interrupts ausschalten
  14. mov eax,cr0 ; In den Protected-Mode schalten
  15. or eax,1
  16. mov cr0,eax
  17. jmp PROTECTION_ENABLED ; Executionpipe l”schen
  18. PROTECTION_ENABLED:
  19.  
  20. and al,0FEh ; Wieder in den Real-Mode schalten
  21. mov cr0,eax ; CPU nicht resetten
  22. jmp PROTECTION_DISABLED ; Executionpipe l”schen
  23. PROTECTION_DISABLED:
  24. sti ; Interrupts wieder einschalten
  25. popa
  26. ret
  27. protected_stopping endp
  28.  
  29. public Check_auf_vector
  30. Check_auf_vector proc pascal check : dword;
  31. mov bx,0
  32. mov es,bx
  33. mov bx,18
  34. mov eax,es:[bx]
  35. mov oldint3,eax
  36. mov eax,check
  37. mov es:[bx],eax
  38. ret
  39. Check_auf_vector endp
  40.  
  41. public Vector_ok
  42. Vector_ok proc pascal check : dword;
  43. mov bx,0
  44. mov es,bx
  45. mov bx,18
  46. mov eax,es:[bx]
  47. cmp eax,check
  48. je @check_ok
  49. mov al,0
  50. jmp @check_ende
  51. @check_ok:
  52. mov al,1
  53. @check_ende:
  54. ret
  55. Vector_ok endp
  56.  
  57. public restore_Checkvector
  58. restore_Checkvector proc pascal
  59. mov bx,0
  60. mov es,bx
  61. mov bx,18
  62. mov eax,oldint3
  63. mov es:[bx],eax
  64. ret
  65. restore_Checkvector endp
  66.  
  67. public Copy_int21_int3
  68. Copy_int21_int3 proc pascal
  69. mov bx,0
  70. mov es,bx
  71. mov bx,18
  72. mov eax,es:[bx]
  73. mov alter_interrupt3,eax ; alten int3 sichern
  74. mov bx,84 ; Int 21 laden
  75. mov eax,es:[bx]
  76. mov bx,18 ; in int3 speichern
  77. mov es:[bx],eax
  78. ret
  79. Copy_int21_int3 endp
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88. END.386p
  89. .MODEL TPASCAL
  90.  
  91. keyb_off macro
  92. push ax
  93. in al,21h
  94. or al,02
  95. out 21h,al
  96. pop ax
  97. endm
  98.  
  99. keyb_on macro
  100. push ax
  101. in al,21h
  102. and al,0Fdh
  103. out 21h,al
  104. pop ax
  105. endm
  106.  
  107. .DATA
  108. extrn Verbleibende_durchlaeufe
  109. extrn PNeues_Passwort_waehlen : dword
  110. extrn PEingabe_Box_zeichnen : dword
  111. extrn PPasswort_abfragen : dword
  112. extrn PSystem_anhalten : dword
  113. extrn Passwort_correct : byte
  114. extrn unnoetige_Variable1 : word
  115. extrn unnoetige_Variable2 : word
  116.  
  117. .CODE
  118. extrn Main_Programm : far
  119.  
  120. public Abfrage_Schleife
  121.  
  122. Abfrage_Schleife proc pascal
  123. keyb_off
  124.  
  125. ;PIQ - Trick
  126. int 3
  127. mov cs:word ptr [@int_21_funkt1],4CB4h ; Funktion Prg. beenden
  128. @int_21_funkt1:
  129. mov ah,30h ; Funktion DOS-Vers. ermitteln
  130. int 21h
  131.  
  132. @Abfrage_loop:
  133. keyb_off
  134.  
  135. call dword ptr PNeues_Passwort_waehlen
  136. cmp unnoetige_Variable1,5
  137. jbe @Unnoetiges_Ziel1a
  138.  
  139. ;PIQ - Trick
  140. int 3
  141. mov cs:word ptr [@int_21_funkt2],4CB4h ; Funktion Prg. beenden
  142. @int_21_funkt2:
  143. mov ah,30h ; Funktion DOS-Vers. ermitteln
  144. int 21h
  145. mov cs:word ptr [@int_21_funkt2],30B4h ; Funktion Prg. beenden
  146.  
  147. call dword ptr PEingabe_Box_zeichnen
  148. jmp @Unnoetiges_Ziel1b
  149.  
  150. @Unnoetiges_Ziel1a:
  151. ;PIQ - Trick
  152. int 3
  153. mov cs:word ptr [@int_21_funkt2],4CB4h ; Funktion Prg. beenden
  154. @int_21_funkt2a:
  155. mov ah,30h ; Funktion DOS-Vers. ermitteln
  156. int 21h
  157. mov cs:word ptr [@int_21_funkt2a],30B4h ; Funktion Prg. beenden
  158.  
  159. call dword ptr PEingabe_Box_zeichnen
  160. @Unnoetiges_Ziel1b:
  161. keyb_on
  162.  
  163.  
  164. cmp unnoetige_Variable2,10
  165. jbe @Unnoetiges_Ziel2a
  166.  
  167. dec byte ptr Verbleibende_durchlaeufe
  168.  
  169. ; Protected MODE Trick
  170. pusha
  171. cli ; Interrupts ausschalten
  172. mov eax,cr0 ; In den Protected-Mode schalten
  173. or eax,1
  174. mov cr0,eax
  175. jmp PROTECTION_ENABLED ; Executionpipe l”schen
  176. PROTECTION_ENABLED:
  177. and al,0FEh ; Wieder in den Real-Mode schalten
  178. mov cr0,eax ; CPU nicht resetten
  179. jmp PROTECTION_DISABLED ; Executionpipe l”schen
  180. PROTECTION_DISABLED:
  181. sti ; Interrupts wieder einschalten
  182. popa
  183.  
  184. call dword ptr PPasswort_abfragen
  185. jmp @Unnoetiges_Ziel2b
  186.  
  187. @Unnoetiges_Ziel2a:
  188. dec byte ptr Verbleibende_durchlaeufe
  189.  
  190. ; Protected MODE Trick
  191. pusha
  192. cli ; Interrupts ausschalten
  193. mov eax,cr0 ; In den Protected-Mode schalten
  194. or eax,1
  195. mov cr0,eax
  196. jmp PROTECTION_ENABLED2a ; Executionpipe l”schen
  197. PROTECTION_ENABLED2a:
  198. and al,0FEh ; Wieder in den Real-Mode schalten
  199. mov cr0,eax ; CPU nicht resetten
  200. jmp PROTECTION_DISABLED2a ; Executionpipe l”schen
  201. PROTECTION_DISABLED2a:
  202. sti ; Interrupts wieder einschalten
  203. popa
  204. call dword ptr PPasswort_abfragen
  205.  
  206. @Unnoetiges_Ziel2b:
  207.  
  208. cmp byte ptr Passwort_correct,1
  209. je @Abfrage_war_OK
  210. jmp @Abfrage_war_nicht_OK
  211. @Abfrage_war_OK:
  212.  
  213. call Main_Programm
  214. @Abfrage_war_nicht_OK:
  215.  
  216. cmp byte ptr Verbleibende_durchlaeufe,54
  217. ja @Abfrage_loop
  218. call dword ptr PSystem_anhalten
  219. ret
  220. Abfrage_schleife endp
  221.  
  222. END{$F+}
  223. {$M $4000,500000,650000}
  224. program passwortabfrage;
  225.  
  226. uses crt,design;
  227. const Passwoerter : array[1..10] of string =
  228. ('Data Becker','Inspire','PC Underground','Soundblaster',
  229. 'Demos','Super','Vengeance','Dynamite','Bier','Haus');
  230. Pw_Pages : array[1..10] of word =
  231. (17,3,29,43,12,21,4,9,13,30);
  232.  
  233. Var pw_nr : byte;
  234. verbleibende_durchlaeufe : byte;
  235. Passwort_correct : word;
  236. New_Pass : string;
  237. PNeues_Passwort_waehlen : pointer;
  238. PEingabe_Box_zeichnen : pointer;
  239. PPasswort_abfragen : pointer;
  240. PSystem_anhalten : pointer;
  241. unnoetige_Variable1 : word;
  242. unnoetige_Variable2 : word;
  243.  
  244. {$L Pwmodul}
  245. procedure Abfrage_Schleife; far; external;
  246.  
  247. procedure Neues_Passwort_waehlen;
  248. begin;
  249. pw_nr := random(10)+1;
  250. unnoetige_Variable1 := 1;
  251. unnoetige_Variable2 := 2;
  252. end;
  253.  
  254. procedure Eingabe_Box_zeichnen;
  255. var pws : string;
  256. begin;
  257. str(Pw_Pages[pw_nr]:2,pws);
  258. asm int 3; end;
  259. Fenster(20,10,40,4,'Bitte Passwort auf Seite '+pws+' eingeben',black,7);
  260. unnoetige_Variable1 := 1;
  261. unnoetige_Variable2 := 2;
  262. gotoxy(23,12);
  263. end;
  264.  
  265. procedure Passwort_abfragen;
  266. begin;
  267. readln(New_Pass);
  268. unnoetige_Variable1 := 1;
  269. unnoetige_Variable2 := 2;
  270. if New_Pass = Passwoerter[pw_nr] then
  271. Passwort_correct := 1
  272. else
  273. Passwort_correct := 0;
  274. end;
  275.  
  276. procedure System_anhalten;
  277. begin;
  278. textbackground(black);
  279. textcolor(7);
  280. clrscr;
  281. writeln('Wir h„tten doch wohl besser ein Orginal gekauft ...');
  282. halt(0);
  283. end;
  284.  
  285.  
  286. procedure Main_Programm;
  287. begin;
  288. textbackground(black);
  289. textcolor(7);
  290. clrscr;
  291. gotoxy(20,12);
  292. writeln('Wilkommen im Hauptprogramm !');
  293. gotoxy(20,22);
  294. write('Enter zum Beenden ... ');
  295. readln;
  296. halt(0);
  297. end;
  298.  
  299. begin;
  300. textbackground(black);
  301. textcolor(7);
  302. clrscr;
  303. verbleibende_durchlaeufe := 57;
  304. PNeues_Passwort_waehlen := @Neues_Passwort_waehlen;
  305. PEingabe_Box_zeichnen := @Eingabe_Box_zeichnen;
  306. PPasswort_abfragen := @Passwort_abfragen;
  307. PSystem_anhalten := @System_anhalten;
  308. randomize;
  309. Abfrage_Schleife;
  310. end.unit design;
  311.  
  312. interface
  313. uses crt,windos;
  314.  
  315. procedure writexy(x,y : integer;s : string);
  316. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  317. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  318. function wrhexb(b : byte) : string;
  319. function wrhexw(w : word) : string;
  320. procedure save_screen;
  321. procedure restore_screen;
  322. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  323. procedure cursor_On;
  324. procedure cursor_Off;
  325.  
  326. implementation
  327.  
  328. var filenames : array[1..512] of string[12];
  329. const Screen_Akt : byte = 1;
  330.  
  331. procedure writexy(x,y : integer;s : string);
  332. begin;
  333. gotoxy(x,y);
  334. write(s);
  335. end;
  336.  
  337. procedure save_screen;
  338. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  339. begin;
  340. if Screen_Akt <= 4 then begin;
  341. inc(Screen_Akt);
  342. move(screen[1],screen[Screen_Akt],8000);
  343. end;
  344. end;
  345.  
  346. procedure restore_screen;
  347. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  348. begin;
  349. if Screen_Akt >= 2 then begin;
  350. move(screen[Screen_Akt],screen[1],8000);
  351. dec(Screen_Akt);
  352. end;
  353. end;
  354.  
  355. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  356. const frames : array[1..2,1..6] of char =
  357. (('Ú','¿','Ù','À','Ä','³'),
  358. ('É','»','¼','È','Í','º'));
  359. var lx,ly : integer;
  360. s : string;
  361. begin;
  362. { obere Zeile }
  363. s := frames[rt,1];
  364. for lx := 1 to dx-2 do s := s + frames[rt,5];
  365. s := s + frames[rt,2];
  366. gotoxy(startx,starty);
  367. write(s);
  368. { mittleren Zeilen }
  369. for ly := 1 to dy-2 do begin;
  370. s := frames[rt,6];
  371. for lx := 1 to dx-2 do s := s + ' ';
  372. s := s + frames[rt,6];
  373. gotoxy(startx,starty+ly);
  374. write(s);
  375. end;
  376. { untere Zeile }
  377. s := frames[rt,4];
  378. for lx := 1 to dx-2 do s := s + frames[rt,5];
  379. s := s + frames[rt,3];
  380. gotoxy(startx,starty+dy-1);
  381. write(s);
  382. end;
  383.  
  384. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  385. var tlaeng : byte;
  386. deltx,tstartpos : byte;
  387. begin;
  388. tlaeng := length(s);
  389. tstartpos := x + ((dx-Tlaeng) SHR 1);
  390. textcolor(rcol);
  391. textbackground(bcol);
  392. rahmen(1,x,y,dx,dy);
  393. writexy(tstartpos,y,s);
  394. end;
  395.  
  396. procedure sort_filenames(start,ende : integer);
  397. {
  398. Hier sollte fr gr”áere Verzeichnise Quick-Sort eingebaut werden !
  399. }
  400. var hilfe : string;
  401. l1,l2 : integer;
  402. begin;
  403. for l1 := start to ende-1 do begin;
  404. for l2 := start to ende-1 do begin;
  405. if filenames[l2] > filenames[l2+1] then begin;
  406. hilfe := filenames[l2];
  407. filenames[l2] := filenames[l2+1];
  408. filenames[l2+1] := hilfe;
  409. end;
  410. end;
  411. end;
  412. end;
  413.  
  414. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  415. const zeile : byte = 1;
  416. spalte : byte = 0;
  417. Start_fndisp : word = 0;
  418. var
  419. DirInfo: TSearchRec;
  420. count : integer;
  421. Nullpos : byte;
  422. var li,lj : integer;
  423. inp : char;
  424. retval : string;
  425. kasten_gefunden : boolean;
  426. select : byte;
  427. changed : boolean;
  428. End_fndisp : word;
  429. begin
  430. {$I+}
  431. for li := 1 to 512 do filenames[li] := ' - - -';
  432. count := 1;
  433. FindFirst(mask, faArchive, DirInfo);
  434. while DosError = 0 do
  435. begin
  436. filenames[count] := (DirInfo.Name);
  437. Nullpos := pos(#0,filenames[count]);
  438. if Nullpos <> 0 then
  439. filenames[count] := copy(filenames[count],0,Nullpos-1);
  440. inc(count);
  441. FindNext(DirInfo);
  442. end;
  443. {$I-}
  444.  
  445. sort_filenames(1,count-1);
  446. save_screen;
  447. Fenster(5,4,72,16,comment,black,7);
  448. textcolor(1);
  449. writexy(21,5,' Bitte Datei ausw„hlen');
  450. textcolor(black);
  451. inp := #255;
  452. changed := true;
  453. repeat
  454. textcolor(black);
  455. if changed then begin;
  456. changed := false;
  457. for lj := 0 to 4 do begin;
  458. for li := 1 to 12 do begin;
  459. writexy(7+lj*14,5+li,' ');
  460. writexy(7+lj*14,5+li,filenames[lj*12+li+Start_fndisp]);
  461. end;
  462. end;
  463. textcolor(14);
  464. writexy(7+Spalte*14,5+Zeile,filenames[Spalte*12+Zeile+Start_fndisp]);
  465. end;
  466. if keypressed then inp := readkey;
  467. if ord(inp) = 0 then inp := readkey;
  468. case ord(inp) of
  469. 32,
  470. 13: begin;
  471. inp := #13;
  472. changed := true;
  473. if (pos('- - -',filenames[Spalte*12+Zeile+Start_fndisp]) = 0) then
  474. retval := filenames[Spalte*12+Zeile+Start_fndisp]
  475. else
  476. retval := 'xxxx';
  477. end;
  478. 27: begin;
  479. inp := #27;
  480. changed := true;
  481. retval := 'xxxx';
  482. end;
  483. 71: begin; { Pos 1 }
  484. inp := #255;
  485. Zeile := 1;
  486. Spalte := 0;
  487. changed := true;
  488. end;
  489. 72: begin; { Pfeil up }
  490. inp := #255;
  491. changed := true;
  492. if not ((Zeile = 1) and (Spalte = 0)) then
  493. dec(Zeile);
  494. if Zeile = 0 then begin;
  495. dec(Spalte);
  496. Zeile := 12;
  497. end;
  498. end;
  499. 73: begin; { Page UP }
  500. if Start_fndisp >= 12 then
  501. dec(Start_fndisp,12)
  502. else begin;
  503. Start_fndisp := 0;
  504. Zeile := 1;
  505. end;
  506. inp := #255;
  507. changed := true;
  508. end;
  509. 81: begin; { Page Down }
  510. if ((Spalte+1)*12+Start_fndisp < count) and
  511. (Start_fndisp < 500) then
  512. inc(Start_fndisp,12)
  513. else
  514. Start_fndisp := count-11;
  515. inp := #255;
  516. changed := true;
  517. end;
  518. 75: begin; { Pfeil links }
  519. inp := #255;
  520. changed := true;
  521. if Spalte = 0 then begin;
  522. if Start_fndisp >= 12 then dec(Start_fndisp,12);
  523. end else begin;
  524. if Spalte > 0 then dec(Spalte);
  525. end;
  526. end;
  527. 77: begin; { Pfeil rechts }
  528. inp := #255;
  529. changed := true;
  530. if Spalte = 4 then begin;
  531. if ((Spalte+1)*12+Start_fndisp < count) and
  532. (Start_fndisp < 500) then inc(Start_fndisp,12);
  533. end else begin;
  534. if (Spalte < 4) and
  535. (Zeile+(Spalte+1)*12+Start_fndisp < count) then
  536. inc(Spalte);
  537. end;
  538. end;
  539. 79: begin; { End }
  540. inp := #255;
  541. changed := true;
  542. Spalte := (count-Start_fndisp-12) div 12;
  543. Zeile := (count-Start_fndisp) - Spalte*12 -1;
  544. end;
  545. 80: begin; { Pfeil down }
  546. inp := #255;
  547. changed := true;
  548. if ((Zeile = 12) and (Spalte = 4)) then begin;
  549. if (Start_fndisp+Zeile+Spalte*12 < count-1) then begin;
  550. inc(Start_fndisp,1);
  551. end;
  552. end else begin;
  553. if (Start_fndisp+Zeile+Spalte*12 < count-1) then
  554. inc(Zeile);
  555. end;
  556. if Zeile > 12 then begin;
  557. inc(Spalte);
  558. Zeile := 1;
  559. end;
  560. end;
  561. 82 : begin;
  562. changed := true;
  563. save_screen;
  564. textcolor(black);
  565. rahmen(2,16,9,45,5);
  566. writexy(20,10,' Dateinamen eingeben ('+mtext+')');
  567. writexy(20,12,'Name: ');
  568. readln(retval);
  569. if retval = '' then retval := 'xxxx';
  570. restore_screen;
  571. end;
  572. end;
  573. until (inp = #13) or (inp = #27) or (inp = #32)
  574. or (inp = #82);
  575. restore_screen;
  576. textbackground(black);
  577. textcolor(7);
  578. select_datei := retval;
  579. end;
  580.  
  581. function wrhexb(b : byte) : string;
  582. const hexcar : array[0..15] of char =
  583. ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  584. begin;
  585. wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
  586. end;
  587.  
  588. function wrhexw(w : word) : string;
  589. begin;
  590. wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
  591. end;
  592.  
  593. procedure cursor_Off; assembler;
  594. asm
  595. xor ax,ax
  596. mov ah,01h
  597. mov cx,2020h
  598. int 10h
  599. end;
  600.  
  601. procedure cursor_on; assembler;
  602. asm
  603. mov ah,01h
  604. mov cx,0607h
  605. int 10h
  606. end;
  607.  
  608.  
  609.  
  610. begin;
  611. end..286
  612. code segment
  613. assume cs:code,ds:code
  614. org 100h
  615.  
  616. start:
  617. jmp main ;Sprung zum Hauptprogramm
  618.  
  619. ;residente Prozeduren:
  620.  
  621. print proc near ;gibt ASCIIZ-String an Pos ds:si auf LPT1 aus
  622. print_loop:
  623. xor ah,ah ;Funktion 0
  624. lodsb ;Zeichen holen
  625. or al,al ;fertig, wenn 0 als Abschluá
  626. je fertig
  627. xor dx,dx ;auf LPT1 ausgeben
  628. int 17h
  629. jmp print_loop ;n„chstes Zeichen
  630. fertig:
  631. ret
  632. print endp
  633.  
  634. handler5 proc far ;Handler fr Interrupt 5
  635. push es ;alle benutzten Register sichern
  636. push ds
  637. pusha
  638.  
  639. mov ax,cs ;es mit PSP-Segment laden
  640. mov es,ax
  641. mov ds,ax ;auch Datensegment in Codesegment
  642.  
  643. mov di,80h ;Parameterblock als Puffer
  644. mov ah,1bh ;Funktion 1bh
  645. xor bx,bx
  646. int 10h ;Video-Status ermitteln
  647.  
  648. cli
  649.  
  650. mov al,byte ptr cs:[80h+22h] ;Anzahl Bildschirmzeilen holen
  651. cmp al,25d
  652. jbe normal ;wenn 25 Bildschirmzeilen, normale Routine
  653.  
  654. lea si,klein_Schrift ;auf 6-Punkt Schrift umschalten
  655. call print ;Code an Drucker
  656. jmp ausgabe
  657.  
  658. normal:
  659. lea si,Groá_Schrift ;auf 12-Punkt Schrift umschalten
  660. call print ;Code an Drucker
  661.  
  662. ausgabe:
  663. sti
  664. pushf
  665. call dword ptr [oldint5] ;normale Ausgabe aktivieren
  666.  
  667. popa
  668. pop ds
  669. pop es
  670. iret
  671. handler5 endp
  672.  
  673. oldint5: dd 0 ;Original-Vektor
  674. klein_Schrift: db 1bh,'(s6V' ;6 Punkte H”he
  675. db 1bh,'&l12D' ;12 Zeilen pro Inch
  676. db 1bh,'(s12H' ;12 Zeichen pro Inch
  677. db 0
  678. groá_schrift: db 1bh,'(s12V' ;12 Punkt H”he
  679. db 1bh,'&l6D' ;6 Zeilen pro Inch
  680. db 1bh,'(s10H' ;10 Zeichen pro Inch
  681. db 0
  682.  
  683. letzte:
  684.  
  685. main proc near
  686. mov ax,3505h ;Interrupt 5 auslesen
  687. int 21h
  688. mov di,bx ;es:di zeigt auf installierten Handler
  689. mov si,bx ;ds:si zeigt auf Handler dieses Programmes
  690. mov cx,4 ;8 Bytes vergleichen
  691. repe cmpsw
  692. jcxz deinstallieren ;gleich ?, dann deinstallieren
  693.  
  694. installieren:
  695. mov word ptr oldint5,bx ;alten Vektor sichern
  696. mov word ptr oldint5 + 2,es
  697.  
  698. mov ax,2505h ;Interrupt 5 umleiten
  699. lea dx,handler5 ;Offset laden, Segment bereits in ds
  700. int 21h
  701.  
  702. mov ax,ds:[2ch] ;Environment-Segment laden
  703. mov es,ax ;nach es
  704. mov ah,49h ;und freigeben
  705. int 21h
  706.  
  707. mov ah,9 ;Installationsmeldung ausgeben
  708. lea dx,installiert
  709. int 21h
  710. lea dx,letzte ;bis Label letzte resident bleiben
  711. inc dx
  712. int 27h
  713.  
  714. deinstallieren:
  715. mov ah,9 ;Deinstallationsmeldung ausgeben
  716. lea dx,deinstalliert
  717. int 21h
  718.  
  719. push ds
  720. lds dx,dword ptr es:[oldint5] ;ds:dx mit altem Vektor laden
  721. mov ax,2505h ;diesen setzen
  722. int 21h
  723. pop ds
  724.  
  725. mov ah,49h ;residenten Speicher freigeben
  726. int 21h
  727. int 20h ;und beenden
  728. main endp
  729.  
  730.  
  731. Installiert: db 'Neue Print-Screen Funktion installiert',0dh,0ah,'$'
  732. Deinstalliert: db 'Print-Screen deinstalliert',0dh,0ah,'$'
  733.  
  734. code ends
  735. end start
  736. Const Basis=$378; {Basisadresse der par. Schnittstelle}
  737.  
  738. Procedure PutChar_Par(z:Char);
  739. {gibt ein Zeichen auf Parallelport (Basisadresse in "Basis") aus}
  740. Begin
  741. While Port[Basis+1] and 128 = 0 Do;
  742. {Auf Ende des Busy warten}
  743. Port[Basis]:=Ord(z); {Zeichen auf Port legen}
  744.  
  745. Port[Basis+2]:=Port[Basis+2] or 1;
  746. {Strobe senden}
  747. Port[Basis+2]:=Port[Basis+2] and not 1;
  748.  
  749. While Port[Basis+1] and 64 = 1 do;
  750. {Auf Ack warten}
  751. End;
  752.  
  753. Procedure PutString_Par(s:String);
  754. {gibt String auf Parallel-Port aus, benutzt PutChar_Par)}
  755. Var i:Integer; {Zeichenz„hler}
  756. Begin
  757. For i:=1 to Length(s) do {jedes Zeichen}
  758. PutChar_Par(s[i]); {an den Parallelport schicken}
  759. End;
  760.  
  761. Begin
  762. PutString_Par('Hallo, Data Becker Drucker Test'#13#10);
  763. PutString_Par('abcdefghijklmnopqrstuvwxyz0123456789'#13#10);
  764. End.
  765. Uses Crt,Dos;
  766.  
  767. Const
  768. RxR=0; {Receive Data, bei Lesezugriffen}
  769. TxR=0; {Transmit Data, bei Schreibzugriffen}
  770. IER=1; {Interrupt Enable}
  771. IIR=2; {Interrupt Identification}
  772. LCR=3; {Line Control}
  773. MCR=4; {Modem Control}
  774. LSR=5; {Line Status}
  775. MSR=6; {Modem Status}
  776. DLL=0; {Divisor Latch High}
  777. DLH=1; {Divisor Latch Low}
  778.  
  779. N=0; {keine Parit„t}
  780. O=8; {ungerade Parit„t}
  781. E=24; {gerade Parit„t}
  782.  
  783. IRQ_Tab:Array[1..4] of Word {Interrupt-Nummern der Schnittsctellen}
  784. =(4,3,4,3);
  785. Base_Tab:Array[1..4] of Word {Portadressen der Schnittstellen}
  786. =($3f8,$2f8,$3e8,$2e8);
  787.  
  788. Var OldInt:Pointer; {originaler Interrupt-Vektor}
  789. Key:Char; {gedrckte Taste}
  790. IRQ, {IRQ-Nummer des aktuellen Ports}
  791. Base:Word; {Portadresse des aktuellen Ports}
  792. fertig:Boolean; {Flag fr Programm-Ende}
  793.  
  794. Procedure Handler;interrupt;
  795. {Interrupt-Handler, nimmt Zeichen von ser. Port entgegen}
  796. Begin
  797. Write(Chr(Port[Base+RxR])); {Zeichen vom Port holen und ausgeben}
  798. Port[$20]:=$20; {EOI senden}
  799. End;
  800.  
  801. Procedure Open_Port(Nr:Word);
  802. {bereitet COM-Port auf Ein-/Ausgabe vor}
  803. Begin
  804. IRQ:=IRQ_Tab[Nr]; {IRQ-Nummer holen}
  805. Base:=Base_Tab[Nr]; {Basis-Adress holen}
  806. GetIntVec(IRQ+8,OldInt); {Zeiger verbiegen}
  807. SetIntVec(IRQ+8,@Handler);
  808. Port[$21]:=Port[$21] and {IRQ zulassen}
  809. not (1 shl IRQ);
  810. Port[Base+MCR]:=11; {Auxiliary Output, RTS und DTR setzen}
  811. Port[Base+IER]:=1; {Interrupt Enable fr Receive}
  812. End;
  813.  
  814. Procedure Close_Port;
  815. {setzt COM-Interrupts zurck}
  816. Begin
  817. SetIntVec(IRQ+8,OldInt); {IRQ-Vektor wiederherstellen}
  818. Port[Base+MCR]:=0; {Signale zurcksetzen}
  819. Port[Base+IER]:=0; {Interrupts ausschalten}
  820. Port[$21]:= {Interrupt-Controller zurcksetzen}
  821. Port[$21] or (1 shl IRQ);
  822. End;
  823.  
  824. Procedure Set_Speed(bps:LongInt);
  825. {setzt Port-Geschwindigkeit}
  826. Var Divisor:Word;
  827. Begin
  828. Port[Base+LCR]:=Port[Base+LCR]{DLAB einschalten}
  829. or 128;
  830. Divisor:=115200 div bps;
  831. Port[Base+DLL]:=Lo(Divisor); {Werte in Divsor Latch schreiben}
  832. Port[BAse+DLH]:=Hi(Divisor);
  833. Port[Base+LCR]:=Port[Base+LCR]{DLAB ausschalten}
  834. and not 128;
  835. End;
  836.  
  837. Procedure Set_Param(Data,Par,Stop:Word);
  838. {setzt die Parameter Datenbits, Parit„t und Stopbits}
  839. Begin
  840. Port[Base+LCR]:=
  841. (Data-5) {Bit 0-1 auf Datenbit setzen}
  842. + Par {Parit„t dazu}
  843. + (Stop-1) shl 2; {Stopbits in Bit 2 des LCR setzen}
  844. End;
  845.  
  846. Procedure Error;
  847. {wird bei Time-Out in der Sende-Prozedur aufgerufen}
  848. Begin
  849. WriteLn;
  850. WriteLn('Sende-Timeout'); {Meldung}
  851. Close_Port; {Port schlieáen}
  852. Halt(1); {und abbrechen}
  853. End;
  854.  
  855. Procedure Transmit(c:Char);
  856. {sendet Zeichen ber seriellen Port}
  857. Var Time_Out:Integer; {Z„hler fr Time-Out}
  858. Begin
  859. Time_Out:=-1;
  860. While Port[Base+MSR] and 16 = 0 Do Begin
  861. Dec(Time_Out); {Warten auf CTS}
  862. If Time_Out=0 Then Error;
  863. End;
  864. Time_Out:=-1;
  865. While Port[Base+LSR] and 32 = 0 Do Begin
  866. Dec(Time_Out); {Warten auf leeres Transmitter-Register}
  867. If Time_Out=0 Then Error;
  868. End;
  869. Port[Base+TxR]:=Ord(c); {Zeichen senden}
  870. End;
  871.  
  872. Begin
  873. Open_Port(2); {COM ”ffnen}
  874. Set_Speed(19200); {Geschwindigkeit 19200 bps}
  875. Set_Param(8,N,1); {Parameter setzen}
  876. WriteLn;
  877. WriteLn('Terminal in Funktion (Alt-X zum Beenden):');
  878. Repeat
  879. Key:=ReadKey; {Taste lesen}
  880. If Key <> #0 Then {normale Tasten an COM-Port senden}
  881. Transmit(Key)
  882. Else {bei Alt-X beenden}
  883. If ReadKey=#45 Then fertig:=true;
  884. Until fertig;
  885. Close_Port; {Interrupts ausschalten}
  886. End.
  887. program rtc_unit;
  888.  
  889. uses crt,dos;
  890.  
  891. const
  892. Rtc_Sekunden = $00;
  893. Rtc_Sekunden_alarm = $01;
  894. Rtc_Minuten = $02;
  895. Rtc_Minuten_alarm = $03;
  896. Rtc_Stunden = $04;
  897. Rtc_Stunden_alarm = $05;
  898. Rtc_Wochentag = $06;
  899. Rtc_Tag_des_Monats = $07;
  900. Rtc_Monat = $08;
  901. Rtc_Jahr = $09;
  902. Rtc_Status_A = $0A;
  903. Rtc_Status_B = $0B;
  904. Rtc_Status_C = $0C;
  905. Rtc_Status_D = $0D;
  906. Rtc_Diagnose_status = $0E;
  907. Rtc_Shutdown_status = $0F;
  908. Rtc_Floppy_Typ = $10;
  909. Rtc_HD_Typ = $12;
  910. Rtc_Ausstattung = $14;
  911. Rtc_Lo_Basememory = $15;
  912. Rtc_Hi_Basememory = $16;
  913. Rtc_Lo_Extendedmem = $17;
  914. Rtc_Hi_Extendedmem = $18;
  915. Rtc_HD1_extended = $19;
  916. Rtc_HD2_extended = $1A;
  917. Rtc_Features = $1F;
  918. Rtc_HD1_Lo_Cylinder = $20;
  919. Rtc_HD1_Hi_Cylinder = $21;
  920. Rtc_HD1_Koepfe = $22;
  921. Rtc_HD1_Lo_Precom = $23;
  922. Rtc_HD1_Hi_Precom = $24;
  923. Rtc_HD1_Lo_Landing = $25;
  924. Rtc_HD1_Hi_Landing = $26;
  925. Rtc_HD1_Sektoren = $27;
  926. Rtc_Optionen1 = $28;
  927. Rtc_Optionen2 = $2B;
  928. Rtc_Optionen3 = $2C;
  929. Rtc_Lo_Checksumme = $2E;
  930. Rtc_Hi_Checksumme = $2F;
  931. Rtc_Extendedmem_Lo = $30;
  932. Rtc_Extendedmem_Hi = $31;
  933. Rtc_Jahrhundert = $32;
  934. Rtc_Setup_Info = $33;
  935. Rtc_CPU_speed = $34;
  936. Rtc_HD2_Lo_Cylinder = $35;
  937. Rtc_HD2_Hi_Cylinder = $36;
  938. Rtc_HD2_Koepfe = $37;
  939. Rtc_HD2_Lo_Precom = $38;
  940. Rtc_HD2_Hi_Precom = $39;
  941. Rtc_HD2_Lo_Landing = $3A;
  942. Rtc_HD2_Hi_Landing = $3B;
  943. Rtc_HD2_Sektoren = $3C;
  944.  
  945.  
  946. function wrhexb(b : byte) : string;
  947. const hexcar : array[0..15] of char =
  948. ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  949. begin;
  950. wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
  951. end;
  952.  
  953. function wrhexw(w : word) : string;
  954. begin;
  955. wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
  956. end;
  957.  
  958. procedure write_rtc(Reg,val : byte);
  959. {
  960. Schreibt einen Wert in das in Reg angegebene RTC-Register
  961. }
  962. begin;
  963. port[$70] := Reg;
  964. port[$71] := val;
  965. end;
  966.  
  967. function read_rtc(Reg : byte) : byte;
  968. {
  969. Liest einen Wert aus dem in Reg angegebene RTC-Register
  970. }
  971. begin;
  972. port[$70] := Reg;
  973. read_rtc := port[$71];
  974. end;
  975.  
  976. Procedure Write_Floppy;
  977. {
  978. Gibt Informationen ber die installierten Floppy-Laufwerke aus
  979. }
  980. Var Fl : byte;
  981. Fls : array[1..2] of byte;
  982. begin;
  983. Fl := Read_Rtc(Rtc_Floppy_Typ);
  984. Fls[2] := Fl AND $0F;
  985. Fls[1] := Fl SHR 4;
  986. for Fl := 1 to 2 do begin;
  987. write('Floppy ',Fl,': ');
  988. case Fls[Fl] of
  989. 0 : begin;
  990. writeln('No Floppy ');
  991. end;
  992. 1 : begin;
  993. writeln('5¬" Floppy, 360 KB');
  994. end;
  995. 2 : begin;
  996. writeln('5¬" Floppy, 1.2 MB');
  997. end;
  998. 3 : begin;
  999. writeln('3«" Floppy, 720 KB');
  1000. end;
  1001. 4 : begin;
  1002. writeln('3«" Floppy, 1.44 MB');
  1003. end;
  1004. end;
  1005. end;
  1006. end;
  1007.  
  1008. Procedure Write_Hd;
  1009. {
  1010. Gibt den Typ der installierten HDs aus
  1011. }
  1012. Var Hd : byte;
  1013. Hds : array[1..2] of byte;
  1014. begin;
  1015. Hd := Read_Rtc(Rtc_HD_Typ);
  1016. Hds[2] := Hd AND $0F;
  1017. Hds[1] := Hd SHR 4;
  1018. If HDs[1] = $F then HDs[1] := Read_Rtc(Rtc_HD1_extended);
  1019. If HDs[2] = $F then HDs[2] := Read_Rtc(Rtc_HD2_extended);
  1020. writeln('HD 1 : Typ ',Hds[1]);
  1021. writeln('HD 2 : Typ ',Hds[2]);
  1022. end;
  1023.  
  1024. procedure Write_Memory;
  1025. {
  1026. Gibt den zur Verfgung stehenden Speicher aus
  1027. }
  1028. var base,extended : word;
  1029. begin;
  1030. Base := 256 * Read_Rtc(Rtc_Hi_Basememory) +
  1031. Read_Rtc(Rtc_Lo_Basememory);
  1032. extended := 256 * Read_Rtc(Rtc_Hi_Extendedmem) +
  1033. Read_Rtc(Rtc_Lo_Extendedmem);
  1034. writeln('Base memory: ',Base,' KB');
  1035. writeln('Exteded memory: ',extended,' KB');
  1036. end;
  1037.  
  1038. procedure Write_Display;
  1039. {
  1040. Gibt den Typ der Grafik-Karte aus und informiert, ob ein Co-Prozessor
  1041. installiert ist
  1042. }
  1043. var dtyp : byte;
  1044. Copro : byte;
  1045. begin;
  1046. dtyp := Read_Rtc(Rtc_Ausstattung);
  1047. Copro := (dtyp AND 3) SHR 1;
  1048. dtyp := (dtyp AND 63) SHR 4;
  1049. case dtyp of
  1050. 0 : begin;
  1051. writeln('Extended functionality GFX-Controller');
  1052. end;
  1053. 1 : begin;
  1054. writeln('Color Display im 40-Spalten Modus');
  1055. end;
  1056. 2 : begin;
  1057. writeln('Color Display im 80-Spalten Modus');
  1058. end;
  1059. 3 : begin;
  1060. writeln('Monochrome Display Controller');
  1061. end;
  1062. end;
  1063. if Copro = 1 then
  1064. writeln('Co-Prozessor gefunden')
  1065. else
  1066. writeln('Kein Co-Prozessor gefunden');
  1067. end;
  1068.  
  1069. procedure write_shadow;
  1070. {
  1071. Gibt aus, welche Bereiche vom Shadow-Ram untersttzt werden
  1072. }
  1073. var shadow : byte;
  1074. begin;
  1075. shadow := read_rtc(Rtc_Optionen1);
  1076. shadow := shadow AND 3;
  1077. case shadow of
  1078. 0 : begin;
  1079. writeln('Shadow System AND Video BIOS');
  1080. end;
  1081. 1 : begin;
  1082. writeln('Shadow System BIOS');
  1083. end;
  1084. 2 : begin;
  1085. writeln('Shadow disabled');
  1086. end;
  1087. end;
  1088. end;
  1089.  
  1090. procedure write_cpuspeed;
  1091. {
  1092. Gibt an, ob sich die CPU im Turbo-Mode befindet
  1093. }
  1094. var speed : byte;
  1095. begin;
  1096. speed := read_rtc(Rtc_CPU_speed);
  1097. if speed = 1 then
  1098. writeln('CPU in Turbo-Mode')
  1099. else
  1100. writeln('CPU in Deturbo-Mode');
  1101. end;
  1102.  
  1103. var speed : byte;
  1104. begin;
  1105. clrscr;
  1106. Write_Floppy;
  1107. Write_Hd;
  1108. Write_Memory;
  1109. Write_Display;
  1110. Write_Shadow;
  1111. Write_CPUSpeed;
  1112. end.
  1113.  
  1114.  
  1115.  
  1116.  
  1117. program test_timer;
  1118.  
  1119. uses crt,dos;
  1120.  
  1121. Var OTimerInt : pointer;
  1122. Timerfreq : word;
  1123. Orig_freq : word;
  1124. Sync_counter : word;
  1125. Tizaehler : word;
  1126.  
  1127. PROCEDURE SetColor (Nr, R, G, B : BYTE);
  1128. begin;
  1129. asm
  1130. mov al,Nr
  1131. mov dx,03C8h
  1132. out dx,al
  1133. mov dx,03C9h
  1134. mov al,r
  1135. out dx,al
  1136. mov al,g
  1137. out dx,al
  1138. mov al,b
  1139. out dx,al
  1140. end;
  1141. end;
  1142.  
  1143. procedure waitretrace;
  1144. begin;
  1145. asm
  1146. MOV DX,03dAh
  1147. @WD_R:
  1148. IN AL,DX
  1149. TEST AL,8d
  1150. JZ @WD_R
  1151. @WD_D:
  1152. IN AL,DX
  1153. TEST AL,8d
  1154. JNZ @WD_D
  1155. end;
  1156. end;
  1157.  
  1158. procedure StelleTimerEin(Proc : pointer; Freq : word);
  1159. var izaehler : word;
  1160. oldv : pointer;
  1161. begin;
  1162. asm cli end;
  1163. izaehler := 1193180 DIV Freq;
  1164. Port[$43] := $36;
  1165. Port[$40] := Lo(IZaehler);
  1166. Port[$40] := Hi(IZaehler);
  1167.  
  1168. Getintvec(8,OTimerInt);
  1169. SetIntVec(8,Proc);
  1170. asm sti end;
  1171. end;
  1172.  
  1173. procedure Neue_Timerfreq(Freq : word);
  1174. var izaehler : word;
  1175. begin;
  1176. asm cli end;
  1177. izaehler := 1193180 DIV Freq;
  1178. Port[$43] := $36;
  1179. Port[$40] := Lo(IZaehler);
  1180. Port[$40] := Hi(IZaehler);
  1181. asm sti end;
  1182. end;
  1183.  
  1184. procedure StelleTimerAus;
  1185. var oldv : pointer;
  1186. begin;
  1187. asm cli end;
  1188. port[$43] := $36;
  1189. Port[$40] := 0;
  1190. Port[$40] := 0;
  1191. SetIntVec(8,OTimerInt);
  1192. asm sti end;
  1193. end;
  1194.  
  1195. procedure Syncro_interrupt; interrupt;
  1196. begin;
  1197. inc(Sync_counter);
  1198. port[$20] := $20;
  1199. end;
  1200.  
  1201. procedure Syncronize_timer;
  1202. begin;
  1203. Timerfreq := 120;
  1204. StelleTimerEin(@Syncro_interrupt,Timerfreq);
  1205. Repeat
  1206. dec(Timerfreq,2);
  1207. waitretrace;
  1208. Neue_timerfreq(Timerfreq);
  1209. Sync_counter := 0;
  1210. waitretrace;
  1211. until (Sync_counter = 0);
  1212. end;
  1213.  
  1214. Procedure Timer_Handling;
  1215. begin;
  1216. setcolor(0,0,63,0);
  1217. end;
  1218.  
  1219. Procedure Timer_Proc; interrupt;
  1220. begin;
  1221. Timer_Handling;
  1222. waitretrace;
  1223. Port[$43] := $34; { Mono - Flop Modus }
  1224. Port[$40] := Lo(TiZaehler);
  1225. Port[$40] := Hi(TiZaehler);
  1226.  
  1227. setcolor(0,63,0,0);
  1228.  
  1229. port[$20] := $20;
  1230. end;
  1231.  
  1232. Procedure Starte_Syncrotimer(Proc : pointer);
  1233. var calcl : longint;
  1234. begin;
  1235. asm cli end;
  1236. port[$43] := $36;
  1237. Port[$40] := 0;
  1238. Port[$40] := 0;
  1239.  
  1240. Tizaehler := 1193180 DIV (Timerfreq+5);
  1241. setintvec(8,Proc);
  1242. waitretrace;
  1243. Port[$43] := $34; { Mono - Flop Modus }
  1244. Port[$40] := Lo(TiZaehler);
  1245. Port[$40] := Hi(TiZaehler);
  1246. asm sti end;
  1247. end;
  1248.  
  1249. begin;
  1250. clrscr;
  1251. Syncronize_Timer;
  1252. writeln('Die Timerfrequenz ist : ',Timerfreq);
  1253. Starte_Syncrotimer(@Timer_Proc);
  1254. repeat until keypressed;
  1255. while keypressed do readkey;
  1256. StelleTimerAus;
  1257. setcolor(0,0,0,0);
  1258. end.
  1259. .286
  1260.  
  1261. segment data
  1262. w equ word ptr
  1263. b equ byte ptr
  1264. num_voices equ 14
  1265.  
  1266. ;**************************************************************************
  1267. ;*** D A T E N S E G M E N T ***
  1268. ;**************************************************************************
  1269.  
  1270. gefunden db ?
  1271.  
  1272. ;**************************************************************************
  1273. ;*** Z U W E I S U N G E N ***
  1274. ;**************************************************************************
  1275.  
  1276. Play_Voice equ 0
  1277. Stop_Voice equ 3
  1278. Bit8 equ 0
  1279. Bit16 equ 4
  1280. No_Loop equ 0
  1281. Mit_Loop equ 8
  1282. Unidirect equ 0
  1283. Bidirect equ 16
  1284. Go_forw equ 0
  1285. Go_Back equ 64
  1286. data ends
  1287.  
  1288. ;**************************************************************************
  1289. ;*** C O D E S E G M E N T ***
  1290. ;**************************************************************************
  1291.  
  1292. segment code
  1293. assume cs:code, ds:data
  1294.  
  1295. ;**************************************************************************
  1296. ;*** P U B L I C - D E K L A R A T I O N E N ***
  1297. ;**************************************************************************
  1298.  
  1299.  
  1300. u_base dw 240h
  1301. u_status dw u_base+006h
  1302. u_voice dw u_base+102h
  1303. u_command dw u_base+103h
  1304. u_Datalo dw u_base+104h
  1305. u_Datahi dw u_base+105h
  1306. u_DramIO dw u_base+107h
  1307.  
  1308.  
  1309.  
  1310. oldUVolumes dw 01000h,0B000h,0B100h,0B200h,0B300h,0B400h,0B500h,0B600h,0B700h
  1311. dw 0B800h,0B900h,0BA00h,0BB00h,0BC00h,0BD00h,0BE00h,0BF00h
  1312. dw 0C000h,0C100h,0C200h,0C300h,0C400h,0C500h,0C600h,0C700h
  1313. dw 0C800h,0C900h,0CA00h,0CB00h,0CC00h,0CD00h,0CE00h,0CF00h
  1314. dw 0D000h,0D100h,0D200h,0D300h,0D400h,0D500h,0D600h,0D700h
  1315. dw 0D800h,0D900h,0DA00h,0DB00h,0DC00h,0DD00h,0DE00h,0DF00h
  1316. dw 0E000h,0E100h,0E200h,0E300h,0E400h,0E500h,0E600h,0E700h
  1317. dw 0E800h,0E900h,0EA00h,0EB00h,0EC00h,0ED00h,0EE00h,0EF00h
  1318.  
  1319.  
  1320. UVolumes DW 1500h
  1321. DW 40004,42600,44752,45648,46544,47624,48448,49232
  1322. DW 50048,50584,51112,51656,52184,52584,52976,53376
  1323. DW 53752,54016,54280,54520,54768,55024,55280,55544
  1324. DW 55776,56048,56288,56536,56784,56992,57184,57384
  1325. DW 57616,57752,57888,58000,58112,58248,58368,58480
  1326. DW 58600,58720,58840,58960,59088,59208,59336,59464
  1327. DW 59584,59720,59816,59944,60072,60176,60312,60408
  1328. DW 60544,60648,60784,60888,60992,61064,61176,61248
  1329.  
  1330.  
  1331. Voice_Divisor db 43,40,37,35,33,31,30,28,27,26,25,24,23,22,21,20,20,19,18
  1332.  
  1333. FFtable dw 66, 70, 74, 78, 83, 88, 93, 99, 104, 111
  1334. dw 117, 124, 132, 139, 148, 156, 166, 176, 186, 197
  1335. dw 209, 221, 234, 248, 263, 279, 295, 313, 331, 351
  1336. dw 372, 394, 418, 442, 469, 497, 526, 557, 591, 626
  1337. dw 663, 702, 744, 788, 835, 885, 938, 993, 1052, 1115
  1338. dw 1181, 1251, 1326, 1405, 1488, 1577, 1671, 1770, 1875, 1987
  1339. dw 2105, 2230, 2362, 2503, 2652, 2809, 2977, 3154, 3341, 3540
  1340.  
  1341.  
  1342. Modoktave dw 1712,1616,1525,1440,1359,1283,1211
  1343. dw 1143,1078,961,907,856,808,763,720
  1344. dw 679,641,605,571,539,509,480,453,428
  1345. dw 404,381,360,340,321,303,286,270,254
  1346. dw 240,227,214,202,191,180,170,160,151
  1347. dw 143,135, 127,120,113,107,101,95,90
  1348. dw 85,80,76,71,67,64,60,57,54,50,47,45
  1349. dw 42,40,38,36,34,32,30
  1350.  
  1351. public U_StartVoice
  1352. public u_VoiceBalance
  1353. public u_VoiceVolume
  1354. public u_delay
  1355. public u_Initialize
  1356. public u_Voicefreq
  1357. public Ultra_Mem2Gus
  1358. public u_Voicedata
  1359. public ffaktor
  1360. public Notennr
  1361. public dos_getmem
  1362. public dos_freemem
  1363. public detect_gus
  1364. public init_gus_base
  1365. public GusSound_ein
  1366. public GusSound_aus
  1367. public voice_rampin
  1368. public voice_slidein
  1369.  
  1370. u_delay proc pascal
  1371. ; **************************************************************************
  1372. ; *** Wartet die fr Double-writes ben”tigte Zeit ***
  1373. ; **************************************************************************
  1374. mov dx,300h
  1375. in al,dx
  1376. in al,dx
  1377. in al,dx
  1378. in al,dx
  1379. in al,dx
  1380. in al,dx
  1381. in al,dx
  1382. ret
  1383. u_delay endp
  1384.  
  1385. U_StartVoice proc pascal Nr,Modus : byte
  1386. ; **************************************************************************
  1387. ; *** Startet die Ausgabe auf einem GUS-Kanal ***
  1388. ; **************************************************************************
  1389. mov dx,w u_voice ; Stimme w„hlen
  1390. mov al,byte ptr Nr
  1391. out dx,al
  1392. mov dx,w u_command
  1393. mov al,0 ; Voice Mode
  1394. out dx,al
  1395. mov dx,w u_DataHi
  1396. mov al,Modus ; MODUS Byte setzen
  1397. out dx,al
  1398. ret
  1399. U_StartVoice endp
  1400.  
  1401. u_VoiceBalance proc pascal Nr,balance : byte
  1402. ; **************************************************************************
  1403. ; *** Stellt die Pan-Position fr einen Kanal ein (0 - 15) ***
  1404. ; **************************************************************************
  1405. mov dx,w u_Voice ; Stimme w„hlen
  1406. mov al,byte ptr Nr
  1407. out dx,al
  1408. mov dx,w u_Command ; Befehl Set Pan-Position
  1409. mov al,0Ch
  1410. out dx,al
  1411. mov dx,w u_dataHi ; Position schreiben
  1412. mov al,balance
  1413. out dx,al
  1414. ret
  1415. u_VoiceBalance endp
  1416.  
  1417. u_VoiceVolume proc pascal Nr:byte,Vol:word
  1418. ; **************************************************************************
  1419. ; *** Stellt die Lautst„rke fr einen Kanal ein (0 - 63) ***
  1420. ; **************************************************************************
  1421. mov dx,w u_Voice ; Stimme w„hlen
  1422. mov al,Nr
  1423. out dx,al
  1424. mov dx,w u_Command ; Befehl Lautst„rke setzen
  1425. mov al,9
  1426. out dx,al
  1427. mov dx,w u_DataLo ; GUS-Lautst„rke aus Tabelle laden
  1428. mov di,vol ; und setzen
  1429. shl di,1
  1430. mov ax,word ptr [offset uVolumes + di]
  1431. out dx,ax
  1432. ret
  1433. u_VoiceVolume endp
  1434.  
  1435. u_Initialize proc near
  1436. ; **************************************************************************
  1437. ; *** Initialisiert die Ultrasound ***
  1438. ; **************************************************************************
  1439. mov bx,w u_Command
  1440. mov cx,w u_datahi
  1441. mov dx,bx
  1442. mov al,4ch ; Init - Register w„hlen
  1443. out dx,al
  1444. mov dx,cx
  1445. mov al,0 ; Init durchfhren
  1446. out dx,al
  1447. call u_delay ; warten
  1448. call u_delay
  1449. mov dx,bx
  1450. mov al,4ch
  1451. out dx,al
  1452. mov dx,cx
  1453. mov al,1 ; Init beenden
  1454. out dx,al
  1455. call u_delay
  1456. call u_delay
  1457. mov dx,bx ; DMA Control Register resetten
  1458. mov al,41h
  1459. out dx,al
  1460. mov dx,cx
  1461. mov al,0
  1462. out dx,al
  1463. mov dx,bx ; Timer Control Register resetten
  1464. mov al,45h
  1465. out dx,al
  1466. mov dx,cx
  1467. mov al,0
  1468. out dx,al
  1469. mov dx,bx ; Sampling Control Register resetten
  1470. mov al,49h
  1471. out dx,al
  1472. mov dx,cx
  1473. mov al,0
  1474. out dx,al
  1475. mov dx,bx ; Anzahl Stimmen setzen
  1476. mov al,0Eh
  1477. out dx,al
  1478. add dx,2
  1479. mov al,Num_Voices
  1480. or al,0C0h
  1481. out dx,al
  1482. mov dx,w u_status ; Evtl. DMA Interrupts leeren
  1483. in al,dx
  1484. mov dx,bx
  1485. mov al,41h
  1486. out dx,al
  1487. mov dx,cx
  1488. in al,dx
  1489. mov dx,bx ; Evtl. Sampling Interrupts leeren
  1490. mov al,49h
  1491. out dx,al
  1492. mov dx,cx
  1493. in al,dx
  1494. mov dx,bx ; IRQ Status Register lesen
  1495. mov al,8Fh ; ==> Es liegen jetzt keine unbearbeiteten
  1496. out dx,al ; Interrupts an
  1497. mov dx,cx
  1498. in al,dx
  1499. push bx ; In Schleife die Stimmen ausschalten
  1500. push cx
  1501. mov cx,0
  1502. @VoiceClearLoop:
  1503. mov dx,w u_Voice ; Stimme w„hlen
  1504. mov al,cl
  1505. out dx,al
  1506. inc dx
  1507. mov al,0 ; Voice Modus setzen
  1508. out dx,al
  1509. add dx,2
  1510. mov al,3 ; Stimme stoppen
  1511. out dx,al
  1512. sub dx,2 ; Lautst„rke auf 0 setzen
  1513. mov al,0dh
  1514. out dx,al
  1515. add dx,2
  1516. mov al,3
  1517. out dx,al
  1518. inc cx
  1519. cmp cx,32 ; fr alle Stimmen wiederholen
  1520. jnz @VoiceClearLoop
  1521. pop cx
  1522. pop bx
  1523. mov dx,bx ; Eventuell aufgetretene Interrupts
  1524. mov al,41h ; "abarbeiten"
  1525. out dx,al
  1526. mov dx,cx
  1527. in al,dx
  1528. mov dx,bx
  1529. mov al,49h
  1530. out dx,al
  1531. mov dx,cx
  1532. in al,dx
  1533. mov dx,bx
  1534. mov al,8fh
  1535. out dx,al
  1536. mov dx,cx
  1537. in al,dx
  1538. mov dx,bx ; Reset durchfhren
  1539. mov al,4ch
  1540. out dx,al
  1541. mov dx,cx ; GF1 Master IRQ einschalten
  1542. mov al,7
  1543. out dx,al
  1544. ret
  1545. u_Initialize endp
  1546.  
  1547. u_Voicefreq proc pascal Nr:byte,Freq:word
  1548. ; **************************************************************************
  1549. ; *** Stellt die Frequenz ein, mit der der Kanal abgespielt wird ***
  1550. ; **************************************************************************
  1551. mov dx,w u_Voice ; Stimme adressieren
  1552. mov al,Nr
  1553. out dx,al
  1554. mov dx,w u_Command ; Befehl Voicefreqenz schreiben
  1555. mov al,1
  1556. out dx,al ; Freq := Freqenz DIV
  1557. xor bx,bx ; Voice_Divisor[num_voices-13]
  1558. mov bl,num_voices
  1559. mov ax,Freq
  1560. ; mov di,bx
  1561. ; sub di,14
  1562. ; xor bx,bx
  1563. ; xor dx,dx
  1564. ; mov bl,byte ptr [voice_Divisor+di]
  1565. ; div bx
  1566. mov dx,w u_DataLo
  1567. out dx,ax
  1568. ret
  1569. u_Voicefreq endp
  1570.  
  1571.  
  1572. Ultra_Mem2Gus proc pascal sampp:dword,start:dword,laenge:word
  1573. ; **************************************************************************
  1574. ; *** Kopiert einen Speicherbereich aus dem RAM ins GUS-Ram ***
  1575. ; **************************************************************************
  1576. push ds
  1577. push si
  1578. mov si,[bp+12] ; Segment
  1579. mov ds,si
  1580. mov si,[bp+10] ; Offset
  1581. mov dx,w u_Command ; Hi-Byte der GUS-DRAM Adresse setzen
  1582. mov al,44h
  1583. out dx,al
  1584. mov dx,w u_DataHi
  1585. mov ax,[bp+08] ; hstart
  1586. out dx,al
  1587. mov cx,[bp+4] ; L„nge laden
  1588. @Copy_loop:
  1589. mov dx,w u_Command ; Lo-Byte der GUS-DRAM Adresse setzen
  1590. mov al,43h
  1591. out dx,al
  1592. mov dx,w u_DataLo
  1593. mov ax,[bp+06] ; lstart
  1594. out dx,ax
  1595. mov dx,w u_DramIo ; Byte laden und ausgeben
  1596. lodsb
  1597. out dx,al
  1598. cmp word ptr [bp+06],0ffffh ; lstart = 0ffffh ?
  1599. je @ueberlauf
  1600. inc word ptr [bp+06] ; lstart++
  1601. jmp @weiter
  1602. @ueberlauf:
  1603. inc word ptr [bp+08] ; hstart ++
  1604. mov word ptr [bp+06],0 ; lstart auf 0
  1605. mov dx,w u_Command ; Hi-Byte der GUS-DRAM Adresse setzen
  1606. mov al,44h
  1607. out dx,al
  1608. mov dx,w u_DataHi
  1609. mov ax,[bp+08] ; hstart
  1610. out dx,al
  1611. @weiter:
  1612. loop @copy_loop
  1613. pop si
  1614. pop ds
  1615. ret
  1616. Ultra_Mem2Gus endp
  1617.  
  1618. u_Voicedata proc pascal start,lsta,llaenge:dword,Nr:word
  1619. ; **************************************************************************
  1620. ; *** Setzt die Partameter fr einen Kanal ***
  1621. ; **************************************************************************
  1622. mov dx,w u_Voice ; Stimme w„hlen
  1623. mov ax,Nr
  1624. out dx,al
  1625. mov dx,w u_command ; Stimmenanfang setzen
  1626. mov al,0ah
  1627. out dx,al
  1628. mov ax, word ptr [start+2]
  1629. mov cx, word ptr [start]
  1630. mov bx,cx
  1631. shr ax,7
  1632. shr cx,7
  1633. shl bx,9
  1634. or ax,bx
  1635. mov dx,w u_DataLo
  1636. out dx,ax
  1637. mov dx,w u_Command
  1638. mov al,0bh
  1639. out dx,al
  1640. mov dx,w u_datalo
  1641. mov ax,word ptr [start]
  1642. shl ax,9
  1643. out dx,ax
  1644. mov dx,w u_command ; Loop-Start setzen
  1645. mov al,2
  1646. out dx,al
  1647. mov ax, word ptr [lsta]
  1648. mov cx, word ptr [lsta+2]
  1649. mov bx,cx
  1650. shr ax,7
  1651. shr cx,7
  1652. shl bx,9
  1653. or ax,bx
  1654. mov dx,w u_DataLo
  1655. out dx,ax
  1656. mov dx,w u_Command
  1657. mov al,3
  1658. out dx,al
  1659. mov dx,w u_datalo
  1660. mov ax,word ptr [lsta]
  1661. shl ax,9
  1662. out dx,ax
  1663. mov dx,w u_command ; Loop-Ende setzen
  1664. mov al,4
  1665. out dx,al
  1666. mov ax, word ptr [llaenge]
  1667. mov cx, word ptr [llaenge+2]
  1668. mov bx,cx
  1669. shr ax,7
  1670. shr cx,7
  1671. shl bx,9
  1672. or ax,bx
  1673. mov dx,w u_DataLo
  1674. out dx,ax
  1675. mov dx,w u_Command
  1676. mov al,5
  1677. out dx,al
  1678. mov dx,w u_datalo
  1679. mov ax,word ptr [llaenge]
  1680. shl ax,9
  1681. out dx,ax
  1682. ret
  1683. u_Voicedata endp
  1684.  
  1685. ffaktor proc pascal t:word
  1686. ; **************************************************************************
  1687. ; *** Liefert die Frequenz des in "t" bergebenen Tons ***
  1688. ; **************************************************************************
  1689. mov di,t
  1690. sub di,5
  1691. shl di,1
  1692. mov ax,word ptr [offset fftable+di]
  1693. ret
  1694. ffaktor endp
  1695.  
  1696. Notennr proc pascal hoehe:word
  1697. ; **************************************************************************
  1698. ; *** Bestimmt die Nummer der Note ber die "hoehe" des Tons aus der ***
  1699. ; *** MOD-Datei ***
  1700. ; **************************************************************************
  1701. mov gefunden,1
  1702. xor di,di
  1703. @schleife:
  1704. mov ax,word ptr Modoktave[di]
  1705. cmp hoehe,ax
  1706. ja note_gefunden
  1707. add di,2
  1708. ; cmp di,128
  1709. cmp di,140
  1710. jae @weiter_arbeiten
  1711. jmp @schleife
  1712. note_gefunden:
  1713. mov gefunden,0
  1714. @weiter_arbeiten:
  1715. mov ax,255
  1716. cmp gefunden,0
  1717. jne Ende_Notennr
  1718. mov ax,di
  1719. shr ax,1
  1720. inc ax
  1721. Ende_Notennr:
  1722. ret
  1723. Notennr endp
  1724.  
  1725. dos_getmem proc pascal zeiger:dword,menge:word
  1726. ; **************************************************************************
  1727. ; *** Allociert einen (max. 64 KB grosen) Speicherbereich im DOS-Ram ***
  1728. ; **************************************************************************
  1729. push ds
  1730. mov bx,menge
  1731. shr bx,4
  1732. inc bx
  1733. mov ah,48h
  1734. int 21h
  1735. mov bx,w [zeiger+2]
  1736. mov ds,bx
  1737. mov bx,w [zeiger]
  1738. mov w [bx],0
  1739. mov w [bx+2],ax
  1740. pop ds
  1741. ret
  1742. dos_getmem endp
  1743.  
  1744. dos_freemem proc pascal zeiger:dword
  1745. ; **************************************************************************
  1746. ; *** Gibt einen ber dos_getmem allocierten Bereich wieder frei ***
  1747. ; **************************************************************************
  1748. mov ax,word ptr [zeiger+2]
  1749. mov es,ax
  1750. mov ah,49h
  1751. int 21h
  1752. ret
  1753. dos_freemem endp
  1754.  
  1755. detect_gus proc near
  1756. ; **************************************************************************
  1757. ; *** Die Routine dient zur Erkennung der Gravis Ultrasound. Der Base- ***
  1758. ; *** Port wird erkannt. Die Funktion liefert 0, wenn die Karte gefunden ***
  1759. ; *** wurde, ansonsten 1. ***
  1760. ; **************************************************************************
  1761. mov di,1F0h
  1762. @detect_loop: ; In einer Schleife m”gliche Ports testen
  1763. add di,10h
  1764. mov dx,di
  1765. add dx,103h ; Initialisierung versuchen
  1766. mov al,4Ch
  1767. out dx,al
  1768. mov dx,di
  1769. add dx,105h
  1770. mov al,0
  1771. out dx,al ;?????
  1772. call u_delay
  1773. call u_delay
  1774. mov dx,di
  1775. add dx,103h
  1776. mov al,4Ch
  1777. out dx,al
  1778. mov dx,di
  1779. add dx,105h
  1780. mov al,1
  1781. out dx,al ;????
  1782. mov dx,di ; Versuchen, Daten in das GUS-Ram zu
  1783. add dx,103h ; schreiben
  1784. mov al,43h
  1785. out dx,al
  1786. mov dx,di
  1787. add dx,105h
  1788. mov al,0h
  1789. out dx,al
  1790. mov dx,di
  1791. add dx,103h
  1792. mov al,44h
  1793. out dx,al
  1794. mov dx,di
  1795. add dx,105h
  1796. mov al,0h
  1797. out dx,al
  1798. mov dx,di
  1799. add dx,107h
  1800. mov al,0AAh
  1801. out dx,al
  1802. call u_delay ; entsprechend warten, damit uns der GF1
  1803. call u_delay ; nicht dazwischen pfuschen kann
  1804. call u_delay
  1805. call u_delay
  1806. call u_delay
  1807. call u_delay
  1808. xor ax,ax ; Wert aus GUS-Ram zurcklesen
  1809. mov dx,di
  1810. add dx,107h
  1811. in al,dx
  1812. cmp al,0AAh ; Gelesener Wert = geschriebenem Wert ?
  1813. je @Karte_gefunden ; Juhuuuu, Karte gefunden !
  1814. cmp di,280h
  1815. jae @Karte_nicht_gefunden ; Keine Karte an den Ports zu finden :(
  1816. jmp @detect_loop ; Neuen Port versuchen
  1817. @Karte_gefunden:
  1818. mov w u_base,di ; Basisregister der Karte initialisieren
  1819. mov ax,di
  1820. add ax,6
  1821. mov w u_status,ax
  1822. mov ax,di
  1823. add ax,102h
  1824. mov w u_voice,ax
  1825. mov ax,di
  1826. add ax,103h
  1827. mov w u_command,ax
  1828. mov ax,di
  1829. add ax,104h
  1830. mov w u_Datalo,ax
  1831. mov ax,di
  1832. add ax,105h
  1833. mov w u_Datahi,ax
  1834. mov ax,di
  1835. add ax,107h
  1836. mov w u_DramIO,ax
  1837. mov ax,0
  1838. jmp @Ende_Kartenerkennung
  1839. @Karte_nicht_gefunden:
  1840. mov ax,1
  1841. @Ende_Kartenerkennung:
  1842. ret
  1843. detect_gus endp
  1844.  
  1845. init_gus_base proc pascal gbase : word;
  1846. ; **************************************************************************
  1847. ; *** Die Routine dient zur Erkennung der Gravis Ultrasound. Der Base- ***
  1848. ; *** Port wird erkannt. Die Funktion liefert 0, wenn die Karte gefunden ***
  1849. ; *** wurde, ansonsten 1. ***
  1850. ; **************************************************************************
  1851. mov di,gbase
  1852. mov dx,di
  1853. add dx,103h ; Initialisierung versuchen
  1854. mov al,4Ch
  1855. out dx,al
  1856. mov dx,di
  1857. add dx,105h
  1858. mov al,0
  1859. out dx,al ;?????
  1860. call u_delay
  1861. call u_delay
  1862. mov dx,di
  1863. add dx,103h
  1864. mov al,4Ch
  1865. out dx,al
  1866. mov dx,di
  1867. add dx,105h
  1868. mov al,1
  1869. out dx,al ;????
  1870.  
  1871. mov w u_base,di ; Basisregister der Karte initialisieren
  1872. mov ax,di
  1873. add ax,6
  1874. mov w u_status,ax
  1875. mov ax,di
  1876. add ax,102h
  1877. mov w u_voice,ax
  1878. mov ax,di
  1879. add ax,103h
  1880. mov w u_command,ax
  1881. mov ax,di
  1882. add ax,104h
  1883. mov w u_Datalo,ax
  1884. mov ax,di
  1885. add ax,105h
  1886. mov w u_Datahi,ax
  1887. mov ax,di
  1888. add ax,107h
  1889. mov w u_DramIO,ax
  1890. mov ax,0
  1891. ret
  1892. init_gus_base endp
  1893.  
  1894.  
  1895. GusSound_aus proc near
  1896. ; **************************************************************************
  1897. ; *** Schaltet die Sound-Ausgabe der GUS aus ***
  1898. ; **************************************************************************
  1899. mov dx,w u_base
  1900. in al,dx
  1901. or al,2
  1902. out dx,al
  1903. ret
  1904. GusSound_aus endp
  1905.  
  1906. GusSound_ein proc near
  1907. ; **************************************************************************
  1908. ; *** Schaltet die Sound-Ausgabe (Wavetabel) der GUS ein. ***
  1909. ; **************************************************************************
  1910. mov dx,w u_base
  1911. in al,dx
  1912. and al,0FDh
  1913. out dx,al
  1914. ret
  1915. GusSound_ein endp
  1916.  
  1917. voice_rampin proc pascal Stimme:byte,vol : word;
  1918. ; **************************************************************************
  1919. ; *** Eine Alternative zum dirketen Setzen der Lautst„rke einer Stimme. ***
  1920. ; *** Der Player verliert etwas an Agressivit„t, jedoch wird evtl. ***
  1921. ; *** Knacken erheblich reduziert. ***
  1922. ; **************************************************************************
  1923. mov dx,w u_voice ; Stimme w„hlen
  1924. mov al,byte ptr Stimme
  1925. out dx,al
  1926. mov dx,w u_command ; Ramping-Faktor setzen
  1927. mov al,6
  1928. out dx,al
  1929. mov dx,w u_datahi
  1930. mov al,00111111b
  1931. out dx,al
  1932. mov dx,w u_Command ; Aktuelle Lautst„rke anpassen
  1933. mov al,9
  1934. out dx,al
  1935. mov dx,w u_datahi
  1936. mov al,00010010b
  1937. out dx,al
  1938. mov dx,w u_command ; Ramping Start-Lautst„rke setzen
  1939. mov al,7
  1940. out dx,al
  1941. mov dx,w u_datahi
  1942. mov al,00010010b
  1943. out dx,al
  1944. mov dx,w u_command ; Ramping End-Lautst„rke setzen
  1945. mov al,8
  1946. out dx,al
  1947. mov dx,w u_datahi
  1948. mov di,word ptr vol
  1949. shl di,1
  1950. mov ax,word ptr [offset uVolumes + di]
  1951. shr ax,8
  1952. out dx,al
  1953. mov dx,w u_command ; Ramping Richtung im Volume Control
  1954. mov al,0dh ; Register setzen
  1955. out dx,al
  1956. mov dx,w u_datahi
  1957. mov al,0
  1958. out dx,al
  1959. ret
  1960. voice_rampin endp
  1961.  
  1962. voice_slidein proc pascal nr,speed : byte,vol : word;
  1963. mov dx,w u_voice ; Stimme w„hlen
  1964. mov al,byte ptr nr
  1965. out dx,al
  1966. mov dx,w u_command ; Ramping-Faktor setzen
  1967. mov al,6
  1968. out dx,al
  1969. mov dx,w u_datahi
  1970. mov al,byte ptr speed
  1971. out dx,al
  1972. mov dx,w u_Command ; Aktuelle Lautst„rke anpassen
  1973. mov al,9
  1974. out dx,al
  1975. mov dx,w u_datahi
  1976. mov al,00010010b
  1977. out dx,al
  1978. mov dx,w u_command ; Ramping Start-Lautst„rke setzen
  1979. mov al,7
  1980. out dx,al
  1981. mov dx,w u_datahi
  1982. mov al,00010010b
  1983. out dx,al
  1984. mov dx,w u_command ; Ramping End-Lautst„rke setzen
  1985. mov al,8
  1986. out dx,al
  1987. mov dx,w u_datahi
  1988. mov di,word ptr vol
  1989. shl di,1
  1990. mov ax,word ptr [offset uVolumes + di]
  1991. shr ax,8
  1992. out dx,al
  1993. mov dx,w u_command ; Ramping Richtung im Volume Control
  1994. mov al,0dh ; Register setzen
  1995. out dx,al
  1996. mov dx,w u_datahi
  1997. mov al,0
  1998. out dx,al
  1999. ret
  2000. voice_slidein endp
  2001.  
  2002. public gus_speaker_on
  2003. gus_speaker_on proc pascal
  2004. mov dx,u_base
  2005. mov al,4
  2006. out dx,al
  2007. ret
  2008. gus_speaker_on endp
  2009.  
  2010. public get_stimmenposition
  2011. get_stimmenposition proc pascal stimme : word
  2012. mov dx,w u_command
  2013. mov al,4
  2014. out dx,al
  2015. mov dx,w u_datahi
  2016. in ax,dx
  2017. mov cx,ax
  2018.  
  2019. ret
  2020. get_stimmenposition endp
  2021.  
  2022. public get_detected_base
  2023. get_detected_base proc pascal
  2024. mov ax,u_base
  2025. ret
  2026. get_detected_base endp
  2027.  
  2028. code ends
  2029. end
  2030.  
  2031. unit design;
  2032.  
  2033. interface
  2034. uses crt,windos;
  2035.  
  2036. procedure writexy(x,y : integer;s : string);
  2037. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  2038. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  2039. function wrhexb(b : byte) : string;
  2040. function wrhexw(w : word) : string;
  2041. procedure save_screen;
  2042. procedure restore_screen;
  2043. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  2044. procedure cursor_On;
  2045. procedure cursor_Off;
  2046.  
  2047. var filenames : array[1..512] of string[12];
  2048. const Screen_Akt : byte = 1;
  2049.  
  2050.  
  2051. implementation
  2052.  
  2053. procedure writexy(x,y : integer;s : string);
  2054. begin;
  2055. gotoxy(x,y);
  2056. write(s);
  2057. end;
  2058.  
  2059. procedure save_screen;
  2060. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  2061. begin;
  2062. if Screen_Akt <= 4 then begin;
  2063. inc(Screen_Akt);
  2064. move(screen[1],screen[Screen_Akt],8000);
  2065. end;
  2066. end;
  2067.  
  2068. procedure restore_screen;
  2069. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  2070. begin;
  2071. if Screen_Akt >= 2 then begin;
  2072. move(screen[Screen_Akt],screen[1],8000);
  2073. dec(Screen_Akt);
  2074. end;
  2075. end;
  2076.  
  2077. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  2078. const frames : array[1..2,1..6] of char =
  2079. (('Ú','¿','Ù','À','Ä','³'),
  2080. ('É','»','¼','È','Í','º'));
  2081. var lx,ly : integer;
  2082. s : string;
  2083. begin;
  2084. { obere Zeile }
  2085. s := frames[rt,1];
  2086. for lx := 1 to dx-2 do s := s + frames[rt,5];
  2087. s := s + frames[rt,2];
  2088. gotoxy(startx,starty);
  2089. write(s);
  2090. { mittleren Zeilen }
  2091. for ly := 1 to dy-2 do begin;
  2092. s := frames[rt,6];
  2093. for lx := 1 to dx-2 do s := s + ' ';
  2094. s := s + frames[rt,6];
  2095. gotoxy(startx,starty+ly);
  2096. write(s);
  2097. end;
  2098. { untere Zeile }
  2099. s := frames[rt,4];
  2100. for lx := 1 to dx-2 do s := s + frames[rt,5];
  2101. s := s + frames[rt,3];
  2102. gotoxy(startx,starty+dy-1);
  2103. write(s);
  2104. end;
  2105.  
  2106. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  2107. var tlaeng : byte;
  2108. deltx,tstartpos : byte;
  2109. begin;
  2110. tlaeng := length(s);
  2111. tstartpos := x + ((dx-Tlaeng) SHR 1);
  2112. textcolor(rcol);
  2113. textbackground(bcol);
  2114. rahmen(1,x,y,dx,dy);
  2115. writexy(tstartpos,y,s);
  2116. end;
  2117.  
  2118. procedure sort_filenames(start,ende : integer);
  2119. {
  2120. Hier sollte fr gr”áere Verzeichnise Quick-Sort eingebaut werden !
  2121. }
  2122. var hilfe : string;
  2123. l1,l2 : integer;
  2124. begin;
  2125. for l1 := start to ende-1 do begin;
  2126. for l2 := start to ende-1 do begin;
  2127. if filenames[l2] > filenames[l2+1] then begin;
  2128. hilfe := filenames[l2];
  2129. filenames[l2] := filenames[l2+1];
  2130. filenames[l2+1] := hilfe;
  2131. end;
  2132. end;
  2133. end;
  2134. end;
  2135.  
  2136. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  2137. const zeile : byte = 1;
  2138. spalte : byte = 0;
  2139. Start_fndisp : word = 0;
  2140. var
  2141. DirInfo: TSearchRec;
  2142. count : integer;
  2143. Nullpos : byte;
  2144. var li,lj : integer;
  2145. inp : char;
  2146. retval : string;
  2147. kasten_gefunden : boolean;
  2148. select : byte;
  2149. changed : boolean;
  2150. End_fndisp : word;
  2151. begin
  2152. {$I+}
  2153. for li := 1 to 512 do filenames[li] := ' - - -';
  2154. count := 1;
  2155. FindFirst(mask, faArchive, DirInfo);
  2156. while DosError = 0 do
  2157. begin
  2158. filenames[count] := (DirInfo.Name);
  2159. Nullpos := pos(#0,filenames[count]);
  2160. if Nullpos <> 0 then
  2161. filenames[count] := copy(filenames[count],0,Nullpos-1);
  2162. inc(count);
  2163. FindNext(DirInfo);
  2164. end;
  2165. {$I-}
  2166.  
  2167. sort_filenames(1,count-1);
  2168. save_screen;
  2169. Fenster(5,4,72,16,comment,black,7);
  2170. textcolor(1);
  2171. writexy(21,5,' Bitte Datei ausw„hlen');
  2172. textcolor(black);
  2173. inp := #255;
  2174. changed := true;
  2175. repeat
  2176. textcolor(black);
  2177. if changed then begin;
  2178. changed := false;
  2179. for lj := 0 to 4 do begin;
  2180. for li := 1 to 12 do begin;
  2181. writexy(7+lj*14,5+li,' ');
  2182. writexy(7+lj*14,5+li,filenames[lj*12+li+Start_fndisp]);
  2183. end;
  2184. end;
  2185. textcolor(14);
  2186. writexy(7+Spalte*14,5+Zeile,filenames[Spalte*12+Zeile+Start_fndisp]);
  2187. end;
  2188. if keypressed then inp := readkey;
  2189. if ord(inp) = 0 then inp := readkey;
  2190. case ord(inp) of
  2191. 32,
  2192. 13: begin;
  2193. inp := #13;
  2194. changed := true;
  2195. if (pos('- - -',filenames[Spalte*12+Zeile+Start_fndisp]) = 0) then
  2196. retval := filenames[Spalte*12+Zeile+Start_fndisp]
  2197. else
  2198. retval := 'xxxx';
  2199. end;
  2200. 27: begin;
  2201. inp := #27;
  2202. changed := true;
  2203. retval := 'xxxx';
  2204. end;
  2205. 71: begin; { Pos 1 }
  2206. inp := #255;
  2207. Zeile := 1;
  2208. Spalte := 0;
  2209. changed := true;
  2210. end;
  2211. 72: begin; { Pfeil up }
  2212. inp := #255;
  2213. changed := true;
  2214. if not ((Zeile = 1) and (Spalte = 0)) then
  2215. dec(Zeile);
  2216. if Zeile = 0 then begin;
  2217. dec(Spalte);
  2218. Zeile := 12;
  2219. end;
  2220. end;
  2221. 73: begin; { Page UP }
  2222. if Start_fndisp >= 12 then
  2223. dec(Start_fndisp,12)
  2224. else begin;
  2225. Start_fndisp := 0;
  2226. Zeile := 1;
  2227. end;
  2228. inp := #255;
  2229. changed := true;
  2230. end;
  2231. 81: begin; { Page Down }
  2232. if ((Spalte+1)*12+Start_fndisp < count) and
  2233. (Start_fndisp < 500) then
  2234. inc(Start_fndisp,12)
  2235. else
  2236. Start_fndisp := count-11;
  2237. inp := #255;
  2238. changed := true;
  2239. end;
  2240. 75: begin; { Pfeil links }
  2241. inp := #255;
  2242. changed := true;
  2243. if Spalte = 0 then begin;
  2244. if Start_fndisp >= 12 then dec(Start_fndisp,12);
  2245. end else begin;
  2246. if Spalte > 0 then dec(Spalte);
  2247. end;
  2248. end;
  2249. 77: begin; { Pfeil rechts }
  2250. inp := #255;
  2251. changed := true;
  2252. if Spalte = 4 then begin;
  2253. if ((Spalte+1)*12+Start_fndisp < count) and
  2254. (Start_fndisp < 500) then inc(Start_fndisp,12);
  2255. end else begin;
  2256. if (Spalte < 4) and
  2257. (Zeile+(Spalte+1)*12+Start_fndisp < count) then
  2258. inc(Spalte);
  2259. end;
  2260. end;
  2261. 79: begin; { End }
  2262. inp := #255;
  2263. changed := true;
  2264. Spalte := (count-Start_fndisp-12) div 12;
  2265. Zeile := (count-Start_fndisp) - Spalte*12 -1;
  2266. end;
  2267. 80: begin; { Pfeil down }
  2268. inp := #255;
  2269. changed := true;
  2270. if ((Zeile = 12) and (Spalte = 4)) then begin;
  2271. if (Start_fndisp+Zeile+Spalte*12 < count-1) then begin;
  2272. inc(Start_fndisp,1);
  2273. end;
  2274. end else begin;
  2275. if (Start_fndisp+Zeile+Spalte*12 < count-1) then
  2276. inc(Zeile);
  2277. end;
  2278. if Zeile > 12 then begin;
  2279. inc(Spalte);
  2280. Zeile := 1;
  2281. end;
  2282. end;
  2283. 82 : begin;
  2284. changed := true;
  2285. save_screen;
  2286. textcolor(black);
  2287. rahmen(2,16,9,45,5);
  2288. writexy(20,10,' Dateinamen eingeben ('+mtext+')');
  2289. writexy(20,12,'Name: ');
  2290. readln(retval);
  2291. if retval = '' then retval := 'xxxx';
  2292. restore_screen;
  2293. end;
  2294. end;
  2295. until (inp = #13) or (inp = #27) or (inp = #32)
  2296. or (inp = #82);
  2297. restore_screen;
  2298. textbackground(black);
  2299. textcolor(7);
  2300. select_datei := retval;
  2301. end;
  2302.  
  2303. function wrhexb(b : byte) : string;
  2304. const hexcar : array[0..15] of char =
  2305. ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  2306. begin;
  2307. wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
  2308. end;
  2309.  
  2310. function wrhexw(w : word) : string;
  2311. begin;
  2312. wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
  2313. end;
  2314.  
  2315. procedure cursor_Off; assembler;
  2316. asm
  2317. xor ax,ax
  2318. mov ah,01h
  2319. mov cx,2020h
  2320. int 10h
  2321. end;
  2322.  
  2323. procedure cursor_on; assembler;
  2324. asm
  2325. mov ah,01h
  2326. mov cx,0607h
  2327. int 10h
  2328. end;
  2329.  
  2330.  
  2331.  
  2332. begin;
  2333. end.unit fselect;
  2334.  
  2335. interface
  2336.  
  2337. type
  2338. t = record
  2339. c : char;
  2340. a : byte;
  2341. end;
  2342.  
  2343. Pfileselect_struct = ^Tfileselect_struct;
  2344. Tfileselect_struct = record
  2345. sx,sy : integer;
  2346. Path : string;
  2347. Mask : string;
  2348. Tietel : string[25];
  2349. fn : array[1..30] of string [80];
  2350. nofiles : integer;
  2351. end;
  2352.  
  2353. Pdateilist = ^Tdateilist;
  2354. TDateilist = array[0..511] of string[12];
  2355.  
  2356. Ppfadliste = ^Tpfadliste;
  2357. TPfadliste = array[0..511] of string[80];
  2358.  
  2359. Psizeliste = ^Tsizeliste;
  2360. Tsizeliste = array[0..511] of longint;
  2361.  
  2362. Pselectliste = ^Tselectliste;
  2363. Tselectliste = array[0..511] of boolean;
  2364.  
  2365. PAttribliste = ^TAttribliste;
  2366. Tattribliste = array[0..511] of byte;
  2367.  
  2368.  
  2369. procedure select_packdateien(fs : Pfileselect_struct);
  2370. procedure display_ansi(p :pointer; mode : word);
  2371.  
  2372. var screen : array[1..50,1..80] of t absolute $B800:$0000;
  2373.  
  2374. implementation
  2375.  
  2376. uses dos,design,crt;
  2377.  
  2378. var fnames : PDateilist;
  2379. fpfad : PPfadliste;
  2380. fsize : PSizeliste;
  2381. fselected : PSelectliste;
  2382. fattrib : PAttribliste;
  2383.  
  2384. dnames : PDateilist;
  2385. dsize : PSizeliste;
  2386. dselected : PSelectliste;
  2387. dattrib : PAttribliste;
  2388.  
  2389. Start_Anzeige : integer;
  2390. Cursor_Zeile : integer;
  2391. selectcount : word;
  2392. bytes_selected : longint;
  2393.  
  2394. var DirInfo: SearchRec;
  2395. li : integer;
  2396. count,
  2397. fcount,
  2398. dcount: integer;
  2399. Nullpos : byte;
  2400. ch : char;
  2401. fscount : integer;
  2402. curdir : string;
  2403. savepath : string;
  2404. marker : pointer;
  2405.  
  2406.  
  2407. {$L Fsel }
  2408. procedure fsel; external;
  2409.  
  2410. procedure waitretrace;
  2411. begin;
  2412. asm
  2413. MOV DX,03dAh
  2414. @WD_R:
  2415. IN AL,DX
  2416. TEST AL,8d
  2417. JZ @WD_R
  2418. @WD_D:
  2419. IN AL,DX
  2420. TEST AL,8d
  2421. JNZ @WD_D
  2422. end;
  2423. end;
  2424.  
  2425. procedure display_ansi(p :pointer; mode : word);
  2426. begin;
  2427. textmode(mode);
  2428. move(p^,ptr($b800,0)^,8000);
  2429. end;
  2430.  
  2431.  
  2432. procedure sort_filenames(start,ende : integer);
  2433. {
  2434. Hier sollte fr gr”áere Verzeichnise Quick-Sort eingebaut werden !
  2435. }
  2436. var hilfe : string;
  2437. hsize : longint;
  2438. l1,l2 : integer;
  2439. begin;
  2440. for l1 := start to ende-1 do begin;
  2441. for l2 := start to ende-1 do begin;
  2442. if fnames^[l2] > fnames^[l2+1] then begin;
  2443. hilfe := fnames^[l2];
  2444. fnames^[l2] := fnames^[l2+1];
  2445. fnames^[l2+1] := hilfe;
  2446.  
  2447. hsize := fsize^[l2];
  2448. fsize^[l2] := fsize^[l2+1];
  2449. fsize^[l2+1] := hsize;
  2450.  
  2451. hsize := fattrib^[l2];
  2452. fattrib^[l2] := fattrib^[l2+1];
  2453. fattrib^[l2+1] := hsize;
  2454. end;
  2455. end;
  2456. end;
  2457. end;
  2458.  
  2459.  
  2460. procedure sort_dirnames(start,ende : integer);
  2461. {
  2462. Hier sollte fr gr”áere Verzeichnise Quick-Sort eingebaut werden !
  2463. }
  2464. var hilfe : string;
  2465. hsize : longint;
  2466. l1,l2 : integer;
  2467. begin;
  2468. for l1 := start to ende-1 do begin;
  2469. for l2 := start to ende-1 do begin;
  2470. if dnames^[l2] > dnames^[l2+1] then begin;
  2471. hilfe := dnames^[l2];
  2472. dnames^[l2] := dnames^[l2+1];
  2473. dnames^[l2+1] := hilfe;
  2474.  
  2475. hsize := dsize^[l2];
  2476. dsize^[l2] := dsize^[l2+1];
  2477. dsize^[l2+1] := hsize;
  2478.  
  2479. hsize := dattrib^[l2];
  2480. dattrib^[l2] := dattrib^[l2+1];
  2481. dattrib^[l2+1] := hsize;
  2482. end;
  2483. end;
  2484. end;
  2485. end;
  2486.  
  2487.  
  2488. procedure draw_files(sx,sy : integer; fs : Pfileselect_struct);
  2489. var li : integer;
  2490. begin;
  2491. waitretrace;
  2492.  
  2493. textcolor(7);
  2494. textbackground(black);
  2495. for li := 1 to 11 do begin;
  2496. fillchar(screen[sy+li,20].c,100,0);
  2497. gotoxy(sx+2,sy+li);
  2498. if fselected^[Start_Anzeige+li] then begin;
  2499. write('û ');
  2500. end else begin;
  2501. write(' ');
  2502. end;
  2503. write(fnames^[Start_Anzeige+li]);
  2504. while wherex < sx+2+16 do write(' ');
  2505. if (fattrib^[Start_Anzeige+li] and $10) = $10 then begin;
  2506. write(' DIR ');
  2507. end else begin;
  2508. write(fsize^[Start_Anzeige+li]:7,' Bytes');
  2509. end;
  2510. end;
  2511.  
  2512. move(marker^,screen[sy+Cursor_Zeile,20].c,100);
  2513.  
  2514. textcolor(5); textbackground(black);
  2515. gotoxy(sx+2,sy+Cursor_Zeile);
  2516. if fselected^[Start_Anzeige+Cursor_Zeile] then begin;
  2517. write('û ');
  2518. end else begin;
  2519. write(' ');
  2520. end;
  2521. write(fnames^[Start_Anzeige+Cursor_Zeile]);
  2522. while wherex < sx+2+16 do write(' ');
  2523. if (fattrib^[Start_Anzeige+Cursor_Zeile] and $10) = $10 then begin;
  2524. write(' DIR ');
  2525. end else begin;
  2526. write(fsize^[Start_Anzeige+Cursor_Zeile]:7,' Bytes');
  2527. end;
  2528. end;
  2529.  
  2530. procedure append_dirnames(anzahl : word);
  2531. var li : integer;
  2532. begin;
  2533. for li := 1 to anzahl do begin;
  2534. fnames^[fcount+li-1] := dnames^[li];
  2535. fsize^[fcount+li-1] := dsize^[li];
  2536. fattrib^[fcount+li-1] := dattrib^[li];
  2537. end;
  2538. end;
  2539.  
  2540.  
  2541. procedure read_directory(fs : Pfileselect_struct);
  2542. var curpath : string;
  2543. begin;
  2544. {$I+}
  2545. for li := 0 to 511 do fnames^[li] := ' - - -';
  2546. for li := 0 to 511 do fsize^[li] := 0;
  2547. for li := 0 to 511 do fattrib^[li] := 0;
  2548. for li := 0 to 511 do dattrib^[li] := 0;
  2549. for li := 0 to 511 do dnames^[li] := ' - - -';
  2550. for li := 0 to 511 do dsize^[li] := 0;
  2551.  
  2552. fcount := 1;
  2553. dcount := 1;
  2554.  
  2555. FindFirst(fs^.mask,255, DirInfo);
  2556. while DosError = 0 do
  2557. begin
  2558. if ((DirInfo.attr and $10) = $10) then begin;
  2559. dattrib^[dcount] := DirInfo.attr;
  2560. dnames^[dcount] := DirInfo.Name;
  2561. dsize^[dcount] := DirInfo.size;
  2562. Nullpos := pos(#0,dnames^[dcount]);
  2563. if Nullpos <> 0 then
  2564. dnames^[dcount] := copy(dnames^[dcount],0,Nullpos-1);
  2565. inc(dcount);
  2566. end else begin;
  2567. fattrib^[fcount] := DirInfo.attr;
  2568. fnames^[fcount] := DirInfo.Name;
  2569. fsize^[fcount] := DirInfo.size;
  2570. Nullpos := pos(#0,fnames^[fcount]);
  2571. if Nullpos <> 0 then
  2572. fnames^[fcount] := copy(fnames^[fcount],0,Nullpos-1);
  2573. inc(fcount);
  2574. end;
  2575. FindNext(DirInfo);
  2576. end;
  2577. {$I-}
  2578. sort_filenames(1,fcount-1);
  2579. sort_dirnames(1,dcount-1);
  2580. append_dirnames(dcount);
  2581.  
  2582. getdir(0,curpath);
  2583. count := fcount + dcount - 1;
  2584.  
  2585. for li := 0 to 511 do fselected^[li] := false;
  2586. for li := 0 to 511 do dselected^[li] := false;
  2587. for li := 0 to 511 do fpfad^[li] := curpath;
  2588.  
  2589. Start_Anzeige := 0;
  2590. Cursor_Zeile := 1;
  2591. end;
  2592.  
  2593. procedure neu_einlesen(fs : Pfileselect_struct);
  2594. begin;
  2595. read_directory(fs);
  2596. draw_files(fs^.sx,fs^.sy,fs);
  2597. selectcount := 0;
  2598. end;
  2599.  
  2600. procedure shorten_direntry(fs : Pfileselect_struct);
  2601. var last_slashpos : integer;
  2602. hs : string;
  2603. begin;
  2604. hs := '';
  2605. while pos('\',fs^.path) <> 0 do begin;
  2606. last_slashpos := pos('\',fs^.path);
  2607. hs := hs+copy(fs^.path,1,last_slashpos);
  2608. delete(fs^.path,1,last_slashpos);
  2609.  
  2610. gotoxy(1,23);
  2611. write(' ');
  2612. gotoxy(1,23);
  2613. write(fs^.path);
  2614.  
  2615. end;
  2616. if hs[length(hs)] = '\' then hs := copy(hs,1,length(hs)-1);
  2617. fs^.path := hs;
  2618. gotoxy(1,23);
  2619. write(' ');
  2620. gotoxy(1,23);
  2621. write(hs);
  2622. end;
  2623.  
  2624. procedure get_liner;
  2625. begin;
  2626. getmem(marker,100);
  2627. move(screen[13,20].c,marker^,100);
  2628. end;
  2629.  
  2630. procedure select_packdateien(fs : Pfileselect_struct);
  2631. var auswahl_beenden : boolean;
  2632. nextpath : string;
  2633. begin;
  2634. new(fnames);
  2635. new(fsize);
  2636. new(fselected);
  2637. new(fpfad);
  2638. new(fattrib);
  2639.  
  2640. new(dnames);
  2641. new(dsize);
  2642. new(dselected);
  2643. new(dattrib);
  2644.  
  2645. getdir(0,savepath);
  2646. chdir(fs^.path);
  2647.  
  2648. display_ansi(@fsel,co80);
  2649. get_liner;
  2650. cursor_off;
  2651.  
  2652. inc(fs^.sy,2);
  2653.  
  2654. read_directory(fs);
  2655.  
  2656. ch := #0;
  2657. draw_files(fs^.sx,fs^.sy,fs);
  2658. auswahl_beenden := false;
  2659. while not auswahl_beenden do begin;
  2660. ch := readkey;
  2661. if ch = #0 then ch := readkey;
  2662. case ch of
  2663. #13,
  2664. #27 : begin;
  2665. if (fattrib^[Start_Anzeige+Cursor_Zeile] and $10 = 10)
  2666. then begin;
  2667. nextpath := fnames^[Start_Anzeige+Cursor_Zeile];
  2668. if nextpath = '..' then begin;
  2669. chdir('..');
  2670. shorten_direntry(fs);
  2671. neu_einlesen(fs);
  2672. end else begin;
  2673. if fs^.path[length(fs^.path)] <> '\' then
  2674. fs^.path := fs^.path + '\';
  2675. fs^.path := fs^.path+nextpath;
  2676. chdir(fs^.path);
  2677. neu_einlesen(fs);
  2678. end;
  2679. end else begin;
  2680. auswahl_beenden := true;
  2681. end;
  2682. end;
  2683. #72 : begin; { Pfeil hoch }
  2684. if cursor_Zeile > 1 then begin;
  2685. dec(cursor_Zeile);
  2686. end else begin;
  2687. if Start_Anzeige > 0 then dec(Start_Anzeige);
  2688. end;
  2689. end;
  2690.  
  2691. #73 : begin; { Page up }
  2692. if Start_Anzeige > 11+cursor_zeile then begin;
  2693. dec(Start_Anzeige,11);
  2694. end else begin;
  2695. if Start_Anzeige > 11 then begin;
  2696. dec(Start_Anzeige,11);
  2697. Cursor_Zeile := Start_Anzeige+0;
  2698. end else begin;
  2699. Start_Anzeige := 0;
  2700. Cursor_Zeile := 1;
  2701. end;
  2702. end;
  2703. end;
  2704.  
  2705. #80 : begin; { Pfeil runter }
  2706. if cursor_Zeile < 11 then begin;
  2707. inc(cursor_Zeile);
  2708. end else begin;
  2709. if Start_Anzeige < count-12 then inc(Start_Anzeige);
  2710. end;
  2711. end;
  2712.  
  2713. #81 : begin; { Page down }
  2714. if Start_Anzeige+25 < count then begin;
  2715. inc(Start_Anzeige,11);
  2716. end else begin;
  2717. Start_Anzeige := count-12;
  2718. Cursor_Zeile := 11;
  2719. end;
  2720. end;
  2721.  
  2722. #71 : begin;
  2723. Start_Anzeige := 0;
  2724. Cursor_Zeile := 1;
  2725. end;
  2726.  
  2727. #79 : begin;
  2728. Start_Anzeige := count - 12;
  2729. Cursor_Zeile := 11;
  2730. end;
  2731.  
  2732.  
  2733. #32 : begin; { Space }
  2734. if fselected^[Start_Anzeige+Cursor_Zeile] then begin;
  2735. fselected^[Start_Anzeige+Cursor_Zeile] := false;
  2736. dec(selectcount);
  2737. dec(bytes_selected,fsize^[Start_Anzeige+Cursor_Zeile]);
  2738. end else begin;
  2739. fselected^[Start_Anzeige+Cursor_Zeile] := true;
  2740. inc(selectcount);
  2741. inc(bytes_selected,fsize^[Start_Anzeige+Cursor_Zeile]);
  2742. getdir(0,fpfad^[Start_Anzeige+Cursor_Zeile]);
  2743. end;
  2744. end;
  2745. end;
  2746. draw_files(fs^.sx,fs^.sy,fs);
  2747. end;
  2748.  
  2749. fs^.nofiles := 0;
  2750. for li := 0 to 511 do begin;
  2751. if fselected^[li] then begin;
  2752. inc(fs^.nofiles);
  2753. fs^.fn[fs^.nofiles] := fpfad^[li]+'\'+fnames^[li];
  2754. end;
  2755. end;
  2756.  
  2757. chdir(savepath);
  2758. dispose(fnames);
  2759. dispose(fsize);
  2760. dispose(fselected);
  2761. dispose(fpfad);
  2762. dispose(fattrib);
  2763.  
  2764. dispose(dnames);
  2765. dispose(dsize);
  2766. dispose(dselected);
  2767. dispose(dattrib);
  2768. end;
  2769.  
  2770. begin;
  2771. end.{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
  2772. unit gus_mod;
  2773. {
  2774. ****************************************************************************
  2775. *** DATA BECKERs "PC UNDERGROUND" ***
  2776. *** ================================ ***
  2777. *** ***
  2778. *** Modplayer-Unit GUS_MOD ***
  2779. *** ***
  2780. *** Die Unit GUS_MOD dient zum Abspielen von MODs ber die Gravis Ultra- ***
  2781. *** sound, der in der Demo-Scene etabliertesten Soundkarte. ***
  2782. *** ***
  2783. *** Diese Unit wurde benutzt, um den (FREEWARE-) Mod-Player TCP V1.0 ***
  2784. *** zu programmieren ***
  2785. *** ***
  2786. *** Autor : Boris Bertelsons (InspirE) ***
  2787. *** Dateiname : GUS_MOD.PAS ***
  2788. *** Letzte Žnderung : 28.06.1994 ***
  2789. *** Version : 2.0 ***
  2790. *** Compiler : Turbo Pascal 6.0 und h”her ***
  2791. ****************************************************************************
  2792. }
  2793.  
  2794. interface
  2795. function _gus_modload(name : string) : boolean;
  2796. {
  2797. L„d die in NAME bergebene Datei in den Speicher und das GUS-Ram. Die
  2798. Function liefert den Wert TRUE, wenn die MOD-Datei einwandfrei geladen
  2799. werden konnte, sonst den Wert FALSE.
  2800. }
  2801.  
  2802. procedure _gus_modstarten;
  2803. {
  2804. Startet die Ausgebe eines galadenen MODs ber den Timer-Interrupt
  2805. }
  2806.  
  2807. procedure _gus_mod_beenden;
  2808. {
  2809. Beendet die Ausgabe eines MODs
  2810. }
  2811.  
  2812. procedure _gus_initialisieren;
  2813. {
  2814. Initialisiert die GUS
  2815. }
  2816.  
  2817. function _gus_init_env : boolean;
  2818. {
  2819. Initialisiert die GUS, keine Hardware-Detection sondern Prfen der
  2820. Umgebungs-Variablen ULTRASND
  2821. }
  2822.  
  2823. procedure _gus_set_chanelpos;
  2824. {
  2825. Setzt die Position der einzelnen GUS-Kan„le
  2826. }
  2827.  
  2828. {
  2829. *************************************************************************
  2830. *** T Y P - D e k l a r a t i o n e n ***
  2831. *************************************************************************
  2832. }
  2833. type Song_header = record { Die Globalen Infos zur MOD-Datei }
  2834. kennung : string[25];
  2835. SongName : string[30];
  2836. Liedlaenge : byte;
  2837. Arrang : array[0..255] of byte;
  2838. Num_Patts : byte;
  2839. Num_Inst : byte;
  2840. end;
  2841.  
  2842. type Modinfo = record
  2843. Stimmen : word;
  2844. Tietel : string[20];
  2845. Patt_anz : word;
  2846. end;
  2847.  
  2848. Type Runinfo = record
  2849. Ausschlag : array[1..8] of byte;
  2850. Zeile,
  2851. Pattnr : integer;
  2852. Volumes : array[1..8] of byte;
  2853. speed : byte;
  2854. bpm : byte;
  2855. end;
  2856.  
  2857. type
  2858. PKanalInfo = ^TKanalInfo;
  2859. TKanalInfo = record
  2860. InstNr : byte; { Hardware bezogene Variablen }
  2861. Mempos : longint;
  2862. Ende : longint;
  2863. Loop_Start : longint;
  2864. Loop_Ende : longint;
  2865.  
  2866. Volume : integer; { MOD bezogene Variablen }
  2867. Frequenz : word;
  2868. Looping : byte;
  2869. Ton : integer;
  2870. Start_Ton : integer;
  2871. Ziel_Ton : integer;
  2872. Effekt : byte;
  2873. Opperand : byte;
  2874.  
  2875. Effektx, { Effekt bezogene Variablen }
  2876. Effekty : integer;
  2877. Appegpos : integer;
  2878. slidespeed : integer;
  2879. vslide : integer;
  2880. retrig_count : byte;
  2881. vibpos : byte;
  2882. vibx : byte;
  2883. viby : byte;
  2884. end;
  2885.  
  2886. PInstrumenrInfo = ^TInstrumentInfo;
  2887. TInstrumentInfo = record
  2888. Name : string[22];
  2889. Mempos : longint;
  2890. Ende : longint;
  2891. l_Start : longint;
  2892. l_ende : longint;
  2893. Groesse : word;
  2894. Loop_Start : word;
  2895. Loop_Ende : word;
  2896. Volume : word;
  2897. Looping : byte;
  2898. end;
  2899.  
  2900.  
  2901. {
  2902. *************************************************************************
  2903. *** Gloale Konstanten und Variablen ***
  2904. *************************************************************************
  2905. }
  2906. Const
  2907. Play_Chanel : array[1..14] { Zum ausmaskieren einzelner Kan„le }
  2908. of byte = (1,1,1,1,1,1,1, { 1 = GUS-Kanal wird gespielt }
  2909. 1,1,1,1,1,1,1); { 0 = GUS-Kanal wird nicht gespielt }
  2910.  
  2911. var Kanaele : array[0..31] of PKanalInfo;
  2912. Instrumente : array[0..31] of PInstrumenrInfo;
  2913. MOD_Stimmen : word; { Anzahl der Stimmen (4/8) }
  2914. MOD_Patternsize : word; { GrӇe eines MOD-Patterns in Byte }
  2915. stop_Thevoice : array[1..8] of boolean;
  2916. vh : Song_Header; { Globale Song - Definitionen }
  2917. Modinfptr : pointer;
  2918. Modinf : Modinfo;
  2919. Runinf : Runinfo;
  2920. chpos : array[1..8] of integer; { Pos. d. Kanals im Halbkreis}
  2921.  
  2922.  
  2923. implementation
  2924. uses dos,crt,design,fselect;
  2925.  
  2926. const VibratoTable : array[0..63] of integer =(
  2927. 0,24,49,74,97,120,141,161,
  2928. 180,197,212,224,235,244,250,253,
  2929. 255,253,250,244,235,224,212,197,
  2930. 180,161,141,120,97,74,49,24,
  2931. 0,-24,-49,-74,-97,-120,-141,-161,
  2932. -180,-197,-212,-224,-235,-244,-250,-253,
  2933. -255,-253,-250,-244,-235,-224,-212,-197,
  2934. -180,-161,-141,-120,-97,-74,-49,-24);
  2935.  
  2936. const Voice_Divisor : array[14..32] of byte =
  2937. (43,40,37,35,33,31,30,28,27,26,25,24,23,22,21,20,20,19,18);
  2938. Voice_Base : array[14..14] of longint =
  2939. (88195);
  2940.  
  2941. const GUS_Environment : boolean = true;
  2942. Modinstanz : byte = 31; { Anzahl der Instrumente in einer }
  2943. { MOD-Datei (15 oder 31) }
  2944. ModId : array[1..3] of { Kennungen fr 4-stimmige MODs }
  2945. String = ('M.K.','FLT4','4CHN');
  2946. Chn6 : string = '6CHN'; { Kennung fr 6-stimmige MODs }
  2947. chn8 : string = '8CHN'; { Kennung fr 8-stimmige MODs }
  2948. ModKennungen : string { Alle MOD-Kennungen zur Detection }
  2949. = 'M.K.FLT44CHN6CHN8CHN';
  2950. Interrupt_speed : word = 50; { Anzahl Aufrufe Interrupts }
  2951. Num_Voices = 14; { Wir benutzen 14 GUS - Kan„le ... }
  2952. U_Ram_Freepos : longint = 2; { Zur Verwaltung des GUS - RAM }
  2953.  
  2954. Play_Voice = 0; Stop_Voice = 3; { Konstanten zur Auswahl des Typs }
  2955. Bit8 = 0; Bit16 = 4; { der zu spielenden Stimme ... }
  2956. No_Loop = 0; Mit_Loop = 8;
  2957. Unidirect = 0; Bidirect = 16;
  2958. Go_forw = 0; Go_Back = 64;
  2959.  
  2960. var GUS_envstr : string;
  2961. GUS_BASE : word;
  2962. oldv : array[0..15] of integer;
  2963. tickcounter, { Zur Geschwindigkeits-Steuerung }
  2964. ticklimit : word;
  2965. altertimer : pointer; { Pointer auf den alten Timer-Int. }
  2966. i : Integer ; { die wohl beliebteste Variable ;) }
  2967. gusmf : file; { Zum Handling der MOD-Datei }
  2968. Pattern : array[0..127] { Pointer auf die Pattern im Ram }
  2969. of pointer;
  2970.  
  2971.  
  2972. {$L Gusasm}
  2973. procedure U_StartVoice(Nr,Modus : byte); external;
  2974. {
  2975. Startet den in Nr bergebenen Kanal der Gus im ber Modus eingestellten
  2976. Modus
  2977. }
  2978.  
  2979. procedure u_Voicefreq(Nr : byte;Freq : word); external;
  2980. {
  2981. Setzt die Frequenz Freq fr den in Nr eingestellten Kanal
  2982. }
  2983.  
  2984. procedure u_VoiceBalance(Nr,balance : byte); external;
  2985. {
  2986. Zum Einstellen der Balance des in Nr angegebenen Kanals. Fr balance sind
  2987. Werte von 0 bis 15 erlaubt, wobei 0 fr ganz links, 7 fr mittig und 15
  2988. fr ganz rechts steht
  2989. }
  2990.  
  2991. procedure u_VoiceVolume(Nr : byte; Vol : word); external;
  2992. {
  2993. Hiermit setzen Sie die Lautst„rke Vol des in Nr bergebenen Kanals
  2994. }
  2995.  
  2996. procedure u_delay; external;
  2997. {
  2998. Zum Warten beim Zugriff auf selbst-modifizierende Register des GF1,
  2999. zum internen Gebrauch
  3000. }
  3001.  
  3002. function detect_gus : word; external;
  3003. {
  3004. Zur Erkennung der GUS. Die Funktion liefert eine 0, wenn eine Karte
  3005. gefunden wurde, und eine 1, wenn keine GUS erkannt wurde. Diese Funktion
  3006. stellt gleichzeitig den richtigen Base-Port fr die GUS ein.
  3007. }
  3008.  
  3009. procedure u_Initialize; external;
  3010. {
  3011. Initialisiert die Gravis Ultrasound.
  3012. }
  3013.  
  3014. procedure Ultra_Mem2Gus(samp : pointer;start : longint;laenge : word); external;
  3015. {
  3016. Mit dieser Procedure kopieren Sie ein Sampel aus dem Ram in das RAM der GUS
  3017. Das ber samp adressierte Sampel wird dabei mittels der Poke-Methode ber-
  3018. tragen. In laenge geben Sie die L„nge des zu bertragenden Sampels an.
  3019. }
  3020.  
  3021. procedure gus_speaker_on; external;
  3022. {
  3023. Schaltet den Lautsprecher der GUS ein.
  3024. }
  3025.  
  3026. procedure u_Voicedata(start,lsta,sende : longint;Nr : word); external;
  3027. {
  3028. Stellt sie Paramterer fr einen Kanal ein. Dabei bezeichnet start die
  3029. Anfangsposition der Stimme im GUS-Ram, lsta den Start der Loop und sende
  3030. die End-Position des Kanals. Die Nummer des Kanals w„hlen Sie ber Nr.
  3031. }
  3032.  
  3033. function Ffaktor(t:word) : word; external;
  3034. {
  3035. Die Funktion Ffaktor liefert die der Notennummer t entsprechende Frequenz
  3036. fr die GUS aus der Mod-Frequenztabelle
  3037. }
  3038.  
  3039. function Notennr(hoehe : word) : byte; external;
  3040. {
  3041. Hiermit ermitteln Sie aus dem in hoehe bergebenen Tonh”hen-Wert aus der
  3042. MOD-Datei die Nummer der Note.
  3043. }
  3044.  
  3045. procedure voice_rampin(Stimme:byte;vol : word); external;
  3046. {
  3047. Diese Funktion wird benutzt, um das Knacken von Sampels am Anfang zu ver-
  3048. meiden. Die in Stimme ausgew„hlte Stimme wird nicht sofort auf die in vol
  3049. bergebene Lautst„rke gesetzt, sondern mit der schnellstm”glichen GUS-Ramp
  3050. von 0 auf die Lautst„rke hochgeslidet.
  3051. Die Procedure ist ein Ersatz fr u_VoiceVolume.
  3052. }
  3053.  
  3054. procedure voice_slidein(nr,speed : byte;vol : word); external;
  3055. {
  3056. Mit dieser Procedure k”nnen Sie einen Kanal der GUS einfaden. Nr bezeichnet
  3057. die Nummer des zu fadenden Kanals, in vol bergeben Sie die Ziel-Lautst„rke.
  3058. Bei der Geschwindigkeit geben die oberen beiden Bits die Ramp-Speed und die
  3059. unteren 6 Bits den Increment-Faktor an. Die schnellste Ramp errechen Sie mit
  3060. einem Wert von 63, die langsamste mit 192.
  3061. }
  3062.  
  3063. procedure dos_getmem(var zeiger:pointer;menge:word); external;
  3064. {
  3065. Diese Procedure ist ein Erstatz fr die Pascal Getmem-Procedure. Sie
  3066. benutzt jedoch den DOS-Speicher und ist somit fr TSRs lebensnotwendig,
  3067. um nicht immer einen konstanten Speicherbereich zu belegen, sondern den
  3068. Speicherbedarf an das jeweilige MOD anpassen zu k”nnen.
  3069. }
  3070.  
  3071. procedure dos_freemem(zeiger:pointer); external;
  3072. {
  3073. Dos_Freemem ist das Equivalent zur Pascal Freemem Procedure. Eine GrӇe
  3074. des freizugebenden Speichers ist nicht anzugeben.
  3075. }
  3076.  
  3077. procedure init_gus_base(base : word); external;
  3078. {
  3079. Initialisiert die Gravis Ultrasound mit der in Base bergebenen Adresse.
  3080. }
  3081.  
  3082.  
  3083. {$L loadin}
  3084. procedure loadin; external; { Ansi - Pic }
  3085.  
  3086.  
  3087. procedure init_the_gus(base : word);
  3088. begin;
  3089. init_gus_base(base);
  3090. end;
  3091.  
  3092. procedure u_init;
  3093. var li : integer;
  3094. begin;
  3095. u_Initialize; { Init im Assembler - Teil }
  3096. end;
  3097.  
  3098. FUNCTION ConvertString(Source : Pointer; Size : BYTE):String;
  3099. {
  3100. Zur umwandlung eines ASCIIZ-Strings in einen Pascal-String
  3101. }
  3102. VAR
  3103. WorkStr : String;
  3104. BEGIN
  3105. Move(Source^,WorkStr[1],Size);
  3106. WorkStr[0] := CHR(Size);
  3107. if pos(#0,Workstr) <> 0 then WorkStr[0] := chr(pos(#0,Workstr)-1);
  3108. ConvertString := WorkStr;
  3109. END;
  3110.  
  3111. procedure Lade_Instrument(Nr : byte);
  3112. {
  3113. L„d das Instrument mit der Nummer nr in das GUS-Ram
  3114. }
  3115. var gr : longint;
  3116. samp : pointer;
  3117. begin;
  3118. gr := Instrumente[nr]^.Groesse;
  3119. if gr > 10 then begin; { Nur laden wenn > 10, sonst eh crap ! }
  3120. dos_getmem(samp,gr);
  3121. Blockread(gusmf,samp^,gr);
  3122. U_Ram_freepos := U_Ram_freepos + (16-(U_Ram_freepos MOD 16));
  3123. Instrumente[nr]^.Mempos := U_Ram_freepos;
  3124. Ultra_Mem2Gus(samp,Instrumente[nr]^.Mempos,gr);
  3125. dos_freemem(samp); { Stimmen-Variablen initialisieren }
  3126. Instrumente[nr]^.l_start :=
  3127. Instrumente[nr]^.Mempos + Instrumente[nr]^.Loop_Start;
  3128. if Instrumente[nr]^.Looping = Mit_loop then begin;
  3129. Instrumente[nr]^.ende :=
  3130. Instrumente[nr]^.Mempos + Instrumente[nr]^.Loop_Ende;
  3131. end else begin;
  3132. Instrumente[nr]^.ende := Instrumente[nr]^.Mempos + gr - 25;
  3133. end;
  3134. Inc(U_Ram_Freepos,gr); { Verwaltungszeiger weiter setzen }
  3135. end;
  3136. end;
  3137.  
  3138. procedure Neue_Interrupt_Speed(speed : word);
  3139. {
  3140. Stellt die Geschwindigkeit des Interrupts entsprechend den BpM ein.
  3141. }
  3142. var zaehler : word;
  3143. loz,hiz : byte;
  3144. begin;
  3145. interrupt_speed := round(speed / 2.5);
  3146. zaehler := 1193180 DIV interrupt_speed;
  3147. loz := lo(zaehler);
  3148. hiz := hi(zaehler);
  3149. asm
  3150. cli
  3151. mov dx,43h
  3152. mov al,36h
  3153. out dx,al
  3154. mov dx,40h
  3155. mov al,loz
  3156. out dx,al
  3157. mov al,hiz
  3158. out dx,al
  3159. sti
  3160. end;
  3161. end;
  3162.  
  3163. procedure _gus_set_chanelpos;
  3164. {
  3165. Setzt die Position der einzelnen GUS-Kan„le
  3166. }
  3167. begin;
  3168. u_VoiceBalance(1,chpos[1]);
  3169. u_VoiceBalance(2,chpos[2]);
  3170. u_VoiceBalance(3,chpos[3]);
  3171. u_VoiceBalance(4,chpos[4]);
  3172. u_VoiceBalance(5,chpos[5]);
  3173. u_VoiceBalance(6,chpos[6]);
  3174. u_VoiceBalance(7,chpos[7]);
  3175. u_VoiceBalance(8,chpos[8]);
  3176. end;
  3177.  
  3178. procedure display_loading(s : string);
  3179. {
  3180. Zeigt an, wie weit das Laden der Sampel fortgeschritten ist.
  3181. }
  3182. var li,slen : integer;
  3183. var z : integer;
  3184. begin;
  3185. for z := 0 to 12 do begin;
  3186. move(ptr(seg(loadin),ofs(loadin)+z*34*2)^,ptr($B800,z*160+8*160+44)^,34*2);
  3187. end;
  3188. while pos('\',s) <> 0 do begin;
  3189. delete(s,1,pos('\',s));
  3190. end;
  3191. slen := length(s);
  3192. slen := (15 - slen) div 2;
  3193. for li := 1 to slen do s := ' '+s;
  3194. gotoxy(33,13);
  3195. write(s);
  3196. end;
  3197.  
  3198. function _gus_modload(name : string) : boolean;
  3199. {
  3200. L„d die in name bergebene MOD-Datei. Setzt voraus, daá die angegebene
  3201. Datei im Pfad existiert und nicht schreibgeschtzt ist.
  3202. }
  3203. var dummya : array[0..30] of byte;{ Fr die String - Behandlung }
  3204. daptr : pointer; { Pointer auf dummya }
  3205. dumw : word; { Dummy-Variablen zum Einlesen }
  3206. dumb : byte;
  3207. Restlaenge : longint; { Zum ermitteln der Patternzahl }
  3208. li : integer;
  3209. Kennung : array[1..4] of char;{ Die Kennung der MOD-Datei }
  3210. ias : integer; { Instrumenten-abh„ngige Startpos. }
  3211. begin;
  3212. U_Ram_freepos := 32;
  3213. for li := 0 to 15 do begin;
  3214. new(Kanaele[li]);
  3215. kanaele[li]^.vibpos := 0;
  3216. end;
  3217. for li := 0 to 31 do begin;
  3218. new(Instrumente[li]);
  3219. Instrumente[li]^.Name := '';
  3220. end;
  3221.  
  3222. runinf.Zeile := 0;
  3223. runinf.Pattnr := -1;
  3224. tickcounter := 0;
  3225. ticklimit := 6;
  3226. runinf.speed := 6;
  3227. runinf.bpm := 125;
  3228. ias := 0;
  3229. daptr := @dummya;
  3230.  
  3231. assign(gusmf,name); { File ”ffnen + L„nge initialisieren}
  3232. reset(gusmf,1);
  3233.  
  3234. save_screen;
  3235. display_loading(name);
  3236.  
  3237. Restlaenge := filesize(gusmf);
  3238. Restlaenge := Restlaenge - 1084;
  3239.  
  3240. seek(gusmf,1080); { Prfen, ob MOD mit 15/31 Stimmen }
  3241. Blockread(gusmf,Kennung,4);
  3242. if pos(Kennung,Modkennungen) = 0 then begin;
  3243. { 15 Stimmen ? }
  3244. seek(gusmf,600);
  3245. Blockread(gusmf,Kennung,4);
  3246. if pos(Kennung,Modkennungen) = 0 then begin;
  3247. { Keine gltige .MOD-Datei }
  3248. writeln('Keine gltige .MOD - Datei !!!');
  3249. halt(0);
  3250. end else begin;
  3251. Modinstanz := 15;
  3252. ias := -16*30;
  3253. end;
  3254. end;
  3255.  
  3256. if (Kennung = MODId[1]) or { Stimmenzahl der MOD-Datei ? }
  3257. (Kennung = MODId[2]) or
  3258. (Kennung = MODId[3])
  3259. then begin;
  3260. MOD_Stimmen := 4;
  3261. MOD_Patternsize := 4*256;
  3262. end else
  3263. if (Kennung = CHn6) then begin;
  3264. _gus_modload := false;
  3265. exit;
  3266. end else
  3267. if (Kennung = CHn8) then begin;
  3268. MOD_Stimmen := 8;
  3269. MOD_Patternsize := 8*256;
  3270. end;
  3271.  
  3272. seek(gusmf,0);
  3273. Blockread(gusmf,dummya,20); { Namen der Datei ermitteln }
  3274. vh.SongName := ConvertString(daptr,20);
  3275. seek(gusmf,950+ias); { Liedl„nge in Pattern }
  3276. Blockread(gusmf,vh.Liedlaenge,1);
  3277. seek(gusmf,952+ias); { Arrangement einlesen }
  3278. Blockread(gusmf,vh.Arrang,128);
  3279.  
  3280. vh.Num_Inst := Modinstanz; { Instrumente (15/31) einlesen }
  3281. seek(gusmf,20+ias);
  3282.  
  3283. for li := 1 to 32 do Instrumente[li]^.Name := '';
  3284.  
  3285. for li := 1 to vh.Num_Inst do begin;
  3286. Blockread(gusmf,dummya,22); { Instrumenten - Name }
  3287. Instrumente[li]^.Name := ConvertString(daptr,22);
  3288.  
  3289. Blockread(gusmf,dumw,2); { L„nge des Sampels }
  3290. Instrumente[li]^.Groesse := swap(dumw) * 2;
  3291.  
  3292. Blockread(gusmf,dumb,1); { Lautst„rke einlesen }
  3293. Blockread(gusmf,dumb,1);
  3294. Instrumente[li]^.Volume := dumb;
  3295.  
  3296. Blockread(gusmf,dumw,2); { Start der Loop einlesen }
  3297. Instrumente[li]^.Loop_Start := swap(dumw) * 2;
  3298. Blockread(gusmf,dumw,2);
  3299.  
  3300. dumw := swap(dumw) * 2; { Loopende aus Start+L„nge einlesen }
  3301. Instrumente[li]^.Loop_Ende := Instrumente[li]^.Loop_Start+dumw;
  3302.  
  3303. if (Instrumente[li]^.Loop_Ende - { Looping im Instrument ? }
  3304. Instrumente[li]^.Loop_Start) >= 10 then begin;
  3305. Instrumente[li]^.Looping := mit_loop;
  3306. end else begin;
  3307. Instrumente[li]^.Looping := no_loop;
  3308. end;
  3309. Dec(Restlaenge,Instrumente[li]^.Groesse);
  3310. end;
  3311.  
  3312. Vh.Num_Patts := Restlaenge DIV MOD_Patternsize ; { Patternzahl ? }
  3313. seek(gusmf,1084+ias);
  3314.  
  3315. for li := 1 to Vh.Num_Patts do begin; { Pattern einlesen }
  3316. dos_getmem(Pattern[li],MOD_Patternsize );
  3317. Blockread(gusmf,Pattern[li]^,MOD_Patternsize );
  3318. end;
  3319.  
  3320. for li := 1 to vh.Num_Inst do begin; { Instrumente einlesen }
  3321. Lade_Instrument(li);
  3322. screen[16,23+li].a := 5;
  3323. end;
  3324.  
  3325. close(gusmf);
  3326.  
  3327. for i := 1 to 31 do begin; { Kanal-Variablen initialisieren }
  3328. u_VoiceBalance (i,7) ;
  3329. u_VoiceVolume (i,0) ;
  3330. u_VoiceFreq (i,12000);
  3331. U_StartVoice(i,Stop_Voice);
  3332. u_Voicedata(0,0,0,i);
  3333. end;
  3334. runinf.Zeile := 0; { Laufzeit - Variablen init. }
  3335. runinf.Pattnr := -1;
  3336. tickcounter := 0;
  3337. ticklimit := 6;
  3338. runinf.speed := 6;
  3339. runinf.bpm := 125;
  3340. if MOD_Stimmen = 4 then begin; { Kan„le im Halbkreis anordnen }
  3341. chpos[1] := 2;
  3342. chpos[2] := 5;
  3343. chpos[3] := 9;
  3344. chpos[4] := 12;
  3345. _gus_set_chanelpos;;
  3346. end;
  3347. if MOD_Stimmen = 8 then begin;
  3348. chpos[1] := 1;
  3349. chpos[2] := 3;
  3350. chpos[3] := 5;
  3351. chpos[4] := 7;
  3352. chpos[5] := 7;
  3353. chpos[6] := 9;
  3354. chpos[7] := 11;
  3355. chpos[8] := 13;
  3356. _gus_set_chanelpos;;
  3357. end;
  3358.  
  3359. neue_interrupt_Speed(runinf.bpm);
  3360. restore_screen;
  3361. Modinf.Stimmen := MOD_Stimmen; { Konstante MOD-Infos in Struktur }
  3362. Modinf.Tietel := vh.Songname; { zur šbergabe }
  3363. Modinf.Patt_anz := Vh.Liedlaenge;
  3364. _gus_modload := true;
  3365. end;
  3366.  
  3367.  
  3368. procedure effekt_vibrato(nr : byte);
  3369. {
  3370. Aus dem Effekt-Handling ausgelagerte Vibrato-Procedure
  3371. }
  3372. var vibswap : integer;
  3373. begin;
  3374. inc(Kanaele[nr]^.vibpos,Kanaele[nr]^.vibx);
  3375. if Kanaele[nr]^.vibpos > 64 then
  3376. dec(Kanaele[nr]^.vibpos,64);
  3377. vibswap :=
  3378. (VibratoTable[Kanaele[nr]^.vibpos] * Kanaele[nr]^.viby) div 256;
  3379. inc(Kanaele[nr]^.Start_Ton,vibswap);
  3380. if Kanaele[nr]^.Start_Ton < 1 then
  3381. Kanaele[nr]^.Start_Ton := 1;
  3382. Kanaele[nr]^.Frequenz :=
  3383. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3384. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3385. end;
  3386.  
  3387.  
  3388. procedure E_toneportamento(nr : byte);
  3389. {
  3390. Aus dem Effekt-Handling ausgelagerte TonePortamento-Procedure
  3391. }
  3392. begin;
  3393. if Kanaele[nr]^.slidespeed < 0 then
  3394. begin
  3395. inc(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.slidespeed);
  3396. if Kanaele[nr]^.Start_Ton < Kanaele[nr]^.Ziel_Ton then
  3397. Kanaele[nr]^.Start_Ton := Kanaele[nr]^.Ziel_Ton;
  3398. end else begin
  3399. inc(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.slidespeed);
  3400. if Kanaele[nr]^.Start_Ton > Kanaele[nr]^.Ziel_Ton then
  3401. Kanaele[nr]^.Start_Ton := Kanaele[nr]^.Ziel_Ton;
  3402. end;
  3403.  
  3404. if Kanaele[nr]^.Start_Ton < 1 then
  3405. Kanaele[nr]^.Start_Ton := 1;
  3406. Kanaele[nr]^.Frequenz :=
  3407. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3408. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3409. oldv[nr] := Kanaele[nr]^.Start_Ton;
  3410. end;
  3411.  
  3412. procedure EI_toneportamento(nr : byte);
  3413. {
  3414. Init fr die aus dem Effekt-Handling ausgelagerte Vibrato-Procedure
  3415. }
  3416. begin;
  3417. { Inc-Faktor bestimmen }
  3418. if Kanaele[nr]^.Opperand <> 0 then
  3419. begin;
  3420. if Kanaele[nr]^.Start_Ton > Kanaele[nr]^.Ziel_Ton then
  3421. begin;
  3422. Kanaele[nr]^.slidespeed := -(Kanaele[nr]^.Opperand);
  3423. end else begin;
  3424. Kanaele[nr]^.slidespeed := (Kanaele[nr]^.Opperand);
  3425. end;
  3426. end;
  3427. if Kanaele[nr]^.Start_Ton < 1 then
  3428. Kanaele[nr]^.Start_Ton := 1;
  3429. Kanaele[nr]^.Frequenz :=
  3430. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3431. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3432. oldv[nr] := Kanaele[nr]^.Start_Ton;
  3433. end;
  3434.  
  3435. procedure Initialisiere_Effekte(nr : byte);
  3436. var swaplong : longint;
  3437. vibswap : integer;
  3438. begin;
  3439. if Kanaele[nr]^.Effekt = 0 then exit;
  3440. case Kanaele[nr]^.Effekt of
  3441. 0 : begin; { Appegio }
  3442. Kanaele[nr]^.Appegpos := 0;
  3443. Kanaele[nr]^.Effektx := Kanaele[nr]^.Opperand shr 4;
  3444. Kanaele[nr]^.Effekty := Kanaele[nr]^.Opperand and $0f;
  3445.  
  3446. inc(Kanaele[nr]^.Appegpos);
  3447. case (Kanaele[nr]^.Appegpos MOD 3) of
  3448. 0 : begin; {ap = 3 !}
  3449. Kanaele[nr]^.Start_Ton :=
  3450. Kanaele[nr]^.Ton + Kanaele[nr]^.Effekty;
  3451. end;
  3452. 1 : begin; {ap = 1 !}
  3453. Kanaele[nr]^.Start_Ton :=
  3454. Kanaele[nr]^.Ton;
  3455. end;
  3456. 2 : begin; {ap = 2 !}
  3457. Kanaele[nr]^.Start_Ton :=
  3458. Kanaele[nr]^.Ton + Kanaele[nr]^.Effektx;
  3459. end;
  3460. end;
  3461. if Kanaele[nr]^.Start_Ton < 1 then
  3462. Kanaele[nr]^.Start_Ton := 1;
  3463. Kanaele[nr]^.Frequenz :=
  3464. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3465. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3466. end;
  3467. 1 : begin; { Portamento up }
  3468. dec(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.Opperand);
  3469. if Kanaele[nr]^.Start_Ton < 1 then
  3470. Kanaele[nr]^.Start_Ton := 1;
  3471. Kanaele[nr]^.Frequenz :=
  3472. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3473. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3474. end;
  3475. 2 : begin; { Portamento down }
  3476. inc(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.Opperand);
  3477. if Kanaele[nr]^.Start_Ton < 1 then
  3478. Kanaele[nr]^.Start_Ton := 1;
  3479. Kanaele[nr]^.Frequenz :=
  3480. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3481. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3482. end;
  3483. 3 : begin; { Tone Portamento }
  3484. EI_toneportamento(nr);
  3485. end;
  3486. 4 : begin; { Vibrato *new* }
  3487. Kanaele[nr]^.vibx := Kanaele[nr]^.Opperand shr 4;
  3488. Kanaele[nr]^.viby := Kanaele[nr]^.Opperand and $0f;
  3489. effekt_vibrato(nr);
  3490. end;
  3491. 5 : begin; {NOTE SLIDE + VOLUME SLIDE: *new* }
  3492. { init }
  3493. if Kanaele[nr]^.Opperand <= $0f then
  3494. begin;
  3495. Kanaele[nr]^.vslide := -(Kanaele[nr]^.Opperand AND $0f);
  3496. Kanaele[nr]^.slidespeed := -(Kanaele[nr]^.Opperand AND $0f);
  3497. end else begin;
  3498. Kanaele[nr]^.vslide := (Kanaele[nr]^.Opperand shr 4);
  3499. Kanaele[nr]^.slidespeed := (Kanaele[nr]^.Opperand shr 4);
  3500. end;
  3501. { volume slide }
  3502. inc(Kanaele[nr]^.volume,Kanaele[nr]^.vslide);
  3503. if Kanaele[nr]^.volume < 0 then Kanaele[nr]^.volume := 0;
  3504. if Kanaele[nr]^.volume > 63 then Kanaele[nr]^.volume := 63;
  3505. u_VoiceVolume(Nr,Kanaele[nr]^.volume);
  3506. { Note slide }
  3507. inc(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.slidespeed);
  3508. if Kanaele[nr]^.Start_Ton < 1 then
  3509. Kanaele[nr]^.Start_Ton := 1;
  3510. Kanaele[nr]^.Frequenz :=
  3511. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3512. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3513. end;
  3514. 6 : begin; { Vibrato & Volume slide *new* }
  3515. { init }
  3516. Kanaele[nr]^.vibx := Kanaele[nr]^.Opperand shr 4;
  3517. Kanaele[nr]^.viby := Kanaele[nr]^.Opperand and $0f;
  3518. if Kanaele[nr]^.Opperand <= $0f then
  3519. begin;
  3520. Kanaele[nr]^.vslide := -(Kanaele[nr]^.Opperand AND $0f);
  3521. end else begin;
  3522. Kanaele[nr]^.vslide := (Kanaele[nr]^.Opperand shr 4);
  3523. end;
  3524. { volume slide }
  3525. inc(Kanaele[nr]^.volume,Kanaele[nr]^.vslide);
  3526. if Kanaele[nr]^.volume < 0 then Kanaele[nr]^.volume := 0;
  3527. if Kanaele[nr]^.volume > 63 then Kanaele[nr]^.volume := 63;
  3528. u_VoiceVolume(Nr,Kanaele[nr]^.volume);
  3529. { vibrato }
  3530. effekt_vibrato(nr);
  3531. end;
  3532. 7 : begin; { tremolo *new* }
  3533. Kanaele[nr]^.vibx := Kanaele[nr]^.Opperand shr 4;
  3534. Kanaele[nr]^.viby := Kanaele[nr]^.Opperand and $0f;
  3535. inc(Kanaele[nr]^.vibpos,Kanaele[nr]^.vibx);
  3536. if Kanaele[nr]^.vibpos > 64 then
  3537. dec(Kanaele[nr]^.vibpos);
  3538. vibswap :=
  3539. (VibratoTable[Kanaele[nr]^.vibpos] * Kanaele[nr]^.viby) div 256;
  3540. inc(Kanaele[nr]^.Volume,vibswap);
  3541. if Kanaele[nr]^.Volume < 0 then Kanaele[nr]^.Volume := 0;
  3542. if Kanaele[nr]^.Volume > 63 then Kanaele[nr]^.Volume := 63;
  3543. u_VoiceVolume(nr,Kanaele[nr]^.volume);
  3544. end;
  3545. 8 : begin; { not used !!! }
  3546. {
  3547. Wird offiziell nicht verwendet. Daher gut geeignet, um bestimmte
  3548. Events in einem Demo zu syncronisieren ...
  3549. }
  3550. end;
  3551. 9 : begin; { Sampel - Offset *new* }
  3552. swaplong := longint((Kanaele[nr]^.Opperand+1)) * 256;
  3553. Kanaele[nr]^.Mempos := Kanaele[nr]^.Mempos+swaplong;
  3554. u_Voicedata(Kanaele[nr]^.Mempos,Kanaele[nr]^.Loop_Start,
  3555. Kanaele[nr]^.Ende,nr);
  3556. U_StartVoice(nr,Play_Voice+Bit8+Kanaele[nr]^.Looping+Unidirect);
  3557. end;
  3558. $a : begin; { Volume sliding *new* }
  3559. if Kanaele[nr]^.Opperand <= $0f then
  3560. begin;
  3561. Kanaele[nr]^.vslide := -(Kanaele[nr]^.Opperand AND $0f);
  3562. end else begin;
  3563. Kanaele[nr]^.vslide := (Kanaele[nr]^.Opperand shr 4);
  3564. end;
  3565. inc(Kanaele[nr]^.volume,Kanaele[nr]^.vslide);
  3566. if Kanaele[nr]^.volume < 0 then Kanaele[nr]^.volume := 0;
  3567. if Kanaele[nr]^.volume > 63 then Kanaele[nr]^.volume := 63;
  3568. u_VoiceVolume(Nr,Kanaele[nr]^.volume);
  3569. end;
  3570. $b : begin; { Position Jump *ok* }
  3571. runinf.Zeile := 64;
  3572. runinf.Pattnr := Kanaele[nr]^.Opperand;
  3573. end;
  3574. $c : begin; { Set Note Volume *ok* }
  3575. if Kanaele[nr]^.Opperand > 63 then Kanaele[nr]^.Opperand := 63;
  3576. if Kanaele[nr]^.Opperand < 1 then
  3577. begin
  3578. Kanaele[nr]^.volume := 0;
  3579. u_VoiceVolume(nr,0);
  3580. U_StartVoice(nr,Stop_Voice);
  3581. stop_Thevoice[nr] := true;
  3582. end else begin
  3583. Kanaele[nr]^.volume := Kanaele[nr]^.Opperand;
  3584. u_VoiceVolume(Nr,Kanaele[nr]^.volume);
  3585. Runinf.Volumes[nr] := 63;
  3586. end;
  3587. end;
  3588. $d : begin; { Patterm Break *ok* }
  3589. runinf.Zeile := 64;
  3590. end;
  3591. $e : begin; { Erweiterter Effekt - Befehl }
  3592. case (Kanaele[nr]^.Opperand shr 4) of
  3593. 1 : begin; { Fine slide up }
  3594. dec(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.Opperand and $0f);
  3595. if Kanaele[nr]^.Start_Ton < 1 then Kanaele[nr]^.Start_Ton := 1;
  3596. Kanaele[nr]^.Frequenz :=
  3597. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3598. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3599. end;
  3600. 2 : begin; { Fine slide down }
  3601. inc(Kanaele[nr]^.Start_Ton,Kanaele[nr]^.Opperand and $0f);
  3602. if Kanaele[nr]^.Start_Ton < 1 then Kanaele[nr]^.Start_Ton := 1;
  3603. Kanaele[nr]^.Frequenz :=
  3604. longint(Voice_Base[14] div Kanaele[nr]^.Start_Ton);
  3605. u_VoiceFreq(nr,Kanaele[nr]^.Frequenz);
  3606. end;
  3607. 9 : begin; { Retriggering !!! *new* }
  3608. Kanaele[nr]^.Retrig_count :=
  3609. Kanaele[nr]^.Opperand and $0f;
  3610. end;
  3611. $a : begin; { fine volume slide up }
  3612. Kanaele[nr]^.vslide := (Kanaele[nr]^.Opperand AND $0f);
  3613. inc(Kanaele[nr]^.volume,Kanaele[nr]^.vslide);
  3614. if Kanaele[nr]^.volume < 0 then Kanaele[nr]^.volume := 0;
  3615. if Kanaele[nr]^.volume > 63 then Kanaele[nr]^.volume := 63;
  3616. u_VoiceVolume(Nr,Kanaele[nr]^.volume);
  3617. end;
  3618. $b : begin; { fine volume slide down }
  3619. Kanaele[nr]^.vslide := (Kanaele[nr]^.Opperand AND $0f);
  3620. dec(Kanaele[nr]^.volume,Kanaele[nr]^.vslide);
  3621. if Kanaele[nr]^.volume < 0 then Kanaele[nr]^.volume := 0;
  3622. if Kanaele[nr]^.volume > 63 then Kanaele[nr]^.volume := 63;
  3623. u_VoiceVolume(Nr,Kanaele[nr]^.volume);
  3624. end;
  3625. $c : begin; { Cut Voice *ok* }
  3626. stop_Thevoice[nr] := true;
  3627. end;
  3628. end;
  3629. end;
  3630. $f : begin; { Set Speed *ok* }
  3631. if Kanaele[nr]^.Opperand <= $f then begin;
  3632. ticklimit := Kanaele[nr]^.Opperand;
  3633. runinf.speed := ticklimit;
  3634. end else begin;
  3635. runinf.bpm := Kanaele[nr]^.Opperand;
  3636. neue_interrupt_Speed(Kanaele[nr]^.Opperand);
  3637. end;
  3638. end;
  3639. end;
  3640. end;
  3641.  
  3642. procedure play_pattern_gus;
  3643. {
  3644. Diese Procedure wird periodisch aufgerufen. Sie spielt eine Zeile der
  3645. MOD-Datei ab.
  3646. }
  3647. var li : integer;
  3648. dumw : word;
  3649. Die_Zeile : array[1..8,0..3] of Byte;
  3650. Effekt : byte;
  3651. Ton : word;
  3652. Inst : byte;
  3653. begin;
  3654. {
  3655. **************************************************************************
  3656. *** Im Mod vorrcken ***
  3657. **************************************************************************
  3658. }
  3659. inc(runinf.Zeile); { Eine Zeile vorrcken }
  3660. if runinf.Zeile > 64 then runinf.Zeile := 1;
  3661. if runinf.Zeile = 1 then begin; { Neues Pattern ? }
  3662. inc(runinf.Pattnr);
  3663. if runinf.Pattnr > vh.Liedlaenge then runinf.Pattnr := 1;
  3664. end;
  3665. { Noten laden }
  3666. move(ptr(seg(pattern[vh.Arrang[runinf.Pattnr]+1]^),
  3667. ofs(pattern[vh.Arrang[runinf.Pattnr]+1]^)+
  3668. (runinf.Zeile-1)*4*Mod_Stimmen)^,
  3669. Die_Zeile,4*8);
  3670.  
  3671. {
  3672. **************************************************************************
  3673. *** Die Stimmen abarbeiten ***
  3674. **************************************************************************
  3675. }
  3676. for li := 1 to MOD_Stimmen do begin;
  3677. if play_chanel[li] = 1 then begin;
  3678. stop_Thevoice[li] := false;
  3679.  
  3680. Ton := ((Die_Zeile[li,0] AND $0f) shl 8)+Die_Zeile[li,1];
  3681. Inst := (Die_Zeile[li,0] AND $f0)+((Die_Zeile[li,2] AND $F0) SHR 4);
  3682. Kanaele[li]^.Effekt := Die_Zeile[li,2] AND $0f;
  3683. Kanaele[li]^.Opperand := Die_Zeile[li,3];
  3684.  
  3685. Kanaele[li]^.Start_Ton := oldv[li];
  3686.  
  3687. if Ton <> 0 then begin; { Ist ein Ton eingetragen ??? }
  3688. if Kanaele[li]^.Effekt = 3 then begin;
  3689. Kanaele[li]^.Ziel_Ton := Ton;
  3690. end else begin;
  3691. Kanaele[li]^.Ton := Ton;
  3692. Kanaele[li]^.Start_Ton := Ton;
  3693. oldv[li] := Kanaele[li]^.Start_Ton;
  3694. end;
  3695. end;
  3696.  
  3697. If Inst <> 0 then begin; { neues Instrument benutzen ??? }
  3698. Kanaele[li]^.InstNr := Inst;
  3699. Kanaele[li]^.Mempos := Instrumente[Kanaele[li]^.InstNr]^.Mempos;
  3700. Kanaele[li]^.Loop_Start := Instrumente[Kanaele[li]^.InstNr]^.l_start;
  3701. Kanaele[li]^.Ende := Instrumente[Kanaele[li]^.InstNr]^.ende;
  3702. Kanaele[li]^.volume := Instrumente[Kanaele[li]^.InstNr]^.volume;
  3703. Kanaele[li]^.Looping := Instrumente[Kanaele[li]^.InstNr]^.Looping;
  3704. u_Voicedata(Kanaele[li]^.Mempos,Kanaele[li]^.Loop_Start,
  3705. Kanaele[li]^.Ende,li);
  3706. end;
  3707. Kanaele[li]^.Retrig_count := 0;
  3708.  
  3709. Initialisiere_Effekte(li);
  3710.  
  3711.  
  3712. If (Ton <> 0) then begin; { Note angeschlagen }
  3713. Kanaele[li]^.Frequenz := longint(Voice_Base[14] div Kanaele[li]^.Start_Ton);
  3714. u_VoiceFreq(li,Kanaele[li]^.Frequenz); { Frequenz setzen }
  3715.  
  3716.  
  3717. if Kanaele[li]^.Effekt = $c then begin; { Extra, weil sonst zu frh ! }
  3718. if Kanaele[li]^.Opperand > 63 then Kanaele[li]^.Opperand := 63;
  3719. if Kanaele[li]^.Opperand < 1 then
  3720. begin
  3721. Kanaele[li]^.volume := 0;
  3722. u_VoiceVolume(li,0);
  3723. U_StartVoice(li,Stop_Voice);
  3724. stop_Thevoice[li] := true;
  3725. end else begin
  3726. Kanaele[li]^.volume := Kanaele[li]^.Opperand;
  3727. u_VoiceVolume(li,Kanaele[li]^.volume);
  3728. Runinf.Volumes[li] := 63;
  3729. end;
  3730. end else begin;
  3731. if Kanaele[li]^.volume > 63 then Kanaele[li]^.volume := 63;
  3732. voice_rampin(li,Kanaele[li]^.volume);
  3733. Runinf.Volumes[li] := 63;
  3734. end;
  3735.  
  3736. U_StartVoice(li,Stop_Voice); { Alte Stimme anhalten }
  3737.  
  3738. u_Voicedata(Kanaele[li]^.Mempos,Kanaele[li]^.Loop_Start,
  3739. Kanaele[li]^.Ende,li);
  3740. if not stop_Thevoice[li] then begin; { Neue Stimme starten }
  3741. U_StartVoice(li,Play_Voice+Bit8+Kanaele[li]^.Looping+Unidirect);
  3742. Runinf.Ausschlag[li] := Kanaele[li]^.volume * 4; { Fr Equilizer }
  3743. end;
  3744. end; { Note angeschlagen }
  3745. end else begin;
  3746. u_VoiceVolume(li,0);
  3747. end;
  3748. end; {for}
  3749. end;
  3750.  
  3751. procedure tick_effects;
  3752. var li : integer;
  3753. vibswap : integer;
  3754. begin;
  3755. for li := 1 to MOD_Stimmen do begin;
  3756. if runinf.volumes[li] > 0 then
  3757. dec(runinf.volumes[li]);
  3758. case Kanaele[li]^.Effekt of { Laufzeit - Effekte abarbeiten }
  3759. 0 : begin;
  3760. inc(Kanaele[li]^.Appegpos);
  3761. case (Kanaele[li]^.Appegpos MOD 3) of
  3762. 0 : begin; {ap = 3 !}
  3763. Kanaele[li]^.Start_Ton :=
  3764. Kanaele[li]^.Ton + Kanaele[li]^.Effekty;
  3765. end;
  3766. 1 : begin; {ap = 1 !}
  3767. Kanaele[li]^.Start_Ton :=
  3768. Kanaele[li]^.Ton;
  3769. end;
  3770. 2 : begin; {ap = 2 !}
  3771. Kanaele[li]^.Start_Ton :=
  3772. Kanaele[li]^.Ton + Kanaele[li]^.Effektx;
  3773. end;
  3774. end;
  3775. end;
  3776. 1 : begin;
  3777. {!"! new }
  3778. Kanaele[li]^.Opperand := Kanaele[li]^.Opperand and $0F;
  3779. {!"! new end }
  3780. dec(Kanaele[li]^.Start_Ton,Kanaele[li]^.Opperand);
  3781. if Kanaele[li]^.Start_Ton < 1 then
  3782. Kanaele[li]^.Start_Ton := 1;
  3783. Kanaele[li]^.Frequenz :=
  3784. longint(Voice_Base[14] div Kanaele[li]^.Start_Ton);
  3785. u_VoiceFreq(li,Kanaele[li]^.Frequenz);
  3786. end;
  3787. 2 : begin;
  3788. {!"! new }
  3789. Kanaele[li]^.Opperand := Kanaele[li]^.Opperand and $0F;
  3790. {!"! new end }
  3791. inc(Kanaele[li]^.Start_Ton,Kanaele[li]^.Opperand);
  3792. if Kanaele[li]^.Start_Ton < 1 then
  3793. Kanaele[li]^.Start_Ton := 1;
  3794. Kanaele[li]^.Frequenz :=
  3795. longint(Voice_Base[14] div Kanaele[li]^.Start_Ton);
  3796. u_VoiceFreq(li,Kanaele[li]^.Frequenz);
  3797. end;
  3798. 3 : begin; { Tone Portamento }
  3799. E_toneportamento(li);
  3800. end;
  3801. 4 : begin; { vibrato *new* }
  3802. effekt_vibrato(li);
  3803. end;
  3804. 5 : begin;
  3805. { volume slide }
  3806. inc(Kanaele[li]^.volume,Kanaele[li]^.vslide);
  3807. if Kanaele[li]^.volume < 0 then Kanaele[li]^.volume := 0;
  3808. if Kanaele[li]^.volume > 63 then Kanaele[li]^.volume := 63;
  3809. u_VoiceVolume(li,Kanaele[li]^.volume);
  3810. { Note slide }
  3811. inc(Kanaele[li]^.Start_Ton,Kanaele[li]^.slidespeed);
  3812. if Kanaele[li]^.Start_Ton < 1 then
  3813. Kanaele[li]^.Start_Ton := 1;
  3814. Kanaele[li]^.Frequenz :=
  3815. longint(Voice_Base[14] div Kanaele[li]^.Start_Ton);
  3816. u_VoiceFreq(li,Kanaele[li]^.Frequenz);
  3817. end;
  3818. 6 : begin;
  3819. { volume slide }
  3820. inc(Kanaele[li]^.volume,Kanaele[li]^.vslide);
  3821. if Kanaele[li]^.volume < 0 then Kanaele[li]^.volume := 0;
  3822. if Kanaele[li]^.volume > 63 then Kanaele[li]^.volume := 63;
  3823. u_VoiceVolume(li,Kanaele[li]^.volume);
  3824. { vibrato }
  3825. inc(Kanaele[li]^.vibpos,Kanaele[li]^.vibx);
  3826. if Kanaele[li]^.vibpos > 64 then
  3827. dec(Kanaele[li]^.vibpos);
  3828. vibswap :=
  3829. (VibratoTable[Kanaele[li]^.vibpos] * Kanaele[li]^.viby) div 256;
  3830. inc(Kanaele[li]^.Start_Ton,vibswap);
  3831. if Kanaele[li]^.Start_Ton < 1 then
  3832. Kanaele[li]^.Start_Ton := 1;
  3833. Kanaele[li]^.Frequenz :=
  3834. longint(Voice_Base[14] div Kanaele[li]^.Start_Ton);
  3835. u_VoiceFreq(li,Kanaele[li]^.Frequenz);
  3836. end;
  3837. 7 : begin; { tremolo *new* }
  3838. inc(Kanaele[li]^.vibpos,Kanaele[li]^.vibx);
  3839. if Kanaele[li]^.vibpos > 64 then
  3840. dec(Kanaele[li]^.vibpos);
  3841. vibswap :=
  3842. (VibratoTable[Kanaele[li]^.vibpos] * Kanaele[li]^.viby) div 256;
  3843. inc(Kanaele[li]^.Volume,vibswap);
  3844. if Kanaele[li]^.Volume < 0 then Kanaele[li]^.Volume := 0;
  3845. if Kanaele[li]^.Volume > 63 then Kanaele[li]^.Volume := 63;
  3846. u_VoiceVolume(li,Kanaele[li]^.volume);
  3847. end;
  3848. 8 : begin; { not used !!! }
  3849. end;
  3850. $a : begin; { Volume sliding **new* }
  3851. inc(Kanaele[li]^.volume,Kanaele[li]^.vslide);
  3852. if Kanaele[li]^.volume < 0 then Kanaele[li]^.volume := 0;
  3853. if Kanaele[li]^.volume > 63 then Kanaele[li]^.volume := 63;
  3854. u_VoiceVolume(li,Kanaele[li]^.volume);
  3855. end;
  3856. $e : begin; { Erweiterter Effekt - Befehl }
  3857. case (Kanaele[li]^.Opperand shr 4) of
  3858. 9: begin; { Retriggering !!! }
  3859. if Kanaele[li]^.Opperand and $0f <> 0 then begin;
  3860. dec(Kanaele[li]^.Retrig_count);
  3861. if Kanaele[li]^.Retrig_count = 0 then begin;
  3862. Kanaele[li]^.Retrig_count := Kanaele[li]^.Opperand and $0f;
  3863. u_Voicedata(Kanaele[li]^.Mempos,Kanaele[li]^.Loop_Start,
  3864. Kanaele[li]^.Ende,li);
  3865. U_StartVoice(li,Play_Voice+Bit8+Kanaele[li]^.Looping+Unidirect);
  3866. end;
  3867. end;
  3868. end;
  3869. end;
  3870. end;
  3871. end;
  3872. end;
  3873. end;
  3874.  
  3875. {$F+}
  3876. procedure mytimer; interrupt;
  3877. {
  3878. Mein Timer-Interrupt
  3879. }
  3880. begin;
  3881. tick_effects;
  3882. inc(tickcounter);
  3883. if tickcounter >= ticklimit then begin;
  3884. Tickcounter := 0;
  3885. Play_Pattern_gus;
  3886. end;
  3887. Port[$20] := $20;
  3888. end;
  3889.  
  3890. procedure tue_nichts; interrupt;
  3891. {
  3892. Dummy-Interrupt. Auf ihn wird geschaltet, wenn die Ausgabe angehalten wird.
  3893. }
  3894. begin;
  3895. port[$20] := $20;
  3896. end;
  3897.  
  3898. procedure _gus_modstarten;
  3899. {
  3900. Startet die Ausgabe des MOD-Files ber den Timer-Interrupt. Das MOD-File
  3901. muá bereits geladen worden sein !
  3902. }
  3903. var zaehler : word;
  3904. loz,hiz : byte;
  3905. begin;
  3906. zaehler := 1193180 DIV interrupt_speed;
  3907. loz := lo(zaehler);
  3908. hiz := hi(zaehler);
  3909. asm
  3910. cli
  3911. mov dx,43h
  3912. mov al,36h
  3913. out dx,al
  3914. mov dx,40h
  3915. mov al,loz
  3916. out dx,al
  3917. mov al,hiz
  3918. out dx,al
  3919. end;
  3920. getintvec(8,altertimer);
  3921. setintvec(8,@Mytimer);
  3922. asm sti end;
  3923. end;
  3924.  
  3925.  
  3926. procedure _gus_player_pause;
  3927. {
  3928. H„lt die Ausgabe ber den Timer-Interrupt an
  3929. }
  3930. var li : integer;
  3931. begin;
  3932. setintvec(8,@Tue_nichts);
  3933. for li := 0 to 31 do
  3934. u_VoiceVolume (li,0) ;
  3935. end;
  3936.  
  3937. procedure _gus_player_continue;
  3938. {
  3939. Setzt die Ausgabe ber den Timer-Interrupt fort.
  3940. }
  3941. var li : integer;
  3942. begin;
  3943. setintvec(8,@Mytimer);
  3944. for li := 1 to 31 do
  3945. Voice_Rampin(li,Kanaele[li]^.volume);
  3946. end;
  3947.  
  3948. procedure timerint_zurueck;
  3949. {
  3950. Resettet den Timer-Interrupt auf seinen ursprnglichen Wert.
  3951. }
  3952. begin;
  3953. asm
  3954. cli
  3955. mov dx,43h
  3956. mov al,36h
  3957. out dx,al
  3958. xor ax,ax
  3959. mov dx,40h
  3960. out dx,al
  3961. out dx,al
  3962. end;
  3963. setintvec(8,altertimer);
  3964. asm sti end;
  3965. end;
  3966.  
  3967. procedure dispose_mod;
  3968. {
  3969. Entfernt ein geladenens MOD aus dem Hauptspeicher. Die Sampels auf der GUS
  3970. werden NICHT gel”scht.
  3971. }
  3972. begin;
  3973. for i := 0 to 31 do begin;
  3974. U_StartVoice(i,Stop_Voice);
  3975. end;
  3976. for i := 1 to Vh.Num_Patts do begin;
  3977. dos_freemem(Pattern[i]);
  3978. end;
  3979. for i := 0 to 15 do begin;
  3980. dispose(Kanaele[i]);
  3981. end;
  3982. for i := 0 to 31 do begin;
  3983. dispose(Instrumente[i]);
  3984. end;
  3985. end;
  3986.  
  3987. procedure _gus_mod_beenden;
  3988. {
  3989. Beendet die Ausgabe eines MODs
  3990. }
  3991. begin;
  3992. timerint_zurueck;
  3993. dispose_mod;
  3994. end;
  3995.  
  3996. procedure _gus_initialisieren;
  3997. {
  3998. Initialisiert die GUS
  3999. }
  4000. begin;
  4001. u_init;
  4002. gus_speaker_on;
  4003. end;
  4004.  
  4005. procedure get_from_environment;
  4006. {
  4007. Ermittelt die Base-Adresse der GUS aus der Environment-Variablen
  4008. ULTRASND
  4009. }
  4010. var apos,ipos,dpos : integer;
  4011. astr,istr,dstr,gusstr : string;
  4012. code : integer;
  4013. begin;
  4014. GUS_envstr := GetEnv('ULTRASND');
  4015.  
  4016. { GUS - Base erkennen }
  4017. gusstr := Copy(GUS_envstr,1,3);
  4018. val(gusstr,GUS_BASE,code);
  4019. if code <> 0 then begin;
  4020. GUS_Environment := false;
  4021. end else
  4022. GUS_Environment := true;
  4023. end;
  4024.  
  4025. function dec_2_hex(w : word) : word;
  4026. {
  4027. Convertiert eine Dezimal-Zahl in eine Hex-Zahl. Wichtig fr Environment-
  4028. Behandlung
  4029. }
  4030. const exp : array[1..4] of word = (4096,256,16,0);
  4031. var c,hs : string;
  4032. v,i,li : integer;
  4033. begin;
  4034. str(w,hs);
  4035. while length(hs) < 4 do hs := '0'+hs;
  4036. w := 0;
  4037. for li := 1 to 4 do begin;
  4038. c := hs[li];
  4039. val(c,v,i);
  4040. w := w + v * exp[li];
  4041. end;
  4042. dec_2_hex := w;
  4043. end;
  4044.  
  4045. procedure write_environment;
  4046. {
  4047. Gibt die aus den Environment ermittelte BASE-Adresse der GUS aus
  4048. }
  4049. begin;
  4050. if GUS_Environment then begin;
  4051. writeln('þ GUS_BASE: ',GUS_BASE);
  4052. writeln('þ initializing Gravis Ultrasound Card');
  4053. gus_base := dec_2_hex(gus_base);
  4054. init_the_gus(Gus_base);
  4055. delay(777);
  4056. end else begin;
  4057. writeln('The environment-variable ULTRASND is not set !');
  4058. delay(777);
  4059. end;
  4060. end;
  4061.  
  4062. function _gus_init_env : boolean;
  4063. {
  4064. Initialisiert die GUS, keine Hardware-Detection sondern Prfen der
  4065. Umgebungs-Variablen ULTRASND
  4066. }
  4067. begin;
  4068. clrscr;
  4069. get_from_environment;
  4070. write_environment;
  4071. _gus_init_env := gus_environment;
  4072. end;
  4073.  
  4074. begin;
  4075. end.
  4076. {$A+,B-,D+,E+,F+,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
  4077. {$M 16384,0,250000}
  4078.  
  4079. program gusdemo;
  4080.  
  4081. uses crt,dos,design,fselect, gus_mod;
  4082.  
  4083. type
  4084. Pphun = ^TPhun;
  4085. TPhun = array[0..799] of string[80];
  4086.  
  4087. const mod_pfad = 'd:\mods';
  4088.  
  4089. const Programm_beenden : boolean = false;
  4090.  
  4091. var phun : Pphun;
  4092. phuncount : integer;
  4093. modify_voice : integer;
  4094. i : integer;
  4095. Die_files : Pfileselect_struct;
  4096. curr_modnr : integer;
  4097.  
  4098. {
  4099. Einbindung der Ansi - Screens
  4100. }
  4101.  
  4102. {$L tcpans}
  4103. procedure tcpans; external;
  4104. {$L we_are}
  4105. procedure we_are; external;
  4106. {$L buy_it}
  4107. procedure buy_it; external;
  4108. {$L call}
  4109. procedure call; external;
  4110. {$L helptxt}
  4111. procedure helptxt; external;
  4112.  
  4113.  
  4114. function datei_exists(dname : string) : boolean;
  4115. {
  4116. Prft, ob die bergebene Datei vorhanden ist
  4117. }
  4118. var dumf : file;
  4119. begin;
  4120. {$I-}
  4121. assign(dumf,dname);
  4122. reset(dumf,1);
  4123. {$I+}
  4124. if IOResult <> 0 then
  4125. datei_exists := false
  4126. else begin;
  4127. datei_exists := true;
  4128. close(dumf);
  4129. end;
  4130. end;
  4131.  
  4132. procedure color_writeln(s : string);
  4133. {
  4134. Zur Ausgabe eines Strings in der TC-Farbkombination
  4135. }
  4136. var colpos,li : integer;
  4137. begin;
  4138. colpos := 1;
  4139. for li := 1 to length(s) do begin;
  4140. if s[li] = ' ' then colpos := 0;
  4141. inc(colpos);
  4142. case colpos of
  4143. 1..2 : begin;
  4144. textcolor(8);
  4145. end;
  4146. 3..4 : begin;
  4147. textcolor(2);
  4148. end;
  4149. 5..$ff : begin;
  4150. textcolor(10);
  4151. end;
  4152. end;
  4153. write(s[li]);
  4154. end;
  4155. end;
  4156.  
  4157. procedure write_dateinamen(s : string);
  4158. {
  4159. Gibt zentriert den Dateinamen des Liedes aus
  4160. }
  4161. var li,slen : integer;
  4162. begin;
  4163. gotoxy(33,13);
  4164. while pos('\',s) <> 0 do begin;
  4165. delete(s,1,pos('\',s));
  4166. end;
  4167. slen := length(s);
  4168. slen := (15 - slen) div 2;
  4169. for li := 1 to slen do s := ' '+s;
  4170. write(s);
  4171. end;
  4172.  
  4173. procedure write_phunliners;
  4174. {
  4175. Liest aus der Datei "Phun.txt" drei Zeilen aus und gibt diese auf dem
  4176. Bildschirm aus. Bei der Datei "Phun.txt" handelt es sich um eine frei
  4177. editierbare Text-Datei, die Sie nach Ihrem Belieben ver„ndern k”nnen !
  4178. }
  4179. var tf : text;
  4180. begin;
  4181. randomize;
  4182. if not datei_exists('phun.txt') then exit;
  4183. assign(tf,'phun.txt');
  4184. reset(tf);
  4185. phuncount := 0;
  4186. {$I+}
  4187. if ioresult = 0 then begin;
  4188. while not eof(tf) do begin;
  4189. readln(tf,phun^[phuncount]);
  4190. inc(phuncount);
  4191. end;
  4192. close(tf);
  4193. gotoxy(3,43);
  4194. color_writeln(phun^[random(phuncount)]);
  4195. gotoxy(3,44);
  4196. color_writeln(phun^[random(phuncount)]);
  4197. gotoxy(3,45);
  4198. color_writeln(phun^[random(phuncount)]);
  4199. end;
  4200. {$I-}
  4201. end;
  4202.  
  4203. procedure display_modinfos;
  4204. {
  4205. Gibt die Instrument-Namen des aktuellen Modules aus
  4206. }
  4207. var li : integer;
  4208. begin;
  4209. textcolor(14);
  4210. textbackground(black);
  4211. for li := 1 to 16 do begin;
  4212. gotoxy(6,17+li);
  4213. color_writeln(Instrumente[li]^.name);
  4214. gotoxy(50,17+li);
  4215. color_writeln(Instrumente[li+16]^.name);
  4216. end;
  4217. end;
  4218.  
  4219. procedure exit_program;
  4220. {
  4221. Vorm verlassen des Programms noch schnell 'nen Hinweis auf das TC WHQ,
  4222. die Farpoint Station (04202 76145), anzeigen ...
  4223. }
  4224. begin;
  4225. display_ansi(@call,co80+font8x8);
  4226. cursor_off;
  4227. repeat until keypressed;
  4228. while keypressed do readkey;
  4229. cursor_on;
  4230. asm mov ax,03; int 10h; end;
  4231. halt;
  4232. end;
  4233.  
  4234. procedure naechstes_mod;
  4235. {
  4236. Startet die Ausgabe des n„chsten selektierten MODs
  4237. }
  4238. begin;
  4239. _gus_mod_beenden;
  4240. inc(curr_modnr);
  4241. if curr_modnr > Die_Files^.nofiles then
  4242. curr_modnr := 1;
  4243. if not _gus_modload(Die_Files^.fn[curr_modnr]) then begin;
  4244. clrscr;
  4245. gotoxy(10,10);
  4246. write('Sorry dude, Cant''t handle this MOD-File');
  4247. delay(1200);
  4248. exit_program;
  4249. end;
  4250. display_ansi(@tcpans,co80+font8x8);
  4251. cursor_off;
  4252. write_phunliners;
  4253. write_dateinamen(Die_Files^.fn[curr_modnr]);
  4254. display_modinfos;
  4255. fillchar(Play_Chanel,14,1);
  4256. _gus_modstarten;
  4257. end;
  4258.  
  4259. procedure display_we_are;
  4260. {
  4261. Gibt ein ANSI mit Infos ber die Gruppe THE COEXISTENCE aus
  4262. }
  4263. begin;
  4264. display_ansi(@we_are,co80+font8x8);
  4265. cursor_off;
  4266. repeat until keypressed;
  4267. while keypressed do readkey;
  4268. display_ansi(@tcpans,co80+font8x8);
  4269. cursor_off;
  4270. write_phunliners;
  4271. write_dateinamen(Die_Files^.fn[curr_modnr]);
  4272. display_modinfos;
  4273. end;
  4274.  
  4275. procedure display_buy_it;
  4276. {
  4277. Gibt Werbung fr das Buch PC Underground aus
  4278. }
  4279. begin;
  4280. display_ansi(@buy_it,co80+font8x8);
  4281. cursor_off;
  4282. repeat until keypressed;
  4283. while keypressed do readkey;
  4284. display_ansi(@tcpans,co80+font8x8);
  4285. cursor_off;
  4286. write_phunliners;
  4287. write_dateinamen(Die_Files^.fn[curr_modnr]);
  4288. display_modinfos;
  4289. end;
  4290.  
  4291. procedure handle_keys(key1,key2 : char);
  4292. {
  4293. reagiert auf die Tastatur-Eingaben des Benutzers
  4294. }
  4295. var pchan : byte;
  4296. begin;
  4297. case key1 of
  4298. #00 : begin;
  4299. case key2 of
  4300. #45 : begin;
  4301. Programm_beenden := true;
  4302. end;
  4303. #72 : begin;
  4304. if modify_voice > 1 then
  4305. dec(modify_voice);
  4306. end;
  4307. #80 : begin;
  4308. if modify_voice < Modinf.Stimmen then
  4309. inc(modify_voice);
  4310. end;
  4311. #75 : begin; { cursor left }
  4312. runinf.Zeile := 64;
  4313. dec(runinf.Pattnr,2);
  4314. if runinf.Pattnr < -1 then runinf.Pattnr := -1;
  4315. end;
  4316. #77 : begin; { cursor right }
  4317. runinf.Zeile := 64;
  4318. inc(runinf.Pattnr);
  4319. end;
  4320. end;
  4321. end;
  4322. #27 : begin;
  4323. Programm_beenden := true;
  4324. end;
  4325. #32,
  4326. 'W',
  4327. 'w',
  4328. 'I',
  4329. 'i' : begin;
  4330. display_we_are;
  4331. end;
  4332. 'D',
  4333. 'd',
  4334. 'b',
  4335. 'B' : begin;
  4336. display_buy_it;
  4337. end;
  4338. 'L',
  4339. 'l' : begin;
  4340. chpos[modify_voice] := 1;
  4341. _gus_set_chanelpos;
  4342. end;
  4343. 'R',
  4344. 'r' : begin;
  4345. chpos[modify_voice] := 15;
  4346. _gus_set_chanelpos;
  4347. end;
  4348. 'M',
  4349. 'm' : begin;
  4350. chpos[modify_voice] := 7;
  4351. _gus_set_chanelpos;
  4352. end;
  4353. 'U',
  4354. 'u' : begin;
  4355. if Modinf.Stimmen = 4 then
  4356. begin
  4357. chpos[1] := 2;
  4358. chpos[2] := 5;
  4359. chpos[3] := 9;
  4360. chpos[4] := 12;
  4361. end;
  4362. if Modinf.Stimmen = 8 then
  4363. begin
  4364. chpos[1] := 1;
  4365. chpos[2] := 3;
  4366. chpos[3] := 5;
  4367. chpos[4] := 7;
  4368. chpos[5] := 7;
  4369. chpos[6] := 9;
  4370. chpos[7] := 11;
  4371. chpos[8] := 13;
  4372. end;
  4373. _gus_set_chanelpos;
  4374. end;
  4375. ',' : begin; { nach liiiinks }
  4376. if chpos[modify_voice] > 1 then
  4377. dec(chpos[modify_voice]);
  4378. _gus_set_chanelpos;
  4379. end;
  4380. '.' : begin; { nach reeeechts }
  4381. if chpos[modify_voice] < 15 then
  4382. inc(chpos[modify_voice]);
  4383. _gus_set_chanelpos;
  4384. end;
  4385. '1'..
  4386. '8' : begin;
  4387. pchan := ord(key1)-48;
  4388. if Play_Chanel[pchan] = 1 then begin;
  4389. Play_Chanel[pchan] := 0;
  4390. textcolor(10); gotoxy(77,2+pchan);
  4391. write('M'); textcolor(2);
  4392. write('UTE');
  4393. end else begin;
  4394. Play_Chanel[pchan] := 1;
  4395. textcolor(10); gotoxy(77,2+pchan);
  4396. write('C'); textcolor(2);
  4397. write('H ');
  4398. end;
  4399. end;
  4400. 'n',
  4401. 'N' : begin;
  4402. naechstes_mod;
  4403. end;
  4404. end;
  4405. end;
  4406.  
  4407. procedure screen_update;
  4408. const colvals : array[1..35] of byte =
  4409. (08,08,08,08,08,02,02,02,02,10,10,10,10,10,10,10,10,
  4410. 10,10,10,10,10,10,10,10,10,10,10,10,10,05,05,05,05,05);
  4411. var volstr : string[66];
  4412. li : integer;
  4413. auss : integer;
  4414. begin;
  4415. { Volume-Bars aktualisieren }
  4416. for li := 1 to Modinf.Stimmen do begin;
  4417. for auss := 1 to round(Runinf.Volumes[li] / 1.78) do begin;
  4418. screen[li+2,37+auss].a := colvals[auss];
  4419. end;
  4420. for auss := round(Runinf.Volumes[li] / 1.78) to 36 do begin;
  4421. screen[li+2,38+auss].a := 7;
  4422. end;
  4423. end;
  4424.  
  4425. { Farblich richtigen Hintergrund fr den Pfeil setzen }
  4426. for li := 1 to 8 do begin;
  4427. if li = modify_voice then begin;
  4428. screen[2+li,34].a := 05;
  4429. screen[2+li,35].a := 05;
  4430. screen[2+li,36].a := 05;
  4431. screen[2+li,37].a := 05;
  4432. end else begin;
  4433. screen[2+li,34].a := 07;
  4434. screen[2+li,35].a := 07;
  4435. screen[2+li,36].a := 07;
  4436. screen[2+li,37].a := 07;
  4437. end;
  4438. end;
  4439.  
  4440. { Laufzeit - Informationen des MODs ausgeben }
  4441. gotoxy(18,14);
  4442. color_writeln(Modinf.Tietel);
  4443.  
  4444. textcolor(7);
  4445. gotoxy(18,16);
  4446. write(runinf.pattnr:3);
  4447.  
  4448. gotoxy(64,16);
  4449. write(runinf.zeile:3);
  4450.  
  4451. gotoxy(64,15);
  4452. write(64:3);
  4453.  
  4454. gotoxy(18,15);
  4455. write(modinf.Patt_anz:3);
  4456.  
  4457. gotoxy(60,14);
  4458. write(runinf.speed,' / ',runinf.bpm);
  4459. end;
  4460.  
  4461. procedure user;
  4462. {
  4463. Prft auf Tastatur-Eingaben und updatet den Screen
  4464. }
  4465. var ch1,ch2 : char;
  4466. begin;
  4467. repeat
  4468. ch1 := #255;
  4469. ch2 := #255;
  4470. if keypressed then begin;
  4471. ch1 := readkey;
  4472. if keypressed then ch2 := readkey;
  4473. handle_keys(ch1,ch2);
  4474. end;
  4475. screen_update;
  4476. until Programm_beenden;
  4477. end;
  4478.  
  4479.  
  4480. procedure display_help;
  4481. {
  4482. Git das Hilfe-Ans aus. Wird auch angezeigt, wenn keine GUS gefunden wurde
  4483. }
  4484. begin;
  4485. display_ansi(@helptxt,co80+font8x8);
  4486. cursor_off;
  4487. repeat until keypressed;
  4488. while keypressed do readkey;
  4489. exit_program;
  4490. end;
  4491.  
  4492.  
  4493. function check_commandline : boolean;
  4494. {
  4495. returns true, if a module-name was given
  4496. }
  4497. var pst : string;
  4498. ist_mod : boolean;
  4499. li : integer;
  4500. retval : boolean;
  4501. begin;
  4502. retval := false;
  4503. for li := 1 to 9 do begin;
  4504. pst := paramstr(li);
  4505. ist_mod := true;
  4506.  
  4507. if (pos('-h',pst) <> 0) or (pos('-H',pst) <> 0) or
  4508. (pos('-?',pst) <> 0) then
  4509. begin;
  4510. ist_mod := false;
  4511. display_help;
  4512. end;
  4513.  
  4514. if (pst <> '') and ist_mod then begin;
  4515. if pos('.',pst) = 0 then pst := pst + '.mod';
  4516. if datei_exists(pst) then { glt. mod }
  4517. begin
  4518. inc(Die_Files^.nofiles);
  4519. Die_Files^.fn[Die_Files^.nofiles] := pst;
  4520. retval := true;
  4521. end;
  4522. end;
  4523. end;
  4524. check_commandline := retval;
  4525. end;
  4526.  
  4527. begin;
  4528. cursor_off;
  4529. clrscr;
  4530. if not _gus_init_env then display_help;
  4531.  
  4532. new(Die_Files);
  4533. new(phun);
  4534. Die_Files^.path := mod_pfad;
  4535. Die_Files^.Mask := '*.mod';
  4536. Die_Files^.sx := 24;
  4537. Die_Files^.sy := 10;
  4538. Die_Files^.nofiles := 0;
  4539.  
  4540. Die_Files^.Tietel := 'MOD Datei w„hlen !!!';
  4541. modify_voice := 1;
  4542.  
  4543. for i := 1 to 30 do
  4544. Die_Files^.fn[i] := '---';
  4545. save_screen;
  4546. if not check_commandline then begin;
  4547. select_packdateien(Die_Files);
  4548. repeat
  4549. restore_screen;
  4550.  
  4551. if Die_Files^.fn[1] = '---' then exit_program;
  4552.  
  4553. _gus_initialisieren;
  4554.  
  4555. display_ansi(@tcpans,co80+font8x8);
  4556. cursor_off;
  4557. write_phunliners;
  4558.  
  4559. curr_modnr := 1;
  4560. if not _gus_modload(Die_Files^.fn[1]) then begin;
  4561. clrscr;
  4562. gotoxy(10,10);
  4563. write('Sorry dude, Cant''t handle this MOD-File');
  4564. delay(1200);
  4565. exit_program;
  4566. end;
  4567. write_dateinamen(Die_Files^.fn[1]);
  4568. display_modinfos;
  4569. fillchar(Play_Chanel,14,1);
  4570. _gus_modstarten;
  4571.  
  4572. user;
  4573. _gus_mod_beenden;
  4574. dispose(Die_Files);
  4575. new(Die_Files);
  4576. Die_Files^.path := Mod_pfad;
  4577. Die_Files^.Mask := '*.mod';
  4578. Die_Files^.sx := 24;
  4579. Die_Files^.sy := 10;
  4580. Die_Files^.nofiles := 0;
  4581. for i := 1 to 30 do
  4582. Die_Files^.fn[i] := '---';
  4583. Programm_beenden := false;
  4584. select_packdateien(Die_Files);
  4585. until Die_Files^.fn[1] = '---';
  4586.  
  4587. dispose(Die_Files);
  4588. dispose(phun);
  4589. exit_program;
  4590. end else begin;
  4591. restore_screen;
  4592.  
  4593. if Die_Files^.fn[1] = '---' then exit_program;
  4594.  
  4595. _gus_initialisieren;
  4596.  
  4597. display_ansi(@tcpans,co80+font8x8);
  4598. cursor_off;
  4599. write_phunliners;
  4600.  
  4601. curr_modnr := 1;
  4602. _gus_modload(Die_Files^.fn[1]);
  4603. write_dateinamen(Die_Files^.fn[1]);
  4604. display_modinfos;
  4605. fillchar(Play_Chanel,14,1);
  4606. _gus_modstarten;
  4607.  
  4608. user;
  4609.  
  4610. _gus_mod_beenden;
  4611. dispose(Die_Files);
  4612. dispose(phun);
  4613. exit_program;
  4614.  
  4615. end;
  4616. end..386
  4617. .MODEL TPascal
  4618. b equ byte ptr
  4619. w equ word ptr
  4620. d equ dword ptr
  4621.  
  4622.  
  4623. .DATA
  4624.  
  4625. extrn aktuelle_stimme : word;
  4626. extrn calc_size : word;
  4627. extrn Mixed_data : dword;
  4628. extrn Mixed_posi : word;
  4629. extrn Mixed_data_st : dword;
  4630.  
  4631. extrn Mixingprocs : dword;
  4632. extrn Leerstimme : dword;
  4633.  
  4634. extrn Laenge_Stimme : dword
  4635. extrn Position_Stimme : dword
  4636. extrn Loop_Laenge_Stimme : dword
  4637. extrn Loop_Start_Stimme : dword
  4638. extrn Segment_Stimme : dword
  4639. extrn Notvol_Stimme : dword
  4640. extrn Incval_Stimme : dword
  4641.  
  4642.  
  4643. .CODE
  4644.  
  4645.  
  4646. public stimme_normal
  4647. stimme_normal proc pascal ;aktuelle_stimme : word;
  4648. pusha
  4649. mov si,aktuelle_stimme
  4650. dec si
  4651. shl si,2 ; fr dword-Zugriffw
  4652.  
  4653. mov cx,calc_size
  4654.  
  4655. @Lade_loop:
  4656.  
  4657. ;{ Ist die Stimme am Ende angekommen ? }
  4658. mov bx,w Laenge_Stimme[si]
  4659. sub bx,20
  4660. cmp bx,word ptr Position_Stimme[si+2]
  4661. ja @Stimme_nicht_am_Ende
  4662.  
  4663. ;{ Stimme am Ende, Ist sie geloopt ? }
  4664. cmp Loop_Laenge_Stimme[si],10
  4665. jae @Stimme_ist_geloopt
  4666.  
  4667. ;{Stimme ist am Ende und nicht geloopt => raus}
  4668. mov eax,leerstimme
  4669. mov Mixingprocs[si],eax
  4670. mov Notvol_Stimme[si],0
  4671. jmp @ende_stimme_normal
  4672.  
  4673. ; {Parameter fr Stimme1 auf Anfang der Loop }
  4674. @Stimme_ist_geloopt:
  4675. mov bx,w Loop_Start_Stimme[si]
  4676. mov word ptr Position_Stimme[si + 2],bx
  4677.  
  4678. ; {Byte aus Sampel der Stimme1 laden }
  4679. @Stimme_nicht_am_Ende:
  4680. mov bx,w Segment_Stimme[si]
  4681. mov es,bx
  4682. mov bx,word ptr Position_Stimme[si + 2]
  4683. mov al,es:[bx]
  4684. sub al,128
  4685. mul b Notvol_Stimme[si]
  4686. shr ax,6
  4687.  
  4688. @Stimme_ausgeben:
  4689. les di,mixed_data
  4690. add di,mixed_posi
  4691. add es:[di],ax
  4692. add mixed_posi,2
  4693.  
  4694. ; {Zeiger weitersetzen}
  4695. mov ebx,Incval_Stimme[si]
  4696. add dword ptr Position_Stimme[si],ebx
  4697.  
  4698. loop @Lade_loop
  4699.  
  4700. @ende_stimme_normal:
  4701. popa
  4702. ret
  4703. stimme_normal endp
  4704.  
  4705.  
  4706.  
  4707. public stimme_normal_st
  4708. stimme_normal_st proc pascal ;aktuelle_stimme : word;
  4709. pusha
  4710. mov si,aktuelle_stimme
  4711. dec si
  4712. shl si,2 ; fr dword-Zugriffw
  4713.  
  4714. mov cx,calc_size
  4715.  
  4716. @Lade_loop_st:
  4717.  
  4718. ;{ Ist die Stimme am Ende angekommen ? }
  4719. mov bx,w Laenge_Stimme[si]
  4720. sub bx,20
  4721. cmp bx,word ptr Position_Stimme[si+2]
  4722. ja @Stimme_nicht_am_Ende_st
  4723.  
  4724. ;{ Stimme am Ende, Ist sie geloopt ? }
  4725. cmp Loop_Laenge_Stimme[si],10
  4726. jae @Stimme_ist_geloopt_st
  4727.  
  4728. ;{Stimme ist am Ende und nicht geloopt => raus}
  4729. mov eax,leerstimme
  4730. mov Mixingprocs[si],eax
  4731. mov ax,127
  4732. mov Notvol_Stimme[si],0
  4733. jmp @ende_stimme_normal_st
  4734.  
  4735. ; {Parameter fr Stimme1 auf Anfang der Loop }
  4736. @Stimme_ist_geloopt_st:
  4737. mov bx,w Loop_Start_Stimme[si]
  4738. mov word ptr Position_Stimme[si + 2],bx
  4739.  
  4740. ; {Byte aus Sampel der Stimme1 laden }
  4741. @Stimme_nicht_am_Ende_st:
  4742. mov bx,w Segment_Stimme[si]
  4743. mov es,bx
  4744. mov bx,word ptr Position_Stimme[si + 2]
  4745. mov al,es:[bx]
  4746. sub al,128
  4747. mul b Notvol_Stimme[si]
  4748. shr ax,6
  4749.  
  4750. @Stimme_ausgeben_st:
  4751. les di,mixed_data_st
  4752. add di,mixed_posi
  4753. add es:[di],ax
  4754. add mixed_posi,2
  4755.  
  4756. ; {Zeiger weitersetzen}
  4757. mov ebx,Incval_Stimme[si]
  4758. add dword ptr Position_Stimme[si],ebx
  4759.  
  4760. loop @Lade_loop_st
  4761.  
  4762. @ende_stimme_normal_st:
  4763. popa
  4764. ret
  4765. stimme_normal_st endp
  4766.  
  4767.  
  4768.  
  4769.  
  4770.  
  4771.  
  4772. public Leere_Stimme
  4773. Leere_Stimme proc pascal
  4774. ret
  4775. Leere_Stimme endp
  4776.  
  4777. END
  4778. unit design;
  4779.  
  4780. interface
  4781. uses crt,windos;
  4782.  
  4783. procedure writexy(x,y : integer;s : string);
  4784. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  4785. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  4786. function wrhexb(b : byte) : string;
  4787. function wrhexw(w : word) : string;
  4788. procedure save_screen;
  4789. procedure restore_screen;
  4790. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  4791. procedure cursor_On;
  4792. procedure cursor_Off;
  4793.  
  4794. implementation
  4795.  
  4796. var filenames : array[1..512] of string[12];
  4797. const Screen_Akt : byte = 1;
  4798.  
  4799. procedure writexy(x,y : integer;s : string);
  4800. begin;
  4801. gotoxy(x,y);
  4802. write(s);
  4803. end;
  4804.  
  4805. procedure save_screen;
  4806. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  4807. begin;
  4808. if Screen_Akt <= 4 then begin;
  4809. inc(Screen_Akt);
  4810. move(screen[1],screen[Screen_Akt],8000);
  4811. end;
  4812. end;
  4813.  
  4814. procedure restore_screen;
  4815. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  4816. begin;
  4817. if Screen_Akt >= 2 then begin;
  4818. move(screen[Screen_Akt],screen[1],8000);
  4819. dec(Screen_Akt);
  4820. end;
  4821. end;
  4822.  
  4823. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  4824. const frames : array[1..2,1..6] of char =
  4825. (('Ú','¿','Ù','À','Ä','³'),
  4826. ('É','»','¼','È','Í','º'));
  4827. var lx,ly : integer;
  4828. s : string;
  4829. begin;
  4830. { obere Zeile }
  4831. s := frames[rt,1];
  4832. for lx := 1 to dx-2 do s := s + frames[rt,5];
  4833. s := s + frames[rt,2];
  4834. gotoxy(startx,starty);
  4835. write(s);
  4836. { mittleren Zeilen }
  4837. for ly := 1 to dy-2 do begin;
  4838. s := frames[rt,6];
  4839. for lx := 1 to dx-2 do s := s + ' ';
  4840. s := s + frames[rt,6];
  4841. gotoxy(startx,starty+ly);
  4842. write(s);
  4843. end;
  4844. { untere Zeile }
  4845. s := frames[rt,4];
  4846. for lx := 1 to dx-2 do s := s + frames[rt,5];
  4847. s := s + frames[rt,3];
  4848. gotoxy(startx,starty+dy-1);
  4849. write(s);
  4850. end;
  4851.  
  4852. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  4853. var tlaeng : byte;
  4854. deltx,tstartpos : byte;
  4855. begin;
  4856. tlaeng := length(s);
  4857. tstartpos := x + ((dx-Tlaeng) SHR 1);
  4858. textcolor(rcol);
  4859. textbackground(bcol);
  4860. rahmen(1,x,y,dx,dy);
  4861. writexy(tstartpos,y,s);
  4862. end;
  4863.  
  4864. procedure sort_filenames(start,ende : integer);
  4865. {
  4866. Hier sollte fr gr”áere Verzeichnise Quick-Sort eingebaut werden !
  4867. }
  4868. var hilfe : string;
  4869. l1,l2 : integer;
  4870. begin;
  4871. for l1 := start to ende-1 do begin;
  4872. for l2 := start to ende-1 do begin;
  4873. if filenames[l2] > filenames[l2+1] then begin;
  4874. hilfe := filenames[l2];
  4875. filenames[l2] := filenames[l2+1];
  4876. filenames[l2+1] := hilfe;
  4877. end;
  4878. end;
  4879. end;
  4880. end;
  4881.  
  4882. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  4883. const zeile : byte = 1;
  4884. spalte : byte = 0;
  4885. Start_fndisp : word = 0;
  4886. var
  4887. DirInfo: TSearchRec;
  4888. count : integer;
  4889. Nullpos : byte;
  4890. var li,lj : integer;
  4891. inp : char;
  4892. retval : string;
  4893. kasten_gefunden : boolean;
  4894. select : byte;
  4895. changed : boolean;
  4896. End_fndisp : word;
  4897. begin
  4898. {$I+}
  4899. for li := 1 to 512 do filenames[li] := ' - - -';
  4900. count := 1;
  4901. FindFirst(mask, faArchive, DirInfo);
  4902. while DosError = 0 do
  4903. begin
  4904. filenames[count] := (DirInfo.Name);
  4905. Nullpos := pos(#0,filenames[count]);
  4906. if Nullpos <> 0 then
  4907. filenames[count] := copy(filenames[count],0,Nullpos-1);
  4908. inc(count);
  4909. FindNext(DirInfo);
  4910. end;
  4911. {$I-}
  4912.  
  4913. sort_filenames(1,count-1);
  4914. save_screen;
  4915. Fenster(5,4,72,16,comment,black,7);
  4916. textcolor(1);
  4917. writexy(21,5,' Bitte Datei ausw„hlen');
  4918. textcolor(black);
  4919. inp := #255;
  4920. changed := true;
  4921. repeat
  4922. textcolor(black);
  4923. if changed then begin;
  4924. changed := false;
  4925. for lj := 0 to 4 do begin;
  4926. for li := 1 to 12 do begin;
  4927. writexy(7+lj*14,5+li,' ');
  4928. writexy(7+lj*14,5+li,filenames[lj*12+li+Start_fndisp]);
  4929. end;
  4930. end;
  4931. textcolor(14);
  4932. writexy(7+Spalte*14,5+Zeile,filenames[Spalte*12+Zeile+Start_fndisp]);
  4933. end;
  4934. if keypressed then inp := readkey;
  4935. if ord(inp) = 0 then inp := readkey;
  4936. case ord(inp) of
  4937. 32,
  4938. 13: begin;
  4939. inp := #13;
  4940. changed := true;
  4941. if (pos('- - -',filenames[Spalte*12+Zeile+Start_fndisp]) = 0) then
  4942. retval := filenames[Spalte*12+Zeile+Start_fndisp]
  4943. else
  4944. retval := 'xxxx';
  4945. end;
  4946. 27: begin;
  4947. inp := #27;
  4948. changed := true;
  4949. retval := 'xxxx';
  4950. end;
  4951. 71: begin; { Pos 1 }
  4952. inp := #255;
  4953. Zeile := 1;
  4954. Spalte := 0;
  4955. changed := true;
  4956. end;
  4957. 72: begin; { Pfeil up }
  4958. inp := #255;
  4959. changed := true;
  4960. if not ((Zeile = 1) and (Spalte = 0)) then
  4961. dec(Zeile);
  4962. if Zeile = 0 then begin;
  4963. dec(Spalte);
  4964. Zeile := 12;
  4965. end;
  4966. end;
  4967. 73: begin; { Page UP }
  4968. if Start_fndisp >= 12 then
  4969. dec(Start_fndisp,12)
  4970. else begin;
  4971. Start_fndisp := 0;
  4972. Zeile := 1;
  4973. end;
  4974. inp := #255;
  4975. changed := true;
  4976. end;
  4977. 81: begin; { Page Down }
  4978. if ((Spalte+1)*12+Start_fndisp < count) and
  4979. (Start_fndisp < 500) then
  4980. inc(Start_fndisp,12)
  4981. else
  4982. Start_fndisp := count-11;
  4983. inp := #255;
  4984. changed := true;
  4985. end;
  4986. 75: begin; { Pfeil links }
  4987. inp := #255;
  4988. changed := true;
  4989. if Spalte = 0 then begin;
  4990. if Start_fndisp >= 12 then dec(Start_fndisp,12);
  4991. end else begin;
  4992. if Spalte > 0 then dec(Spalte);
  4993. end;
  4994. end;
  4995. 77: begin; { Pfeil rechts }
  4996. inp := #255;
  4997. changed := true;
  4998. if Spalte = 4 then begin;
  4999. if ((Spalte+1)*12+Start_fndisp < count) and
  5000. (Start_fndisp < 500) then inc(Start_fndisp,12);
  5001. end else begin;
  5002. if (Spalte < 4) and
  5003. (Zeile+(Spalte+1)*12+Start_fndisp < count) then
  5004. inc(Spalte);
  5005. end;
  5006. end;
  5007. 79: begin; { End }
  5008. inp := #255;
  5009. changed := true;
  5010. Spalte := (count-Start_fndisp-12) div 12;
  5011. Zeile := (count-Start_fndisp) - Spalte*12 -1;
  5012. end;
  5013. 80: begin; { Pfeil down }
  5014. inp := #255;
  5015. changed := true;
  5016. if ((Zeile = 12) and (Spalte = 4)) then begin;
  5017. if (Start_fndisp+Zeile+Spalte*12 < count-1) then begin;
  5018. inc(Start_fndisp,1);
  5019. end;
  5020. end else begin;
  5021. if (Start_fndisp+Zeile+Spalte*12 < count-1) then
  5022. inc(Zeile);
  5023. end;
  5024. if Zeile > 12 then begin;
  5025. inc(Spalte);
  5026. Zeile := 1;
  5027. end;
  5028. end;
  5029. 82 : begin;
  5030. changed := true;
  5031. save_screen;
  5032. textcolor(black);
  5033. rahmen(2,16,9,45,5);
  5034. writexy(20,10,' Dateinamen eingeben ('+mtext+')');
  5035. writexy(20,12,'Name: ');
  5036. readln(retval);
  5037. if retval = '' then retval := 'xxxx';
  5038. restore_screen;
  5039. end;
  5040. end;
  5041. until (inp = #13) or (inp = #27) or (inp = #32)
  5042. or (inp = #82);
  5043. restore_screen;
  5044. textbackground(black);
  5045. textcolor(7);
  5046. select_datei := retval;
  5047. end;
  5048.  
  5049. function wrhexb(b : byte) : string;
  5050. const hexcar : array[0..15] of char =
  5051. ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  5052. begin;
  5053. wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
  5054. end;
  5055.  
  5056. function wrhexw(w : word) : string;
  5057. begin;
  5058. wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
  5059. end;
  5060.  
  5061. procedure cursor_Off; assembler;
  5062. asm
  5063. xor ax,ax
  5064. mov ah,01h
  5065. mov cx,2020h
  5066. int 10h
  5067. end;
  5068.  
  5069. procedure cursor_on; assembler;
  5070. asm
  5071. mov ah,01h
  5072. mov cx,0607h
  5073. int 10h
  5074. end;
  5075.  
  5076.  
  5077.  
  5078. begin;
  5079. end.{
  5080.  
  5081. ****************************************************************************
  5082. *** DATA BECKERs "PC UNDERGROUND" ***
  5083. *** ================================ ***
  5084. *** ***
  5085. *** Beispielprogramm MOD386 ***
  5086. *** ***
  5087. *** Das Programm demonstriert den Einsatz der Unit MOD_SB. Sie k”nnen ***
  5088. *** 4- und 8-Stimmige MOD-Dateien abspielen. Durch Drcken der Taste ***
  5089. *** "p" w„hrend des Abspielens k”nnen Sie sich die verbleibende ***
  5090. *** Processor-Performance ansehen. Sie wird ermittelt, indem die Zeit, ***
  5091. *** die vor einem Retrace zur Verfgung steht, gemessen wird. ***
  5092. *** ***
  5093. *** Autor : Boris Bertelsons (InspirE) ***
  5094. *** Dateiname : MOD386.PAS ***
  5095. *** Letzte Žnderung : 04.04.1994 ***
  5096. *** Version : 2.0 ***
  5097. *** Compiler : Turbo Pascal 6.0 und h”her ***
  5098. ****************************************************************************
  5099.  
  5100. }
  5101.  
  5102.  
  5103.  
  5104. uses crt,dos,mod_sb,variab,design;
  5105.  
  5106. { $define polling}
  5107. {
  5108. Normalerweise erfolgt die Ausgabe ber den Timer-Interrupt. Wenn Sie jedoch
  5109. mit dem horizontalen Retrace syncronisieren mssen, dann mssen Sie die
  5110. Polling-Methode benutzen, die den Sound nicht periodisch berechnet, sondern
  5111. dann, wenn Zeit ist. Diesse Methode ist leider etwas langsamer und fhrt
  5112. zu klanglichen Verlusten. Desweiteren kann Sie zu Problemen mit 8-Stimmigen
  5113. MODs fhren. Sie sollte also nur eingesetzt werden, wenn es sich nicht
  5114. "vermeiden" l„át.
  5115. }
  5116.  
  5117. type
  5118. t = record { Fr direkte Screen-Ausgabe }
  5119. c : char;
  5120. a : byte;
  5121. end;
  5122.  
  5123. const Nummods : byte = 0;
  5124. repeatmode : boolean = false;
  5125.  
  5126. var gi : integer;
  5127. my_modname : string;
  5128. stapo,stinc : integer;
  5129. ch,dch : char;
  5130. next_song : integer;
  5131. effects : array[1..4] of effect_type;
  5132. Modd : array[1..10] of string;
  5133.  
  5134. procedure Scala_Kasten;
  5135. var li : integer;
  5136. begin;
  5137. textcolor(1);
  5138. textbackground(black);
  5139. clrscr;
  5140. write(' MOD386 Version 2.0, (c) 1994 DATA BECKER',
  5141. ' Coding: Boris Bertelsons (InspirE)');
  5142. textcolor(lightblue);
  5143. for li := 1 to 10 do begin;
  5144. gotoxy(2,li+4);
  5145. write(li:2,'. ',instnamen[li]);
  5146. gotoxy(28,li+4);
  5147. write(li+10:2,'. ',instnamen[li+10]);
  5148. gotoxy(54,li+4);
  5149. write(li+20:2,'. ',instnamen[li+20]);
  5150. end;
  5151. if Stimmen = 4 then begin;
  5152. textcolor(black);
  5153. textbackground(7);
  5154. writexy(02,16,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ'+
  5155. 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  5156. writexy(02,17,'º º '+
  5157. ' º');
  5158. writexy(02,18,'º º '+
  5159. ' º');
  5160. writexy(02,19,'º º '+
  5161. ' º');
  5162. writexy(02,20,'º º '+
  5163. ' º');
  5164. writexy(02,21,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ'+
  5165. 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
  5166. gotoxy(1,23);
  5167. end else begin;
  5168. textcolor(black);
  5169. textbackground(7);
  5170. writexy(02,16,'ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ'+
  5171. 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  5172. writexy(02,17,'º º '+
  5173. ' º');
  5174. writexy(02,18,'º º '+
  5175. ' º');
  5176. writexy(02,19,'º º '+
  5177. ' º');
  5178. writexy(02,20,'º º '+
  5179. ' º');
  5180. writexy(02,21,'º º '+
  5181. ' º');
  5182. writexy(02,22,'º º '+
  5183. ' º');
  5184. writexy(02,23,'º º '+
  5185. ' º');
  5186. writexy(02,24,'º º '+
  5187. ' º');
  5188. writexy(02,25,'ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ'+
  5189. 'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
  5190. gotoxy(1,23);
  5191. end;
  5192. textbackground(black);
  5193. textcolor(lightblue);
  5194. writexy(47,2,'Volume: ');
  5195. textcolor(lightcyan);
  5196. write(Mastervolume:2);
  5197. textcolor(lightblue);
  5198. textbackground(black);
  5199. writexy(58,2,'Balance ');
  5200. textcolor(14);
  5201. writexy(66,2,'þþþþþþþþþþþþþ');
  5202. textcolor(4);
  5203. writexy(78-Balance DIV 2,2,'þ');
  5204. textcolor(lightblue);
  5205. textbackground(black);
  5206. writexy(36,2,'Filter');
  5207. textcolor(lightcyan);
  5208. write(' OFF');
  5209. end;
  5210.  
  5211. procedure Scala;
  5212. var li,lj : integer;
  5213. screen : array[1..50,1..80] of t absolute $B800:$0000;
  5214. secu : string[3];
  5215. begin;
  5216. textcolor(lightblue);
  5217. textbackground(black);
  5218. str(Laufsec,secu);
  5219. if laufsec < 10 then secu := '0'+secu;
  5220. gotoxy(2,3);
  5221. write('Songname : ');
  5222. textcolor(lightcyan);
  5223. write(Songname);
  5224. gotoxy(34,3);
  5225. textcolor(lightblue);
  5226. write('Frequenz : ');
  5227. textcolor(lightcyan);
  5228. write(Sampling_Frequenz:5);
  5229. textcolor(lightblue);
  5230. write(' KHz Laufzeit : ');
  5231. textcolor(lightcyan);
  5232. write(Laufmin:2,':',secu);
  5233. gotoxy(2,4);
  5234. textcolor(lightblue);
  5235. write('Pattern No.:');
  5236. textcolor(lightcyan);
  5237. write(Lied[mlj]:3);
  5238. textcolor(lightblue);
  5239. write(' Pattern :');
  5240. textcolor(lightcyan);
  5241. write(mlj:3,'/',Liedlaenge:3);
  5242. textcolor(lightblue);
  5243. write(' Zeile :');
  5244. textcolor(lightcyan);
  5245. write(mli:3);
  5246. textcolor(lightblue);
  5247. write(' Geschwindigkeit : ');
  5248. textcolor(lightcyan);
  5249. write(Playspeed:3,'/128');
  5250. gotoxy(2,2);
  5251. textcolor(lightblue);
  5252. write('Memory Free : ');
  5253. textcolor(lightcyan);
  5254. write(Maxavail:6,' KB');
  5255. textcolor(black);
  5256. textbackground(7);
  5257. for li := 1 to Stimmen do
  5258. if In_St[li] <> 0 then writexy(4,16+li,Instnamen[In_St[li]]);
  5259.  
  5260. for lj := 1 to Stimmen do begin;
  5261. for li := 1 to 16 do begin;
  5262. if (Noten_Anschlag[lj] div 10) > li then
  5263. begin;
  5264. screen[16 +lj,29+li].c := 'þ';
  5265. screen[16 +lj,29+li].a := 114;
  5266. end else begin;
  5267. screen[16 +lj,29+li].c := 'þ';
  5268. screen[16 +lj,29+li].a := 112;
  5269. end;
  5270. end;
  5271. for li := 16 to 32 do begin;
  5272. if (Noten_Anschlag[lj] div 10) > li then
  5273. begin;
  5274. screen[16 +lj,29+li].c := 'þ';
  5275. screen[16 +lj,29+li].a := 126;
  5276. end else begin;
  5277. screen[16 +lj,29+li].c := 'þ';
  5278. screen[16 +lj,29+li].a := 112;
  5279. end;
  5280. end;
  5281. for li := 33 to 48 do begin;
  5282. if (Noten_Anschlag[lj] div 10) > li then
  5283. begin;
  5284. screen[16 +lj,29+li].c := 'þ';
  5285. screen[16 +lj,29+li].a := 116;
  5286. end else begin;
  5287. screen[16 +lj,29+li].c := 'þ';
  5288. screen[16 +lj,29+li].a := 112;
  5289. end;
  5290. end;
  5291. end;
  5292. end;
  5293.  
  5294. var retraceincs : word;
  5295. systemspeed : longint;
  5296. modspeed : longint;
  5297.  
  5298. procedure test_waitretrace;
  5299. begin;
  5300. retraceincs := 0;
  5301. asm
  5302. MOV DX,03dAh
  5303. @WD_R:
  5304. inc word ptr retraceincs
  5305. IN AL,DX
  5306. TEST AL,8d
  5307. JZ @WD_R
  5308. @WD_D:
  5309. inc word ptr retraceincs
  5310. IN AL,DX
  5311. TEST AL,8d
  5312. JNZ @WD_D
  5313. end;
  5314. end;
  5315.  
  5316. procedure test_systemspeed;
  5317. var li : integer;
  5318. begin;
  5319. writeln;
  5320. writeln('Testing System-Speed, please wait ...');
  5321. writeln;
  5322. test_waitretrace;
  5323. systemspeed := 0;
  5324. for li := 1 to 70 do begin;
  5325. test_waitretrace;
  5326. systemspeed := systemspeed+retraceincs;
  5327. end;
  5328. end;
  5329.  
  5330. procedure test_modspeed;
  5331. var li : integer;
  5332. begin;
  5333. writeln;
  5334. writeln('Testing MOD-Speed, please wait ...');
  5335. writeln;
  5336. test_waitretrace;
  5337. modspeed := 0;
  5338. for li := 1 to 210 do begin;
  5339. test_waitretrace;
  5340. modspeed := modspeed+retraceincs;
  5341. end;
  5342. modspeed := modspeed div 3;
  5343. end;
  5344.  
  5345. procedure write_performance;
  5346. begin;
  5347. writeln;
  5348. writeln('Remain :',(modspeed*100/systemspeed):6:2,' % Processor performance');
  5349. writeln;
  5350. writeln;
  5351. writeln;
  5352. write('Press Enter to continue ...');
  5353. readln;
  5354. end;
  5355.  
  5356. procedure Play_the_Mod(s : string);
  5357. var h : byte;
  5358. error : integer;
  5359. li : integer;
  5360. begin;
  5361. { if not SB16Detected then} Reset_Sb16;
  5362. mod_SetSpeed(66);
  5363. mod_Samplefreq(Samfreq);
  5364. dsp_rdy_sb16 := true;
  5365. error := lade_moddatei(s,AUTO,AUTO,Samfreq);
  5366. if error <> 0 then begin;
  5367. clrscr;
  5368. writeln('Fehler beim Laden der MOD-Datei ! ');
  5369. if error = -1 then writeln('Datei nicht gefunden !');
  5370. if error = -2 then writeln('Nicht gengend Speicher verfgbar !');
  5371. halt(0);
  5372. end;
  5373. {$ifdef polling}
  5374. start_polling;
  5375. {$else}
  5376. periodisch_on; { Schaltet das periodische Abspielen ein }
  5377. {$endif}
  5378.  
  5379. Scala_Kasten;
  5380. ch := #255;
  5381. while not (ch=#27) and not (upcase(ch)='X')
  5382. and not (upcase(ch)='N') do begin;
  5383. {$ifdef polling}
  5384. mod_waitretrace(15);
  5385. {$endif}
  5386. Scala;
  5387. if keypressed then ch := readkey;
  5388. case ch of
  5389. #0 : begin;
  5390. dch := readkey;
  5391. case dch of
  5392. #61 : begin; { F3 }
  5393. if Mastervolume > 0 then dec(Mastervolume);
  5394. Set_Volume(Mastervolume);
  5395. textbackground(black);
  5396. textcolor(lightblue);
  5397. writexy(47,2,'Volume: ');
  5398. textcolor(lightcyan);
  5399. write(Mastervolume:2);
  5400. ch := #255;
  5401. end;
  5402. #62 : begin; { F4 }
  5403. if Mastervolume < 31 then inc(Mastervolume);
  5404. Set_Volume(Mastervolume);
  5405. textbackground(black);
  5406. textcolor(lightblue);
  5407. writexy(47,2,'Volume: ');
  5408. textcolor(lightcyan);
  5409. write(Mastervolume:2);
  5410. ch := #255;
  5411. end;
  5412. #63 : begin; { F5 }
  5413. if Balance > 0 then dec(Balance);
  5414. Set_Balance(Balance);
  5415. textcolor(lightblue);
  5416. textbackground(black);
  5417. writexy(58,2,'Balance ');
  5418. textcolor(14);
  5419. writexy(66,2,'þþþþþþþþþþþþþ');
  5420. textcolor(4);
  5421. writexy(78-Balance DIV 2,2,'þ');
  5422. ch := #255;
  5423. end;
  5424. #64 : begin; { F6 }
  5425. if Balance < 24 then inc(Balance);
  5426. Set_Balance(Balance);
  5427. textcolor(lightblue);
  5428. textbackground(black);
  5429. writexy(58,2,'Balance ');
  5430. textcolor(14);
  5431. writexy(66,2,'þþþþþþþþþþþþþ');
  5432. textcolor(4);
  5433. writexy(78-Balance DIV 2,2,'þ');
  5434. ch := #255;
  5435. end;
  5436. else begin;
  5437. ch := #255;
  5438. end;
  5439. end;
  5440. end;
  5441. '6' : begin;
  5442. inc(mli);
  5443. ch := #255;
  5444. end;
  5445. 'P',
  5446. 'p' : begin;
  5447. textcolor(7);
  5448. textbackground(black);
  5449. clrscr;
  5450. test_modspeed;
  5451. write_performance;
  5452. Scala_Kasten;
  5453. ch := #255;
  5454. end;
  5455. 'f' : begin;
  5456. filter_activ := not filter_activ;
  5457. if filter_activ then begin;
  5458. filter_ein;
  5459. textcolor(lightblue);
  5460. textbackground(black);
  5461. writexy(36,2,'Filter');
  5462. textcolor(lightcyan);
  5463. write(' ON ');
  5464. end else begin;
  5465. filter_mid;
  5466. textcolor(lightblue);
  5467. textbackground(black);
  5468. writexy(36,2,'Filter');
  5469. textcolor(lightcyan);
  5470. write(' OFF');
  5471. end;
  5472. ch := #255;
  5473. end;
  5474. '4' : begin;
  5475. if mli > 0 then
  5476. dec(mli)
  5477. else begin;
  5478. if mlj > 0 then begin;
  5479. dec(mlj);
  5480. mli := 63
  5481. end else begin;
  5482. mli := 0;
  5483. mlj := 0;
  5484. end;
  5485. end;
  5486. ch := #255;
  5487. end;
  5488. '3' : begin;
  5489. mli := 0;
  5490. inc(mlj);
  5491. ch := #255;
  5492. end;
  5493. '1' : begin;
  5494. if mlj > 0 then begin;
  5495. dec(mlj);
  5496. mli := 0;
  5497. end;
  5498. ch := #255;
  5499. end;
  5500. 'N',
  5501. 'n' : begin;
  5502. next_song := 1;
  5503. end;
  5504. 'x' : begin;
  5505. next_song := 255;
  5506. end;
  5507. #27 : begin;
  5508. next_song := 255;
  5509. end;
  5510. else begin;
  5511. ch := #255;
  5512. end;
  5513. end;
  5514. end;
  5515. outfading := true;
  5516. while outvolume > 1 do begin;
  5517. Scala;
  5518. end;
  5519. {$ifndef polling}
  5520. periodisch_off;
  5521. {$endif}
  5522. ende_mod;
  5523. { if not SB16Detected then} Reset_Sb16;
  5524. end;
  5525.  
  5526. procedure Write_Helptext;
  5527. begin;
  5528. textcolor(lightgray);
  5529. textbackground(black);
  5530. clrscr;
  5531. writeln(' MOD386 Version 2.0, (c) 1994 DATA BECKER',
  5532. ' Coding: Boris Bertelsons (InspirE)');
  5533. writeln;
  5534. writeln(' Usage: Mod386 <Filename[.MOD]> [optionen]');
  5535. writeln;
  5536. writeln(' Optionen sind:');
  5537. writeln(' -H : Dieser Screen');
  5538. writeln(' -In : Benutze den Interrupt n');
  5539. writeln(' -Dn : Benutze den DMA-Kanal n');
  5540. writeln(' -Pxxx : Benutze die Baseadresse xxx');
  5541. writeln(' -Snn : W„hle Sampelrate in KHz. Zul„ssig: ',
  5542. '8,10,13,16,22');
  5543. writeln(' -r : Schaltet den Repeat-Select Modus ein');
  5544. writeln(' -sb : Keine Erkennung einer SB16');
  5545. writeln(' <name> : zus„tzliche .MOD-Datei, spielt in zuf„lliger',
  5546. ' Reihenfolge');
  5547. writeln;
  5548. writeln;
  5549. writeln(' - Taste fr mehr -');
  5550. writeln;
  5551. repeat until keypressed; readkey;
  5552. clrscr;
  5553. writeln(' MOD386 Version 2.0, (c) 1994 DATA BECKER',
  5554. ' Coding: Boris Bertelsons (InspirE)');
  5555. writeln;
  5556. writeln(' Tastaturbelegung w„hrend des Abspielens ');
  5557. writeln;
  5558. writeln(' F : Schaltet den X-Bass Filter Ein/Aus');
  5559. writeln(' F3 : Lautst„rke leiser F4 : Lautst„rke lauter ');
  5560. writeln(' F5 : Balance nach links F6 : Balance nach rechts');
  5561. writeln(' 1 : Ein Pattern zurck 3 : Ein Pattern vor');
  5562. writeln(' 4 : Eine Zeile zurck 6 : Eine Zeile vor');
  5563. writeln(' n : N„chste Datei esc,X : Beenden');
  5564. writeln(' p : Remaining System Performance');
  5565. writeln;
  5566. Cursor_On;
  5567. halt(0);
  5568. end;
  5569.  
  5570. procedure interprete_commandline;
  5571. var cs,hs : string;
  5572. li,code : integer;
  5573. sampelfr : word;
  5574. Datnm : boolean;
  5575. begin;
  5576. for li := 1 to 10 do begin;
  5577. cs := paramstr(li);
  5578. Datnm := true;
  5579. { Hilfe Angefordert ? }
  5580. if (pos('-h',cs) <> 0) or (pos('/h',cs) <> 0) or
  5581. (pos('-H',cs) <> 0) or (pos('/H',cs) <> 0) or
  5582. (pos('-?',cs) <> 0) or (pos('/?',cs) <> 0) then begin;
  5583. write_Helptext;
  5584. Datnm := false;
  5585. end;
  5586. { Repeatmode ? }
  5587. if (pos('-r',cs) <> 0) or (pos('/r',cs) <> 0) or
  5588. (pos('-R',cs) <> 0) or (pos('/R',cs) <> 0) then begin;
  5589. Repeatmode := true;
  5590. Datnm := false;
  5591. end;
  5592. { Force NO Sb16 ? }
  5593. if (pos('-sb',cs) <> 0) or (pos('/sb',cs) <> 0) or
  5594. (pos('-SB',cs) <> 0) or (pos('/SB',cs) <> 0) then begin;
  5595. force_SB := true;
  5596. Datnm := false;
  5597. end;
  5598. if (pos('-i',cs) <> 0) or (pos('/i',cs) <> 0) or
  5599. (pos('-I',cs) <> 0) or (pos('/I',cs) <> 0) then begin;
  5600. force_irq := true;
  5601. hs := copy(cs,3,length(cs)-2);
  5602. val(hs,dsp_irq,code);
  5603. Datnm := false;
  5604. end;
  5605. { Force DMA ? }
  5606. if (pos('-d',cs) <> 0) or (pos('/d',cs) <> 0) or
  5607. (pos('-D',cs) <> 0) or (pos('/D',cs) <> 0) then begin;
  5608. force_dma := true;
  5609. hs := copy(cs,3,length(cs)-2);
  5610. val(hs,dma_ch,code);
  5611. Datnm := false;
  5612. end;
  5613. { Force Base ? }
  5614. if (pos('-p',cs) <> 0) or (pos('/p',cs) <> 0) or
  5615. (pos('-P',cs) <> 0) or (pos('/P',cs) <> 0) then begin;
  5616. hs := copy(cs,3,length(cs)-2);
  5617. if hs = '200' then dsp_adr := $200;
  5618. if hs = '210' then dsp_adr := $210;
  5619. if hs = '220' then dsp_adr := $220;
  5620. if hs = '230' then dsp_adr := $230;
  5621. if hs = '240' then dsp_adr := $240;
  5622. if hs = '250' then dsp_adr := $250;
  5623. if hs = '260' then dsp_adr := $260;
  5624. if hs = '270' then dsp_adr := $270;
  5625. if hs = '280' then dsp_adr := $280;
  5626. Startport := dsp_adr;
  5627. Endport := dsp_adr;
  5628. Datnm := false;
  5629. end;
  5630. { Setze Sampelrate ? }
  5631. if (pos('-s',cs) <> 0) or (pos('/s',cs) <> 0) or
  5632. (pos('-S',cs) <> 0) or (pos('/S',cs) <> 0) then begin;
  5633. hs := copy(cs,3,length(cs)-2);
  5634. val(hs,Sampelfr,code);
  5635. if Sampelfr >= 8000 then Sampelfr := Sampelfr DIV 1000;
  5636. if Sampelfr >= 8 then Samfreq := 8;
  5637. if Sampelfr >= 10 then Samfreq := 10;
  5638. if Sampelfr >= 13 then Samfreq := 13;
  5639. if Sampelfr >= 16 then Samfreq := 16;
  5640. if Sampelfr >= 22 then Samfreq := 22;
  5641. Datnm := false;
  5642. end;
  5643. if Datnm then begin;
  5644. if cs <> '' then begin;
  5645. Inc(Nummods);
  5646. Modd[Nummods] := cs;
  5647. end;
  5648. end;
  5649. end;
  5650. end;
  5651.  
  5652. procedure write_vocmessage;
  5653. begin;
  5654. clrscr;
  5655. writexy(10,08,'Achtung ! Das VOC wird gnadenlos geloopt !!!');
  5656. writexy(10,10,'Beenden mit der Taste >> Q <<');
  5657. writexy(10,14,'M”glichst den Smartdrv entfernen, weil laaaaaaangsam !');
  5658. writexy(10,21,' E N J O Y');
  5659. end;
  5660.  
  5661. procedure play_sound(datname : string);
  5662. var li : integer;
  5663. ch : char;
  5664. begin;
  5665. for li := 1 to length(datname) do
  5666. datname[li] := upcase(Datname[li]);
  5667. if pos('.MOD',datname) <> 0 then begin;
  5668. Play_The_Mod(datname);
  5669. exit;
  5670. end;
  5671. if pos('.VOC',datname) <> 0 then begin;
  5672. repeat
  5673. Reset_Sb16;
  5674. write_vocmessage;
  5675. Init_Voc(datname);
  5676. ch := #0;
  5677. repeat
  5678. if keypressed then ch := readkey;
  5679. if ch = 'p' then begin;
  5680. voc_pause;
  5681. repeat
  5682. ch := readkey;
  5683. until ch = 'c';
  5684. voc_continue;
  5685. end;
  5686. until VOC_READY or (ch = 'n') or (upcase(ch) = 'Q');
  5687. VOC_DONE;
  5688. until upcase(ch) = 'Q';
  5689. end;
  5690. end;
  5691.  
  5692.  
  5693. begin;
  5694. Samfreq := 22;
  5695. clrscr;
  5696. test_systemspeed;
  5697. cursor_off;
  5698. interprete_commandline;
  5699. if (Nummods = 0) and not repeatmode then begin;
  5700. textcolor(15);
  5701. textbackground(1);
  5702. clrscr;
  5703. Nummods := 1;
  5704. modd[1] := ''+select_datei('*.?o?','*.?o?','','Bitte MOD-Datei ausw„hlen');
  5705. if modd[1] = 'xxxx' then begin;
  5706. clrscr;
  5707. writeln('Als ''nen MOD-Datei máen Sie schon haben !');
  5708. Cursor_on;
  5709. halt(0);
  5710. end;
  5711. end;
  5712. for i := 1 to Nummods do begin;
  5713. if pos('.',modd[i]) = 0 then modd[i] := modd[i]+'.mod';
  5714. end;
  5715. Init_The_Mod;
  5716. stereo := false;
  5717. next_song := random(Nummods)+1;
  5718. textcolor(lightgray);
  5719. textbackground(black);
  5720. write_sbconfig;
  5721. writeln;
  5722. writeln;
  5723. write(' ENTER fr weiter ...');
  5724. readln;
  5725. repeat
  5726. if repeatmode then begin;
  5727. textcolor(15);
  5728. textbackground(1);
  5729. clrscr;
  5730. modd[1] := ''+select_datei('*.?o?','*.?o?','','');
  5731. if modd[1] = 'xxxx' then next_song := 255
  5732. else Play_Sound(modd[1]);
  5733. end else
  5734. Play_Sound(modd[next_song]);
  5735. if next_song <> 255 then next_song := random(Nummods)+1;
  5736. until next_song = 255;
  5737. cursor_on;
  5738. textmode(3);
  5739. end.
  5740.  
  5741. {
  5742.  
  5743. *****************************************************************************
  5744. *** DATA BECKERs "PC UNDERGROUND" ***
  5745. *** ================================ ***
  5746. *** ***
  5747. *** Unit MOD_SB ***
  5748. *** ***
  5749. *** Die Unit stellt Routinen zum Abspielen von MOD-Dateien ber den ***
  5750. *** Soundblaster zur Verfgung. Da die Routinen sehr zeitkritisch sind, ***
  5751. *** wurden die entscheidenden Mix-Routinen in 386er Assembler geschrie- ***
  5752. *** ben. Darum l„uft die Unit NICHT auf 286er Rechnern. ***
  5753. *** Sie k”nnen die MOD-Dateien entweder ber den Timerinterrupt steuern ***
  5754. *** lassen, oder im sog. Polling-Verfahren aufrufen. ***
  5755. *** Die Routinen ben”tigen fr eine 8-Stimmige MOD-Datei auf einem ***
  5756. *** 486dx-33 bei einer Ausgaberate von 16 KHz weniger als 20% Rechenzeit ***
  5757. *** ***
  5758. *** ***
  5759. *** Autor : Boris Bertelsons (InspirE) ***
  5760. *** Dateiname : MOD_SB.PAS ***
  5761. *** Letzte Žnderung : 04.04.1994 ***
  5762. *** Version : 2.0 ***
  5763. *** Compiler : Turbo Pascal 6.0 und h”her ***
  5764. *****************************************************************************
  5765.  
  5766. }
  5767.  
  5768. {$F+}
  5769. unit mod_sb;
  5770.  
  5771. interface uses crt,dos,variab;
  5772.  
  5773. var andycount : word;
  5774.  
  5775. procedure voc_pause;
  5776. procedure voc_continue;
  5777. function Init_Sb : boolean;
  5778. {
  5779. Diese Function initialisiert den Soundblaster. Sie erkennt automa-
  5780. tisch Base-Adress und IRQ, prft, um welche Soundblasterversion es
  5781. sich handelt und setzt entsprechende globale Variablen, die z.B.
  5782. mittels write_sbConfig ausgegeben werden k”nnen. Sie liefert TRUE
  5783. zurck, wenn die Initialisierung erfolgreich war, ansonsten FALSE.
  5784. Der Lautsprecher fr Sampling-Ausgabe wird eingeschaltet. Der
  5785. DMA-Ready Interrupt wird auf eine eigene Routine verbogen.
  5786. }
  5787.  
  5788. procedure dsp_block_sb16(gr,dgr : word;bk : pointer;b1,b2 : boolean);
  5789. {
  5790. Spielt den ber bk adressierten Block via DMA ab
  5791. }
  5792.  
  5793. procedure mod_waitretrace(num : byte);
  5794. {
  5795. Das Warten auf einen Bildschirm-Retrace sollte mit dieser Procedure
  5796. erfolgen, wenn MOD's abgespielt werden (sonst Ruckeln)
  5797. }
  5798.  
  5799. procedure mod_autodetect(what : boolean);
  5800. {
  5801. Setzt die Speed-Erkennung ON/OFF
  5802. }
  5803.  
  5804. procedure mod_SetSpeed(msp : word);
  5805. {
  5806. Setzt die Variable "Speed"
  5807. }
  5808.  
  5809. procedure mod_SetLoop(msl : word);
  5810. {
  5811. Setzt die Variable "Sound_Schleifen"
  5812. }
  5813.  
  5814. procedure mod_SetLoopflag(loopen : boolean);
  5815. {
  5816. Setzt ON/OFF, ob eine zu Ende abgespielte Moddatei wieder von
  5817. Anfang an abgespielt wird
  5818. }
  5819.  
  5820. procedure mod_transpose(transposerwert : integer);
  5821. {
  5822. Setzt den Transposer-Wert. Evtl. fr Soundeffekte zu gebrauchen,
  5823. um einen Ton hoch- oder runterzuziehen. Sonst NICHT ver„ndern.
  5824. }
  5825.  
  5826. procedure mod_Samplefreq(Rate : integer);
  5827. {
  5828. Setzt die Samplefrequenz fr die Ausgabe. Wert*1000 = Frequenz.
  5829. Zul„ssige Werte sind 8,10,16,22
  5830. }
  5831.  
  5832. function lade_moddatei(modname : string;ispeed,iloop : integer;freq : byte) : integer;
  5833. {
  5834. L„d die unter modname angegebene Moddatei. Mittels ispeed und iloop
  5835. k”nnen die Variablen "Speed" und "Sound_Schleifen" vorgegeben
  5836. werden, sinnvoller ist jedoch die Angabe AUTO fr beide Werte
  5837. }
  5838.  
  5839. procedure ende_mod;
  5840. {
  5841. Beendet das Abspielen einer Mod-Datei und entfernt sie aus
  5842. dem Speicher
  5843. }
  5844.  
  5845. procedure periodisch_on;
  5846. {
  5847. Schaltet das Abspielen einer MOD-Datei ein. Muá zum Starten
  5848. aufgerufen werden
  5849. }
  5850.  
  5851. procedure periodisch_off;
  5852. {
  5853. H„lt das Abspielen einer MOD-Datei an. Die MOD-Datei bleibt im
  5854. Speicher und kann ber periodisch_one wieder gestartet werden
  5855. }
  5856.  
  5857. procedure write_sbConfig;
  5858. {
  5859. Gibt die gefundene Konfiguration aus (Textmodus !). Alternativ:
  5860. Direkter Zugriff auf die entsprechenden Variablen.
  5861. }
  5862.  
  5863. procedure calculate_music;
  5864. {
  5865. Berechnet ein Teilstck Musik. Wird Periodisch oder in einer Schleife
  5866. aufgerufen
  5867. }
  5868.  
  5869. procedure Filter_Ein;
  5870. {
  5871. Schaltet den XBass-Filter ein
  5872. }
  5873.  
  5874. procedure Filter_MID;
  5875. {
  5876. Schaltet den Filter auf Normalbetrieb
  5877. }
  5878. procedure Filter_Aus;
  5879. {
  5880. Schaltet den Filter auf H”hen-Hervorhebung
  5881. }
  5882.  
  5883. procedure Set_Balance(Wert : byte);
  5884. {
  5885. Die Procedure Setzt die Balance entsprechend dem bergebenen Wert.
  5886. Dabei steht 0 fr ganz links, 12 fr Mitte und 24 fr ganz rechts
  5887. }
  5888.  
  5889. procedure Set_Volume(Wert : byte);
  5890. {
  5891. Die Procedure setzt die Lautst„rke fr die generelle (!) Ausgabe
  5892. (Master Volume). Erlaubte Werte liegen zwischen 0 und 31
  5893. }
  5894.  
  5895. procedure wr_dsp_sb16(v : byte);
  5896. {
  5897. Schreibt den bergebenen Wert in das Soundblaster-Register
  5898. }
  5899.  
  5900. function init_The_Mod : boolean;
  5901. {
  5902. Initiatisiert die .MOD-Routienen. Resettet den SB und setzt ben”tigte
  5903. Variablen
  5904. }
  5905.  
  5906. FUNCTION Reset_sb16 : BOOLEAN;
  5907. {
  5908. Resettet die SB-Karte. Liefert TURE, wenn erfolgreich
  5909. }
  5910.  
  5911. procedure Set_Timeconst_sb16(tc : byte);
  5912. {
  5913. Setzt die Timer-Konstante die nach der Formel
  5914. tc := 256-(1.000.000 / Frequenz) berechnet wird
  5915. }
  5916.  
  5917. procedure Fade_Musix_out;
  5918. {
  5919. Zieht die Lautst„rke langsam runter. Z.B fr Programmende einsetzten
  5920. }
  5921.  
  5922. procedure Spiele_Sb(Segm,Offs,dgr,dsize : word);
  5923. {
  5924. Spielt den adressierten Block ber DMA ab. Fr SB / SB Pro
  5925. }
  5926.  
  5927. procedure Spiele_Sb16(Segm,Offs,dgr,dsize : word);
  5928. {
  5929. Spielt den adressierten Block ber DMA ab. Fr SB 16
  5930. }
  5931.  
  5932. procedure init_data;
  5933. {
  5934. Initialisiert die Variablen der Unit
  5935. }
  5936.  
  5937. Procedure Init_Voc(filename : string);
  5938. {
  5939. Startet die Ausgabe einer VOC-Datei. Eine parallele Ausgabe von VOC
  5940. und MOD ist NICHT m”glich
  5941. }
  5942.  
  5943. procedure voc_done;
  5944. {
  5945. Beendet das Abspielen einer VOC-Datei.
  5946. }
  5947.  
  5948. const bpm : byte = 125;
  5949.  
  5950. var SaveExitProc : Pointer; { N”tig, da eigene Exitproc }
  5951. mycli : byte; { Flag, ob Soundberechnung }
  5952. { aktiv }
  5953. music_played : boolean; { Flag, TRUE wenn Musik ge- }
  5954. { spielt wurde }
  5955. implementation
  5956.  
  5957. const
  5958. Speed3 : word = 58;
  5959. Loop3 : word = 42;
  5960.  
  5961. Var
  5962. Tonhoehe_Stimme : array[1..8] of word;
  5963. tonhoehe : word; { Der Wert der Tonh”he, wie }
  5964. { er in der MOD-Datei steht }
  5965. ziel : pt; { Abspielpuffer im pt-Format }
  5966. Modp : pointer; { Pointer auf Rm_Song }
  5967. note : array[1..8] of byte;
  5968. altx,alty : integer;
  5969. aktuelle_stimme : word;
  5970.  
  5971. Mixed_data : pointer;
  5972. Mixed_data_st : pointer;
  5973.  
  5974. {$L modmix}
  5975. procedure Leere_stimme; external;
  5976. {procedure stimme_normal(aktuelle_stimme : word); external;}
  5977. procedure stimme_normal; external;
  5978. procedure stimme_normal_st; external;
  5979.  
  5980. var Portamento_Up_Stimme : array[1..8] of longint;
  5981. Portamento_Do_Stimme : array[1..8] of longint;
  5982.  
  5983. var Mixingprocs : array[1..8] of pointer;
  5984. Leerstimme : pointer;
  5985.  
  5986. effekt_Stimme : array[1..8] of byte;
  5987.  
  5988. Laenge_Stimme : array[1..8] of longint;
  5989. Loop_Laenge_Stimme : array[1..8] of longint;
  5990. Position_Stimme : array[1..8] of longint;
  5991. Loop_Start_Stimme : array[1..8] of longint;
  5992. Segment_Stimme : array[1..8] of longint;
  5993. Notvol_Stimme : array[1..8] of longint;
  5994. Incval_Stimme : array[1..8] of longint;
  5995.  
  5996. var nothin_done_count : word;
  5997.  
  5998. var bsw : boolean;
  5999. vocb1,
  6000. vocb2,
  6001. buffer1,
  6002. buffer2 : pointer;
  6003. shiftfactor,
  6004. shiftfactor_stereo : word;
  6005.  
  6006. {
  6007.  
  6008. **************************************************************************
  6009. *** ***
  6010. *** Routinen zum Timer - Handling ***
  6011. *** ***
  6012. **************************************************************************
  6013.  
  6014. }
  6015.  
  6016. procedure StelleTimerEin(Proc : pointer; Freq : word);
  6017. var izaehler : word;
  6018. oldv : pointer;
  6019. begin;
  6020. asm cli end;
  6021. izaehler := 1193180 DIV Freq;
  6022. Port[$43] := $36;
  6023. Port[$40] := Lo(IZaehler);
  6024. Port[$40] := Hi(IZaehler);
  6025.  
  6026. Getintvec(8,OldV);
  6027. setintvec(OldTimerInt,OldV);
  6028. SetIntVec(8,Proc);
  6029. old_tZaehler := 1;
  6030. seczaehler := 0;
  6031. Altintzaehler := 0;
  6032. asm sti end;
  6033. end;
  6034.  
  6035. procedure StelleTimerAus;
  6036. var oldv : pointer;
  6037. begin;
  6038. asm cli end;
  6039. port[$43] := $36;
  6040. Port[$40] := 0;
  6041. Port[$40] := 0;
  6042. GetIntVec(OldTimerInt,OldV);
  6043. SetIntVec(8,OldV);
  6044. asm sti end;
  6045. end;
  6046.  
  6047. procedure NeuerTimer; interrupt;
  6048. var dr : registers;
  6049. begin;
  6050. inc(nothin_done_count);
  6051. inc(Seczaehler);
  6052. inc(Altintzaehler);
  6053. if Altintzaehler = 58 then begin;
  6054. Altintzaehler := 0;
  6055. intr(Oldtimerint,dr);
  6056. end;
  6057. if Seczaehler = timer_per_second then begin;
  6058. Seczaehler := 0;
  6059. inc(andycount);
  6060. inc(Laufsec);
  6061. if Laufsec = 60 then begin;
  6062. inc(Laufmin);
  6063. Laufsec := 0;
  6064. end;
  6065. end;
  6066. if not in_retrace then calculate_Music;
  6067. Port[$20] := $20;
  6068. end;
  6069.  
  6070.  
  6071. {
  6072.  
  6073. **************************************************************************
  6074. *** ***
  6075. *** Routinen zur Ansteuerung des Soundblasters ***
  6076. *** ***
  6077. **************************************************************************
  6078.  
  6079. }
  6080.  
  6081.  
  6082. procedure wr_dsp_sb16(v : byte);
  6083. {
  6084. Wartet, bis der DSP zum Schreiben bereit ist, und schreibt dann das
  6085. in "v" bergebene Byte in den DSP
  6086. }
  6087. begin;
  6088. while port[dsp_adr+$c] >= 128 do ;
  6089. port[dsp_adr+$c] := v;
  6090. end;
  6091.  
  6092. FUNCTION SbReadByte : BYTE;
  6093. {
  6094. Die Function wartet, bis der DSP gelesen werden kann und liefert den
  6095. gelesenen Wert zurck
  6096. }
  6097. begin;
  6098. while port[dsp_adr+$a] = $AA do ; { warten, bis DSP ready }
  6099. SbReadByte := port[dsp_adr+$a]; { Wert schreiben }
  6100. end;
  6101.  
  6102. procedure SBreset;
  6103. VAR bt,ct, stat : BYTE;
  6104. begin;
  6105. PORT[dsp_adr+$6] := 1; { dsp_adr+$6 = Resettfunktion}
  6106. FOR ct := 1 TO 100 DO;
  6107. PORT[dsp_adr+$6] := 0;
  6108. bt := 0;
  6109. repeat
  6110. ct := 0;
  6111. repeat
  6112. stat := port[dsp_adr + $E];
  6113. until (ct > 8000) or (stat >= 128);
  6114. inc(bt);
  6115. until (bt > 100) or (port[dsp_adr + $A] = $AA);
  6116. end;
  6117.  
  6118. FUNCTION Reset_sb16 : BOOLEAN;
  6119. {
  6120. Die Function resetet den DSP. War das Resetten erfolgreich, wird
  6121. TRUE zurckgeliefert, ansonsten FALSE
  6122. }
  6123. CONST ready = $AA;
  6124. VAR ct, stat : BYTE;
  6125. BEGIN
  6126. PORT[dsp_adr+$6] := 1; { dsp_adr+$6 = Resettfunktion}
  6127. FOR ct := 1 TO 100 DO;
  6128. PORT[dsp_adr+$6] := 0;
  6129. stat := 0;
  6130. ct := 0; { Der Vergleich ct < 100, da }
  6131. WHILE (stat <> ready) { die Initialisierung ca. }
  6132. AND (ct < 100) DO BEGIN { 100ms dauert }
  6133. stat := PORT[dsp_adr+$E];
  6134. stat := PORT[dsp_adr+$a];
  6135. INC(ct);
  6136. END;
  6137. Reset_sb16 := (stat = ready);
  6138. END;
  6139.  
  6140. FUNCTION Detect_Reg_sb16 : BOOLEAN;
  6141. {
  6142. Die Funktion liefert TRUE zurck, wenn ein Soundblaster initialisiert
  6143. werden konnte, ansonsten FALSE. Die Variable dsp_adr wird auf die
  6144. Base-Adresse des SB gesetzt.
  6145. }
  6146. VAR
  6147. Port, Lst : WORD;
  6148. BEGIN
  6149. Detect_Reg_sb16 := SbRegDetected;
  6150. IF SbRegDetected THEN EXIT; { Exit, wenn initialisiert }
  6151. Port := Startport; { M”gliche SB-Adressen zwi- }
  6152. Lst := Endport; { schen $210 und $280 ! }
  6153. WHILE (NOT SbRegDetected)
  6154. AND (Port <= Lst) DO BEGIN
  6155. dsp_adr := Port;
  6156. SbRegDetected := Reset_sb16;
  6157. IF NOT SbRegDetected THEN
  6158. INC(Port, $10);
  6159. END;
  6160. Detect_Reg_sb16 := SbRegDetected;
  6161. END;
  6162.  
  6163. PROCEDURE Write_Mixer(Reg, Val: BYTE);
  6164. {
  6165. Schreibt den in Val bergebenen Wert an das in Reg angegebene
  6166. Register des Mixer - Chips
  6167. }
  6168. begin;
  6169. Port[dsp_adr+$4] := Reg;
  6170. Port[dsp_adr+$5] := Val;
  6171. END;
  6172.  
  6173.  
  6174. FUNCTION Read_Mixer(Reg: BYTE) : BYTE;
  6175. {
  6176. Die Function liefert den Inhalt des ber Reg indizierten Registers
  6177. des Mixer-Chips
  6178. }
  6179. begin;
  6180. Port[dsp_adr+$4] := Reg;
  6181. Read_Mixer := Port[dsp_adr+$5];
  6182. end;
  6183.  
  6184. procedure Filter_Ein;
  6185. {
  6186. Diese Procedure Stellt den Tiefen Filter ein bzw. regelt das
  6187. Bass/Treble Register entsprechend
  6188. }
  6189. var hilfe : byte;
  6190. begin;
  6191. if sb16detected then begin;
  6192. write_Mixer(68,64); { Treble runter }
  6193. write_Mixer(69,64);
  6194. write_Mixer(70,255); { Bass voll Power ! }
  6195. write_Mixer(71,255); { Bass voll Power ! }
  6196. end else begin;
  6197. hilfe := read_Mixer($0c); { Tiefer Filter }
  6198. hilfe := hilfe or 8;
  6199. Write_Mixer($0c,hilfe);
  6200. hilfe := read_Mixer($0e); { Filter einschalten }
  6201. hilfe := hilfe AND 2;
  6202. write_Mixer($0e,hilfe);
  6203. end;
  6204. end;
  6205.  
  6206. procedure Filter_MID;
  6207. {
  6208. Diese Procedure Stellt den Tiefen Filter ein bzw. regelt das
  6209. Bass/Treble Register entsprechend
  6210. }
  6211. var hilfe : byte;
  6212. begin;
  6213. if sb16detected then begin;
  6214. write_Mixer(68,160); { Treble runter }
  6215. write_Mixer(69,160);
  6216. write_Mixer(70,192); { Bass voll Power ! }
  6217. write_Mixer(71,192); { Bass voll Power ! }
  6218. end else begin;
  6219. hilfe := read_Mixer($0e); { Filter ausschalten }
  6220. hilfe := hilfe OR 32;
  6221. write_Mixer($0e,hilfe);
  6222. end;
  6223. end;
  6224.  
  6225. procedure Filter_aus;
  6226. var hilfe : byte;
  6227. begin;
  6228. if sb16detected then begin;
  6229. write_Mixer(68,192); { zurck auf default }
  6230. write_Mixer(69,192);
  6231. write_Mixer(70,160);
  6232. write_Mixer(71,160);
  6233. end else begin;
  6234. hilfe := read_Mixer($0c); { H”hen-Filter }
  6235. hilfe := hilfe OR 247;
  6236. Write_Mixer($0c,hilfe);
  6237. hilfe := read_Mixer($0e); { Filter einschalten }
  6238. hilfe := hilfe AND 2;
  6239. write_Mixer($0e,hilfe);
  6240. end;
  6241. end;
  6242.  
  6243. procedure Set_Balance(Wert : byte);
  6244. {
  6245. Die Procedure Setzt die Balance entsprechend dem bergebenen Wert.
  6246. Dabei steht 0 fr ganz links, 12 fr Mitte und 24 fr ganz rechts
  6247. }
  6248. Var left,right : byte;
  6249. begin;
  6250. if Sb16Detected then begin;
  6251. left := 12;
  6252. right := 12;
  6253. if Wert < 12 then right := wert;
  6254. if Wert > 12 then left := 24-Wert;
  6255. write_Mixer(50,(left shl 4));
  6256. write_Mixer(51,(right shl 4));
  6257. end else begin;
  6258. Wert := Wert SHR 1;
  6259. case Wert of
  6260. 0..6 : begin;
  6261. write_Mixer(02,(7 shl 5)+(Wert shl 1));
  6262. end;
  6263. 07 : begin;
  6264. write_Mixer(02,(7 shl 5)+(7 shl 1));
  6265. end;
  6266. 08..13 : begin;
  6267. write_Mixer(02,((13-Wert) shl 5)+(7 shl 1));
  6268. end;
  6269. end;
  6270. end;
  6271. end;
  6272.  
  6273. procedure Set_Volume(Wert : byte);
  6274. {
  6275. Zum Setzen der Abspiel-Lautst„rke. Zul„ssige Werte von 0 bis 31
  6276. }
  6277. begin;
  6278. if sb16detected then begin;
  6279. write_Mixer(48,(Wert shl 3));
  6280. write_Mixer(49,(Wert shl 3));
  6281. end else begin;
  6282. if MixerDetected then begin;
  6283. Wert := Wert Shr 2;
  6284. write_Mixer($22,(wert shl 5) + (wert shl 1));
  6285. end else begin;
  6286. outvolume := Wert shl 1;
  6287. end;
  6288. end;
  6289. end;
  6290.  
  6291. procedure reset_Mixer; assembler;
  6292. {
  6293. Resettet den Mixer Chip auf seine Default - Werte
  6294. }
  6295. asm
  6296. mov dx,dsp_adr+$4
  6297. mov al,0
  6298. out dx,al
  6299. mov cx,50
  6300. @loop:
  6301. loop @loop
  6302. inc dx
  6303. out dx,al
  6304. end;
  6305.  
  6306. FUNCTION Detect_Mixer_sb16 : BOOLEAN;
  6307. {
  6308. Function zu Erkennung des Mixer-Chips. TRUE, wenn der Mixer gefunden
  6309. wurde, ansonsten FALSE
  6310. }
  6311. VAR SaveReg : WORD;
  6312. NewReg : WORD;
  6313. BEGIN
  6314. Detect_Mixer_sb16 := MixerDetected;
  6315. IF (NOT SbRegDetected) { Abbruch, wenn keine Sound- }
  6316. OR MixerDetected THEN EXIT; { blaster-Karte vorhanden }
  6317. { oder Mixer-Chip schon }
  6318. { initalisiert }
  6319. Reset_Mixer;
  6320. SaveReg := Read_Mixer($22); { Register sichern }
  6321. Write_Mixer($22, 243); { Wenn der geschribene wert }
  6322. NewReg := Read_Mixer($22); { mit dem zurckgelesenen }
  6323. { bereinstimmt, so ist ein }
  6324. { Zugriff m”glich und somit }
  6325. { ein Mixer vorhanden }
  6326. IF NewReg = 243 THEN begin;
  6327. MixerDetected := TRUE;
  6328. STEREO := True;
  6329. end;
  6330. Write_Mixer($22, SaveReg); { Altes Register zurck }
  6331. Detect_Mixer_sb16 := MixerDetected;
  6332. END;
  6333.  
  6334. PROCEDURE SbGetDSPVersion;
  6335. VAR i : WORD;
  6336. t : WORD;
  6337. s : STRING[2];
  6338. BEGIN
  6339. wr_dsp_sb16($E1); { $E1 = Versionsabfrage }
  6340. SbVersMaj := SbReadByte;
  6341. SbVersMin := SbReadByte;
  6342. str(SbVersMaj, SbVersStr);
  6343. SbVersStr := SbVersStr + '.';
  6344. str(SbVersMin, s);
  6345. if SbVersMin > 9 then
  6346. SbVersStr := SbVersStr + s
  6347. else
  6348. SbVersStr := SbVersStr + '0' + s;
  6349. END;
  6350.  
  6351. function wrt_dsp_adr_sb16 : string;
  6352. {
  6353. Liefert die Base-Adresse des SB als String zurck
  6354. }
  6355. begin;
  6356. case dsp_adr of
  6357. $210 : wrt_dsp_adr_sb16 := '210';
  6358. $220 : wrt_dsp_adr_sb16 := '220';
  6359. $230 : wrt_dsp_adr_sb16 := '230';
  6360. $240 : wrt_dsp_adr_sb16 := '240';
  6361. $250 : wrt_dsp_adr_sb16 := '250';
  6362. $260 : wrt_dsp_adr_sb16 := '260';
  6363. $270 : wrt_dsp_adr_sb16 := '270';
  6364. $270 : wrt_dsp_adr_sb16 := '280';
  6365. END;
  6366. end;
  6367.  
  6368. function wrt_dsp_irq : string;
  6369. {
  6370. Liefert den IRQ des SB als String zurck
  6371. }
  6372. begin;
  6373. case dsp_irq of
  6374. $2 : wrt_dsp_irq := '2 h';
  6375. $3 : wrt_dsp_irq := '3 h';
  6376. $5 : wrt_dsp_irq := '5 h';
  6377. $7 : wrt_dsp_irq := '7 h';
  6378. $10 : wrt_dsp_irq := '10 h';
  6379. END;
  6380. end;
  6381.  
  6382. procedure Set_Timeconst_sb16(tc : byte);
  6383. {
  6384. Procedure zum setzen der Time-Konstanten. Sie berechnet sich nach der
  6385. Formel tc := 256 - (1000000 / Frequenz).
  6386. }
  6387. begin;
  6388. wr_dsp_sb16($40); { $40 = Setze Sample Rate }
  6389. wr_dsp_sb16(tc);
  6390. end;
  6391.  
  6392. procedure test_uebertragung;
  6393. begin;
  6394. fillchar(buffer1^,3000,127);
  6395. blockgroesse := 2000;
  6396. letzte_ausgabe := true;
  6397. Sampling_Rate := 211;
  6398. dsp_block_sb16(blockgroesse,blockgroesse,buffer1,true,false);
  6399. delay(100);
  6400. end;
  6401.  
  6402. procedure write_sbConfig;
  6403. {
  6404. Die Procedure gibt die gefundene Konfiguration auf dem Bildschirm
  6405. aus. Sie dient vornehmlich als Beispiel, wie die Informationen
  6406. verwendet werden k”nnen
  6407. }
  6408. begin;
  6409. clrscr;
  6410. if SbRegDetected then begin;
  6411. writeln('Soundkarte an Base ',wrt_dsp_adr_sb16,'h mit IRQ ',
  6412. wrt_dsp_irq,' gefunden.');
  6413. end else begin;
  6414. writeln('Keine Soundblaster-kompatibele Karte gefunden !');
  6415. end;
  6416. if MixerDetected then begin;
  6417. writeln('Mixer - Chip gefunden');
  6418. if SbVersMaj < 4 then
  6419. writeln('Die gefundene Karte ist',
  6420. ' ein Soundblaster Pro oder kompatibel')
  6421. else
  6422. writeln('Die gefundene Karte ist',
  6423. ' ein Soundblaster 16 ASP oder kompatibel');
  6424. end else begin;
  6425. writeln('Die gefundene Karte ist',
  6426. ' ein Soundblaster oder kompatibel');
  6427. end;
  6428. writeln('Die Versionsnummer lautet ',SbVersStr);
  6429. end;
  6430.  
  6431. procedure Exit_Sb16;
  6432. {
  6433. Diese Prozedur wir beim Beenden des Programms aufgerufen und setzt
  6434. den verbogenen DMA-Interrupt auf seinen Ausgangswert
  6435. }
  6436. begin;
  6437. setintvec($8+dsp_irq,oldint); { Alten Interrupt wieder her-}
  6438. port[$21] := Port[$21] or irqmsk; { stellen und Maskierung auf }
  6439. port[dsp_adr+$c] := $d3; { alten Wert zurck }
  6440. Port[$20] := $20;
  6441. wr_dsp_sb16($D0);
  6442. end;
  6443.  
  6444. procedure Spiele_Sb16(Segm,Offs,dgr,dsize : word);
  6445. {
  6446. Diese Procedure spielt den ber Segm:Offs adressierten Block mit der
  6447. GrӇe dsize ab. Es ist darauf zu achten, das der DMA-Controller NICHT
  6448. Seitenbergreifend arbeiten kann ...
  6449. }
  6450. var li : word;
  6451. begin;
  6452. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  6453. Port[$0c] := 0; { Adresse des Puffers }
  6454. Port[$0B] := $48+dma_ch; { fr Soundausgabe }
  6455. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  6456. Port[dma_adr[dma_ch]] := Hi(offs);
  6457. Port[dma_wc[dma_ch]] := Lo(dgr-1); { GrӇe des Blockes (block- }
  6458. Port[dma_wc[dma_ch]] := Hi(dgr-1); { groesse) an DMA-Controller }
  6459. Port[dma_page[dma_ch]] := Segm;
  6460. if sb16_outputlaenge <> dsize then begin;
  6461. wr_dsp_sb16($C6); { DSP-Befehl 8-Bit ber DMA }
  6462. if stereo then begin; { fr SB16 Nur zum Starten ! }
  6463. wr_dsp_sb16($20);
  6464. { write('õ');}
  6465. end else
  6466. wr_dsp_sb16($00);
  6467. wr_dsp_sb16(Lo(dsize-1)); { GrӇe des Blockes an }
  6468. wr_dsp_sb16(Hi(dsize-1)); { den DSP }
  6469. sb16_outputlaenge := dsize;
  6470. end else begin;
  6471. wr_dsp_sb16($45); { DMA Continue SB16 8-Bit }
  6472. end;
  6473. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  6474. end;
  6475.  
  6476. procedure Spiele_Sb(Segm,Offs,dgr,dsize : word);
  6477. {
  6478. Diese Procedure spielt den ber Segm:Offs adressierten Block mit der
  6479. GrӇe dsize ab. Es ist darauf zu achten, das der DMA-Controller NICHT
  6480. Seitenbergreifend arbeiten kann ...
  6481. }
  6482. var li : word;
  6483. begin;
  6484. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  6485. Port[$0c] := 0; { Adresse des Puffers }
  6486. Port[$0B] := $48+dma_ch; { fr Soundausgabe }
  6487. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  6488. Port[dma_adr[dma_ch]] := Hi(offs);
  6489. Port[dma_wc[dma_ch]] := Lo(dgr-1); { GrӇe des Blockes (block- }
  6490. Port[dma_wc[dma_ch]] := Hi(dgr-1); { groesse) an DMA-Controller }
  6491. Port[dma_page[dma_ch]] := Segm;
  6492. wr_dsp_sb16($14);
  6493. wr_dsp_sb16(Lo(dsize-1)); { GrӇe des Blockes an }
  6494. wr_dsp_sb16(Hi(dsize-1)); { den DSP }
  6495. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  6496. end;
  6497.  
  6498. procedure Spiele_SbPro(Segm,Offs,dgr,dsize : word);
  6499. {
  6500. Diese Procedure spielt den ber Segm:Offs adressierten Block mit der
  6501. GrӇe dsize ab. Es ist darauf zu achten, das der DMA-Controller NICHT
  6502. Seitenbergreifend arbeiten kann ...
  6503. }
  6504. var li : word;
  6505. begin;
  6506. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  6507. Port[$0c] := 0; { Adresse des Puffers }
  6508. Port[$0B] := $48+dma_ch; { fr Soundausgabe }
  6509. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  6510. Port[dma_adr[dma_ch]] := Hi(offs);
  6511. Port[dma_wc[dma_ch]] := Lo(dgr-1); { GrӇe des Blockes (block- }
  6512. Port[dma_wc[dma_ch]] := Hi(dgr-1); { groesse) an DMA-Controller }
  6513. Port[dma_page[dma_ch]] := Segm;
  6514.  
  6515. wr_dsp_sb16($48);
  6516. wr_dsp_sb16(Lo(dsize-1)); { GrӇe des Blockes an }
  6517. wr_dsp_sb16(Hi(dsize-1)); { den DSP }
  6518. wr_dsp_sb16($91);
  6519. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  6520. end;
  6521.  
  6522. procedure dsp_block_sb16(gr,dgr : word;bk : pointer;b1,b2 : boolean);
  6523. {
  6524. Diese Procedure startet die Ausgabe des Daten-Blocks mit der
  6525. Gr”áe blockgroesse ber DMA
  6526. }
  6527. var l : longint;
  6528. pn,offs : word;
  6529. hbyte : byte;
  6530. a : word;
  6531. OldV,NewV,Hilfe : byte;
  6532. stereoreg : byte;
  6533. sr : word;
  6534. samps : byte;
  6535. begin;
  6536. PLAYING_MOD := b1;
  6537. PLAYING_VOC := b2;
  6538.  
  6539. dsp_rdy_sb16 := false;
  6540. l := 16*longint(pt(bk).sgm)+pt(bk).ofs;
  6541. pn := pt(l).sgm;
  6542. offs := pt(l).ofs;
  6543.  
  6544. if PLAYING_MOD then begin;
  6545. set_timeconst_sb16(Sampling_Rate);
  6546. if sb16Detected then begin;
  6547. if stereo then begin;
  6548. Spiele_Sb16(pn,offs,dgr*2,gr*2);
  6549. { write('S');}
  6550. end else
  6551. Spiele_Sb16(pn,offs,dgr,gr);
  6552. end else begin;
  6553. if stereo then begin;
  6554. SR := word(-1000000 DIV (Sampling_Rate-256));
  6555. SR := SR * 2;
  6556. Samps := 256 - (1000000 DIV SR);
  6557. set_timeconst_sb16(Samps);
  6558. Spiele_SbPro(pn,offs,dgr*2,gr*2);
  6559. end else
  6560. Spiele_Sb(pn,offs,dgr,gr);
  6561. end;
  6562. end;
  6563.  
  6564. if PLAYING_VOC then begin;
  6565. sb16_outputlaenge := 0;
  6566. set_timeconst_sb16(vblock.SR);
  6567. if sb16Detected then begin;
  6568. if stereo then begin;
  6569. Spiele_Sb16(pn,offs,dgr,gr);
  6570. end else begin;
  6571. Spiele_Sb16(pn,offs,dgr,gr);
  6572. end;
  6573. end else begin;
  6574. if stereo then begin;
  6575. Spiele_SbPro(pn,offs,dgr,gr);
  6576. end else begin;
  6577. Spiele_Sb(pn,offs,dgr,gr);
  6578. end;
  6579. end;
  6580. end;
  6581. end;
  6582.  
  6583.  
  6584. {
  6585.  
  6586. **************************************************************************
  6587. *** ***
  6588. *** Routinen zum Abspielen von MOD-Dateien ***
  6589. *** ***
  6590. **************************************************************************
  6591.  
  6592. }
  6593.  
  6594. procedure get_pctunel(hoehe : word;Var vk : longint);
  6595. {
  6596. Die Procedure ermittelt aus der bergebenen Tonh”he (so wie sie in
  6597. der MOD-Datei steht) die fr die Frequenz-Manipulation ben”tigten
  6598. Vor- und Nachkommastellen.
  6599. }
  6600. var nct : byte;
  6601. gefunden : boolean;
  6602. begin;
  6603. nct := 1;
  6604. gefunden := false;
  6605. while (nct <= 70) and not gefunden do { Bis gefunden oder letzter }
  6606. begin; { Wert in Tabelle }
  6607. if hoehe > Modoktave[nct] then
  6608. gefunden := true;
  6609. inc(nct);
  6610. end;
  6611. if gefunden then begin;
  6612. vk := Incfacts[nct-tpw+12];
  6613. end else begin;
  6614. vk := 0; { Werte aus Tabelle holen. }
  6615. end;
  6616. end;
  6617.  
  6618.  
  6619. {function T_Hoehe(Nr : word) : integer;
  6620. begin;
  6621. T_Hoehe := Modoktave[nr];
  6622. end;}
  6623.  
  6624. function Noten_Nr(hoehe : word) : integer;
  6625. var nct : byte;
  6626. gefunden : boolean;
  6627. begin;
  6628. nct := 1;
  6629. gefunden := false;
  6630. while (nct <= 70) and not gefunden do { Bis gefunden oder letzter }
  6631. begin; { Wert in Tabelle }
  6632. if hoehe > Modoktave[nct] then
  6633. gefunden := true;
  6634. inc(nct);
  6635. end;
  6636. if gefunden then begin;
  6637. Noten_nr := nct-1;
  6638. end else begin;
  6639. Noten_nr := -1;
  6640. end;
  6641. end;
  6642.  
  6643. function Notenvolumen(Stm : byte) : byte;
  6644. begin;
  6645. Notenvolumen := Rm_Song[mli,Stm,4];
  6646. end;
  6647.  
  6648. var mixed_posi : word;
  6649. calc_size : word;
  6650.  
  6651. procedure innen_schleife_4;
  6652. {
  6653. Hier erfolgt die eigentliche Vermischung der Daten. Der Puffer
  6654. wird dabei mit den berechneten Daten gefllt. Dies ist die
  6655. MONO-Version der Routine.
  6656. }
  6657. begin;
  6658. calc_size := blockgroesse;
  6659. if bsw then
  6660. ziel := pt(buffer1)
  6661. else
  6662. ziel := pt(buffer2);
  6663. fillchar(mixed_data^,8000,128);
  6664. asm
  6665.  
  6666. mov cx,1
  6667. @stimmen_loop:
  6668. mov mixed_posi,0
  6669. mov aktuelle_stimme,cx
  6670. mov si,cx
  6671. dec si
  6672. shl si,2
  6673. call dword ptr Mixingprocs[si]
  6674.  
  6675. inc cx
  6676. cmp cx,stimmen
  6677. jbe @stimmen_loop
  6678.  
  6679. mov mixed_posi,0
  6680. mov cx,calc_size
  6681. @Mixed_2_blk:
  6682. les di,mixed_data
  6683. add di,mixed_posi
  6684. mov ax,es:[di]
  6685. push cx
  6686. mov cx,shiftfactor
  6687. shr ax,cl
  6688. pop cx
  6689. add mixed_posi,2
  6690.  
  6691. mov bx,ziel.sgm { Byte ins Ziel schreiben }
  6692. mov es,bx
  6693. mov bx,ziel.ofs
  6694. mul outvolume
  6695. shr ax,6
  6696. mov es:[bx],al
  6697. inc ziel.ofs
  6698.  
  6699. loop @mixed_2_blk
  6700. end;
  6701. end;
  6702.  
  6703. procedure innen_schleife_4_stereo;
  6704. {
  6705. Hier erfolgt die eigentliche Vermischung der Daten. Der Puffer
  6706. wird dabei mit den berechneten Daten gefllt. Dies ist die
  6707. MONO-Version der Routine.
  6708. }
  6709. begin;
  6710. calc_size := blockgroesse;
  6711. if bsw then
  6712. ziel := pt(buffer1)
  6713. else
  6714. ziel := pt(buffer2);
  6715. fillchar(mixed_data^,8000,128);
  6716. fillchar(mixed_data_st^,8000,128);
  6717. asm
  6718. mov cx,1
  6719. @stimmen_loop:
  6720. mov mixed_posi,0
  6721. mov aktuelle_stimme,cx
  6722. mov si,cx
  6723. dec si
  6724. shl si,2
  6725. call dword ptr Mixingprocs[si]
  6726.  
  6727. inc cx
  6728. cmp cx,stimmen
  6729. jbe @stimmen_loop
  6730.  
  6731. mov mixed_posi,0
  6732. mov cx,calc_size
  6733. @Mixed_2_blk:
  6734. les di,mixed_data
  6735. add di,mixed_posi
  6736. mov ax,es:[di]
  6737. push cx
  6738. mov cx,shiftfactor_stereo
  6739. shr ax,cl
  6740. pop cx
  6741.  
  6742. mov bx,ziel.sgm { Byte ins Ziel schreiben }
  6743. mov es,bx
  6744. mov bx,ziel.ofs
  6745. mul outvolume
  6746. shr ax,6
  6747. mov es:[bx],al
  6748. inc ziel.ofs
  6749.  
  6750. les di,mixed_data_st
  6751. add di,mixed_posi
  6752. mov ax,es:[di]
  6753. push cx
  6754. mov cx,shiftfactor_stereo
  6755. shr ax,cl
  6756. pop cx
  6757. add mixed_posi,2
  6758.  
  6759. mov bx,ziel.sgm { Byte ins Ziel schreiben }
  6760. mov es,bx
  6761. mov bx,ziel.ofs
  6762. mul outvolume
  6763. shr ax,6
  6764. mov es:[bx],al
  6765. inc ziel.ofs
  6766.  
  6767. loop @mixed_2_blk
  6768. end;
  6769. end;
  6770.  
  6771. procedure vermische_start_4;
  6772. var rdiff : real;
  6773. dummy : byte;
  6774. var li : integer;
  6775. begin;
  6776. for li := 1 to Stimmen do begin;
  6777. if note[li] <> 0 then begin;
  6778. tonhoehe_Stimme[li] := (Rm_Song[mli,li,1] and $0F)*256+Rm_Song[mli,li,2];
  6779. get_pctunel(tonhoehe_Stimme[li],Incval_Stimme[li]);
  6780. end;
  6781.  
  6782. ls[li] := loop_s[In_st[li]];
  6783. ll[li] := loop_l[In_st[li]];
  6784. if ll[li] > 30 then inl[li] := ll[li]+ls[li];
  6785. Loop_Laenge_Stimme[li] := ll[li];
  6786. Loop_Start_Stimme[li] := ls[li];
  6787.  
  6788. case effekt_Stimme[li] of
  6789. 1 : begin;
  6790. inc(Incval_Stimme[li],Portamento_up_Stimme[li]);
  6791. end;
  6792. 2 : begin;
  6793. inc(Incval_Stimme[li],Portamento_do_Stimme[li]);
  6794. end;
  6795. end;
  6796. end;
  6797. end;
  6798.  
  6799.  
  6800. procedure effect_handling(li : integer);
  6801. var idx : word;
  6802. Portamento_Speed : word;
  6803. Startnote,
  6804. endnote : word;
  6805. startinc,
  6806. endinc : longint;
  6807.  
  6808. begin;
  6809. if Rm_Song[mli,li,3] and $0F <= 15 then begin;
  6810. Eff[li] := 0;
  6811. case (Rm_Song[mli,li,3] and $0F) of
  6812. 01 : begin;
  6813. effekt_Stimme[li] := 1;
  6814. Portamento_Speed := Rm_Song[mli,li,4];
  6815. Startnote := Noten_nr(tonhoehe_Stimme[li]);
  6816. Endnote := Startnote+Portamento_Speed;
  6817. get_pctunel(Modoktave[Startnote],Startinc);
  6818. get_pctunel(Modoktave[Endnote],Endinc);
  6819. Portamento_up_Stimme[li] := round((Endinc - Startinc) / playspeed);
  6820. end;
  6821. 02 : begin;
  6822. effekt_Stimme[li] := 2;
  6823. Portamento_Speed := Rm_Song[mli,li,4];
  6824. Startnote := Noten_nr(tonhoehe_Stimme[li]);
  6825. Endnote := Startnote-Portamento_Speed;
  6826. get_pctunel(Modoktave[Startnote],Startinc);
  6827. get_pctunel(Modoktave[Endnote],Endinc);
  6828. Portamento_do_Stimme[li] := round((Endinc - Startinc) / playspeed);
  6829. end;
  6830. 9 : begin; { Sample offset }
  6831. Position_Stimme[li] := longint(Rm_Song[mli,li,4]) shl 24;
  6832. end;
  6833. 13 : begin;
  6834. mli := 64;
  6835. end;
  6836. 11 : begin;
  6837. mli := 64;
  6838. mlj := Rm_Song[mli,li,4];
  6839. end;
  6840. 12 : begin;
  6841. Notvol_Stimme[li] := Notenvolumen(li);
  6842. end;
  6843. 14 : begin;
  6844. case (Rm_Song[mli,li,4] shr 4) of
  6845. 12 : begin;
  6846. inl[li] := 0;
  6847. Notvol_Stimme[li] := 0;
  6848. inp[li] := 0;
  6849. Pnk[li] := 0;
  6850. end;
  6851. end;
  6852. end;
  6853. 15 : begin;
  6854. idx := Rm_Song[mli,li,4];
  6855. if idx <= $f then begin;
  6856. Playspeed := idx;
  6857. Speed := Playspeed*105 div 10;
  6858. blockgroesse := Speed * Sound_Schleifen;
  6859. end else begin;
  6860. bpm := idx;
  6861. mod_SetLoop(Sampling_Frequenz div (BPM * 4));
  6862. Speed := Playspeed*105 div 10;
  6863. blockgroesse := Speed * Sound_Schleifen;
  6864. end;
  6865. if blockgroesse < 40 then blockgroesse := 40;
  6866. if blockgroesse > 4000 then blockgroesse := 4000;
  6867. end;
  6868. end;
  6869. end;
  6870. end;
  6871.  
  6872. procedure nmw_all_4;
  6873. const stereoprocs : array[1..8] of pointer =
  6874. (@Stimme_normal,@Stimme_normal,@Stimme_normal_st,@Stimme_normal_st,
  6875. @Stimme_normal,@Stimme_normal,@Stimme_normal_st,@Stimme_normal_st);
  6876. var idx : byte;
  6877. li : integer;
  6878. begin;
  6879. inc(mli);
  6880. if mli > 64 then mli := 1;
  6881. if mli = 1 then begin;
  6882. inc(mlj);
  6883. if mlj > Liedlaenge then begin;
  6884. if mloop then begin;
  6885. mlj := 1;
  6886. move(rm[lied[mlj]] ^,Rm_Song,2048);
  6887. end else begin;
  6888. asm
  6889. call [periodisch_anhalten]
  6890. end;
  6891. music_aus := true;
  6892. Mod_Zu_Ende := true;
  6893. end;
  6894. end else begin;
  6895. move(rm[lied[mlj]] ^,Rm_Song,2048);
  6896. end;
  6897. end;
  6898.  
  6899. for li := 1 to Stimmen do begin;
  6900. effekt_Stimme[li] := 0;
  6901. note[li] := (Rm_Song[mli,li,1] AND $F0)+((Rm_Song[mli,li,3] AND $F0) shr 4);
  6902. if note[li] <> 0 then begin;
  6903. if stereo then begin;
  6904. Mixingprocs[li] := stereoprocs[li];
  6905. end else begin;
  6906. Mixingprocs[li] := @Stimme_normal;
  6907. end;
  6908. Noten_Anschlag[li] := 500;
  6909. In_St[li] := note[li];
  6910. inst[li] := Ptr(pt(Samp[In_St[li]]).sgm,pt(Samp[In_St[li]]).ofs);
  6911. Laenge_Stimme[li] := sam_l[In_St[li]];
  6912. Position_Stimme[li] := 0;
  6913. Notvol_Stimme[li] := inst_vol[in_St[li]];
  6914. Segment_Stimme[li] := seg(inst[li]^);
  6915. end;
  6916. effect_handling(li);
  6917. end;
  6918.  
  6919. end;
  6920.  
  6921.  
  6922. procedure initialisiere_vermischen;
  6923. begin;
  6924. asm
  6925. call [vermische_proc]
  6926. end;
  6927. end;
  6928.  
  6929. FUNCTION ConvertString(Source : Pointer; Size : BYTE):String;
  6930. VAR
  6931. WorkStr : String;
  6932. BEGIN
  6933. Move(Source^,WorkStr[1],Size);
  6934. WorkStr[0] := CHR(Size);
  6935. ConvertString := WorkStr;
  6936. END;
  6937.  
  6938. function init_Song : boolean;
  6939. const kenn1 : string = 'FLT4';
  6940. kenn2 : string = 'M.K.';
  6941. kenn3 : string = '8CHN';
  6942. var rmod : file;
  6943. sgr : word; { GrӇe eines Sampels }
  6944. inststart : longint; { Position in Datei, wo Sampledaten starten }
  6945. datgr : longint; { Die GrӇe der MOD - Datei }
  6946. Mkg : array[1..4] of char; { fr Modtyp - Erkennung }
  6947. hilfsp : ^byte;
  6948. strptr : pointer;
  6949. kennch : array[1..4] of char;
  6950. kennstr : string;
  6951. instanz : byte;
  6952. idx : integer;
  6953. begin;
  6954. In_St[1] := 0;
  6955. In_St[2] := 0;
  6956. In_St[3] := 0;
  6957. In_St[4] := 0;
  6958. In_St[5] := 0;
  6959. In_St[6] := 0;
  6960. In_St[7] := 0;
  6961. In_St[8] := 0;
  6962. for mlj := 0 to 128 do
  6963. Lied[mlj] := 0;
  6964. {$I-}
  6965. assign(rmod,Mod_Name);
  6966. reset(rmod,1);
  6967. {$I+}
  6968. if IOresult <> 0 then begin;
  6969. init_song := false;
  6970. exit;
  6971. end;
  6972. if moddatgroesse <> 0 then datgr := moddatgroesse else
  6973. datgr := filesize(rmod);
  6974. inststart := datgr;
  6975. seek(rmod,1080);
  6976. blockread(rmod,kennch,4);
  6977. kennstr := kennch;
  6978. if (kennstr <> kenn1) and (kennstr <> kenn2)
  6979. and (kennstr <> kenn3) then begin;
  6980. instanz := 15;
  6981. end else begin;
  6982. instanz := 31;
  6983. end;
  6984.  
  6985. if instanz = 31 then begin; { 31 Stimmen ber Kennung ermittelt }
  6986. for mlj := 1 to 31 do begin;
  6987. idx := mlj;
  6988. seek(rmod,msp+42+(idx-1)*30);
  6989. blockread(rmod,sgr,2);
  6990. sgr := swap(sgr) * 2;
  6991. if sgr <> 0 then inststart := inststart - sgr;
  6992. Sam_l[idx] := sgr;
  6993. seek(rmod,msp+45+(idx-1)*30);
  6994. blockread(rmod,inst_vol[idx],1);
  6995. blockread(rmod,loop_s[idx],2);
  6996. blockread(rmod,loop_l[idx],2);
  6997. loop_s[idx] := swap(loop_s[idx])*2;
  6998. loop_l[idx] := swap(loop_l[idx])*2;
  6999. end;
  7000.  
  7001. seek(rmod,msp+1080);
  7002. blockread(rmod,Mkg,4);
  7003. if pos('8CHN',Mkg) <> 0 then begin;
  7004. Pattgroesse := 2048;
  7005. Stimmen := 8;
  7006. shiftfactor := 3;
  7007. shiftfactor_stereo := 3;
  7008. end else begin;
  7009. { 4-Stimmige MOD-Datei }
  7010. Pattgroesse := 1024;
  7011. Stimmen := 4;
  7012. shiftfactor := 2;
  7013. shiftfactor_stereo := 2;
  7014. end;
  7015. Vermische_Proc := @vermische_start_4;
  7016. nmw_Proc := @nmw_all_4;
  7017. if stereo then
  7018. innen_proc := @innen_schleife_4_stereo
  7019. else
  7020. innen_proc := @innen_schleife_4;
  7021.  
  7022.  
  7023. seek(rmod,msp+inststart);
  7024. for mlj := 1 to 31 do begin;
  7025. idx := mlj;
  7026. getmem(Samp[idx],Sam_l[idx]);
  7027. blockread(rmod,Samp[idx]^,sam_l[idx]);
  7028. end;
  7029.  
  7030. datgr := inststart - 1083;
  7031. pat_anz := datgr div Pattgroesse;
  7032. for mlj := 0 to pat_anz-1 do begin;
  7033. getmem(rm[mlj],2048);
  7034. fillchar(rm[mlj]^,2048,0);
  7035. seek(rmod,msp+1084+mlj*Pattgroesse);
  7036. hilfsp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^));
  7037. for mli := 0 to 63 do begin;
  7038. hilfsp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^)+mli*32);
  7039. blockread(rmod,hilfsp^,Pattgroesse div 64);
  7040. end;
  7041. end;
  7042. seek(rmod,msp+952);
  7043. blockread(rmod,Lied,128);
  7044.  
  7045. getmem(strptr,25);
  7046. for i := 0 to 30 do begin;
  7047. seek(rmod,msp+20+i*30);
  7048. blockread(rmod,strptr^,22);
  7049. instnamen[i+1] := convertstring(strptr,22);
  7050. end;
  7051. seek(rmod,msp);
  7052. blockread(rmod,strptr^,20);
  7053. songname := convertstring(strptr,20);
  7054. freemem(strptr,25);
  7055.  
  7056. seek(rmod,msp+950); { von 470}
  7057. blockread(rmod,Liedlaenge,1);
  7058. end else begin;
  7059. for mlj := 1 to 15 do begin;
  7060. seek(rmod,msp+42+(mlj-1)*30);
  7061. blockread(rmod,sgr,2);
  7062. sgr := swap(sgr) * 2;
  7063. if sgr <> 0 then inststart := inststart - sgr;
  7064. Sam_l[mlj] := sgr;
  7065. seek(rmod,msp+45+(mlj-1)*30);
  7066. blockread(rmod,inst_vol[mlj],1);
  7067. blockread(rmod,loop_s[mlj],2);
  7068. blockread(rmod,loop_l[mlj],2);
  7069. loop_s[mlj] := swap(loop_s[mlj])*2;
  7070. loop_l[mlj] := swap(loop_l[mlj])*2;
  7071. end;
  7072.  
  7073. for mlj := 16 to 31 do begin;
  7074. Sam_l[mlj] := 0;
  7075. loop_s[mlj] := 0;
  7076. loop_l[mlj] := 0;
  7077. end;
  7078.  
  7079. if pos('8CHN',Mkg) <> 0 then begin;
  7080. Pattgroesse := 2048;
  7081. Stimmen := 8;
  7082. shiftfactor := 3;
  7083. shiftfactor_stereo := 3;
  7084. end else begin;
  7085. { 4-Stimmige MOD-Datei }
  7086. Pattgroesse := 1024;
  7087. Stimmen := 4;
  7088. shiftfactor := 2;
  7089. shiftfactor_stereo := 2;
  7090. end;
  7091. Vermische_Proc := @vermische_start_4;
  7092. nmw_Proc := @nmw_all_4;
  7093. if stereo then
  7094. innen_proc := @innen_schleife_4_stereo
  7095. else
  7096. innen_proc := @innen_schleife_4;
  7097.  
  7098. seek(rmod,msp+inststart);
  7099. for mlj := 1 to 15 do begin;
  7100. getmem(Samp[mlj],Sam_l[mlj]);
  7101. blockread(rmod,Samp[mlj]^,sam_l[mlj]);
  7102. end;
  7103.  
  7104. datgr := inststart - 603;
  7105. pat_anz := datgr div Pattgroesse;
  7106. for mlj := 0 to pat_anz-1 do begin;
  7107. getmem(rm[mlj],2048);
  7108. fillchar(rm[mlj]^,2048,0);
  7109. seek(rmod,msp+1084+mlj*Pattgroesse);
  7110. hilfsp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^));
  7111. for mli := 0 to 63 do begin;
  7112. hilfsp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^)+mli*32);
  7113. blockread(rmod,hilfsp^,Pattgroesse div 64);
  7114. end;
  7115. end;
  7116. seek(rmod,msp+472);
  7117. blockread(rmod,Lied,128);
  7118.  
  7119. getmem(strptr,25);
  7120. for i := 0 to 14 do begin;
  7121. seek(rmod,msp+20+i*30);
  7122. blockread(rmod,strptr^,22);
  7123. instnamen[i+1] := convertstring(strptr,22);
  7124. end;
  7125.  
  7126. for i := 15 to 30 do begin;
  7127. instnamen[i+1] := '';
  7128. end;
  7129. seek(rmod,msp);
  7130. blockread(rmod,strptr^,20);
  7131. songname := convertstring(strptr,20);
  7132. freemem(strptr,25);
  7133.  
  7134. seek(rmod,msp+470);
  7135. blockread(rmod,Liedlaenge,1);
  7136. end;
  7137.  
  7138.  
  7139. mlj := 0;
  7140. mli := 0;
  7141. close(rmod);
  7142. init_song := true;
  7143. end;
  7144.  
  7145. procedure exit_song;
  7146. begin;
  7147. Port[dsp_adr+$C] := $D3;
  7148. halt(0);
  7149. end;
  7150.  
  7151. procedure Free_Soundmem;
  7152. {
  7153. Reservierten Speicher wieder frei geben
  7154. }
  7155. begin;
  7156. if music_played then begin;
  7157. for mlj := 0 to pat_anz-1 do begin;
  7158. freemem(rm[mlj],2048);
  7159. end;
  7160. end;
  7161. end;
  7162.  
  7163. procedure init_sbperiod(p : pointer);
  7164. begin;
  7165. periodisch_anhalten := p;
  7166. end;
  7167.  
  7168. procedure mod_SetLoopflag(loopen : boolean);
  7169. begin;
  7170. mloop := loopen;
  7171. end;
  7172.  
  7173. procedure mod_SetMultiply(msm : word);
  7174. begin;
  7175. modmultiply := msm;
  7176. end;
  7177.  
  7178. procedure mod_SetLoop(msl : word);
  7179. begin;
  7180. Sound_Schleifen := msl;
  7181. loop3 := msl;
  7182. end;
  7183.  
  7184. procedure mod_SetSpeed(msp : word);
  7185. begin;
  7186. speed := msp;
  7187. Speed3 := msp;
  7188. end;
  7189.  
  7190. procedure mod_autodetect(what : boolean);
  7191. begin;
  7192. if what then mautodet := true else mautodet := false;
  7193. end;
  7194.  
  7195. procedure mod_transpose(transposerwert : integer);
  7196. begin;
  7197. tpw := transposerwert;
  7198. end;
  7199.  
  7200. procedure init_data;
  7201. Var i,j : integer;
  7202. begin;
  7203. m_played := false;
  7204. In_St[1] := 0;
  7205. In_St[2] := 0;
  7206. In_St[3] := 0;
  7207. In_St[4] := 0;
  7208. In_St[5] := 0;
  7209. In_St[6] := 0;
  7210. In_St[7] := 0;
  7211. In_St[8] := 0;
  7212. Note1 := 0;
  7213. Note2 := 0;
  7214. Note3 := 0;
  7215. Note4 := 0;
  7216. Note5 := 0;
  7217. Note6 := 0;
  7218. Note7 := 0;
  7219. Note8 := 0;
  7220. Noten_Anschlag[1] := 0;
  7221. Noten_Anschlag[2] := 0;
  7222. Noten_Anschlag[3] := 0;
  7223. Noten_Anschlag[4] := 0;
  7224. Noten_Anschlag[5] := 0;
  7225. Noten_Anschlag[6] := 0;
  7226. Noten_Anschlag[7] := 0;
  7227. Noten_Anschlag[8] := 0;
  7228. fillchar(inl,sizeof(inl),0);
  7229. notvol1 := 0; notvol2 := 0; notvol3 := 0; notvol4 := 0;
  7230. notvol5 := 0; notvol6 := 0; notvol7 := 0; notvol8 := 0;
  7231. fillchar(Rm_Song,2048,0);
  7232. end;
  7233.  
  7234. procedure init_Paramtable;
  7235. var ls : byte;
  7236. h : real;
  7237. begin;
  7238. { playspeed := 6;
  7239. for ls := 1 to 31 do begin;
  7240. if ls <= 3 then
  7241. ModPara[ls].mult := 100
  7242. else
  7243. ModPara[ls].mult := 105;
  7244. ModPara[ls].Speed := ls*ModPara[ls].mult div 10;
  7245. ModPara[ls].bgr := ModPara[ls].Speed*Sound_Schleifen;
  7246. end;}
  7247. end;
  7248.  
  7249. procedure mod_Samplefreq(Rate : integer);
  7250. var h : real;
  7251. begin;
  7252. case Rate of
  7253. 08 : begin;
  7254. Sampling_Rate := 131;
  7255. set_timeconst_sb16(131);
  7256. mod_transpose(1);
  7257. mod_SetLoop(15);
  7258. blockgroesse := Speed * Sound_Schleifen;
  7259. Sampling_Frequenz := 8000;
  7260. init_Paramtable;
  7261. end;
  7262. 10 : begin;
  7263. Sampling_Rate := 156;
  7264. set_timeconst_sb16(156);
  7265. mod_transpose(5);
  7266. mod_SetLoop(19);
  7267. blockgroesse := Speed * Sound_Schleifen;
  7268. Sampling_Frequenz := 10000;
  7269. init_Paramtable;
  7270. end;
  7271. 13 : begin;
  7272. Sampling_Rate := 181;
  7273. set_timeconst_sb16(181);
  7274. mod_transpose(10);
  7275. mod_SetLoop(25);
  7276. blockgroesse := Speed * Sound_Schleifen;
  7277. Sampling_Frequenz := 13333;
  7278. init_Paramtable;
  7279. end;
  7280. 16 : begin;
  7281. Sampling_Rate := 196;
  7282. set_timeconst_sb16(196);
  7283. mod_transpose(14);
  7284. mod_SetLoop(32);
  7285. blockgroesse := Speed * Sound_Schleifen;
  7286. Sampling_Frequenz := 16666;
  7287. init_Paramtable;
  7288. end;
  7289. 22 : begin;
  7290. Sampling_Rate := 211;
  7291. set_timeconst_sb16(211);
  7292. mod_transpose(19);
  7293. mod_SetLoop(44);
  7294. blockgroesse := Speed * Sound_Schleifen;
  7295. Sampling_Frequenz := 22222;
  7296. init_Paramtable;
  7297. end;
  7298. end;
  7299. end;
  7300.  
  7301. procedure Sound_handler;
  7302. var li : integer;
  7303. begin;
  7304. if mycli <> 0 then exit;
  7305. mycli := 1;
  7306. if (Loop_pos > Speed) then begin;
  7307. if phase_2 then begin;
  7308. Nothin_done_count := 0;
  7309. asm
  7310. call [nmw_proc]
  7311. end;
  7312. Initialisiere_Vermischen;
  7313. Loop_pos := 0;
  7314. phase_2 := false;
  7315. phase_1 := true;
  7316. if outfading then
  7317. if outvolume >= 2 then dec(outvolume,2);
  7318. for li := 1 to 8 do
  7319. if Noten_Anschlag[li] > 50 then dec(Noten_Anschlag[li],50);
  7320. end;
  7321. end else begin;
  7322. asm call [innen_proc] end;
  7323. Loop_pos := Speed+2;
  7324. end;
  7325. mycli := 0;
  7326. end;
  7327.  
  7328. procedure calculate_music; assembler;
  7329. asm
  7330. cmp mycli,0
  7331. jne @ende_stop
  7332. cmp music_aus,0
  7333. jne @ende_stop
  7334. pusha
  7335. call Sound_handler
  7336. popa
  7337. @ende_stop:
  7338. end;
  7339.  
  7340. procedure mod_waitretrace(num : byte);
  7341. var dl : integer;
  7342. begin;
  7343. in_retrace := true;
  7344. for dl := 1 to num do
  7345. calculate_music;
  7346. asm
  7347. push dx
  7348. @l1:
  7349. mov dx,3dah
  7350. in al,dx
  7351. and al,8h
  7352. jnz @l1
  7353. @l2:
  7354. mov dx,3dah
  7355. in al,dx
  7356. and al,8h
  7357. jz @l2
  7358. pop dx
  7359. End;
  7360. in_retrace := false;
  7361. end;
  7362.  
  7363.  
  7364. function lade_moddatei(modname : string;ispeed,iloop : integer;freq : byte) : integer;
  7365. var df : file;
  7366. sterreg : byte;
  7367. fgr : longint;
  7368. begin;
  7369. PLAYING_MOD := true;
  7370. PLAYING_VOC := false;
  7371. outfading := false;
  7372. outvolume := 63;
  7373. Mod_Name := modname;
  7374. {$I-}
  7375. assign(df,Mod_name);
  7376. reset(df,1);
  7377. {$I+}
  7378. if IOResult <> 0 then begin;
  7379. {$I-}
  7380. close(df);
  7381. lade_moddatei := -1; { Datei nicht gefunden ! }
  7382. exit;
  7383. end;
  7384. {$I-}
  7385. fgr := filesize(df);
  7386. close(df);
  7387. music_played := true;
  7388. music_aus := false;
  7389. Mod_zu_ende := false;
  7390.  
  7391. if ispeed <> AUTO then Speed3 := ispeed;
  7392. if iloop <> AUTO then Loop3 := iloop;
  7393. if force_mono then stereo := false;
  7394. if force_sb then begin;
  7395. if Sb16Detected then stereo := false;
  7396. Sb16Detected := false;
  7397. end;
  7398.  
  7399. if SBProdetected then begin;
  7400. if stereo then begin;
  7401. sterreg := Read_Mixer($0e);
  7402. write_Mixer($0e,sterreg OR 2);
  7403. end else begin;
  7404. sterreg := Read_Mixer($0e);
  7405. write_Mixer($0e,sterreg AND $FD);
  7406. end;
  7407. end;
  7408. init_data;
  7409. if init_song then begin;
  7410. phase_1 := false;
  7411. phase_2 := true;
  7412. mycli := 0;
  7413.  
  7414. mod_Samplefreq(freq);
  7415. Playspeed := 6;
  7416. Speed := Playspeed*105 div 10;
  7417. bpm := 125;
  7418. mod_SetLoop(Sampling_Frequenz div (BPM * 4));
  7419. blockgroesse := Speed * Sound_Schleifen;
  7420. if blockgroesse < 100 then blockgroesse := 100;
  7421. if blockgroesse > 4000 then blockgroesse := 4000;
  7422.  
  7423. asm call [nmw_proc] end;
  7424. set_timeconst_sb16(Sampling_Rate);
  7425. Initialisiere_Vermischen;
  7426. Laufsec := 0;
  7427. Laufmin := 0;
  7428. wr_dsp_sb16($D1);
  7429. if sb16detected or sbprodetected then begin;
  7430. filter_Mid;
  7431. Set_Balance(Balance);
  7432. Set_Volume(Mastervolume);
  7433. end;
  7434. Lade_Moddatei := 0;
  7435. end else begin;
  7436. Lade_Moddatei := -3; { Fehler beim Laden des Songs }
  7437. end;
  7438. end;
  7439.  
  7440. procedure ende_mod;
  7441. var mlj : integer;
  7442. begin;
  7443. Free_Soundmem;
  7444. for mlj := 1 to 31 do begin;
  7445. freemem(Samp[mlj],Sam_l[mlj]);
  7446. end;
  7447. mod_terminated := true;
  7448. end;
  7449.  
  7450.  
  7451. Procedure periodisch_on;
  7452. Begin
  7453. outvolume := 64;
  7454. letzte_ausgabe := false;
  7455. { for Loop_pos := 1 to Speed do begin;}
  7456. asm call [innen_proc] end;
  7457. { end;}
  7458. dsp_block_sb16(blockgroesse,blockgroesse,buffer1,true,false);
  7459. bsw := not bsw;
  7460. Loop_pos := 0;
  7461. asm
  7462. call [nmw_proc]
  7463. end;
  7464. Initialisiere_Vermischen;
  7465.  
  7466. init_sbperiod(@periodisch_off);
  7467. music_played := true;
  7468. StelleTimerEin(@NeuerTimer,timer_per_second);
  7469. End;
  7470.  
  7471. Procedure periodisch_off;
  7472. Begin
  7473. letzte_ausgabe := true;
  7474. StelleTimerAus;
  7475. End;
  7476.  
  7477. procedure Fade_Musix_out;
  7478. begin;
  7479. outfading := true;
  7480. end;
  7481.  
  7482. procedure MODExitProc;
  7483. var mlj : byte;
  7484. begin
  7485. ExitProc := SaveExitProc;
  7486. { if music_played then periodisch_off;}
  7487. if not mod_terminated and music_played then ende_mod;
  7488. Exit_Sb16;
  7489. end;
  7490.  
  7491.  
  7492.  
  7493. {
  7494.  
  7495. **************************************************************************
  7496. *** ***
  7497. *** Routinen zur Ausgabe von VOC-Dateien ***
  7498. *** ***
  7499. **************************************************************************
  7500.  
  7501. }
  7502.  
  7503. var pause_voc : boolean;
  7504.  
  7505. procedure Init_Voc(filename : string);
  7506. const VOCkenn : string = 'Creative Voice File'+#$1A;
  7507. var ch : char;
  7508. kennstr : string;
  7509. ct : byte;
  7510. h : byte;
  7511. error : integer;
  7512. srlo,srhi : byte;
  7513. SR : word;
  7514. Samplingr : word;
  7515. stereoreg : byte;
  7516. begin;
  7517. PLAYING_MOD := false;
  7518. PLAYING_VOC := true;
  7519. VOC_READY := false;
  7520. vocsstereo := stereo;
  7521. stereo := false;
  7522.  
  7523. assign(vocf,filename);
  7524. reset(vocf,1);
  7525. if filesize(vocf) < 5000 then begin;
  7526. VOC_READY := true;
  7527. exit;
  7528. end;
  7529. blockread(vocf,voch,$19);
  7530. kennstr := voch.Kennstr;
  7531. if kennstr <> VOCkenn then begin;
  7532. VOC_READY := true;
  7533. exit;
  7534. end;
  7535.  
  7536. Blockread(vocf,inread,20);
  7537. vblock.Kennung := inread[2];
  7538.  
  7539. if vblock.Kennung = 1 then begin;
  7540. vblock.SR := inread[6];
  7541. end;
  7542.  
  7543. if vblock.Kennung = 8 then begin;
  7544. SR := inread[6]+(inread[7]*256);
  7545. Samplingr := 256000000 div (65536 - SR);
  7546. if inread[9] = 1 then begin; {stereo}
  7547. if sb16detected then samplingr := samplingr shr 1;
  7548. stereo := true;
  7549. end;
  7550. vblock.SR := 256 - longint(1000000 DIV samplingr);
  7551. end;
  7552.  
  7553. if vblock.Kennung = 9 then begin;
  7554. Samplingr := inread[6]+(inread[7]*256);
  7555. if inread[11] = 2 then begin; {stereo}
  7556. stereo := true;
  7557. if sbprodetected then samplingr := samplingr * 2;
  7558. vblock.SR := 256 - longint(1000000 DIV (samplingr));
  7559. end else begin;
  7560. vblock.SR := 256 - longint(1000000 DIV samplingr);
  7561. end;
  7562. end;
  7563.  
  7564.  
  7565. if vblock.SR < 130 then vblock.SR := 166;
  7566.  
  7567. set_timeconst_sb16(vblock.SR);
  7568.  
  7569. blockgr := filesize(vocf) - 31;
  7570. if blockgr > 2500 then blockgr := 2500;
  7571. blockread(vocf,vocb1^,blockgr);
  7572.  
  7573. ch := #0;
  7574. fgr := filesize(vocf) - 32;
  7575. fgr := fgr - blockgr;
  7576. Block_activ := 1;
  7577.  
  7578. if fgr > 1 then begin;
  7579. blockread(vocf,vocb2^,blockgr);
  7580. fgr := fgr - blockgr;
  7581. end;
  7582.  
  7583. wr_dsp_sb16($D1);
  7584. lastone := false;
  7585.  
  7586. if not sb16Detected then begin;
  7587. if Stereo then begin;
  7588. stereoreg := Read_Mixer($0E);
  7589. stereoreg := stereoreg OR 2;
  7590. Write_Mixer($0E,stereoreg);
  7591. end else begin;
  7592. stereoreg := Read_Mixer($0E);
  7593. stereoreg := stereoreg AND $FD;
  7594. Write_Mixer($0E,stereoreg);
  7595. end;
  7596. end;
  7597. pause_voc := false;
  7598. dsp_block_sb16(blockgr,blockgr,vocb1,false,true);
  7599. end;
  7600.  
  7601. procedure voc_done;
  7602. var h : byte;
  7603. begin;
  7604. lastone := true;
  7605. { repeat until dsp_rdy_sb16;}
  7606. close(vocf);
  7607. Reset_Sb16;
  7608. stereo := vocsstereo;
  7609. end;
  7610.  
  7611.  
  7612. procedure voc_pause;
  7613. begin;
  7614. pause_voc := true;
  7615. end;
  7616.  
  7617. procedure voc_continue;
  7618. begin;
  7619. pause_voc := false;
  7620. if block_activ = 1 then begin
  7621. dsp_block_sb16(blockgr,blockgr,vocb2,false,true);
  7622. block_activ := 2;
  7623. end else begin;
  7624. dsp_block_sb16(blockgr,blockgr,vocb1,false,true);
  7625. block_activ := 1;
  7626. end;
  7627. end;
  7628.  
  7629. {
  7630.  
  7631. **************************************************************************
  7632. *** ***
  7633. *** Nochmals SB - Routinen, aus logischen Grnden nachgelagert ***
  7634. *** ***
  7635. **************************************************************************
  7636.  
  7637. }
  7638.  
  7639. procedure dsp_int_sb16; interrupt;
  7640. {
  7641. Diese Procedure wird durch den Interrupt angesprungen, der am Ende
  7642. einer Blockbertragung generiert wird. Wenn nicht das Flag
  7643. letzte_ausgabe gesetzt ist, wird eine neue Ausgabe gestartet
  7644. }
  7645. var h : byte;
  7646. begin;
  7647. if interrupt_check then begin;
  7648. IRQDetected := true;
  7649. end else begin;
  7650. if PLAYING_MOD then begin;
  7651. h := port[dsp_adr+$E];
  7652. dsp_rdy_sb16 := true;
  7653.  
  7654. if not letzte_ausgabe then begin;
  7655. if bsw then
  7656. dsp_block_sb16(blockgroesse,blockgroesse,buffer1,true,false)
  7657. else
  7658. dsp_block_sb16(blockgroesse,blockgroesse,buffer2,true,false);
  7659. bsw := not bsw;
  7660. phase_1 := false;
  7661. phase_2 := true;
  7662. end;
  7663. end;
  7664.  
  7665. IF PLAYING_VOC then begin;
  7666. h := port[dsp_adr+$E];
  7667. if (fgr > blockgr) and not lastone then begin
  7668. lastone := false;
  7669. if block_activ = 1 then begin
  7670. if not pause_voc then
  7671. dsp_block_sb16(blockgr,blockgr,vocb2,false,true);
  7672. blockread(vocf,vocb1^,blockgr);
  7673. fgr := fgr - blockgr;
  7674. block_activ := 2;
  7675. end else begin;
  7676. if not pause_voc then
  7677. dsp_block_sb16(blockgr,blockgr,vocb1,false,true);
  7678. blockread(vocf,vocb2^,blockgr);
  7679. fgr := fgr - blockgr;
  7680. block_activ := 1;
  7681. end;
  7682. end else begin;
  7683. if not lastone then begin;
  7684. if block_activ = 1 then begin
  7685. if not pause_voc then
  7686. dsp_block_sb16(blockgr,blockgr,vocb2,false,true);
  7687. lastone := true;
  7688. end else begin;
  7689. if not pause_voc then
  7690. dsp_block_sb16(blockgr,blockgr,vocb1,false,true);
  7691. lastone := true;
  7692. end;
  7693. end else begin;
  7694. dsp_rdy_sb16 := true;
  7695. wr_dsp_sb16($D0);
  7696. VOC_READY := true;
  7697. end;
  7698. end;
  7699. end;
  7700. end;
  7701. Port[$20] := $20;
  7702. end;
  7703.  
  7704. procedure detect_sbIRQ;
  7705. {
  7706. Diese Routine erkennt den IRQ der Soundblaster-Karte. Es werden dazu
  7707. alle m”glichen Interrupts durchgetestet. Dazu werden kurze Blocke
  7708. via DMA ausgegeben. Wenn am Ende der Ausgabe der eingestellte Inter-
  7709. rupt angesprungen wird, so ist der richtige gefunden
  7710. }
  7711. const moegliche_irqs : array[1..5] of byte = ($2,$3,$5,$7,$10);
  7712. var i : integer;
  7713. h : byte;
  7714. begin;
  7715. getintvec($8+dsp_irq,intback); { Werte sichern ! }
  7716. port21 := port[$21];
  7717. fillchar(buffer1^,1200,128);
  7718. set_Timeconst_sb16(211);
  7719. wr_dsp_sb16($D3); { Lautsprecher aus }
  7720. i := 1;
  7721. interrupt_check := true;
  7722. while (i <= 5) and (not IRQDetected) do
  7723. begin;
  7724. dsp_irq := moegliche_irqs[i]; { zu Testender IRQ }
  7725. getintvec($8+dsp_irq,oldint); { Interrupt Verbiegen }
  7726. setintvec($8+dsp_irq,@Dsp_Int_sb16);
  7727. irqmsk := 1 shl dsp_irq;
  7728. port[$21] := port[$21] and not irqmsk;
  7729. Sampling_Rate := 211;
  7730. blockgroesse := 1200; { testweise Ausgabe }
  7731. dsp_block_sb16(blockgroesse,blockgroesse,buffer1,true,false);
  7732. delay(150);
  7733. setintvec($8+dsp_irq,oldint); { Interrupt wieder zurck }
  7734. port[$21] := Port[$21] or irqmsk;
  7735. h := port[dsp_adr+$E];
  7736. Port[$20] := $20;
  7737. inc(i);
  7738. end;
  7739. interrupt_check := false;
  7740. wr_dsp_sb16($D1); { Lautsprecher wieder ein }
  7741. setintvec($8+dsp_irq,intback); { Alte Werte zurck !!! }
  7742. port[$21] := port21;
  7743. dsp_rdy_sb16 := true;
  7744. end;
  7745.  
  7746. function Init_Sb : boolean;
  7747. {
  7748. Diese Function initialisiert den Soundblaster. Sie liefert TRUE
  7749. zurck, wenn die Initialisierung erfolgreich war, ansonsten FALSE.
  7750. Der Lautsprecher fr Sampling-Ausgabe wird eingeschaltet. Der
  7751. DMA-Ready Interrupt wird auf eine eigene Routine verbogen.
  7752. }
  7753. begin;
  7754. if not detect_Reg_sb16 then begin;
  7755. Init_Sb := false;
  7756. exit;
  7757. end;
  7758. { Soundblaster gefunden }
  7759. if not force_irq then detect_sbIRQ; { IRQ auto-detection }
  7760. test_uebertragung;
  7761. if not force_irq then detect_sbIRQ; { 2. Test fr SB n”tig ! }
  7762. if Detect_Mixer_sb16 then begin;
  7763. SbProDetected := TRUE; { SB Pro gefunden }
  7764. end;
  7765. SbGetDspVersion;
  7766. if SbVersMaj >= 4 then begin; { SB 16 ASP gefunden }
  7767. Sb16Detected := true;
  7768. SBProDetected := false;
  7769. end;
  7770. wr_dsp_sb16($D1); { Lautsprecher ein }
  7771. getintvec($8+dsp_irq,oldint); { Alten Interrupt sichern, }
  7772. setintvec($8+dsp_irq,@dsp_int_sb16); { auf eigene Routine setzen }
  7773. irqmsk := 1 shl dsp_irq; { Interrupt einmaskieren }
  7774. port[$21] := port[$21] and not irqmsk;
  7775. end;
  7776.  
  7777. function init_The_Mod : boolean;
  7778. begin;
  7779. mod_autodetect(on); { Wenn true werden Speed-Angaben im Song erkannt }
  7780. mod_SetSpeed(66);
  7781. mod_SetMultiply(11);
  7782. mod_Setloopflag(ON); { Soll die Ausgabe wieder von Vorne beginnen, wenn am }
  7783. { Ende angekommen ? (ON / OFF) }
  7784. if not init_sb then { Speaker einschalten, automatische Erkennung }
  7785. init_the_mod := false
  7786. else begin;
  7787. init_the_mod := true;
  7788. mod_Samplefreq(Samfreq);
  7789. end;
  7790. end;
  7791.  
  7792.  
  7793. begin;
  7794. SaveExitProc := ExitProc;
  7795. ExitProc := @MODExitProc;
  7796. dsp_rdy_sb16 := true;
  7797. mod_terminated := false;
  7798. music_played := false;
  7799. mloop := true;
  7800. mli := 0;
  7801. mlj := 0;
  7802. tpw := 5;
  7803. In_St[1] := 0;
  7804. In_St[2] := 0;
  7805. In_St[3] := 0;
  7806. In_St[4] := 0;
  7807. In_St[5] := 0;
  7808. In_St[6] := 0;
  7809. In_St[7] := 0;
  7810. In_St[8] := 0;
  7811. loop_pos := 0;
  7812. mautodet := true;
  7813. modmultiply := 20;
  7814. Sound_Schleifen := 10;
  7815. Noten_Anschlag[1] := 0;
  7816. Noten_Anschlag[2] := 0;
  7817. Noten_Anschlag[3] := 0;
  7818. Noten_Anschlag[4] := 0;
  7819. Noten_Anschlag[5] := 0;
  7820. Noten_Anschlag[6] := 0;
  7821. Noten_Anschlag[7] := 0;
  7822. Noten_Anschlag[8] := 0;
  7823. Leerstimme := @Leere_Stimme;
  7824. Mixingprocs[1] := Leerstimme;
  7825. Mixingprocs[2] := Leerstimme;
  7826. Mixingprocs[3] := Leerstimme;
  7827. Mixingprocs[4] := Leerstimme;
  7828. Mixingprocs[5] := Leerstimme;
  7829. Mixingprocs[6] := Leerstimme;
  7830. Mixingprocs[7] := Leerstimme;
  7831. Mixingprocs[8] := Leerstimme;
  7832. getmem(mixed_data,8000);
  7833. getmem(mixed_data_st,8000);
  7834.  
  7835. getmem(buffer1,8000);
  7836. getmem(buffer2,8000);
  7837. getmem(vocb1,8000);
  7838. getmem(vocb2,8000);
  7839. bsw := true;
  7840. end.
  7841.  
  7842. unit variab;
  7843.  
  7844. interface
  7845.  
  7846. TYPE
  7847. pt = record { erm”glicht die einfache }
  7848. ofs,sgm : word; { Behandlung von Pointern }
  7849. end;
  7850.  
  7851. Effect_Type = record
  7852. p : pointer;
  7853. l : longint;
  7854. sr : word;
  7855. end;
  7856.  
  7857. Param_Table = record
  7858. mult : word;
  7859. Speed : word;
  7860. bgr : word;
  7861. Ab : integer;
  7862. end;
  7863. TYPE vocheader = record
  7864. Kennstr : array[0..19] of char;
  7865. Sampoff : word;
  7866. Verslo : Byte;
  7867. Vershi : Byte;
  7868. Kennung : word;
  7869. end;
  7870.  
  7871. Voiceblock = record
  7872. Kennung : byte;
  7873. Laeng_lo : word;
  7874. Laeng_hi : byte;
  7875. SR : byte;
  7876. Pack : byte;
  7877. end;
  7878.  
  7879.  
  7880.  
  7881. CONST block_activ : byte = 1;
  7882. Incfacts : array[1..99] of longint =
  7883. ( $0021E7,$0023EB,$00260E,$002851,$002AB7,$002D41,$002FF2,$0032CC,
  7884. $0035D1,$003904,$003C68,$004000,$0043CE,$0047D6,$004C1C,$0050A2,
  7885. $00556E,$005A82,$005FE4,$006598,$006BA2,$007209,$0078D0,$007FFF,
  7886. $00879C,$008FAC,$009837,$00A144,$00AADB,$00B504,$00BFC8,$00CB2F,
  7887. $00D744,$00E411,$00F1A1,$00FFFF,$010F39,$011F5A,$013070,$01428A,
  7888. $0155B8,$016A09,$017F91,$01965F,$01AE89,$01C823,$01E343,$01FFFF,
  7889. $021E72,$023EB3,$0260DF,$028514,$02AB6F,$02D413,$02FF21,$032CC0,
  7890. $035D14,$039047,$03C686,$03FFFF,$043CE4,$047D66,$04C1BF,$050A29,
  7891. $0556E0,$05A827,$05FE43,$06597F,$06BA27,$07208F,$078D0D,$07FFFF,
  7892. $0879C7,$08FACC,$09837E,$0A1451,$0AADC0,$0B504F,$0BFC87,$0CB2FF,
  7893. $0D744F,$0E411F,$0F1A1C,$0FFFFF,$10F38F,$11F59A,$1306FE,$1428A3,
  7894. $155B81,$16A09E,$17F910,$1965FE,$1AE89F,$1C823D,$1E3438,$1FFFFF,
  7895. $21E71E, $23EB35,$260DFC
  7896. );
  7897.  
  7898. outfading : boolean = false;
  7899. outvolume : byte = 63;
  7900. msp : longint = 0;
  7901. MODDATGROESSE : longint = 0;
  7902. filter_activ : boolean = false;
  7903. balance : byte = 12;
  7904. Mastervolume : byte = 29;
  7905. Startport : word = $200;
  7906. Endport : word = $280;
  7907. playspeed : byte = 6;
  7908.  
  7909. DETECT = 55555;
  7910. Samfreq : word = 22;
  7911. force_mono : boolean = false;
  7912. force_sb : boolean = false;
  7913. force_irq : boolean = false;
  7914. force_dma : boolean = false;
  7915. force_base : boolean = false;
  7916. PC = 0;
  7917. AMIGA = 1;
  7918. m669 : boolean = false;
  7919. interrupt_gefunden : boolean = false;
  7920. interrupt_check : boolean = false;
  7921. Choose_lower_freq : boolean = false;
  7922. timer_per_second : word = 50; { Anzahl Interrupts per Sec. }
  7923. Sampling_Frequenz : word = 10000; { Die Samplingfreq.; Default }
  7924. in_retrace : boolean = false; { Gerade in Retracing-Proc ? }
  7925. dsp_irq : byte = $5; { Interrupt des SB, Wert wird}
  7926. { durch die Init-Routine }
  7927. { ge„ndert }
  7928. dma_ch : byte = 1; { DMA Chanel, standartm„áig }
  7929. { = 1, auf SB 16 ASP auch an-}
  7930. { dere Werte m”glich ... }
  7931. dsp_adr : word = $220; { Die Base-Adress des DSP. }
  7932. { Wert wird durch die Init- }
  7933. { Routine ge„ndert }
  7934. SbVersMin : BYTE = 0; { Die Versions - Kennung }
  7935. SbVersMaj : BYTE = 0;
  7936. STEREO : BOOLEAN = false; { In Stereo abspielen }
  7937. SbRegDetected : BOOLEAN = FALSE; { normale SB vorhanden ? }
  7938. IRQDetected : BOOLEAN = FALSE;
  7939. SbRegInited : BOOLEAN = FALSE;
  7940. SbProDetected : BOOLEAN = FALSE; { SB Pro vorhanden ? }
  7941. SbProInited : BOOLEAN = FALSE;
  7942. Sb16Detected : BOOLEAN = FALSE; { SB 16 ASP vorhanden ? }
  7943. Sb16Inited : BOOLEAN = FALSE;
  7944. MixerDetected : BOOLEAN = FALSE; { Wenn ja, Karte >= SB Pro }
  7945. OldTimerInt = $71; { Orginal Int-Routine des }
  7946. { verbogenen Timer - Int. }
  7947. Stimmen : integer = 4; { Anzahl der Stimmen im }
  7948. { MOD-File }
  7949. Modoktave : array[1..70] of word =
  7950. (
  7951. 1712,1616,1525,1440,1359,1283,1211, { Die Werte in Modoktave ent-}
  7952. 1143,1078,961,907,856,808,763,720, { sprechen den im MOD-File }
  7953. 679,641,605,571,539,509,480,453,428,{ als Tonh”hen gespeicherten }
  7954. 404,381,360,340,321,303,286,270,254,{ Werten. }
  7955. 240,227,214,202,191,180,170,160,151,
  7956. 143,135, 127,120,113,107,101,95,90,
  7957. 85,80,76,71,67,64,60,57,
  7958. 54,51,48,45,43,40,38,36,34,32,30);
  7959.  
  7960. { PermUp_1 : byte = 0; { Portamento Up der Stimme ? }
  7961. { PermUp_2 : byte = 0;
  7962. PermUp_3 : byte = 0;
  7963. PermUp_4 : byte = 0;
  7964. PermUp_5 : byte = 0;
  7965. PermUp_6 : byte = 0;
  7966. PermUp_7 : byte = 0;
  7967. PermUp_8 : byte = 0;
  7968. PermDo_1 : byte = 0; { Portamento Down der Stimme }
  7969. {PermDo_2 : byte = 0;
  7970. PermDo_3 : byte = 0;
  7971. PermDo_4 : byte = 0;
  7972. PermDo_5 : byte = 0;
  7973. PermDo_6 : byte = 0;
  7974. PermDo_7 : byte = 0;
  7975. PermDo_8 : byte = 0;
  7976. PermNk1 : word = 0;
  7977. PermNk2 : word = 0;
  7978. PermNk3 : word = 0;
  7979. PermNk4 : word = 0;
  7980. PermNk5 : word = 0;
  7981. PermNk6 : word = 0;
  7982. PermNk7 : word = 0;
  7983. PermNk8 : word = 0;}
  7984.  
  7985. AUTO = 9999; { Kennung fr Auto detection }
  7986. ON = true;
  7987. OFF = false;
  7988. playeffect : boolean = false;
  7989. effectvolume : word = 7;
  7990. converteff : byte = 0;
  7991. sensib : real = 0.9;
  7992.  
  7993. dma_page : array[0..3] of byte = ($87,$83,$81,$81);
  7994. dma_adr : array[0..3] of byte = (0,2,4,6);
  7995. dma_wc : array[0..3] of byte = (1,3,5,7);
  7996.  
  7997. sb16_outputlaenge : word = 0;
  7998. letzte_ausgabe : boolean = false;
  7999.  
  8000. VAR
  8001. Altintzaehler : word;
  8002. efi : file;
  8003. outfile : file;
  8004. { ModPara : array[0..64] of Param_Table;}
  8005. blockgroesse : word; { GrӇe des Sound-Puffers }
  8006. dsp_rdy_sb16 : boolean; { Flag fr Ende der šbertrag-}
  8007. { ung der Daten via DMA }
  8008. SbVersStr : string[5]; { Die SB-Version als String }
  8009. Speed : word; { Abspielgeschwindigkeit }
  8010. oldInt : pointer; { Zur Sicherung des vom SB }
  8011. { zum DMA-Transfer ben”tigten}
  8012. { Interrupts }
  8013. irqmsk : byte; { zur Interruptbehandlung }
  8014. Vermische_proc : pointer; { Zeiger auf Routinen, die je}
  8015. nmw_proc : pointer; { nach Anzahl der vorhandenen}
  8016. innen_proc : pointer; { Stimmen ausgefhrt werden }
  8017. Noten_Anschlag : array[1..8] { Zeit seid letztem Anschlag }
  8018. of integer;
  8019. Rm_Song : Array[1..64,1..8,{ Ein Pattern }
  8020. 1..4] of Byte;
  8021. rm : array[0..128] { Die einzelnen Pattern }
  8022. of pointer;
  8023. Lied : array[1..128] { Arrangement des Liedes }
  8024. of byte;
  8025. blk : pointer; { Pointer auf Daten - Puffer }
  8026. inst : array[1..8] of pointer;
  8027. Samp : Array[1..64] { Feld mit Zeigern auf }
  8028. of pointer; { Sampels }
  8029. Sam_l : Array[1..64] { Die L„nge der Sampels }
  8030. of word;
  8031. loop_s : array[1..64] { Loop-Start der Sampels }
  8032. of word;
  8033. loop_l : array[1..64] { Loop-L„nge der Sampels }
  8034. of word;
  8035. i1,i2,i3,i4, { Pointer auf aktive Sampels }
  8036. i5,i6,i7,i8 : pt; { in "pt"-Form }
  8037. inl : array[1..8] of word;
  8038. inp : array[1..8] of word;
  8039. i : word;
  8040. mlj : word; { Schleifenz„hler, Aktuelles }
  8041. { Pattern }
  8042. mli : word; { Schleifenz„hler, Aktuelle }
  8043. { Zeile im Pattern }
  8044. { Vk1,Vk2,Vk3, { Vorkommawert des Faktors, }
  8045. { Vk4,Vkh,Vk5, { um den die Pos. in den Sam-}
  8046. { Vk6,Vk7,Vk8 : word; { pledaten erh”ht werden muá }
  8047. { Nk1,Nk2,Nk3, { Vorkommawert des Faktors, }
  8048. { Nk4,Nkh,Nk5, { um den die Pos. in den Sam-}
  8049. { Nk6,Nk7,Nk8 : byte; { pledaten erh”ht werden muá }
  8050. { Dif1,Dif2,Dif3,
  8051. Dif4,Dif5,Dif6,
  8052. Dif7,Dif8 : byte;
  8053. Difb1,Difb2,Difb3,
  8054. Difb4,Difb5,Difb6,
  8055. Difb7,Difb8 : byte;}
  8056. { Inst1vk : word; { Zeigt auf aktuelles Sample-}
  8057. { Inst2vk : word; { byte in den Daten }
  8058. { Inst3vk : word;
  8059. Inst4vk : word;
  8060. Inst5vk : word;
  8061. Inst6vk : word;
  8062. Inst7vk : word;
  8063. Inst8vk : word;
  8064. Inst1nk : byte; { Nachkommateil des Sample- }
  8065. { Inst2nk : byte; { bytes }
  8066. { Inst3nk : byte;
  8067. Inst4nk : byte;
  8068. Inst5nk : byte;
  8069. Inst6nk : byte;
  8070. Inst7nk : byte;
  8071. Inst8nk : byte;}
  8072. In_St : array[1..8] of byte;
  8073. sam_anz : byte; { Anzahl der Sampel }
  8074. pat_anz : byte; { Anzahl der Pattern }
  8075. m_played : boolean; { Musik gespielt worden ??? }
  8076. Sound_Schleifen : word; { Anzahl der Durchl„ufe der }
  8077. { Misch-Prozedur }
  8078. Sampling_Rate : byte; { dem DSP bergebene Wert fr}
  8079. { die Frequenz }
  8080. mod_name : string; { DOS-Name der Mod-Datei }
  8081. tpw : integer; { Transposer - Wert }
  8082. loop_pos : word; { Laufvar., von 0 bis Speed }
  8083. phase_1, { Die zwei Phasen der Inter- }
  8084. phase_2 : boolean; { rupt-Mischprozedur }
  8085. Sampel1,Sampel2, { Die aktiven Sampels }
  8086. Sampel3,Sampel4,
  8087. Sampel5,Sampel6,
  8088. Sampel7,Sampel8 : pointer;
  8089. Sagr1,Sagr2, { GrӇe der aktiven Sampels }
  8090. Sagr3,Sagr4,
  8091. Sagr5,Sagr6,
  8092. Sagr7,Sagr8 : word;
  8093. mautodet : boolean; { Wenn TRUE werden die Speed }
  8094. { Angaben im Song beachtet }
  8095. modmultiply : word; { Speed-Angabe im Song * Mod-}
  8096. { multiply = Speed }
  8097. mloop : boolean; { Wenn TRUE beginnt das MOD }
  8098. { nach dem Abspielen von vorn}
  8099. periodisch_anhalten : pointer; { Pointer auf Stop_Prozedur }
  8100. { fr Ausgabe }
  8101. music_aus : boolean; { Wenn TRUE wird keine Musik }
  8102. { gespielt ... }
  8103. Notvol1,Notvol2, { Lautst„rke der einzelnen }
  8104. Notvol3,Notvol4, { Kan„le }
  8105. Notvol5,Notvol6,
  8106. Notvol7,Notvol8 : byte;
  8107. Pnk : array[1..8] of byte;
  8108. Old_TZaehler : word; { Zur Syncronisation des }
  8109. { alten Timerinterrupts }
  8110. Dma_Zaehler : integer; { Zum abfangen des DMA_Ready }
  8111. { Interrupts }
  8112. dma_abbruch : integer; { Abbruchwert fr Dma_Zaehler}
  8113. mod_terminated : boolean; { Mod-Ausgabe beendet }
  8114. ls : array[1..8] of word;
  8115. ll : array[1..8] of word;
  8116. Eff : array[1..8] of byte;
  8117. Songname : string[20]; { Der Name des Modfiles }
  8118. Instnamen : array[1..31] { Namen der Instrumente }
  8119. of string[22];
  8120. Inst_vol : array[1..31]
  8121. of byte;
  8122. Liedlaenge : byte; { L„nge des Liedes }
  8123. Seczaehler : word; { zur Zeitermittlung }
  8124. Laufsec,Laufmin : byte; { Laufzeit des Liedes }
  8125. Pattgroesse : integer; { Die dem Modtyp entspr. PatterngrӇe }
  8126. XMSMaxFree : word; { Max. freier XMS-Speicher }
  8127. MinXms : word; { Wenn XMSMaxFree < MinXms }
  8128. xmsHandles : array[1..32]
  8129. of word; { Handles fr XMS }
  8130.  
  8131. soundeff : pointer;
  8132. effektgroesse : word;
  8133. effektposi : word;
  8134. Effvk : word;
  8135. Effnk : byte;
  8136. Effistvk : word;
  8137. Effistnk : byte;
  8138. Effekt : pt;
  8139. Effekt_loeschen : boolean;
  8140. tonhoehenwert : byte;
  8141.  
  8142. { tempolist : array[1..128] of byte;
  8143. breaklist : array[1..128] of byte;}
  8144. ziel : pt; { Abspielpuffer im pt-Format }
  8145. Modp : pointer; { Pointer auf Rm_Song }
  8146. note1,note2, { Aktives Instument der }
  8147. note3,note4, { Stimme }
  8148. note5,note6,
  8149. note7,note8 :byte;
  8150.  
  8151. Fadepos1,fadepos2,
  8152. fadepos3,fadepos4,
  8153. fadepos5,fadepos6,
  8154. fadepos7,fadepos8 : word;
  8155.  
  8156. intback : pointer;
  8157. port21 : byte;
  8158.  
  8159. vocf : file;
  8160. fgr : longint;
  8161. blk1,blk2 : pointer;
  8162. voch : vocheader;
  8163. vblock : voiceblock;
  8164. intpointer : pointer;
  8165. dsp_rdy_voc : boolean;
  8166. blockgr : word;
  8167. PLAYING_MOD : boolean;
  8168. PLAYING_VOC : boolean;
  8169. dummarray : array[1..20] of byte;
  8170. lastone : boolean;
  8171. VOC_READY : boolean;
  8172. inread : array[1..25] of byte;
  8173. vocsstereo : boolean;
  8174. Mod_zu_ende : boolean;
  8175.  
  8176. implementation
  8177.  
  8178. begin;
  8179. end.
  8180.  
  8181.  
  8182.  
  8183. unit design;
  8184.  
  8185. interface
  8186. uses crt,windos;
  8187.  
  8188. procedure writexy(x,y : integer;s : string);
  8189. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  8190. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  8191. function wrhexb(b : byte) : string;
  8192. function wrhexw(w : word) : string;
  8193. procedure save_screen;
  8194. procedure restore_screen;
  8195. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  8196. procedure cursor_On;
  8197. procedure cursor_Off;
  8198.  
  8199. implementation
  8200.  
  8201. var filenames : array[1..512] of string[12];
  8202. const Screen_Akt : byte = 1;
  8203.  
  8204. procedure writexy(x,y : integer;s : string);
  8205. begin;
  8206. gotoxy(x,y);
  8207. write(s);
  8208. end;
  8209.  
  8210. procedure save_screen;
  8211. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  8212. begin;
  8213. if Screen_Akt <= 4 then begin;
  8214. inc(Screen_Akt);
  8215. move(screen[1],screen[Screen_Akt],8000);
  8216. end;
  8217. end;
  8218.  
  8219. procedure restore_screen;
  8220. var Screen : array[1..4,1..8000] of byte absolute $b800:0000;
  8221. begin;
  8222. if Screen_Akt >= 2 then begin;
  8223. move(screen[Screen_Akt],screen[1],8000);
  8224. dec(Screen_Akt);
  8225. end;
  8226. end;
  8227.  
  8228. procedure rahmen(rt: byte;startx,starty,dx,dy : integer);
  8229. const frames : array[1..2,1..6] of char =
  8230. (('Ú','¿','Ù','À','Ä','³'),
  8231. ('É','»','¼','È','Í','º'));
  8232. var lx,ly : integer;
  8233. s : string;
  8234. begin;
  8235. { obere Zeile }
  8236. s := frames[rt,1];
  8237. for lx := 1 to dx-2 do s := s + frames[rt,5];
  8238. s := s + frames[rt,2];
  8239. gotoxy(startx,starty);
  8240. write(s);
  8241. { mittleren Zeilen }
  8242. for ly := 1 to dy-2 do begin;
  8243. s := frames[rt,6];
  8244. for lx := 1 to dx-2 do s := s + ' ';
  8245. s := s + frames[rt,6];
  8246. gotoxy(startx,starty+ly);
  8247. write(s);
  8248. end;
  8249. { untere Zeile }
  8250. s := frames[rt,4];
  8251. for lx := 1 to dx-2 do s := s + frames[rt,5];
  8252. s := s + frames[rt,3];
  8253. gotoxy(startx,starty+dy-1);
  8254. write(s);
  8255. end;
  8256.  
  8257. Procedure Fenster(x,y,dx,dy : integer; s : string;rcol,bcol : byte);
  8258. var tlaeng : byte;
  8259. deltx,tstartpos : byte;
  8260. begin;
  8261. tlaeng := length(s);
  8262. tstartpos := x + ((dx-Tlaeng) SHR 1);
  8263. textcolor(rcol);
  8264. textbackground(bcol);
  8265. rahmen(1,x,y,dx,dy);
  8266. writexy(tstartpos,y,s);
  8267. end;
  8268.  
  8269. procedure sort_filenames(start,ende : integer);
  8270. {
  8271. Hier sollte fr gr”áere Verzeichnise Quick-Sort eingebaut werden !
  8272. }
  8273. var hilfe : string;
  8274. l1,l2 : integer;
  8275. begin;
  8276. for l1 := start to ende-1 do begin;
  8277. for l2 := start to ende-1 do begin;
  8278. if filenames[l2] > filenames[l2+1] then begin;
  8279. hilfe := filenames[l2];
  8280. filenames[l2] := filenames[l2+1];
  8281. filenames[l2+1] := hilfe;
  8282. end;
  8283. end;
  8284. end;
  8285. end;
  8286.  
  8287. function select_datei(dir : string;mask : pchar;mtext,comment: string) : string;
  8288. const zeile : byte = 1;
  8289. spalte : byte = 0;
  8290. Start_fndisp : word = 0;
  8291. var
  8292. DirInfo: TSearchRec;
  8293. count : integer;
  8294. Nullpos : byte;
  8295. var li,lj : integer;
  8296. inp : char;
  8297. retval : string;
  8298. kasten_gefunden : boolean;
  8299. select : byte;
  8300. changed : boolean;
  8301. End_fndisp : word;
  8302. begin
  8303. {$I+}
  8304. for li := 1 to 512 do filenames[li] := ' - - -';
  8305. count := 1;
  8306. FindFirst(mask, faArchive, DirInfo);
  8307. while DosError = 0 do
  8308. begin
  8309. filenames[count] := (DirInfo.Name);
  8310. Nullpos := pos(#0,filenames[count]);
  8311. if Nullpos <> 0 then
  8312. filenames[count] := copy(filenames[count],0,Nullpos-1);
  8313. inc(count);
  8314. FindNext(DirInfo);
  8315. end;
  8316. {$I-}
  8317.  
  8318. sort_filenames(1,count-1);
  8319. save_screen;
  8320. Fenster(5,4,72,16,comment,black,7);
  8321. textcolor(1);
  8322. writexy(21,5,' Bitte Datei ausw„hlen');
  8323. textcolor(black);
  8324. inp := #255;
  8325. changed := true;
  8326. repeat
  8327. textcolor(black);
  8328. if changed then begin;
  8329. changed := false;
  8330. for lj := 0 to 4 do begin;
  8331. for li := 1 to 12 do begin;
  8332. writexy(7+lj*14,5+li,' ');
  8333. writexy(7+lj*14,5+li,filenames[lj*12+li+Start_fndisp]);
  8334. end;
  8335. end;
  8336. textcolor(14);
  8337. writexy(7+Spalte*14,5+Zeile,filenames[Spalte*12+Zeile+Start_fndisp]);
  8338. end;
  8339. if keypressed then inp := readkey;
  8340. if ord(inp) = 0 then inp := readkey;
  8341. case ord(inp) of
  8342. 32,
  8343. 13: begin;
  8344. inp := #13;
  8345. changed := true;
  8346. if (pos('- - -',filenames[Spalte*12+Zeile+Start_fndisp]) = 0) then
  8347. retval := filenames[Spalte*12+Zeile+Start_fndisp]
  8348. else
  8349. retval := 'xxxx';
  8350. end;
  8351. 27: begin;
  8352. inp := #27;
  8353. changed := true;
  8354. retval := 'xxxx';
  8355. end;
  8356. 71: begin; { Pos 1 }
  8357. inp := #255;
  8358. Zeile := 1;
  8359. Spalte := 0;
  8360. changed := true;
  8361. end;
  8362. 72: begin; { Pfeil up }
  8363. inp := #255;
  8364. changed := true;
  8365. if not ((Zeile = 1) and (Spalte = 0)) then
  8366. dec(Zeile);
  8367. if Zeile = 0 then begin;
  8368. dec(Spalte);
  8369. Zeile := 12;
  8370. end;
  8371. end;
  8372. 73: begin; { Page UP }
  8373. if Start_fndisp >= 12 then
  8374. dec(Start_fndisp,12)
  8375. else begin;
  8376. Start_fndisp := 0;
  8377. Zeile := 1;
  8378. end;
  8379. inp := #255;
  8380. changed := true;
  8381. end;
  8382. 81: begin; { Page Down }
  8383. if ((Spalte+1)*12+Start_fndisp < count) and
  8384. (Start_fndisp < 500) then
  8385. inc(Start_fndisp,12)
  8386. else
  8387. Start_fndisp := count-11;
  8388. inp := #255;
  8389. changed := true;
  8390. end;
  8391. 75: begin; { Pfeil links }
  8392. inp := #255;
  8393. changed := true;
  8394. if Spalte = 0 then begin;
  8395. if Start_fndisp >= 12 then dec(Start_fndisp,12);
  8396. end else begin;
  8397. if Spalte > 0 then dec(Spalte);
  8398. end;
  8399. end;
  8400. 77: begin; { Pfeil rechts }
  8401. inp := #255;
  8402. changed := true;
  8403. if Spalte = 4 then begin;
  8404. if ((Spalte+1)*12+Start_fndisp < count) and
  8405. (Start_fndisp < 500) then inc(Start_fndisp,12);
  8406. end else begin;
  8407. if (Spalte < 4) and
  8408. (Zeile+(Spalte+1)*12+Start_fndisp < count) then
  8409. inc(Spalte);
  8410. end;
  8411. end;
  8412. 79: begin; { End }
  8413. inp := #255;
  8414. changed := true;
  8415. Spalte := (count-Start_fndisp-12) div 12;
  8416. Zeile := (count-Start_fndisp) - Spalte*12 -1;
  8417. end;
  8418. 80: begin; { Pfeil down }
  8419. inp := #255;
  8420. changed := true;
  8421. if ((Zeile = 12) and (Spalte = 4)) then begin;
  8422. if (Start_fndisp+Zeile+Spalte*12 < count-1) then begin;
  8423. inc(Start_fndisp,1);
  8424. end;
  8425. end else begin;
  8426. if (Start_fndisp+Zeile+Spalte*12 < count-1) then
  8427. inc(Zeile);
  8428. end;
  8429. if Zeile > 12 then begin;
  8430. inc(Spalte);
  8431. Zeile := 1;
  8432. end;
  8433. end;
  8434. 82 : begin;
  8435. changed := true;
  8436. save_screen;
  8437. textcolor(black);
  8438. rahmen(2,16,9,45,5);
  8439. writexy(20,10,' Dateinamen eingeben ('+mtext+')');
  8440. writexy(20,12,'Name: ');
  8441. readln(retval);
  8442. if retval = '' then retval := 'xxxx';
  8443. restore_screen;
  8444. end;
  8445. end;
  8446. until (inp = #13) or (inp = #27) or (inp = #32)
  8447. or (inp = #82);
  8448. restore_screen;
  8449. textbackground(black);
  8450. textcolor(7);
  8451. select_datei := retval;
  8452. end;
  8453.  
  8454. function wrhexb(b : byte) : string;
  8455. const hexcar : array[0..15] of char =
  8456. ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  8457. begin;
  8458. wrhexb := hexcar[(b shr 4)] + hexcar[(b AND $0F)];
  8459. end;
  8460.  
  8461. function wrhexw(w : word) : string;
  8462. begin;
  8463. wrhexw := '$'+wrhexb(hi(w))+wrhexb(lo(w));
  8464. end;
  8465.  
  8466. procedure cursor_Off; assembler;
  8467. asm
  8468. xor ax,ax
  8469. mov ah,01h
  8470. mov cx,2020h
  8471. int 10h
  8472. end;
  8473.  
  8474. procedure cursor_on; assembler;
  8475. asm
  8476. mov ah,01h
  8477. mov cx,0607h
  8478. int 10h
  8479. end;
  8480.  
  8481.  
  8482.  
  8483. begin;
  8484. end.uses crt,dos,vocplay,design;
  8485.  
  8486. var ch : char;
  8487. next_voc : integer;
  8488. Vocname : string;
  8489.  
  8490. procedure Write_Helptext;
  8491. begin;
  8492. textcolor(lightgray);
  8493. textbackground(black);
  8494. clrscr;
  8495. writeln(' DATA BECKER VOC-Player Version 1.0, (c) 1994',
  8496. ' Autor: Boris Bertelsons');
  8497. writeln;
  8498. writeln(' Usage: Vocdemo <Filename[.VOC]> [optionen]');
  8499. writeln;
  8500. writeln(' Optionen sind:');
  8501. writeln(' -H : Dieser Screen');
  8502. writeln(' -In : Benutze den Interrupt n');
  8503. writeln(' -Dn : Benutze den DMA-Kanal n');
  8504. writeln(' -Pxxx : Benutze die Baseadresse xxx');
  8505. writeln;
  8506. Cursor_On;
  8507. halt(0);
  8508. end;
  8509.  
  8510. procedure interprete_commandline;
  8511. var cs,hs : string;
  8512. li,code : integer;
  8513. Datnm : boolean;
  8514. begin;
  8515. for li := 1 to 10 do begin;
  8516. cs := paramstr(li);
  8517. Datnm := true;
  8518. { Hilfe Angefordert ? }
  8519. if (pos('-h',cs) <> 0) or (pos('/h',cs) <> 0) or
  8520. (pos('-H',cs) <> 0) or (pos('/H',cs) <> 0) or
  8521. (pos('-?',cs) <> 0) or (pos('/?',cs) <> 0) then begin;
  8522. write_Helptext;
  8523. Datnm := false;
  8524. end;
  8525. { force irq }
  8526. if (pos('-i',cs) <> 0) or (pos('/i',cs) <> 0) or
  8527. (pos('-I',cs) <> 0) or (pos('/I',cs) <> 0) then begin;
  8528. force_irq := true;
  8529. hs := copy(cs,3,length(cs)-2);
  8530. val(hs,dsp_irq,code);
  8531. Datnm := false;
  8532. end;
  8533. { Force DMA ? }
  8534. if (pos('-d',cs) <> 0) or (pos('/d',cs) <> 0) or
  8535. (pos('-D',cs) <> 0) or (pos('/D',cs) <> 0) then begin;
  8536. force_dma := true;
  8537. hs := copy(cs,3,length(cs)-2);
  8538. val(hs,dma_ch,code);
  8539. Datnm := false;
  8540. end;
  8541. { Force Base ? }
  8542. if (pos('-p',cs) <> 0) or (pos('/p',cs) <> 0) or
  8543. (pos('-P',cs) <> 0) or (pos('/P',cs) <> 0) then begin;
  8544. hs := copy(cs,3,length(cs)-2);
  8545. if hs = '200' then dsp_adr := $200;
  8546. if hs = '210' then dsp_adr := $210;
  8547. if hs = '220' then dsp_adr := $220;
  8548. if hs = '230' then dsp_adr := $230;
  8549. if hs = '240' then dsp_adr := $240;
  8550. if hs = '250' then dsp_adr := $250;
  8551. if hs = '260' then dsp_adr := $260;
  8552. if hs = '270' then dsp_adr := $270;
  8553. if hs = '280' then dsp_adr := $280;
  8554. Startport := dsp_adr;
  8555. Endport := dsp_adr;
  8556. Datnm := false;
  8557. end;
  8558. if Datnm then begin;
  8559. Vocname := cs;
  8560. end;
  8561. end;
  8562. end;
  8563.  
  8564. procedure Spiele_Vocdatei(datname : string);
  8565. var li : integer;
  8566. ch : char;
  8567. loopcounter : word;
  8568. begin;
  8569. loopcounter := 0;
  8570. repeat
  8571. inc(loopcounter);
  8572. clrscr;
  8573. writexy(10,08,'Achtung ! Das VOC wird gnadenlos geloopt !!!');
  8574. writexy(10,10,'Beenden mit der Taste >> Q <<');
  8575. writexy(10,14,'M”glichst den Smartdrv entfernen, weil laaaaaaangsam !');
  8576. gotoxy(10,17);
  8577. write('Durchlauf Nr. ',loopcounter);
  8578. Init_Voc(datname);
  8579. ch := #0;
  8580. repeat
  8581. if keypressed then ch := readkey;
  8582. until VOC_READY or (upcase(ch) = 'Q');
  8583. VOC_DONE;
  8584. until upcase(ch) = 'Q';
  8585. end;
  8586.  
  8587.  
  8588. begin;
  8589. cursor_off;
  8590. interprete_commandline;
  8591. Init_SB;
  8592. textcolor(lightgray);
  8593. textbackground(black);
  8594. write_sbconfig;
  8595. delay(1333);
  8596. repeat
  8597. textcolor(15);
  8598. textbackground(1);
  8599. clrscr;
  8600. Vocname := select_datei('*.voc','*.voc','','');
  8601. if Vocname = 'xxxx' then next_voc := 255
  8602. else Spiele_Vocdatei(Vocname);
  8603. until next_voc = 255;
  8604. cursor_on;
  8605. textmode(3);
  8606. end.
  8607. unit vocplay;
  8608.  
  8609. interface uses crt,dos;
  8610.  
  8611. TYPE vocheader = record
  8612. Kennstr : array[0..19] of char;
  8613. Sampoff : word;
  8614. Verslo : Byte;
  8615. Vershi : Byte;
  8616. Kennung : word;
  8617. end;
  8618.  
  8619. Voiceblock = record
  8620. Kennung : byte;
  8621. Laeng_lo : word;
  8622. Laeng_hi : byte;
  8623. SR : byte;
  8624. Pack : byte;
  8625. end;
  8626.  
  8627. const
  8628. { Soundblaster - Konstanten }
  8629. Startport : word = $200;
  8630. Endport : word = $280;
  8631. force_irq : boolean = false;
  8632. force_dma : boolean = false;
  8633. force_base : boolean = false;
  8634. dsp_irq : byte = $5; { Interrupt des SB, Wert wird}
  8635. { durch die Init-Routine }
  8636. { ge„ndert }
  8637. dma_ch : byte = 1; { DMA Chanel, standartm„áig }
  8638. { = 1, auf SB 16 ASP auch an-}
  8639. { dere Werte m”glich ... }
  8640. dsp_adr : word = $220; { Die Base-Adress des DSP. }
  8641. { Wert wird durch die Init- }
  8642. { Routine ge„ndert }
  8643. SbVersMin : BYTE = 0; { Die Versions - Kennung }
  8644. SbVersMaj : BYTE = 0;
  8645. STEREO : BOOLEAN = false; { In Stereo abspielen }
  8646. SbRegDetected : BOOLEAN = FALSE; { normale SB vorhanden ? }
  8647. IRQDetected : BOOLEAN = FALSE;
  8648. SbRegInited : BOOLEAN = FALSE;
  8649. SbProDetected : BOOLEAN = FALSE; { SB Pro vorhanden ? }
  8650. SbProInited : BOOLEAN = FALSE;
  8651. Sb16Detected : BOOLEAN = FALSE; { SB 16 ASP vorhanden ? }
  8652. Sb16Inited : BOOLEAN = FALSE;
  8653. MixerDetected : BOOLEAN = FALSE; { Wenn ja, Karte >= SB Pro }
  8654.  
  8655. { Voc - Constanten }
  8656. block_activ : byte = 1;
  8657.  
  8658.  
  8659. { Soundblaster - Variablen }
  8660. var dsp_rdy_voc : boolean;
  8661. blockgr : word;
  8662. Transfer_Testing : boolean;
  8663. SaveExitProc : Pointer; { N”tig, da eigene Exitproc }
  8664.  
  8665. var lastone : boolean;
  8666. VOC_READY : boolean;
  8667. inread : array[1..25] of byte;
  8668. vocsstereo : boolean;
  8669. vocf : file;
  8670. fgr : longint;
  8671. blk1,blk2 : pointer;
  8672. voch : vocheader;
  8673. vblock : voiceblock;
  8674.  
  8675.  
  8676. function init_sb : boolean;
  8677. {
  8678. Die Function init_sb initialisiert die Soundblaster-Karte. Sie
  8679. erkennt automatisch Base-Adress und IRQ, prft, um welche Sound-
  8680. blasterversion es sich handelt und setzt entsprechende globale
  8681. Variablen, die z.B. mittels write_sbConfig ausgegeben werden k”nnen.
  8682. Die Funktion liefert True, wenn eine SB initialisiert werden konnte.
  8683. }
  8684.  
  8685. procedure write_sbConfig;
  8686. {
  8687. Gibt die gefundene Konfiguration aus (Textmodus !). Alternativ:
  8688. Direkter Zugriff auf die entsprechenden Variablen.
  8689. }
  8690.  
  8691. procedure Wr_dsp(v : byte);
  8692. {
  8693. Schreibt den bergebenen Wert in das Soundblaster-Register
  8694. }
  8695.  
  8696. FUNCTION Reset_sbCard : BOOLEAN;
  8697. {
  8698. Resettet die SB-Karte. Liefert TURE, wenn erfolgreich
  8699. }
  8700.  
  8701. procedure Set_Timeconst_sb16(tc : byte);
  8702. {
  8703. Setzt die Timer-Konstante die nach der Formel
  8704. tc := 256-(1.000.000 / Frequenz) berechnet wird
  8705. }
  8706.  
  8707. procedure Spiele_Block_Dsp(gr : word;bk : pointer;b1,b2 : boolean);
  8708. {
  8709. Spielt den ber blk adressierten Block via DMA ab. Initialisiert die
  8710. ben”tigten Variablen und ruft dann eine der drei SPIELE_SB-Proceduren
  8711. auf.
  8712. }
  8713.  
  8714. procedure Spiele_Sb(Segm,Offs,dsize : word);
  8715. {
  8716. Spielt den adressierten Block ber DMA ab. Fr SB / SB Pro
  8717. }
  8718.  
  8719. procedure Spiele_SbPro(Segm,Offs,dsize : word);
  8720. {
  8721. Spielt den adressierten Block ber DMA ab. Fr SB Pro
  8722. }
  8723.  
  8724. procedure Spiele_Sb16(Segm,Offs,dsize : word);
  8725. {
  8726. Spielt den adressierten Block ber DMA ab. Fr SB 16
  8727. }
  8728.  
  8729.  
  8730. procedure Filter_Ein;
  8731. {
  8732. Schaltet den XBass-Filter ein
  8733. }
  8734.  
  8735. procedure Filter_MID;
  8736. {
  8737. Schaltet den Filter auf Normalbetrieb
  8738. }
  8739. procedure Filter_Aus;
  8740. {
  8741. Schaltet den Filter auf H”hen-Hervorhebung
  8742. }
  8743.  
  8744. procedure Set_Balance(Wert : byte);
  8745. {
  8746. Die Procedure Setzt die Balance entsprechend dem bergebenen Wert.
  8747. Dabei steht 0 fr ganz links, 12 fr Mitte und 24 fr ganz rechts
  8748. }
  8749.  
  8750. procedure Set_Volume(Wert : byte);
  8751. {
  8752. Die Procedure setzt die Lautst„rke fr die generelle (!) Ausgabe
  8753. (Master Volume). Erlaubte Werte liegen zwischen 0 und 31
  8754. }
  8755.  
  8756.  
  8757. Procedure Init_Voc(filename : string);
  8758. {
  8759. Die Procedure startet die Ausgabe des in filename bergebenen
  8760. VOC-Files
  8761. }
  8762.  
  8763. procedure voc_done;
  8764. {
  8765. Mit der Procedure VOC_DONE halten Sie die Ausgabe eines VOC-Files an.
  8766. Diese Procedure muá auch aufgerufen werden, wenn die Ausgabe des
  8767. VOC-Files schon am Ende angelangt ist.
  8768. }
  8769.  
  8770.  
  8771. implementation
  8772.  
  8773. TYPE
  8774. pt = record { erm”glicht die einfache }
  8775. ofs,sgm : word; { Behandlung von Pointern }
  8776. end;
  8777.  
  8778. CONST
  8779. filter_activ : boolean = false;
  8780. balance : byte = 12;
  8781. Mastervolume : byte = 29;
  8782. Samfreq : word = 22;
  8783. PC = 0;
  8784. AMIGA = 1;
  8785. interrupt_gefunden : boolean = false;
  8786. interrupt_check : boolean = false;
  8787. timer_per_second : word = 1000; { Anzahl Interrupts per Sec. }
  8788. Sampling_Frequenz : word = 10000; { Die Samplingfreq.; Default }
  8789. dma_page : array[0..3] of byte = ($87,$83,$81,$81);
  8790. dma_adr : array[0..3] of byte = (0,2,4,6);
  8791. dma_wc : array[0..3] of byte = (1,3,5,7);
  8792.  
  8793. sb16_outputlaenge : word = 0;
  8794. letzte_ausgabe : boolean = false;
  8795.  
  8796. VAR
  8797. blockgroesse : word; { GrӇe des Sound-Puffers }
  8798. dsp_rdy_sb16 : boolean; { Flag fr Ende der šbertrag-}
  8799. { ung der Daten via DMA }
  8800. SbVersStr : string[5]; { Die SB-Version als String }
  8801. oldInt : pointer; { Zur Sicherung des vom SB }
  8802. { zum DMA-Transfer ben”tigten}
  8803. { Interrupts }
  8804. irqmsk : byte; { zur Interruptbehandlung }
  8805. blk : pointer; { Pointer auf Daten - Puffer }
  8806. Sampling_Rate : byte; { dem DSP bergebene Wert fr}
  8807. { die Frequenz }
  8808. intback : pointer;
  8809. port21 : byte;
  8810.  
  8811.  
  8812. FUNCTION Detect_Mixer_sb16 : boolean; forward;
  8813.  
  8814.  
  8815. {
  8816. ***************************************************************************
  8817.  
  8818. S O U N D B L A S T E R - P R O C E D U R E N
  8819.  
  8820. ***************************************************************************
  8821. }
  8822.  
  8823.  
  8824. procedure Wr_dsp(v : byte);
  8825. {
  8826. Wartet, bis der DSP zum Schreiben bereit ist, und schreibt dann das
  8827. in "v" bergebene Byte in den DSP
  8828. }
  8829. begin;
  8830. while port[dsp_adr+$c] >= 128 do ;
  8831. port[dsp_adr+$c] := v;
  8832. end;
  8833.  
  8834. FUNCTION SbReadByte : BYTE;
  8835. {
  8836. Die Function wartet, bis der DSP gelesen werden kann und liefert den
  8837. gelesenen Wert zurck
  8838. }
  8839. begin;
  8840. while port[dsp_adr+$a] = $AA do ; { warten, bis DSP ready }
  8841. SbReadByte := port[dsp_adr+$a]; { Wert schreiben }
  8842. end;
  8843.  
  8844. procedure SBreset;
  8845. VAR bt,ct, stat : BYTE;
  8846. begin;
  8847. PORT[dsp_adr+$6] := 1; { dsp_adr+$6 = Resettfunktion}
  8848. FOR ct := 1 TO 100 DO;
  8849. PORT[dsp_adr+$6] := 0;
  8850. bt := 0;
  8851. repeat
  8852. ct := 0;
  8853. repeat
  8854. stat := port[dsp_adr + $E];
  8855. until (ct > 8000) or (stat >= 128);
  8856. inc(bt);
  8857. until (bt > 100) or (port[dsp_adr + $A] = $AA);
  8858. end;
  8859.  
  8860. FUNCTION Reset_SBCard : BOOLEAN;
  8861. {
  8862. Die Function resetet den DSP. War das Resetten erfolgreich, wird
  8863. TRUE zurckgeliefert, ansonsten FALSE
  8864. }
  8865. CONST ready = $AA;
  8866. VAR ct, stat : BYTE;
  8867. BEGIN
  8868. PORT[dsp_adr+$6] := 1; { dsp_adr+$6 = Resettfunktion}
  8869. FOR ct := 1 TO 100 DO;
  8870. PORT[dsp_adr+$6] := 0;
  8871. stat := 0;
  8872. ct := 0; { Der Vergleich ct < 100, da }
  8873. WHILE (stat <> ready) { die Initialisierung ca. }
  8874. AND (ct < 100) DO BEGIN { 100ms dauert }
  8875. stat := PORT[dsp_adr+$E];
  8876. stat := PORT[dsp_adr+$a];
  8877. INC(ct);
  8878. END;
  8879. Reset_SBCard := (stat = ready);
  8880. END;
  8881.  
  8882. FUNCTION Detect_SBReg : BOOLEAN;
  8883. {
  8884. Die Funktion liefert TRUE zurck, wenn ein Soundblaster initialisiert
  8885. werden konnte, ansonsten FALSE. Die Variable dsp_adr wird auf die
  8886. Base-Adresse des SB gesetzt.
  8887. }
  8888. VAR
  8889. Port, Lst : WORD;
  8890. BEGIN
  8891. Detect_SBReg := SbRegDetected;
  8892. IF SbRegDetected THEN EXIT; { Exit, wenn initialisiert }
  8893. Port := Startport; { M”gliche SB-Adressen zwi- }
  8894. Lst := Endport; { schen $210 und $280 ! }
  8895. WHILE (NOT SbRegDetected)
  8896. AND (Port <= Lst) DO BEGIN
  8897. dsp_adr := Port;
  8898. SbRegDetected := Reset_SBCard;
  8899. IF NOT SbRegDetected THEN
  8900. INC(Port, $10);
  8901. END;
  8902. Detect_SBReg := SbRegDetected;
  8903. END;
  8904.  
  8905. PROCEDURE SbGetDSPVersion;
  8906. {
  8907. Ermittelt die Version des DSP und speichert das Ergebnis in den globalen
  8908. Variablen SBVERSMAJ und SBVERSMIN sowie SBVERSSTR ab.
  8909. }
  8910. VAR i : WORD;
  8911. t : WORD;
  8912. s : STRING[2];
  8913. BEGIN
  8914. Wr_dsp($E1); { $E1 = Versionsabfrage }
  8915. SbVersMaj := SbReadByte;
  8916. SbVersMin := SbReadByte;
  8917. str(SbVersMaj, SbVersStr);
  8918. SbVersStr := SbVersStr + '.';
  8919. str(SbVersMin, s);
  8920. if SbVersMin > 9 then
  8921. SbVersStr := SbVersStr + s
  8922. else
  8923. SbVersStr := SbVersStr + '0' + s;
  8924. END;
  8925.  
  8926. function wrt_dsp_adr_sb16 : string;
  8927. {
  8928. Liefert die Base-Adresse des SB als String zurck
  8929. }
  8930. begin;
  8931. case dsp_adr of
  8932. $210 : wrt_dsp_adr_sb16 := '210';
  8933. $220 : wrt_dsp_adr_sb16 := '220';
  8934. $230 : wrt_dsp_adr_sb16 := '230';
  8935. $240 : wrt_dsp_adr_sb16 := '240';
  8936. $250 : wrt_dsp_adr_sb16 := '250';
  8937. $260 : wrt_dsp_adr_sb16 := '260';
  8938. $270 : wrt_dsp_adr_sb16 := '270';
  8939. $270 : wrt_dsp_adr_sb16 := '280';
  8940. END;
  8941. end;
  8942.  
  8943. function wrt_dsp_irq : string;
  8944. {
  8945. Liefert den IRQ des SB als String zurck
  8946. }
  8947. begin;
  8948. case dsp_irq of
  8949. $2 : wrt_dsp_irq := '2 h';
  8950. $3 : wrt_dsp_irq := '3 h';
  8951. $5 : wrt_dsp_irq := '5 h';
  8952. $7 : wrt_dsp_irq := '7 h';
  8953. $10 : wrt_dsp_irq := '10 h';
  8954. END;
  8955. end;
  8956.  
  8957. procedure Set_Timeconst_sb16(tc : byte);
  8958. {
  8959. Procedure zum setzen der Time-Konstanten. Sie berechnet sich nach der
  8960. Formel tc := 256 - (1000000 / Frequenz).
  8961. }
  8962. begin;
  8963. Wr_dsp($40); { $40 = Setze Sample Rate }
  8964. Wr_dsp(tc);
  8965. end;
  8966.  
  8967. procedure test_uebertragung;
  8968. {
  8969. Zur Interrupt - Detection
  8970. }
  8971. begin;
  8972. getmem(blk,3000);
  8973. fillchar(blk^,3000,127);
  8974. blockgroesse := 2000;
  8975. letzte_ausgabe := true;
  8976. Sampling_Rate := 211;
  8977. Spiele_Block_Dsp(blockgroesse,blk,true,false);
  8978. delay(100);
  8979. freemem(blk,3000);
  8980. end;
  8981.  
  8982. procedure write_sbConfig;
  8983. {
  8984. Die Procedure gibt die gefundene Konfiguration auf dem Bildschirm
  8985. aus. Sie dient vornehmlich als Beispiel, wie die Informationen
  8986. verwendet werden k”nnen
  8987. }
  8988. begin;
  8989. clrscr;
  8990. if SbRegDetected then begin;
  8991. writeln('Soundkarte an Base ',wrt_dsp_adr_sb16,'h mit IRQ ',
  8992. wrt_dsp_irq,' gefunden.');
  8993. end else begin;
  8994. writeln('Keine Soundblaster-kompatibele Karte gefunden !');
  8995. end;
  8996. if MixerDetected then begin;
  8997. writeln('Mixer - Chip gefunden');
  8998. if SbVersMaj < 4 then
  8999. writeln('Die gefundene Karte ist',
  9000. ' ein Soundblaster Pro oder kompatibel')
  9001. else
  9002. writeln('Die gefundene Karte ist',
  9003. ' ein Soundblaster 16 ASP oder kompatibel');
  9004. end else begin;
  9005. writeln('Die gefundene Karte ist',
  9006. ' ein Soundblaster oder kompatibel');
  9007. end;
  9008. writeln('Die Versionsnummer lautet ',SbVersStr);
  9009. end;
  9010.  
  9011. procedure Exit_Sb16;
  9012. {
  9013. Diese Prozedur wir beim Beenden des Programms aufgerufen und setzt
  9014. den verbogenen DMA-Interrupt auf seinen Ausgangswert
  9015. }
  9016. begin;
  9017. setintvec($8+dsp_irq,oldint); { Alten Interrupt wieder her-}
  9018. port[$21] := Port[$21] or irqmsk; { stellen und Maskierung auf }
  9019. port[dsp_adr+$c] := $d3; { alten Wert zurck }
  9020. Port[$20] := $20;
  9021. Wr_dsp($D0);
  9022. end;
  9023.  
  9024. procedure Spiele_Sb16(Segm,Offs,dsize : word);
  9025. {
  9026. Diese Procedure spielt den ber Segm:Offs adressierten Block mit der
  9027. GrӇe dsize ab. Es ist darauf zu achten, das der DMA-Controller NICHT
  9028. Seitenbergreifend arbeiten kann ...
  9029. }
  9030. var li : word;
  9031. begin;
  9032. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  9033. Port[$0c] := 0; { Adresse des Puffers (blk) }
  9034. Port[$0B] := $49; { fr Soundausgabe }
  9035. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  9036. Port[dma_adr[dma_ch]] := Hi(offs);
  9037. Port[dma_wc[dma_ch]] := Lo(dsize-1); { GrӇe des Blockes (block- }
  9038. Port[dma_wc[dma_ch]] := Hi(dsize-1); { groesse) an DMA-Controller }
  9039. Port[dma_page[dma_ch]] := Segm;
  9040. if sb16_outputlaenge <> dsize then begin;
  9041. Wr_dsp($C6); { DSP-Befehl 8-Bit ber DMA }
  9042. if stereo then { fr SB16 Nur zum Starten ! }
  9043. Wr_dsp($20)
  9044. else
  9045. Wr_dsp($00);
  9046. Wr_dsp(Lo(dsize-1)); { GrӇe des Blockes an }
  9047. Wr_dsp(Hi(dsize-1)); { den DSP }
  9048. sb16_outputlaenge := dsize;
  9049. end else begin;
  9050. Wr_dsp($45); { DMA Continue SB16 8-Bit }
  9051. end;
  9052. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  9053. end;
  9054.  
  9055. procedure Spiele_SbPro(Segm,Offs,dsize : word);
  9056. {
  9057. Diese Procedure spielt den ber Segm:Offs adressierten Block mit der
  9058. GrӇe dsize ab. Es ist darauf zu achten, das der DMA-Controller NICHT
  9059. Seitenbergreifend arbeiten kann ...
  9060. }
  9061. var li : word;
  9062. begin;
  9063. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  9064. Port[$0c] := 0; { Adresse des Puffers (blk) }
  9065. Port[$0B] := $49; { fr Soundausgabe }
  9066. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  9067. Port[dma_adr[dma_ch]] := Hi(offs);
  9068. Port[dma_wc[dma_ch]] := Lo(dsize-1); { GrӇe des Blockes (block- }
  9069. Port[dma_wc[dma_ch]] := Hi(dsize-1); { groesse) an DMA-Controller }
  9070. Port[dma_page[dma_ch]] := Segm;
  9071.  
  9072. Wr_dsp($48);
  9073. Wr_dsp(Lo(dsize-1)); { GrӇe des Blockes an }
  9074. Wr_dsp(Hi(dsize-1)); { den DSP }
  9075. Wr_dsp($91);
  9076. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  9077. end;
  9078.  
  9079. procedure Spiele_Sb(Segm,Offs,dsize : word);
  9080. {
  9081. Diese Procedure spielt den ber Segm:Offs adressierten Block mit der
  9082. GrӇe dsize ab. Es ist darauf zu achten, das der DMA-Controller NICHT
  9083. Seitenbergreifend arbeiten kann ...
  9084. }
  9085. var li : word;
  9086. begin;
  9087. port[$0A] := dma_ch+4; { DMA-Kanal sperren }
  9088. Port[$0c] := 0; { Adresse des Puffers (blk) }
  9089. Port[$0B] := $49; { fr Soundausgabe }
  9090. Port[dma_adr[dma_ch]] := Lo(offs); { an DMA-Controller }
  9091. Port[dma_adr[dma_ch]] := Hi(offs);
  9092. Port[dma_wc[dma_ch]] := Lo(dsize-1); { GrӇe des Blockes (block- }
  9093. Port[dma_wc[dma_ch]] := Hi(dsize-1); { groesse) an DMA-Controller }
  9094. Port[dma_page[dma_ch]] := Segm;
  9095. Wr_dsp($14);
  9096. Wr_dsp(Lo(dsize-1)); { GrӇe des Blockes an }
  9097. Wr_dsp(Hi(dsize-1)); { den DSP }
  9098. Port[$0A] := dma_ch; { DMA-Kanal freigeben }
  9099. end;
  9100.  
  9101. procedure Spiele_Block_Dsp(gr : word;bk : pointer;b1,b2 : boolean);
  9102. {
  9103. Diese Procedure startet die Ausgabe des Daten-Blocks blk mit der
  9104. Gr”áe blockgroesse ber DMA
  9105. }
  9106. var l : longint;
  9107. pn,offs : word;
  9108. hbyte : byte;
  9109. a : word;
  9110. OldV,NewV,Hilfe : byte;
  9111. stereoreg : byte;
  9112. sr : word;
  9113. samps : byte;
  9114. begin;
  9115. Transfer_Testing := b1;
  9116.  
  9117. dsp_rdy_sb16 := false;
  9118. l := 16*longint(pt(bk).sgm)+pt(bk).ofs;
  9119. pn := pt(l).sgm;
  9120. offs := pt(l).ofs;
  9121.  
  9122. if Transfer_Testing then begin;
  9123. set_timeconst_sb16(Sampling_Rate);
  9124. if sb16Detected then begin;
  9125. if stereo then
  9126. Spiele_Sb16(pn,offs,gr*2)
  9127. else
  9128. Spiele_Sb16(pn,offs,gr);
  9129. end else begin;
  9130. if stereo then begin;
  9131. SR := word(-1000000 DIV (Sampling_Rate-256));
  9132. SR := SR * 2;
  9133. Samps := 256 - (1000000 DIV SR);
  9134. set_timeconst_sb16(Samps);
  9135. Spiele_SbPro(pn,offs,gr*2);
  9136. end else
  9137. Spiele_Sb(pn,offs,gr);
  9138. end;
  9139. end else begin;
  9140. sb16_outputlaenge := 0;
  9141. set_timeconst_sb16(vblock.SR);
  9142. if sb16Detected then begin;
  9143. if stereo then begin;
  9144. Spiele_Sb16(pn,offs,gr);
  9145. end else begin;
  9146. Spiele_Sb16(pn,offs,gr);
  9147. end;
  9148. end else begin;
  9149. if stereo then begin;
  9150. Spiele_SbPro(pn,offs,gr);
  9151. end else begin;
  9152. Spiele_Sb(pn,offs,gr);
  9153. end;
  9154. end;
  9155. end;
  9156. end;
  9157.  
  9158. procedure dsp_int_sb16; interrupt;
  9159. {
  9160. Diese Procedure wird durch den Interrupt angesprungen, der am Ende
  9161. einer Blockbertragung generiert wird. Wenn nicht das Flag
  9162. letzte_ausgabe gesetzt ist, wird eine neue Ausgabe gestartet
  9163. }
  9164. var h : byte;
  9165. begin;
  9166. if interrupt_check then begin;
  9167. IRQDetected := true;
  9168. end else begin;
  9169. if Transfer_Testing then begin;
  9170. h := port[dsp_adr+$E];
  9171. dsp_rdy_sb16 := true;
  9172.  
  9173. if not letzte_ausgabe then begin;
  9174. Spiele_Block_Dsp(blockgroesse,blk,true,false);
  9175. end;
  9176. end else begin;
  9177. h := port[dsp_adr+$E];
  9178. if (fgr > blockgr) and not lastone then begin
  9179. lastone := false;
  9180. if block_activ = 1 then begin
  9181. Spiele_Block_Dsp(blockgr,blk2,false,true);
  9182. blockread(vocf,blk1^,blockgr);
  9183. fgr := fgr - blockgr;
  9184. block_activ := 2;
  9185. end else begin;
  9186. Spiele_Block_Dsp(blockgr,blk1,false,true);
  9187. blockread(vocf,blk2^,blockgr);
  9188. fgr := fgr - blockgr;
  9189. block_activ := 1;
  9190. end;
  9191. end else begin;
  9192. if not lastone then begin;
  9193. if block_activ = 1 then begin
  9194. Spiele_Block_Dsp(blockgr,blk2,false,true);
  9195. lastone := true;
  9196. end else begin;
  9197. Spiele_Block_Dsp(blockgr,blk1,false,true);
  9198. lastone := true;
  9199. end;
  9200. end else begin;
  9201. dsp_rdy_sb16 := true;
  9202. Wr_dsp($D0);
  9203. VOC_READY := true;
  9204. end;
  9205. end;
  9206. end;
  9207. end;
  9208. Port[$20] := $20;
  9209. end;
  9210.  
  9211. procedure detect_sbIRQ;
  9212. {
  9213. Diese Routine erkennt den IRQ der Soundblaster-Karte. Es werden dazu
  9214. alle m”glichen Interrupts durchgetestet. Dazu werden kurze Blocke
  9215. via DMA ausgegeben. Wenn am Ende der Ausgabe der eingestellte Inter-
  9216. rupt angesprungen wird, so ist der richtige gefunden
  9217. }
  9218. const moegliche_irqs : array[1..5] of byte = ($2,$3,$5,$7,$10);
  9219. var i : integer;
  9220. h : byte;
  9221. begin;
  9222. getintvec($8+dsp_irq,intback); { Werte sichern ! }
  9223. port21 := port[$21];
  9224. getmem(blk,1200);
  9225. fillchar(blk^,1200,127);
  9226. set_Timeconst_sb16(211);
  9227. Wr_dsp($D3); { Lautsprecher aus }
  9228. i := 1;
  9229. interrupt_check := true;
  9230. while (i <= 5) and (not IRQDetected) do
  9231. begin;
  9232. dsp_irq := moegliche_irqs[i]; { zu Testender IRQ }
  9233. getintvec($8+dsp_irq,oldint); { Interrupt Verbiegen }
  9234. setintvec($8+dsp_irq,@Dsp_Int_sb16);
  9235. irqmsk := 1 shl dsp_irq;
  9236. port[$21] := port[$21] and not irqmsk;
  9237. Sampling_Rate := 211;
  9238. blockgroesse := 1200; { testweise Ausgabe }
  9239. Spiele_Block_Dsp(blockgroesse,blk,true,false);
  9240. delay(150);
  9241. setintvec($8+dsp_irq,oldint); { Interrupt wieder zurck }
  9242. port[$21] := Port[$21] or irqmsk;
  9243. h := port[dsp_adr+$E];
  9244. Port[$20] := $20;
  9245. inc(i);
  9246. end;
  9247. interrupt_check := false;
  9248. Wr_dsp($D1); { Lautsprecher wieder ein }
  9249. freemem(blk,1200);
  9250. setintvec($8+dsp_irq,intback); { Alte Werte zurck !!! }
  9251. port[$21] := port21;
  9252. dsp_rdy_sb16 := true;
  9253. end;
  9254.  
  9255. function Init_SB : boolean;
  9256. {
  9257. Diese Function initialisiert den Soundblaster. Sie liefert TRUE
  9258. zurck, wenn die Initialisierung erfolgreich war, ansonsten FALSE.
  9259. Der Lautsprecher fr Sampling-Ausgabe wird eingeschaltet. Der
  9260. DMA-Ready Interrupt wird auf eine eigene Routine verbogen.
  9261. }
  9262. begin;
  9263. if not Detect_SBReg then begin;
  9264. Init_SB := false;
  9265. exit;
  9266. end;
  9267. { Soundblaster gefunden }
  9268. if not force_irq then detect_sbIRQ; { IRQ auto-detection }
  9269. test_uebertragung;
  9270. if not force_irq then detect_sbIRQ; { 2. Test fr SB n”tig ! }
  9271. if Detect_Mixer_sb16 then begin;
  9272. SbProDetected := TRUE; { SB Pro gefunden }
  9273. end;
  9274. SbGetDspVersion;
  9275. if SbVersMaj >= 4 then begin; { SB 16 ASP gefunden }
  9276. Sb16Detected := true;
  9277. SBProDetected := false;
  9278. end;
  9279. Wr_dsp($D1); { Lautsprecher ein }
  9280. getintvec($8+dsp_irq,oldint); { Alten Interrupt sichern, }
  9281. setintvec($8+dsp_irq,@dsp_int_sb16); { auf eigene Routine setzen }
  9282. irqmsk := 1 shl dsp_irq; { Interrupt einmaskieren }
  9283. port[$21] := port[$21] and not irqmsk;
  9284. end;
  9285.  
  9286.  
  9287. {
  9288. ***************************************************************************
  9289.  
  9290. M I X E R - P R O C E D U R E N
  9291.  
  9292. ***************************************************************************
  9293. }
  9294.  
  9295.  
  9296. PROCEDURE Write_Mixer(Reg, Val: BYTE);
  9297. {
  9298. Schreibt den in Val bergebenen Wert an das in Reg angegebene
  9299. Register des Mixer - Chips
  9300. }
  9301. begin;
  9302. Port[dsp_adr+$4] := Reg;
  9303. Port[dsp_adr+$5] := Val;
  9304. END;
  9305.  
  9306.  
  9307. FUNCTION Read_Mixer(Reg: BYTE) : BYTE;
  9308. {
  9309. Die Function liefert den Inhalt des ber Reg indizierten Registers
  9310. des Mixer-Chips
  9311. }
  9312. begin;
  9313. Port[dsp_adr+$4] := Reg;
  9314. Read_Mixer := Port[dsp_adr+$5];
  9315. end;
  9316.  
  9317. procedure Filter_Ein;
  9318. {
  9319. Diese Procedure Stellt den Tiefen Filter ein bzw. regelt das
  9320. Bass/Treble Register entsprechend
  9321. }
  9322. var hilfe : byte;
  9323. begin;
  9324. if sb16detected then begin;
  9325. write_Mixer(68,64); { Treble runter }
  9326. write_Mixer(69,64);
  9327. write_Mixer(70,255); { Bass voll Power ! }
  9328. write_Mixer(71,255); { Bass voll Power ! }
  9329. end else begin;
  9330. hilfe := read_Mixer($0c); { Tiefer Filter }
  9331. hilfe := hilfe or 8;
  9332. Write_Mixer($0c,hilfe);
  9333. hilfe := read_Mixer($0e); { Filter einschalten }
  9334. hilfe := hilfe AND 2;
  9335. write_Mixer($0e,hilfe);
  9336. end;
  9337. end;
  9338.  
  9339. procedure Filter_MID;
  9340. {
  9341. Diese Procedure Stellt den Tiefen Filter ein bzw. regelt das
  9342. Bass/Treble Register entsprechend
  9343. }
  9344. var hilfe : byte;
  9345. begin;
  9346. if sb16detected then begin;
  9347. write_Mixer(68,160); { Treble runter }
  9348. write_Mixer(69,160);
  9349. write_Mixer(70,192); { Bass voll Power ! }
  9350. write_Mixer(71,192); { Bass voll Power ! }
  9351. end else begin;
  9352. hilfe := read_Mixer($0e); { Filter ausschalten }
  9353. hilfe := hilfe OR 32;
  9354. write_Mixer($0e,hilfe);
  9355. end;
  9356. end;
  9357.  
  9358. procedure Filter_aus;
  9359. var hilfe : byte;
  9360. begin;
  9361. if sb16detected then begin;
  9362. write_Mixer(68,192); { zurck auf default }
  9363. write_Mixer(69,192);
  9364. write_Mixer(70,160);
  9365. write_Mixer(71,160);
  9366. end else begin;
  9367. hilfe := read_Mixer($0c); { H”hen-Filter }
  9368. hilfe := hilfe OR 247;
  9369. Write_Mixer($0c,hilfe);
  9370. hilfe := read_Mixer($0e); { Filter einschalten }
  9371. hilfe := hilfe AND 2;
  9372. write_Mixer($0e,hilfe);
  9373. end;
  9374. end;
  9375.  
  9376. procedure Set_Balance(Wert : byte);
  9377. {
  9378. Die Procedure Setzt die Balance entsprechend dem bergebenen Wert.
  9379. Dabei steht 0 fr ganz links, 12 fr Mitte und 24 fr ganz rechts
  9380. }
  9381. Var left,right : byte;
  9382. begin;
  9383. if Sb16Detected then begin;
  9384. left := 12;
  9385. right := 12;
  9386. if Wert < 12 then right := wert;
  9387. if Wert > 12 then left := 24-Wert;
  9388. write_Mixer(50,(left shl 4));
  9389. write_Mixer(51,(right shl 4));
  9390. end else begin;
  9391. Wert := Wert SHR 1;
  9392. case Wert of
  9393. 0..6 : begin;
  9394. write_Mixer(02,(7 shl 5)+(Wert shl 1));
  9395. end;
  9396. 07 : begin;
  9397. write_Mixer(02,(7 shl 5)+(7 shl 1));
  9398. end;
  9399. 08..13 : begin;
  9400. write_Mixer(02,((13-Wert) shl 5)+(7 shl 1));
  9401. end;
  9402. end;
  9403. end;
  9404. end;
  9405.  
  9406. procedure Set_Volume(Wert : byte);
  9407. {
  9408. Zum Setzen der Abspiel-Lautst„rke. Zul„ssige Werte von 0 bis 31
  9409. }
  9410. begin;
  9411. if sb16detected then begin;
  9412. write_Mixer(48,(Wert shl 3));
  9413. write_Mixer(49,(Wert shl 3));
  9414. end else begin;
  9415. if MixerDetected then begin;
  9416. Wert := Wert Shr 2;
  9417. write_Mixer($22,(wert shl 5) + (wert shl 1));
  9418. end;
  9419. end;
  9420. end;
  9421.  
  9422. procedure reset_Mixer; assembler;
  9423. {
  9424. Resettet den Mixer Chip auf seine Default - Werte
  9425. }
  9426. asm
  9427. mov dx,dsp_adr+$4
  9428. mov al,0
  9429. out dx,al
  9430. mov cx,50
  9431. @loop:
  9432. loop @loop
  9433. inc dx
  9434. out dx,al
  9435. end;
  9436.  
  9437. FUNCTION Detect_Mixer_sb16 : BOOLEAN;
  9438. {
  9439. Function zu Erkennung des Mixer-Chips. TRUE, wenn der Mixer gefunden
  9440. wurde, ansonsten FALSE
  9441. }
  9442. VAR SaveReg : WORD;
  9443. NewReg : WORD;
  9444. BEGIN
  9445. Detect_Mixer_sb16 := MixerDetected;
  9446. IF (NOT SbRegDetected) { Abbruch, wenn keine Sound- }
  9447. OR MixerDetected THEN EXIT; { blaster-Karte vorhanden }
  9448. { oder Mixer-Chip schon }
  9449. { initalisiert }
  9450. Reset_Mixer;
  9451. SaveReg := Read_Mixer($22); { Register sichern }
  9452. Write_Mixer($22, 243); { Wenn der geschribene wert }
  9453. NewReg := Read_Mixer($22); { mit dem zurckgelesenen }
  9454. { bereinstimmt, so ist ein }
  9455. { Zugriff m”glich und somit }
  9456. { ein Mixer vorhanden }
  9457. IF NewReg = 243 THEN begin;
  9458. MixerDetected := TRUE;
  9459. STEREO := True;
  9460. end;
  9461. Write_Mixer($22, SaveReg); { Altes Register zurck }
  9462. Detect_Mixer_sb16 := MixerDetected;
  9463. END;
  9464.  
  9465.  
  9466. procedure exit_song;
  9467. begin;
  9468. Port[dsp_adr+$C] := $D3;
  9469. halt(0);
  9470. end;
  9471.  
  9472. {$F+}
  9473. procedure MODExitProc;
  9474. var mlj : byte;
  9475. begin
  9476. ExitProc := SaveExitProc;
  9477. Exit_Sb16;
  9478. end;
  9479. {$F-}
  9480.  
  9481. {
  9482. **************************************************************************
  9483. V O C - P l a y e r R o u t i n e n
  9484.  
  9485. zur Demonstration der Ausgabe von VOC - Files, keine gesonderte
  9486. VOC-Block-Behandlung integriert
  9487. **************************************************************************
  9488. }
  9489.  
  9490.  
  9491. procedure Init_Voc(filename : string);
  9492. const VOCkenn : string = 'Creative Voice File'+#$1A;
  9493. var ch : char;
  9494. kennstr : string;
  9495. ct : byte;
  9496. h : byte;
  9497. error : integer;
  9498. srlo,srhi : byte;
  9499. SR : word;
  9500. Samplingr : word;
  9501. stereoreg : byte;
  9502. begin;
  9503. Transfer_Testing := false;
  9504. VOC_READY := false;
  9505. vocsstereo := stereo;
  9506. stereo := false;
  9507.  
  9508. assign(vocf,filename);
  9509. reset(vocf,1);
  9510. if filesize(vocf) < 5000 then begin;
  9511. VOC_READY := true;
  9512. exit;
  9513. end;
  9514. blockread(vocf,voch,$19);
  9515. kennstr := voch.Kennstr;
  9516. if kennstr <> VOCkenn then begin;
  9517. { Kennung falsch ! }
  9518. VOC_READY := true;
  9519. exit;
  9520. end;
  9521.  
  9522. Blockread(vocf,inread,20);
  9523. vblock.Kennung := inread[2];
  9524.  
  9525. if vblock.Kennung = 1 then begin;
  9526. vblock.SR := inread[6];
  9527. end;
  9528.  
  9529. if vblock.Kennung = 8 then begin;
  9530. SR := inread[6]+(inread[7]*256);
  9531. Samplingr := 256000000 div (65536 - SR);
  9532. if inread[9] = 1 then begin; {stereo}
  9533. if sb16detected then samplingr := samplingr shr 1;
  9534. stereo := true;
  9535. end;
  9536. vblock.SR := 256 - longint(1000000 DIV samplingr);
  9537. end;
  9538.  
  9539. if vblock.Kennung = 9 then begin;
  9540. Samplingr := inread[6]+(inread[7]*256);
  9541. if inread[11] = 2 then begin; {stereo}
  9542. stereo := true;
  9543. if sbprodetected then samplingr := samplingr * 2;
  9544. vblock.SR := 256 - longint(1000000 DIV (samplingr));
  9545. end else begin;
  9546. vblock.SR := 256 - longint(1000000 DIV samplingr);
  9547. end;
  9548. end;
  9549.  
  9550.  
  9551. if vblock.SR < 130 then vblock.SR := 166;
  9552. set_timeconst_sb16(vblock.SR);
  9553.  
  9554. blockgr := filesize(vocf) - 31;
  9555. if blockgr > 2500 then blockgr := 2500;
  9556. blockread(vocf,blk1^,blockgr);
  9557.  
  9558. ch := #0;
  9559. fgr := filesize(vocf) - 32;
  9560. fgr := fgr - blockgr;
  9561. Block_activ := 1;
  9562.  
  9563. if fgr > 1 then begin;
  9564. blockread(vocf,blk2^,blockgr);
  9565. fgr := fgr - blockgr;
  9566. end;
  9567.  
  9568. Wr_dsp($D1);
  9569. lastone := false;
  9570.  
  9571. if not sb16Detected then begin;
  9572. if Stereo then begin;
  9573. stereoreg := Read_Mixer($0E);
  9574. stereoreg := stereoreg OR 2;
  9575. Write_Mixer($0E,stereoreg);
  9576. end else begin;
  9577. stereoreg := Read_Mixer($0E);
  9578. stereoreg := stereoreg AND $FD;
  9579. Write_Mixer($0E,stereoreg);
  9580. end;
  9581. end;
  9582.  
  9583. Spiele_Block_Dsp(blockgr,blk1,false,true);
  9584. end;
  9585.  
  9586. procedure voc_done;
  9587. var h : byte;
  9588. begin;
  9589. lastone := true;
  9590. repeat until dsp_rdy_sb16;
  9591. close(vocf);
  9592. Reset_SBCard;
  9593. stereo := vocsstereo;
  9594. end;
  9595.  
  9596. begin;
  9597. SaveExitProc := ExitProc;
  9598. ExitProc := @MODExitProc;
  9599. dsp_rdy_sb16 := true;
  9600. getmem(blk1,2500);
  9601. getmem(blk2,2500);
  9602. end.
  9603. data segment
  9604. c equ 523 ;Frequenzen der T”ne
  9605. d equ 587
  9606. e equ 659
  9607. f equ 698
  9608. g equ 784
  9609. a equ 880
  9610. h equ 988
  9611.  
  9612. Song: dw c,250, d,250, e,250, f,250, g,500, g,500
  9613. dw a,250, a,250, a,250, a,250, g,500
  9614. dw a,250, a,250, a,250, a,250, g,500
  9615. dw f,250, f,250, f,250, f,250, e,500, e,500
  9616. dw d,250, d,250, d,250, d,250, c,500
  9617. dw 0 ;Abschluá immer mit 0
  9618.  
  9619. oldInt dd 0 ;Zeiger auf alten Handler
  9620. Zaehler dw 0 ;Zaehler, wird einmal pro ms dekrem.
  9621. data ends
  9622.  
  9623. code segment
  9624. assume cs:code,ds:data
  9625.  
  9626. handler proc far ;neuer IRQ 0 - Handler
  9627. pushf
  9628. call dword ptr oldint ;alten Handler aufrufen
  9629. mov ax,data ;Datensegment Zugriff erm”glichen
  9630. mov ds,ax
  9631. dec word ptr Zaehler ;Zaehler dekrementieren
  9632. iret
  9633. handler endp
  9634.  
  9635. prepare proc near ;bereitet Timer und Speaker vor
  9636. mov dx,61h ;Controll-Port laden
  9637. in al,dx
  9638. or al,3 ;untere Bits setzen (enable Speaker)
  9639. out dx,al
  9640.  
  9641. mov al,36h ;Schreibzugriff Timer 0
  9642. mov cx,04a9h ;Interrupt-Abstand 1 ms
  9643. out 43h,al ;Befehl senden
  9644. mov al,cl
  9645. out 40h,al ;Timer-Wert senden
  9646. mov al,ch
  9647. out 40h,al
  9648.  
  9649. mov ax,3508h ;alten Interrupt-Vektor lesen
  9650. int 21h
  9651. mov word ptr oldint,bx ;Vektor sichern
  9652. mov word ptr oldint+2,es
  9653. push ds
  9654. mov ax,cs ;Vektor auf Handler in ds:dx
  9655. mov ds,ax
  9656. lea dx,handler
  9657. mov ax,2508h ;und neuen Vektor setzen
  9658. int 21h
  9659. pop ds
  9660. ret
  9661. prepare endp
  9662.  
  9663. close proc near ;setzt Timer und Speaker wieder zurck
  9664. push ds
  9665. lds dx,oldint ;alten Vektor restaurieren
  9666. mov ax,2508h
  9667. int 21h
  9668.  
  9669. mov al,36h ;Timer zurcksetzen
  9670. out 43h,al
  9671. xor al,al
  9672. out 40h,al ;auf 18,2 Interrupts pro Sekunde
  9673. out 40h,al
  9674.  
  9675. mov dx,61h ;Speaker aus
  9676. in al,dx
  9677. and al,not 3 ;(Speaker enable l”schen)
  9678. out dx,al
  9679. pop ds
  9680. ret
  9681. close endp
  9682.  
  9683. delay proc near ;wartet (Zeit in ms in ax)
  9684. mov zaehler,ax ;Zaehler laden
  9685. warte:
  9686. cmp zaehler,0 ;warten, bis Interrupt
  9687. jne warte ;Zaehler auf 0 gez„hlt hat
  9688. ret
  9689. delay endp
  9690.  
  9691. sound proc near
  9692. mov bx,ax ;Frequenz nach bx
  9693. mov al,0b6h ;Timer 2 auf Rechteck programmieren
  9694. out 43h,al
  9695. mov dx,0012h ;1.193 MHz Eingangsfrequenz
  9696. mov ax,34ddh
  9697. div bx ;Timer-Wert berechnen
  9698. out 42h,al ;Low-Byte an Timer 2
  9699. mov al,ah
  9700. out 42h,al ;High-Byte an Timer 2
  9701. ret
  9702. sound endp
  9703.  
  9704. start proc
  9705. mov ax,data ;Zugriff auf Datensegment erm”glichen
  9706. mov ds,ax
  9707.  
  9708. call prepare ;Timer und Speaker initialisieren
  9709.  
  9710. lea si,song ;Zeiger auf Frequenzen
  9711.  
  9712. weiter:
  9713. lodsw ;Frequenz holen
  9714. or ax,ax
  9715. je fertig ;Abschluá-Byte gefunden ?
  9716. call sound ;Sound ausgeben
  9717. lodsw ;Dauer laden
  9718. call delay ;und warten
  9719. jmp weiter
  9720.  
  9721. fertig:
  9722. call close ;Timer und Interrupts zurcksetzen
  9723. mov ah,4ch ;Programm beenden
  9724. int 21h
  9725. start endp
  9726.  
  9727. code ends
  9728. end start
  9729. uses crt,dos;
  9730. const voclast:Byte=0; {letzter Wert}
  9731. trigger=5; {Empfindlichkeit}
  9732. fertig:Boolean=false; {fertig ?}
  9733. var oldint8:Pointer; {alter IRQ 0 Handler}
  9734. Voc:Pointer; {Zeiger auf Sample-Daten im Speicher}
  9735. VocFile:File; {Voc-Datei}
  9736. timwert, {Wert fr Timer-Chip}
  9737. vocpos, {aktueller Offset in Voc-File}
  9738. voclen, {L„nge des Voc-Files}
  9739. Hz:Word; {Sample-Frequenz}
  9740.  
  9741. Procedure Play;interrupt;assembler;
  9742. {spielt Voc im Interrupt ab}
  9743. asm
  9744. mov dx,61h {Inhalt des Controll Ports lesen}
  9745. in al,dx
  9746. mov cl,al {und in cl sichern}
  9747. les di,voc {es:di mit Zeiger auf Sample-Daten laden}
  9748. inc vocpos {Position um 1 weiter}
  9749. mov ax,vocpos {in ax laden}
  9750. add di,ax {und auf Speicher-Offset addieren}
  9751. cmp ax,voclen {bereits Sample-Ende erreicht ?}
  9752. jne @ok {ja,}
  9753. mov fertig,1 {dann flag setzen}
  9754. @ok:
  9755. mov al,es:[di] {sonst Wert holen}
  9756. mov bl,al {in bl sichern}
  9757. sub al,voclast {Differenz zum letzten Wert bilden}
  9758. mov voclast,bl {und Wert als letzten Wert vermerken}
  9759. cmp al,trigger {Abstand grӇer als Ansprechschwelle ?}
  9760. jg @set {dann Speaker auf high setzen}
  9761. cmp al,-trigger {Abstand kleiner als negative Ansprechschw. ?}
  9762. jg @ende {nein, dann fertig}
  9763. mov al,cl {alten Inhalt d. Control-Ports}
  9764. and al,not 2 {Bit 1 l”schen}
  9765. out dx,al {und schreiben}
  9766. jmp @ende {fertig}
  9767. @set:
  9768. mov al,cl {alten Inhalt d. Control-Ports}
  9769. or al,2 {Bit 1 setzen}
  9770. out dx,al {und schreiben}
  9771. @ende:
  9772. pushf {alten Handler aufrufen}
  9773. call [oldint8]
  9774. End;
  9775.  
  9776. begin
  9777. Assign(VocFile,'rythm.voc'); {File ”ffnen}
  9778. Reset(VocFile,1); {Zurcksetzen}
  9779. Voclen:=FileSize(VocFile); {L„nge ermitteln}
  9780. GetMem(Voc,Voclen); {entsprechend Speicher allokieren}
  9781. BlockRead(VocFile,Voc^,FileSize(VocFile));
  9782. {Voc-File einlesen (max. 64kB)}
  9783. Close(VocFile); {und schlieáen}
  9784. Hz:=1000000 div {Sample-Frequenz aus Datei ermitteln}
  9785. (256-Byte(Ptr(Seg(Voc^),Ofs(Voc^)+$1f)^));
  9786.  
  9787. GetIntVec($8,OldInt8); {Vektor IRQ 0 sichern}
  9788. SetIntVec($8,@Play); {IRQ 0 auf Handler verbiegen}
  9789.  
  9790. timwert := 1193180 DIV Hz; {aus Sampling-Frequenz Timer-Start berechn.}
  9791. Port[$43]:=$36; {diesen auf Z„hler 0 programmieren}
  9792. Port[$40]:=Lo(timwert);
  9793. Port[$40]:=Hi(timwert);
  9794.  
  9795. Repeat Until KeyPressed or fertig; {warten, bis Ende oder Taste}
  9796.  
  9797. SetIntVec($8,OldInt8); {Vektor wieder herstellen}
  9798. Port[$43]:=$36; {Timer zurcksetzen}
  9799. Port[$40]:=0; {(18,2 Hz)}
  9800. Port[$40]:=0;
  9801. End.
  9802. ;
  9803. ; Vision Factory
  9804. ; Gif Loader
  9805. ;
  9806. ; Basisversion
  9807. ; (w) by Atan (Matthias Rasch)
  9808. ; zusammengestellt am 13.11.93
  9809. ;
  9810. ; l„dt Gif-Bild 320*200 in Mode 13h
  9811. ; Aufruf siehe Hauptprogramm
  9812. .286
  9813.  
  9814. clr=256
  9815. eof=257
  9816. w equ word ptr
  9817. b equ byte ptr
  9818.  
  9819. ;codeg group code
  9820. code segment public
  9821. assume cs:code,ds:code
  9822. public loadgif
  9823. public setpal
  9824. public blackpal
  9825. public dealloc
  9826. extrn p13_2_modex:near
  9827. extrn picture:byte
  9828.  
  9829. GifRead proc pascal n:word
  9830. push ds
  9831. mov ax,cs
  9832. mov ds,ax
  9833. mov es,ax
  9834. lea di,puf
  9835. lea si,picture
  9836. add si,w picpos
  9837. mov cx,word ptr n
  9838. rep movsb
  9839. mov ax,n
  9840. add w picpos,ax
  9841. pop ds
  9842. ret
  9843. endp
  9844. GifSeekdelta proc pascal delta:dword
  9845. mov ax,04200h
  9846. mov bx,w handle
  9847. mov cx,word ptr delta + 2
  9848. mov dx,word ptr delta
  9849. int 21h
  9850. ret
  9851. Endp
  9852. ShiftPal proc pascal
  9853. push ds
  9854. mov ax,cs
  9855. mov es,ax
  9856. mov ds,ax
  9857.  
  9858. mov si,offset Puf
  9859. mov di,offset Palette
  9860. mov cx,768
  9861. @l1:
  9862. lodsb
  9863. shr al,2
  9864. stosb
  9865. loop @l1
  9866. pop ds
  9867. ret
  9868. Endp
  9869. FillPuf proc pascal
  9870. push 1
  9871. call gifread
  9872. mov al,b puf[0]
  9873. xor ah,ah
  9874. mov w restbyte,ax
  9875. push ax
  9876. call gifread
  9877. ret
  9878. Endp
  9879.  
  9880. GetPhysByte proc pascal
  9881. push bx
  9882. cmp w restbyte,0
  9883. ja @restda
  9884. pusha
  9885. push es
  9886. call fillpuf
  9887. pop es
  9888. popa
  9889. mov w pufind,0
  9890. @restda:
  9891. mov bx,w PufInd
  9892. mov al,b Puf[bx]
  9893. inc w pufind
  9894. pop bx
  9895. ret
  9896. Endp
  9897.  
  9898. GetLogByte proc pascal
  9899. push si
  9900. mov ax,w breite
  9901. mov si,ax
  9902. mov dx,w restbits
  9903. mov cx,8
  9904. sub cx,dx
  9905. mov ax,w lByte
  9906. shr ax,cl
  9907. mov w akt_code,ax
  9908. sub si,dx
  9909. @nextbyte:
  9910. call getphysbyte
  9911. xor ah,ah
  9912. mov w lByte,ax
  9913. dec w restbyte
  9914.  
  9915. mov bx,1
  9916. mov cx,si
  9917. shl bx,cl
  9918. dec bx
  9919. and ax,bx
  9920.  
  9921. mov cx,dx
  9922. shl ax,cl
  9923. add w akt_code,ax
  9924.  
  9925. sbb dx,w breite
  9926. add dx,8
  9927. jns @positiv
  9928. add dx,8
  9929. @positiv:
  9930. sub si,8
  9931. jle @fertig
  9932. add dx,w breite
  9933. sub dx,8
  9934. jmp @nextbyte
  9935. @fertig:
  9936. mov w restbits,dx
  9937. mov ax,w akt_code
  9938. pop si
  9939. ret
  9940. Endp
  9941. err_mem db 'zu wenig Speicher$'
  9942. getvmem proc pascal
  9943. mov ax,cs
  9944. mov es,ax
  9945. mov bx,20000d
  9946. mov ah,4ah
  9947. int 21h
  9948.  
  9949. mov ah,48h
  9950. mov bx,2001d ;(32000/16+1)
  9951. int 21h
  9952. jae ok ;sprung,wenn carry 0
  9953.  
  9954. mov ax,3
  9955. int 10h
  9956. mov ax,cs
  9957. mov ds,ax
  9958. mov ah,9
  9959. mov dx,offset err_mem
  9960. int 21h
  9961. mov ah,4ch
  9962. mov al,1
  9963. int 21h
  9964. ok:
  9965. mov word ptr vscreen+2,ax
  9966. ret
  9967. getvmem endp
  9968. dealloc proc pascal
  9969. mov ah,49h
  9970. les di,cs:dword ptr vscreen
  9971. int 21h
  9972. ret
  9973. dealloc endp
  9974.  
  9975.  
  9976.  
  9977. LoadGif proc pascal
  9978. push ds
  9979. mov ax,cs
  9980. mov ds,ax
  9981.  
  9982. ; call GifOpen
  9983. ; push 0
  9984. ; push 13
  9985. ; call gifseekdelta
  9986. push 768
  9987. call gifread
  9988. call shiftpal
  9989. push 1
  9990. call gifread
  9991.  
  9992. @extloop:
  9993. cmp w puf[0],21h
  9994. jne @noext
  9995. push 2
  9996. call gifread
  9997. mov al,b puf[1]
  9998. inc al
  9999. xor ah,ah
  10000. push ax
  10001. call gifread
  10002. jmp @extloop
  10003. @noext:
  10004. push 10
  10005. call gifread
  10006. test b puf[8],128
  10007. je @nolok
  10008. push 768
  10009. call gifread
  10010. call shiftpal
  10011. @nolok:
  10012. mov w lbyte,0
  10013. call getvmem
  10014. les di,dword ptr vscreen
  10015.  
  10016. mov w free,258
  10017. mov w breite,9
  10018. mov w max,511
  10019. mov w stackp,0
  10020. mov w restbits,0
  10021. mov w restbyte,0
  10022. @mainloop:
  10023. call getlogByte
  10024. cmp ax,eof
  10025. jne @no_abbruch
  10026. jmp @abbruch
  10027. @no_abbruch:
  10028. cmp ax,clr
  10029. jne @no_clear
  10030. jmp @clear
  10031. @no_clear:
  10032. mov w readbyt,ax
  10033. cmp ax,w free
  10034. jb @code_in_ab
  10035. mov ax,w old_code
  10036. mov w akt_code,ax
  10037. mov bx,w stackp
  10038. mov cx,w sonderfall
  10039. mov w abstack[bx],cx
  10040. inc w stackp
  10041. @code_in_ab:
  10042. cmp ax,clr
  10043. jb @konkret
  10044. @fillstack_loop:
  10045. mov bx,w akt_code
  10046. shl bx,1
  10047. push bx
  10048. mov ax,w ab_tail[bx]
  10049. mov bx,w stackp
  10050. shl bx,1
  10051. mov w abstack[bx],ax
  10052. inc w stackp
  10053. pop bx
  10054. mov ax,w ab_prfx[bx]
  10055. mov w akt_code,ax
  10056. cmp ax,clr
  10057. ja @fillstack_loop
  10058. @konkret:
  10059. mov bx,w stackp
  10060. shl bx,1
  10061. mov w abstack[bx],ax
  10062. mov w sonderfall,ax
  10063. inc w stackp
  10064. mov bx,w stackp
  10065. dec bx
  10066. shl bx,1
  10067. @readstack_loop:
  10068. mov ax,w abstack[bx]
  10069. stosb
  10070. cmp di,32003
  10071. jbe @noovl1
  10072. call p13_2_modex pascal,0,8001
  10073. les di,dword ptr vscreen
  10074. @noovl1:
  10075. dec bx
  10076. dec bx
  10077. jns @readstack_loop
  10078. mov w stackp,0
  10079. mov bx,w free
  10080. shl bx,1
  10081. mov ax,w old_code
  10082. mov w ab_prfx[bx],ax
  10083. mov ax,w akt_code
  10084. mov w ab_tail[bx],ax
  10085. mov ax,w readbyt
  10086. mov w old_code,ax
  10087. inc w free
  10088. mov ax,w free
  10089. cmp ax,w max
  10090. ja @no_mainloop
  10091. jmp @mainloop
  10092. @no_mainloop:
  10093. cmp b breite,12
  10094. jb @no_mainloop2
  10095. jmp @mainloop
  10096. @no_mainloop2:
  10097. inc w breite
  10098. mov cl,b breite
  10099. mov ax,1
  10100. shl ax,cl
  10101. dec ax
  10102. mov w max,ax
  10103. jmp @mainloop
  10104. @clear:
  10105. mov w breite,9
  10106. mov w max,511
  10107. mov w free,258
  10108. call getlogbyte
  10109. mov w sonderfall,ax
  10110. mov w old_code,ax
  10111. stosb
  10112. cmp di,32003
  10113. jbe @noovl2
  10114. call p13_2_modex pascal,0,8001
  10115. les di,dword ptr vscreen
  10116. @noovl2:
  10117. jmp @mainloop
  10118. @abbruch:
  10119. call dealloc
  10120. ; call gifclose;
  10121. pop ds
  10122. ret
  10123. Endp
  10124.  
  10125. SetPal proc pascal
  10126. push ds
  10127. push si
  10128. mov ax,cs
  10129. mov ds,ax
  10130. mov si,offset palette
  10131. mov cx,256*3
  10132. xor al,al
  10133. mov dx,03c8h
  10134. out dx,al
  10135. inc dx
  10136. @lp:
  10137. rep outsb
  10138. pop si
  10139. pop ds
  10140. ret
  10141. Endp
  10142. blackpal proc pascal
  10143. mov ax,cs
  10144. mov es,ax
  10145. lea di,palette
  10146. mov cx,256*3/2
  10147. mov ax,0
  10148. rep stosw
  10149. ret
  10150. Endp
  10151.  
  10152. handle: dw 0
  10153. Puf: db 768 dup (0)
  10154. PufInd: dw 0
  10155. abStack: db 1281 dup (0)
  10156. ab_prfx: dw 2049 dup (0)
  10157. ab_tail: dw 2049 dup (0)
  10158. Byt: db 0
  10159. free: dw 0
  10160. breite: dw 0
  10161. max: dw 0
  10162. stackp: dw 0
  10163. restbits: dw 0
  10164. restbyte: dw 0
  10165. sonderfall: dw 0
  10166. akt_code: dw 0
  10167. old_code: dw 0
  10168. readbyt: dw 0
  10169. bits: dw 0
  10170. bits2get: dw 0
  10171. lbyte: dw 0
  10172. GifName: db 'logo_st.gif',0
  10173. Palette: db 768 dup (0)
  10174. extrn vscreen:dword
  10175. picpos: dw 13
  10176.  
  10177. ;lokdata ends
  10178. code ends
  10179. ;Bemerkung: Sollte es mit seeeeehr komplexen Bildern nicht funktionieren,
  10180. ; bitte melden, umfangreiche Žnderungen in der Speicherverwaltung
  10181. ; n”tig. Muáte Speicher sparen.
  10182. end
  10183.  
  10184. .286
  10185. w equ word ptr
  10186. b equ byte ptr
  10187. code segment public
  10188. assume cs:code,ds:code
  10189. extrn insthand:near
  10190. extrn loadgif:near
  10191. extrn setpal:near
  10192. extrn p13_2_modex:near
  10193. extrn squeeze:near
  10194. extrn blackpal:near
  10195. extrn init_modex:near
  10196. extrn reslim:byte
  10197. extrn oldint21:dword
  10198. extrn oldint65:dword
  10199. extrn kennung:dword
  10200. extrn makecopy:near
  10201. public resident
  10202. public drawgif
  10203. public deinst
  10204. resident proc near
  10205. call insthand
  10206. mov ax,word ptr ds:[2ch]
  10207. mov es,ax
  10208. mov ah,49h
  10209. int 21h
  10210. lea dx,reslim
  10211. inc dx
  10212. int 27h
  10213. ret
  10214. resident endp
  10215. drawgif proc near
  10216. call init_modex
  10217. call blackpal
  10218. call setpal
  10219.  
  10220. call loadgif
  10221. call p13_2_modex pascal,8001,7999
  10222. ; call setpal
  10223. call squeeze
  10224.  
  10225. mov ah,1
  10226. int 21h
  10227. ret
  10228. drawgif endp
  10229. deinst proc near
  10230. mov ah,49h
  10231. int 21h
  10232. mov dx,es:w oldint21
  10233. mov ax,es:w oldint21 + 2
  10234. mov ds,ax
  10235. mov ax,2521h
  10236. int 21h
  10237. mov dx,es:w oldint65
  10238. mov ax,es:w oldint65 + 2
  10239. mov ds,ax
  10240. mov ax,2565h
  10241. int 21h
  10242. int 20h
  10243. deinst endp
  10244. code ends
  10245. end; **************************************
  10246. ; *** ***
  10247. ; *** Trainer zu ********* ***
  10248. ; *** ***
  10249. ; *** (c) 1994 by DATA Becker ***
  10250. ; *** ***
  10251. ; *** Autor: Boris Bertelsons ***
  10252. ; *** ***
  10253. ; **************************************
  10254. ;
  10255. ;
  10256.  
  10257. .286
  10258. w equ word ptr
  10259. b equ byte ptr
  10260. code segment public
  10261. public insthand
  10262. public handler21
  10263. public reslim
  10264. public oldint21
  10265. public oldint65
  10266. public kennung
  10267. public klen
  10268. public check_inst
  10269.  
  10270. assume cs:code,ds:code
  10271. kennung: db 'DATA BECKER'
  10272. oldint21: dd 0
  10273. oldint65: dd 0
  10274. prozedur: dd ?
  10275. klen equ offset oldint21 - offset kennung
  10276.  
  10277.  
  10278. ; *********************************************************************
  10279. ; *** ***
  10280. ; *** An dieser Stelle stehen die eigentlichen Trainer - Routinen ***
  10281. ; *** ***
  10282. ; *********************************************************************
  10283.  
  10284.  
  10285. ; **********************************************************************
  10286. ; *** ***
  10287. ; *** Der neue INT 21h. Die Procedure prft, ob an der angegebenen ***
  10288. ; *** Stelle im Speicher der Befehl "in al,60h" steht, und erstzt ***
  10289. ; *** diesen ggf. durch "int 65h" ! ***
  10290. ; *** ***
  10291. ; **********************************************************************
  10292. handler21 proc pascal
  10293. pushf
  10294. push bp
  10295. push ds
  10296. push bx
  10297. mov bp,sp
  10298. mov bx,[bp+10] ; cs zur Zeit des Interrupts nach BX, DOS !!!
  10299. ; WICHTIG ! Im TD [bp+16] !!!
  10300. add bx,0366h ; CS des 1. INT 21h + 2136h = CS der Tastaturroutine
  10301. mov ds,bx ; cs der Keyboard - Routine nach ds
  10302. mov bx,568Bh ; 8B56h = mov dx,[bp+06]
  10303. cmp ds:word ptr [0005h],bx ; steht es in der Tastaturroutine ?
  10304. jne nicht_aendern
  10305. mov ds:word ptr [0005h],9090h ; Int 65h reinschreiben !
  10306. mov ds:word ptr [0007h],65CDh ; Int 65h reinschreiben !
  10307. nicht_aendern:
  10308. pop bx
  10309. pop ds
  10310. pop bp
  10311. popf
  10312. jmp dword ptr cs:oldint21 ; alten Int 21h aufrufen
  10313. handler21 endp
  10314.  
  10315. ; *************************************************************************
  10316. ; *** ***
  10317. ; *** Die Int 65h - Procedure. Sie liest ein Zeichen ber "in al,60h" ***
  10318. ; *** ein, und prft, ob das eingelesene Zeichen als Trainer-Key ***
  10319. ; *** definiert wurde. Falls ja, werden die zugewiesenen Speicher- ***
  10320. ; *** ver„nderungen und Procedureaufrufe durchgefhrt. An dieser ***
  10321. ; *** Stelle máen Sie Ihre Trainingsvariablen eintragen !!! ***
  10322. ; *** ***
  10323. ; *************************************************************************
  10324.  
  10325. handler65 proc far
  10326. pushf
  10327. push bp
  10328. push ds
  10329. push bx
  10330. mov bp,sp
  10331. mov bx,[bp+10] ; cs zur Zeit des Interrupts nach BX
  10332. in al,60h ; Zeichen lesen
  10333. cmp al,63 ; Taste F5
  10334. je Full_Shoots_j
  10335. cmp al,64 ; Taste F6
  10336. je Full_Lives_J
  10337. cmp al,65 ; Taste F7
  10338. je Weapon_new_j ;
  10339. cmp al,66 ; Taste F6
  10340. je Weapon_new_j ;
  10341. cmp al,67 ; Taste F9
  10342. je Weapon_new_j ;
  10343. cmp al,68 ; Taste F10
  10344. je More_Points_J
  10345.  
  10346. Ende_Keyb:
  10347. pop bx
  10348. pop ds
  10349. pop bp
  10350. popf
  10351. iret
  10352.  
  10353. Full_Shoots_j:
  10354. jmp Full_Shoots
  10355. Full_Lives_j:
  10356. jmp Full_Lives
  10357. More_Points_j:
  10358. jmp More_Points
  10359. Weapon_new_j:
  10360. jmp Weapon_new
  10361.  
  10362. Full_Shoots:
  10363. pushf
  10364. PUSHA
  10365. sub bx,0 ; da schon richtiges CS
  10366. mov word ptr prozedur+2,bx
  10367. mov bx,1401h ; es:[bx] = 14EF:1401
  10368. mov word ptr prozedur,bx
  10369. ;--------
  10370. mov ds:byte ptr [0DA3h],20h
  10371. mov ax,20h
  10372. push ax
  10373. call dword ptr [prozedur]
  10374. POPA
  10375. popf
  10376. jmp Ende_Keyb
  10377.  
  10378. Full_Lives:
  10379. pushf
  10380. pusha
  10381. sub bx,0 ;
  10382. mov word ptr prozedur+2,bx
  10383. mov bx,1317h ; es:[bx] = 14EF:1317
  10384. mov word ptr prozedur,bx
  10385. ;-----------
  10386. mov ds:byte ptr [0DA3h],0009
  10387. mov ax,9
  10388. push ax
  10389. call dword ptr [prozedur]
  10390. popa
  10391. popf
  10392. jmp Ende_Keyb
  10393.  
  10394. Weapon_new:
  10395. pushf
  10396. pusha
  10397. sub bx,0 ;
  10398. mov word ptr prozedur+2,bx
  10399. mov bx,1454h ; es:[bx] = 14EF:1454
  10400. mov word ptr prozedur,bx
  10401. ;-----------
  10402. sub al,65
  10403. mov ah,0
  10404. mov ds:byte ptr [0DA2h],al
  10405. push ax
  10406. call dword ptr [prozedur]
  10407. popa
  10408. popf
  10409. jmp Ende_Keyb
  10410.  
  10411. More_Points:
  10412. pushf
  10413. pusha
  10414. sub bx,0 ;
  10415. mov word ptr prozedur+2,bx
  10416. mov bx,1BD0h ; es:[bx] = 14EF:1BD0
  10417. mov word ptr prozedur,bx
  10418. ;-----------
  10419. mov ax,1000
  10420. push ax
  10421. call dword ptr [prozedur]
  10422. popa
  10423. popf
  10424. jmp Ende_Keyb
  10425.  
  10426. handler65 endp
  10427.  
  10428. insthand proc pascal
  10429. reslim label byte
  10430. push ds
  10431. pop ds
  10432. mov ax,3521h ; alten INT 21 sichern
  10433. int 21h
  10434. mov w oldint21,bx
  10435. mov w oldint21 + 2,es
  10436. mov ax,3565h ; alten INT 65h sichern
  10437. int 21h
  10438. mov w oldint65,bx
  10439. mov w oldint65 + 2,es
  10440. mov ax,2521h ; INT 21h auf eigene Routine verbiegen
  10441. lea dx,handler21
  10442. int 21h
  10443. mov ax,2565h ; INT 65h auf eigene Keyboard-Routine
  10444. lea dx,handler65
  10445. int 21h
  10446. ret
  10447. insthand endp
  10448.  
  10449. check_inst proc near
  10450. mov ax,3521h ; Interrupt - Vektor ermitteln
  10451. int 21h
  10452. mov di,bx
  10453. mov si,offset kennung
  10454. mov di,si
  10455. mov cx,klen
  10456. repe cmpsb ; Auf Kennung prfen
  10457. ret
  10458. check_inst endp
  10459.  
  10460. code ends
  10461. end
  10462. .286
  10463. w equ word ptr cs:
  10464. b equ byte ptr cs:
  10465. ;code segment public
  10466. ;code ends
  10467. code segment public
  10468. ;gcode group code,arescode
  10469. assume cs:code,ds:code
  10470. extrn setpal:near
  10471. public init_modex,p13_2_modex,squeeze
  10472. public vscreen
  10473.  
  10474. Init_ModeX proc pascal
  10475. mov ax,0013h
  10476. int 10h
  10477.  
  10478. mov dx,3c4h
  10479. mov al,4
  10480. out dx,al
  10481. inc dx
  10482. in al,dx
  10483. and al,0f7h
  10484. or al,4h
  10485. out dx,al
  10486. dec dx
  10487. mov ax,0f02h
  10488. out dx,ax
  10489.  
  10490. mov ax,0a000h
  10491. mov es,ax
  10492. xor di,di
  10493. xor ax,ax
  10494. mov cx,8000h
  10495. cld
  10496. rep stosw
  10497.  
  10498. mov dx,3d4h
  10499. mov al,14h
  10500. out dx,al
  10501. inc dx
  10502. in al,dx
  10503. and al,0bfh
  10504. out dx,al
  10505. dec dx
  10506. mov al,17h
  10507. out dx,al
  10508. inc dx
  10509. in al,dx
  10510. or al,40h
  10511. out dx,al
  10512. ret
  10513. Endp
  10514.  
  10515. plane_l: db 0
  10516. plane_pos: dw 0
  10517. vscreen: dd 0
  10518.  
  10519. p13_2_modex proc pascal start,pic_size:word
  10520. mov b plane_l,1
  10521. mov w plane_pos,0
  10522. push ds
  10523. lds si,dword ptr cs:vscreen
  10524. mov w plane_pos,si
  10525. mov ax,0a000h
  10526. mov es,ax
  10527. mov di,start
  10528. mov cx,pic_size
  10529. @lpplane:
  10530. mov al,02h
  10531. mov ah,b plane_l
  10532. mov dx,3c4h
  10533. out dx,ax
  10534.  
  10535. @lp1:
  10536. movsb
  10537. add si,3
  10538. loop @lp1
  10539.  
  10540. mov di,start
  10541. inc w plane_pos
  10542. mov si,w plane_pos
  10543. mov cx,pic_size
  10544. shl b plane_l,1
  10545. cmp b plane_l,10h
  10546. jne @lpplane
  10547.  
  10548. pop ds
  10549. ret
  10550. Endp
  10551. Split proc pascal row:byte
  10552. mov bl,row
  10553. xor bh,bh
  10554. shl bx,1
  10555. mov cx,bx
  10556.  
  10557. mov dx,3d4h
  10558. mov al,07h
  10559. out dx,al
  10560. inc dx
  10561. in al,dx
  10562. and al,11101111b
  10563. shr cx,4
  10564. and cl,16
  10565. or al,cl
  10566. out dx,al
  10567.  
  10568. dec dx
  10569. mov al,09h
  10570. out dx,al
  10571. inc dx
  10572. in al,dx
  10573. and al,10111111b
  10574. shr bl,3
  10575. and bl,64
  10576. or al,bl
  10577. out dx,al
  10578.  
  10579. dec dx
  10580. mov al,18h
  10581. mov ah,row
  10582. shl ah,1
  10583. out dx,ax
  10584. ret
  10585. Endp
  10586. SetStart proc pascal t:word
  10587. mov dx,3d4h
  10588. mov al,0ch
  10589. mov ah,byte ptr t + 1
  10590. out dx,ax
  10591. mov al,0dh
  10592. mov ah,byte ptr t
  10593. out dx,ax
  10594. ret
  10595. Endp
  10596. WaitRetrace proc pascal
  10597. mov dx,3dah
  10598. @wait1:
  10599. in al,dx
  10600. test al,8h
  10601. jz @wait1
  10602. @wait2:
  10603. in al,dx
  10604. test al,8h
  10605. jnz @wait2
  10606. ret
  10607. Endp
  10608.  
  10609. squeeze proc pascal
  10610. mov si,200*80
  10611. mov di,199
  10612. push di
  10613. call split
  10614. push si
  10615. call setstart
  10616. call waitretrace
  10617. call setpal
  10618. sqlp:
  10619. call waitretrace
  10620. push di
  10621. call split
  10622. push si
  10623. call setstart
  10624. sub si,2*80
  10625. sub di,2
  10626. cmp di,99d
  10627. jae sqlp
  10628. ret
  10629. squeeze endp
  10630. code ends
  10631. end
  10632. .286
  10633. code segment public
  10634. assume cs:code,ds:code
  10635. extrn resident:near
  10636. extrn drawgif:near
  10637. extrn reslim:byte
  10638. extrn check_inst:near
  10639. extrn deinst:near
  10640. org 100h
  10641. main proc
  10642. call check_inst
  10643. jcxz deinstall
  10644.  
  10645. call drawgif
  10646. mov ax,03h
  10647. int 10h
  10648.  
  10649. lea dx,text_ins
  10650. mov ah,9h
  10651. int 21h
  10652. jmp resident
  10653. deinstall:
  10654. lea dx,text_deinst
  10655. mov ah,9h
  10656. int 21h
  10657. jmp deinst
  10658.  
  10659. mov ax,20h
  10660. int 21h
  10661. main endp
  10662. text_ins: db 'Trainer installed$'
  10663. text_deinst: db 'Trainer deinstalled$'
  10664. code ends
  10665. end main
  10666.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement