1 REM +++++++++++++++++++++++++++++++++
2 REM ! Program ....   LIBCASPR.BAS   !
3 REM ! Utgave  5.0    30-10-82       !
4 REM ! av (c) JAN KRISTENSEN         !
5 REM ! endret av JAN KRISTENSEN      !
6 REM ! Minne 16 Kbytes               !
7 REM ! Innsendt av JAN KRISTENSEN    !
8 REM +++++++++++++++++++++++++++++++++
9 REM 
10 REM Dette er en forandring av
11 REM program >KASSMENY.BAS<. N}
12 REM skriver programmet ut blocknr.
13 REM 
14 REM 
15 REM  VARIABEL-LISTE 
16 REM 
17 REM A9$ E3$ F$() F9$ L$() L1$() L%()        A2$() P9% A9% Q% I% G$ C$ S X() T       L% A% C% J% A8$ G% A2$
18 REM F% S% K% L$ Y% T1% T% Y1% Y3% A1$       A$ V9% Z% E9% H9% B9% T9% Q9% L9%       I9% N9%
19 REM 
20 REM 
21 REM 
22 REM   7460 byte  
23 REM 
24 REM 
25 REM 
26 REM  INITIERING 
27 REM 
28 DIM A9$=0%,E3$=7%,F$(40%)=5%,F9$=5%,L$(40%),L1$(40%),L%(40%),A2$(40%)
29 P9%=PEEK(65065%)+SWAP%(PEEK(65066%)) : POKE P9%+4%,253%,0%,3%,0%,253%,0% : P9%=P9%+7% : E3$=STRING$(6%,0%)+CHR$(3%)
30 A9%=PEEK(948%)+SWAP%(PEEK(949%))+1% : A9%=PEEK(A9%) : POKE 65408%,205%,A9%,5%,208%,111%,201% : POKE 65017%,0%,0%
31 DEFFNK=((PEEK(-526%) XOR 255%)*256%+(PEEK(-527%) XOR 255%))*5.12+(PEEK(-528%) XOR 255%)/50%
32 REM  MENY 
33 ; CHR$(12%)TAB(15%)'KASSETTMENY' : ; TAB(14%)'=============' : ; : ; 'HVILKEN KASSETT TYPE ER DET ?' : ; 
34 ; '1 = PHILIPS  C60' : ; '2 = PHILIPS  C90' : ; '3 = MAXELL   C46' : ; '4 = MAXELL   C60' : ; '5 = MAXELL   C90'
35 ; '6 = BASF     C60' : ; '7 = AGFA     C60' : ; '8 = CORONET  C60' : ; '9 = GJSNITT  C60' : ; '10= GJSNITT  C90'
36 ; '11= ABCKLUBB CAS' : ; CUR(5%,20%)'P.S. HVIS DU HAR'CUR(6%,20%)'EN TYPE KASSETT'CUR(7%,20%)'SOM IKKE ER HER'
37 ; CUR(8%,20%)'S] KAN DU LAGE NYE'CUR(9%,20%)'PARAMETER FOR DEN'CUR(10%,20%)'MED >KASSMENY.DAT<'
38 ; CUR(22%,0%)'#NR. I KOLLONE FOR BLOCK ER FEILCODE'
39 ; CUR(18%,0%)'VELG TYPE'; : ONERRORGOTO 39 : INPUT Q% : IF Q%<1% OR Q%>11% 39
40 REM  VALG AV KASSETT-TYPE 
41 ON Q% GOSUB 80,81,82,83,84,85,86,87,88,89,90 : ; CHR$(12%); : FOR I%=1% TO 20% : ; CUR(I%,0%)CHR$(151%); : NEXT I%
42 FOR I%=2% TO 78% : SETDOT 3%,I% : SETDOT 61%,I% : NEXT I% : FOR I%=3% TO 61% : SETDOT I%,2% : SETDOT I%,78%
43 NEXT I% : ; CUR(5%,2%)'HUSK ] START KASSETT P] 5OOOj'CUR(7%,2%)'STOPP S\KINGEN MED 5Cj'
44 ; CUR(10%,2%)'TRYKK 5RETURNj S] STARTER S\KINGEN'; : GET G$ : ; CUR(10%,2%)SPACE$(37%);
45 ; CUR(21%,0%)C$CUR(0%,3%)'NR. LOCNR.  NAVN    FIL BLOCK  TID'CUR(21%,14%)'>KASSETT-MENY<    JK-1982'
46 ; CUR(5%,2%)SPACE$(36%)CUR(7%,2%)SPACE$(37%); : POKE 65008%,-1%,-1%,-1% : REM  NULLSTILL KLOKKEN 
47 GOTO 92 : REM  RUTINE FOR FILNAVN/                     FEILKODE OG BLOCK
48 REM  UTREGNING AV LOCNR. 
49 S=-X(2%)/X(3%)/2%+SQR((X(2%)/X(3%)/2%)^2%-((X(1%)-(T-2.983))/X(3%))) : L%=S+.5 : A%=A%+1% : C%=C%+1%
50 IF C%<10% ; CUR(A%+1%,3%)CHR$(135%)C%; : GOSUB 66 : GOTO 52
51 IF C%<100% ; CUR(A%+1%,2%)CHR$(135%)C%; : GOSUB 66
52 J%=J%+1% : L$(J%)=A8$ : L%(J%)=L% : RETURN 
53 IF G%=1% GOSUB 73 : ; CUR(A%+1%,31%)CHR$(135%)A2$CHR$(151%); : A2$(J%)=A2$ : G%=0% : RETURN 
54 GOSUB 73 : ; CUR(A%+1%,31%)CHR$(135%)A2$CHR$(151%); : A2$(J%)=A2$ : RETURN 
55 OUT 58%,0% : POKE 65013%,0% : A%=A%+1%
56 ; CUR(22%,0%)SPACE$(79%)CUR(22%,0%)'PRINTER (J/N)?'; : GET G$ : ; G$ : IF G$='J' OR G$='j' F%=1% ELSE F%=0%
57 ONERRORGOTO 57 : ; CUR(22%,25%)'TABULERING'; : INPUT S% : ; CHR$(12%) : OPEN 'PR:' ASFILE F% : ; #F%TAB(S%)C$
58 ; #F%TAB(S%)' NR. LOCNR.   NAVN    FIL BLOCK  TID' : ; #F%TAB(S%)STRING$(37%,61%)
59 FOR K%=1% TO J% : IF F%=0% IF K%>16% GET G$
60 L1$(K%)=RIGHT$(NUM$(L%(K%)),2%)
61 IF L%(K%)<10% GOSUB 70 : L1$(K%)='00'+L1$(K%) : ; #F%'   'L1$(K%)'    '+L$(K%)'  '+F$(K%); : GOSUB 69 : GOTO 64
62 IF L%(K%)<100% GOSUB 70 : L1$(K%)='0'+L1$(K%) : ; #F%'   'L1$(K%)'    '+L$(K%)'  '+F$(K%); : GOSUB 69 : GOTO 64
63 GOSUB 70 : ; #F%'  'L%(K%)'    '+L$(K%)'  '+F$(K%); : GOSUB 69 : GOTO 64
64 NEXT K% : ; #F%TAB(S%)STRING$(37%,61%) : ; #F% : ; #F% : ; #F% : CLOSE F%
65 ; 'EN LISTE TIL (J/N) ?'; : GET G$ : ; G$ : IF G$='J' 56 ELSE IF G$='N' END ELSE 65
66 L$=RIGHT$(NUM$(L%),2%) : IF L%<10% L$='00'+L$ : L1$(C%)=L$ : ; TAB(8%)L$; : RETURN 
67 IF L%<100% L$='0'+L$ : L1$(C%)=L$ : ; TAB(8%)L$; : RETURN 
68 L1$(C%)=L$ : ; TAB(7%)L%; : RETURN 
69 ; #F%'  'A2$(K%) : RETURN 
70 IF K%<10% ; #F%TAB(S%)' 'K%; : RETURN 
71 ; #F%TAB(S%)K%; : RETURN 
72 REM ** UTREGNING AV TIDEN PR. FIL
73 Y%=(T1%-T%)/60% : Y1%=Y%*60%
74 Y3%=(T1%-T%)-Y1% : A1$=NUM$(Y3%) : A1$=RIGHT$(A1$,2%) : IF Y3%<10% A1$='0'+A1$ ELSE A1$=A1$
75 A$=NUM$(Y%) : A2$=A$+'.'+A1$ : RETURN 
76 REM ** RUTINE FOR T\MMING AV SKJERM            HVIS DET ER FLER EN 18 FILER            P] EN KASSETT **
77 FOR I%=2% TO 19% : ; CUR(I%,2%)SPACE$(37%); : NEXT I%
78 ; CUR(2%,3%)CHR$(135%)'18  'L1$(J%)TAB(14%)L$(J%)'  'F$(J%)' 'A2$(J%)CHR$(151%); : A%=1% : G%=1% : RETURN 
79 REM *** DATA FOR DIV. KASSETTER ***
80 C$='PHILIPS C60' : X(1%)=-.739 : X(2%)=1.74963 : X(3%)=.001614 : RETURN 
81 C$='PHILIPS C90' : X(1%)=-.3948 : X(2%)=1.75383 : X(3%)=.001165 : RETURN 
82 C$='MAXELL C46' : X(1%)=-.3751 : X(2%)=1.73557 : X(3%)=.001835 : RETURN 
83 C$='MAXELL C60' : X(1%)=-.3217 : X(2%)=1.74412 : X(3%)=.001231 : RETURN 
84 C$='MAXELL C90' : X(1%)=-.6207 : X(2%)=1.72126 : X(3%)=.001875 : RETURN 
85 C$='BASF C60' : X(1%)=-.2159 : X(2%)=1.73865 : X(3%)=.001713 : RETURN 
86 C$='AGFA C60' : X(1%)=-.7139 : X(2%)=1.73454 : X(3%)=.001765 : RETURN 
87 C$="CORONET C60" : X(1%)=-.329 : X(2%)=1.77496 : X(3%)=.00141 : RETURN 
88 C$='GJSNITT C60' : X(1%)=-.5501 : X(2%)=1.74752 : X(3%)=.001652 : RETURN 
89 C$='GJSNITT C90' : X(1%)=-.3704 : X(2%)=1.75097 : X(3%)=.001187 : RETURN 
90 C$='ABCklubb CAS' : X(1%)=-.4469 : X(2%)=1.72582 : X(3%)=.001605 : RETURN 
91 REM *** RUTINE FOR FILNAVN/FEILKODE             OG BLOCK ***
92 V9%=65535%
93 IF (INP(56%) AND 95%)=67% 55
94 Z%=CALL(65408%) : E9%=Z% AND 255% : Z%=Z% AND 65280% : POKE P9%,SWAP%(Z%) : H9%=PEEK(Z%)
95 B9%=PEEK(Z%+1%)+SWAP%(PEEK(Z%+2%)) : IF V9%<>65535% GOTO 101
96 IF E9% OR H9%<>255% OR B9%<>65535% 93
97 IF A%=18% GOSUB 77
98 REM *** FILNAVN ***
99 A8$=LEFT$(A9$,8%)+'.'+MID$(A9$,9%,3%) : ; CUR(A%+2%,13%)CHR$(135%)A8$CHR$(151%);
100 T=FNK : T%=(T+.5)-2% : GOSUB 49 : GOSUB 123 : V9%=V9%+1% : GOTO 93
101 IF (E9% OR H9% OR B9%<>V9%)=0% 106
102 IF B9%<>0% AND T9%=4% 105
103 REM *** FEILKODE ***
104 F$(J%)='#'+RIGHT$(NUM$(E9% AND 127%),2%) : ; CUR(A%+1%,27%)CHR$(135%)F$(J%)CHR$(151%);
105 V9%=65535% : GOTO 96
106 GOSUB 123 : V9%=V9%+1% : IF B9%=0% Q9%=PEEK(Z%+3%) ELSE 110
107 IF (Q9% OR 1%)=131% T9%=1% : GOTO 110
108 IF Q9%=0% T9%=3% : GOTO 110
109 IF Q9%<128% T9%=2% ELSE T9%=4%
110 ON T9% GOSUB 112,115,117,121 : IF L9%=1% F$(J%)=F9$ : T1%=INT(FNK+.5) : GOSUB 53 : GOTO 47
111 GOTO 93
112 IF B9%=0% I9%=2% ELSE I9%=1%
113 L9%=ASC(MID$(A9$,I9%,1%)) : IF L9%<2% RETURN 
114 I9%=I9%+L9% : GOTO 113
115 IF LEFT$(A9$,7%)=E3$ L9%=1% : RETURN 
116 L9%=0% : RETURN 
117 I9%=1%
118 L9%=ASC(MID$(A9$,I9%,1%)) : IF L9%=255% L9%=0% : RETURN 
119 N9%=ASC(MID$(A9$,I9%+1%,1%)) : IF N9%=0% L9%=1% : RETURN 
120 I9%=I9%+N9%+8% : GOTO 118
121 L9%=0% : RETURN 
122 REM *** UTSKRIFT AV BLOCK ***
123 F9$=' '+NUM$(B9%+2%) : F9$=RIGHT$(F9$,LEN(F9$)-2%) : ; CUR(A%+1%,27%)CHR$(135%)F9$CHR$(151%); : RETURN