Tom Jr. writes:
> Ric Merz wrote:
> >
> > Is this the same Basic/V that only allows 2 character data names (A1, A2,
> > etc) and doesn't support the "packed numbers" data format?
>
> It doesn't have a Long Integer either - just a Short Integer.
Almost all of the languages on the HP3000 support only a subset of the
datatypes that IMAGE uses. I spend my days looking at other peoples'
databases -- and I can tell virtually instantly what language the primary
application for the database was written in. COBOL-based databases are filled
with I, J, X, Z, and P dataitems, but no real numbers. In contrast, BASIC and
FORTRAN databases are populated generally onlywith I, X, and R fields.
Clearly, it would be better if all languages supported all datatypes, but
that's part and parcel of what the shared source program is all about. If you
now want an increased range of datatypes supported in BASIC, all you need do
is write the code and submit the modified source back to the "controlling
legal authority" [whoever that might be; I am actually a little unclear on
the details of the process :-)].
Nonetheless, BASIC's limitations shouldn't be taken as limitations. As long
as you have a CALL statement that allows you to call a
macroassembler/primitive programming language, you can do anything you need
to do. Traditionally, the macroassembler/primitive programming language has
been SPL on the HP3000.
Having BASIC on your resume is never going to do anyone any good, but if you
program from an engineering/business point of view, you're not as interested
in "geekiness" of the language that you're using. Rather, what you want to do
is lay down the most *behavior* you that you possibly can, in the shortest
period of time, and have it be as maintainable that you possibly can make it,
without requiring the employment of technical gurus. For those purposes,
BASIC is nearly the ideal upper level language.
I have for a very long time been enthusiastic about the notion of finite
state automata theory, for both the design of analog and digital hardware, as
well as software. Indeed, everything we've ever built here has been based
around the idea.
If you're familiar with the idea of Markov chains, then you are reasonably
familiar with the notions of finite state automata. The only difference is
that Markov chains are intrinsically an observational event; you have no idea
why the process changes state, all you do is simply measure and record the
probablity that it will change from its present state, and to which state it
will progress.
In FSA theory, the transition from state to state is most normally highly
deterministic, based on the presence of a signalling event. Virtually all
electronics instruments and real-time/event-driven programming practices
(such as HP's old RTE and Microsoft's VB) are built around the notion of FSA.
Further, I've always considered object-oriented programming practices to be a
subset of FSA.
However, after saying all of this, the idea is not complicated. An FSA
program exists in a hierarchy of layers, with the topmost being most normally
simply a "wait loop." Based on the input that the program receives in the
wait loop, the received command is directed to any one of a number of primary
behavior programs that sit just below the wait loop. These second-tier
primary behaviors can then call any number of highly modularized programs
that do one or a very few specific tasks, and no more. These task-specific
programs represent a third sublayer, with a fourth sublayer being the highly
optimized drivers and utilities.
While the upper two layers will represent about 95% of all of the code,
simply because they are the behavioral layers that create the program's
presentation to the world, the actual hard work of the program's processing
is done in the third- and fourth-level layers, and it's here that you spend
your time optimizing the code for maximal efficiency.
The upper layers tend to be supervisory -- and like any good supervisor, they
should do no real work themselves. Rather, they should simply walk around
with clipboard and pencil in hand and point out that this needs to be done,
and then that needs to be done, and in what order. The real work should be
done by the lower-level, highly optimized and efficient driver/utility drones.
This design architecture not only allows for very maintainable code that
tends to execute at very high speeds, it also allows for very high
plasticities (what biologists call "mosaic evolution"), such that major new
behaviors can be added (or dropped) without much affecting the whole of the
program -- while minimizing pleiotropies (interdependencies) in the code.
Bill Gates said a few years ago that he really loved Visual Basic, but that
it couldn't be used for the development of commercial products. I was
extremely disappointed to hear him say that, and a great portion of the
reason we put QCTerm together in VB was simply to demonstrate that Bill's
statement wasn't true. [However, when we first got QCTerm to begin to work,
it took something like 20 seconds to paint a screen -- and my heart sank. I
wasn't all that sure that we would ever get it to work fast enough. But now,
after a great deal of optimization and understanding of what was causing
those initital speed delays, QCTerm is faster than Reflection in every way
that we can measure].
QCTerm is programmed as a finite-state automaton. VB is the upper-level
supervisory code which calls a great number of APIs (intrinsics in HP3000
parlance).
QueryCalc, our primary product, is programmed in exactly the same way, being
composed of about 200 BASIC programs and 200 small, highly task-specific SPL
routines. Fifteen years ago, when we first began QueryCalc's design, we
looked at every language then available on the HP3000. BASIC easily won out
because it was not only the fastest high-level language availabe at the time,
it also has excellent string handling characteristics (which is an absolutely
necessary attribute for good user interface design) and a truly nice
BASIC-IMAGE interface.
But BASIC, as has been pointed out, also has some obvious deficiencies, so
almost immediately we wrote callable SPL subroutines to handle integers of
any reasonable length (I1, I2, I3, I4, etc.), as well as packed and zoned
numbers. Further, we found in our investigations that BASIC, in distinct
contrast to C, protects us too much, and thus file I/O is a little slow in
BASIC, and thus a good portion of the 200 SPL routines we wrote were for the
purposes of doing high-speed file transfers.
As long as I'm making this posting long, I've included below one module of
QueryCalc code -- now long obsolete -- that built color bitmaps inside the
HP3000 specifically for the then-popular HP PaintJet printers. We used to
have dozens of these routines for different printers before we adopted
PostScript as our primary printing language. This code is third-layer code
(in that it does some real work, but it is also supervisory in that it calls
the very low-level specific SPL routines that were written for this task; you
can see these routines peppered throughout the code)
This code is not only a good example of the mosaic evolutionary nature of the
design (major behaviors can be dropped in and out without affecting the
whole), it also exhibits two very important ideas in BASIC: code segmentation
and a COMMON area. The COMMON area is uniformly the same in all 200 QueryCalc
BASIC programs -- and represents both an easy data transfer mechanism between
programs (which might be called "pipes", and are the strings I$, I1$, I2$)
but it is also the finite state table(s) necessary to
FSA/real-time/event-driven programming. There is one table on page 3-6 in the
BASIC compiler manual that is so important to this idea that it should be
memorized. As you'll see on the chart, the COMMON area is static; the
segmented program local variables move up and down on the stack as necessary.
Nonetheless, after saying all of this, you don't need to worry about any of
this when you first start writing IMAGE-interactive programs in BASIC. Nor do
you need to curse the deficiencies of BASIC; given a proper architectural
design, you can do anything you wish.
Wirt Atmar
========================================
QCPJPIE
1000 REM **************************************************************
1010 REM
1020 REM QueryCalc Graphic routines
1030 REM
1040 REM Types: PaintJet Graphs
1050 REM
1060 REM 100%/Pie Chart
1070 REM
1080 REM **************************************************************
1090 COM I$[255],I1$[255],I2$[255],Q$[25,255],B$[30],F9$[2],N9$[30]
1100 COM P$[10,60],L9$[255],L8$[255],D$[10,60],B1$[30],P7$[10]
1110 COM INTEGER W[26,26],A[26],K0[26],J0[26],P7[26]
1120 COM R,C,X,Y,P,C1,E,M,W1
1130 COM LONG R0[6]
1140 COM C[20],F3$[6],F4$[6]
1150 COM R5[2340]
1160 COM INTEGER R6[26],K[3],P[8],M5,V5,U5,M0[5],F[40],G[26,3]
1170 REM **************************************************************
1180 DIM I3$[255],I4$[255],I5$[8,100],I6$[255],H$[100],L5$[10,50]
1190 DIM I9$[3,255],A$[255]
1200 DIM G1$[60],G2$[60],G3$[20]
1210 INTEGER X[4],X0,X1,Y1,Y4,Y9,C0[10],C1[10],F9,B9,T9[2700],B0,B1
1220 INTEGER G0,G5
1230 DIM X0[10],Y0[10],X1[10],Y1[10],X2[10],Y2[10]
1240 DIM D1[10],M1[10],M2[10],F1[10],F2[10],L0[10],L1[10]
1250 DIM X4[10],Y4[10],D4[10]
1260 MAT X=ZER
1270 DEF INTEGER FNM(X)=X
1280 REM **************************************************************
1290 REM Variables:
1300 REM
1310 REM R1 - Graph minimum
1320 REM R2 - Graph maximum
1330 REM W8 - Bar width
1340 REM W9 - Graph width
1350 REM D8 - No. of Data Points
1360 REM S8 - Graph Delta (Scale)
1370 REM S9 - Graph Spacing
1380 REM T9 - Type of Graph Spacing (0-Spaces at Top & Bottom)
1390 REM (1-No Spaces at T & B)
1400 REM D1[*] - Data
1410 REM D2[*] - Bar widths for X# of Data Points
1420 REM D4[*] - Direction for labels (0-leftwards, 1-rightwards)
1430 REM F1[*] - angle in radians of lesser pie border
1440 REM F2[*] - angle in radians of greater pie border
1450 REM Y0[*] - value of Y-offset to move pie segment outwards
1460 REM X0[*] - value of X-offset to move pie segment outwards
1470 REM Y1[*] - value of outer limits of lesser pie line (y)
1480 REM Y2[*] - value of outer limits of greater pie line (y)
1490 REM X1[*] - value of outer limits of lesser pie line (x)
1500 REM X2[*] - value of outer limits of greater pie line (x)
1510 REM X4[*] - location where label is to be written
1520 REM Y4[*] - location where label is to be written
1530 REM M1[*] - slope of lesser pie line
1540 REM M2[*] - slope of greter pie line
1550 REM L5$[*] - Data Point Labels (8 chars)
1560 REM G1$ - Graph Title
1570 REM T5 - Transparency flag (0 = normal, 1 = trancparency)
1580 REM G5 - First segment flag (0 = normal, 1 = >75%)
1590 REM
1600 REM **************************************************************
1610 CALL SHRINKSTACK(FNM(0))
1620 G1$=G2$=G3$=""
1630 MAT L5$=NUL$
1640 H$[1,100]=" "
1650 R1=R2=W8=W9=D8=S9=E9=E=T5=0
1660 MAT D1=ZER
1670 E=0
1680 REM *********************
1690 REM Read the Graph
1700 REM Information
1710 REM *********************
1720 CALL READPAGE(F[2],R5[*],NUM(I$)-64,E1)
1730 IF E1<>0 THEN DO
1740 E=142
1750 END
1760 DOEND
1770 G1$=FNV$(ABS(R5[55]))
1780 G2$=UPS$(FNV$(ABS(R5[368])))
1790 I3$=UPS$(DEB$(FNV$(ABS(R5[394]))))
1800 IF I3$[1;1]="Y" THEN T5=1
1810 S8=0
1820 Z9=184
1830 IF R5[Z9]=0 THEN 1930
1840 S8=S8+1
1850 D1[S8]=FNV(ABS(R5[Z9]))
1860 IF D1[S8]<0 THEN DO
1870 E=166
1880 END
1890 DOEND
1900 IF S8=7 THEN 1930
1910 Z9=Z9+26
1920 GOTO 1830
1930 IF S8=0 THEN DO
1940 E=136
1950 END
1960 DOEND
1970 FOR Z9=1 TO S8
1980 IF R5[185+(Z9-1)*26]=0 THEN 2000
1990 L5$[Z9]=FNV$(ABS(R5[185+(Z9-1)*26]))
2000 NEXT Z9
2010 REM **************************************************************
2020 REM Draw the Graph
2030 REM **************************************************************
2040 RESTORE 2450
2050 G0=7
2060 B0=0
2070 B1=0
2080 IF G2$[1,2]="BL" THEN DO
2090 RESTORE 2530
2100 G0=7
2110 B0=6
2120 B1=0
2130 DOEND
2140 IF G2$[1,2]="YE" THEN DO
2150 RESTORE 2450
2160 G0=7
2170 B0=0
2180 B1=3
2190 DOEND
2200 IF G2$[1,2]="TU" THEN DO
2210 RESTORE 2610
2220 G0=7
2230 B0=2
2240 B1=6
2250 DOEND
2260 IF G2$[1,2]="OR" THEN DO
2270 RESTORE 2610
2280 G0=7
2290 B0=1
2300 B1=3
2310 DOEND
2320 IF G2$[1,2]="GR" THEN DO
2330 RESTORE 2610
2340 G0=7
2350 B0=3
2360 B1=2
2370 DOEND
2380 IF G2$[1,2]="RE" THEN DO
2390 RESTORE 2450
2400 G0=7
2410 B0=1
2420 B1=1
2430 DOEND
2440 REM yellow/blue/gray/org/grn/coral/pink
2450 DATA 6,0
2460 DATA 3,0
2470 DATA 5,0
2480 DATA 1,0
2490 DATA 4,3
2500 DATA 2,0
2510 DATA 1,3
2520 REM yellow/pink/gray/org/grn/coral/lt.grn
2530 DATA 3,3
2540 DATA 5,0
2550 DATA 4,3
2560 DATA 1,3
2570 DATA 2,3
2580 DATA 5,3
2590 DATA 6,3
2600 REM yellow/blue/gray/pink/lt.yel/coral/lt.grn
2610 DATA 3,3
2620 DATA 6,0
2630 DATA 7,0
2640 DATA 5,0
2650 DATA 5,7
2660 DATA 5,3
2670 DATA 6,3
2680 FOR Z=1 TO 7
2690 READ C0[Z],C1[Z]
2700 NEXT Z
2710 FOR V=1 TO S8
2720 T0=0
2730 FOR Z=V TO S8
2740 IF D1[Z]>T0 THEN DO
2750 T0=D1[Z]
2760 Z9=Z
2770 DOEND
2780 NEXT Z
2790 T2=D1[V]
2800 D1[V]=D1[Z9]
2810 D1[Z9]=T2
2820 T2=C0[V]
2830 C0[V]=C0[Z9]
2840 C0[Z9]=T2
2850 T2=C1[V]
2860 C1[V]=C1[Z9]
2870 C1[Z9]=T2
2880 I3$=L5$[V]
2890 L5$[V]=L5$[Z9]
2900 L5$[Z9]=I3$
2910 NEXT V
2920 V=S8
2930 IF D1[V]=0 THEN DO
2940 S8=S8-1
2950 IF S8>0 THEN 2920
2960 DOEND
2970 IF S8=0 THEN DO
2980 E=136
2990 END
3000 DOEND
3010 GOTO 3530
3020 REM*************************************
3030 REM By skipping over the next section of
3040 REM code, the graph will not be inter-
3050 REM leaved in its sort (big,small,big...)
3060 REM*************************************
3070 FOR V=1 TO S8 STEP 2
3080 T0=0
3090 T1=1L77
3100 Z9=V
3110 FOR Z=V TO S8
3120 IF D1[Z]>T0 THEN DO
3130 T0=D1[Z]
3140 Z9=Z
3150 DOEND
3160 NEXT Z
3170 IF T0>0 THEN DO
3180 T2=D1[V]
3190 D1[V]=D1[Z9]
3200 D1[Z9]=T2
3210 T2=C0[V]
3220 C0[V]=C0[Z9]
3230 C0[Z9]=T2
3240 T2=C1[V]
3250 C1[V]=C1[Z9]
3260 C1[Z9]=T2
3270 I3$=L5$[V]
3280 L5$[V]=L5$[Z9]
3290 L5$[Z9]=I3$
3300 DOEND
3310 Z8=V+1
3320 FOR Z=V+1 TO S8
3330 IF D1[Z]<T1 THEN DO
3340 T1=D1[Z]
3350 Z8=Z
3360 DOEND
3370 NEXT Z
3380 IF T1<1L77 THEN DO
3390 T2=D1[V+1]
3400 D1[V+1]=D1[Z8]
3410 D1[Z8]=T2
3420 T2=C0[V+1]
3430 C0[V+1]=C0[Z8]
3440 C0[Z8]=T2
3450 T2=C1[V+1]
3460 C1[V+1]=C1[Z8]
3470 C1[Z8]=T2
3480 I3$=L5$[V+1]
3490 L5$[V+1]=L5$[Z8]
3500 L5$[Z8]=I3$
3510 DOEND
3520 NEXT V
3530 T0=0
3540 FOR Z=1 TO S8
3550 T0=T0+D1[Z]
3560 NEXT Z
3570 IF T0=0 THEN DO
3580 E=185
3590 END
3600 DOEND
3610 FOR Z=1 TO S8
3620 D1[Z]=D1[Z]/T0
3630 NEXT Z
3640 G5=0
3650 IF D1[1]>.75 THEN DO
3660 G5=1
3670 FOR Z=S8 TO 2 STEP -1
3680 D1[Z+1]=D1[Z]
3690 C0[Z+1]=C0[Z]
3700 C1[Z+1]=C1[Z]
3710 L5$[Z+1]=L5$[Z]
3720 NEXT Z
3730 C0[2]=C0[1]
3740 C1[2]=C1[1]
3750 D1[2]=D1[1]-.75
3760 D1[1]=.75
3770 L5$[2]=""
3780 S8=S8+1
3790 DOEND
3800 SYSTEM E9,"PURGE QCBITMAP,TEMP"
3810 SYSTEM E9,"BUILD QCBITMAP;REC=2700,5,F,BINARY;DISC=80;TEMP"
3820 I3$[1,28]="QCBITMAP"
3830 CALL OPENFILE(I3$,F9,E9)
3840 IF E9<>0 THEN DO
3850 E=101
3860 END
3870 DOEND
3880 P2=6.28319
3890 A=.8
3900 R0=250
3910 R1=A*250
3920 S7=0
3930 CALL BACKGROUND(F9,B9,T9[*],G0,B0,B1,E9)
3940 FOR Z=1 TO S8
3950 F1[Z]=S7
3960 F2[Z]=D1[Z]*P2+S7
3970 S7=F2[Z]
3980 NEXT Z
3990 FOR Z=1 TO S8
4000 IF G5=1 AND Z<3 THEN DO
4010 IF Z=1 THEN DO
4020 X0[1]=INT(20*SIN((F1[1]+F2[2])/2))+720
4030 Y0[1]=INT(20*A*COS((F1[1]+F2[2])/2))+336
4040 DOEND
4050 ELSE DO
4060 Y0[2]=Y0[1]
4070 X0[2]=X0[1]
4080 DOEND
4090 DOEND
4100 ELSE DO
4110 X0[Z]=INT(20*SIN((F1[Z]+F2[Z])/2))+720
4120 Y0[Z]=INT(20*A*COS((F1[Z]+F2[Z])/2))+336
4130 DOEND
4140 X1[Z]=INT(R0*SIN(F1[Z]))+X0[Z]
4150 Y1[Z]=INT(R1*COS(F1[Z]))+Y0[Z]
4160 X2[Z]=INT(R0*SIN(F2[Z]))+X0[Z]
4170 Y2[Z]=INT(R1*COS(F2[Z]))+Y0[Z]
4180 IF F2[Z]=P2 THEN X2[Z]=X2[Z]-1
4190 M1[Z]=(X1[Z]-X0[Z])/(Y1[Z]-Y0[Z])
4200 M2[Z]=(X2[Z]-X0[Z])/(Y2[Z]-Y0[Z])
4210 X5=X1[Z]
4220 Y9=Y1[Z]
4230 GOSUB 5610
4240 F1[Z]=F5
4250 X5=X2[Z]
4260 Y9=Y2[Z]
4270 GOSUB 5610
4280 F2[Z]=F5
4290 IF F2[Z]<F1[Z] THEN F2[Z]=P2
4300 X[1]=Y0[Z]
4310 IF 0>=F1[Z] AND 0<=F2[Z] THEN X[1]=Y0[Z]+A*R0
4320 IF P2/2>=F1[Z] AND P2/2<=F2[Z] THEN X[1]=Y0[Z]-A*R0
4330 X[2]=Y0[Z]
4340 X[3]=Y1[Z]
4350 X[4]=Y2[Z]
4360 GOSUB 5500
4370 L0[Z]=X[1]
4380 L1[Z]=X[4]
4390 NEXT Z
4400 MAT D4=ZER
4410 Y5=670
4420 FOR Z=S8 TO 1 STEP -1
4430 IF (F1[Z]+F2[Z])/2>P2/2 THEN DO
4440 IF Z=S8 AND D1[Z]<.07 THEN DO
4450 D4[Z]=1
4460 DOEND
4470 DOEND
4480 ELSE DO
4490 D4[Z]=1
4500 DOEND
4510 Y4[Z]=INT(R1*1.2*COS((F1[Z]+F2[Z])/2))+Y0[Z]+10
4520 IF D4[Z]=0 THEN X4[Z]=INT(R0*1.2*SIN((F1[Z]+F2[Z])/2))+X0[Z]
4530 IF D4[Z]=1 THEN X4[Z]=INT(R0*1.2*SIN((F1[Z]+F2[Z])/2))+X0[Z]
4540 IF D4[Z]=0 THEN DO
4550 IF Y4[Z]<Y5-30 THEN Y5=Y4[Z]
4560 ELSE Y5=Y4[Z]=Y5-30
4570 DOEND
4580 NEXT Z
4590 FOR Y9=1 TO 672
4600 FOR Z=1 TO S8
4610 IF Y9>=L0[Z] AND Y9<=L1[Z] THEN DO
4620 MAT X=ZER
4630 X5=INT(M1[Z]*(Y9-Y0[Z]))+X0[Z]
4640 IF X1[Z]<=X0[Z] AND X5>=X1[Z] AND X5<=X0[Z] THEN DO
4650 IF Y1[Z]<=Y0[Z] THEN DO
4660 IF Y9<=Y0[Z] AND Y9>=Y1[Z] THEN GOSUB 5700
4670 DOEND
4680 IF Y0[Z]<Y1[Z] THEN DO
4690 IF Y9<=Y1[Z] AND Y9>=Y0[Z] THEN GOSUB 5700
4700 DOEND
4710 DOEND
4720 IF X0[Z]<X1[Z] AND X5>=X0[Z] AND X5<=X1[Z] THEN DO
4730 IF Y1[Z]<=Y0[Z] THEN DO
4740 IF Y9<=Y0[Z] AND Y9>=Y1[Z] THEN GOSUB 5700
4750 DOEND
4760 IF Y0[Z]<Y1[Z] THEN DO
4770 IF Y9<=Y1[Z] AND Y9>=Y0[Z] THEN GOSUB 5700
4780 DOEND
4790 DOEND
4800 X5=INT(M2[Z]*(Y9-Y0[Z]))+X0[Z]
4810 IF X2[Z]<=X0[Z] AND X5>=X2[Z] AND X5<=X0[Z] THEN DO
4820 IF Y2[Z]<=Y0[Z] THEN DO
4830 IF Y9<=Y0[Z] AND Y9>=Y2[Z] THEN GOSUB 5700
4840 DOEND
4850 IF Y0[Z]<Y2[Z] THEN DO
4860 IF Y9<=Y2[Z] AND Y9>=Y0[Z] THEN GOSUB 5700
4870 DOEND
4880 DOEND
4890 IF X0[Z]<X2[Z] AND X5>=X0[Z] AND X5<=X2[Z] THEN DO
4900 IF Y2[Z]<=Y0[Z] THEN DO
4910 IF Y9<=Y0[Z] AND Y9>=Y2[Z] THEN GOSUB 5700
4920 DOEND
4930 IF Y0[Z]<Y2[Z] THEN DO
4940 IF Y9<=Y2[Z] AND Y9>=Y0[Z] THEN GOSUB 5700
4950 DOEND
4960 DOEND
4970 X5=INT(SQR((A*R0)**2-(Y9-Y0[Z])**2)/A)+X0[Z]
4980 GOSUB 5610
4990 X5=2*X0[Z]-X5
5000 GOSUB 5610
5010 CALL LINECOLOR(F9,B9,T9[*],Y9,X[1],X[2],C0[Z],C1[Z],E9)
5020 DOEND
5030 NEXT Z
5040 NEXT Y9
5050 FOR Z=1 TO S8
5060 X0=INT(R0*SIN(F1[Z]))+X0[Z]-1
5070 FOR T0=F1[Z] TO F2[Z] STEP .008
5080 X1=INT(R0*SIN(T0))+X0[Z]
5090 Y1=INT(R1*COS(T0))+Y0[Z]
5100 CALL BUILDGRAPH(F9,B9,T9[*],X1,Y1,E9)
5110 IF X1<>X0 THEN DO
5120 IF T0<P2/4 OR T0>3*P2/4 THEN DO
5130 FOR Y4=1 TO 10 STEP 2
5140 CALL BUILDGRAPH(F9,B9,T9[*],X1,Y1+Y4,E9)
5150 NEXT Y4
5160 DOEND
5170 X0=X1
5180 DOEND
5190 NEXT T0
5200 FOR T0=F1[Z] TO F2[Z]*1.0001 STEP F2[Z]-F1[Z]
5210 IF G5=1 AND (Z=2 AND T0=F1[Z] OR Z=1 AND T0>F1[Z]) THEN 5380
5220 A1=SIN(T0)
5230 A2=A*COS(T0)
5240 X0=X0[Z]-1
5250 FOR R5=0 TO 250 STEP 2
5260 X1=INT(R5*A1)+X0[Z]
5270 Y1=INT(R5*A2)+Y0[Z]
5280 CALL BUILDGRAPH(F9,B9,T9[*],X1,Y1,E9)
5290 IF X1<>X0 THEN DO
5300 IF F1[Z]<P2/2 AND T0=F1[Z] AND T0>0 OR F2[Z]>P2/2 AND T0=&
F2[Z] AND T0<P2 THEN DO
5310 FOR Y4=1 TO 10 STEP 2
5320 CALL BUILDGRAPH(F9,B9,T9[*],X1,Y1+Y4,E9)
5330 NEXT Y4
5340 DOEND
5350 X0=X1
5360 DOEND
5370 NEXT R5
5380 NEXT T0
5390 IF G5=1 AND Z=2 THEN 5470
5400 A1=SIN((F1[Z]+F2[Z])/2)
5410 A2=A*COS((F1[Z]+F2[Z])/2)
5420 FOR R5=220 TO 280 STEP 2
5430 X1=INT(R5*A1)+X0[Z]
5440 Y1=INT(R5*A2)+Y0[Z]
5450 CALL BUILDGRAPH(F9,B9,T9[*],X1,Y1,E9)
5460 NEXT R5
5470 NEXT Z
5480 GOTO 5810
5490 REM***************************************************************
5500 FOR I5=1 TO 4
5510 FOR I6=I5+1 TO 4
5520 IF X[I6]<X[I5] THEN DO
5530 T=X[I5]
5540 X[I5]=X[I6]
5550 X[I6]=T
5560 DOEND
5570 NEXT I6
5580 NEXT I5
5590 RETURN
5600 REM***************************************************************
5610 A5=(X5-X0[Z])
5620 B5=(Y9-Y0[Z])/A
5630 F5=ATN(ABS(A5/B5))
5640 IF A5>=0 AND B5<0 THEN F5=P2/2-F5
5650 IF A5<=0 AND B5<=0 THEN F5=F5+P2/2
5660 IF A5<0 AND B5>0 THEN F5=P2-F5
5670 IF F5<=F2[Z]*1.001 AND F5>=F1[Z]/1.001 THEN GOSUB 5700
5680 RETURN
5690 REM***************************************************************
5700 IF ABS(X5-X[2])<2 THEN 5780
5710 IF X5>X[2] THEN DO
5720 X[1]=X[2]
5730 X[2]=X5
5740 DOEND
5750 ELSE DO
5760 IF X5>X[1] THEN X[1]=X5
5770 DOEND
5780 RETURN
5790 REM***************************************************************
5800 REM Routine to play out the graph to PaintJet
5810 REM***************************************************************
5820 I6$='27"&k0S"'27"&l6D"'27"(s0B"'27"*t180R"'27"*r3U"'27"*b1M"'27&
"*r0A"'27"&a+276V"
5830 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
5840 I5$[1]='27"*v90A"'27"*v88B"'27"*v85C"
5850 I5$[2]='27"*v53A"'27"*v8B"'27"*v14C"
5860 I5$[3]='27"*v3A"'27"*v26B"'27"*v22C"
5870 I5$[4]='27"*v89A"'27"*v83B"'27"*v13C"
5880 I5$[5]='27"*v4A"'27"*v4B"'27"*v29C"
5890 I5$[6]='27"*v53A"'27"*v5B"'27"*v25C"
5900 I5$[7]='27"*v2A"'27"*v22B"'27"*v64C"
5910 I5$[8]='27"*v4A"'27"*v4B"'27"*v6C"
5920 FOR Z=1 TO 8
5930 CONVERT Z-1 TO A$
5940 I6$=I5$[Z]+'27"*v"+A$+"I"
5950 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
5960 NEXT Z
5970 I6$=H$[1,(80-LEN(G1$))/2]+G1$+'27"&a+100V"
5980 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
5990 FOR Y9=1 TO 676
6000 CALL BREAKLINE(F9,B9,T9[*],Y9,I9$[1],I9$[2],I9$[3],E9)
6010 FOR Z=1 TO 3
6020 CALL RUNTIME(I9$[Z],R0)
6030 CONVERT R0 TO A$
6040 IF Z<3 THEN I6$='27"*b"+A$+"V"+I9$[Z]
6050 IF Z=3 THEN I6$='27"*b"+A$+"W"+I9$[Z]
6060 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
6070 NEXT Z
6080 IF T5=1 THEN DO
6090 FOR Z=1 TO S8
6100 IF Y9=Y4[Z] THEN DO
6110 IF G5=1 AND Z<3 THEN DO
6120 IF Z=1 THEN DO
6130 CONVERT INT((D1[1]+D1[2])*1000)/10 TO A$
6140 L5$[1]=DEB$(L5$[1])+" ("+A$+"%)"
6150 DOEND
6160 ELSE DO
6170 L5$[Z]=""
6180 DOEND
6190 DOEND
6200 ELSE DO
6210 CONVERT INT(D1[Z]*1000)/10 TO A$
6220 L5$[Z]=DEB$(L5$[Z])+" ("+A$+"%)"
6230 DOEND
6240 IF D4[Z]=0 THEN CONVERT X4[Z]*4-LEN(L5$[Z])*60 TO A$
6250 IF D4[Z]=1 THEN CONVERT X4[Z]*4 TO A$
6260 I6$='27"&k4S"'27"&a"+A$+"H"+L5$[Z]
6270 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
6280 DOEND
6290 NEXT Z
6300 DOEND
6310 NEXT Y9
6320 IF T5=0 THEN DO
6330 I6$='27"&a-2704V"
6340 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
6350 T0=1
6360 FOR Y9=1 TO 676
6370 FOR Z=1 TO S8
6380 IF Y9=Y4[Z] THEN DO
6390 IF G5=1 AND Z<3 THEN DO
6400 IF Z=1 THEN DO
6410 CONVERT INT((D1[1]+D1[2])*1000)/10 TO A$
6420 L5$[1]=DEB$(L5$[1])+" ("+A$+"%)"
6430 DOEND
6440 ELSE DO
6450 L5$[Z]=""
6460 DOEND
6470 DOEND
6480 ELSE DO
6490 CONVERT INT(D1[Z]*1000)/10 TO A$
6500 L5$[Z]=DEB$(L5$[Z])+" ("+A$+"%)"
6510 DOEND
6520 IF D4[Z]=0 THEN CONVERT X4[Z]*4-LEN(L5$[Z])*60 TO A$
6530 IF D4[Z]=1 THEN CONVERT X4[Z]*4 TO A$
6540 I6$='27"&k4S"'27"&a"+A$+"H"+L5$[Z]
6550 CONVERT (Y9-T0)*4 TO A$
6560 I6$='27"&a+"+A$+"V"+I6$
6570 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
6580 T0=Y9
6590 DOEND
6600 NEXT Z
6610 NEXT Y9
6620 CONVERT (676-T0)*4 TO A$
6630 I6$='27"&a+"+A$+"V"
6640 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
6650 DOEND
6660 I6$='27"*rB"'27"&k0S"'27"&a+280V"'27"&a0H"
6670 CALL GRAPHWRITE(F[3],I6$,FNM(LEN(I6$)),E9)
6680 CALL CLOSEFILE(F9,E9)
6690 END
6700 REM **************************************************************
6710 REM
6720 REM Function to return the numeric value of a cell.
6730 REM
6740 REM Parameters: R0 - record number of the cell
6750 REM Return: Long number value of the cell
6760 REM
6770 REM **************************************************************
6780 DEF LONG FNV(REAL R0)
6790 DIM C$[255]
6800 LONG V
6810 V=0L0
6820 CALL GETACELL(F[1],C$,R0,K8)
6830 CALL STRINGTOLONG(C$[4;8],V)
6840 RETURN V
6850 FNEND
6860 REM **************************************************************
6870 REM
6880 REM Function to return the text value of a cell.
6890 REM
6900 REM Parameters: R0 - record number of the cell
6910 REM Return: Text value returned
6920 REM
6930 REM **************************************************************
6940 DEF FNV$(REAL R0)
6950 DIM C$[255],V$[255]
6960 REAL T
6970 V$=""
6980 CALL GETACELL(F[1],C$,R0,K8)
6990 IF C$[1;1]="N" OR C$[1;1]="R" THEN DO
7000 IF C$[63;1]=" " THEN DO
7010 I$=C$[25;2]+C$[4;8]
7020 INVOKE "QCFORMAT"
7030 C$[27;36]=I$
7040 C$[63;1]="*"
7050 CALL PUTACELL(F[1],C$,R0,K8)
7060 DOEND
7070 V$=DEB$(C$[27;36])
7080 DOEND
7090 IF C$[1;1]="$" OR C$[1;1]="Q" THEN DO
7100 CALL STRINGTODBLE(C$[12;4],T)
7110 CALL READTEXT(V$,T,F[*],K8)
7120 DOEND
7130 IF C$[1;1]="T" THEN DO
7140 V$=DEB$(C$[64;186])
7150 DOEND
7160 RETURN DEB$(V$)
7170 FNEND
7180 REM **************************************************************
========================================
|
