home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / DATAREP.ZIP / LIST.INC < prev    next >
Encoding:
Text File  |  1990-02-22  |  4.2 KB  |  108 lines
  1. {Lists the stimuli on the screen.  Because this program can be    }
  2. {modified for heteroassociation, both the f (input) and g(output) }
  3. {sets can be shown.                                               }
  4.  
  5. PROCEDURE List_test_set;
  6.      VAR Nr_of_characters: INTEGER;
  7.          Backward, Forward, Quit: BOOLEAN;
  8.  
  9.      PROCEDURE Write_Message (Biggest: INTEGER);
  10.          VAR Input_char: CHAR;
  11.          BEGIN;
  12.          Save_cursor;
  13.          Bottom_line;
  14.          Backward:= FALSE; Forward:= FALSE; Quit:= FALSE;
  15.          WRITE  ('There are', Biggest:3,
  16.                  ' stimuli to write. B)ack. F)orward. > ');
  17.          READLN (Input_char);
  18.          CASE Input_char OF
  19.               'B','b': Backward:= TRUE;
  20.               'F','f': Forward := TRUE;
  21.               OTHERWISE Quit:= TRUE;
  22.               END; 
  23.          Restore_cursor;
  24.          END;
  25.  
  26.      PROCEDURE Write_pair (One, Two: CHAR; I: INTEGER);
  27.          VAR J: INTEGER;
  28.              Name_one, Name_two: STRING;
  29.          BEGIN
  30.          CASE One OF 'F','f': Name_one:= F_set [I].Name;
  31.                      'G','g': Name_one:= G_set [I].Name;
  32.                      'T','t': Name_one:= T_set [I].Name;
  33.                      END;
  34.  
  35.          CASE Two OF 'F','f': Name_two:= F_set [I].Name;
  36.                      'G','g': Name_two:= G_set [I].Name;
  37.                      'T','t': Name_two:= T_set [I].Name;
  38.                      END;
  39.     
  40.          WRITE ('   ',One:1,'[',I:2,']. ');
  41.          FOR J:= 1 TO Nr_of_Characters DO WRITE (Name_one [J]);
  42.          WRITE ('   ',Two:1,'[',I:2,']. ');
  43.          FOR J:= 1 TO Nr_of_Characters DO WRITE (Name_two [J]);
  44.          WRITELN;
  45.          END;
  46.  
  47.      PROCEDURE List_screen (One, Two: CHAR);
  48.          VAR I, First, Last, Largest, Last_pair: INTEGER;
  49.          BEGIN
  50.          IF Number_present_in_set (One) >= Number_present_in_set (Two)
  51.               THEN Largest:= Number_present_in_set (One) 
  52.               ELSE Largest:= Number_present_in_set (Two);
  53.          First:= 1;
  54.          Last_pair:= Largest;
  55.          IF Last_pair > 16 THEN Last:= 16 ELSE Last:= Last_pair;
  56.          FOR I:= First TO Last DO Write_pair (One, Two, I);
  57.          IF Last_pair > 16 THEN 
  58.            REPEAT Write_message (Largest);
  59.                   IF Forward AND (NOT Quit) THEN 
  60.                              BEGIN 
  61.                              First:= Last + 1;
  62.                              Last:=  Last + 8;     {Write 7 more.}
  63.                              IF Last > Last_pair THEN Last:= Last_pair;
  64.                              FOR I:= First TO Last DO Write_pair (One, Two, I);
  65.                              First:= Last - 15;
  66.                              END;
  67.                   IF Backward AND (NOT Quit) THEN 
  68.                              BEGIN
  69.                              First:= First - 8;
  70.                              IF First < 1 THEN First:= 1;
  71.                              Last:= First + 15;
  72.                              IF Last > Last_pair THEN BEGIN
  73.                                                       Last:= Last_pair;
  74.                                                       First:= Last_pair - 15;
  75.                                                       END;
  76.                              Clear_block;
  77.                              WRITELN;
  78.                              FOR I:= First TO Last DO Write_pair (One, Two, I);
  79.                              END;
  80.                  UNTIL Quit;
  81.          END;
  82.  
  83.      PROCEDURE Type_list (One, Two: CHAR);  {To be used if do not have VT-100.}
  84.          VAR I, Largest: INTEGER;
  85.          BEGIN
  86.          IF Number_present_in_set (One) >= Number_present_in_set (Two)
  87.               THEN Largest:= Number_present_in_set (One) 
  88.               ELSE Largest:= Number_present_in_set (Two);
  89.          FOR I:= 1 TO Largest DO Write_pair (One, Two, I);
  90.          END;
  91.  
  92.      BEGIN  {List_test_set.}
  93.      Nr_of_Characters:= Dimensionality DIV 8;
  94.      IF VT100 THEN
  95.         BEGIN
  96.         Scroll_block;     Clear_block;
  97.         WRITELN;
  98.         IF FG_Mode THEN List_screen ('F','G');
  99.         IF NOT FG_mode THEN List_screen ('T','F');
  100.         END;
  101.      IF NOT VT100 THEN
  102.         BEGIN
  103.         IF FG_mode THEN Type_list ('F','G');
  104.         IF NOT FG_mode THEN Type_list ('T','F');
  105.         END;
  106.      END;   {List_test_set.}
  107.  
  108.