home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG121.ARC / FRENCH.ARK / FRENCH2.PAS < prev    next >
Pascal/Delphi Source File  |  1988-08-07  |  2KB  |  99 lines
  1. procedure givequiz(var quiz:quiztype;var order:integerarray;
  2.             numberquestions:integer; var quizitems: stringarray;
  3.             var wrong: booleanarray; var numberwrong: integer);
  4.  
  5. { french version }
  6.  
  7. var
  8.      line,french,english,response  :textline;
  9.      genderresponse,genderchar,c   :character;
  10.      k      :integer;
  11.      answerok,error,genderok       :boolean;
  12.  
  13. procedure stripnl(var s:textline);
  14.  
  15. var
  16.      i      :integer;
  17. begin
  18.      i := index(NEWLINE,1,s);
  19.      if i<>0 then s[i] := EOS; {remove newline from line}
  20. end;
  21.  
  22. procedure ncopy(var src:textline; si:integer;
  23.         var dest:textline; di:integer; count:integer);
  24.  
  25. { copies at most "count" characters from src[si] to dest[di] }
  26.  
  27. begin
  28.      while (src[si] <> EOS) and (count>0) and (max(si,di)<=MAXSTR) do
  29.      begin
  30.       dest[di] := src[si];
  31.       si := si + 1;
  32.       di := di + 1;
  33.       count := count - 1;
  34.      end;
  35.      if di > MAXSTR then di := di - 1;
  36.      dest[di] := EOS;
  37. end;
  38.  
  39. procedure decode(var line,french,english:textline; var genderchar
  40.          :character; var decodeerror:boolean);
  41.  
  42. var
  43.      k,v,v1,i,j         :integer;
  44.  
  45. begin
  46.      stripnl(line);
  47.      v:= index(SLASH,1,line);
  48.      decodeerror := false;
  49.      if v >= 2 then
  50.      begin
  51.       ncopy(line,1,french,1,v-1);
  52.       v1 := index(SLASH,v+1,line);
  53.       if (v1 <> 0) then { have noun }
  54.       begin
  55.            if v1-v <> 2 then
  56.            decodeerror := true
  57.            else
  58.            begin
  59.            genderchar := line[v+1];
  60.            scopy(line,v1+1,english,1);
  61.            end;
  62.       end
  63.       else { have non-noun }
  64.            scopy(line,v+1,english,1);
  65.      end
  66.      else decodeerror := true;
  67. end { decode };
  68.  
  69. function match(var response,target:textline):boolean;
  70. { returns 'true' if response matches one of the items in target }
  71.  
  72. var
  73.      matched,endofstring    :boolean;
  74.      substring    :textline;
  75.      v,start    :integer;
  76.  
  77. begin
  78.      matched := false; endofstring := false;
  79.      start := 1;
  80.      if slength(response) > 0 then
  81.      while (not matched) and (not endofstring) do
  82.      begin
  83.        v := index(SEMICOLON,start,target);
  84.        if v=0 then
  85.        begin
  86.         scopy(target,start,substring,1);
  87.         endofstring := true;
  88.        end
  89.        else
  90.        begin
  91.         ncopy(target,start,substring,1,v-start);
  92.         start := v + 1;
  93.        end;
  94.        matched := equal(response,substring);
  95.       end;
  96.       match := matched;
  97. end { match };
  98.  
  99.