home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / microcrn / issue_44.arc / OR4.ARC / OR4.PAS < prev    next >
Pascal/Delphi Source File  |  1988-08-29  |  59KB  |  1,629 lines
  1.  
  2. {-----------------------------------------------------------------------}
  3. {||||||||||||||||             O R  4.0               |||||||||||||||||||}
  4. {-----------------------------------------------------------------------}
  5.  
  6.  {--------------------------------------------------------------------}
  7.  {      Three Level Hierarchy Object Learning Recognizer Design       }
  8.  {                    Using List Search Methods                       }
  9.  {--------------------------------------------------------------------}
  10.  
  11.      {-----------------------------------------------------------}
  12.      {                     Written by:                           }
  13.      {                                                           }
  14.      {                       21Aug88                             }
  15.      {                                                           }
  16.      {                      Art Gaffin                           }
  17.      {        1514 Canna Court, Mountain View, CA  94043         }
  18.      {                 Phone: (415) 964-5634                     }
  19.      {                                                           }
  20.      {                      Doug Gaffin                          }
  21.      { Dept of Zoology, Oregon State Univ, Corvallis, OR  97331  }
  22.      {                 Phone: (503) 754-3705                     }
  23.      {                                                           }
  24.      {                  ALL RIGHTS RESERVED                      }
  25.      {-----------------------------------------------------------}
  26.  
  27.  
  28.    {$V-} {$R-}        {$S-}  {tp4}
  29.    uses crt,dos;  {for readkey}{for intr}
  30.  
  31.  
  32. {========================= Global Constants: ===========================}
  33. const
  34.    RECOG_MEMORY_SIZE           = 64;
  35.    RECOG_MEMORY_SIZE_MINUS_1   = 63;
  36.  
  37. const
  38.    g_frame_size       : array [1..4] of word = (   4,    4,    3,    8 );
  39.    g_learn_similarity : array [1..3] of word = (   2,    3,    1 );
  40.    g_recog_similarity : array [1..3] of word = (   2,    1,    1 );
  41.    g_info_level       : array [1..3] of word = (   3,    2,    1 );
  42.  
  43.    g_perm_mem_thres   : array [1..3] of word = (  20,   25,   25 );
  44.    g_min_recog_freq   : array [1..3] of word = (  20,   25,   25 );
  45.    g_jitter_flag      : array [1..3] of word = (   0,    1,    1 );
  46.    g_fatigue_flag     : array [1..3] of word = (   0,    1,    1 );
  47.  
  48.    g_forget_threshold : array [1..3] of word = (  20,   25,   25 );
  49.    g_forget_level     : array [1..3] of word = ( 200,  200,  400 );
  50.    g_ration_level     : array [1..3] of word = ( 100,  200,  400 );
  51.  
  52. {========================= Utility Constants: ==========================}
  53.  
  54. const
  55.    CONTINUE_MODE      = 0;
  56.    EXIT_MODE          = 1;
  57.  
  58.    IDLE_MODE          = 0;
  59.  
  60.    LEARN_1_MODE       = 1;
  61.    LEARN_2_MODE       = 2;
  62.    LEARN_3_MODE       = 3;
  63.  
  64.    RECOG_1_MODE       = 4;
  65.    RECOG_2_MODE       = 5;
  66.    RECOG_3_MODE       = 6;
  67.  
  68.    MANUAL             = 0;
  69.    AUTO               = 1;
  70.  
  71.    AUTO_PASSES_1      = 1000;
  72.    AUTO_PASSES_2      = 1500;
  73.    AUTO_PASSES_3      = 1000;
  74.  
  75.    NORMAL_SPEED       = 0;
  76.    FAST_SPEED         = 1;
  77.    SLOW_SPEED         = 2;
  78.  
  79.  
  80. { ----------- declarations for menu across top of screen: ------------- }
  81. const
  82.    TOP_LINE_NUM_ITEMS = 7;
  83.  
  84.    Across_Top_Msg : string =
  85. '|'#27'@ -left   |'#26'@ -right   |'#17#217'@ -select    |(esc)@ -STOP process';
  86.  
  87.    Display_Mem_Msg : string =
  88. '|(esc)@,|Q@ -exit mode   |<any key>@ -toggles scroll on/off';
  89.  
  90.    Exit_Msg : string =
  91. '|(esc)@,|Q@ -exit/finish    |Y@ -go ahead and exit   |N@ -do NOT exit';
  92.  
  93.    Pop_Down_Msg : string =
  94. '|(esc)@ -exit menu   |'#24'@ -up   |'#25'@ -down   |'#17#217'@ -select';
  95.  
  96.    top_line_selno         : integer = 1;
  97.  
  98.    help_index_selno       : integer = 1;
  99.    help_index_x           : integer = 25;
  100.    help_index_y           : integer = 10;
  101.  
  102.    learn_selno            : integer = 1;
  103.    learn_x                : integer = 26;
  104.  
  105.    recognize_selno        : integer = 1;
  106.    recognize_x            : integer = 35;
  107.  
  108.    display_mem_selno      : integer = 1;
  109.    display_mem_x          : integer = 48;
  110.  
  111.    exit_x                 : integer = 1;
  112.  
  113.  
  114. {===================== Global Type Declarations: =======================}
  115.  
  116. type
  117.    FRAME_8      = array [0..7] of word;
  118.    CELL_8 = record
  119.                 element : FRAME_8;
  120.                frequency : integer;
  121.             end;
  122.    MEMORY_8 = array [0..RECOG_MEMORY_SIZE_MINUS_1] of CELL_8;
  123.  
  124.    SCREEN_BUF = array [0..79] of word;
  125.  
  126.  
  127. {===================== Global Data Declarations: =======================}
  128.  
  129. const
  130.    g_beep_mode      : word = 1;
  131.    g_exit_mode      : word = 0;
  132.    g_op_mode        : word = 0;
  133.    g_auto_mode      : word = 0;
  134.    g_speed_mode     : word = 0;
  135.  
  136. var
  137.    g_screen_buf     : SCREEN_BUF;
  138.    g_old_screen_buf : SCREEN_BUF;
  139.  
  140.  
  141. {================ Recognizer #1 Global Data Declarations ===============}
  142.  
  143. var
  144.    recog_memory_1     : MEMORY_8;
  145.    recog_memory_2     : MEMORY_8;
  146.    recog_memory_3     : MEMORY_8;
  147.  
  148.    g_memory_num       : word;
  149.  
  150.  
  151. {============================ Includes: ================================}
  152.  
  153. {$I PC_Box.pas}
  154.  
  155. {----------------------------------------------------------------------------}
  156. procedure  Set_Window_Area  (X,Y,Width,Height:integer);
  157. begin
  158.    Window(X, Y, (X + Width - 1), (Y + Height - 1));  GotoXY(1, 1);
  159. end;  {Set_Window_Area}
  160.  
  161. {----------------------------------------------------------------------------}
  162. procedure  Set_Color  (T,B:integer);
  163. begin
  164.    TextColor(T); TextBackground(B);
  165. end;  {Set_Color }
  166.  
  167. {----------------------------------------------------------------------------}
  168. procedure  Beep  (Freq,Duration : integer);
  169. begin
  170.    if ( g_beep_mode = 1 ) then begin
  171.       if (Duration > 0) then begin
  172.          sound(Freq); delay(Duration); nosound;
  173.       end
  174.       else begin
  175.          sound(Freq); sound(Freq); nosound;
  176.       end;
  177.    end;
  178. end;  {Beep}
  179.  
  180. {================= Turbo Pascal Version 3.0 =================================}
  181. (*
  182. function ReadKey : char;
  183. var
  184.    TmpChar : char;
  185. begin
  186.    read(kbd,TmpChar);
  187.    ReadKey := TmpChar;
  188. end;  {ReadKey}
  189. {----------------------------------------------------------------------------}
  190. procedure  Empty_KeyBuf;
  191. var
  192.    DummyChar : char;
  193. begin
  194.    while (keypressed) do DummyChar := ReadKey;
  195. end;  {Empty_KeyBuf}
  196. {----------------------------------------------------------------------------}
  197. function  GetKey : char;
  198. var
  199.    TmpChar : char;
  200. begin
  201.    { Get Keyboard Char - conv ==> Upcase, Fn= +150, Ck for valid }
  202.    TmpChar := ReadKey;
  203.    if ((TmpChar = Chr(27)) and KeyPressed)
  204.       then  begin  TmpChar := ReadKey;  GetKey := chr(ord(TmpChar) + 150);  end
  205.       else  GetKey := upcase(TmpChar);
  206. end;  {GetKey}
  207.   *)
  208. {================= Turbo Pascal Version 4.0 =================================}
  209. (**)
  210. procedure  Empty_KeyBuf;
  211. var
  212.    DummyChar : char;
  213. begin
  214.    while (keypressed) do DummyChar := ReadKey;
  215. end;  {Empty_KeyBuf}
  216. {----------------------------------------------------------------------------}
  217. function  GetKey : char;
  218. var
  219.    TmpChar : char;
  220. begin
  221.    { Get Keyboard Char - conv ==> Upcase, Fn= +150, Ck for valid }
  222.    TmpChar := ReadKey;
  223.    if (TmpChar = #0)
  224.       then  begin  TmpChar := ReadKey;  GetKey := chr(ord(TmpChar) + 150);  end
  225.       else  GetKey := upcase(TmpChar);
  226. end;  {GetKey}
  227. (**)
  228. {============================================================================}
  229. procedure  Rev_Video; begin  TextBackground(White); TextColor(Black); end;
  230. procedure  High_Video; begin  TextBackground(Black); TextColor(White); end;
  231. procedure  Med_Video; begin  TextBackground(Black); TextColor(LightGray); end;
  232.  
  233. {----------------------------------------------------------------------------}
  234. procedure  Clear_Msg_Line( Y_Loc:word );
  235. begin
  236.    Set_Window_Area(1,Y_Loc,80,1);  Med_Video;  clrscr;
  237. end;  {Clear_Msg}
  238.  
  239. {----------------------------------------------------------------------------}
  240. procedure  Msg_Line( Y_Loc:word; Msg:string );
  241. var
  242.    c : char;
  243.    i : integer;
  244. begin
  245.    Set_Window_Area(1,Y_Loc,80,1);  Med_Video;  clrscr;
  246.    gotoXY(1,1);
  247.    for i := 1 to length(Msg) do begin
  248.       c := Msg[i];
  249.       case c of
  250.       '^': High_Video;
  251.       '|': Rev_Video;
  252.       '@': Med_Video;
  253.       else write(c);
  254.       end;  {end case}
  255.    end;
  256. end;  {Msg_Line}
  257.  
  258.  
  259. {============================ Includes: ================================}
  260.  
  261. {$I PullDown.pas}
  262. {$I Help.pas}
  263.  
  264. {=======================================================================}
  265. { Display_Word:                                                         }
  266. {=======================================================================}
  267.  
  268. procedure  Display_Word ( passed_string:STRING;
  269.                           passed_word : word );
  270. begin
  271.    if ( length(passed_string) = 0 ) then begin
  272.       Draw_Window_Box( 60,15,19,5, 'Debug' );
  273.    end
  274.    else begin
  275.       Set_Window_Area(60,15,19,5); High_Video;
  276.       gotoXY(2,5);
  277.       writeln( passed_string:10, passed_word:5 );
  278.    end;
  279. end;  {Display_Word}
  280.  
  281.  
  282. {=======================================================================}
  283. { Display_Message_1:                                                    }
  284. {=======================================================================}
  285.  
  286. procedure  Display_Message_1;
  287. begin
  288.    save_screen_1;
  289.    Draw_Window_Box( 25,8, 32,5, '' );
  290.    gotoXY(3,3); writeln('    An OBJECT occurs when ' );
  291.    gotoXY(3,4); writeln('   two or more stimuli are ');
  292.    gotoXY(3,5); writeln(' repeatedly observed together. ');
  293.    delay(2000);
  294.    restore_screen_1;
  295. end;  {Display_Message_1}
  296.  
  297.  
  298. {=======================================================================}
  299. { Display_Credits:                                                      }
  300. {=======================================================================}
  301.  
  302. procedure  Display_Credits;
  303. begin
  304.    Draw_Window_Box( 21,7, 35,14, 'credits' );
  305.    gotoXY(3,3);   writeln('         --  O R 4  --');
  306.    gotoXY(3,4);   writeln('3 Level Hierarchy Object Learning');
  307.    gotoXY(3,6);   writeln('    Doug Gaffin / Art Gaffin');
  308.    gotoXY(3,7);   writeln('           21Aug88');
  309.    gotoXY(3,9);   writeln('Dept of Zoology, Oregon State Univ');
  310.    gotoXY(3,10);  writeln('      Corvallis, OR 97331');
  311.    gotoXY(3,12);  writeln('     Phone: (503) 754-3705');
  312.    gotoXY(3,13);  writeln('            (415) 964-5634');
  313. end;  {Display_Credits}
  314.  
  315.  
  316. {=======================================================================}
  317. { Display_Current_Status:                                               }
  318. {=======================================================================}
  319.  
  320. procedure  Display_Current_Status;
  321. begin
  322.    Draw_Window_Box( 1,21, 13,1, 'mode' );
  323.    gotoXY(2,2);
  324.    case g_op_mode of
  325.    IDLE_MODE:    write( '  I D L E' );
  326.    RECOG_1_MODE: write( ' RECOGNIZE 1' );
  327.    RECOG_2_MODE: write( ' RECOGNIZE 2' );
  328.    RECOG_3_MODE: write( ' RECOGNIZE 3' );
  329.    LEARN_1_MODE: write( ' L E A R N 1' );
  330.    LEARN_2_MODE: write( ' L E A R N 2' );
  331.    LEARN_3_MODE: write( ' L E A R N 3' );
  332.    end;
  333. end;  {Display_Current_Status}
  334.  
  335. {=======================================================================}
  336. { Display_Response:                                                     }
  337. {=======================================================================}
  338.  
  339. procedure  Display_Response( x,y, response : word );
  340.  
  341. begin
  342.    Set_Window_Area(x,y,64,2);
  343.    Med_Video;  clrscr;
  344.    gotoXY( response+1, 1 );
  345.    Rev_Video; write(response:2);
  346.    Med_Video;
  347. end;
  348.  
  349.  
  350. {=======================================================================}
  351. { Init_Stimulus_Window:                                                 }
  352. {=======================================================================}
  353.  
  354. procedure  Init_Stimulus_Window( x,y,z : word;
  355.                                  header : string );
  356. var
  357.    width : word;
  358. begin
  359.    { ------------ prepare screen recognizer memory data: ---------------}
  360.    width := g_frame_size[g_memory_num]*3+8;
  361.    Set_Window_Area(x+1,y+1,width,z);  rev_video;  clrscr;
  362.    draw_window_box(x,y, width,z, header);
  363. end;  {Init_Stimulus_Window}
  364.  
  365.  
  366.  
  367. {=======================================================================}
  368. { Display_Stimulus_Window:                                              }
  369. {=======================================================================}
  370.  
  371. procedure  Display_Stimulus_Window ( x,y,z : word;
  372.                                      stimulus       : FRAME_8 );
  373. const
  374.    display_count : array[1..4] of word = ( 0, 0, 0, 0 );
  375. var
  376.    index_x, width  : word;
  377.  
  378. begin
  379.  
  380.    { ------------ prepare screen recognizer memory data: ---------------}
  381.    width := g_frame_size[g_memory_num]*3+8;
  382.    Set_Window_Area(x+1,y+1,width,z);  High_Video;
  383.  
  384.    { --- write data - it will scroll up within window automatically: -- }
  385.    display_count[g_memory_num] := display_count[g_memory_num] + 1;
  386.    gotoXY(1,z);
  387.    writeln;
  388.    write( display_count[g_memory_num]:5,' ' );
  389.    for index_x := 0 to g_frame_size[g_memory_num]-1 do begin
  390.       if (stimulus[index_x] = 63)
  391.          then Rev_Video
  392.          else Med_Video;
  393.       write(stimulus[index_x]:3);
  394.    end;
  395.    Med_Video;
  396.  
  397. end;  {Display_Stimulus_Window}
  398.  
  399.  
  400.  
  401. {=======================================================================}
  402. { Displ_Mem:  display contents of recognizer memory                   }
  403. {=======================================================================}
  404.  
  405. procedure  Displ_Mem( recog_memory : MEMORY_8 );
  406.  
  407. label
  408.    Exit_Point;
  409. var
  410.    index_x, index_y  : word;
  411.    freq, temp_value  : word;
  412.    dummy_char        : char;
  413.  
  414. begin
  415.    Save_Screen_1;
  416.  
  417.    Msg_Line( 25, Display_Mem_Msg );
  418.  
  419.    { ------------ prepare screen recognizer memory data: ---------------}
  420.    Set_Window_Area(18,5,42,17);  gotoXY(1,1);  High_Video;
  421.    draw_window_box(18,5,42,17, 'Resp #      cell contents:     freq:');
  422.  
  423.    Set_Window_Area(19,6,42,17);  gotoXY(1,1);  High_Video;
  424.  
  425.    { --- write data - it will scroll up within window automatically: -- }
  426.    for index_y := 0 to ( RECOG_MEMORY_SIZE - 1 ) do begin
  427.  
  428.       freq := recog_memory[index_y].frequency;
  429.  
  430.       if ( freq >= g_perm_mem_thres[g_memory_num] )
  431.          then High_Video
  432.          else Med_Video;
  433.  
  434.       write( index_y:5, '    ' );
  435.  
  436.       if ( keypressed ) then begin
  437.          dummy_char := readkey;
  438.          if ( dummy_char in [#27,'Q','q'] ) then goto Exit_Point;
  439.          dummy_char := readkey;
  440.       end;
  441.  
  442.  
  443.       for index_x := 0 to g_frame_size[g_memory_num]-1 do begin
  444.          temp_value := recog_memory[index_y].element[index_x];
  445.          if ( freq >= g_perm_mem_thres[g_memory_num] )
  446.             then High_Video
  447.             else Med_Video;
  448.          if (temp_value = 63)
  449.             then Rev_Video;
  450.          write( temp_value:3 );
  451.       end;
  452.  
  453.       {---------------- highlight freq if at threshold: ----------------}
  454.       if ( freq >= g_perm_mem_thres[g_memory_num] )
  455.          then High_Video
  456.          else Med_Video;
  457.       writeln( freq:6);
  458.  
  459.       { -------- vary the scrolling rates according to content: ------- }
  460.       if ( freq >= g_perm_mem_thres[g_memory_num] ) then begin
  461.          beep(1500, 5); delay(400);
  462.       end;
  463.       delay(40);
  464.    end;
  465.    delay(500);
  466. Exit_Point:
  467.    Restore_Screen_1;
  468. end;  {Displ_Mem}
  469.  
  470.  
  471.  
  472. {=======================================================================}
  473. { Init_Stimulus:                                                        }
  474. {=======================================================================}
  475.  
  476. procedure  Init_Stimulus( var stimulus : FRAME_8 );
  477. var
  478.    index : word;
  479. begin
  480.    for index := 0 to 7 do begin
  481.       stimulus[index] := 0;
  482.    end;
  483. end; {Init_Stimulus}
  484.  
  485.  
  486.  
  487. {=======================================================================}
  488. { Init_Memory:                                                          }
  489. {    Initialize generalization memory and parameters for recognizer #1. }
  490. {=======================================================================}
  491.  
  492. procedure  Init_Memory( var recog_memory : MEMORY_8 );
  493. var
  494.    index_1 : word;
  495.    index_2 : word;
  496. begin
  497.    for index_1 := 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
  498.       for index_2 := 0 to 7 do begin
  499.          recog_memory[index_1].element[index_2] := 0;
  500.       end;
  501.       recog_memory[index_1].frequency := 0;
  502.    end;
  503. end; {Init_Memory}
  504.  
  505.  
  506.  
  507. {=======================================================================}
  508. { Gen_Stimulus_Input:                                                   }
  509. {    Generates a stimulus using pseudo random number generator with one }
  510. {    relatively frequent stimulus randomly superimposed on the stream.  }
  511. {    This is to see if the learning system will assign it a cell and an }
  512. {    appropriate response value.                                        }
  513. {=======================================================================}
  514.  
  515. procedure Gen_Stimulus_Input( var stimulus : FRAME_8 );
  516. const
  517.    element_phase_1 : word = 0;
  518.    element_phase_2 : word = 0;
  519.    element_phase_3 : word = 0;
  520.  
  521.    {-------------------- pattern to superimpose: -----------------------}
  522.    pattern_1 : array [1..8] of array [0..7] of word = (
  523.      ( 063, 063, 000, 000, 000, 000, 000, 000 ),
  524.      ( 000, 063, 063, 000, 000, 000, 000, 000 ),
  525.      ( 000, 000, 063, 063, 000, 000, 000, 000 ),
  526.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  527.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  528.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  529.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  530.      ( 000, 000, 000, 000, 000, 000, 000, 000 ) );
  531.  
  532.    pattern_2 : array [1..8] of array [0..7] of word = (
  533.      ( 000, 000, 063, 063, 000, 000, 000, 000 ),
  534.      ( 000, 063, 063, 000, 000, 000, 000, 000 ),
  535.      ( 063, 063, 000, 000, 000, 000, 000, 000 ),
  536.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  537.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  538.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  539.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  540.      ( 000, 000, 000, 000, 000, 000, 000, 000 ) );
  541.  
  542.    pattern_3 : array [1..8] of array [0..7] of word = (
  543.      ( 063, 000, 000, 063, 000, 000, 000, 000 ),
  544.      ( 000, 063, 063, 000, 000, 000, 000, 000 ),
  545.      ( 063, 000, 000, 063, 000, 000, 000, 000 ),
  546.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  547.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  548.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  549.      ( 000, 000, 000, 000, 000, 000, 000, 000 ),
  550.      ( 000, 000, 000, 000, 000, 000, 000, 000 ) );
  551.  
  552. var
  553.    index : word;
  554.  
  555. begin
  556.  
  557.    {----------------- generate pseudo random stimulus: -----------------}
  558.    for index := 0 to 7 do
  559.       stimulus[index] := random( 64 );
  560.  
  561.    {--- superimpose multi-frame patterns at pseudo random intervals: ---}
  562.    if ( random( 16 ) = 5 ) and
  563.       ( element_phase_1 = 0 ) and
  564.       ( element_phase_2 = 0 ) and
  565.       ( element_phase_3 = 0 )  {so no overlapping patterns}
  566.       then element_phase_1 := 1;  {=1 kicks off 8-frame pattern}
  567.  
  568.    if ( random( 16 ) = 15 ) and
  569.       ( element_phase_1 = 0 ) and
  570.       ( element_phase_2 = 0 ) and
  571.       ( element_phase_3 = 0 )  {so no overlapping patterns}
  572.       then element_phase_2 := 1;  {=1 kicks off 8-frame pattern}
  573.  
  574.    if ( random( 16 ) = 15 ) and
  575.       ( element_phase_1 = 0 ) and
  576.       ( element_phase_2 = 0 ) and
  577.       ( element_phase_3 = 0 )  {so no overlapping patterns}
  578.       then element_phase_3 := 1;  {=1 kicks off 8-frame pattern}
  579.  
  580.    {--- superimpose patterns on stimulus according to current phase: ---}
  581.    if (element_phase_1 > 0) and (element_phase_1 <= 8) then begin
  582.       for index := 0 to 7 do begin
  583.          if (pattern_1[element_phase_1][index] <> 0)
  584.             then stimulus[index] := pattern_1[element_phase_1][index];
  585.       end;
  586.       element_phase_1 := element_phase_1 + 1;
  587.       if (element_phase_1 = 9) then element_phase_1 := 0;
  588.    end;
  589.  
  590.    if (element_phase_2 > 0) and (element_phase_2 <= 8) then begin
  591.       for index := 0 to 7 do begin
  592.          if (pattern_2[element_phase_2][index] <> 0)
  593.             then stimulus[index] := pattern_2[element_phase_2][index];
  594.       end;
  595.       element_phase_2 := element_phase_2 + 1;
  596.       if (element_phase_2 = 9) then element_phase_2 := 0;
  597.    end;
  598.  
  599.    if (element_phase_3 > 0) and (element_phase_3 <= 8) then begin
  600.       for index := 0 to 7 do begin
  601.          if (pattern_3[element_phase_3][index] <> 0)
  602.             then stimulus[index] := pattern_3[element_phase_3][index];
  603.       end;
  604.       element_phase_3 := element_phase_3 + 1;
  605.       if (element_phase_3 = 9) then element_phase_3 := 0;
  606.    end;
  607.  
  608. end;  {Gen_Stimulus_Input}
  609.  
  610.  
  611.  
  612. {=======================================================================}
  613. { Calculate_Similarity:                                                 }
  614. {    Compare each of 8 elements of one stimulus with the coresponding   }
  615. {    element of the other stimulus and calculate the total number       }
  616. {    [0..8] of good compares.  A returned value of 8 means a perfect    }
  617. {    match.                                                             }
  618. {=======================================================================}
  619.  
  620. function  Calculate_Similarity( stimulus_1  : FRAME_8;
  621.                                 stimulus_2  : FRAME_8 ) : word;
  622.  
  623. { ------------------------- declarations: ----------------------------- }
  624. var
  625.    cum_sim, cum_sim_1, cum_sim_2, cum_sim_3 : word;
  626.    cum_sim_4, cum_sim_5, index : word;
  627.  
  628. { ----------------------- function body: ------------------------------ }
  629. begin
  630.    if ( g_jitter_flag[g_memory_num] = 0 ) then begin
  631.       cum_sim := 0;
  632.       for index := 0 to g_frame_size[g_memory_num]-1 do
  633.  
  634.          if ( stimulus_1[index] = stimulus_2[index] ) then begin
  635.             if ( stimulus_1[index] <> 0 )
  636.                then cum_sim := cum_sim + 1;
  637.          end;
  638.  
  639.       Calculate_Similarity := cum_sim;
  640.    end
  641.    else begin
  642.  
  643.       {------------------------- shift one left: -----------------------}
  644.       cum_sim_1 := 0;
  645.       for index := 0 to g_frame_size[g_memory_num]-3 do
  646.  
  647.          if ( stimulus_1[index] = stimulus_2[index+2] ) then begin
  648.             if ( stimulus_1[index] <> 0 )
  649.                then cum_sim_1 := cum_sim_1 + 1;
  650.          end;
  651.  
  652.       {---------------------------- no shift: --------------------------}
  653.       cum_sim_2 := 0;
  654.       for index := 0 to g_frame_size[g_memory_num]-2 do
  655.  
  656.          if ( stimulus_1[index] = stimulus_2[index+1] ) then begin
  657.             if ( stimulus_1[index] <> 0 )
  658.                then cum_sim_2 := cum_sim_2 + 1;
  659.          end;
  660.  
  661.       {------------------------ shift one right: -----------------------}
  662.       cum_sim_3 := 0;
  663.       for index := 0 to g_frame_size[g_memory_num]-1 do
  664.  
  665.          if ( stimulus_1[index] = stimulus_2[index] ) then begin
  666.             if ( stimulus_1[index] <> 0 )
  667.                then cum_sim_3 := cum_sim_3 + 1;
  668.          end;
  669.  
  670.       {------------------------ shift one right: -----------------------}
  671.       cum_sim_4 := 0;
  672.       for index := 0 to g_frame_size[g_memory_num]-2 do
  673.  
  674.          if ( stimulus_1[index+1] = stimulus_2[index] ) then begin
  675.             if ( stimulus_1[index+1] <> 0 )
  676.                then cum_sim_4 := cum_sim_4 + 1;
  677.          end;
  678.  
  679.       {------------------------ shift one right: -----------------------}
  680.       cum_sim_5 := 0;
  681.       for index := 0 to g_frame_size[g_memory_num]-3 do
  682.  
  683.          if ( stimulus_1[index+2] = stimulus_2[index] ) then begin
  684.             if ( stimulus_1[index+2] <> 0 )
  685.                then cum_sim_5 := cum_sim_5 + 1;
  686.          end;
  687.  
  688.       {---------------- calculate maximum of 3 values: -----------------}
  689.       cum_sim := cum_sim_1;
  690.       if ( cum_sim_2 > cum_sim ) then cum_sim := cum_sim_2;
  691.       if ( cum_sim_3 > cum_sim ) then cum_sim := cum_sim_3;
  692.       if ( cum_sim_4 > cum_sim ) then cum_sim := cum_sim_4;
  693.       if ( cum_sim_5 > cum_sim ) then cum_sim := cum_sim_5;
  694.  
  695.       Calculate_Similarity := cum_sim;
  696.    end;
  697. end; {Calculate_Similarity}
  698.  
  699.  
  700.  
  701. {=======================================================================}
  702. { Find_Most_Similar_Cell:                                               }
  703. {    1) Search memory for a cell that is most similar to the input      }
  704. {       stimulus.                                                       }
  705. {                                                                       }
  706. {    2) Return the cell number as the value of the function             }
  707. {                                                                       }
  708. {    3) Return the similarity level of that selected cell in            }
  709. {       most_similar_level                                              }
  710. {=======================================================================}
  711.  
  712. function  Find_Most_Similar_Cell( stimulus               : FRAME_8;
  713.                                   recog_memory           : MEMORY_8;
  714.                                   var most_similar_level : word ) : word;
  715.  
  716. { ------------------------- declarations: ----------------------------- }
  717. var
  718.    index_1, index_2   : word;
  719.    most_similar_addr  : word;
  720.    similarity_level   : word;
  721.  
  722. { ----------------------- function body: ------------------------------ }
  723. begin
  724.    most_similar_level := 0;
  725.    most_similar_addr  := 0;
  726.  
  727.    {--- start list scan from a random place - eliminates preference: ---}
  728.    index_2 := random( RECOG_MEMORY_SIZE );
  729.  
  730.    for index_1:= 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
  731.  
  732.       {--------------------- loop back around: -------------------------}
  733.       if ( index_2 = RECOG_MEMORY_SIZE_MINUS_1 )
  734.          then index_2 := 0
  735.          else index_2 := index_2 + 1;
  736.  
  737.       similarity_level :=
  738.          Calculate_Similarity( stimulus,
  739.                                recog_memory[index_2].element );
  740.  
  741.       {------------------- save first most similar: --------------------}
  742.       if ( similarity_level > most_similar_level ) then begin
  743.          most_similar_level := similarity_level;
  744.          most_similar_addr  := index_2;
  745.       end;
  746.    end;
  747.    Find_Most_Similar_Cell := most_similar_addr;
  748. end; {Find_Most_Similar_Cell}
  749.  
  750.  
  751.  
  752. {=======================================================================}
  753. { Find_Available_Cell:                                                  }
  754. {    Look for unused cell - one with frequency = 0.  Return the cell    }
  755. {    number.                                                            }
  756. {=======================================================================}
  757.  
  758. function  Find_Available_Cell( recog_memory        : MEMORY_8;
  759.                                var none_avail_flag : word ) : word;
  760.  
  761. { ------------------------- declarations: ----------------------------- }
  762. var
  763.    index, rnd_index : word;
  764.  
  765. { ------------------------- function body: ---------------------------- }
  766. begin
  767.    none_avail_flag := 0;
  768.    Find_Available_Cell := 0;
  769.    for index := 0 to (RECOG_MEMORY_SIZE_MINUS_1 div 2) do begin
  770.       rnd_index := random(RECOG_MEMORY_SIZE_MINUS_1) + 1;
  771.       if ( recog_memory[rnd_index].frequency = 0 ) then begin
  772.          Find_Available_Cell := rnd_index;
  773.          exit;
  774.       end;
  775.    end;
  776.    none_avail_flag := 1;
  777. end; {Find_Available_Cell}
  778.  
  779.  
  780.  
  781. {=======================================================================}
  782. { Find_Weak_Cell:                                                       }
  783. {    Look for cell with the lowest frequency and less than the          }
  784. {    g_perm_mem_thres[g_memory_num].                                    }
  785. {=======================================================================}
  786.  
  787. function  Find_Weak_Cell( recog_memory        : MEMORY_8;
  788.                           var none_avail_flag : word ) : word;
  789.  
  790. { ------------------------- declarations: ----------------------------- }
  791. var
  792.    index, rnd_index, weakest_cell_freq, weakest_cell_num : word;
  793.  
  794. { ------------------------- function body: ---------------------------- }
  795. begin
  796.    weakest_cell_freq := $0FFF;
  797.    weakest_cell_num := 0;
  798.    Find_Weak_Cell := 0;
  799.    for index := 0 to (RECOG_MEMORY_SIZE_MINUS_1 div 2) do begin
  800.       rnd_index := random(RECOG_MEMORY_SIZE_MINUS_1) + 1;
  801.       if ( recog_memory[rnd_index].frequency < weakest_cell_freq ) then begin
  802.          weakest_cell_freq := recog_memory[rnd_index].frequency;
  803.          weakest_cell_num := rnd_index;
  804.       end;
  805.    end;
  806.  
  807.    if ( weakest_cell_freq < g_perm_mem_thres[g_memory_num] ) then begin
  808.       Find_Weak_Cell := weakest_cell_num;
  809.       none_avail_flag := 0;
  810.    end
  811.    else begin
  812.       Find_Weak_Cell := 0;
  813.       none_avail_flag := 1;
  814.    end;
  815.  
  816. end; {Find_Weak_Cell}
  817.  
  818.  
  819.  
  820. {=======================================================================}
  821. { Rationalize_Freqs:                                                    }
  822. {    This function totals all freq's and normalizes them while          }
  823. {    preserving relative values.                                        }
  824. {=======================================================================}
  825.  
  826. procedure  Rationalize_Freqs( var recog_memory : MEMORY_8 );
  827. var
  828.    freq, total_freq, ave_freq, index : word;
  829. begin
  830.    {------------- calulate total of all freq's in memory: --------------}
  831.    total_freq := 0;
  832.    for index := 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
  833.       freq := recog_memory[index].frequency;
  834.       total_freq := total_freq + freq;
  835.    end;
  836.  
  837.    {---------------- rationalize all freq's in memory: -----------------}
  838.    ave_freq := total_freq div RECOG_MEMORY_SIZE;
  839.    if (ave_freq > 8) then begin
  840.       for index := 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
  841.          if ( recog_memory[index].frequency <
  842.               g_perm_mem_thres[g_memory_num] ) then begin
  843.          recog_memory[index].frequency  :=
  844.             recog_memory[index].frequency div 2;
  845.          end;
  846.       end;
  847.    end;
  848. end;  {Rationalize_Freqs}
  849.  
  850.  
  851.  
  852. {=======================================================================}
  853. { Info_Content:                                                         }
  854. {    Calculates the number of non-zero elements in frame.               }
  855. {=======================================================================}
  856.  
  857. function  Info_Content( stimulus : FRAME_8 ) : word;
  858. var
  859.    index, total_non_zeroes : word;
  860. begin
  861.    total_non_zeroes := 0;
  862.    for index := 0 to g_frame_size[g_memory_num]-1 do begin
  863.       if ( stimulus[index] <> 0 )
  864.          then total_non_zeroes := total_non_zeroes + 1;
  865.    end;
  866.    Info_Content := total_non_zeroes;
  867. end;  {Info_Content}
  868.  
  869.  
  870.  
  871. {=======================================================================}
  872. { Forget_One:                                                           }
  873. {    Select one cell of memory, and if below a threshold, erase cell    }
  874. {    contents.                                                          }
  875. {=======================================================================}
  876.  
  877. procedure  Forget_One( var recog_memory : MEMORY_8 );
  878. var
  879.    selected_cell, cell_freq, index : word;
  880. begin
  881.    selected_cell := random( RECOG_MEMORY_SIZE );
  882.    cell_freq := recog_memory[selected_cell].frequency;
  883.  
  884.    {--------------------  should we erase the cell?: -------------------}
  885.    if ( selected_cell <> 0 ) and
  886.       ( cell_freq < g_forget_threshold[g_memory_num] ) then begin
  887.  
  888.       {--------------------- yes, erase the cell: ----------------------}
  889.       Beep( 330, 5 );
  890.       for index := 0 to 7 do
  891.          recog_memory[selected_cell].element[index] := 0;
  892.       recog_memory[selected_cell].frequency := 0;
  893.    end;
  894.  
  895. end;  {Forget_One}
  896.  
  897.  
  898. {=======================================================================}
  899. { Learn:                                                                }
  900. {    1) Search for the most similar cell to the input stimulus.         }
  901. {                                                                       }
  902. {    2) If not similar enough, look for unused cell to initialize with  }
  903. {       this stimulus.                                                  }
  904. {                                                                       }
  905. {    3) If all are used, then find the cell with the weakest learning   }
  906. {       (lowest frequency), destroy its contents, and initialize with   }
  907. {       this stimulus.                                                  }
  908. {=======================================================================}
  909.  
  910. procedure  Learn( stimulus         : FRAME_8;
  911.                   var recog_memory : MEMORY_8 );
  912.  
  913. {-------------------------- declarations: ------------------------------}
  914. const
  915.    learn_pass_num : array [1..3] of word = (0, 0, 0);
  916.  
  917. var
  918.    most_similar_level           : word;
  919.    memory_address, new_cell_num : word;
  920.    index, freq, none_avail_flag : word;
  921.    local_pass_num               : word;
  922.  
  923. {------------------------ function body: -------------------------------}
  924. begin
  925.  
  926.    {---------------------- rationalize freq's: -------------------------}
  927.    learn_pass_num[g_memory_num] := learn_pass_num[g_memory_num] + 1;
  928.    local_pass_num := learn_pass_num[g_memory_num];
  929.    if ( g_ration_level[g_memory_num] > 0 )
  930.       then if ( (local_pass_num mod g_ration_level[g_memory_num]) = 0 )
  931.          then Rationalize_Freqs( recog_memory );
  932.  
  933.    {---------------if interval is finished, FORGET one: ----------------}
  934.    if ( (local_pass_num mod g_forget_level[g_memory_num]) = 0 ) then begin
  935.       Forget_One( recog_memory );
  936.    end;
  937.  
  938.    {------------ switch modes for auto mode if necessary: --------------}
  939.    if ( g_auto_mode = AUTO ) then begin
  940.  
  941.       {----------- periodically display appropriate memory: ------------}
  942.       if ( (local_pass_num mod 1000) = 0 ) then begin
  943.          case g_op_mode of
  944.          LEARN_1_MODE: begin
  945.                           g_memory_num := 1; Displ_Mem( recog_memory_1 );
  946.                        end;
  947.          LEARN_2_MODE: begin
  948.                           g_memory_num := 2; Displ_Mem( recog_memory_2 );
  949.                        end;
  950.          LEARN_3_MODE: begin
  951.                           g_memory_num := 3; Displ_Mem( recog_memory_3 );
  952.                        end;
  953.          end;  {end case}
  954.       end;
  955.  
  956.       {------------------ switch modes automatically: ------------------}
  957.       case g_op_mode of
  958.       LEARN_1_MODE: if (local_pass_num >= AUTO_PASSES_1 ) then begin
  959.                        g_op_mode := LEARN_2_MODE;
  960.                        Display_Current_Status;
  961.                     end;
  962.       LEARN_2_MODE: if (local_pass_num >= AUTO_PASSES_2 ) then begin
  963.                        g_op_mode := LEARN_3_MODE;
  964.                        Display_Current_Status;
  965.                     end;
  966.       LEARN_3_MODE: if (local_pass_num >= AUTO_PASSES_3 ) then begin
  967.                        g_auto_mode := MANUAL;
  968.                        g_op_mode := RECOG_3_MODE;
  969.                        Display_Current_Status;
  970.                     end;
  971.       end;
  972.    end;
  973.  
  974.    {-----------------  exit procedure if too many zeros: ---------------}
  975.    if ( Info_Content( stimulus ) < g_info_level[g_memory_num] ) then begin
  976.       exit;
  977.    end;
  978.  
  979.    {------- find most similar cell in recog_memory to stimulus: --------}
  980.    memory_address := Find_Most_Similar_Cell( stimulus,
  981.                                              recog_memory,
  982.                                              most_similar_level );
  983.  
  984.  
  985.    {-------- is it close enough to bump existing targeted cell? --------}
  986.    if ( most_similar_level >= g_learn_similarity[g_memory_num] ) and
  987.       ( memory_address <> 0 ) then begin
  988.  
  989.       {----------- close enough to map into existing cell: -------------}
  990.       freq := recog_memory[memory_address].frequency;
  991.  
  992.       {------------------ increment frequency count: -------------------}
  993.       if ( freq < g_perm_mem_thres[g_memory_num] ) then begin
  994.          recog_memory[memory_address].frequency :=
  995.             recog_memory[memory_address].frequency + 1;
  996.          Beep(3500,1);
  997.       end
  998.       else begin
  999.          {----------- mature cell - do NOT increment frequency: --------}
  1000.       end;
  1001.  
  1002.    end
  1003.  
  1004.    { --------- not similar enough? - if so, extablish new one: -------- }
  1005.    else begin
  1006.  
  1007.       { ------ if space is available, allocate additional cell: ------- }
  1008.       new_cell_num := Find_Available_Cell( recog_memory, none_avail_flag );
  1009.  
  1010.       if ( none_avail_flag = 0 ) then begin
  1011.  
  1012.          { ------ found space, put stimulus (glimpse) into cell: ------ }
  1013.          for index := 0 to g_frame_size[g_memory_num]-1 do
  1014.              recog_memory[new_cell_num].element[index] := stimulus[index];
  1015.  
  1016.          { --------------- start frequency count at 1: ---------------- }
  1017.          recog_memory[new_cell_num].frequency := 1;
  1018.       end
  1019.  
  1020.       else begin
  1021.          { -------------- no space, replace weakest one: -------------- }
  1022.          new_cell_num := Find_Weak_Cell( recog_memory,
  1023.                                          none_avail_flag );
  1024.  
  1025.          if ( none_avail_flag = 0 ) then begin
  1026.             for index := 0 to g_frame_size[g_memory_num]-1 do
  1027.                recog_memory[new_cell_num].element[index] := stimulus[index];
  1028.  
  1029.             { --------------- start frequency count at 1: ---------------- }
  1030.             recog_memory[new_cell_num].frequency := 1;
  1031.             Beep( 500, 1 );
  1032.          end;
  1033.       end;
  1034.    end;
  1035. end; {Learn}
  1036.  
  1037.  
  1038.  
  1039. {=======================================================================}
  1040. { Find_Most_Recog_Cell:                                                 }
  1041. {    1) Search memory for a frequency qualified cell that is most       }
  1042. {       similar to the input stimulus.                                  }
  1043. {                                                                       }
  1044. {    2) Return the cell number as the value of the function             }
  1045. {                                                                       }
  1046. {    3) Return the similarity level of that selected cell in            }
  1047. {       most_similar_level                                              }
  1048. {=======================================================================}
  1049.  
  1050. function  Find_Most_Recog_Cell( stimulus               : FRAME_8;
  1051.                                 recog_memory           : MEMORY_8;
  1052.                                 var most_similar_level : word ) : word;
  1053.  
  1054. { ------------------------- declarations: ----------------------------- }
  1055. var
  1056.    index_1, most_similar_addr, similarity_level  : word;
  1057.  
  1058. { ----------------------- function body: ------------------------------ }
  1059. begin
  1060.    most_similar_level := 0;
  1061.    most_similar_addr  := 0;
  1062.  
  1063.    for index_1:= 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
  1064.  
  1065.       similarity_level :=
  1066.          Calculate_Similarity( stimulus,
  1067.                                recog_memory[index_1].element );
  1068.  
  1069.       {--------- only look at cells with qualified frequencies: --------}
  1070.       if ( recog_memory[index_1].frequency >=
  1071.               g_min_recog_freq[g_memory_num] ) then begin
  1072.  
  1073.          {------------------ save first most similar: ------------------}
  1074.          if ( similarity_level > most_similar_level ) then begin
  1075.             most_similar_level := similarity_level;
  1076.             most_similar_addr  := index_1;
  1077.          end;
  1078.       end;
  1079.    end;
  1080.    Find_Most_Recog_Cell := most_similar_addr;
  1081. end; {Find_Most_Recog_Cell}
  1082.  
  1083.  
  1084.  
  1085. {=======================================================================}
  1086. { Recognize:                                                            }
  1087. {    1) Search recog_memory for the cell that is most similar to the    }
  1088. {       input stimulus.                                                 }
  1089. {                                                                       }
  1090. {    2) If the similarity is within a limit set by  MIN_RECOG_DIFF,     }
  1091. {       recognition is established and the similarity level.            }
  1092. {=======================================================================}
  1093.  
  1094. function  Recognize( stimulus     : FRAME_8;
  1095.                      recog_memory : MEMORY_8 ) : word;
  1096.  
  1097. { ------------------------- declarations: ----------------------------- }
  1098. var
  1099.    most_similar_level   : word;
  1100.    memory_address, freq : word;
  1101.  
  1102. begin
  1103.    Recognize := 0;
  1104.  
  1105.    {-----------------  exit procedure if too many zeros: ---------------}
  1106.    if ( Info_Content( stimulus ) < g_info_level[g_memory_num] ) then begin
  1107.       exit;
  1108.    end;
  1109.  
  1110.    { ------- find most similar cell in recog_memory to stimulus: ------ }
  1111.    memory_address := Find_Most_Recog_Cell( stimulus,
  1112.                                            recog_memory,
  1113.                                            most_similar_level );
  1114.  
  1115.    { -------------- is it close enough to be recognized? -------------- }
  1116.    if ( most_similar_level >= g_recog_similarity[g_memory_num] ) then begin
  1117.  
  1118.       { -------------------- established cell?: ----------------------- }
  1119.       freq := recog_memory[memory_address].frequency;
  1120.       if ( freq >= g_min_recog_freq[g_memory_num] ) then begin
  1121.  
  1122.          { ----------- beep to demonstrate recognition: --------------- }
  1123.          Recognize := memory_address;
  1124.       end;
  1125.    end;
  1126. end;  {Recognize}
  1127.  
  1128.  
  1129.  
  1130. {=======================================================================}
  1131. { Expand:                                                               }
  1132. {    Pushes response into stimulus.  It treats it as a FIFO buffer.     }
  1133. {=======================================================================}
  1134.  
  1135. procedure  Expand( response     : word;
  1136.                    var stimulus : FRAME_8 );
  1137. var
  1138.    index : word;
  1139. begin
  1140.    for index := 7 downto 1 do begin
  1141.       stimulus[index] := stimulus[index-1];
  1142.    end;
  1143.    stimulus[0] := response;
  1144. end;  {Expand}
  1145.  
  1146.  
  1147.  
  1148. {=======================================================================}
  1149. { Help_Index_Menu:                                                      }
  1150. {=======================================================================}
  1151.  
  1152. procedure  Help_Index_Menu;
  1153. var
  1154.    Exit_Sw : integer;
  1155. begin
  1156.    Save_Screen_1;
  1157.    Help_Menu(10,7,'Help.txt','Instructions');
  1158.    Restore_Screen_1;
  1159. end;  {Help_Index_Menu}
  1160.  
  1161.  
  1162.  
  1163. {=======================================================================}
  1164. { Exit_Menu:                                                            }
  1165. {=======================================================================}
  1166.  
  1167. procedure  Exit_Menu;
  1168. var
  1169.    Exit_Sw : integer;
  1170.    YesNo_Ch : char;
  1171. begin
  1172.    Save_Screen_1;
  1173.    Msg_Line( 25, Exit_Msg );
  1174.    YesNo_Menu(Exit_x, 2, 'OK?', YesNo_Ch, Exit_Sw);
  1175.    if (Exit_Sw = 1) then begin
  1176.       case YesNo_Ch of
  1177.       'Y': g_exit_mode := 1;
  1178.       'N': g_exit_mode := 0;
  1179.       end;  {end case}
  1180.    end;
  1181.    Restore_Screen_1;
  1182. end;  {Exit_Menu}
  1183.  
  1184.  
  1185. {=======================================================================}
  1186. { Learn_Menu:                                                           }
  1187. {=======================================================================}
  1188.  
  1189. procedure  Learn_Menu;
  1190. var
  1191.    Exit_Sw : integer;
  1192. begin
  1193.    Save_Screen_1;
  1194.    Msg_Line( 25, Pop_Down_Msg );
  1195.    PullDown_Menu(Learn_x,2,'',
  1196.                  'Level #1/Level #2/Level #3',
  1197.                  '       ^/       ^/       ^',
  1198.                  Learn_SelNo, Exit_Sw);
  1199.  
  1200.    Restore_Screen_1;
  1201.    if (Exit_Sw = 1) then begin
  1202.       case Learn_SelNo of
  1203.       1: begin g_op_mode := LEARN_1_MODE; g_auto_mode := MANUAL; end;
  1204.       2: begin g_op_mode := LEARN_2_MODE; g_auto_mode := MANUAL; end;
  1205.       3: begin g_op_mode := LEARN_3_MODE; g_auto_mode := MANUAL; end;
  1206.       end;  {end case}
  1207.    end;
  1208. end;  {Learn_Menu}
  1209.  
  1210.  
  1211. {=======================================================================}
  1212. { Recognize_Menu:                                                       }
  1213. {=======================================================================}
  1214.  
  1215. procedure  Recognize_Menu;
  1216. var
  1217.    Exit_Sw : integer;
  1218. begin
  1219.    Save_Screen_1;
  1220.    Msg_Line( 25, Pop_Down_Msg );
  1221.    PullDown_Menu(Recognize_x,2,'',
  1222.                  'Level #1/Level #2/Level #3',
  1223.                  '       ^/       ^/       ^',
  1224.                  Recognize_SelNo, Exit_Sw);
  1225.  
  1226.    Restore_Screen_1;
  1227.    if (Exit_Sw = 1) then begin
  1228.       case Recognize_SelNo of
  1229.       1: g_op_mode := RECOG_1_MODE;
  1230.       2: g_op_mode := RECOG_2_MODE;
  1231.       3: g_op_mode := RECOG_3_MODE;
  1232.       end;  {end case}
  1233.    end;
  1234. end;  {Recognize}
  1235.  
  1236.  
  1237. {=======================================================================}
  1238. { Display_Mem_Menu:                                                     }
  1239. {=======================================================================}
  1240.  
  1241. procedure  Display_Mem_Menu;
  1242. var
  1243.    Exit_Sw : integer;
  1244. begin
  1245.    Save_Screen_1;
  1246.    Msg_Line( 25, Pop_Down_Msg );
  1247.    PullDown_Menu(Display_Mem_x,2,'',
  1248.                  'Level #1/Level #2/Level #3',
  1249.                  '       ^/       ^/       ^',
  1250.                  display_mem_selNo, Exit_Sw);
  1251.  
  1252.    Restore_Screen_1;
  1253.    if (Exit_Sw = 1) then begin
  1254.       case display_mem_selno of
  1255.       1: begin g_memory_num := 1; Displ_Mem( recog_memory_1 ); end;
  1256.       2: begin g_memory_num := 2; Displ_Mem( recog_memory_2 ); end;
  1257.       3: begin g_memory_num := 3; Displ_Mem( recog_memory_3 ); end;
  1258.       end;  {end case}
  1259.    end;
  1260. end;  {Display_Mem_Menu}
  1261.  
  1262.  
  1263. {=======================================================================}
  1264. { Top_Line_Menu:                                                        }
  1265. {    Handles mode management.                                           }
  1266. {=======================================================================}
  1267.  
  1268. procedure  Top_Line_Menu( SelNo:integer );
  1269. begin
  1270.    Across_Menu(1,1,SelNo,
  1271. '  Exit  Idle  Demo  Learn  Recognize  Displ-Memory  Quiet  Speed  Help',
  1272. '   ^    ^     ^    +^     +^         +      ^       ^      ^      ^   ',
  1273. '  0---  1---  2---  3----  4--------  5-----------  6----  7----  8---');
  1274. end;  {Top_Line_Menu}
  1275.  
  1276.  
  1277. {=======================================================================}
  1278. { Check_Mode:                                                           }
  1279. {    Handles mode management.                                           }
  1280. {=======================================================================}
  1281.  
  1282. procedure  Check_Mode;
  1283.  
  1284. var
  1285.    InChar,NewChar,C,Dummy : char;
  1286.    Dummy_Sw,I : integer;
  1287.    FileName : string;
  1288. begin
  1289.    if (keypressed) then begin
  1290.       Beep(1550,1);
  1291.       NewChar := GetKey;
  1292.       Clear_Msg_Line( 25 );
  1293.       Empty_KeyBuf;
  1294.  
  1295.       Msg_Line( 25, Across_Top_Msg );
  1296.  
  1297.       case NewChar of
  1298.       'X': begin {exit}
  1299.               Top_Line_SelNo:=0; Top_Line_Menu(Top_Line_SelNo); Exit_Menu;
  1300.            end;
  1301.       'Z': g_exit_mode := 1;
  1302.       'I': begin {idle}
  1303.               Top_Line_SelNo:=1; Top_Line_Menu(Top_Line_SelNo);
  1304.               g_op_mode := IDLE_MODE;
  1305.            end;
  1306.       'D': begin {demo}
  1307.               Top_Line_SelNo:=2; Top_Line_Menu(Top_Line_SelNo);
  1308.               g_op_mode := LEARN_1_MODE;
  1309.               g_auto_mode := AUTO;
  1310.            end;
  1311.       'L': begin {learn}
  1312.               Top_Line_SelNo:=3; Top_Line_Menu(Top_Line_SelNo);
  1313.               Learn_Menu;
  1314.            end;
  1315.       'R': begin {recognize}
  1316.               Top_Line_SelNo:=4; Top_Line_Menu(Top_Line_SelNo);
  1317.               Recognize_Menu;
  1318.            end;
  1319.       'M': begin {display memory}
  1320.               Top_Line_SelNo:=5; Top_Line_Menu(Top_Line_SelNo);
  1321.               Display_Mem_Menu;
  1322.            end;
  1323.       'Q': begin {quiet mode}
  1324.               Top_Line_SelNo:=6; Top_Line_Menu(Top_Line_SelNo);
  1325.               if ( g_beep_mode = 1 )
  1326.                  then g_beep_mode := 0
  1327.                  else g_beep_mode := 1;
  1328.            end;
  1329.       'S': begin
  1330.               Top_Line_SelNo:=7; Top_Line_Menu(Top_Line_SelNo);
  1331.               case ( g_speed_mode ) of
  1332.               NORMAL_SPEED: g_speed_mode := FAST_SPEED;
  1333.               FAST_SPEED: g_speed_mode := SLOW_SPEED;
  1334.               SLOW_SPEED: g_speed_mode := NORMAL_SPEED;
  1335.               end;
  1336.            end;
  1337.       'H': begin {help}
  1338.               Top_Line_SelNo:=7; Top_Line_Menu(Top_Line_SelNo); Help_Index_Menu;
  1339.            end;
  1340.  
  1341.       #27:      begin
  1342.                    g_op_mode := 0;
  1343.                    Top_Line_SelNo := 1;  Top_Line_Menu(Top_Line_SelNo);
  1344.                 end;
  1345.       #225:     begin  {left arrow}
  1346.                    if (Top_Line_SelNo > 0) then Top_Line_SelNo := Top_Line_SelNo - 1;
  1347.                    Top_Line_Menu(Top_Line_SelNo);
  1348.                 end;
  1349.       #227:     begin  {right arrow}
  1350.                    if (Top_Line_SelNo < TOP_LINE_NUM_ITEMS)
  1351.                       then Top_Line_SelNo := Top_Line_SelNo + 1;
  1352.                    Top_Line_Menu(Top_Line_SelNo);
  1353.                 end;
  1354.       #13,#230: begin
  1355.                    case Top_Line_SelNo of
  1356.                    0: g_exit_mode := EXIT_MODE;
  1357.                    1: g_op_mode := IDLE_MODE;
  1358.                    2: begin
  1359.                          g_op_mode := LEARN_1_MODE;
  1360.                          g_auto_mode := AUTO;
  1361.                       end;
  1362.                    3: Learn_Menu;
  1363.                    4: Recognize_Menu;
  1364.                    5: Display_Mem_Menu;
  1365.                    6: if ( g_beep_mode = 1 )
  1366.                          then g_beep_mode := 0
  1367.                          else g_beep_mode := 1;
  1368.                    7: case ( g_speed_mode ) of
  1369.                       NORMAL_SPEED: g_speed_mode := FAST_SPEED;
  1370.                       FAST_SPEED: g_speed_mode := SLOW_SPEED;
  1371.                       SLOW_SPEED: g_speed_mode := NORMAL_SPEED;
  1372.                       end;
  1373.                    8: Help_Index_Menu;  {in center of screen}
  1374.                    end;  {end case}
  1375.                 end;
  1376.       else      begin  Beep(500,2);  Beep(1500,2);  Beep(500,2);  end;
  1377.       end;  {end case}
  1378.  
  1379.       Display_Current_Status;
  1380.  
  1381.    end;  {end if}
  1382. end;  {Check_Mode}
  1383.  
  1384.  
  1385. {=======================================================================}
  1386. {               B E G I N   M A I N   P R O G R A M :                   }
  1387. {=======================================================================}
  1388.  
  1389. label
  1390.    Next_Stimulus;
  1391. var
  1392.    NewChar                  : char;
  1393.    index, response          : word;
  1394.    stimulus_1, stimulus_2, stimulus_3, stimulus_4 : FRAME_8;
  1395.    response_1, response_2, response_3 : word;
  1396.    last_response_1, last_response_2, last_response_3 : word;
  1397.  
  1398. const
  1399.    pass_counter : word = 0;
  1400.  
  1401. begin
  1402.    Init_Screen_Buffers;  { set up for saving screen }
  1403.    Save_Screen_2;
  1404.  
  1405.    g_exit_mode := CONTINUE_MODE;
  1406.    textmode(BW80);
  1407.  
  1408.    if ( g_exit_mode = CONTINUE_MODE ) then begin
  1409.  
  1410.       {---------------------- initialize screen: -----------------------}
  1411.       set_window_area( 1, 1, 80, 27 );  Med_Video;
  1412.       clrscr;
  1413.       gotoXY(1,1);  Rev_Video;
  1414.  
  1415.       {------------------- briefly display credits: --------------------}
  1416.       Display_Credits;
  1417.       delay(2500);
  1418.       Med_Video;
  1419.       clrscr;
  1420.  
  1421.       {---------------- initialize learning system: --------------------}
  1422.       Init_Memory( recog_memory_1 );
  1423.       Init_Memory( recog_memory_2 );
  1424.       Init_Memory( recog_memory_3 );
  1425.  
  1426.       Init_Stimulus( stimulus_1 );
  1427.       Init_Stimulus( stimulus_2 );
  1428.       Init_Stimulus( stimulus_3 );
  1429.  
  1430.       g_memory_num := 1; Init_Stimulus_Window(1,3,13, 'stimulus #1');
  1431.       g_memory_num := 2; Init_Stimulus_Window(41,3,3, 'stimulus #2');
  1432.       g_memory_num := 3; Init_Stimulus_Window(41,8,3, 'stimulus #3');
  1433.       g_memory_num := 4; Init_Stimulus_Window(41,13,3, 'response #3');
  1434.  
  1435.       { ------------------ set up and init menu: ---------------------- }
  1436.       Clear_Msg_Line( 25 );
  1437.       Empty_KeyBuf;
  1438.       Msg_Line( 25, Across_Top_Msg );
  1439.       Top_Line_SelNo:=1;  Top_Line_Menu(Top_Line_SelNo);
  1440.       g_op_mode := IDLE_MODE;
  1441.  
  1442.       { --------- set the pseudo random seed from the clock: ---------- }
  1443.       Randomize;
  1444.  
  1445.       { --------------------- main real time loop: -------------------- }
  1446.       repeat
  1447.  
  1448. Next_Stimulus:
  1449.  
  1450.          Check_Mode;
  1451.  
  1452.          pass_counter := pass_counter + 1;
  1453.          if ( (pass_counter mod 4000) = 0 ) then Display_Message_1;
  1454.  
  1455.          case  g_op_mode of
  1456.  
  1457.          IDLE_MODE:  begin
  1458.                g_memory_num := 1;
  1459.                Gen_Stimulus_Input( stimulus_1 );
  1460.                Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1461.                beep( 330, 1 ); delay(50);
  1462.             end;
  1463.  
  1464.          RECOG_1_MODE: begin
  1465.                g_memory_num := 1;
  1466.                Gen_Stimulus_Input( stimulus_1 );
  1467.                Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1468.                response_1 := Recognize( stimulus_1,
  1469.                                         recog_memory_1 );
  1470.  
  1471.                expand( response_1, stimulus_2 );
  1472.  
  1473.                g_memory_num := 2;
  1474.                Display_Stimulus_Window( 41,3,3, stimulus_2 );
  1475.                if ( response_1 > 0 )
  1476.                   then beep( response_1*50+120, 5 );
  1477.                Display_Response( 8,19, response_1 );
  1478.  
  1479.             end;
  1480.  
  1481.          RECOG_2_MODE: begin
  1482.                g_memory_num := 1;
  1483.                Gen_Stimulus_Input( stimulus_1 );
  1484.                if ( g_speed_mode <> FAST_SPEED )
  1485.                   then Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1486.                response_1 := Recognize( stimulus_1,
  1487.                                         recog_memory_1 );
  1488.  
  1489.                expand( response_1, stimulus_2 );
  1490.  
  1491.                g_memory_num := 2;
  1492.                Display_Stimulus_Window( 41,3,3, stimulus_2 );
  1493.                response_2 := Recognize( stimulus_2,
  1494.                                         recog_memory_2 );
  1495.  
  1496.                {-------------------- fatigue check: --------------------}
  1497.                if ( g_fatigue_flag[2] = 1 ) and
  1498.                   ( response_2 <> 0 ) and
  1499.                   ( response_2 = last_response_2 ) then goto Next_Stimulus;
  1500.                last_response_2 := response_2;
  1501.  
  1502.                expand( response_2, stimulus_3 );
  1503.  
  1504.                g_memory_num := 3;
  1505.                Display_Stimulus_Window( 41,8,3, stimulus_3 );
  1506.  
  1507.                if ( response_2 > 0 ) then begin
  1508.                   if (g_beep_mode = 1)
  1509.                      then beep( response_2*50+120, 10 )
  1510.                      else delay(300);
  1511.                end;
  1512.  
  1513.                Display_Response( 8,19, response_2 );
  1514.             end;
  1515.  
  1516.          RECOG_3_MODE: begin
  1517.                g_memory_num := 1;
  1518.                Gen_Stimulus_Input( stimulus_1 );
  1519.                if ( g_speed_mode <> FAST_SPEED )
  1520.                   then Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1521.                response_1 := Recognize( stimulus_1,
  1522.                                         recog_memory_1 );
  1523.  
  1524.                expand( response_1, stimulus_2 );
  1525.  
  1526.                g_memory_num := 2;
  1527.                Display_Stimulus_Window( 41,3,3, stimulus_2 );
  1528.                response_2 := Recognize( stimulus_2,
  1529.                                         recog_memory_2 );
  1530.  
  1531.                {-------------------- fatigue check: --------------------}
  1532.                if ( g_fatigue_flag[2] = 1 ) and
  1533.                   ( response_2 <> 0 ) and
  1534.                   ( response_2 = last_response_2 ) then goto Next_Stimulus;
  1535.                last_response_2 := response_2;
  1536.  
  1537.                expand( response_2, stimulus_3 );
  1538.  
  1539.                g_memory_num := 3;
  1540.                Display_Stimulus_Window( 41,8,3, stimulus_3 );
  1541.  
  1542.                response_3 := Recognize( stimulus_3,
  1543.                                         recog_memory_3 );
  1544.  
  1545.                {-------------------- fatigue check: --------------------}
  1546.                if ( g_fatigue_flag[3] = 1 ) and
  1547.                   ( response_3 <> 0 ) and
  1548.                   ( response_3 = last_response_3 ) then goto Next_Stimulus;
  1549.                last_response_3 := response_3;
  1550.  
  1551.                expand( response_3, stimulus_4 );
  1552.  
  1553.                g_memory_num := 4;
  1554.                Display_Stimulus_Window( 41,13,3, stimulus_4 );
  1555.  
  1556.                if ( response_3 > 0 ) then begin
  1557.                   if (g_beep_mode = 1)
  1558.                      then beep( response_3*50+120, 20 )
  1559.                      else delay(500);
  1560.                end;
  1561.  
  1562.                Display_Response( 8,19, response_3 );
  1563.             end;
  1564.  
  1565.          LEARN_1_MODE: begin
  1566.                g_memory_num := 1;
  1567.                Gen_Stimulus_Input( stimulus_1 );
  1568.                Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1569.                Learn( stimulus_1,
  1570.                       recog_memory_1 );
  1571.             end;
  1572.  
  1573.          LEARN_2_MODE: begin
  1574.                g_memory_num := 1;
  1575.                Gen_Stimulus_Input( stimulus_1 );
  1576.                if ( g_speed_mode <> FAST_SPEED )
  1577.                   then Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1578.                response_1 := Recognize( stimulus_1,
  1579.                                         recog_memory_1 );
  1580.                expand( response_1, stimulus_2 );
  1581.  
  1582.                g_memory_num := 2;
  1583.                Display_Stimulus_Window( 41,3,3, stimulus_2 );
  1584.                Learn( stimulus_2,
  1585.                       recog_memory_2 );
  1586.             end;
  1587.  
  1588.          LEARN_3_MODE: begin
  1589.                g_memory_num := 1;
  1590.                Gen_Stimulus_Input( stimulus_1 );
  1591.                if ( g_speed_mode <> FAST_SPEED )
  1592.                   then Display_Stimulus_Window( 1,3,13, stimulus_1 );
  1593.                response_1 := Recognize( stimulus_1,
  1594.                                         recog_memory_1 );
  1595.                expand( response_1, stimulus_2 );
  1596.  
  1597.                g_memory_num := 2;
  1598.                Display_Stimulus_Window( 41,3,3, stimulus_2 );
  1599.                response_2 := Recognize( stimulus_2,
  1600.                                         recog_memory_2 );
  1601.  
  1602.                {-------------------- fatigue check: --------------------}
  1603.                if ( g_fatigue_flag[2] = 1 ) and
  1604.                   ( response_2 <> 0 ) and
  1605.                   ( response_2 = last_response_2 ) then goto Next_Stimulus;
  1606.                last_response_2 := response_2;
  1607.  
  1608.                expand( response_2, stimulus_3 );
  1609.  
  1610.                g_memory_num := 3;
  1611.                Display_Stimulus_Window( 41,8,3, stimulus_3 );
  1612.  
  1613.                Learn( stimulus_3,
  1614.                       recog_memory_3 );
  1615.             end;
  1616.          end;
  1617.  
  1618.       if ( g_speed_mode = SLOW_SPEED ) then delay(250);
  1619.  
  1620.       until ( g_exit_mode = EXIT_MODE );
  1621.  
  1622.    end;
  1623.  
  1624.    CursorOn;  {turn it back on}
  1625.    Restore_Screen_2;
  1626. end.
  1627.  
  1628. { ------------------------ End of Program ----------------------------- }
  1629.