DataMuseum.dk

top - download

    Length: 12480 (0x30c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »CHANGE.K«

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »CHANGE.K« 

Mikados K File

PROCEDURE CHGCONTENTS(VAR EL:ELEMENT);
VAR NEWEL:ELEMENT;
    SAVENR,I,OPT1,OPT2:INTEGER;
(*$P*)
PROCEDURE CHGCONT2;
PROCEDURE FJERN(VAR AKTFELT:ELEMENT);
BEGIN
  IF AKTFELT<>NIL THEN
  BEGIN
    NEWEL:=AKTFELT^.NEXTELEMENT;
    AKTFELT^.NEXTELEMENT:=NIL;
    SAVE(SAVENR):=AKTFELT; 
    AKTFELT:=NEWEL
  END ELSE WRITELN('Intet at fjerne')
END;
PROCEDURE INDFØJ(VAR AKTFELT:ELEMENT);
BEGIN
  IF AKTFELT<>NIL THEN
  BEGIN
    NEWEL:=AKTFELT;
    SINGLE:=TRUE;
    AKTFELT:=VANDRET;
    SINGLE:=FALSE;CHANGING:=FALSE;
    CASE AKTFELT^.ELEMENTTYPE OF
    FELT,INDKOMMANDO,
    UDKOMMANDO,BEREGN:AKTFELT^.NEXTELEMENT:=NEWEL;
    PICTURE:AKTFELT^.FØRSTFELT:=NEWEL;
    GENTAG:AKTFELT^.FIRSTFELT:=NEWEL;
    OTHERWISE WRITELN('TYPEFEJL I ELEMENTINDFØJELSE VANDRET')
  END ELSE AKTFELT:=VANDRET
END;
BEGIN
  WITH EL^ DO
    BEGIN (*OPT1=2*)
      CLEARSCREEN;
      WRITELN('Strukturændring');
      IF ELEMENTTYPE IN (.PICTURE,GENTAG.) THEN
      BEGIN
        GOTOXY(1,5);
        WRITELN('1 Vandret');
        WRITELN('2 Lodret');
        REPEAT
          GOTOXY(1,8);
          WRITE('Vælg 1-2 ');READLN;READ(OPT1)
        UNTIL (IORESULT=0) AND (OPT1 IN (.1,2.))
      END;
      GOTOXY(1,10);
      WRITELN('Mulige ændringer');
      GOTOXY(1,11);
      WRITELN('1 Fjern første');
      WRITELN('2 Fjern kæde');
      WRITELN('3 Indføj element');
      WRITELN('4 Indføj kæde');
      REPEAT
        GOTOXY(1,16);
        WRITE('Vælg 1-4 ');READLN;READ(OPT2)
      UNTIL (IORESULT=0) AND (OPT2 IN (.1..4.));
      IF OPT2 IN (.1,2.) THEN
      REPEAT
        GOTOXY(1,18);
        WRITE('Gemmes i nr 1..10, 0 for nej ');READLN;READ(SAVENR)
      UNTIL (IORESULT=0) AND (SAVENR IN (.0..10.));
      CASE ELEMENTTYPE OF
      LISTEDESC,
      PICTURE,
      GENTAG :IF OPT1=2 THEN
              CASE OPT2 OF
              1:IF NEXTELEMENT<>NIL THEN
                BEGIN
                  NEWEL:=NEXTELEMENT^.NEXTELEMENT;
                  NEXTELEMENT^.NEXTELEMENT:=NIL;
                  SAVE(SAVENR):=NEXTELEMENT;
                  NEXTELEMENT:=NEWEL
                END
                ELSE WRITELN('Der er intet at slette');
              2:BEGIN
                  SAVE(SAVENR):=NEXTELEMENT;
                  NEXTELEMENT:=NIL
                END;
              3:IF NEXTELEMENT<>NIL THEN
                BEGIN
                  NEWEL:=NEXTELEMENT;
                  SINGLE:=TRUE;
                  NEXTELEMENT:=LODRET;
                  SINGLE:=FALSE;
                  CHANGING:=FALSE;
                  NEXTELEMENT^.NEXTELEMENT:=NEWEL
                END
                ELSE NEXTELEMENT:=LODRET;
              4:IF NEXTELEMENT=NIL THEN
                BEGIN
                  REPEAT
                    GOTOXY(1,18);WRITE('Hvilken kæde (1-10, 0 for nej ');
                    READLN;READ(SAVENR)
                  UNTIL (IORESULT=0) AND (SAVENR IN (.0..10.));
                  IF SAVENR<>0 THEN
                  IF SAVE(SAVENR)^.ELEMENTTYPE IN (.PICTURE,GENTAG.) THEN
                    NEXTELEMENT:=SAVE(SAVENR)
                END
                ELSE WRITELN('Kæde allerede præsent')
              END
              ELSE (*OPT1=1*)
              CASE OPT2 OF
              1:IF ELEMENTTYPE=PICTURE THEN
                  FJERN(FØRSTFELT)
                ELSE 
                  FJERN(FIRSTFELT);
              2:IF ELEMENTTYPE=PICTURE THEN
                BEGIN
                  SAVE(SAVENR):=FØRSTFELT;
                  FØRSTFELT:=NIL
                END
                ELSE
                BEGIN
                  SAVE(SAVENR):=FIRSTFELT;
                  FIRSTFELT:=NIL
                END;
              3:IF ELEMENTTYPE=PICTURE THEN
                  INDFØJ(FØRSTFELT)   
                ELSE 
                  INDFØJ(FIRSTFELT);
              4:BEGIN
                  REPEAT
                    GOTOXY(1,18);WRITE('Hvilken kæde (1..10, 0 for nej ');
                    READLN;READ(SAVENR)
                  UNTIL (IORESULT=0) AND (SAVENR IN (.0..10.));
                  IF SAVENR<>0 THEN
                  BEGIN
                    IF ELEMENTTYPE=PICTURE THEN
                    IF FØRSTFELT=NIL THEN
                      FØRSTFELT:=SAVE(SAVENR)
                    ELSE WRITELN('Kæde allerede præsent')
                    ELSE
                    IF FIRSTFELT=NIL THEN
                      FIRSTFELT:=SAVE(SAVENR)
                    ELSE WRITELN('Kæde allerede præsent')
                  END
                END
              END;
      INDKOMMANDO,UDKOMMANDO,
      BEREGN,
      FELT   :CASE OPT2 OF
              1:IF NEXTELEMENT<>NIL THEN
                BEGIN
                  NEWEL:=NEXTELEMENT^.NEXTELEMENT;
                  NEXTELEMENT^.NEXTELEMENT:=NIL;
                  SAVE(SAVENR):=NEXTELEMENT;
                  NEXTELEMENT:=NEWEL
                END
                ELSE WRITELN('Der er intet at fjerne');
              2:BEGIN
                  SAVE(SAVENR):=NEXTELEMENT;
                  NEXTELEMENT:=NIL
                END;
              3:IF NEXTELEMENT<>NIL THEN
                BEGIN
                  NEWEL:=NEXTELEMENT;
                  SINGLE:=TRUE;
                  NEXTELEMENT:=VANDRET;
                  SINGLE:=FALSE;CHANGING:=FALSE;
                  NEXTELEMENT^.NEXTELEMENT:=NEWEL
                END ELSE NEXTELEMENT:=VANDRET;
              4:IF NEXTELEMENT=NIL THEN
                BEGIN
                  REPEAT
                    GOTOXY(1,18);WRITE('Hvilken kæde, (0..10, 0 for nej) ');
                    READLN;READ(SAVENR)
                  UNTIL (IORESULT=0) AND (SAVENR IN (.0..10.));
                  IF SAVENR<>0 THEN NEXTELEMENT:=SAVE(SAVENR)
                END
                ELSE WRITELN('Kæde allerede præsent')
              END
      END
    END
END;
(*$P*)
BEGIN
  WITH EL^ DO
  BEGIN
    CLEARSCREEN;
    WRITELN('Ændring af elementtype: ',ELTYPE(ORD(ELEMENTTYPE)));
    GOTOXY(1,5);
    WRITELN('1 Indholdsændring');
    WRITELN('2 Strukturændring');
    REPEAT
      GOTOXY(1,8);
      WRITELN('Vælg 1-2 ');READLN;READ(OPT1)
    UNTIL (IORESULT=0) AND (OPT1 IN (.1,2.));
    IF OPT1=1 THEN
    BEGIN
      CHANGING:=TRUE;
      CASE ELEMENTTYPE OF
      LISTEDESC:BEGIN
                  REPEAT
                    GOTOXY(1,10);
                    WRITE('LINESPP ',LINESPP);
                    READLN;READ(LINESPP)
                  UNTIL (IORESULT=0) AND (LINESPP IN (.1..72.));
                  FOR I:=1 TO 8 DO
                  REPEAT
                    GOTOXY(1,10+I);
                    WRITE('FILES(',I:2,')',FILES(I):3);READLN;
                    READ(FILES(I))
                  UNTIL IORESULT=0
                END;
      INDKOMMANDO,
      UDKOMMANDO:BEGIN
                   NEWEL:=IOKOMM;
                   ELEMENTTYPE:=NEWEL^.ELEMENTTYPE;
                   IF ELEMENTTYPE=INDKOMMANDO THEN
                   BEGIN
                     GETFILREF:=NEWEL^.GETFILREF;
                     GETMODE:=NEWEL^.GETMODE;
                     FØRSTNØGL:=NEWEL^.FØRSTNØGL
                   END
                   ELSE
                   BEGIN
                     PUTFILREF:=NEWEL^.PUTFILREF;
                     PUTMODE:=NEWEL^.PUTMODE
                   END
                 END;
      PICTURE:BEGIN
                NEWEL:=BILLEDE;
                PICTPOS:=NEWEL^.PICTPOS;
                PICTNAVN:=NEWEL^.PICTNAVN
              END;
      GENTAG:BEGIN
               NEWEL:=GENTAGELSE;
               LØKKETYPE:=NEWEL^.LØKKETYPE;
               BETINGELSE:=NEWEL^.BETINGELSE;
               POSINCR:=NEWEL^.POSINCR
             END;
      BEREGN:BEGIN
               NEWEL:=BEREGNING;
               UDTRYK:=NEWEL^.UDTRYK;
               GEMREF:=NEWEL^.GEMREF;
               GEMINDEKS:=NEWEL^.GEMINDEKS;
               UDTRYKTYPE:=NEWEL^.UDTRYKTYPE
             END;
      FELT:BEGIN
             NEWEL:=FIELD;
             INDPOS:=NEWEL^.INDPOS;
             EDITERING:=NEWEL^.EDITERING;
             POSTREF:=NEWEL^.POSTREF;
             INDEKS:=NEWEL^.INDEKS;
             LÆNGDE:=NEWEL^.LÆNGDE;
             FORAN0:=NEWEL^.FORAN0;
             FELTTYPE:=NEWEL^.FELTTYPE;
             IF FELTTYPE=REEL THEN DEC:=NEWEL^.DEC;
             IF NEWEL^.NEXTELEMENT<>NIL THEN NEXTELEMENT:=NEWEL^.NEXTELEMENT
           END
      END; (*CASE ELEMENTTYPE*)
      CHANGING:=FALSE
    END (*OPT1=1*)
    ELSE
      CHGCONT2       
  END
END;
(*$P*)
PROCEDURE CHANGE(VAR EL:ELEMENT;CURRPICT:STRING);
VAR OPT1,OPT2:INTEGER;
    CVANDRET,CLODRET:ELEMENT;
 
PROCEDURE SETOKSET;
VAR I:INTEGER;
BEGIN
  CVANDRET:=NIL;
  CLODRET:=NIL;
  FOR I:=1 TO 5 DO OKSET(I):=0;I:=1;
  WITH EL^ DO
  CASE ELEMENTTYPE OF
  LISTEDESC:IF NEXTELEMENT<>NIL THEN
            BEGIN
              OKSET(1):=2;
              I:=2;
              CLODRET:=NEXTELEMENT
            END;
  PICTURE:BEGIN
            CURRPICT:=PICTNAVN;
            IF FØRSTFELT<>NIL THEN  
            BEGIN
              OKSET(1):=1;I:=2;CVANDRET:=FØRSTFELT
            END;
            IF NEXTELEMENT<>NIL THEN
            BEGIN
              OKSET(I):=2;I:=I+1;CLODRET:=NEXTELEMENT
            END 
          END;
  GENTAG: BEGIN
            IF FIRSTFELT<>NIL THEN  
            BEGIN
              OKSET(1):=1;I:=2;CVANDRET:=FIRSTFELT
            END;
            IF NEXTELEMENT<>NIL THEN
            BEGIN
              OKSET(I):=2;I:=I+1;CLODRET:=NEXTELEMENT
            END 
          END;
  FELT,INDKOMMANDO,
  UDKOMMANDO,       
  BEREGN: IF NEXTELEMENT<>NIL THEN
          IF NEXTELEMENT^.ELEMENTTYPE IN
             (.PICTURE..UDKOMMANDO,GENTAG,BEREGN.) THEN
          BEGIN
            OKSET(1):=1;
            I:=2;
            CVANDRET:=NEXTELEMENT
          END
  END;
  OKSET(I):=3;
  OKSET(I+1):=4;
  OKSET(I+2):=5
END;
(*$P*)
BEGIN
  WITH EL^ DO
  REPEAT
    CLEARSCREEN;
    SETOKSET;
    WRITELN('Ændring af elementtype :',ELTYPE(ORD(ELEMENTTYPE)),             
            ' i PICTURE ',CURRPICT);
    GOTOXY(1,5);
    OPT2:=6;
    FOR OPT1:=1 TO 5 DO
    IF OKSET(OPT1)>0 THEN
      WRITELN(OPT1:3,' ',CHGTYPE(OKSET(OPT1)))
    ELSE
    BEGIN
      OPT2:=OPT1;
      OPT1:=6
    END;
    REPEAT
      GOTOXY(1,11);
      WRITE('Indtast valg ');READLN;READ(OPT1)
    UNTIL (IORESULT=0) AND (OPT1>0) AND (OPT1<OPT2);
    OPT1:=OKSET(OPT1);
    CASE OPT1 OF
    1:CHANGE(CVANDRET,CURRPICT);
    2:CHANGE(CLODRET,CURRPICT);
    4:BEGIN
        REPEAT
          GOTOXY(1,13);
          WRITE('1: udfra dette element, 2: generelt ');
          READLN;READ(OPT2)
        UNTIL (IORESULT=0) AND (OPT2 IN (.1,2.));
        PRNIVEAU:=0;
        IF OPT2=1 THEN
          PRINTEL(EL)
        ELSE OPLYS
      END;
    5:CHGCONTENTS(EL)
    END
  UNTIL OPT1=3
END;
(*$P*)