0001 ! visicm2    PICHERET PEIRE  PPCT211 PPCP309 10/02/85 VERs 21/1/87
0002 ! necessite les ROM VISICALC et hp75 I/O 
0010 INTEGER P,C,R,F5,V5,V0,F1,X0,Y0,X1,Y1,Z0,Z1,Z2,S1,S4,S5,S6,S7
0020 RCLVAR
0030 T2$=CHR$(13)&"����������������" @ M2=0
0040 DIM B0$[96],M$[96],T$[96]
0060 OPTION BASE 1
0061 DIM P1(4,4),P2(2),Q(4)
0062 INTEGER T0,T8,T,T2,T3(6)
0063 M1=100 @ GOSUB 8795
0064 T=GETSTATUS(0) @ ON K GOSUB 115,116,117,118,119
0065 PUTSTATUS 0,T
0066 FOR M=1 TO 2
0067 FOR N=1 TO 4
0070 READ P1(M,N)
0071 NEXT N
0072 NEXT M
0075 GOTO 151
0080 DATA 250,279,5050,4200,850,479,4850,3140
0082 DATA 250,4000,5050,7479,850,4220,4850,6879
0084 DATA 5250,279,10250,4200,5850,479,9850,3140
0086 DATA 5250,4000,10250,7479,5850,4220,9850,6879
0101 DATA 250,279,5050,7479,850,1079,4850,6679
0104 DATA 5250,279,10250,7479,5850,1079,9850,6679
0107 DATA 250,279,10250,4200,1850,479,9850,3140
0110 DATA 250,4000,10250,7479,1850,4220,9850,6879
0112 !
0113 DATA 250,279,10250,7479,1850,1079,9850,6679
0115 RESTORE 113 @ T=0 @ RETURN
0116 RESTORE 101 @ T=120 @ RETURN
0117 RESTORE 107 @ T=121 @ RETURN
0118 RESTORE 80 @ T=122 @ RETURN
0119 IF T=0 THEN 63 ELSE GOSUBX T @ GOTO 65
0120 RESTORE 104 @ T=0 @ RETURN
0121 RESTORE 110 @ T=0 @ RETURN
0122 RESTORE 82 @ T=123 @ RETURN
0123 RESTORE 84 @ T=124 @ RETURN
0124 RESTORE 86 @ T=0 @ RETURN
0151 !
0155 IF PRT$#":G1" THEN P1$=PRT$ @ PRINTER IS ":G1"
0400 DEF FNP7(X) = 2*PI*X/U1
0401 DEF FNP8(X,Y)
0421 IF 0#POS("NAERROR",GETVALUE$(X,Y,1)) THEN FNP8=0 @ GOTO 451
0426 FNP8=VAL(GETVALUE$(X,Y,1))
0451 END DEF
0487 !
0491 DEF FNP9(X,Y) ! CALCUL du PAS GRADUTIONS
0492 D=-1*(MAX((X-Y)/X,Y/X)/2-1)
0493 D=D*(X/10^INT(LOG10(X)))
0494 DATA 5,6,8,10,12,16,20,25,50,60,80,100
0495 RESTORE 494 @ FOR Y=1 TO 12 @ READ L @ L=L/10
0496 IF D<L THEN 498
0497 NEXT Y
0498 FNP9=L*10^(INT(LOG10(X))-1)
0499 END DEF
0500 M1=80 @ GOSUB 8795 @ T=K
1010 M$=MESSAGE$(95)
1020 B0$=COORD$(C,0,S5)
1030 GOSUB 9115 @ T0=0
1040 T0=COL(B0$)
1060 IF NOT T0 THEN BEEP @ GOTO 1010
1061 IF T=3 THEN T8=T0 @ GOTO 1115
1070 M$=MESSAGE$(97)
1080 B0$=COORD$(MAXCOL,0,S5)
1090 GOSUB 9115 @ T8=0
1100 T8=COL(B0$)
1110 IF NOT T8 THEN BEEP @ GOTO 1070
1115 M$=MESSAGE$(94)
1120 FOR T2=1 TO 6
1130 IF T2=1 THEN B0$=COORD$(0,R,S5) ELSE B0$=CHR$(T2+64)
1140 GOSUB 9115 @ IF B0$=CHR$(T2+64) THEN T2=T2-1 @ GOTO 1500
1150 IF ROW(B0$) THEN T3(T2)=ROW(B0$) ELSE 1130
1160 NEXT T2 @ T2=T2-1
1500 !
1510 GOSUB 5000 @ IF T=3 THEN 3500
1670 T4=FNP9(U1,U)
1680 T9=T4*CEIL(U1/T4)
1690 T1=0
2000 !
2100 !
2102 GOSUB 9983
2104 P1(3,1)=T0
2105 P1(3,2)=T1
2106 P1(3,3)=T8+.8
2107 P1(3,4)=T9
2108 GOSUB 6038
2110 FOR Q1=0 TO 2 STEP 2
2111 !
2113 P2(1)=P1(3,Q1+1)
2114 P2(2)=P1(3,Q1+2)
2115 GOSUB 6700 @ NEXT Q1
2121 GOSUB 6600
2129 !
2130 FOR M=T0 TO T8 @ U=P1(3,2)
2131 FOR N1=1 TO T2
2132 IF T=2 THEN 2140
2133 P2(1)=M @ P2(2)=U @ Q1=0 @ GOSUB 6700 @ GOSUB 4170
2134 P2(1)=M+.8 @ A=T3(N1) @ P2(2)=FNP8(M,A)+U @ U=P2(2) @ Q1=2 @ GOSUB 6700 @ GOTO 2144
2140 P2(1)=M+(N1-1)*(.8/T2) @ P2(2)=U @ Q1=0 @ GOSUB 6700 @ GOSUB 4170
2141 P2(1)=M+N1*(.8/T2) @ A=T3(N1) @ P2(2)=FNP8(M,A) @ Q1=2 @ GOSUB 6700
2144 GOSUB 6500
2145 NEXT N1
2146 NEXT M
2210 FOR M=T1 TO T9 STEP T4
2220 P2(1)=P1(3,1) @ P2(2)=M @ Q1=0 @ GOSUB 6700
2230 PRINT "PA";Q(1);Q(2);"YT;"
2240 PRINT "CP-8,-.25;LB";M;CHR$(3)
2250 NEXT M
2251 U=INT((P1(2,3)-P1(2,1))/T2) @ FOR N1=1 TO T2
2252 Q(1)=P1(2,1)+U*(N1-1) @ Q(2)=P1(2,4)+100
2253 Q(3)=Q(1)+MIN(1000,U/2) @ Q(4)=Q(2)+200 @ GOSUB 6500
2254 PRINT "pa";Q(1);Q(2)
2260 PRINT "CP1,1.2;LB";GETLABEL$(0,T3(N1));CHR$(3) @ NEXT N1
2270 PRINT "pa";(P1(2,1)+P1(2,3))/2;P1(2,4);"SI";L9/5;H9/5
2280 PRINT "CP";-LEN(ACTIVE$)/2;1;"LB";ACTIVE$;CHR$(3)
2499 GOTO 9990
2500 !
3000 ! GRAPH X,Y
3010 !
3489 GOTO 9990
3499 !
3500 P1(3,1)=-1.1 ! CAMEMBERT
3530 P1(3,2)=-1
3540 P1(3,3)=1.756
3550 P1(3,4)=1
3560 GOSUB 6038
3565 P2(1)=0 @ P2(2)=0 @ Q1=0 @ GOSUB 6700 @ PRINT "PA";Q(1);Q(2);"PD"
3570 FOR O1=0 TO 2*PI+PI/20 STEP PI/20
3580 P2(1)=COS(O1) @ P2(2)=SIN(O1) @ Q1=0 @ GOSUB 6700
3590 PRINT "PA";Q(1);Q(2);"PD"
3600 NEXT O1 @ PRINT "PU";
3605 N=T0 @ P2(1)=0 @ P2(2)=0 @ Q1=0 @ GOSUB 6700 @ A=0
3607 FOR N1=1 TO T2
3610 GOSUB 7000 @ U=A+T1/2
3615 P2(1)=COS(FNP7(U))
3616 P2(2)=SIN(FNP7(U)) @ Q1=2 @ GOSUB 6700
3618 IF FNP7(U)<PI/2 OR FNP7(U)>PI*1.5 THEN K=1 ELSE K=-9
3619 PRINT "PA";Q(3);Q(4);
3620 PRINT "CP";K;0;"LB";GETLABEL$(0,T3(N1));" ";STR$(IP(T1/U1*100));"%";CHR$(3)
3625 A=A+T1
3635 P2(1)=COS(FNP7(A))
3640 P2(2)=SIN(FNP7(A)) @ Q1=2 @ GOSUB 6700
3650 PRINT "PA";Q(1);Q(2);"PD";Q(3);Q(4);"PU"
3670 NEXT N1 @ PRINT "SI";L9/7;H9/7;"PA";P1(2,1);P1(2,4);"CP1,1";
3675 PRINT "LB";GETLABEL$(T0,0);CHR$(3)
3999 GOTO 2270
4170 IF N1#1 THEN RETURN
4171 PRINT "PA";Q(1);Q(2);"XT;"
4190 PRINT "CP-.33,-1;LB";GETLABEL$(M,0);CHR$(3) @ RETURN
5000 !
5010 T1=0
5020 U=INF @ U1=EPS
5030 FOR N=T0 TO T8
5040 T4=0
5050 FOR N1=1 TO T2
5060 GOSUB 7000
5070 IF U>T1 THEN U=T1
5080 T4=T4+T1
5090 IF T#2 THEN 5110
5100 IF U1<T1 THEN U1=T1
5110 NEXT N1
5120 IF T=2 THEN 5140
5130 IF U1<T4 THEN U1=T4
5140 NEXT N @ RETURN
6000 !   INITIALISATION                
6038 X2=(P1(3,3)-P1(3,1))/(P1(2,3)-P1(2,1)) @ P1(4,1)=P1(3,1)-X2*(P1(2,1)-P1(1,1))
6040 X3=(P1(3,4)-P1(3,2))/(P1(2,4)-P1(2,2)) @ P1(4,2)=P1(3,2)-X3*(P1(2,2)-P1(1,2))
6041 P1(4,3)=P1(3,3)+X2*(P1(1,3)-P1(2,3))
6042 P1(4,4)=P1(3,4)+X3*(P1(1,4)-P1(2,4))
6060 PRINT "IN;VS10;IP p1(1,1),p1(1,2),p1(1,3),p1(1,4)"
6070 L9=2 @ H9=3 ! @ PRINT "SI",L9/10,H9/10,";"
6080 PRINT "SP1;"
6090 RETURN
6100 !
6500 ! Hachures
6510 !
6511 PRINT "IW";Q(1);Q(2);Q(3);Q(4)
6520 FOR Y=Q(2)-(Q(3)-Q(1)) TO Q(4) STEP 100*SQR(N1)
6530 PRINT "PU";Q(1);Y;"PD";Q(3);Y+(Q(3)-Q(1))
6540 NEXT Y
6550 PRINT "PU;IW;"
6599 !  trace la boite x1,y1 ; x2,y2
6600 !
6620 PRINT "PA;PU";Q(1);Q(2)
6622 PRINT "PA;PD";Q(3);Q(2);Q(3);Q(4);Q(1);Q(4);Q(1);Q(2)
6623 PRINT "PU";
6640 RETURN
6700 ! P2(x.y)en unit utilisateur sont transforme en unit plotter , charger dans q(1+q1,2+q1)
6701 FOR O=1 TO 2
6711 P2(O)=(P1(1,2+O)-P1(1,O))/(P1(4,2+O)-P1(4,O))*(P2(O)-P1(4,O))+P1(1,O)
6721 NEXT O
6722 Q(1+Q1)=INT(P2(1)) @ Q(2+Q1)=INT(P2(2))
6723 RETURN
6731 !
7000 A$=GETVALUE$(N,T3(N1),1) @ T1=POS("NAERROR",A$) @ IF T1#0 THEN T1=0 ELSE T1=VAL(A$)
7010 RETURN
8790 !
8795 IF NOT M2 THEN M2=M1+1
8796 SETWIN @ DISP MESSAGE$(M1);": ";MESSAGE$(M2) @ T$=UPRC$(CHOICE$(M2)) @ M2=0
8810 K$=WAITKEY$(-1) @ K=POS(T$,UPRC$(K$)) @ IF K THEN RETURN
8830 IF POS("��",K$) THEN POP ELSE 8810
8835 IF K$="�" THEN P=0
8852 GOTO 9990
8853 !
9115 SETWIN @ DISP M$;": "; @ CLRLCD LEN(M$)+3
9121 W0,P0=1 @ F0=0
9123 SETWIN LEN(M$)+3
9125 K$=INLINE$(B0$,W0,P0,T2$,F0)
9130 B0$=INPBUF$ @ W0=INPWIN @ P0=INPPTR @ F0=IRFLAG @ L=LEN(B0$)+1
9180 K=POS(T2$,K$) @ IF K>3 THEN 9123
9210 IF K=1 THEN RETURN
9220 IF K=2 THEN POP @ GOTO 9990
9230 IF K=3 THEN POP @ P=0 @ GOTO 9990
9399 RETURN
9982 IF V0 THEN CURSOFF
9983 SETWIN @ DISP MESSAGE$(2) @ RETURN
9990 PRINT "sp;" @ PRINTER IS DSP$ @ V5=3 @ STOVAR @ END