1 REM * PROGRAM : BILDKONSTRUKTION F\R OLIKA LINSTYPER ************************ 2 REM * 1984-07-11 PER SVALIN ********* 3 REM * F\R FYSIK I ]K 8 GRH ********** 4 REM * F]R UTNYTTJAS AV DE SOM S] VILL 5 REM * VINJETT *********************** 6 GOSUB 185 7 REM * PROGRAMSTART ****************** 8 ; CHR$(7,12) 9 REM * INLEDANDE TEXT *************** 10 GOSUB 72 11 IF X$='[' OR X$='{' THEN 12 ELSE 14 12 REM * F\RKLARINGAR ***************** 13 GOSUB 58 14 REM * DIMENSIONERINGAR ************* 15 DIM A$=9 : DIM B$=15 : DIM C$=10 : DIM D$=30 : DIM E$=31 : DIM G$=22 : DIM H$=31 16 DIM F$=1 : DIM X$=1 : DIM Z$=1 17 REM * STYRVARIABLER ******************* KAN [NDRAS, OM S] \NSKAS *********** 18 F=0 : A%=0 : REM * BR[NNVIDDEN OCH AVST]NDET [R= 0 FR]N B\RJAN 19 R0%=20% : REM * OPTISKA AXELNS L[GE 20 K0%=30% : REM * LINSEN L[GE 21 H1=32 : REM * LINSENS H\JD 22 H3=12 : REM * F\REM]LETS H\JD 23 Q=53 : REM * STR]LEN RITAS TOM POS Q 24 D$='Bilden f}r ej plats p} sk{rmen' 25 E$='Str}larna {r parallella ' 26 G$='Avst}ndet lins-bild {r' 27 H$='Parametrarna kan EJ optimeras !' 28 REM ************************************************************************ 29 ; CHR$(12) : REM * LOOP-ING]NG **** 30 REM * SK[RMEN I GRAFISK MOD ******** 31 FOR I=0 TO 23 : ; CHR$(151) : NEXT I 32 ; CUR(18,0)STRING$(40,95) 33 REM * RITA OPTISK AXEL O. LINSMODELL 34 GOSUB 83 35 REM * INDATA -LINSENS BR[NNVIDD **** 36 GOSUB 101 37 REM * RITA OCH MARKERA LINSEN ****** 38 IF F>0 GOSUB 90 ELSE GOSUB 95 39 REM * INDATA -F\REM]LETS AVST]ND *** 40 GOSUB 114 41 REM * RITA F\REM]LET *************** 42 GOSUB 125 43 REM * RITA STR]LG]NGEN ************* 44 FOR I=1 TO 2000 : NEXT I : REM ******** V[NTA 2 SEKUNDER ****************** 45 GOSUB 132 46 REM * RITA OCH BESKRIV BILDEN ****** 47 FOR I=1 TO 2000 : NEXT I : REM ******** V[NTA 2 SEKUNDER ****************** 48 IF K9%<>0 AND FNR1(K9%)0 GOSUB 159 ELSE ; CUR(19,0);D$SPACE$(10) : ; CUR(20,0);G$;ABS(K0%-K8%)'cm' 49 IF A%=F ; CUR(20,0);E$ 50 REM * [NDRA LINS OCH/ELLER AVST]ND * 51 FOR I=1 TO 5000 : NEXT I : REM ******** V[NTA 5 SEKUNDER ****************** 52 GOSUB 175 53 IF F$=']' F$=' ' : GOTO 17 54 REM * SLUT P] HUVUDPROGRAMMET ****** 55 GOTO 29 56 REM ************************************************************************ 57 REM * SUBRUTIN F\R VINJETT [R PLACERAD I SLUTET **************************** 58 REM * SUBRUTIN : F\RORD ANG]ENDE [NDRING AV STYR-VARIABLERNA **************** 59 ; CHR$(12) 60 ; : ; 'Innan programmet startar,n}gra inledandeord om {ndringar av variabler.' 61 ; : ; 'Drygt halva sk{rmen utnyttjas f|r att rita p}.(Lins,f|rem}l,str}lg}ng och bild.)' 62 ; 'Vissa parametrar {r f|rvalda och l{ggs in vid programstart.' 63 ; 'De {r: Optiska axelns l{ge - rad 20' 64 ; TAB(7)'Linsens l{ge - kolumn 30' 65 ; TAB(7)'Linsens h|jd - 32' 66 ; TAB(7)'F|rem}lets h|jd - 12' 67 ; : ; 'I vissa l{gen kan det vara en f|rdel att{ndra n}gon/n}gra av dessa parametrar.' 68 ; 'Tryck i s} fall p} <[> (som i {ndra) n{rfrasen "Vill du {ndra ......" dyker upp d} bilden {r klar' 69 ; CUR(22,0)'Tryck p} s} k|r vi.' 70 ; CUR(22,35)'< >' : ; CUR(22,36); : GET X$ 71 IF X$=CHR$(13) RETURN ELSE 70 72 REM * SUBRUTIN F\R INLEDANDE TEXT ** 73 ; : ; TAB(12)'STR]LG]NG OCH' 74 ; : ; TAB(11)'BILDKONSTRUKTION' 75 ; : ; TAB(10)'F\R OLIKA LINSTYPER' 76 ; : ; : ; 'Du v{ljer br{nnvidd f|r linsen samt f|rem}lets avst}nd framf|r linsen.' 77 ; : ; 'Datorn ritar d} str}lg}ngen och bilden av f|rem}let.' 78 ; 'D{refter beskrives bilden kortfattat.' 79 ; : ; 'Vill du ha information om {ndringsm|jligheter, tryck p} <[>.' 80 ; CUR(22,0)'Tryck p} f|r start.' 81 ; CUR(22,35)'< >' : ; CUR(22,36); : GET X$ 82 IF X$=CHR$(13) OR X$='[' OR X$='{' THEN RETURN ELSE 81 83 REM * SUBRUTIN F\R OPTISKA AXELN *** 84 FOR K%=2% TO 79% : SETDOT R0%,K% : NEXT K% 85 REM * SUBRUTIN F\R LINSER ********** 86 R9%=R0%-H1/2 : R8%=R0%+H1/2 87 FOR R%=R9% TO R8% : SETDOT R%,K0% : NEXT R% 88 CLRDOT R0%,K0% : RETURN 89 REM ************************* F>0 * 90 R7%=R9%+3 : R6%=R8%-4 91 FOR R%=R7% TO R6% 92 SETDOT R%,K0%-1 : SETDOT R%,K0%+1 93 NEXT R% : RETURN 94 REM ************************* F<0 * 95 FOR R%=R9% TO R9%+4 96 SETDOT R%,K0%-1 : SETDOT R%,K0%+1 97 NEXT R% 98 FOR R%=R8%-5 TO R8% 99 SETDOT R%,K0%-1 : SETDOT R%,K0%+1 100 NEXT R% : RETURN 101 REM * SUBRUTIN F\R INDATA, BR[NNVIDD 102 IF K0%<41 K1%=K0%-5% ELSE K1%=78%-K0% : REM * K1% [R MAXIMAL BR[NNVIDD ***** 103 IF F=0 ; CUR(16,15);CHR$(135)'cm 'CHR$(151) : ; CUR(17,0);CHR$(135)'(Max.'K1%'cm)'CHR$(151) 104 ONERRORGOTO 104 105 ; CUR(16,0);CHR$(135)'Br{nnvidd'CHR$(151); 106 IF F=0 ; CHR$(135); : INPUT F : ; CHR$(151) 107 ; CUR(16,10);CHR$(135)'='F'cm 'CHR$(151) 108 IF ABS(F)>K1% ; CHR$(135)'F\R STOR BR[NNVIDD ! MAX.';K1%;CHR$(151) : F=0 : GOTO 104 109 ; CUR(17,0)SPACE$(40) 110 ; CUR(0,K0%/2-2)F : IF F>0 ; CUR(0,K0%/2-2)'+' : REM * MARKERA BR[NNVIDD * 111 ; CUR(0,K0%/2-3);CHR$(135) : ; CUR(0,K0%/2+1);CHR$(151) 112 CLRDOT R0%,K0%-F : CLRDOT R0%,K0%+F 113 RETURN 114 REM * SUBRUTIN F\R INDATA, F\REM]LS-AVST]ND FRAMF\R LINS ****************** 115 ; CUR(17,19);CHR$(135)'cm'CHR$(151) 116 ONERRORGOTO 116 117 ; CUR(18,0)CHR$(135)'(Max.'(K0%-3%)'cm)'CHR$(151) 118 ; CUR(17,0);CHR$(135)'F|rem}lsavst.'CHR$(151); 119 IF A%=0 ; CHR$(135); : INPUT A% : ; CHR$(151) 120 ; CUR(17,14);CHR$(135)'='A%'cm 'CHR$(151) 121 IF A%<=0 A%=0 : ; CUR(18,0)'AVST]NDET SKALL VARA POSITIVT !' : GOTO 114 122 IF (K0%-A%)<3 ; CHR$(135)'F\R STORT AVST]ND ! MAX'(K0%-3%)CHR$(151) : A%=0 : GOTO 118 123 ; CUR(18,0)STRING$(40,95) 124 RETURN 125 REM * SUBRUTIN F\R RITA F\REM]LET * 126 A1%=K0%-A% : REM * F\REM.KOORDINAT 127 IF F>0 AND A%F THEN K9%=(F*A1%-K0%*(K0%-A1%))/(F-K0%+A1%) ELSE K9%=0 : REM ******LINJERNAS SK[RNINGSPUNKT ************** 136 K8%=K9% : IF K9%<3% OR K9%>78% THEN K9%=0% 137 REM * STR]LE TILL LINS ************ 138 FOR K%=A1% TO K0% 139 SETDOT R0%-H2,K% : SETDOT FNR1(K%),K% : NEXT K% 140 REM * STR]LE FR]N LINS ************ 141 REM * F>0,A>F ******************** 142 IF F>0 THEN 143 ELSE 151 143 FOR K%=K0% TO 79% : SETDOT FNR1(K%),K% : SETDOT FNR2(K%),K% 144 IF FNR1(K%)>Q OR FNR2(K%)>Q THEN IF A%>F RETURN ELSE 146 145 NEXT K% : IF A%>F RETURN 146 REM * F>0,A<=F ******************* 147 FOR K%=K0% TO 3% STEP -2 148 IF FNR1(K%)<=1 OR FNR2(K%)<=1 THEN RETURN 149 SETDOT FNR1(K%),K% : SETDOT FNR2(K%),K% 150 NEXT K% : RETURN 151 REM * F<0,AF ************ 152 FOR K%=K0% TO 79% 153 IF FNR1(K%)<45 SETDOT FNR1(K%),K% 154 IF FNR2(K%)>1 SETDOT FNR2(K%),K% 155 NEXT K% 156 FOR K%=K0% TO 3% STEP -2 : SETDOT FNR2(K%),K% 157 IF FNR2(K%)>45 THEN RETURN 158 NEXT K% : RETURN 159 REM * SUBRUTIN F\R BILDRITNING **** 160 IF F>0 AND A%>F THEN FOR R%=R0% TO FNR1(K9%)-2 : SETDOT R%,K9% : NEXT R% 161 IF F>0 AND A%0 THEN FOR R%=FNR1(K9%)+2 TO R0% STEP 2 : SETDOT R%,K9% : NEXT R% 162 IF F<0 THEN FOR R%=FNR2(K9%)+1 TO R0% STEP 2 : SETDOT R%,K9% : NEXT R% 163 IF F>0 AND A%>F THEN SETDOT FNR1(K9%)-1,K9%+1 : SETDOT FNR1(K9%)-1,K9%-1 164 IF F>0 AND A%0 OR F<0 THEN SETDOT FNR1(K9%)+1,K9%+1 : SETDOT FNR1(K9%)+1,K9%-1 165 REM * KOMMENTAR ******************* 166 ; CHR$(7) 167 L1=ABS(R0%-FNR1(K9%)) : L=L1/H2*100 168 IF K9%H2 C$='f|rstorad' 173 ; CUR(19,0)'Bilden {r 'A$','B$' samt 'C$' ('INT(L)'%)';SPACE$(25) 174 RETURN 175 REM * SUBRUTIN F\R AVST]NDS[NDRING OCH BR[NNVIDDS[NDRING ***************** 176 ; CUR(21,0)'Vill du {ndra avst}ndet ( ), br{nnvidden( ) eller b}da ( )?' 177 POKE 32489,193 : POKE 32593,198 : POKE 32608,194 178 ; CUR(22,36)'( )' : ; CUR(22,37); : GET Z$ 179 IF ASC(Z$)>95 Z$=CHR$(ASC(Z$)-32) 180 IF Z$='F' F=0 181 IF Z$='A' A%=0 182 IF Z$='B' OR Z$=CHR$(13) F=0 : A%=0 183 IF Z$='[' 211 : REM * SUB-SUBRUTIN 184 RETURN 185 REM * VINJETT ********************* 186 T%=-1% 187 FOR I=1 TO 24 : ; : ; CHR$(151); : NEXT I 188 FOR R%=0% TO 22% 189 FOR K%=1% TO 39% 190 IF R%<3% OR R%>19% THEN 192 191 IF K%>4% AND K%<36% THEN 193 192 ; CUR(R%,K%); : IF T%>0% THEN ; 'f'; ELSE ; '9'; 193 NEXT K% : T%=-T% : NEXT R% 194 REM * TEXT INOM RAMEN ************* 195 ; CUR(11,12);CHR$(135)'STR]LG]NG'CHR$(151) 196 ; CUR(12,12);CHR$(135)'I LINSER'CHR$(151) 197 FOR F=1 TO 3000 : NEXT F 198 ; CUR(14,12);CHR$(135)'ETT PROGRAM FR]N'CHR$(151) 199 POKE 32693,212,207,198,212,193,160,205,193,212,197,205,193,212,201,195,193,204 200 POKE 31837,195,197,206,212,197,210 201 REM * FANFAR ********************** 202 FOR G=1 TO 3 203 OUT 6,251 : FOR F=1 TO 500 : NEXT F 204 OUT 6,3 : FOR F=1 TO 500 : NEXT F 205 OUT 6,249 : FOR F=1 TO 500 : NEXT F 206 OUT 6,1 : FOR F=1 TO 500 : NEXT F 207 NEXT G 208 OUT 6,0 : ; CHR$(7) 209 ; CHR$(135) 210 RETURN 211 REM * SUB-SUBRUTIN F\R [NDRING AV STYRVARIABLERNA ************************ 212 ; CHR$(12) 213 ; : ; '[NDRING AV STYRVARIABLER' 214 ; : ; 'Raden f|r optiska axeln ------R='R0%' (Normalt R=20 Min.5 Max.46)' 215 IF A% f|r }terst{llning till normalv{rden.' 222 IF F>0 AND A%<>F AND (K8%-A1%)<75 ; : ; 'Tryck p} f|r automatisk optimering av parametrarna.' 223 ; CUR(22,0)'Tryck p} s} forts{tter vi.' 224 IF R0%<35 H4=2*(R0%-3%) ELSE H4=2*(67-R0%) 225 IF R0%<5 OR R0%>46 THEN 235 226 IF K0%H4 THEN F$='L' : ; CHR$(7) : GOTO 237 230 IF H3>H1/2-2 THEN F$='F' : ; CHR$(7) : GOTO 238 231 ; CUR(22,35)'< >' : ; CUR(22,36); : GET F$ 232 IF F$=CHR$(13) RETURN 233 IF ASC(F$)>95 F$=CHR$(ASC(F$)-32) 234 ONERRORGOTO 231 235 IF F$='R' ; CUR(4,33)' ';CUR(4,32); : INPUT R0% : GOTO 223 236 IF F$='K' ; CUR(6,33)' ';CUR(6,32); : INPUT K0% : GOTO 223 237 IF F$='L' ; CUR(8,33)' ';CUR(8,32); : INPUT H1 : GOTO 223 238 IF F$='F' ; CUR(10,33)' ';CUR(10,32); : INPUT H3 : GOTO 223 239 IF F$=']' RETURN 240 IF F$='A' 241 ELSE 231 241 REM * SUB-SUBRUTIN F\R AUTOMATISK PARAMETEROPTIMERING ******************** 242 REM * F>0 A=F ******************** 243 IF F>0 AND A%=F THEN 259 244 REM * F>0 A>F ******************** 245 IF F>0 AND A%>F AND K8%-A1%<=75 THEN 246 ELSE 251 246 IF FNR1(K8%)>Q H3=H3*(Q-R0%)/(FNR1(K8%)-R0%) : H2=H3 247 R0%=19+Q-INT(FNR1(K8%)) : K0%=A%+4 248 IF R0%<=19 THEN H1=2*(R0%-3) 249 IF R0%<5 THEN 259 250 RETURN 251 REM * F>0 A0 AND A%46 THEN 259 255 RETURN 256 REM * F<0 AF ************ 257 GOTO 259 258 RETURN 259 ; CUR(21,2)H$CHR$(7) : POKE 32464,170 : POKE 32498,170 : GOTO 231 260 REM * SLUT * SLUT * SLUT * SLUT * **************************************** 261 REM * PROGRAMMET UPPTAR 14670 BYTESKVAR [R 433 BYTES ********************** 262 REM * JAG GRATULERAR ALLA SOM ORKATL[SA IGENOM HELA DETTA PROGRAM OCH DESS-UTOM BEGRIPIT DET.