%%HP: T(3)A(D)F(.);

@ PHUN SCANNER (c) by Phunatic Phreak 1992/93 
@ connect to www.phreak.ch for more !
«
     «
     "+++"
      XMIT DROP 
      "Hangin' up" 1 DISP
      2 WAIT
      "ATH0" 13 CHR +
      XMIT DROP
      2 WAIT
      99 SRECV
      DROP2
      »

      «
      \-> Y X I
      «
      "Storin' number" 1 DISP
      IF 10 Y > THEN "0" Y \->STR + ELSE Y \->STR END
      IF 10 X > THEN "0" + END X \->STR + I +
      10 CHR + 
      IFERR 'LIST' STO+ THEN STO END
      »
      »

CLLCD
"   ' PHUN SCANNER '" 1 DISP
"    CODED 1992 BY" 3 DISP
"   PHUNATIC PHREAK" 4 DISP
0 WAIT DROP


{{"R" "R"}{"B" "B"}{"C" "C"}{"T" "T"}} TMENU
"Save:(R)ing,(B)usy," 10 CHR + "(C)onnect,(T)imeout."+ "" INPUT
{} TMENU
DUP
   CASE
   SIZE 1 == THEN "..." + END
   DUP SIZE 2 == THEN ".." + END
   DUP SIZE 3 == THEN "." + END
   END
0 0 0 0 \-> r b c t
«
DUP DUP DUP
   1 1 SUB 4 ROLLD 2 2 SUB 4 ROLLD 3 3 SUB 4 ROLLD 4 4 SUB 4 ROLLD
1 4
START
   CASE
   DUP "R" == THEN 1 'r' STO DROP END
   DUP "B" == THEN 1 'b' STO DROP END
   DUP "C" == THEN 1 'c' STO DROP END
   "T" == THEN 1 't' STO END
   END
NEXT
r b c t
»

"Enter prefix" "" INPUT

"Enter 4 suffix digits" "" INPUT
DUP
1 2 SUB OBJ\-> SWAP 3 4 SUB OBJ\->

"Enter ringcounts" "" INPUT
OBJ\->

"Enter dial timeout" "" INPUT
OBJ\-> 8192 *

"Enter ringing timeout" "" INPUT
OBJ\-> 8192 *

0 0 0 0 0 0 0

\-> hangup mkstr rsave bsave csave tsave prefix Y1 X1 ringcounts
    dtout rtout toutc ring busy conn total dtime rtime
« 
.1 STIME
CLLCD

"Enter ModemInit" "ATS6=3X6" INPUT

13 CHR + XMIT DROP
"Please wait while"  1 DISP
"setting up modem"   2 DISP

2 WAIT
99 SRECV DROP2

"CONN :" conn \->STR + 3 DISP
"RING :" ring \->STR + 4 DISP
"BUSY :" busy \->STR + 5 DISP
"TIME :" toutc \->STR + 6 DISP
"TOTAL:" total \->STR + 7 DISP


X1 99 FOR X
   Y1 99 FOR Y
    DO
      "ATD" prefix +
      IF Y 10 < THEN "0" + END
      Y \->STR +
      IF X 10 < THEN "0" + END
      X \->STR +
      13 CHR +
      DUP
      1 DISP
      "" 2 DISP
      XMIT DROP
      99 SRECV DROP2
      TICKS B\->R 'dtime' STO
      DO 1 SRECV DROP UNTIL
          SIZE TICKS B\->R dtime -
	  DUP dtout SWAP -
	  DUP IF 0 < THEN DROP 0 END
	  8192 / 2 FIX \->STR STD "Timeout: " SWAP + 7 DISP
          dtout > OR END

      IF TICKS B\->R dtime - dtout < THEN 
      "Answer time: " TICKS B\->R dtime - 8192 / 2 FIX \->STR STD + " sec" + 7 DISP

      99 SRECV DROP
      2 22 SUB
      DUP
      2 DISP
      1 4 SUB
      DUP DUP2 DUP2 					@;last modified 23.4.93

      "VOIC"
      IF == THEN "-> VOICE Detected " 6 DISP
      hangup EVAL
      1 6 ROLLD
      END

      "RING"
      IF == THEN 2200 .25 BEEP
      1 \-> RCB
        «
          TICKS B\->R 'rtime' STO
          IF ringcounts 1 > THEN
          0
            DO 1
            "Waiting for " ringcounts RCB - \->STR + 
            " RINGS" + 1 DISP
            "" 2 DISP

	      DO 1 SRECV DROP UNTIL
	          SIZE TICKS B\->R rtime -
		  DUP rtout SWAP -
		  DUP IF 0 < THEN DROP 0 END
		  8192 / 2 FIX \->STR STD "Timeout: " SWAP + 7 DISP
	          rtout > OR END

	            IF TICKS B\->R rtime - rtout > THEN
	            2900 .40 BEEP
	            hangup EVAL
	            IF tsave THEN Y X "T" mkstr EVAL END
	            'toutc' INCR DROP
	            ringcounts 'RCB' STO
	            ELSE

	            99 SRECV DROP
	            2 22 SUB DUP
	            2 DISP
	            1 4 SUB
	            DUP
	            "RING" IF == THEN 2200 .25 BEEP
	                   'RCB' INCR DROP SWAP DROP 0 SWAP
	                   END
	
	            "CONN" IF == THEN 2600 .25 BEEP
	                   DROP2 1 1
	                   END
	            ringcounts RCB == OR
	            END

            UNTIL END
          ELSE 0 END

          hangup EVAL

          IF THEN
            IF csave THEN Y X "C" mkstr EVAL END
            1 5 ROLLD
            'conn' INCR DROP
            ELSE
            IF rsave THEN Y X "R" mkstr EVAL END
            1 5 ROLLD
            'ring' INCR DROP
          END
        »
      END

      "CONN"
      IF == THEN 2600 .25 BEEP
      hangup EVAL
      IF csave THEN Y X "C" mkstr EVAL END
      1 4 ROLLD
      'conn' INCR DROP
      END

      "BUSY"
      IF == THEN 1500 .25 BEEP
      hangup EVAL
      IF bsave THEN Y X "B" mkstr EVAL END
      1 3 ROLLD
      'busy' INCR DROP
      END

      "NO C"
      IF == THEN
      hangup EVAL
      1 SWAP
      END

      "NO D"
      IF == THEN
      "NO DIALTONE !!" 1 DISP
      "CHECK YOUR LINE" 2 DISP
      1200 1 BEEP
      0
      END

     ELSE
       2900 .40 BEEP
       hangup EVAL
       IF tsave THEN Y X "T" mkstr EVAL END
       'toutc' INCR DROP
       1
     END

     IF DEPTH NOT THEN hangup EVAL 0 END
     UNTIL END

'total' INCR DROP
CLLCD
"CONN :" conn \->STR + 3 DISP
"RING :" ring \->STR + 4 DISP
"BUSY :" busy \->STR + 5 DISP
"TIME :" toutc \->STR + 6 DISP
"TOTAL:" total  \->STR + 7 DISP
  NEXT
  0 'Y1' STO
  NEXT
CLOSEIO
2000 .5 BEEP 2600 .5 BEEP 2200 .5 BEEP
»
OFF
»