C SPIT.FTN C C A SUBROUTINE TO FIND THE RECORD THAT HAS THE DESIRED DATA C IF THE DESIRED DATA IS FOUND MID WILL BE THE DESIRED RECORD C NUMBER AND RES WILL BE = TO 1 C IF MORE THAN 1 QUALIFY, RES WILL = 2 AND MID WILL BE THE TOP C ONE THAT QUALIFIES C IF NONE QUALIFY, MID WILL BE THE ONE ALPHABETICALLY ABOVE C THE TARGET AND RES WILL BE 0 C SUBROUTINE SPIT(TARGET,BEG,END,MID,RES,ENDS) INTEGER BEG,END,MID,RES,TOP,BOT INTEGER CHAR ! NO. OF CHARACTERS INTEGER ENDS ! END OF THE SORTED PORTION BYTE MASTER(84) BYTE TARGET(10),LAST(5) BYTE A ! CHARACTER PICKED UP FROM KEYBOARD INTEGER CPOS ! CURSOR POSITION INTEGER COMPAR ! COMPARE SUBROUTINE COMMON MASTER DATA LAST/'L','A','S','T',0/ CALL ERASA CALL CUR(1,1) CHAR=LEN(TARGET) ! GET NO. OF CHARACTERS C C FIRST SEARCH SEQUENTIALLY THE UNSORTED PORTION C IF(COMPAR(TARGET,LAST,4).EQ.0)GO TO 280 ! WANT TO DISPLAY LAST 20 TOP=BEG BOT=ENDS CHAR=LEN(TARGET) ! GET NO. OF CHARACTERS 120 MID=(TOP+BOT)/2.0 130 READ(2'MID)MASTER IF(MASTER(1).NE."71)GO TO 140 ! THIS REC NOT DELETED MID=MID-1 GO TO 130 140 K=COMPAR(TARGET,MASTER,CHAR) ! K = 1 IF TARGET BIGGER IF(K.EQ.0)GO TO 300 ! FOUND IT IF((BOT-TOP).LE.4)GO TO 180 ! SEARCH SEQUENTIALLY IF(K.EQ.1)GO TO 150 ! TARGET IS BIGGER BOT=MID ! TEST NAME BIGGER GO TO 120 150 TOP=MID GO TO 120 C C COME HERE TO SEARCH SEQUENTIALLY C 180 MID=TOP 190 IF(MID.GT.END) GO TO 380 ! GIVE UP, GONE PASSED END READ(2'MID)MASTER K=COMPAR(TARGET,MASTER,CHAR) IF(K.EQ.0)GO TO 300 ! FOUND IT IF(K.EQ.2)GO TO 380 ! TEST IS BIGGER, PASSED IT MID=MID+1 GO TO 190 C C WANT TO DISPLAY THE LAST 20 NAMES C 280 MID=END-7 GO TO 400 C C COME HERE IF FOUND IT C 300 RES=1 310 MID=MID-1 READ(2'MID)MASTER ! LOOKING FOR TOP ONE OF MATCHES IF(COMPAR(TARGET,MASTER,CHAR).EQ.0)GO TO 310 MID=MID+1 ! HAVE GONE ONE TOO FAR C THIS MUST BE THE TOP NAME THAT MATCHES. Is there more than one? C READ(2'MID+1)MASTER IF(COMPAR(TARGET,MASTER,CHAR).NE.0)RETURN ! ONLY ONE MATCH C CALL ERASA C CALL CUR(1,1) WRITE(5,330) 330 FORMAT(' MORE THAN ONE MATCH WAS FOUND. IDENTIFY THE ONE YOU 1 WANT.') WRITE(5,410) CPOS=MID GO TO 415 C380 CALL ERASA C CALL CUR(1,1) 380 WRITE(5,390) 390 FORMAT(' FAILED TO FIND') C C DIDN'T FIND SO DISPLAY 8 ABOVE AND 8 BELOW. C WE ARE ONE PASSED THE APPARENT POSITION THIS NAME SHOULD HAVE C 400 WRITE(5,410) 410 FORMAT(' ENTER UP OR DOWN, F FOR FORWARD 16, B FOR BACK 16' 1,/,' A TO ACCEPT, R TO REJECT') MID=MID-8 ! IF HIT A WILL TAKE MID IF(MID.GT.(END-15)) MID=END-15 IF(MID.LT.2)MID=2 CPOS=MID ! THIS WILL BE CURSOR POSITION 415 CALL BATCH(MID,END) 420 CALL UPDN(A) IF(A.GT."140)A=A-"40 ! IF SMALL LETTER, CHANGE TO CAP LETTER IF(A.EQ."106)GO TO 440 ! GO FORWARD A BATCH IF(A.EQ."102)GO TO 460 ! BACK UP 16 IF(A.EQ."101)GO TO 480 ! ACCEPT IF(A.EQ."122)GO TO 500 ! HIT R FOR REJECT (GIVING UP) IF(A.EQ."34)GO TO 520 ! HIT UP ARROW IF(A.EQ."35)GO TO 540 ! HIT DOWN ARROW GO TO 420 C C GO FORWARD ONE BATCH C 440 CPOS=CPOS+16 MID=CPOS CALL BATCH(CPOS,END) GO TO 420 C C GO BACK ONE BATCH 460 CPOS=CPOS-16 IF(CPOS.LT.2) CPOS=2 MID=CPOS CALL BATCH(CPOS,END) GO TO 420 C C THEY ACCEPTED IT 480 CALL ERASA ! ERASE SCREEN CALL CUR(1,1) RES=1 RETURN C C THEY HIT REJECT 500 RES=0 CALL ERASA CALL CUR(1,1) RETURN C C HIT UP ARROW 520 IF(MID.LE.CPOS)GO TO 420 ! AT TOP, DO NOTHING MID=MID-1 ! MOVE OUR CHOICE UP CALL CUP ! MOVE CURSOR UP GO TO 420 C C HIT DOWN ARROW 540 IF(MID.GE.(MID+15))GO TO 420 ! AT BOTTOM, DO NOTHING MID=MID+1 CALL CDN GO TO 420 END C C SUBROUTINE BATCH C C A SUBROUTINE TO PUT THE CURSOR 5 DOWN PRINT 16 LINES AND RETURN C THE CURSOR TO POSITION 6 DOWN (THE FIRST LINE) C SUBROUTINE BATCH(MID,END) BYTE MASTER(84) INTEGER END COMMON MASTER CALL CUR(5,1) CALL ERASR DO 190 I=MID,MID+15 IF(I.GT.END)GO TO 200 READ(2'I)MASTER WRITE(5,110)I,(MASTER(J),J=1,40) 110 FORMAT(I6,2X,40A1) 190 CONTINUE 200 CALL CUR(6,1) RETURN END