1 REM Ins{nd av: Stefan Lennerbrant <4364>    1987-01-04 16.52.55 (WRITE)
10 !
20 ! cp - litet kopieringsprogram - anv{nder FNArgin()
25 ! F|r ABC800-serien
30 ! 
40 ! Stefan Lennerbrant  <4364>   86-08-06   (86-08-07)
50 ! 
51 ! Snabbinfo...
52 ! 
53 ! Programmet kopierar filer.
54 ! Anrop sker med "RUN CP", varefter man matar in namnet p} fr}n-fil
55 ! och till-fil, eller med "RUN CP,fr}nfil tillfil", d} dessa filer kopieras
56 ! Man kan {ven skriva "RUN CP,fr}nfil tillfil fr}nfil tillfil...", vilket
57 ! kopierar f|rsta fr}nfil till f|rsta tillfil, andra fr}nfil till andra 
58 ! tillfil o.s.v.
59 ! Programmet s{ger till om n}got g}r galet.
60 ! Om man framf|r fr}n-fil skriver ett utropstkn ("!"), tas fr}nfilen bort
61 ! efter kopieringen
62 ! 
63 ! Syftet med CP {r att det ska vara ett exempel till funktionen
64 ! FNArgin(), vilken tar reda p} vilka "argument" som angetts om man
65 ! skriver "RUN CP,arg1 arg2 arg3...", s} programmet CP {r kanske inte
66 ! speciellt bra i sig, det nedskrevs i all hast.
67 ! 
68 ! Lycka till med egna FNArgin()-program, det {r ganska stiligt att kunna
69 ! anv{nda UNIX p} ABC800...
70 ! 
71 ! (Ett exempel p} anv{ndningsomr}de {r n{r man i PROG-1 vill CHAIN:a till
72 ! PROG-2, varefter PROG-2 ska CHAIN:a tillbaka
73 ! F|r att PROG-2 ska veta till vilket program det ska hoppa, kan man i
74 ! PROG-1 anropa med CHAIN "PROG-2,PROG-1", varefter PROG-2 letar upp
75 ! argumentet "PROG-1" och CHAIN:ar dit sedan...)
76 ! 
77 ! 
100 INTEGER : EXTEND 
110 DIM Inf$=160,Utf$=160,Q$=253
120 IF FNArgin OR Argc/2.<>INT(Argc/2.) ; 'cp: Bad arguments.' : GOTO 380
130 Argpos=0
140 ! 
150 IF Argc IF Argpos>=Argc GOTO 380 ELSE Inf$=Argv$(Argpos) : Utf$=Argv$(Argpos+1) : Argpos=Argpos+2
160 IF Inf$='' INPUT 'Infil: ("!"-rm)',Inf$
170 IF LEFT$(Inf$,1)='!' Inf$=RIGHT$(Inf$,2) : Rm=1 ELSE Rm=0
180 ON ERROR GOTO 190 : OPEN Inf$ AS FILE 1 : GOTO 210
190 ; 'cp: Error' ERRCODE; : IF Argc ; 'at ' Inf$ ' & ' Utf$ ELSE ; 
200 GOTO 380
210 IF Utf$='' INPUT 'Utfil:        ',Utf$
220 ON ERROR GOTO 240 : OPEN Utf$ AS FILE 2
230 ; 'cp: File ' Utf$ ' exists. Do you want to replace ? '; : POKE 65506,0 : GET S$ : IF INSTR(1,'YyJj',S$)=0 ; 'No' : GOTO 380 ELSE ; 'Yes'
240 PREPARE Utf$ AS FILE 2
250 ! 
260 ON ERROR GOTO 320
270 ; : ; 
280 Var=0
290 POSIT #1,Var*253 : GET #1,Q$ COUNT 253
300 PUT #2,Q$
310 Var=Var+1 : ; Inf$ ' -> ' Utf$ TAB(70) Var+1 CHR$(13); : GOTO 290
320 CLOSE 
330 ; 
340 IF ERRCODE<>38 ; 'cp: Copy failed. Error' ERRCODE
350 IF Argc=0 IF ERRCODE=38 ; 'cp: Copy ready'
360 IF Rm ; 'cp: Do you really want to remove ' Inf$ ' ? '; : POKE 65506,0 : GET S$ : IF INSTR(1,'YyJj',S$) ; 'Yes' : KILL Inf$ ELSE ; 'No'
370 IF Argc GOTO 150
380 ; : CHAIN 'nul:'
390 DEF FNArgin LOCAL Arg$=0,I,I1,I2
400   Argc=0
410   I=CALL(81)+1
420   I1=0
430   IF PEEK(I+I1)<>13 I1=I1+1 : GOTO 430
440   POKE VAROOT(Arg$),I1,SWAP%(I1),I,SWAP%(I),I1,SWAP%(I1)
450   I=INSTR(1,Arg$,',') : IF I=0 OR I=LEN(Arg$) RETURN 0 ELSE Arg$=RIGHT$(Arg$,I+1)
460   Arg$=FNFixsp$(Arg$)
470   IF Arg$='' RETURN 0
480   I=0 : I2=0
490   I1=I+1 : Argc=Argc+1 : I=INSTR(I1,Arg$,' ') : IF I I2=FNMax(I2,I-I1) : GOTO 490 ELSE I2=FNMax(I2,LEN(Arg$)+1-I1)
500   DIM Argv$(Argc-1)=I2 ! -1 f|r b|rjar med 0
510   I1=-1
520   I1=I1+1 : I=INSTR(1,Arg$,' ') : IF I Argv$(I1)=LEFT$(Arg$,I-1) : Arg$=RIGHT$(Arg$,I+1) : GOTO 520
530   Argv$(I1)=Arg$
540   RETURN 0
550 FNEND 
560 DEF FNFixsp$(In$) LOCAL In$=160,Ut$=160
570   Ut$=In$
580   IF LEN(Ut$) IF LEFT$(Ut$,1)=' ' Ut$=RIGHT$(Ut$,2) : GOTO 580
590   IF LEN(Ut$) IF RIGHT$(Ut$,LEN(Ut$))=' ' Ut$=LEFT$(Ut$,LEN(Ut$)-1) : GOTO 590
600   IF LEN(Ut$)=0 RETURN ''
610   I=1
620   I=INSTR(I,Ut$,' ')
630   IF I=0 RETURN Ut$
640   I=I+1
650   IF MID$(Ut$,I,1)=' ' Ut$=LEFT$(Ut$,I-1)+RIGHT$(Ut$,I+1) : GOTO 650
660   GOTO 620
670 FNEND 
680 DEF FNMax(X1,X2)
690   IF X1>X2 RETURN X1 ELSE RETURN X2
700 FNEND