{Start of file FLYAKITE.PAS *************************************************}
{FLYAKITE - Kite flying program}
{Developed in Apple ][ Pascal and converted to TURBO Pascal 4.0 10/30/88}
(* 13-SEP-81, 1400 HRS *) {Apple ][ date}
{COPYRIGHT (c) 1981-1988 By author: Harry J Smith, Saratoga, CA}
{$I-}
{$R+}
PROGRAM FlyAKite;
USES Printer, Crt, Graph; {Turbo Pascal 4.0 interface}
CONST Revision = 'Last revised: 11/02/88, 0500 hours';
CONST N = 4; NT = 100; EY = 0.005; MaxR = 20;
TYPE
ColorType = 0 .. MaxColors;
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,
Scale, XMax, YMax : REAL;
Vector : RECORD
CASE INTEGER OF
1 : (X, Y, TX, TY,
XD, YD, TXD, TYD : 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}
OutP : ^TEXT;
Color : ColorType;
Dot2, Dot4,
Device, Mode : INTEGER;
MaxXPix, MaxYPix : WORD;
Palette : PaletteType;
PROCEDURE SavePlot;
VAR
Save : TEXT;
XG, YG,
CBit, NPix : INTEGER;
BEGIN
ASSIGN(Save, 'b:FlyAkite.OUT');
REWRITE(Save); {Text file}
FOR YG:= 0 TO MaxYPix DO BEGIN
WRITE(Save, YG);
CBit:= 0; NPix:= 0;
FOR XG:= 0 TO MaxXPix DO BEGIN
IF GetPixel(XG, YG) = CBit THEN NPix:= NPix + 1
ELSE BEGIN
WRITE(Save, ' ', NPix);
CBit:= (CBit + 1) MOD 2; NPix:= 1;
END
END;
IF NPix <> 0 THEN BEGIN
WRITE(Save, ' ', NPix);
END;
WRITELN(Save);
END;
CLOSE(Save);
END; {SavePlot}
PROCEDURE PrintPlot;
VAR
XG, YG,
Line, Bit, Dot,
Out1, Out2, Out3 : INTEGER;
C1, C2, C3 : CHAR;
BEGIN
WRITELN(Lst);
WRITELN(Lst);
WRITELN(Lst);
FOR Line:= 0 TO MaxYPix DIV 12 DO BEGIN
WRITE(Lst, CHR(27), '*', CHR(39), CHR(0), CHR(5)); {Start graphics mode}
YG:= 12 * Line;
FOR XG:= 0 TO MaxXPix DO BEGIN
Out1:= 0; Out2:= 0; Out3:= 0;
FOR Bit:= 0 TO 3 DO BEGIN
Dot := GetPixel(XG, YG + Bit); IF Dot <> 0 THEN Dot:= 3;
Out1:= 4 * Out1 + Dot;
Dot := GetPixel(XG, YG + Bit + 4); IF Dot <> 0 THEN Dot:= 3;
Out2:= 4 * Out2 + DOT;
Dot := GetPixel(XG, YG + Bit + 8); IF Dot <> 0 THEN Dot:= 3;
Out3:= 4 * Out3 + Dot;
END;
C1:= CHR(Out1); C2:= CHR(Out2); C3:= CHR(Out3);
WRITE(Lst, C1, C2, C3, C1, C2, C3);
END;
WRITE(Lst, CHR(27), 'J', CHR(24), CHR(13)); {24 dot line feed}
END;
WRITELN(Lst);
WRITELN(Lst);
WRITELN(Lst);
END; {PrintPlot}
PROCEDURE MoveToL(X, Y : INTEGER);
BEGIN
MoveTo(X, MaxYPix - Y);
END; {MoveToL}
PROCEDURE LineToL(X, Y : INTEGER);
BEGIN
LineTo(X, MaxYPix - Y);
END; {LineToL}
FUNCTION ForceColor(Color : ColorType) : ColorType;
BEGIN
Color:= Color MOD Palette.Size;
IF Color = 0 THEN Color:= 1;
SetColor(Color);
ForceColor:= Color;
END; {ForceColor}
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:= ARCTAN(Y / X);
IF X > 0 THEN ATan2:= Temp
ELSE
IF Y >= 0 THEN ATan2:= Temp + Pi
ELSE ATan2:= Temp - Pi;
END;
END; {ATan2}
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(OutP^, S:7: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; {Output2}
PROCEDURE RHSF; {Evaluate the Right Hand Side Function}
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; {RHSF}
PROCEDURE RKutta(VAR S : REAL; H : REAL); {MUST CALL RHSF BEFORE RKutta}
{Runge-Kutta method of integration of ordinary differential equations}
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; {RKutta}
PROCEDURE AIRK(VAR S : REAL; SI, H : REAL); {Advance Integration by RKutta}
LABEL ExitAIRK;
BEGIN
IF SI = S THEN GoTo ExitAIRK;
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;
ExitAIRK:
END; {AIRK}
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;
Output2;
Functn:= A - Zeta;
END; {Functn}
PROCEDURE Root(X1, X2, EY : REAL; NT : INTEGER; VAR X : REAL);
LABEL ExitRoot;
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(OutP^, 'CONVERGED'); Converge:= TRUE; GoTo ExitRoot;
END;
REPEAT
IF KEYPRESSED THEN BEGIN
Ch:= ReadKey;
IF Ch = '0' THEN BEGIN
WRITELN(OutP^, 'MANUALLY ABORTED BEFORE CONVERGANCE');
Abort:= TRUE; GoTo ExitRoot;
END;
END;
UNTIL NOT KEYPRESSED;
END;
WRITELN('DID NOT CONVERGE IN ', NT, ' ITERATIONS');
ExitRoot:
END; {Root}
PROCEDURE GetCase(N : INTEGER);
LABEL ExitGetCase;
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 GoTo ExitGetCase;
Dublu:= 1.0 / OneOW;
EMu:= Dublu * Factor;
RHSF;
ExitGetCase:
END; {GetCase}
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; {GetReal}
PROCEDURE Perp(DOTS : INTEGER);
VAR
XP, YP, XL, YL : INTEGER;
R : REAL;
BEGIN
XP:= GetX; YP:= MaxYPix - GetY;
WITH Vector DO BEGIN
R:= SQRT(SQR(TX) + SQR(TY));
XL:= TRUNC(XP + DOTS * -TY / R);
YL:= TRUNC(YP + DOTS * TX / R);
END;
MoveToL(XL, YL);
XL:= XP + XP - XL;
YL:= YP + YP - YL;
LineToL(XL, YL);
MoveToL(XP, YP);
END; {Perp}
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((MaxXPix - XZ) / ScaleT);
N3:= -TRUNC((YZ) / ScaleT);
N4:= TRUNC((MaxYPix - YZ) / ScaleT);
MoveToL(0, 0);
SetColor(WHITE); TX:= 1; TY:= 0;
FOR I:= N1 TO N2 DO BEGIN
LineToL(TRUNC(I * ScaleT) + XZ, 0); Perp(Dot4);
END;
LineToL(MaxXPix, 0); TX:= 0; TY:= 1;
FOR I:= N3 TO N4 DO BEGIN
LineToL(MaxXPix, TRUNC(I * ScaleT) + YZ); Perp(Dot4);
END;
LineToL(MaxXPix, MaxYPix); TX:= -1; TY:= 0;
FOR I:= N2 DOWNTO N1 DO BEGIN
LineToL(TRUNC(I * ScaleT) + XZ, MaxYPix); Perp(Dot4);
END;
LineToL(0, MaxYPix); TX:= 0; TY:= -1;
FOR I:= N4 DOWNTO N3 DO BEGIN
LineToL(0, TRUNC(I * ScaleT) + YZ); Perp(Dot4);
END;
LineToL(0, 0);
END;
END; {Grid}
PROCEDURE PlotSt;
LABEL ExitPlotSt;
VAR
Ch : CHAR;
MinH, MaxH,
ScaleF, IR, SV,
Scale : REAL;
ScaleX : REAL;
XP, YP,
XZ, YZ, CN : INTEGER;
St : STRING;
PROCEDURE PlotM(VAR S : REAL; SI, H : REAL);
LABEL ExitPlotM;
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; {CompH}
PROCEDURE Plot1;
BEGIN
WITH Vector DO BEGIN
XP:= ROUND(X * Scale) + XZ;
YP:= ROUND(Y * Scale) + YZ;
END;
LineToL(XP, YP);
END; {Plot1}
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 > MaxYPix) THEN GoTo ExitPlotM;
END;
H:= SI - S;
IF H <> 0 THEN BEGIN
RKutta(S, H); RHSF; Plot1;
END;
S:= SI;
ExitPlotM:
END; {PlotM}
BEGIN {PlotSt}
ClrScr; WRITELN;
WRITELN('Note: Type an "S" after the plot to save it to B:FLYAKITE.OUT');
WRITELN(' Type a "P" after the plot to print it on LQ-2500 printer');
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 GoTo ExitPlotSt;
GetCase(CN);
Dot2:= Round(MaxYPix / 100.0);
Dot4:= Dot2 + Dot2;
Scale:= 0.9 * MaxYPix / YMax; ScaleX:= 0.9 * MaxXPix / 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((MaxXPix - XMax * Scale) / 2.0);
YZ:= ROUND((MaxYPix - YMax * Scale) / 2.0);
WRITELN('INPUT 0.1 <= X <= ', MaxXPix,
' DOT POSITION TO PLOT X=0 OR 0 IF ', XZ, ' IS OK');
IR:= GetReal(0, MaxXPix);
IF IR <> 0 THEN XZ:= ROUND(IR);
WRITELN('INPUT 0.1 <= Y <= ', MaxYPix,
' DOT POSITION TO PLOT Y=0 OR 0 IF ', YZ, ' IS OK');
IR:= GetReal(0, MaxYPix);
IF IR <> 0 THEN YZ:= ROUND(IR);
SetGraphMode(Mode);
SetBkColor(Black);
Color:= ForceColor(White);
MoveToL(XZ, YZ);
Perp(Dot4);
WHILE SI > S+1000.0 DO BEGIN
PlotM(S, S+1000.0, H); Perp(Dot2);
END;
SV:= S+1000.0;
PlotM(S, SI, H); Perp(Dot4);
PlotM(S, SV, H); Perp(Dot2);
REPEAT
PlotM(S, S+1000.0, H);
IF (XP > -1) AND (YP <= MaxYPix) THEN Perp(Dot2);
UNTIL (XP < 0) OR (YP > MaxYPix);
GetCase(CN); MoveToL(XZ, YZ); SetColor(WHITE);
REPEAT
PlotM(S, S - 1000.0, H);
IF (XP > -1) AND (YP <= MaxYPix) THEN Perp(Dot2);
UNTIL (XP < 0) OR (YP > MaxYPix);
Grid(XZ, YZ, Scale);
Color:= ForceColor(Yellow);
XP:= 3 + Dot4; YP:= 3 + Dot4; MoveTo(XP, YP);
OutText(FileName);
OutText(' Flight # '); Str(CN, St); OutText(St);
YP:= YP + Dot2 + TextHeight('M'); MoveTo(XP, YP);
OutText('Scale = '); Str(ScaleF:1:1, St); OutText(St);
OutText(' Ft/Pixel 1000 Ft/Tic');
YP:= YP + Dot2 + TextHeight('M'); MoveTo(XP, YP);
OutText('X=0 @ '); Str(XZ, St); OutText(St);
OutText(' Y=0 @ '); Str(YZ, St); OutText(St);
OutText(' of '); Str(MaxXPix + 1, St); OutText(St);
OutText('x'); Str(MaxYPix + 1, St); OutText(St);
OutText(' Pixels');
Ch:= ReadKey; Ch:= UpCase(Ch);
IF Ch = 'S' THEN SavePlot;
IF Ch = 'P' THEN PrintPlot;
RestoreCrtMode; {TEXTMODE;}
ExitPlotSt:
END; {PlotSt}
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; {ClearData}
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;
} Ch:= ReadKey;
END;
END; {CkIO}
PROCEDURE Init;
VAR I : INTEGER;
BEGIN
TextBackground(Black);
TextColor(Yellow);
{ Device:= CGA; Mode:= CGAHi; }
Device:= Detect; Mode:= 0;
InitGraph(Device, Mode, '');
MaxXPix:= GetMaxX; MaxYPix:= GetMaxY;
GetPalette(Palette);
IF Palette.Size < 2 THEN Palette.Size:= 2;
RestoreCrtMode;
ClrScr;
WRITELN;
WRITELN('Program FLYAKITE - A kite flying program');
WRITELN(Revision);
WRITELN('COPYRIGHT (c) 1981-1988 By author: Harry J Smith, Saratoga, CA');
WRITELN;
WRITELN('MEMAVAIL = ', MEMAVAIL);
WRITELN;
WRITELN('Device, Mode, MaxX, MaxY = ',
Device, ' ', Mode, ' ', MaxXPix, ' ', MaxYPix);
WRITE('Palette.Size: Colors = ', Palette.Size, ':');
FOR I:= 0 TO Palette.Size - 1 DO
WRITE(' ', Palette.Colors[I]);
WRITELN;
PiO4:= ArcTan(1.0);
PiO2:= 2.0 * PiO4;
Pi:= 2.0 * PiO2;
Pi2:= 2.0 * Pi;
DPR:= 180.0 / Pi;
Bell:= CHR(7);
FileName:= 'NOT-ENTERED-YET';
PrintName:= 'CONSOLE:';
OutP:= @Output;
ClearData;
WRITELN('HIT ANY KEY TO CONTINUE');
OneCh:= ReadKey;
END; {Init}
PROCEDURE ScrHed;
BEGIN
ClrScr;
WRITELN('OUTPUT TOGGLE SET TO ', PrintName,
' FLIGHT FILE NAME IS ', FileName);
WRITELN;
END; {ScrHed}
PROCEDURE Scr1;
BEGIN
ScrHed;
WRITELN('0. QUIT, RETURN TO THE 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(1, 23);
WRITE('SELECT OPTION ');
END; {Scr1}
PROCEDURE TogglePr;
BEGIN
IF PrintName = 'CONSOLE:'
THEN OutP:= @Lst
ELSE OutP:= @Output;
IF PrintName = 'CONSOLE:'
THEN PrintName:= 'PRINTER:'
ELSE PrintName:= 'CONSOLE:';
END; {TogglePr}
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 A:81DEC31A.FLY');
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(1, 23);
WRITE('SELECT OPTION ');
END; {ScrDBM}
PROCEDURE EnterName;
VAR Ch : CHAR; I : INTEGER;
BEGIN
ScrHed;
WRITELN('INPUT FLIGHT FILE NAME');
READLN(FileName);
FOR I:= 1 TO Length(FileName) DO
FileName[I]:= UpCase(FileName[I]);
END; {EnterName}
PROCEDURE LoadFile;
LABEL ExitLoadFile;
VAR I, J : INTEGER; Ch : CHAR;
BEGIN
REPEAT
ScrHed;
WRITELN('DO YOU WISH TO LOAD FLIGHT FILE FROM DISK? (Y/N)');
Ch:= ReadKey; Ch:= UpCase(Ch);
UNTIL (Ch = 'Y') OR (Ch = 'N');
WRITELN;
IF Ch = 'Y' THEN BEGIN
ClearData;
Assign(FDat, FileName);
RESET(FDat); CkIO(J);
IF J=0 THEN BEGIN
READ(FDat, ADat[0]); CkIO(J);
IF J <> 0 THEN GoTo ExitLoadFile;
FOR I:= 1 TO ADat[0].NR DO BEGIN
READ(FDat, ADat[I]); CkIO(J);
IF J <> 0 THEN GoTo ExitLoadFile;
END;
CLOSE(FDat); CkIO(J);
END;
END;
ExitLoadFile:
END; {LoadFile}
PROCEDURE StoreFile;
LABEL ExitStoreFile;
VAR I, J : INTEGER; Ch : CHAR;
BEGIN
REPEAT
ScrHed;
WRITELN('DO YOU WISH TO STORE FLIGHT FILE ONTO DISK? (Y/N)');
Ch:= ReadKey; Ch:= UpCase(Ch);
UNTIL (Ch = 'Y') OR (Ch = 'N');
WRITELN;
IF Ch = 'Y' THEN BEGIN
Assign(FDat, FileName);
REWRITE(FDat); CkIO(J);
IF J=0 THEN BEGIN
FOR I:= 0 TO ADat[0].NR DO BEGIN
WRITE(FDat, ADat[I]); CkIO(J);
IF J <> 0 THEN GoTo ExitStoreFile;
END;
CLOSE(FDat); CkIO(J);
END;
END;
ExitStoreFile:
END; {StoreFile}
PROCEDURE ClearTest;
VAR Ch : CHAR;
BEGIN
REPEAT
ClrScr;
WRITELN('DO YOU WISH TO CLEAR ALL FLIGHT DATA IN MAIN MEMORY? (Y/N)');
Ch:= ReadKey; Ch:= UpCase(Ch);
UNTIL (Ch = 'Y') OR (Ch = 'N');
IF Ch = 'Y' THEN ClearData;
END; {ClearTest}
PROCEDURE DispData;
VAR CN : INTEGER; Ch : CHAR;
BEGIN
ClrScr;
WRITELN(OutP^); WRITELN(OutP^);
WRITELN(OutP^, 'FLIGHT DATA FILE ', FileName);
WRITELN(OutP^); WRITELN(OutP^, ' FAC1 FAC2 ONEOW H');
WITH ADat[0] DO
WRITELN(OutP^, Fac1R:8:2, Fac2R:8:2, OOWR:8:1, HR:8:1);
WRITELN(OutP^); WRITELN(OutP^,
' LEN T ZETA SA FACTOR XKITE YKITE FLIGHT');
FOR CN:= 1 TO ADat[0].NR DO
WITH ADat[CN] DO
WRITELN(OutP^, LenR:7:1, TR:8:2, ZetaR:8:2, SAR:8:2, FactR:8:2,
XMR:8:1, YMR:8:1, CN:6);
WRITELN(OutP^, 'EOF');
IF PrintName = 'CONSOLE:' THEN Ch:= ReadKey;
END; {DispData}
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(1, 23);
WRITE('SELECT OPTION ');
END; {ScreH}
PROCEDURE InH;
BEGIN
WITH ADat[0] DO BEGIN
ClrScr;
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; {InH}
PROCEDURE InOOW;
BEGIN
WITH ADat[0] DO BEGIN
ClrScr;
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; {InOOW}
PROCEDURE InFact1;
BEGIN
WITH ADat[0] DO BEGIN
ClrScr;
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; {InFact1}
PROCEDURE InFact2;
BEGIN
WITH ADat[0] DO BEGIN
ClrScr;
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; {InFact2}
BEGIN {EnterHed}
REPEAT
ScreH;
Ch:= ReadKey;
CASE Ch OF
'1': InH;
'2': InOOW;
'3': InFact1;
'4': InFact2;
END;
UNTIL Ch = '0';
END; {EnterHed}
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(1, 23);
WRITE('SELECT OPTION ');
END; {ScrDat}
PROCEDURE InLen;
BEGIN
WITH ADat[CN] DO BEGIN
ClrScr;
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; {InLen}
PROCEDURE InT;
BEGIN
WITH ADat[CN] DO BEGIN
ClrScr;
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; {InT}
PROCEDURE InZeta;
BEGIN
WITH ADat[CN] DO BEGIN
ClrScr;
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; {InZeta}
PROCEDURE InSA;
BEGIN
WITH ADat[CN] DO BEGIN
ClrScr;
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; {InSA}
PROCEDURE AddLine;
BEGIN
WITH ADat[0] DO BEGIN
IF NR < MaxR THEN NR:= NR+1;
CN:= NR;
END;
END; {AddLine}
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; {DelLine}
PROCEDURE AdvLine;
BEGIN
IF CN >= ADat[0].NR THEN CN:= 1
ELSE CN:= CN+1;
END; {AdvLine}
BEGIN {EnterData}
CN:= 1;
IF ADat[0].NR = 0
THEN ADat[0].NR:= 1;
REPEAT
ScrDat;
Ch:= ReadKey;
CASE Ch OF
'1': InLen;
'2': InT;
'3': InZeta;
'4': InSA;
'5': AddLine;
'6': DelLine;
'7': AdvLine;
END;
UNTIL Ch = '0';
END; {EnterData}
BEGIN {DBM}
REPEAT
ScrDBM;
Ch:= ReadKey;
CASE Ch OF
'1': TogglePr;
'2': EnterName;
'3': LoadFile;
'4': StoreFile;
'5': ClearTest;
'6': EnterHed;
'7': EnterData;
'8': DispData;
END;
UNTIL Ch = '0';
END; {DBM}
PROCEDURE CompFact;
VAR CN, CNMax : INTEGER; Ch : CHAR;
BEGIN
ClrScr;
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(OutP^); WRITELN(OutP^);
WRITELN(OutP^, 'COMPUTE WIND FACTORS FOR FLIGHT FILE ',
FileName, ' FOR FLIGHT ', CN, ' THRU ', CNMax);
REPEAT
GetCase(CN);
IF( OneOW > 0) AND (T > 0) THEN BEGIN
WRITELN(OutP^); WRITELN(OutP^); WRITELN(OutP^,
' LEN T ZETA SA FAC1 FAC2 ONEOW H FLIGHT');
WRITELN(OutP^, SI:7: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(OutP^); WRITELN(OutP^,
' 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;
END;
CN:= CN+1;
UNTIL (CN > CNMax) OR (OneOW <= 0) OR Abort;
IF PrintName = 'CONSOLE:' THEN Ch:= ReadKey;
END;
BEGIN {FlyAKite}
Init;
REPEAT
REPEAT
Scr1;
OneCh:= ReadKey;
CASE OneCh OF
'1': TogglePr;
'2': DBM;
'3': CompFact;
'4': PlotSt;
'5': BEGIN SetGraphMode(Mode); SetBkColor(Black); END;
'6': RestoreCrtMode;
END;
UNTIL OneCh = '0';
REPEAT
ClrScr;
WRITELN('DO YOU WISH TO RETURN TO THE SYSTEM? (Y/N)');
OneCh:= ReadKey; OneCh:= UpCase(OneCh);
UNTIL (OneCh = 'Y') OR (OneCh = 'N');
UNTIL OneCh = 'Y';
ClrScr;
END. {FlyAKite}
Return to FlyAKite Program
Return to Harry's Home Page
times since October 20, 2004.