FlyAKite Apple ][ listing




(* 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


This page accessed times since October 20, 2004.
Page created by: hjsmithh@sbcglobal.net
Changes last made on Tuesday, 08-Jul-08 15:51:28 PDT

1