home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 09_10 / tricks / ptrtrick.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-11  |  2.3 KB  |  83 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      PTRTRICK.PAS                      *)
  3. (* Compiler  : Quick Pascal 1.0 (Demo-Version)            *)
  4. (* Bemerkung : Die Option Far-Call muß beim Compilieren   *)
  5. (*             gesetzt sein!                              *)
  6. (*         (c) 1991 Jens Rohloff & TOOLBOX                *)
  7. (* ------------------------------------------------------ *)
  8. PROGRAM Pointertrick (input, output);
  9.  
  10. CONST
  11.   max = 3;
  12.  
  13. TYPE
  14.   FUNC = FUNCTION(x : INTEGER) : REAL;
  15.     (* Der Typ Funktion wird geschaffen:   *)
  16.     (* Alle Funktionen mit der gleichen    *)
  17.     (* Schnittstelle sind vom gleichen Typ *)
  18.  
  19. VAR
  20.   Funktionen : ARRAY [1..max] OF FUNC;
  21.     (* Ein Feld, das auf Funktionen     *)
  22.     (* verweisen kann                   *)
  23.   hilf    : FUNC;
  24.   i       : INTEGER;
  25.   x       : REAL;
  26.   antwort : CHAR;
  27.  
  28.  
  29.   FUNCTION eins(X : INTEGER) : REAL;
  30.     (* Funktionen eins, zwei und drei haben *)
  31.     (* die gleichen Schnittstellen          *)
  32.   VAR
  33.     xx : REAL;
  34.   BEGIN
  35.     WriteLn('Funktion eins:');
  36.     WriteLn('"Ich wurde von', x, ' aufgerufen."');
  37.     IF x > 2 THEN
  38.       xx   := Funktionen[x-1](x-1);
  39.     eins := 1;
  40.   END;
  41.  
  42.   FUNCTION zwei(X : INTEGER) : REAL;
  43.   VAR
  44.     antwort : CHAR;
  45.     xx      : REAL;
  46.   BEGIN
  47.     WriteLn('Funktion ', x);
  48.     WriteLn('Im Funktionskörper etwas anders !');
  49.     IF x > 1 THEN BEGIN
  50.       WriteLn('Springen ja oder nein (J/N) [N] ');
  51.         (* Kleine Spielerei ... *)
  52.       ReadLn(antwort);
  53.       IF (UpCase(antwort) = 'J') THEN
  54.         xx := Funktionen[x-1](x);
  55.     END;
  56.     zwei := 2;
  57.   END;
  58.  
  59.   FUNCTION drei(X : INTEGER) : REAL;
  60.   BEGIN
  61.     WriteLn('Funktion ', x);
  62.     drei := 3;
  63.   END;
  64.  
  65. BEGIN
  66.   Funktionen[1] := eins;
  67.   Funktionen[2] := zwei;
  68.   Funktionen[3] := drei;
  69.   Write('Welche Funktion ? ');  ReadLn(i);
  70.   If ((i >= 1) AND (i <= max)) THEN x := Funktionen[i](i);
  71.   REPEAT
  72.     hilf := Funktionen[1];
  73.     FOR i := 1 TO max-1 DO Funktionen[i] := Funktionen[i+1];
  74.     Funktionen[max] := hilf;
  75.     Write('Welche Funktion ? '); ReadLn(i);
  76.     If ((i >= 1) AND (i <= max)) THEN x := Funktionen[i](i);
  77.     WriteLn('Ende ? (J/N) [N]');
  78.     ReadLn(antwort);
  79.   UNTIL(Upcase(antwort) = 'J')
  80. END.
  81. (* ------------------------------------------------------ *)
  82. (*               Ende von PTRTRICK.PAS                    *)
  83.