program ZKS(input,output,INP);


ORIGIN
  VIDEO=0E800H, TIME=8,
  CUR=0CH, CURL=0FH, CURC=0EH, CURCH=0BH;

label 1;

const
  VSTM=63;		     (* DELKA RADKU V SOUBORU OTAZEK *)
  MAXPOD=10;			     (* MAX. POCET PODOTAZEK *)
  MAXPOD1=11;
  MJMENO=30;			   (* DELKA JMENA ZKOUSENEHO *)
  BELL=7;
  BS=8;
  CS=1FH;
  OPEN=15;

type
    TFN=packed array [1..8] of char;
    TFCB=record
	   DR:BYTE;
	   FN: TFN;
	   FT: packed array [1..3] of char;
	   EX,S1,S2,RC: BYTE;
	   CPMA: packed array [1..16] of char;
	   CR:BYTE;
	   RRN:integer;
	   RRNO:BYTE
	 end;
  TPFD=array [1..21] of char;

  TDFD=record PFD:TPFD;  FCB:TFCB; BUFF:array[1..128] of char end;

  TZAZ=record
	 JMENO: packed array [1..MJMENO] of char;
	 ROCNIK: char;
	 SKUPINA: packed array [1..2] of char;
	 BODY: integer;
	 VYSL: packed array [1..3] of char;
	 TNAME: TFN;
	 CTESTU:char;
       end;

var
  INP:text;
  VSTUP: packed array  [1..VSTM] of char;(* RADEK ZE SOUBORU OTAZEK *)
  KOD, KOD2, CTESTU: char;	       (* PRVNI ZNAK Z RADKU *)
  NODP,					   (* POCET ODPOVEDI *)
  NPOD,					  (* POCET PODOTAZEK *)
  IL,IC:BYTE;
  II:WORD;
  IP,IK,IR: BYTE;			   (* POZICE KURZORU *)
  ODPOV,KODODP: array [1..MAXPOD] of char;
  VAHAOD:array [1..MAXPOD] of integer;
  ZKOUSKA:Boolean;
  VAHA: array [1..MAXPOD] of integer;
  TXT: packed array [1..MAXPOD1] of char;
  SKORE,			       (* CELKOVY POCET BODU *)
  SKOREP,SKOREM,		    (* KLADNE A ZAPORNE BODY *)
  NOTAZ,				     (* CISLO OTAZKY *)
  MEZVYH,			  (* LIMIT PRO SPLNENI TESTU *)
  SKORES: integer;
  I:integer;
  IS:integer;
  ZAZNAM:TZAZ;
  PLATNA: Boolean;
EXTERNAL var
  VIDEO: packed array [0..31,0..63] of char;
  CUR:WORD;
  CURL,CURC:BYTE;
  CURCH:char;
  TIME:BYTE;

SYSTEM function BDOS(var ADR:TFCB;FUN:BYTE):BYTE; EXTERNAL;

procedure CLRSCR;		  (* VYMAZANI CELE OBRAZOVKY *)
begin write(chr(CS)) end;

procedure BEEP;				(* PRI CHYBE ZAPISKA *)
begin for := 20 do write(chr(BELL)) end;

procedure GETCUR;
begin IL:=CURL;  IC:=CURC;  II:=CUR end;

procedure CURADR(I,J: BYTE; II:WORD);(* NASTAV POZICI KURZORU *)
var VID:^char;

begin
  INLINE("DI);
  VID type WORD:=CUR;
  VID^:=' '; CURCH:=' ';
  if J=0 then VIDEO[I]:='  ';      (* ZACATEK RADKY, SMAZ JI *)
  CURL:=I;
  CURC:=J;
  CUR:=II;
  VID type WORD:=CUR;
  VID^:=' ';
  INLINE("EI)
end;

function CHINP:char;
SYSTEM function BDOS(F:BYTE):char;  EXTERNAL;
begin CHINP:=BDOS(1) end;

procedure CLREOS;      (* SMAZ OBRAZOVKU OD KURZORU DO KONCE *)
var I,J:BYTE;

begin
  INLINE("DI);
  for I:=CURC to 63 do VIDEO[CURL,I]:=' ';
  CURCH:=' ';
  for I:=CURL+1 to 31 do
    for J:=0 to 63 do VIDEO[I,J]:=' ';
  INLINE("EI);
end;

procedure VELKE;	      (* KOD PREVED NA VELKA PISMENA *)
begin
  if KOD in ['a'..'z'] then
    KOD:=chr(ord(KOD)+ord('A')-ord('a'))
end;

procedure VOLBA;
var
    B:Boolean;
    I:integer;

procedure CHYBA;
begin
  writeln;
  write('Chybne cislo studijni skupiny !');
  BEEP;
  B:=false
end;

begin
  writeln;
  GETCUR;
  repeat
    writeln('Prejete si Pouceni nebo Zkousku ?');
    write('Odpovezte P/Z: ');
    KOD:=CHINP;
    VELKE;
    if not (KOD in ['P','Z']) then
      begin
	writeln;
        write('Chybna odpoved !');
	BEEP;
	B:=false;
	CURADR(IL,IC,II);
	CLREOS
      end
    else
      begin
	B:=true;
        ZKOUSKA:=KOD='Z';
      end
  until B;
  if ZKOUSKA then
    begin
      writeln(chr(CS),' ':10,'Z K O U S K A');
      writeln;
      write('Prosim Vase jmeno: ');
      readln;
      with ZAZNAM do for I:=1 to MJMENO
                     do if eoln then JMENO[I]:=' '
			else begin JMENO[I]:=input^; get(input) end;
      GETCUR;
      repeat					   (* rocnik *)
	CURADR(IL,IC,II);
	CLREOS;
        write('Rocnik: ');
	KOD:=CHINP;
        B:=KOD in ['1'..'8'];
	if not B then
	  begin
	    writeln;
            write('Takovy rocnik neznam !');
	    BEEP;
	  end
      until B;
      ZAZNAM.ROCNIK:=KOD;
      writeln;

      GETCUR;
      repeat					  (* skupina *)
	CURADR(IL,IC,II);
	CLREOS;
        write('Studijni skupina: ');
        ZAZNAM.SKUPINA:='  ';
	B:=true;
	KOD:=CHINP;
        if not(KOD in ['0'..'9']) then CHYBA else
	  begin
	    KOD2:=CHINP;
	    if ord(KOD2)=0DH then ZAZNAM.SKUPINA[2]:=KOD
            else if  KOD2 in ['0'..'9'] then
		   begin
		     ZAZNAM.SKUPINA[1]:=KOD;
		     ZAZNAM.SKUPINA[2]:=KOD2
		   end else CHYBA
	  end
      until B;
      with INP type TDFD, FCB do ZAZNAM.TNAME:=FN;
    end
end;

procedure GTZN;			    (* CTI ODPOVED NA OTAZKU *)
var I:BYTE;
    NASEL:Boolean;
begin
  write('Zvol odpovedi (SP = konec odpovedi) ');
  repeat
    KOD:=CHINP;
    VELKE;
    NASEL:=false;		(* JE TO PRIPUSTNA ODPOVED ? *)
    for I:=1 to NPOD+1 do
      NASEL:=NASEL or (TXT[I]=KOD);
    if not NASEL then
      begin
	writeln;
        write('Nespravna odpoved !');
	BEEP;
	CURADR(IL+2,IC+34,II+(34+128));
	CLREOS
      end
  until NASEL
end;

procedure CTIR;		   (* PRECTI RADEK ZE SOUBORU OTAZEK *)
var I:BYTE;

begin
  VSTUP:='# ';
  if not eof(INP) then readln(INP);
  if not eof(INP) then
    begin
      for I:=1 to 63 do
        if eoln(INP) then VSTUP[I]:=' '
	else begin VSTUP[I]:=INP^; get(INP) end;
    end;
  KOD:=VSTUP[1];
end;

procedure OTAZKA;		  (* ZPRACOVANI JEDNE OTAZKY *)
label 1;

var I:BYTE;
    J:integer;
    PLUS: Boolean;			  (* DOTAZ A ODPOVED *)

begin
  NODP:=0; NPOD:=0; PLATNA:=false;
  CLRSCR;
  KOD:=VSTUP[1];
  PLUS:=true;
  while PLUS do if KOD<>'#' then CTIR
		else if ZKOUSKA and not eof(INP) then
		       begin
			 for I:=2 to 63 do PLUS:=PLUS and(VSTUP[I]<>CTESTU);
			 if PLUS then CTIR;
		       end else PLUS:=false;
  repeat
    CTIR;
    if KOD<>'#' then
      if KOD<>'*' then                           (* KOMENTAR *)
        if KOD=' ' then                       (* TEXT OTAZKY *)
	  writeln(VSTUP) else
	  begin					(* PODOTAZKA *)
	    NPOD:=NPOD+1; PLATNA:=true;
	    VELKE;
	    KODODP[NPOD]:=KOD;
	    I:=2;
	    PLUS:=true;
	    J:=0;
	    repeat			 (* BODOVE HODNOCENI *)
              if VSTUP[I] in ['0'..'9']
              then J:=J*10+(ord(VSTUP[I])-ord('0')) else
                if VSTUP[I]='-' then PLUS:=false;
              VSTUP[I]:=' ';
	      I:=I+1;		       (* MUZE TO BYT DIVOKE *)
	    until I=5;
	    if not PLUS then J:=-J;
	    VAHA[NPOD]:=J;
	    writeln(VSTUP);
	  end;				 (* PODOTAZKA, WHILE *)
  until KOD='#';
  writeln;
  GETCUR;
  if PLATNA then
    begin					 (* ODPOVEDI *)
      TXT:='  ';
      for I:=1 to NPOD do TXT[I]:=KODODP[I];
      TXT[NPOD+1]:=' ';
      CURADR(IL,IC,II);
      CLREOS;
      write('Dosud odpovezeno:');
    1:repeat
	CURADR(IL+2,IC,II+128);
	CLREOS;
	GTZN;
	VELKE;
        if KOD<>' ' then
	  for J:=1 to NODP do
	    if KOD=ODPOV[J] then
	      begin		   (* STEJNA ODPOVED UZ BYLA *)
		writeln;
                write('Odpoved "',KOD,'" jiz byla pouzita !');
		BEEP;
		goto 1;
	      end;				      (* FOR *)
	NODP:=NODP+1;
	ODPOV[NODP]:=KOD;
	CURADR(IL,IC+(18+2*NODP),II+(18+2*NODP));
	write(KOD)
      until KOD=' ';
      NODP:=NODP-1;
    end;					    (* IF <> *)
end;						     (* OTAZ *)

procedure TEST;
var I,J:integer;
begin
  SKORE:=0;
  SKOREP:=0; SKOREM:=0;
  reset(INP);
  read(INP,CTESTU,MEZVYH);
  CTESTU:=chr( (1+TIME mod(ord(CTESTU)-ord('0'))) + ord('0'));
  NOTAZ:=0;
  ctir;
  while not eof(INP) do
    begin
      NOTAZ:=NOTAZ+1;
      OTAZKA;
      if PLATNA then
	begin
	  SKORES:=0;
	  for I:=1 to NODP do
	    for J:= 1 to NPOD do
	      if ODPOV[I]=KODODP[J] then
		begin
		  IS:=VAHA[J];
		  VAHAOD[I]:=IS;
		  SKORES:=SKORES+IS;
		  if IS>0 then SKOREP:=SKOREP+IS;
		  if IS<0 then SKOREM:=SKOREM-IS;
		end;
	  SKORE:=SKORE+SKORES;
	  if not ZKOUSKA then
	    begin
	      CURADR(IL,IC,II);
	      CLREOS;
              write('Pocet bodu:');
              for I:=1 to NODP do write(ODPOV[I]:4,': ',VAHAOD[I]:1);
	      writeln;
              writeln('Pocet bodu za otazku: ',SKORES:1);
              writeln('Celkem: ',SKORE:1);
              write('SP = dalsi otazka');
	      KOD:=CHINP
	    end;
	end;					  (* NOT EOF *)
    end;					    (* WHILE *)
end;

procedure KONEC;
begin
  CLRSCR; WRITELN; WRITELN;
  writeln(' ':10,'V Y H O D N O C E N I');
  writeln;
  writeln('Za spravne odpovedi jste ziskal ',SKOREP:1,' bodu');
  if SKOREM<>0 then
    begin
      writeln('Za chybne odpovedi ',SKOREM:1,' bodu odebiram.');
      writeln('Celkem mate ',SKORE:1,' bodu');
    end;
    writeln; writeln;
  if SKORE>=MEZVYH then
    begin
      writeln('Blahopreji,  P R O S P E L  jste');
    end else
    begin
      writeln('Bohuzel,  N E P R O S P E L  jste !');
      writeln;
      write('Potrebujete ziskat jeste ',MEZVYH-SKORE:1,' bodu.')
    end;
  BEEP;
end;


begin
1:CLRSCR;
  writeln('(c) VS CVUT-FEL            BIM080288');
  writeln;
  writeln;
  writeln;
  writeln('Prezkouseni znalosti probirane latky');
  writeln;
  writeln;
  write('Zadej jmeno testu: ');

  readln;
  with INP type TDFD
  do with FCB
     do  begin for I:=1 to 8 do
                 if eoln then FN[I]:=' ' else
		   begin
		     KOD:=input^;
		     VELKE;
		     FN[I]:=KOD;
		     get(input)
		   end;
	   DR:=2;(* funguje jen v siti, soubor testu je na b: *)
           FT:='TST';
	 end;
  with INP type TDFD do
    if BDOS(FCB,OPEN)=255 then
      begin
        writeln('Neznamy test ',FCB.FN);
	BEEP;
	goto 1
      end;
  repeat  
   VOLBA; TEST;
   if not zkouska then
   begin clrscr; writeln;writeln;
          write('K O N E C    P O U C E N I':40);
          beep 
   end
  until ZKOUSKA;
  KONEC;
  ZAZNAM.CTESTU:=CTESTU;
  ZAZNAM.BODY:=SKORE;
  if SKORE>=MEZVYH then ZAZNAM.VYSL:='ANO'
  else ZAZNAM.VYSL:='NE ';
end.