0010 ! BAR713 codes È barre HP-41 sur HP-71/Thkjet, LaserJet ou HP82905
0020 ! (c)Michael Markov, adaptation Eric Gengoux V3.0 16/04/1987.
0030 ! LEX: JPCLEX
0040 DESTROY ALL @ DIM A$[32],F$[32]
0050 H5=0
0060 INPUT "Octets/Ligne? ","13";R6 @ R6=MAX(MIN(13,R6-3),1)
0070 INPUT "Lignes/Pg,Hauteur? ","24,26";H6,H7
0080 IF H5 THEN 620 ELSE H=0 @ H8=0 @ H9=0 @ LC OFF
0090 PWIDTH INF @ DIM O$[1290]
0100 INPUT "Thinkjet/Hp82905 ? ","T";Q$ @ H8="T"=UPRC$(Q$)
0110 IF NOT H8 THEN O1$=HTA$('FFFFFFFFFFFF')&HTA$('00000000') @ O0$=O1$[5] ! RÅglage 82905B
0120 INPUT "Fichier ? ";F$
0130 P=POS(F$,":") @ IF NOT P THEN F$=RTRIM$(F$)&":TAPE:1" @ GOTO 130
0140 D$=UPRC$(F$[P]) @ D=DEVADDR(D$)
0150 L=POS(F$,":",P+1) @ IF L THEN L=VAL(F$[L+1]) ELSE L=1
0160 F$=F$[1,P-1] @ F$[11]=CHR$(224)&CHR$(128)
0170 SEND L; UNT UNL MTA LISTEN D DDL 4 DATA 0,2 UNL ! Recherche DIR et adresse fichier
0180 WAIT 5 ! ArrÁt progr. pendant les recherches sur cassette
0190 SEND L; UNL UNT TALK D DDT 2 
0200 ENTER :D:L USING "#,32A";A$
0210 IF NUM(A$)=255 THEN DISP "Fichier non trouvÅ" @ BEEP @ END 
0220 IF POS(A$,F$)#1 THEN 200
0230 SEND L; UNT MTA LISTEN D DDL 4 DATA A$[15,16] UNL 
0240 L0=NUM(A$[29])*256+NUM(A$[30]) @ DIM P$[L0]
0250 P9=BINAND(NUM(A$[31]),1) ! Bit PRIVATE armÅ si P=1
0260 STD @ M$="#,"&STR$(L0)&"A"
0270 WAIT 5 ! Lecture fichier HP-41 dans variable P$
0280 SEND L; TALK D DDT 2 @ ENTER :D:L USING M$;P$
0290 SEND L; UNT UNL LISTEN D SDC UNL 
0300 ! Analyse par lignes (selon type) du programme HP-41 ("parse")
0310 P$[L0]=CHR$(47) @ GOTO 620
0320 B=NUM(P$[R0]) @ B1=NUM(P$[R0+1]) @ B2=NUM(P$[R0+2])
0330 X=1+(B>143)+(B>207)
0340 IF B>239 THEN X=B-239 ! Instr. alpha
0350 IF B>28 AND B<32 THEN X=MAX(2,B1-238) ! XEQ/GTO/W globaux
0360 IF B>191 AND B<206 AND B2>240 THEN X=B2-237 ! Labels globaux
0370 IF B>191 AND B<206 AND B2<241 THEN X=3 ! .END.
0380 IF B>15 AND B<29 THEN GOSUB 400 ! Instr. numÅriques
0390 L2=L2+(B#0) @ R0=R0+X @ RETURN 
0400 N=R0+1
0410 B9=NUM(P$[N,N]) @ N=N+1
0420 IF B9>15 AND B9<29 THEN X=X+1 @ GOTO 410 ELSE RETURN 
0430 IF H8 THEN PRINT CHR$(14)&ESC$('&l8D'); ELSE PRINT ESC$('0')&ESC$('E'); ! Bits rangÅe code
0440 PRINT F$[1,10];L0;'Octets'
0450 H5=1 @ L2=1 @ L1=1 @ R0=1 @ M1=0 @ M2=0 @ C=0 @ T=16*(1+P9)
0460 IF H8 THEN PRINT ESC$('*r1280S'); ! Graph. hte. densitÅ
0470 FOR I=1 TO L0 STEP R6 @ E=MIN(L0,I+R6-1) @ B$=P$[I,E]
0480 M1=MIN(R6,R0-I)
0490 IF R0<E+1 THEN GOSUB 320 @ GOTO 490
0500 M2=(X+E-R0+1)*(E+1#R0) @ R=CEIL(I/R6)
0510 B$=CHR$(T+MOD(R-1,16))&CHR$(M1*16+M2)&B$
0520 FOR K=1 TO LEN(B$) @ C=C+NUM(B$[K,K]) ! Checksum
0530 C=MOD(C+INT(C/256),256) @ NEXT K
0540 B$=CHR$(C)&B$
0550 IF R9 AND R<>R9 THEN 600
0560 IF H9 THEN H$=ATH$(B$,1) ELSE H$=""
0570 PRINT USING '"ROW ",3D,"   Lignes",4D,"-",4D,3X,33A';R;L1;L2-1;H$
0580 GOSUB 680 @ IF R=R9 THEN 620
0590 IF NOT MOD(R,H6) THEN PRINT CHR$(12) ! Nbre. ROWs/page
0600 L1=(R0=E+1)+L2-1
0610 NEXT I
0620 R9=0 @ DISP "Fin/Tout/Ligne/Hex ";
0630 IF H9 THEN DISP "on" ELSE DISP "off"
0640 BEEP @ ON POS("FTLHM",UPRC$(KEYWAIT$))+1 GOTO 640,670,430,660,650,60
0650 H9=NOT H9 @ GOTO 620
0660 INPUT "Ligne #? ";R9 @ GOTO 450
0670 DISP @ PWIDTH 80 @ END 
0680 IF NOT H8 THEN 800 ELSE O$='7070' ! Routine THINKJET
0690 FOR A=1 TO LEN(B$)
0700 FOR A0=7 TO 0 STEP -1
0710 IF SBIT(B$,A,A0) THEN O$=O$&'7F0' ELSE O$=O$&'70'
0720 NEXT A0 @ NEXT A
0730 O$=O$&'7F07' @ IF MOD(LEN(O$),2) THEN O$=O$&'0'
0740 O$=HTA$(O$,1)
0750 ENDLINE '' @ PRINT CHR$(27)&'*rA';
0760 FOR H=1 TO H7 ! Hauteur barres
0770 PRINT ESC$('*b'&STR$(LEN(O$))&'W')&O$;
0780 NEXT H @ PRINT ESC$('*b1W')&CHR$(0)&ESC$('*b1W')&CHR$(0)
0790 ENDLINE @ PRINT CHR$(27)&'*rB'; @ RETURN 
0800 O$=O0$&O0$ @ FOR A=1 TO LEN(B$) ! Routine HP82905
0810 FOR A0=7 TO 0 STEP -1
0820 IF SBIT(B$,A,A0) THEN O$=O$&O1$ ELSE O$=O$&O0$
0830 NEXT A0 @ NEXT A @ O$=O$&O1$&O0$ @ C2=LEN(O$)
0840 PRINT ESC$('&l9D') ! Lignes jointives (esp. 9 points)
0850 PRINT ESC$('&k2S') ! Graphique mode condensÅ
0860 FOR H=1 TO H7 DIV 8 @ PRINT CHR$(27)&'*b';C2;'G';O$ @ NEXT H
0870 PRINT ESC$('&k0S') @ PRINT ! Titre ROW mode normal
0880 RETURN