DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »XYGRAF.PAS«

└─⟦ba3b4f658⟧ Bits:30003088 Xray: elevopgave i Pascal, feb 92
    └─⟦this⟧ »XYGRAF.PAS« 

TextFile

(* **************************************************************************
   ****                       XYGRAF                                     ****
   ****           Forklaring ligger i fotokopi.			         ****
   ************************************************************************** *)
PROCEDURE AKSER(A,B,aenhed,benhed:INTEGER);
  var sted,streg :integer;
BEGIN
   IF (B>=0) AND(B<=1023) THEN         (* X-AKSEN TEGNES *)
      BEGIN
         POSITION(0,B);FLYTTIL(1023,B);
         IF B<993 THEN FLYTTIL(993,B+30) ELSE FLYTTIL(993,1023);
         IF B>30 THEN FLYTTIL(993,B-30) ELSE FLYTTIL(993,0);
         FLYTTIL(1023,B);
         (* enheder tegnes *)
         STED:=A;WHILE STED>0 DO STED:=STED-AENHED;
         IF B<1013 THEN STREG:=10 ELSE STREG:=-10;
         WHILE STED<1023-AENHED DO
         BEGIN
           STED:=STED+AENHED;
           POSITION(STED,B);
           FLYTTIL(STED,B+STREG);
         END;
         
      END;
   IF (A>=0) AND (A<=1023) THEN         (* Y-AKSEN TEGNGES *)
      BEGIN
         POSITION(A,0);FLYTTIL(A,1023);
         IF A<993 THEN FLYTTIL(A+30,993) ELSE FLYTTIL(1023,993);
         IF A>30 THEN FLYTTIL(A-30,993) ELSE FLYTTIL(0,993);
         FLYTTIL(A,1023);
         (* ENHEDER TEGNES *)
         STED:=B;WHILE STED>0 DO STED:=STED-BENHED;
         IF A<1013 THEN STREG:=10 ELSE STREG:=-10;
         WHILE STED<1023-BENHED DO
           BEGIN
             STED:=STED+BENHED;
             POSITION(A,STED);
             FLYTTIL(A+STREG,STED);
           END;
      END;
END;

PROCEDURE TEGNGRAF(VAR DATA:REALARRAY;ANTAL:INTEGER;
                       XMIN,XMAX,YMIN,YMAX :REAL );
LABEL EXIT;
VAR I,K :INTEGER; VAERDI:REAL;Y:INTARRAY;CH:CHAR;
    XENHED,YENHED,XCENTRUM,YCENTRUM :REAL;
BEGIN
   WRITELN;WRITELN('*GRAFTEGNING ... ');WRITELN('*');
   WRITE('* SKAL KOORDINATSYSTEMET INDTEGNES? (J/N) : ');
   REPEAT READ(KBD,CH) UNTIL CH IN (.'J','j','n','N'.);WRITELN(CH);
   IF CH IN (.'J','j'.) THEN
     BEGIN
      
       WRITELN('HVORDAN SKAL AKSERNE INDELES ? ');
       WRITELN('X-AKSEN DÆKKER FRA ',XMIN:10:2,' TIL ',XMAX:10:2);
       WRITELN('Y-AKSEN DÆKKER FRA ',YMIN:10:2,' TIL ',YMAX:10:2);
       WRITE('HVOR LANGT SKAL DER VÆRE MELLEM MÆRKERNE PÅ X-AKSEN ?');
       READLN(XENHED);
       WRITE('HVOR LANGT SKAL DER VÆRE MELLEM MÆRKERNE PÅ Y-AKSEN ?');
       READLN(YENHED);
       XENHED:=XENHED/(XMAX-XMIN)*(1024 DIV ANTAL)*(ANTAL-1);
       YENHED:=YENHED/(YMAX-YMIN)*1023;
       XCENTRUM:=-XMIN/(XMAX-XMIN)*(1024 DIV ANTAL)*(ANTAL-1);
       YCENTRUM:=-YMIN/(YMAX-YMIN)*1023;
       AKSER(ROUND(XCENTRUM),ROUND(YCENTRUM),ROUND(XENHED),ROUND(YENHED));
     END;     
   K:=1024 DIV ANTAL;  (*SKALAFAKTOR *)
   FOR I:=0 TO ANTAL-1 DO
      BEGIN
         VAERDI:=1023/(YMAX-YMIN)*(DATA(.I.)-YMIN);
         IF (VAERDI<=-0.5) OR (VAERDI>=1023.5) THEN Y(.I.):=-1
                                               ELSE Y(.I.):=ROUND(VAERDI)
      END;
      I:=0;
      REPEAT
         WHILE Y(.I.) <0 DO    (* UDENFOR PAPIRET  *)
            BEGIN  I:=I+1; IF I>=ANTAL THEN GOTO EXIT END;
         POSITION(K*I,Y(.I.));
         WHILE Y(.I.)>=0 DO    (* INDEN FOR PAPIRET *)
            BEGIN MOVETO(K*I,Y(.I.));
                  I:=I+1; IF I>=ANTAL THEN GOTO EXIT 
            END;
         PENPAUSE
      UNTIL I>=ANTAL;
  EXIT:
  END;
  
  PROCEDURE TEGNKURVE(VAR DATAX,DATAY:REALARRAY;ANTAL :INTEGER;
  		     XMIN,XMAX,YMIN,YMAX :REAL );
  LABEL EXIT;
  VAR I:INTEGER; VAERDI:REAL;X,Y:INTARRAY;CH:CHAR;
      XENHED,YENHED,XCENTRUM,YCENTRUM : REAL;
  BEGIN
     WRITELN;WRITELN('* KURVETEGNING...');WRITELN('*');
     WRITE(' SKAL KOORDINATSYSTEMET TEGNES ? (J/N) : ');
     REPEAT READ(KBD,CH) UNTIL CH IN (.'J','j','n','N'.); WRITELN(CH);
     IF CH IN (.'J','j'.) THEN
        BEGIN
      
       WRITELN('HVORDAN SKAL AKSERNE INDELES ? ');
       WRITELN('X-AKSEN DÆKKER FRA ',XMIN:10:2,' TIL ',XMAX:10:2);
       WRITELN('Y-AKSEN DÆKKER FRA ',YMIN:10:2,' TIL ',YMAX:10:2);
       WRITE('HVOR LANGT SKAL DER VÆRE MELLEM MÆRKERNE PÅ X-AKSEN ?');
       READLN(XENHED);
       WRITE('HVOR LANGT SKAL DER VÆRE MELLEM MÆRKERNE PÅ Y-AKSEN ?');
       READLN(YENHED);
       XENHED:=XENHED/(XMAX-XMIN)*1023;
       YENHED:=YENHED/(YMAX-YMIN)*1023;
       XCENTRUM:=-XMIN/(XMAX-XMIN)*1023;
       YCENTRUM:=-YMIN/(YMAX-YMIN)*1023;
       AKSER(ROUND(XCENTRUM),ROUND(YCENTRUM),ROUND(XENHED),ROUND(YENHED));
     END;     
     FOR I:=0 TO ANTAL-1 DO
        BEGIN
           VAERDI:=1023/(XMAX-XMIN)*(DATAX(.I.)-XMIN);
           IF (VAERDI<=-0.5) OR (VAERDI>=1023.5) THEN X(.I.):=-1
           					 ELSE X(.I.):=ROUND(VAERDI);
           VAERDI:=1023/(YMAX-YMIN)*(DATAY(.I.)-YMIN);
           IF (VAERDI<=-0.5) OR (VAERDI>=1023.5) THEN Y(.I.):=-1
           					 ELSE Y(.I.):=ROUND(VAERDI);
        END;
     I:=0;
     REPEAT
        WHILE (X(.I.)<0) OR (Y(.I.)<0) DO (* UNDENFOR PAPIRET *)
           BEGIN I:=I+1; IF I>=ANTAL THEN GOTO EXIT END;
        POSITION(X(.I.),Y(.I.));
        WHILE (X(.I.)>=0) AND (Y(.I.)>=0) DO (* INDENFOR PAPIRET *)
           BEGIN MOVETO(X(.I.),Y(.I.));I:=I+1; IF I>=ANTAL THEN GOTO EXIT END;
        PENPAUSE;
     UNTIL I>=ANTAL;
  EXIT:
  END;

           «eof»