"Histo 3D" for Sharp PC-1500 + CE-150
� Hebdogiciel, Shift editions.
Author : Thierry DOMBLIDES
Published in Hebdogiciel #23, March 1984.
BASIC program - 3328 bytes.
CLOAD "HISTO 3D"
RUN
----- BASIC program -----------------------------------------
1 "HISTO 3D"
2 "Hebdogiciel No 23"
7 GOTO 150
10 "INIT"GRAPH :SORGN :COLOR 0
20 DATA -1,0,0,-100,150,-100,200,-180,50,-180,0,-100,-1,0,50,-180,50,-260
30 DATA -1,0,0,-100,0,-260
80 RESTORE
90 ON ERROR GOTO 125
100 READ X,Y
105 IF X<0READ X,Y:GLCURSOR (X,Y):GOTO 120
110 LINE -(X,Y)
120 GOTO 90
125 COLOR 3:A=15,B=65
130 FOR I=1TO 9
135 LINE (A,-100)-(B,-180)
136 A=A+15,B=B+15
140 NEXT I
145 RETURN
150 "A"CLEAR :WAIT 64:PRINT "*******HISTO.3D*******"
160 BEEP 3,100,64:DIM HA(6),HA$(6)*16:DR=0
170 INPUT "TITRE DU GRAPHE:";A$
175 COLOR 3
180 LPRINT "******************"
190 LO=LEN A$,PL=INT ((18-LO)/2)
200 COLOR 2:LCURSOR PL:LPRINT A$
210 TEXT :COLOR 3:LPRINT "******************"
220 BEEP 2,50,64
230 CLS :WAIT 0:PRINT "VALEUR Max :":CURSOR 12:INPUT MAX
235 IF MAX<0GOTO 230
240 GOSUB "INIT"
250 COLOR 1:CSIZE 1
260 ROTATE 1:X=0,VA=0,PAS=MAX/10
270 FOR I=0TO 10
275 GLCURSOR (X,-55):LPRINT USING "#####.#";VA
280 X=X+15,VA=VA+PAS
290 NEXT I
295 CLS :BEEP 3,55,64:WAIT 0
300 PRINT "Nbre Matieres (<7):":CURSOR 19:INPUT NO
310 IF NO>6GOTO 295
311 CLS :INPUT "Nbr de rangees:";RA
312 GOSUB "LEGENDE"
315 FOR TY=1TO RA
320 E=150/MAX,N=1,DX=50/NO,DY=DX/.625
330 GOSUB "VAL"
340 COLOR 1
345 HA(1)=V*E
350 LINE (0,-260)-(HA(1),-260)
360 LINE (0,-280)-(HA(1),-280)
365 D1=0,D2=-280
370 D1=D1+DX,D2=D2-DY
380 LINE (D1,D2)-(D1+HA(1),D2)
390 LINE (HA(1),-260)-(HA(1),-280)
400 LINE -(HA(1)+D1,D2)
410 LINE -(HA(1)+D1,D2+20)
420 LINE -(HA(1),-260)
425 LINE (0,-260)-(0,-280)
430 LINE -(DX,-280-DY)
435 GLCURSOR (D1-5,D2-15):LPRINT HA$(1)
437 GLCURSOR (D1+90,D2+DY+40):CSIZE 2:LPRINT STR$ TY
440 G=1
450 FOR I=2TO NO
455 N=I
460 GOSUB "VAL"
470 G=G+1:IF G>3LET G=0
480 COLOR G
490 HA(I)=V*E
491 LINE (D1,D2)-(D1+DX,D2-DY)
492 D1=D1+DX,D2=D2-DY
493 LINE -(D1+HA(I),D2):LINE -(D1+HA(I)-DX,D2+DY)
495 GLCURSOR (D1-2*DX/3,D2-15):CSIZE 1:LPRINT HA$(I)
500 IF HA(I)<HA(I-1)GOSUB "INF"
510 IF HA(I)>HA(I-1)GOSUB "SUP"
520 IF HA(I)=HA(I-1)GOSUB "="
600 NEXT I
610 COLOR 0:LINE (D1,D2)-(D1,D2-160)
615 DR=1
620 LINE (0,D2-160)-(0,D2+20+NO*DY):SORGN
900 NEXT TY
910 TEXT :LF 17:END
1000 "VAL"CLS
1005 IF TY>1GOTO 11000
1010 BEEP 3,55:WAIT 0:PRINT "Valeur colonne No"+STR$ N+":"
1020 CURSOR 20:INPUT V
1030 IF V>MAXOR V<0CLS :GOTO 1005
1031 IF TY>1GOTO 1040
1035 CLS :INPUT "Libelle colonne:";HA$(N)
1040 RETURN
2000 "INF"
2005 KL=20*.625
2007 IF HA(I-1)-HA(I)>=KLGOTO 2010
2008 GOTO "INF+"
2010 IF 20<=DYLINE (D1+HA(I),D2)-(D1+HA(I),D2+20):GOTO 2030
2020 LINE (D1+HA(I),D2)-(D1+HA(I),D2+DY):GOTO 2060
2030 LINE (D1+HA(I),D2+20)-(D1-DX+HA(I)+20*0.625,D2+DY)
2060 RETURN
3000 "="
3005 IF NO>4AND HA(I-2)>HA(I-1)GOTO "=SUP"
3010 LINE (D1+HA(I),D2)-(D1+HA(I),D2+20)
3020 LINE -(D1-DX+HA(I),D2+DY+20)
3030 RETURN
4000 "SUP"
4010 IF NO>4GOTO 6000
4020 LINE (D1+HA(I),D2)-(D1+HA(I),D2+20)
4021 LINE -(D1-DX+HA(I),D2+DY+20)
4022 LINE -(D1-DX+HA(I),D2+DY)
4023 LINE -(D1-DX+HA(I-1),D2+DY)
4024 LINE (D1-DX+HA(I),D2+DY+20)-(D1-DX+HA(I-1),D2+DY+20)
4060 RETURN
5000 "INF+"
5010 LINE (D1+HA(I),D2)-(D1+HA(I),D2+20)
5020 LINE -(D1-DX+HA(I-1),D2+DY+20-(HA(I-1)-HA(I))/0.625)
5030 GOTO 2060
6000 IF HA(I-1)>=HA(I-2)GOTO 4020
6010 IF HA(I)>=HA(I-2)GOSUB "S"
6020 IF HA(I)<HA(I-2)GOSUB "SS"
6030 GOTO 4060
7000 "S"
7010 LINE (D1+HA(I),D2)-(D1+HA(I),D2+20)
7020 LINE -(D1-DX+HA(I),D2+DY+20)
7030 LINE -(D1-DX+HA(I),D2+DY)
7040 LINE -(D1-DX+HA(I),D2+DY)
7050 LINE (D1-DX+HA(I),D2+DY+20)-(D1-2*DX+HA(I-2),D2+DY+20)
7060 RETURN
8000 "SS"
8010 LINE (D1+HA(I),D2)-(D1+HA(I),D2+20)
8020 LINE (D1-DX+HA(I),D2+DY)-(D1-DX+HA(I),D2+DY)
8025 IF OP=1GOTO 8040
8030 LINE (D1-DX+HA(I),D2+DY)-(D1-DX+HA(I),D2+2*DY)
8040 LINE (D1+HA(I),D2+20)-(D1-DX+HA(I)+5,D2+2*DY)
8045 IF OP=1LET OP=0:RETURN
8050 RETURN
9000 "LEGENDE"
9010 CSIZE 1:COLOR 2:ROTATE 1
9020 GLCURSOR (200,-20):LPRINT "LEGENDE"
9030 COLOR 3:LINE (195,-15)-(195,-65)
9035 DD=170
9040 FOR P=1TO RA
9045 BEEP 2,64
9050 CLS :WAIT 0:PRINT "LEGENDE No"+STR$ P+":":CURSOR 12:INPUT LE$
9060 COLOR 1:GLCURSOR (DD,15):CSIZE 2:LPRINT STR$ P
9070 COLOR 3:GLCURSOR (DD,0):CSIZE 1:LPRINT LE$
9080 DD=DD-25
9090 NEXT P
9200 RETURN
10000 "=SUP":OP=1
10010 GOSUB 8010
10020 GOTO 3030
11000 CLS :WAIT 0
11001 BEEP 2,100
11002 IF LEN HA$(N)>6LET PO$=LEFT$ (HA$(N),6)+".":GOTO 11010
11005 PO$=HA$(N)
11010 PRINT "Ran.:"+STR$ TY+" /Col:"+PO$+":"
11020 CURSOR 20:INPUT V
11030 GOTO 1030
