Compucolor.org – Virtual Media

Listing of file='WHISIT.BAS;01' on disk='vmedia/chip_128-sector.ccvf'

100 REM    CUVIC CUVIC CUVIC CUVIC CUVIC CUVIC CUVIC CUVIC
102 REM
104 REM !  XXXXXXX       WHERE IS IT ?                XXXXXXX
106 REM
108 REM    THIS PROGRAM ALLOWS YOU TO LIST ITEMS ,  WHERE
110 REM    THEY ARE  OR WHO HAS BORROWED THEM, KEEP A  FILE
111 REM    AND TO PRINT THE LIST
112 REM
114 REM      WRITTEN BY - P.J.STUCKEY  20 - 6 - 82
116 REM       COMPUCOLOR/INTECOLOR USERS GROUP VICTORIA 
118 REM  P.O. BOX 420, CAMBERWELL, VICTORIA, AUSTRALIA, 3124
120
200 CLEAR 500
210 FILE "T",1540
220 NIL= 0
230 OPEN= 0
240 FOR I= 1TO 1000:NEXT
250
260 REM  =========   MAIN MENU
270
280 PLOT 12,15:PRINT :PRINT :PRINT
290 PRINT " WHERE IS IT - A PROGRAM TO HELP YOU KEEP TRACK OF THINGS."
300 PRINT "               EACH FILE HAS SPACE FOR 25 ITEMS."
310 PRINT
320
330 PRINT "     1 -     RETRIEVE LOCATION  FILES "
340 PRINT "     2 -     INSERT NEW RECORD       "
350 PRINT "     3 -     DELETE RECORD           "
360 PRINT "     4 -     CREATE NEW FILE         "
370 PRINT "     5 -     VIEW RECORDS            "
380 PRINT "     6 -     FINISH WITH FILE        "
385 PRINT
390 INPUT "CHOICE ";ACT:IF (1> ACT)OR (6< ACT)THEN 260
400 ON (ACT)GOTO 410,440,460,480,500,530
410 INPUT " FILE NO (DEF=1) ";FO:IF FO= 0THEN FO= 1
420 OPEN= 1
430 GOSUB 1230:GOTO 260
440 IF OPEN= 0THEN PRINT "NO FILES OPEN ":GOTO 240
450 GOTO 560
460 IF OPEN= 0THEN 440
470 GOSUB 1410:GOSUB  700:GOTO 260
480 IF  OPEN= 0 THEN GOSUB 1080:GOTO 260
490 PRINT "ALREADY HAVE AN OPEN FILE ,FINISH IT AND THEN TRY":GOTO 240
500 IF  OPEN= 0 THEN  440
510 INPUT "TO PRINTER ? ";YY$:IF YY$= "Y"THEN GOSUB 1300:GOTO 260
520 GOSUB 1410:PRINT :PRINT :INPUT "RETURN TO CONT";YY$:GOTO 260
530 PUT  1,1;NXT,FRAE
540 FILE "C",1:OPEN= 0:INPUT "CONTINUE ? ";YY$:IF YY$= "Y"THEN 260
550 END
560 INPUT " DATE DD-MM-YY ";DATE$
570 DATE$= LEFT$ (DATE$+ "        ",8)
580 PRINT "           -----------------------------":PLOT 28
590 INPUT " ITEM NAME ";ITEM$:ITEM$= LEFT$ (ITEM$+ "                             ",29)
600 INPUT " OK>";YY$:IF YY$= "N"THEN 580
610 PRINT "                           -------------------------":PLOT 28
620 INPUT "LOCATION OR  BORROWER NAME ";BRR$:BRR$= LEFT$ (BRR$+ "                         ",25)
630 INPUT " OK>";YY$:IF YY$= "N"THEN 610
640 SS$= DATE$+ " "+ ITEM$+ " "+ BRR$
650 PRINT SS$
660 INPUT " INSERT IT ? ";YY$:IF YY$= "N"THEN 260
670 GOSUB 840
680 GOTO 260
690
700 REM  ========= CHOOSE ITEM AND DELETE IT
710
720 IF COUNT= 0THEN RETURN
730 PLOT 3,0,28:PRINT "----------------------------------------------------------------":PLOT 28
740 PRINT " LEFT ARROW = UP:RIGHT ARROW = DOWN:HOME = DELETE:OTHER = ABORT";
750 PLOT 3,0,6
760 N= 1
770 POKE 33278,0
780 Y= PEEK (33278):IF Y= 0THEN 780
790 IF Y= 26THEN PLOT 25,- 28* (N< > 1):N= N+ 1* (N< > 1):GOTO 770
800 IF Y= 25THEN PLOT 26,- 10* (N< > COUNT):N= N- (N< > COUNT):GOTO 770
810 IF Y= 8THEN GOTO 920
820 PLOT 3,0,4+ N:PRINT :PRINT "ABORT ":FOR I= 1TO 700:NEXT :RETURN
830
840 REM  ========== PLACE AN ITEM IN THE LIST
850
860 TEMP= FRAE:GET  1,FRAE;FRAE
870 IF TEMP= NILTHEN PRINT "CANT INSERT ITEM ; FILE IS FULL":GOTO 240
880 PUT 1,TEMP;NXT,SS$[64]
890 NXT= TEMP
900 RETURN
910
920 REM  ==========  DELETE NTH ITEM
930
940 PLOT 3,0,4+ N:PRINT
950 INPUT "CONFIRM>";YY$:IF  YY$= "N" THEN  RETURN
960 TEMP= NXT
970 IF  N= 1 THEN  THERE= NXT:GET 1,THERE;NXT:GOTO 1050
980 IF N= 2THEN 1020
990 FOR I= 1TO N- 2
1000 GET 1,TEMP;TEMP
1010 NEXT
1020 GET 1,TEMP;THERE:REM  ITEM TO BE DELETED
1030 GET 1,THERE;HERE:REM  NEXT ITEM ON LIST
1040 PUT 1,TEMP;HERE:REM  POINT AROUND ITEM
1050 PUT 1,THERE;FRAE:FRAE= THERE:REM  PLACE ON FREE LIST
1060 RETURN
1070
1080 REM  ===========  SET UP FILE
1090
1100 FILE "N","DAT.BOR",25,68,25
1110 FILE "R",1,"DAT.BOR",4
1120 FRAE= 25:NXT= NIL
1130 PUT 1,1;NXT,FRAE
1140 PUT 1,2;NIL
1150 FOR I= 3TO 25
1160 PUT 1,I;I- 1,"                                                                "[64]
1170 NEXT
1180 FILE "C",1
1190 PRINT "NEW FILE CREATED AND INITIALIZED"
1200 FOR I= 1TO 700:NEXT
1210 RETURN
1220
1230 REM  ============  RETRIEVE FILE
1240
1250 D$= "DAT.BOR;"+ STR$ (FO)
1260 FILE "R",1,D$,4
1270 GET 1,1;NXT,FRAE
1280 RETURN
1290
1300 REM  ============  OUTPUT TO PRINTER
1310
1320 INPUT "TURN PRINTER ON";YY$
1330 PRT= 1
1340 PLOT 27,18,4,27,13
1350 GOSUB 1440
1360 POKE 33265,0
1370 INPUT "TURN PRINTER OFF";YY$
1380 PRT= 0
1390 RETURN
1400
1410 REM  ============  PRINT FILE OUT
1420
1430 PLOT 12,15
1440 PRINT :PRINT :PRINT :PRINT
1450 PRINT "DATE    - ITEM NAME                  - LOCATION OR BORROWER NAME"
1460 COUNT= 0:IF NXT= 0THEN RETURN
1470 TEMP= NXT
1480 GET  1,TEMP;GARBAGE,SS$[64]
1490 PRINT SS$;CHR$ (28* (1- PRT))
1500 COUNT= COUNT+ 1
1510 GET 1,TEMP;TEMP:IF TEMP< > NILTHEN 1480
1520 RETURN
1530
1540 REM  =============  ERROR TRAP
1550
1560 FILE "E",NO,ER,LN
1570 OPEN= 0
1580 IF ER= 14THEN PRINT "THE FILE SPECIFIED  DOES NOT EXIST":GOTO 240
1590 PRINT "FCS ERROR -DISK MAY BE CORRUPTED "
1600 PRINT "IN LINE NO . ";LN;"  OF TYPE NO ";ER
1610 GOTO 240