home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / MINIRES.ARJ / MINIRES.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-02-28  |  7.6 KB  |  221 lines
  1. (*                                 æ»Ñµ¿á½∞¡« ñ½∩ æ«ΣΓÅá¡«αá¼δ.
  2.  
  3.   äѼ«¡ßΓαᵿ«¡¡á∩ »α«úαá¼¼á, »«¬áºδóáεΘá∩ ß»«ß«íδ ß«¬αáΘÑ¡¿∩  αẼÑαá
  4. αѺ¿ñÑ¡Γ¡δσ »α«úαá¼¼, ¡á»¿ßá¡¡δσ ¡á ∩ºδ¬Ñ Turbo-Pascal 6.0.
  5.    Å«ñα«í¡«ßΓ¿ ¿ß»«½∞º«óá¡¡δσ Γα嬫ó »α¿óÑñÑ¡δ ó ßΓáΓ∞Ñ, »«¼ÑΘÑ¡¡«⌐  ó
  6. φΓ«⌐ ªÑ æ«ΣΓÅá¡«αá¼Ñ.
  7.    Åα«úαἼᠿúαáÑΓ »α«ßΓπε ¼Ñ½«ñ¿ε ó  Σ«¡«ó«¼  αѪ¿¼Ñ,  ºáΓѼ  ñѽáÑΓ
  8. »∩Γ¿ßѬπ¡ñ¡πε »áπºπ ¿ ß¡«óá ¿úαáÑΓ Γπ ªÑ ¼Ñ½«ñ¿ε.
  9.    ÇóΓ«α ºá ¬áτÑßΓ󫠼ѽ«ñ¿¿ «ΓóÑΓßΓóÑ¡¡«ßΓ¿ ¡Ñ ¡ÑßÑΓ.
  10.    ä½∩ »α«ßΓ«Γδ óÑ¬Γ«α »αÑαδóá¡¿∩ 1C »ÑαÑσóáΓδóáÑΓß∩ íѺó«ºóαáΓ¡«,  Γ«
  11. ÑßΓ∞ »«ß½Ñ ºá»π߬á φΓ«⌐ »α«úαá¼¼δ  «ßΓá½∞¡δÑ  αѺ¿ñÑ¡Γδ,  ¿ß»«½∞ºπεΘ¿Ñ
  12. óÑ¬Γ«α 1C, ¼«úπΓ »ÑαÑßΓáΓ∞ ßαáíáΓδóáΓ∞.
  13.    ùΓ«íδ  »α«óÑα¿Γ∞,  ß¬«½∞¬«  »á¼∩Γ¿  φ¬«¡«¼¿Γß∩  »α¿   ¿ß»«½∞º«óá¡¿¿
  14. ¼ÑΓ«ñ«ó  ß«¬αáΘÑ¡¿∩  αẼÑαá   αѺ¿ñÑ¡Γ¡«⌐   »α«úαá¼¼δ,   ó«ßßΓá¡«ó¿ΓÑ
  15. «»¿ßá¡¿Ñ ¼á¬α««»αÑñѽѡ¿∩ Standard.
  16.    ô ¼Ñ¡∩ »«½πτ¿½ß∩ αѺ¿ñÑ¡Γ ó 5824 íá⌐Γá  »α¿  {$DEFINE  Standard}  ¿
  17. óßÑú« ½¿Φ∞ 1904 íá⌐Γá, Ñß½¿  ¿ß»«½∞º«óáΓ∞  ¼ÑΓ«ñδ  ß«¬αáΘÑ¡¿∩  αẼÑαá
  18. αѺ¿ñÑ¡Γ¡«⌐ »α«úαá¼¼δ, Γ« ÑßΓ∞ {.$DEFINE Standard}.
  19.  
  20.                                         ÇóΓ«α      ÿÑσ«óµ«ó Ç.ï.
  21.                                                    25 ΣÑóαá½∩ 1992 ú«ñá
  22.  
  23. *)
  24.  
  25. {.$DEFINE Standard}
  26.  
  27. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  28. {$M 1024,0,0}
  29.  
  30. program MiniResident;
  31.  
  32. uses DOS,CRT;
  33.  
  34. CONST
  35.      Counter  : word = 0; (* æτÑΓτ¿¬ ó맮ó«ó »αÑαδóá¡¿∩ 1C - Γá⌐¼Ñαá *)
  36.      MusicItem: word = 1; (* ì«¼Ñα ΓѬπΘÑ⌐ τáßΓ«Γδ ¿ ñ½¿Γѽ∞¡«ßΓ¿ ºóπ¬á *)
  37.      MaxItem         = 58;(* éßÑú« φ½Ñ¼Ñ¡Γ«ó ¼áßß¿ó«ó ñ½¿Γѽ∞¡«ßΓ¿
  38.                              ¿ τáßΓ«Γδ ºóπ¬á *)
  39.  
  40. CONST Fr : ARRAY[1..MaxItem] of word =  (* ùáßΓ«Γá ºóπ¬á *)
  41.                                 ( $106,$106,$125,$149,$106,$149,$125,$0C4,
  42.                                   $106,$106,$125,$149,$106,$106,$106,$106,
  43.                                   $125,$149,$15D,$149,$125,$106,$0F6,$0C4,
  44.                                   $0DC,$0F6,$106,$106,$0DC,$0F6,$0DC,$0AE,
  45.                                   $0DC,$0F6,$106,$0DC,$0C4,$0DC,$0C4,$0AE,
  46.                                   $0A4,$0AE,$0C4,$0DC,$0F6,$0DC,$0AE,$0DC,
  47.                                   $0F6,$106,$0DC,$0C4,$106,$0F6,$125,$106,
  48.                                   $106,0);
  49.       Tm : ARRAY[1..MaxItem] of byte =  (* Åáπºá ¼Ñªñπ ¿º¼Ñ¡Ñ¡¿∩¼¿ ºóπ¬«ó *)
  50.                                 ( 5 ,5 ,5 ,5 ,5 ,5 ,5 ,5 ,
  51.                                   5 ,5 ,5 ,5 ,11,11,5 ,5 ,
  52.                                   5 ,5 ,5 ,5 ,5 ,5 ,5 ,5 ,
  53.                                   5 ,5 ,11,11,6 ,5 ,6 ,5 ,
  54.                                   5 ,5 ,5 ,5 ,6 ,5 ,6 ,5 ,
  55.                                   5 ,5 ,7 ,6 ,5 ,6 ,5 ,5 ,
  56.                                   5 ,5 ,7 ,5 ,5 ,5 ,5 ,11 ,
  57.                                   11,90);
  58.  
  59. (*
  60.      Åα«µÑñπαδ Move, Sound ¿ NoSound, ¡á»¿ßá¡¡δÑ ó¼ÑßΓ« ßΓá¡ñáαΓ¡δσ
  61.    ¿º ¼«ñπ½Ñ⌐ SYSTEM ¿ CRT.
  62. *)
  63.  
  64. procedure Move( VAR Source, Dest; Count : word );
  65. (* ä½∩ Γ«ú«, τΓ«íδ ¡Ñ ¿ß»«½∞º«óáΓ∞ move ¿º ¼«ñπ½∩ SYSTEM *)
  66.  
  67. TYPE
  68.    Bytes = array[1..MaxInt] of byte;
  69. VAR
  70.    I : word;
  71. begin
  72.  
  73.    FOR I := 1 TO Count DO Bytes(Dest)[I] := Bytes(Source)[I];
  74.  
  75. end;{Move}
  76.  
  77. (* Åα«µÑñπαδ Sound ¿ NoSound óº∩Γδ ¿º í¿í½¿«ΓѬ¿ Object Professional
  78. for Turbo-Pascal. êßσ«ñ¡δÑ ΓѬßΓδ ñαπú¿σ »α«µÑñπα, ¡Ñ«íσ«ñ¿¼δσ ñ½∩
  79. αáí«Γδ éáΦ¿σ αѺ¿ñÑ¡Γ¡δσ »α«úαá¼¼, ¼«ª¡« ¡á⌐Γ¿ Γá¼ ªÑ.
  80. *)
  81.  
  82.  
  83. procedure Sound(Hz: Word);
  84. (*Turn on the sound at the designated frequency*)
  85. begin
  86.  asm
  87.  
  88.         MOV     BX,Hz                  (*BX = Hz       *)
  89.         MOV     AX,34DCh
  90.         MOV     DX,0012h               (*DX:AX = $1234DC = 1,193,180 *)
  91.         CMP     DX,BX                  (*Make sure the division won't *)
  92.         JAE     @SoundExit             (* produce a divide by zero error *)
  93.         DIV     BX                     (*Count (AX) = $1234DC div Hz     *)
  94.         MOV     BX,AX                  (*Save Count in BX                *)
  95.  
  96.         IN      AL,61h                 (*Check the value in port $61     *)
  97.         TEST    AL,00000011b           (*Bits 0 and 1 set if speaker is on *)
  98.         JNZ     @SetCount              (*If they're already on, continue   *)
  99.  
  100.         OR      AL,00000011b           (*Set bits 0 and 1   *)
  101.         OUT     61h,AL                 (*Change the value   *)
  102.         MOV     AL,182                 (*Tell the timer that the count is coming *)
  103.         OUT     43h,AL                 (*by sending 182 to port $43  *)
  104.  
  105. @SetCount:
  106.         MOV     AL,BL                  (*Low byte into AL       *)
  107.         OUT     42h,AL                 (*Load low order byte into port $42 *)
  108.         MOV     AL,BH                  (*High byte into AL                 *)
  109.         OUT     42h,AL                 (*Load high order byte into port $42*)
  110.  
  111. @SoundExit:
  112. end;
  113. end;{Sound}
  114.  
  115.  
  116. procedure NoSound; assembler;
  117. (* Turn off the sound *)
  118. asm
  119.  
  120.         IN      AL,61h                  (* Get current value of port $61 *)
  121.         AND     AL,11111100b            (* Turn off bits 0 and 1         *)
  122.         OUT     61h,AL                  (* Reset the port                *)
  123.  
  124. end; {NoSound}
  125.  
  126.  
  127. procedure BufferDS; (* îÑßΓ« ñ½∩ σαá¡Ñ¡¿∩ ¡«ó«ú« áñαÑßá ßÑú¼Ñ¡Γá ñá¡¡«ú« *)
  128. begin
  129. end;{BufferDS}
  130.  
  131. procedure MyRes; interrupt;
  132.  (* ÉѺ¿ñÑ¡Γ¡á∩ »α«µÑñπαá - «íαáí«Γτ¿¬ »ÑαÑσóáτÑ¡¡«ú« »αÑαδóá¡¿∩ 1æ *)
  133.  
  134. begin
  135. {$IFNDEF Standard}
  136.     ASM
  137.        mov ax, cs : word ptr [BufferDS]
  138.        mov ds,ax
  139.     END;
  140. {$ENDIF}
  141.  
  142.     INC( Counter );
  143.     if MusicItem = MaxItem        (* éß∩ ¼πºδ¬á «Γδúαá½á? *)
  144.        then NoSound
  145.        else Sound( (Fr[MusicItem]*9) DIV 10 );
  146.      if Counter = Tm[MusicItem]   (* ä½¿Γѽ∞¡«ßΓ∞ ΓѬπΘÑú« ºóπ¬á
  147.                                      ¿ßτÑα»á¡á? *)
  148.         then begin
  149.                  Inc( MusicItem );   (* äá, »ÑαÑσ«ñ¿¼ ¬ ß½ÑñπεΘѼπ ºóπ¬π *)
  150.                  Counter := 0;
  151.                  if MusicItem > MaxItem
  152.                     then MusicItem := 1;
  153.              end;
  154. end;{MyRes}
  155.  
  156. {$IFNDEF Standard}
  157.  
  158. procedure DummyProc; external;
  159.  
  160. procedure Keep( ExitCode : byte );
  161. (* æñó¿ú ßÑú¼Ñ¡Γá ñá¡¡δσ ó»½«Γ¡πε ¬ ¬«ñ«ó«¼π ßÑú¼Ñ¡Γπ.
  162.    é αѺπ½∞ΓáΓÑ πª¿¼áÑΓß∩ EXE - Σá⌐½ ¡á߬«½∞¬« ó«º¼«ª¡«. *)
  163.  
  164. VAR
  165.    ResidSize: word; (* αẼÑα αѺ¿ñÑ¡Γ¡«⌐ τáßΓ¿ »α«úαá¼¼δ ó »áαáúαáΣáσ *)
  166.    NewDS    : word; (* º¡áτÑ¡¿Ñ ßÑú¼Ñ¡Γá ¡«ó«ú« DS - ßÑú¼Ñ¡Γá ñá¡¡δσ  *)
  167.    DataSize : word; (* αẼÑα ßÑú¼Ñ¡Γá ñá¡¡δσ ó »áαáúαáΣáσ            *)
  168.  
  169.  
  170. begin
  171.  
  172.  
  173.  
  174.   NewDS := (CSeg + Ofs(DummyProc) DIV 16) +1; (* ì«óδ⌐ ßÑú¼Ñ¡Γ ñá¡¡δσ
  175.                                               ¡áτ¿¡áÑΓß∩ ßαáºπ »«ß½Ñ
  176.                                               »α«µÑñπαδ Keep *)
  177.  
  178.   DataSize := SSeg-DSeg;
  179.   ResidSize:= NewDS-PrefixSeg+DataSize;
  180.  
  181.   asm      (* çừ¼¡¿¼ º¡áτÑ¡¿Ñ áñαÑßá ¡«ó«ú« ßÑú¼Ñ¡Γá ñá¡¡δσ *)
  182.      mov ax,NewDS
  183.      mov cs : word ptr [BufferDS], ax
  184.   end;
  185.  
  186.   move( MEM[ DSeg:0 ], MEM[ NewDS:0 ], (SSeg-DSeg)*16);
  187.         (* move ßñó¿úáÑΓ ßÑú¼Ñ¡Γ ñá¡¡δσ ó»α¿Γδ¬
  188.            ¬ ¬«ñá¼ αѺ¿ñÑ¡Γ¡«⌐ τáßΓ¿ »α«úαá¼¼δ *)
  189.  
  190.   ASM                             (* æΓá¡«ó¿¼ß∩ αѺ¿ñÑ¡Γ«¼ *)
  191.     mov ax,[SYSTEM.PREFIXSEG]
  192.     mov es,ax
  193.     mov es,es:[02CH]              (* æ¡áτá½á «ßó«í«ªπ Environment block *)
  194.     mov ah,49H
  195.     int 21H
  196.  
  197.     mov dx,ResidSize              (* ôßΓá¡«ó¿¼ αẼÑα αѺ¿ñÑ¡Γ¡«⌐ τáßΓ¿ *)
  198.     mov ah,31H
  199.     mov al,ExitCode               (* ÆÑ»Ñα∞ - TSR ß ¬«ñ«¼ ó«ºóαáΓá ExitCode *)
  200.     int 21H
  201.   END;
  202.  
  203. end;{Keep}
  204.  
  205. procedure DummyProc;
  206. begin
  207. end;{DummyProc}
  208.  
  209. {$ENDIF}
  210.  
  211. (* ÄΓßεñá ¡áτ¿¡áÑΓß∩ Γá τáßΓ∞ »α«úαá¼¼δ, ¬«Γ«αá∩ ¡Ñ »«»áñÑΓ ó αѺ¿ñÑ¡Γ.
  212.    ìÑ ñπ¼á⌐ΓÑ, τΓ« φΓ« ß½¿Φ¬«¼ ¼á½«, óÑñ∞ «¡á ó¬½ετáÑΓ ó ßÑí∩ »α«µÑñπαδ
  213.    ¿º ¼«ñπ½Ñ⌐ DOS, SYSTEM, CRT ¿ ¿¡¿µ¿á½¿ºáµ¿«¡¡δ⌐ ¬«ñ φΓ¿σ ¼«ñπ½Ñ⌐.
  214. *)
  215.  
  216. begin
  217.   SetIntVec( $1C, Addr(MyRes) );
  218.   SwapVectors;
  219.   Keep( 0 );
  220. end.
  221.