home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / PPAGE210.ZIP / SIREN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-01-09  |  2.1 KB  |  91 lines
  1. { Cheezy Siren - An external page bell for Pocket Pager }
  2. { The controls are the same as those used by PPage.     }
  3.  
  4. {$X+}
  5.  
  6.  
  7. Uses Crt, Modem;
  8.  
  9.  
  10. Const
  11.      _LeftShift  = $02;
  12.      _RightShift = $01;
  13.  
  14.  
  15. Var
  16.    A, B : Word;
  17.  
  18.  
  19. { Checks status of both Shift keys     }
  20. { Alt-C is pressed by the Sysop.       }
  21.  
  22. Function KeyOn(Mask : Byte) : Boolean;
  23. Var
  24.    KeyboardStatus : ^Byte;
  25. Begin
  26.      KeyboardStatus := Ptr($0000,$0417);
  27.      KeyOn := (KeyboardStatus^ AND Mask) = Mask;
  28. End;
  29.  
  30.  
  31. { Does a complete check of the key-    }
  32. { board to see who pressed what.       }
  33.  
  34. Procedure CheckKeys;
  35. Var
  36.    Ch : Char;
  37. Begin
  38.      NoSound;
  39.      If ReadKey = #0 Then
  40.      { A "special" key, either remote or local. }
  41.      Begin
  42.           If NOT(SLData^.LastKey) Then
  43.           { The last keypressed was remote. }
  44.           Begin
  45.                ReadKey;
  46.                Halt(1);
  47.           End
  48.           Else
  49.           { The last keypress was local. }
  50.           Begin
  51.                If ReadKey = #46 {Alt-C} Then If KeyOn(_LeftShift) OR
  52.                KeyOn(_RightShift) Then Halt(4) Else Halt(3);
  53.           End;
  54.      End
  55.      Else
  56.      { Any "normal" key, #1-255, local or remote. }
  57.      Begin
  58.           If NOT(SLData^.LastKey) Then Halt(1) Else Halt(2);
  59.      End;
  60. End;
  61.  
  62.  
  63. Begin
  64.      ComToggle;  { Turn Comm. Off }
  65.      TextColor(7); TextBackground(0);
  66.      WriteLn('■ Cheezy Siren, by David Shafer');
  67.      WriteLn('■ Alt-C/Shift-Alt-C to Chat, any other key to Abort');
  68.      ComToggle;  { Turn Comm. Back On }
  69.  
  70.      { Make 10 complete cycles }
  71.      For B := 1 To 10 Do
  72.      Begin
  73.           { Sound travels up }
  74.           For A := 1000 To 1500 Do
  75.           Begin
  76.                If Keypressed Then CheckKeys;
  77.                Sound(A);
  78.                Delay(1);
  79.           End;
  80.           { Sound travels down }
  81.           For A := 1500 DownTo 1000 Do
  82.           Begin
  83.                If Keypressed Then CheckKeys;
  84.                Sound(A);
  85.                Delay(1);
  86.           End;
  87.      End;
  88.      NoSound;
  89.      Halt(0);  { Not necessary, but a reminder. }
  90. End.
  91.