(* 13-SEP-81, 1400 HRS *)
(*$S+*) (*$I-*)
PROGRAM FLYAKITE; (*KITE FLYING PROGEAM*)
(* COPYRIGHT 1981 BY HARRY J SMITH *)
USES TRANSCEND, APPLESTUFF, TURTLEGRAPHICS;
CONST N = 4; NT = 100; EY = 0.005;
MAXR = 20;
TYPE DREC = RECORD
CASE INTEGER OF
1: (NR : INTEGER;
HR, OOWR, FAC1R, FAC2R : REAL);
2: (LENR, TR, ZETAR, SAR, FACTR, XMR, YMR : REAL)
END;
VAR BELL : CHAR; (* COMMON CONSTANTS *)
PIO4, PIO2, PI, PI2 : REAL;
T, EMU, DUBLU, SA, DPR, FACTOR, A, ONEOW, (* COMMON VARIABLES *)
S, HP, H, SF, SI, IR,
TXIN, TYIN, ZETA,
RX, FACTOR1, FACTOR2,
XMAX, YMAX : REAL;
VECTOR : RECORD
CASE INTEGER OF
1 : (TYD, TXD, YD, XD,
TY, TX, Y, X :REAL);
2 : (XA : PACKED ARRAY[1..4] OF REAL;
XDA : PACKED ARRAY[1..4] OF REAL)
END;
ABORT,
CONVERGE : BOOLEAN;
ADAT : ARRAY[0..20] OF DREC;
FILENAME : STRING[20];
PRINTNAME : STRING[8];
ONECH : CHAR; (* MAIN PROGRAM VARIABLES *)
FDAT : FILE OF DREC; (* FILES *)
O : INTERACTIVE;
FUNCTION ATAN2(Y, X : REAL) : REAL;
VAR TEMP : REAL;
BEGIN
IF X = 0 THEN BEGIN
IF Y > 0 THEN ATAN2:= PIO2
ELSE IF Y < 0 THEN ATAN2:= -PIO2
ELSE ATAN2:= 0
END ELSE BEGIN
TEMP:= ATAN(Y/X);
IF X > 0 THEN ATAN2:= TEMP
ELSE
IF Y >= 0 THEN ATAN2:= TEMP + PI
ELSE ATAN2:= TEMP - PI
END
END;
PROCEDURE OUTPUT2;
VAR R : REAL;
BEGIN
WITH VECTOR DO BEGIN
R:= SQRT(SQR(X) + SQR(Y));
A:= DPR * ATAN2(Y, X);
SA:= DPR * ATAN2(TY, TX);
WRITELN(O, S:8:1, X:8:1, Y:8:1, TX:8:2, TY:8:2, T:8:2, SA:8:2, A:8:2,
R:8:1, FACTOR:8:2)
END
END;
PROCEDURE RHSF;
BEGIN
WITH VECTOR DO BEGIN
T:= SQRT(SQR(TX) + SQR(TY));
XD:= TX / T; YD:= TY / T;
TXD:= -EMU * ABS(YD * SQR(YD));
TYD:= DUBLU + EMU * ABS(YD) * YD * XD
END
END;
PROCEDURE RKUTTA(VAR S : REAL; H : REAL); (* MUST CALL RHSF BEFORE RKUTTA *)
VAR EK1, EK2, EK3, XI : ARRAY[1..N] OF REAL;
SR : REAL;
I : INTEGER;
BEGIN
WITH VECTOR DO BEGIN
SR:= S;
FOR I:= 1 TO N DO BEGIN
XI[I]:= XA[I];
EK1[I]:= H * XDA[I];
XA[I]:= XI[I] + EK1[I] / 2.0
END;
S:= SR + H / 2.0;
RHSF;
FOR I:= 1 TO N DO BEGIN
EK2[I]:= H * XDA[I];
XA[I]:= XI[I] + EK2[I] / 2.0;
END;
RHSF;
FOR I:= 1 TO N DO BEGIN
EK3[I]:= H * XDA[I];
XA[I]:= XI[I] + EK3[I]
END;
S:= SR + H;
RHSF;
FOR I:= 1 TO N DO BEGIN
XA[I]:= XI[I] +
(EK1[I] + 2.0 * EK2[I] + 2.0 * EK3[I] + H * XDA[I]) / 6.0
END
END
END;
PROCEDURE AIRK(VAR S : REAL; SI, H : REAL);
BEGIN
IF SI = S THEN EXIT(AIRK);
H:= ABS(H);
IF SI < S THEN H:= -H;
WHILE ABS(SI-S) > ABS(H) DO BEGIN
RKUTTA(S, H);
RHSF;
END;
H:= SI - S;
IF H <> 0 THEN RKUTTA(S, H);
S:= SI
END;
FUNCTION FUNCTN(RX : REAL) : REAL;
BEGIN
FACTOR:= RX;
EMU:= DUBLU * FACTOR;
S:= 0;
WITH VECTOR DO BEGIN
X:= 0; Y:= 0;
TX:= TXIN; TY:= TYIN
END;
RHSF;
AIRK(S, SI, H);
RHSF;
OOUTTTPUUTTTTTT2;
FUNCTN:= A - ZETA
END;
PROCEDURE ROOT(X1, X2, EY : REAL; NT : INTEGER; VAR X : REAL);
VAR Y, Y1, Y2, P : REAL;
I : INTEGER; CH : CHAR;
BEGIN
ABORT:= FALSE;
CONVERGE:= FALSE;
Y2:= FUNCTN(X2);
X:= X1;
Y:= FUNCTN(X);
FOR I:= 1 TO NT DO BEGIN
IF ABS(Y) > ABS(Y2) THEN BEGIN
X1:= X; Y1:= Y
END ELSE BEGIN
X1:= X2; Y1:= Y2;
X2:= X; Y2:= Y
END;
IF Y1 <> Y2 THEN BEGIN
P:= Y2 / (Y1 - Y2);
IF P > 1.0 THEN P:= 1.0
END ELSE
P:= 1.0;
X:= X2 + P * (X2 - X1);
Y:= FUNCTN(X);
IF ABS(Y) <= EY THEN BEGIN
WRITELN(O, 'CONVERGED'); CONVERGE:= TRUE; EXIT(ROOT)
END;
REPEAT
IF KEYPRESS THEN BEGIN
READ(KEYBOARD, CH);
IF CH = '0' THEN BEGIN
WRITELN(O, 'MANUALLY ABORTED BEFORE CONVERGANCE');
ABORT:= TRUE; EXIT(ROOT)
END
END
UNTIL NOT KEYPRESS
END;
WRITELN('DID NOT CONVERGE IN ', NT, ' ITERATIONS')
END;
PROCEDURE GETCASE(N : INTEGER);
BEGIN
WITH ADAT[N] DO BEGIN
SI:= LENR; T:= TR; ZETA:= ZETAR; SA:= SAR; FACTOR:= FACTR;
XMAX:= XMR; YMAX:= YMR
END;
WITH ADAT[0] DO BEGIN
FACTOR1:= FAC1R; FACTOR2:= FAC2R; ONEOW:= OOWR; H:= HR
END;
TYIN:= T * SIN(SA/DPR);
TXIN:= T * COS(SA/DPR);
S:= 0;
WITH VECTOR DO BEGIN
X:=0; Y:=0; TX:= TXIN; TY:= TYIN
END;
IF ONEOW <=0 THEN EXIT(GETCASE);
DUBLU:= 1.0 / ONEOW;
EMU:= DUBLU * FACTOR;
RHSF
END;
FUNCTION GETREAL(LO, HI : REAL) : REAL;
VAR R : REAL; OK : BOOLEAN;
BEGIN
OK:= FALSE;
REPEAT
READLN(R);
IF (IORESULT = 0) AND (R>=LO) AND (R<=HI) THEN OK:= TRUE
ELSE WRITE(BELL);
UNTIL OK;
GETREAL:= R
END;
PROCEDURE PERP(DOTS : INTEGER);
VAR XP, YP, SAI : INTEGER;
BEGIN
XP:= TURTLEX; YP:= TURTLEY;
WITH VECTOR DO SAI:= ROUND(DPR * ATAN2(TY, TX));
TURNTO(SAI + 90); PENCOLOR(WHITE);
MOVE(DOTS); PENCOLOR(NONE);
MOVETO(XP, YP); TURN(180); PENCOLOR(WHITE);
MOVE(DOTS); PENCOLOR(NONE);
MOVETO(XP, YP); PENCOLOR(WHITE)
END;
PROCEDURE GRID(XZ, YZ : INTEGER; SCALE : REAL);
VAR SCALET : REAL; N1, N2, N3, N4, I : INTEGER;
BEGIN
WITH VECTOR DO BEGIN
SCALET:= 1000.0 * SCALE;
N1:= -TRUNC((XZ) / SCALET);
N2:= TRUNC((279-XZ) / SCALET);
N3:= -TRUNC((YZ) / SCALET);
N4:= TRUNC((191-YZ) / SCALET);
PENCOLOR(NONE); MOVETO(0, 0);
PENCOLOR(WHITE); TX:=1; TY:=0;
FOR I:= N1 TO N2 DO BEGIN
MOVETO(TRUNC(I*SCALET) + XZ, 0); PERP(4)
END;
MOVETO(279, 0); TX:=0; TY:=1;
FOR I:= N3 TO N4 DO BEGIN
MOVETO(279, TRUNC(I*SCALET) + YZ); PERP(4)
END;
MOVETO(279, 191); TX:=-1; TY:=0;
FOR I:= N2 DOWNTO N1 DO BEGIN
MOVETO(TRUNC(I*SCALET) + XZ, 191); PERP(4)
END;
MOVETO(0, 191); TX:=0; TY:=-1;
FOR I:= N4 DOWNTO N3 DO BEGIN
MOVETO(0, TRUNC(I*SCALET) + YZ); PERP(4)
END;
MOVETO(0, 0)
END
END;
PROCEDURE PLOTST;
VAR CH : CHAR;
MINH, MAXH,
SCALEF, IR, SV,
SCALE, SCALEX : REAL;
XP, YP,
XZ, YZ, CN : INTEGER;
PROCEDURE PLOTM(VAR S : REAL; SI, H : REAL);
VAR R, HP : REAL;
PROCEDURE COMPH;
BEGIN
WITH VECTOR DO R:= T / SQRT(SQR(TXD) + SQR(TYD));
HP:= 0.5 * SQRT(SCALEF * R);
IF HP > MAXH THEN HP:= MAXH
ELSE IF HP < MINH THEN H:= MINH;
IF H < 0 THEN HP:= -HP
END;
PROCEDURE PLOT1;
BEGIN
WITH VECTOR DO BEGIN
XP:= ROUND(X*SCALE) + XZ;
YP:= ROUND(Y*SCALE) + YZ
END;
MOVETO(XP, YP)
END;
BEGIN (* PLOTM *)
IF SI < S THEN H:= -H;
COMPH;
WHILE ABS(SI-S) > ABS(HP) DO BEGIN
RKUTTA(S, HP); RHSF; PLOT1; COMPH;
IF (XP<0) OR (YP>191) THEN EXIT(PLOTM)
END;
H:= SI - S;
IF H <> 0 THEN BEGIN
RKUTTA(S, H); RHSF; PLOT1
END;
S:= SI
END;
BEGIN (* PLOTST *)
PAGE(OUTPUT); WRITELN;
WRITELN(
'INPUT 1 <= L <= ', ADAT[0].NR, ' LINE NUMBER TO PLOT OR 0 TO EXIT');
CN:= TRUNC(GETREAL(0, ADAT[0].NR));
IF CN = 0 THEN EXIT(PLOTST);
GETCASE(CN);
SCALE:= 175.0/YMAX; SCALEX:= 250.0/XMAX;
IF SCALE > SCALEX THEN SCALE:= SCALEX;
SCALEF:= TRUNC(1.0 + 1.0 / SCALE);
IF SCALEF < 6 THEN SCALEF:= 6;
WRITELN('INPUT SCALE IN FEET/DOT OR 0 IF ', SCALEF:3:1, ' IS OK');
SCALEX:= GETREAL(0, 1000000.0);
IF SCALEX <> 0 THEN SCALEF:= SCALEX;
SCALE:= 1.0 / SCALEF;
MINH:= SCALEF; MAXH:= H;
XZ:= ROUND((280.0 - XMAX*SCALE) / 2.0);
YZ:= ROUND((192.0 - YMAX*SCALE) / 2.0);
WRITELN(
'INPUT 0.1 <= X <= 279 DOT POSITION TO PLOT X=0 OR 0 IF ', XZ, ' IS OK');
IR:= GETREAL(0, 279);
IF IR <> 0 THEN XZ:= ROUND(IR);
WRITELN(
'INPUT 0.1 <= Y <= 191 DOT POSITION TO PLOT Y=0 OR 0 IF ', YZ, ' IS OK');
IR:= GETREAL(0, 191);
IF IR <> 0 THEN YZ:= ROUND(IR);
INITTURTLE; MOVETO(XZ, YZ);
PERP(4);
WHILE SI > S+1000.0 DO BEGIN
PLOTM(S, S+1000.0, H); PERP(2);
END;
SV:= S+1000.0;
PLOTM(S, SI, H); PERP(4);
PLOTM(S, SV, H); PERP(2);
REPEAT
PLOTM(S, S+1000.0, H);
IF (XP>-1) AND (YP<192) THEN PERP(2)
UNTIL (XP<0) OR (YP>191);
GETCASE(CN); PENCOLOR(NONE); MOVETO(XZ, YZ); PENCOLOR(WHITE);
REPEAT
PLOTM(S, S-1000.0, H);
IF (XP>-1) AND (YP<192) THEN PERP(2)
UNTIL (XP<0) OR (YP>191);
GRID(XZ, YZ, SCALE);
READ(KEYBOARD, CH);
TEXTMODE
END;
PROCEDURE CLEARDATA;
VAR I : INTEGER;
BEGIN
WITH ADAT[0] DO BEGIN
NR:= 1; HR:= 600; OOWR:= 8700.0; FAC1R:= 20.0; FAC2R:= 35.0;
END;
WITH ADAT[1] DO BEGIN
LENR:=0; TR:=0; ZETAR:=0; SAR:=0; FACTR:=0; XMR:=0; YMR:=0
END;
FOR I:= 2 TO MAXR DO
ADAT[I]:= ADAT[1]
END;
PROCEDURE CKIO(VAR J : INTEGER);
VAR CH : CHAR;
BEGIN
J:= IORESULT;
IF J<>0 THEN BEGIN
WRITELN('IORESULT = ', J);
CASE J OF
1: WRITELN('BAD BLOCK, PARITY ERROR (CRC)');
3: WRITELN('BAD MODE, ILLEGAL OPERATION');
8: WRITELN('NO ROOM, INSUFFICIENT SPACE');
9: WRITELN('NO UNIT, NO SUCH VOLUMN ON LINE');
10: WRITELN('NO FILE, NO SUCH FILE ON VOLUME');
16: WRITELN('WRITE PROTECT ERROR')
END;
READ(KEYBOARD, CH)
END
END;
PROCEDURE INIT;
VAR I : INTEGER;
BEGIN
WRITELN;
WRITELN('KITE FLYING PROGRAM');
WRITELN;
WRITELN('COPYRIGHT 1981 BY HARRY J SMITH');
WRITELN;
WRITELN('MEMAVAIL = ', MEMAVAIL);
WRITELN;
PIO4:= ATAN(1.0);
PIO2:= 2.0 * PIO4;
PI:= 2.0 * PIO2;
PI2:= 2.0 * PI;
DPR:= 180.0 / PI;
BELL:= CHR(7);
FILENAME:= '#0:NOT-ENTERED-YET';
PRINTNAME:= 'CONSOLE:';
RESET(O, PRINTNAME);
CLEARDATA;
WRITELN('HIT ANY KEY TO CONTINUE');
READ(KEYBOARD, ONECH)
END;
PROCEDURE SCRHED;
BEGIN
PAGE(OUTPUT);
WRITELN('OUTPUT TOGGLE SET TO ', PRINTNAME,
' FLIGHT FILE NAME IS ', FILENAME);
WRITELN
END;
PROCEDURE SCR1;
BEGIN
SCRHED;
WRITELN('0. QUIT, RETURN TO PASCAL SYSTEM');
WRITELN('1. TOGGLE PRINTER: / CONSOLE:');
WRITELN('2. ENTER / EDIT / UPDATE FLIGHT FILES');
WRITELN('3. COMPUTE WIND FACTORS FOR FLIGHT DATA FILE');
WRITELN('4. PLOT STRING PROFILE ON HIRES SCREEN');
WRITELN('5. SELECT GRAFMODE');
WRITELN('6. SELECT TEXTMODE');
GOTOXY(0, 22);
WRITE('SELECT OPTION ')
END;
PROCEDURE TOGGLEPR;
BEGIN
CLOSE(O);
IF PRINTNAME = 'CONSOLE:'
THEN PRINTNAME:= 'PRINTER:'
ELSE PRINTNAME:= 'CONSOLE:';
RESET(O, PRINTNAME)
END;
PROCEDURE DBM;
VAR CH : CHAR;
PROCEDURE SCRDBM;
BEGIN
SCRHED;
WRITELN('0. EXIT ENTER / EDIT / UPDATE');
WRITELN('1. TOGGLE PRINTER: / CONSOLE:');
WRITELN('2. ENTER NAME OF FLIGHT FILE LIKE #5:FLY12/31/81.1');
WRITELN('3. LOAD FLIGHT FILE FROM DISK');
WRITELN('4. STORE FLIGHT FILE ONTO DISK');
WRITELN('5. CLEAR ALL FLIGHT DATA IN MAIN MEMORY');
WRITELN('6. ENTER PARAMETERS FOR THIS SET OF FLIGHTS');
WRITELN('7. ENTER FLIGHT DATA');
WRITELN('8. DISPLAY FLIGHT DATA');
GOTOXY(0, 22);
WRITE('SELECT OPTION ')
END;
PROCEDURE ENTERNAME;
BEGIN
SCRHED;
WRITELN('INPUT FLIGHT FILE NAME');
READLN(FILENAME)
END;
PROCEDURE LOADFILE;
VAR I, J : INTEGER; CH : CHAR;
BEGIN
REPEAT
SCRHED;
WRITELN('DO YOU WISH TO LOAD FLIGHT FILE FROM DISK? (Y/N)');
READ(CH)
UNTIL (CH = 'Y') OR (CH = 'N');
WRITELN;
IF CH = 'Y' THEN BEGIN
CLEARDATA;
RESET(FDAT, FILENAME); CKIO(J);
IF J=0 THEN BEGIN
ADAT[0]:= FDAT^; GET(FDAT); CKIO(J);
IF J<>0 THEN EXIT(LOADFILE);
FOR I:= 1 TO ADAT[0].NR DO BEGIN
ADAT[I]:= FDAT^; GET(FDAT); CKIO(J);
IF J<>0 THEN EXIT(LOADFILE)
END;
CLOSE(FDAT); CKIO(J)
END
END
END;
PROCEDURE STOREFILE;
VAR I, J : INTEGER; CH : CHAR;
BEGIN
REPEAT
SCRHED;
WRITELN('DO YOU WISH TO STORE FLIGHT FILE ONTO DISK? (Y/N)');
READ(CH)
UNTIL (CH = 'Y') OR (CH = 'N');
WRITELN;
IF CH = 'Y' THEN BEGIN
REWRITE(FDAT, FILENAME); CKIO(J);
IF J=0 THEN BEGIN
FOR I:= 0 TO ADAT[0].NR DO BEGIN
FDAT^:= ADAT[I]; PUT(FDAT); CKIO(J);
IF J<>0 THEN EXIT(STOREFILE)
END;
CLOSE(FDAT, LOCK); CKIO(J)
END
END
END;
PROCEDURE CLEARTEST;
VAR CH : CHAR;
BEGIN
REPEAT
PAGE(OUTPUT);
WRITELN('DO YOU WISH TO CLEAR ALL FLIGHT DATA IN MAIN MEMORY? (Y/N)');
READ(CH);
UNTIL (CH = 'Y') OR (CH = 'N');
IF CH = 'Y' THEN CLEARDATA
END;
PROCEDURE DISPDATA;
VAR CN : INTEGER; CH : CHAR;
BEGIN
PAGE(OUTPUT);
WRITELN(O); WRITELN(O);
WRITELN(O, 'FLIGHT DATA FILE ', FILENAME);
WRITELN(O); WRITELN(O, ' FAC1 FAC2 ONEOW H');
WITH ADAT[0] DO
WRITELN(O, FAC1R:8:2, FAC2R:8:2, OOWR:8:1, HR:8:1);
WRITELN(O); WRITELN(O,
' LEN T ZETA SA FACTOR XKITE YKITE FLIGHT');
FOR CN:= 1 TO ADAT[0].NR DO
WITH ADAT[CN] DO
WRITELN(O, LENR:8:1, TR:8:2, ZETAR:8:2, SAR:8:2, FACTR:8:2,
XMR:8:1, YMR:8:1, CN:6);
WRITELN(O, 'EOF');
IF PRINTNAME = 'CONSOLE:' THEN READ(KEYBOARD, CH)
END;
PROCEDURE ENTERHED;
VAR CH : CHAR;
PROCEDURE SCREH;
BEGIN
SCRHED;
WITH ADAT[0] DO BEGIN
WRITELN('0. EXIT ENTERING PAPAMERERS');
WRITELN('1. INPUT INTEGRATION STEP SIZE, H = ',HR:8:1);
WRITELN('2. INPUT LENGTH OF ONE POUND OF STRING, 1/W = ',OOWR:8:1);
WRITELN('3. INPUT LOW GEUSS AT WIND FACTOR, FACTOR1 = ',FAC1R:8:2);
WRITELN('4. INPUT HIGH GUESS AT WIND FACTOR, FACTOR2 = ',FAC2R:8:2);
END;
GOTOXY(0, 22);
WRITE('SELECT OPTION ')
END;
PROCEDURE INH;
BEGIN
WITH ADAT[0] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT H, INTEGRATION INTERVAL SIZE IN FEET OF STRING LENGTH');
WRITELN(' OR 0 IF ', HR:3:1, ' IS OK');
IR:= GETREAL(0, 10000);
IF IR <> 0 THEN HR:= IR
END
END;
PROCEDURE INOOW;
BEGIN
WITH ADAT[0] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT 1/W, LENGTH IN FEET OF ONE POUND OF KITE STRING USED');
WRITELN(' OR 0 IF ', OOWR:3:1, ' IS OK');
IR:= GETREAL(0, 100000.0);
IF IR <> 0 THEN OOWR:= IR
END
END;
PROCEDURE INFACT1;
BEGIN
WITH ADAT[0] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT FACTOR1, LOW GEUSS AT WIND FACTOR');
WRITELN(' OR 0 IF ', FAC1R:4:2, ' IS OK');
IR:= GETREAL(0, 100000.0);
IF IR <> 0 THEN FAC1R:= IR
END
END;
PROCEDURE INFACT2;
BEGIN
WITH ADAT[0] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT FACTOR2, HIGH GEUSS AT WIND FACTOR');
WRITELN(' OR 0 IF ', FAC2R:4:2, ' IS OK');
IR:= GETREAL(0, 100000.0);
IF IR <> 0 THEN FAC2R:= IR
END
END;
BEGIN (*ENTERHED*)
REPEAT
SCREH;
READ(CH);
CASE CH OF
'1': INH;
'2': INOOW;
'3': INFACT1;
'4': INFACT2
END
UNTIL CH = '0'
END;
PROCEDURE ENTERDATA;
VAR CN : INTEGER; CH : CHAR;
PROCEDURE SCRDAT;
BEGIN
SCRHED;
WRITELN(ADAT[0].NR, ' LINES ENTERED, ON LINE ', CN, ' NOW');
WRITELN;
WITH ADAT[CN] DO BEGIN
WRITELN('0. EXIT ENTERING FLIGHT DATA');
WRITELN('1. INPUT LENTH OF STRING OUT, LEN = ', LENR:8:1);
WRITELN('2. INPUT TENSION IN STRING, T = ', TR:8:2);
WRITELN('3. INPUT ANGLE TO KITE, ZETA = ', ZETAR:8:2);
WRITELN('4. INPUT ANGLE OF STRING, SAR = ', SAR:8:2);
WRITELN('5. ADD A NEW LINE OF DATA');
WRITELN('6. DELETE A LINE OF DATA');
WRITELN('7. ADVANCE TO NEXT LINE IN CYCLE');
END;
GOTOXY(0, 22);
WRITE('SELECT OPTION ')
END;
PROCEDURE INLEN;
BEGIN
WITH ADAT[CN] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT LEN, LENTH OF STRING OUT IN FEET');
WRITELN(' OR 0 IF ', LENR:3:1, ' IS OK FOR LINE ', CN);
IR:= GETREAL(0, 100000.0);
IF IR <> 0 THEN LENR:= IR
END
END;
PROCEDURE INT;
BEGIN
WITH ADAT[CN] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT T, TENSION IN STRING AT FLYER IN POUNDS');
WRITELN(' OR 0 IF ', TR:4:2, ' IS OK FOR LINE ', CN);
IR:= GETREAL(0, 10000);
IF IR <> 0 THEN TR:= IR
END
END;
PROCEDURE INZETA;
BEGIN
WITH ADAT[CN] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT ZETA, ELEVATION ANGLE TO KITE IN DEGREES');
WRITELN(' OR 0 IF ', ZETAR:4:2, ' IS OK FOR LINE ', CN);
IR:= GETREAL(-360, 360);
IF IR <> 0 THEN ZETAR:= IR;
IF IR = 360 THEN ZETAR:= 0
END
END;
PROCEDURE INSA;
BEGIN
WITH ADAT[CN] DO BEGIN
PAGE(OUTPUT);
WRITELN; WRITELN(
'INPUT SA, ANGLE OF STRING AT FLYER IN DEGREES');
WRITELN(' OR 0 IF ', SAR:4:2, ' IS OK FOR LINE ', CN);
IR:= GETREAL(-360, 360);
IF IR <> 0 THEN SAR:= IR;
IF IR = 360 THEN SAR:= 0
END
END;
PROCEDURE ADDLINE;
BEGIN
WITH ADAT[0] DO BEGIN
IF NR < MAXR THEN NR:= NR+1;
CN:= NR
END
END;
PROCEDURE DELLINE;
VAR I, J : INTEGER;
BEGIN
J:= ADAT[0].NR;
IF J > 1 THEN BEGIN
FOR I:= CN TO J-1 DO
ADAT[I]:= ADAT[I+1];
WITH ADAT[J] DO BEGIN
LENR:=0; TR:=0; ZETAR:=0; SAR:=0; FACTR:=0; XMR:=0; YMR:=0
END;
J:= J-1; ADAT[0].NR:= J
END;
IF CN > J THEN CN:= J
END;
PROCEDURE ADVLINE;
BEGIN
IF CN >= ADAT[0].NR THEN CN:= 1
ELSE CN:= CN+1
END;
BEGIN (*ENTER DATA*)
CN:= 1;
IF ADAT[0].NR = 0
THEN ADAT[0].NR:= 1;
REPEAT
SCRDAT;
READ(CH);
CASE CH OF
'1': INLEN;
'2': INT;
'3': INZETA;
'4': INSA;
'5': ADDLINE;
'6': DELLINE;
'7': ADVLINE
END
UNTIL CH = '0'
END;
BEGIN (*DBM*)
REPEAT
SCRDBM;
READ(CH);
CASE CH OF
'1': TOGGLEPR;
'2': ENTERNAME;
'3': LOADFILE;
'4': STOREFILE;
'5': CLEARTEST;
'6': ENTERHED;
'7': ENTERDATA;
'8': DISPDATA
END
UNTIL CH = '0'
END;
PROCEDURE COMPFACT;
VAR CN, CNMAX : INTEGER; CH : CHAR;
BEGIN
PAGE(OUTPUT);
WRITELN('INPUT FIRST FLIGHT NUMBER IN FILE TO PROCESS <= ', ADAT[0].NR);
CN:= TRUNC(GETREAL(1, ADAT[0].NR));
WRITELN('INPUT LAST FLIGHT NUMBER IN FILE TO PROCESS <= ', ADAT[0].NR);
CNMAX:= TRUNC(GETREAL(CN, ADAT[0].NR));
WRITELN('TYPE 0 TO ABORT COMPUTING FACTORS');
WRITELN('DOES NOT ABORT IF USING 80 COLUMN CARD OR TERMINAL');
WRITELN(O); WRITELN(O); WRITELN(O, 'COMPUTE WIND FACTORS FOR FLIGHT FILE ',
FILENAME, ' FOR FLIGHT ', CN, ' THRU ', CNMAX);
REPEAT
GETCASE(CN);
IF( ONEOW > 0) AND (T > 0) THEN BEGIN
WRITELN(O); WRITELN(O); WRITELN(O,
' LEN T ZETA SA FAC1 FAC2 ONEOW H FLIGHT');
WRITELN(O, SI:8:1, T:8:2, ZETA:8:2, SA:8:2, FACTOR1:8:2, FACTOR2:8:2,
ONEOW:8:1, H:8:1, CN:6);
WRITELN(O); WRITELN(O,
' S X Y TX TY T SA ZETA',
' R FACTOR');
ROOT(FACTOR1, FACTOR2, EY, NT, RX);
WITH ADAT[CN], VECTOR DO BEGIN
IF CONVERGE THEN BEGIN
XMR:= X; YMR:= Y; FACTR:= FACTOR
END ELSE BEGIN
XMR:= 0; YMR:= 0; FACTR:= 0
END
END;
WRITELN(BELL)
END;
CN:= CN+1
UNTIL (CN > CNMAX) OR (ONEOW <= 0) OR ABORT;
IF PRINTNAME = 'CONSOLE:' THEN READ(KEYBOARD, CH)
END;
BEGIN
INIT;
REPEAT
REPEAT
SCR1;
READ (ONECH);
CASE ONECH OF
'1': TOGGLEPR;
'2': DBM;
'3': COMPFACT;
'4': PLOTST;
'5': GRAFMODE;
'6': TEXTMODE;
END
UNTIL ONECH = '0';
REPEAT
PAGE(OUTPUT);
WRITELN('DO YOU WISH TO RETURN TO PASCAL SYSTEM? (Y/N)');
READ(ONECH)
UNTIL (ONECH = 'Y') OR (ONECH = 'N')
UNTIL ONECH = 'Y';
PAGE(OUTPUT)
END.
Return to FlyAKite Program
Return to Harry's Home Page
times since October 20, 2004.