home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
025.lha
/
address
< prev
next >
Wrap
Text File
|
1987-04-02
|
21KB
|
786 lines
'AMIGA ADDRESS ** CAPACITY OF 1225 ENTRIES ** VER.1.0
'QUICK SEARCH IN EVERY FIELD ** MARK HURST (503)-843-3185
CLEAR ,65000&
DEFINT a-z
WINDOW 1,"* * * AMIGA ADDRESS * * *",(0,0)-(440,114),23
DIM a$(9),m(8),n(50),p$(9,4),index$(9,4),label$(21)
bit=1
ON ERROR GOTO 6000
OPEN "address.ind" FOR INPUT AS 2
FOR x=1 TO 9
bin(x)=bit
FOR y=0 TO 4
INPUT #2,index$(x,y)
NEXT y
bit=bit*2
NEXT x
CLOSE #2
FOR x=1 TO 10
READ title$(x)
NEXT
FOR x=13 TO 21
READ label$(x)
NEXT
ON ERROR GOTO 0
DATA NAME 1,NAME 2,ADDRESS 1,ADDRESS 2,CITY
DATA STA.ZIP,PHONE,TITLE 1,TITLE 2,
DATA MAIL ADDRESS LABELS,ADDRESS BOOK LABELS,MASTER FILE
DATA FIRST NAME FIRST,FIRST NAME LAST,CHOOSE RECORD #
DATA MATCH FIELD STRING,MATCH RECORD STRING,ALL RECORDS
job=1
recsel=4
name1=1
pfield=53
sortp$="000000000"
savefile=0
OPEN "address.dat" AS 2 LEN=262
FIELD 2,35 AS n1$,35 AS n2$,35 AS ad1$,35 AS ad2$,20 AS city$,20 AS state$,12 AS ph$,35 AS t1$,35 AS t2$
screen.refresh:
LOCATE 3,1:COLOR 1,2
FOR x=1 TO 9
PRINT TAB(10-LEN(title$(x)));title$(x)
NEXT
COLOR 1,0:LOCATE 1,18:PRINT "*** RECORD NUMBER "
rec=1
IF LOF(2)>0 THEN
GET 2,1
GOSUB 710
GOSUB 700
END IF
MENU 1,0,1,"RECORD FUNCTIONS"
MENU 1,1,1,"Input & Edit Record"
MENU 1,2,1,"Add Record"
MENU 1,3,1,"Delete Current Record"
MENU 1,4,1,"Hardcopy"
MENU 2,0,1,"SEARCHES"
MENU 2,1,1,"Field Search"
MENU 2,2,1,"Record Search"
MENU 2,3,1,"Get Record Number"
MENU 3,0,1,"MAITENENCE"
MENU 3,1,1,"Data Backup"
MENU 3,2,1,"Restore Index File"
MENU 3,3,1,"Exit Amiga Address"
MENU 4,0,1,""
LINE (0,0)-(48,11),3,bf:LINE(392,0)-(440,11),3,bf
COLOR 2,3:LOCATE 1,2:PRINT"LAST"TAB(51)"NEXT"
COLOR 1,0
ON MENU GOSUB main.menu
120 MENU ON
121 IF MOUSE(0)>-1 THEN 121
IF MOUSE(2)<12 THEN
IF MOUSE(1)<40 THEN GOSUB 140
IF MOUSE(1)>392 AND MOUSE(1)<440 THEN GOSUB 150
END IF
GOTO 121
main.menu:
ON MENU(0) GOTO 1,2,3
1 ON MENU(1) GOTO 300,600,500,4000
2 ON MENU(1) GOTO 400,200,1000
3 ON MENU(1) GOTO 920,2060,900
'****** BACK ONE RECORD ********
140 IF change THEN GOSUB 800
IF rec>1 THEN rec=rec-1 ELSE rec=LOF(2)/262
GET 2,rec
GOSUB 710
GOSUB 700:RETURN
'******** UP ONE RECORD ***********
150 IF change THEN GOSUB 800
IF rec<LOF(2)/262 THEN GET 2:rec=rec+1 ELSE rec=1:GET 2,1
GOSUB 710
GOSUB 700
RETURN
'******* RECORD SEARCH *********
200
WINDOW 9,"* * * Record Search * * *",(0,105)-(350,160),0
215 found=0
CLS
LINE INPUT"SEARCHING FOR ? ";search$
search$=UCASE$(search$)
220 GET 2,1
FOR rec=1 TO LOF(2)/266-1
GET 2:GOSUB 710
FOR look=1 TO 9
p=INSTR(UCASE$(a$(look)),search$)
IF p=0 THEN 240
WINDOW OUTPUT 1:COLOR 1,0
found=1:GOSUB 700
LOCATE look+2,1:COLOR 1,3
PRINT TAB(11);a$(look)
WINDOW OUTPUT 9
GOSUB 470
COLOR 1,0
ON INT(MOUSE(1)/103)+1 GOTO 240,215,275
240 NEXT look,rec
GOSUB 430
ON INT(x/103)+1 GOTO 220,215,275
275 WINDOW CLOSE 9:GOTO 120
'******* INPUT DATA ********
300 savefile=1:change=1
LOCATE 13,1:COLOR 0,1
PRINT"INPUT & EDIT - Use arrow keys or Mouse to move cursor"
PRINT"Hit `ESC' key to Quit input and edit";
COLOR 1,0
gettext 9,3,11,35,a$(),3,0
LOCATE 13,1:PRINT SPACE$(53):PRINT SPACE$(52);
GOSUB 800
GOTO 120
'******* FIELD SEARCHES *******
400 storerec=rec
402 COLOR 3,2:LOCATE 13,1:PRINT"Select FIELD to Search in with MOUSE"
LOCATE 14,1:PRINT"Hit the `ESC' key to Exit Search";
403 a$=INKEY$
IF a$=CHR$(27) THEN
COLOR 1,0:LOCATE 13,1
PRINT SPACE$(36):PRINT SPACE$(36);
GOTO 120
END IF
IF MOUSE(0)>-1 THEN 403
y=MOUSE(2):x=MOUSE(1)
IF x>100 OR y<16 OR y>87 THEN 403
408 COLOR 1,0:LOCATE 13,1:PRINT SPACE$(36):PRINT SPACE$(36);
fpos=INT((y-8)/8):LOCATE fpos+2,1
COLOR 3,2
tb=10-LEN(title$(fpos))
409 PRINT TAB(tb);title$(fpos)
COLOR 1,0
410 WINDOW 9,"* * * Field Search * * *",(0,105)-(350,160),0
412 found=0
book=-1
rec=1
LINE INPUT"SEARCHING FOR ? ";search$
search$=UCASE$(search$)
413 IF book=4 THEN
GOSUB 428
ELSE
book=book+1
IF rec>LOF(2)/262 THEN GOSUB 428
END IF
414 cpos=INSTR(rec-(book*245),index$(fpos,book),LEFT$(search$,1))
416 IF cpos=0 THEN rec=((book+1)*246):GOTO 413
420 found=1
rec=cpos+(book*245)
GET 2,rec
GOSUB 455
422 IF search$=UCASE$(LEFT$(fstr$,LEN(search$))) THEN
storerec=rec:WINDOW OUTPUT 1
GOSUB 710
GOSUB 700:WINDOW OUTPUT 9
GOSUB 470
GOSUB 475
ELSE
rec=rec+1
END IF
424 IF found=2 THEN 450
426 GOTO 414
428 GOSUB 430:GOTO 446
'******* END OF FILE ********
430 CLS
IF found=0 THEN
PRINT "--- """search$""" NOT FOUND ---"
GOTO 434
END IF
432 found=0:PRINT "*** END OF THE FILE ***"
434 LINE(0,27)-(98,51),3,bf
LINE(106,27)-(204,51),3,bf
LINE(212,27)-(310,51),3,bf
436 LOCATE 5,4:COLOR 2,3
PRINT "REPEAT";TAB(16);"ANOTHER";TAB(31);"QUIT"
PRINT TAB(4);"SEARCH";TAB(17);"SEARCH";TAB(29);"SEARCHING";
442 IF MOUSE(0)>-1 THEN 442
444 IF MOUSE(2)>27 THEN IF MOUSE(2)<51 THEN IF MOUSE(1)<310 THEN RETURN
GOTO 442
446 ON INT(MOUSE(1)/103)+1 GOTO 448,450,452
448 book=-1:rec=1:GOTO 413
450 WINDOW CLOSE 9:COLOR 1,2
LOCATE fpos+2,tb:PRINT title$(fpos);
GOTO 402
452 rec=storerec:WINDOW CLOSE 9:COLOR 1,2
LOCATE fpos+2,tb:PRINT title$(fpos)
COLOR 1,0:GOTO 120
'****** FIELD STRING EQUATE TO FSTR$ ******
455 ON fpos GOTO 456,457,458,459,460,461,462,463,464
456 fstr$=n1$:RETURN
457 fstr$=n2$:RETURN
458 fstr$=ad1$:RETURN
459 fstr$=ad2$:RETURN
460 fstr$=city$:RETURN
461 fstr$=state$:RETURN
462 fstr$=ph$:RETURN
463 fstr$=t1$:RETURN
464 fstr$=t2$:RETURN
'***** SEARCH next restart quit *****
470 CLS
LINE(0,27)-(98,43),3,bf
LINE(106,27)-(204,43),3,bf
LINE(212,27)-(310,43),3,bf
471 LOCATE 5,1
PRINT TAB(4);"NEXT";
PRINT TAB(16);"RESTART";
PRINT TAB(31);"QUIT";
COLOR 1,0
472 IF MOUSE(0)>-1 THEN 472
473 IF MOUSE(2)>27 THEN IF MOUSE(2)<43 THEN IF MOUSE(1)<310 THEN RETURN
474 GOTO 472
475 ON INT(MOUSE(1)/103)+1 GOTO 476,477,478
476 rec=rec+1:RETURN
477 book=0:rec=1:found=0:RETURN
478 found=2:RETURN
'****** DELETE RECORD ********
500 savefile=1
requester 0,80,116,"Delete this record ?",1,"YES","NO"
WINDOW CLOSE 3
ON answer GOTO 570,580
570 FOR x=1 TO 9:a$(x)=" ":NEXT x
GOSUB 800:GOSUB 710:GOSUB 700
580 GOTO 120
'***** ADD RECORD TO FILE ********
600 FOR book=0 TO 4:p=0
605 p=INSTR(p+1,index$(1,book)," ")
IF p=0 THEN 680
FOR chap=1 TO 9
IF MID$(index$(chap,book),p,1)<>" " THEN 605
NEXT chap
rec=book*245+p:GET 2,rec:GOTO 695
680 NEXT book
rec=LOF(2)/262+1
695 FOR x=1 TO 9
a$(x)=STRING$(35,32)
NEXT x
GOSUB 700:GOTO 300
'******* PUT DATA ON SCREEN *******
700 LOCATE 1,36:PRINT rec" *** "
PRINT
FOR x=1 TO 9:PRINT TAB(11);a$(x)
NEXT x
RETURN
709 '******* CONVERT DATA TO ARRAY *******
710 a$(1)=n1$:a$(2)=n2$:a$(3)=ad1$:a$(4)=ad2$
a$(5)=city$:a$(6)=state$:a$(7)=ph$:a$(8)=t1$
a$(9)=t2$:IF nf=1 THEN GOSUB 720
RETURN
'***** FIRST NAME FIRST
720 p=INSTR(1,a$(1),","):IF p=0 THEN RETURN
pp=INSTR(a$(1)," ")
p1$=MID$(a$(1),p+1,pp-p+1):p2$=LEFT$(a$(1),p-1)
a$(1)=p1$+p2$:RETURN
'**** PUT FILE *******
800 LSET n1$=a$(1):LSET n2$=a$(2):LSET ad1$=a$(3)
LSET ad2$=a$(4):LSET city$=a$(5):LSET state$=a$(6)
LSET ph$=a$(7):LSET t1$=a$(8)
LSET t2$=a$(9):PUT 2,rec
book=INT(rec/246):cpos=rec-(book*245)
FOR chap=1 TO 9
MID$(index$(chap,book),cpos,1)=UCASE$(LEFT$(a$(chap),1))
NEXT
RETURN
'****** SAVE INDEX FILE BEFORE QUITING ********
900 IF savefile THEN
CLS
PRINT "SAVING INDEX FILE AND CLOSING FILES"
GOSUB 800:CLOSE #1:GOSUB 2010
END IF
CLOSE:CLS:PRINT "HAVE A NICE DAY"
PRINT
PRINT"type `SYSTEM' to Exit Amiga Basic
END
'****** BACKUP FILES ******
920 IF change THEN GOSUB 800
930 CLS:PRINT "Use CLI window to Backup Data files"
PRINT "Example:
PRINT" 1> copy address.dat df1:
PRINT" 1> copy address.ind df1:
PRINT
PRINT"Press any key to continue"
LINE INPUT a$
CLS
GOTO screen.refresh
'********** GET RECORD NUMBER **********
1000 LOCATE 13,1:INPUT"Record Number";num
IF num<1 OR num>LOF(2)/262 THEN 1000
GET 2,num:rec=num
GOSUB 710:GOSUB 700
LOCATE 13,1:PRINT SPACE$(20);
GOTO 120
'********** INDEX FILE STORAGE ********
2010 OPEN "address.ind" FOR OUTPUT AS 3
FOR x=1 TO 9
FOR y=0 TO 4
WRITE #3,index$(x,y)
NEXT y,x
CLOSE #3:RETURN
'******* RESTORE INDEX FILE *********
2020 FOR x=1 TO 9
FOR y=0 TO 4
index$(x,y)=STRING$(245,CHR$(255))
NEXT y,x:RETURN
2025 FOR rec=1 TO LOF(2)/262
GET 2,rec
GOSUB 710
y=INT(rec/246)
p=rec-(y*245)
FOR x=1 TO 9
MID$(index$(x,y),p,1)=UCASE$(LEFT$(a$(x),1))
NEXT x,rec
RETURN
'********* START A NEW FILE ********
2040 GOSUB 2020:GOSUB 2010:RETURN
'***** RESTORE ROUTINES *******
2060 LOCATE 13,1:PRINT"This is going to take a while"
GOSUB 2020:GOSUB 2025
GOSUB 2010
LOCATE 13,1:PRINT SPACE$(30);
GOTO 120
'**** ABasiC.Address to Amiga Basic.Address converter ******
3000 OPEN "address.dat" AS 3 LEN=315
FIELD 3,160 AS p1$,15 AS j1$,20 AS p2$,15 AS j2$,12 AS p3$,23 AS j3$,70 AS p4$
OPEN "df1:address.dat" AS 2 LEN=262
FIELD 2,262 AS dat$
FOR x=1 TO LOF(3)/315
LOCATE 2:PRINT x
GET 3
d$=p1$+p2$+p3$+p4$
LSET dat$=d$
PUT 2
NEXT x
STOP
KILL"address.dat"
NAME "new.address.dat" AS "address.dat"
CLOSE:END
' ****** PRINT INDEX FILE ******
3500 FOR x=1 TO 9:FOR y=0 TO 4:PRINT index$(x,y):NEXT y,x
END
'****** HARDCOPY ******
4000 WINDOW 9,"***** HARDCOPY ******",(0,10)-(600,170),0
'DRAW BOXES
CLS
LINE(4,7)-(163,51),1,b
LINE(4,63)-(147,98),1,b
LINE(180,7)-(339,58),1,b
LINE(350,7)-(554,130),1,b
LINE(179,85)-(229,99),2,b:LINE(242,85)-(284,99),2,b
LINE(403,109)-(448,122),2,b:LINE(483,109)-(527,122),2,b
LINE(71,18)-(107,18):LINE(28,73)-(113,73):LINE(188,18)-(321,18)
LINE(442,9)-(442,105):LINE(445,9)-(445,105)
LINE(498,9)-(498,105):LINE(501,9)-(501,105)
LINE(353,29)-(550,29):LINE(353,26)-(550,26)
FOR x=39 TO 103 STEP 8
LINE(353,x)-(550,x)
NEXT x
'PUT LABELS IN BOXES
LOCATE 2,10
PRINT "JOBS":LOCATE 4
FOR x=13 TO 15:PRINT TAB(2);label$(x):NEXT x
LOCATE 9,5:PRINT "NAME 1 SET";:LOCATE 11,2
PRINT label$(16):LOCATE 12,2:PRINT label$(17)
LOCATE 2,25:PRINT "RECORD SELECTION"
LOCATE 4
FOR x=18 TO 21:PRINT TAB(24);label$(x):NEXT x
LOCATE 5
FOR x=1 TO 9:PRINT TAB(45);title$(x):NEXT x
LOCATE 2,57:PRINT "PRINT";TAB(64);"SORT";
LOCATE 3,57:PRINT "FIELDS";TAB(64);"PRIOR."
LOCATE 12,24:PRINT "PRINT";TAB(32);"EXIT";
'SET UP CURRANT VALUES
4100 mode=2
GOSUB 4110
GOSUB 4115
GOSUB 4120
GOSUB 4125
GOSUB 4145
GOTO 4150
4110 COLOR 1,mode:LOCATE job+3,2
PRINT label$(job+12):COLOR 1,0:RETURN
4115 COLOR 1,mode:LOCATE 10+name1,2
PRINT label$(name1+15):COLOR 1,0:RETURN
4120 COLOR 1,mode:LOCATE recsel+3,24
PRINT label$(recsel+17):COLOR 1,0
IF recsel=1 THEN
LOCATE 18,2:PRINT SPACE$(40)
ELSEIF recsel=4 THEN
LOCATE 15,2:PRINT SPACE$(40)
ELSEIF recsel=2 THEN
LOCATE 5
FOR z=1 TO 9
PRINT TAB(45);title$(z)
NEXT z
ELSE
cfield=0
END IF
RETURN
'SET UP PRINT FIELDS/SORT PRIOR.
4125
FOR bit=1 TO 9
LOCATE bit+4,58
IF pfield AND bin(bit) THEN PRINT "»»»" ELSE PRINT " "
LOCATE bit+4,66
IF MID$(sortp$,bit,1)<>"0" THEN PRINT MID$(sortp$,bit,1)
NEXT bit
RETURN
4145 LOCATE 15,52:COLOR 1,2-stat:PRINT "MARK";
COLOR 1,stat:PRINT TAB(63);"RUB";
COLOR 1,0
RETURN
'MOUSE SELECTIONS
4150 IF MOUSE(0)>-1 THEN 4150
x=MOUSE(1):y=MOUSE(2)
IF x>4 AND x<163 AND y>23 AND y<48 THEN
mode=0:GOSUB 4110:mode=2
ON INT(y/8)-2 GOSUB 4300,4350,4400
GOTO 4150
END IF
IF x>4 AND x<147 AND y>79 AND y<96 THEN
mode=0:GOSUB 4115:mode=2
ON INT(y/8)-9 GOSUB 4450,4475
GOTO 4150
END IF
IF x>180 AND x<339 AND y>23 AND y<56 THEN
mode=0:GOSUB 4120:mode=2
ON INT(y/8)-2 GOSUB 4500,4550,4600,4650
GOTO 4150
END IF
IF x>445 AND x<554 AND y>30 AND y<104 THEN
ON INT(x/55)-7 GOSUB 4700,4750
GOTO 4150
END IF
IF x>403 AND x<448 AND y>109 AND y<122 THEN
stat=0:GOSUB 4145:GOTO 4150
END IF
IF x>483 AND x<527 AND y>109 AND y<122 THEN
stat=2:GOSUB 4145:GOTO 4150
END IF
IF x>179 AND x<229 AND y>85 AND y<99 THEN GOSUB 4800
IF x>242 AND x<284 AND y>85 AND y<99 THEN
WINDOW CLOSE 9:GOTO 120
END IF
GOTO 4150
'****** VARIABLE SETS ******
4300 job=1:GOSUB 4110:pfield=53:GOSUB 4125:RETURN
4350 job=2:GOSUB 4110:pfield=127:GOSUB 4125:RETURN
4400 job=3:GOSUB 4110:pfield=0:GOSUB 4125:RETURN
4450 name1=1:GOSUB 4115:RETURN
4475 name1=2:GOSUB 4115:RETURN
4499 '***** CHOOSE RECORDS ****
4500 recsel=1:GOSUB 4120
LOCATE 14,2:PRINT "TYPE `E' + <RETURN> WHEN FINISHED"
LOCATE 18,2:PRINT "RECORDS CHOSEN ";SPACE$(40);
FOR c=1 TO 10:choose(c)=0:NEXT c:c=1
4510 LOCATE 15,2:LINE INPUT"RECORD # ";a$
IF UCASE$(a$)="E" THEN 4540
IF VAL(a$)=0 THEN 4510
IF VAL(a$)>LOF(2)/262 THEN 4510
LOCATE 18,c*4+14:choose(c)=VAL(a$):PRINT choose(c);
c=c+1:IF c<11 THEN 4510
4540 LOCATE 14,2:PRINT SPACE$(40)
PRINT TAB(2);SPACE$(40):RETURN
'*** MATCH FIELD STRING ***
4550 recsel=2:GOSUB 4120
LOCATE 15,2:PRINT "Choose Match Field With MOUSE";
LOCATE 5:FOR x=1 TO 9:PRINT TAB(45);title$(x):NEXT x
4555 IF MOUSE(0)>-1 THEN 4555
x=MOUSE(1):y=MOUSE(2)
IF x>353 THEN IF x<442 THEN IF y>32 THEN IF y<104 THEN 4570
GOTO 4555
4570 fpos=INT(y/8)-3:COLOR 1,2:LOCATE fpos+4,45
PRINT title$(fpos)
COLOR 1,0
LOCATE 15,2:LINE INPUT"TYPE IN MATCH STRING ";search$
search$=UCASE$(search$)
LOCATE 15,2:PRINT "MATCH STRING IS "search$;SPACE$(20)
RETURN
'*** MATCH RECORD STRING ***
4600 recsel=3:GOSUB 4120
LOCATE 15,2:LINE INPUT"TYPE IN MATCH STRING ";search$
search$=UCASE$(search$)
LOCATE 15,2:PRINT "MATCH STRING IS ";search$;SPACE$(20);
RETURN
'*** ALL RECORDS ***
4650 recsel=4:GOSUB 4120:RETURN
'*** PRINT FIELDS/SORT PRIOR. ***
4700 p=INT(y/8)-3:LOCATE p+4,58
ON (stat/2)+1 GOTO 4710,4720
4710 IF pfield AND bin(p) THEN RETURN
pfield=pfield+bin(p)
PRINT "»»»";:RETURN
4720 IF pfield AND bin(p) THEN
PRINT " ";
pfield=pfield-bin(p)
END IF
RETURN
4750 p=INT(y/8)-3:LOCATE p+4,65
ON (stat/2)+1 GOTO 4760,4780
4760 IF snum=4 THEN RETURN
IF MID$(sortp$,p,1)<>"0" THEN RETURN
snum=snum+1
MID$(sortp$,p,1)=RIGHT$(STR$(snum),1)
PRINT STR$(snum);
RETURN
4780 m$=MID$(sortp$,p,1):IF m$="0" THEN RETURN
snum=VAL(m$)-1
FOR x=1 TO 9
IF VAL(MID$(sortp$,x,1))>snum THEN
MID$(sortp$,x,1)="0"
LOCATE x+4,65:PRINT " ";
END IF
NEXT x
RETURN
'** PRINT **
4800 LOCATE 17,2:INPUT"HOW MANY COPIES";cop
sp=INSTR(sortp$,"1"):GOSUB 5000
OPEN "O",#7,"Par:"
FOR y=1 TO cop:FOR x=1 TO recn
GET 2,orig(x):GOSUB 710
IF name1=1 THEN GOSUB 720
IF job=1 THEN
PRINT #7,a$(1):PRINT #7,a$(3)
p=INSTR(a$(5)," "):PRINT #7,LEFT$(a$(5),p+1);
PRINT #7,a$(6)
PRINT #7,"":PRINT #7,"":PRINT #7,""
END IF
IF job=2 THEN
PRINT #7,a$(1):PRINT #7,a$(2)
PRINT #7,a$(3):PRINT #7,a$(4)
p=INSTR(a$(5)," "):PRINT #7,LEFT$(a$(5),p+1);
PRINT #7,LEFT$(a$(6),9);:PRINT #7,a$(7):PRINT #7,""
END IF
IF job=3 THEN
l=0
PRINT #7,""
FOR bit=1 TO 9
IF pfield AND bin(bit) THEN
PRINT #7,a$(bit)" ";
l=l+LEN(a$(bit))
END IF
IF bit=2 THEN
PRINT #7,"("orig(x)")";
END IF
IF bit=7 OR l>69 THEN PRINT #7,"":PRINT #7," ";:l=0
NEXT bit
END IF
NEXT x,y
CLOSE #7
LOCATE 17,2:PRINT SPACE$(20);
ERASE sort$:ERASE orig
RETURN
'** SORT ROUTINE **
5000 DIM sort$(LOF(2)/262),orig(LOF(2)/262)
recn=0
FOR y=1 TO snum
a(y)=INSTR(sortp$,RIGHT$(STR$(y),1))
NEXT y
ON recsel GOSUB 5100,5200,5300,5400
5015 IF sp=0 THEN RETURN
5020 change=0
FOR x=1 TO recn-1
IF sort$(x)<=sort$(x+1) THEN 5050
change=1:SWAP orig(x),orig(x+1)
SWAP sort$(x),sort$(x+1)
5050 NEXT x
5060 IF change THEN 5020
RETURN
5100 FOR x=1 TO 10
IF choose(x)=0 THEN RETURN
recn=recn+1
GET 2,choose(x):GOSUB 710:orig(x)=choose(x)
IF sp THEN
sort$(x)=""
FOR y=1 TO snum
sort$(x)=sort$(x)+UCASE$(a$(a(y)))
NEXT y
END IF
NEXT x:RETURN
5200 book=-1:x=1
5205 IF book=4 THEN RETURN
book=book+1
5215 IF x>LOF(2)/262 THEN RETURN
5220 cpos=INSTR(x-(book*245),index$(fpos,book),LEFT$(search$,1))
IF cpos=0 THEN x=((book+1)*246):GOTO 5205
x=cpos+(book*245)
GET 2,x
GOSUB 455
IF search$=UCASE$(LEFT$(fstr$,LEN(search$))) THEN GOSUB 710 ELSE 5280
recn=recn+1:orig(recn)=x
IF sp THEN
sort$(recn)=""
FOR y=1 TO snum
sort$(recn)=sort$(recn)+UCASE$(a$(a(y)))
NEXT y
END IF
5280 x=x+1
GOTO 5220
5300 GET 2,1
FOR x=1 TO LOF(2)/262-1:GOSUB 710
FOR look=1 TO 9
p=INSTR(UCASE$(a$(look)),search$)
IF p=0 THEN 5380
recn=recn+1:orig(recn)=x
IF sp THEN
sort$(recn)=""
FOR y=1 TO snum
sort$(recn)=sort$(recn)+UCASE$(a$(a(y)))
NEXT y
END IF
look=9
5380 NEXT look
GET 2
NEXT x
RETURN
5400 GET 2,1
FOR x=1 TO LOF(2)/262
recn=LOF(2)/262
GOSUB 710:orig(x)=x
IF sp THEN
sort$(x)=""
FOR y=1 TO snum
sort$(x)=sort$(x)+UCASE$(a$(a(y)))
NEXT y
END IF
GET 2
NEXT x:RETURN
6000 GOSUB 2040:RESUME
'********* gettext **************
'This is a subprogram that takes
'characters from the keyboard and
'puts them on the screen.
'Includes keyboard features of the
'Basic Editor
SUB gettext(lines,topx,topy,wide,a$(),cur,bc) STATIC
l=1:p=1:c=cur
FOR x=1 TO lines
IF a$(x)="" THEN a$(x)=SPACE$(wide)
NEXT x
GOSUB putcursor:
getkey:
IF MOUSE(0)<0 THEN
IF MOUSE(1)>(topy-1)*8 THEN
IF MOUSE(1)<(topy+wide)*8 THEN
IF MOUSE(2)>(topx-1)*8 THEN
IF MOUSE(2)<(topx+lines-1)*8 THEN
c=bc:GOSUB putcursor:c=cur
p=INT(MOUSE(1)/8)-topy+2
l=INT(MOUSE(2)/8)-topx+2
GOSUB putcursor
END IF
END IF
END IF
END IF
END IF
a$=INKEY$
IF a$="" THEN getkey
IF a$=CHR$(27) THEN
c=bc:GOSUB putcursor
EXIT SUB
END IF
IF a$=CHR$(13) THEN
IF l=lines THEN BEEP:GOTO getkey
c=bc:GOSUB putcursor:c=cur
p=1:l=l+1:GOTO 100
END IF
IF a$=CHR$(8) THEN
IF p>1 THEN
c=bc:GOSUB putcursor:c=cur
p=p-1
a$(l)=LEFT$(a$(l),p-1)+MID$(a$(l),p+1)+" "
LOCATE topx+l-1,topy
PRINT a$(l)
GOTO 100
ELSE
GOTO getkey
END IF
END IF
ON INSTR(CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),a$)GOTO up,down,right,left
IF p>wide THEN BEEP:GOTO getkey
IF RIGHT$(a$(l),wide+1-p)=SPACE$(wide+1-p) THEN
MID$(a$(l),p,1)=a$
LOCATE topx+l-1,topy+p-1
PRINT a$;
ELSE
a$(l)=LEFT$(a$(l),p-1)+a$+MID$(a$(l),p,wide-p)
LOCATE topx+l-1,topy
PRINT a$(l)
END IF
p=p+1
100 :
GOSUB putcursor
GOTO getkey
up:
IF l=1 THEN BEEP:GOTO getkey
c=bc:GOSUB putcursor:c=cur
l=l-1:GOTO 100
down:
IF l=lines THEN BEEP:GOTO getkey
c=bc:GOSUB putcursor:c=cur
l=l+1:GOTO 100
right:
IF p>wide THEN BEEP:GOTO getkey
c=bc:GOSUB putcursor:c=cur
p=p+1:GOTO 100
left:
IF p=1 THEN BEEP:GOTO getkey
c=bc:GOSUB putcursor:c=cur
p=p-1:GOTO 100
putcursor:
LINE((topy+p-2)*8,(topx+l-2)*8)-((topy+p-2)*8,(topx+l-2)*8+6),c
RETURN
END SUB
'****** requester subprogram *********
SUB requester(flag,topx,topy,message$,win,choice0$,choice1$)STATIC
SHARED answer
IF flag%=1 THEN alreadyopen
WINDOW 3,"requester",(topx%,topy%)-(topx%+180,topy%+32),2
alreadyopen:
WINDOW OUTPUT 3
LOCATE 1,1:PRINT message$
LINE(4,13)-(76,24),2,bf
LINE(92,13)-(164,24),2,bf
LOCATE 3,6-INT(LEN(choice0$)/2):PRINT choice0$;
LOCATE 3,16-INT(LEN(choice1$)/2):PRINT choice1$;
choose3:
IF MOUSE(0)>-1 THEN choose3
IF MOUSE(1)<4 THEN choose3
IF MOUSE(1)>164 THEN choose3
IF MOUSE(2)<4 THEN choose3
IF MOUSE(2)>24 THEN choose3
answer=INT((MOUSE(1)-8)/72)
WINDOW OUTPUT win
END SUB