ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MISC/EDUCATIO/CATTEST.ZIP/PROTOTYP.PAS

Pascal/Delphi Source File | 1991-04-03 | 13.7 KB | 500 lines

{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,R-,S-,V+,X-}
{$M 16384,0,655360}

{$UNDEF Watch_Student}   {used to record student answers to disk for "analysis"}
{$UNDEF Overlaying}

{$IFNDEF Overlaying}
PROGRAM {substitute next line}
prototst;


{ an example of a simple question without formulas }
{$ELSE}
unit PROTOovr;
interface
function PROTO(VAR grade : Integer):Boolean;
implementation
{$ENDIF}

USES
Crt,DOS,WIN,timestuf,UTILITY,EVAL3;

FUNCTION {substitute next line}
PROTO
(VAR grade : Integer)
: Boolean; { when called, return True if properly answered
                 returns False when help was used and the
                 question resumed}




TYPE
  DebugLinePtr = ^Debug_lines;
  Debug_Lines = RECORD
                  line : STRING; {these will be written into a debug window}
                  next : DebugLinePtr;
                END;

  errorPtr =  ^Wrong_Answers;
  Wrong_Answers = RECORD
                    value : real; {each entry is a teacher chosen error value}
                    remark : STRING; {each entry is a teacher chosen response}
                    Next : errorPtr;
                  END;

  TitleStrPtr = ^TitleStr;
  WinRecPtr = ^WinRec;
  WinRec = RECORD
             Next: WinRecPtr;
             State: WinState;
             Title : TitleStrPtr;
             TitleAttr, FrameAttr: Byte;
             Buffer: Pointer;
           END;

CONST
    variable : char = #0; { set to non character if numbers to be read }
    tolerance : real = 0.1; { set to reasonable discriminatory level
                              as fraction of true answer }




VAR
  OutFile : TEXT;

CONST
    ProgName_String : STRING = {substitute next line}
'PROTO';

VAR
  SaveTextAttr : Byte;
  OldQuestionFile : Text;
  Choice_Line,
  comment_string, {string for student responses }
  answer : STRING; { Student response to main question }
  true_answer,
  Value : real;   { Returned value of Student response }
  Err,ErrPos   : integer; {Required Error Flags for EVAL }
  ErrMsg: STRING;
  Problem_Right,
  Question_Done : Boolean;
  My_Choice : Char;
  GenTempPtr,TempPtr,RootErrorPtr : errorPtr;
  TempDebugLinePtr,GenTempDebugPtr,
  RootDebugLinePtr : DebugLinePtr;
  TopWindow : WinRecPtr;
  WindowCount : Integer;
  Color : Byte;
  pswd : Char;
  question2 : STRING;



PROCEDURE ActiveWindow(Active: Boolean);
BEGIN
  IF TopWindow <> NIL
    THEN
      BEGIN
        UnFrameWin;
        WITH TopWindow^ DO
          IF Active
            THEN
              FrameWin(Title^, DoubleFrame, TitleAttr, FrameAttr)
            ELSE
              FrameWin(Title^, SingleFrame, FrameAttr, FrameAttr);
      END;
END;

PROCEDURE OpenWindow(X1, Y1, X2, Y2: Byte; T: TitleStr;
                     TAttr, FAttr: Byte);

VAR
  W: WinRecPtr;
BEGIN
  GoToXY(38,1);WriteLn('WAIT');
  ActiveWindow(False);
  New(W);
  WITH W^ DO
    BEGIN
      Next := TopWindow;
      SaveWin(State);
      GetMem(Title, Length(T) + 1);
      Title^ := T;
      TitleAttr := TAttr;
      FrameAttr := FAttr;
      Window(X1, Y1, X2, Y2);
      GetMem(Buffer, WinSize);
      ReadWin(Buffer^);
      FrameWin(T, DoubleFrame, TAttr, FAttr);
    END;
  TopWindow := W;
  Inc(WindowCount);
END;

PROCEDURE CloseWindow;

VAR
  W: WinRecPtr;
BEGIN
  IF TopWindow <> NIL
    THEN
      BEGIN
        W := TopWindow;
        WITH W^ DO
          BEGIN
            UnFrameWin;
            WriteWin(Buffer^);
            FreeMem(Buffer, WinSize);
            FreeMem(Title, Length(Title^) + 1);
            RestoreWin(State);
            TopWindow := Next;
          END;
        Dispose(W);
        ActiveWindow(True);
        Dec(WindowCount);
        GoToXY(38,1);WriteLn('    ');
      END;
END;

PROCEDURE reverse(text_in:STRING);
BEGIN
  SaveTextAttr := TextAttr;
  TextAttr := Black + LightGray*16;
  OpenWindow(1,1,80,4,text_in,LightGray*16,LightGray);
  TextAttr := LightGray;
  ClrScr;
END;

PROCEDURE Normal;
BEGIN
  CloseWindow;
  TextAttr := SaveTextAttr;
END;

PROCEDURE Help;
BEGIN
  Reverse('HELP');
  Our_Write(1,1,'There is no help available for this question.');
  Pause(1,2,'Press any key to continue.');
  Normal;
END;



FUNCTION Choice: Char;

VAR
  s : STRING;
BEGIN
  Reverse('MAIN MENU');
  Our_Write(1,1,'[F1]:Calculator [F2]:Answer [F3]:Help [F4]:Comment [F5]:Next Question'  )
  ;
  Our_Write(1,2,'[F6]:Quit Exam '  );
  Choice := Read_Key;
  Normal;
END;

FUNCTION Is_The_STUDENT_Answer_Right(prompt:STRING;
                                     correct_value:real): boolean;

PROCEDURE Wrong_Answer;

VAR
  k_error: integer;
  temp_value : real;
  TEMP_REMARK : STRING;
BEGIN
  TempPtr := RootErrorPtr;
  Reverse('Help after incorrect answer.');
    WHILE TempPtr <> NIL DO
      BEGIN

        IF abs(TempPtr^.value-value) <= abs(tolerance*true_answer)
          THEN
            BEGIN
              Our_Write(1,1,TempPtr^.remark);
              Pause(1,2,'Press any key to continue.');
              Normal;
              exit;
            END;
        { if we exhaust all guesses about the error, then do the following}
        TempPtr := TempPtr^.Next;
        END;
  Our_write(1,1,'Unable to interpret your error. Returning to question.');
  Pause(1,2,'Press any key to continue.');
  Normal;
END; {of Wrong_Answer}

BEGIN
  Question_Done := False;
  REPEAT
    REPEAT
      Reverse('ANSWER');
      Our_Write(1,1,
                     'Escape to leave, [0 thru 9, ., +, -, /, *, arrows], '+#27#217+
                ' key to compute.'
                );
                Our_Write(1,2,' ');
      Read_Float_Masked
                  (1,
                   2,
                   3, {number of digits}
                   Prompt,
                   False,
                   value);
      Normal;
   {$IFDEF Watch_Student}
      WriteLn(OutFile,Time_Stamp,'Answer input->',value);
   {$ENDIF}
      IF Escape_struck
        THEN
          BEGIN

            WHILE
                  YesNo(1,2,'Do you want to abandon this question (y,n,Y,N)?') DO
              BEGIN
                Is_The_STUDENT_Answer_Right := False;
                      { student could not do this question }
                Question_Done := True;
                      { abandon question, not necessarily Watch_Student }
                Grade := -1; {Proctor Convention}
      {$IFDEF Watch_Student}
                WriteLn(OutFile,'Student abandoned problem');
      {$ENDIF}
                exit;
              END;
          END;
      UNTIL NOT Escape_Struck;

      IF abs(value - true_answer) <= abs(tolerance*true_answer)
        THEN
          BEGIN
            Is_The_STUDENT_Answer_Right := True;
            Question_Done := True;
            exit;
          END
        ELSE
          IF YesNo(1,2,'Do you want help?')
            THEN
              Wrong_Answer;

      UNTIL (Question_Done);

END {of Is_The_Student_Right};


PROCEDURE Initialize;
BEGIN
  Randomize;
  TopWindow := nil;
  WindowCount := 0;
  Question_Done := False;
  Problem_Right := False;
  {$IFDEF Watch_Student}
  Assign(OutFile,ProgName_String+'.$$$');
  if FileExists(ProgName_String+'$$$')
    then Append(OutFile)
      else ReWrite(OutFile);
  {$ENDIF}

END {of Initialize};

PROCEDURE real_chooser(prompt:STRING;correct_answer:real);

VAR k_line : integer;
BEGIN
  REPEAT
    My_Choice := Choice;
    GoToXY(1,25);
    ClrEol;
    CASE My_Choice OF
      PF1 : {Calculator}
            BEGIN
              Reverse('CALCULATOR');
              Our_Write(1,1,
                        'Escape to leave, [0 thru 9, ., +, -, /, *]'+#27#217+
                        ' key to compute.'
              );

              answer := Read_equation(
                        1,2,80,'Enter an expression(max length = 80)',[]);
              IF NOT Escape_struck
                THEN
                  BEGIN
                 {$IFDEF Watch_Student}
                    WriteLn(OutFile,Time_Stamp,
                            'Student expression follows:',answer);
                 {$ENDIF}
                    Evaluate(answer,Value,ErrPos,ErrMsg);
                    IF ErrMsg <> 'O.K.'
                      THEN
                        BEGIN
                          Our_Write
                          (1,1,'There has been an error in interpreting your answer.'
                          );
                          Pause(1,2,'Press any key to continue.');
                        END
                      ELSE
                        BEGIN
                          GoToXY(1,1);
                          Write('Calculator Result = ',Value);
                          ClrEol;
                 {$IFDEF Watch_Student}
                          WriteLn(OutFile,Time_Stamp,
                                  '*+-/*+-/ Calculator Result = ',Value);
                 {$ENDIF}
                          Pause(1,2,'Press any key to continue.');
                        END;
                  END;
               Normal;
            END;

      PF2 : {Enter an answer}
            Problem_Right :=
                             Is_The_STUDENT_Answer_Right('ANSWER = ',correct_answer);
      PF3 : {Get Help}
            Help;
      PF4 : {Comment, this is not a full fledged editor, and may
                       need improvement}
            BEGIN
              Reverse('COMMENT');
              Our_Write(1,1,
                        'Enter any characters (no editing available). End with ENTER.');
              ReadLn(comment_string);
              Normal;
           {$IFDEF Watch_Student}
              WriteLn(OutFile,Time_Stamp,
                      'student comment: ', comment_string);
            {$ENDIF}
            END;
      PF5 : {quit this question}
            BEGIN
          {$IFDEF Watch_Student}
              WriteLn(OutFile,Time_Stamp,
                      'Student abandoned problem, continuing to next.');
              WriteLn(OutFile,'Closing file '+ProgName_String);
              Close(OutFile);
          {$ENDIF}
              Question_Done := true;
              Grade := -1; {this is the halt flag for terminating
                         a question }
            END;
      PF6 : {quit the examination}
            BEGIN
          {$IFDEF Watch_Student}
              WriteLn(OutFile,Time_Stamp,
                      'Student abandoned examination.');
              WriteLn(OutFile,'Closing file '+ProgName_string);
              Close(OutFile);
          {$ENDIF}
              Question_Done := true;
              Grade := -2; {this is the halt flag for terminating
                         the examination }
            END;
      PF10 :
             BEGIN {window with debug information}
               SaveTextAttr := TextAttr;
               TextAttr := Black + LightGray*16;
               OpenWindow(2,10,78,24,'DEBUG',LightGray*16,LightGray);
               TextAttr := LightGray;
               ClrScr;
               REPEAT
                 pswd := Read_Key;
                 UNTIL pswd = '\'; {change this if students discover it}
                 TempDebugLinePtr :=  RootDebugLinePtr;
                 while TempDebugLinePtr^.next <> NIL DO
                 BEGIN
                   WriteLn( TempDebugLinePtr^.line);
                   TempDebugLinePtr := TempDebugLinePtr^.next;
                 END;
                 WriteLn( TempDebugLinePtr^.line); {last line}
                 Pause(1,wherey+1,'Press a key to exit');
                 Normal;
             END;
    END; {case}
    UNTIL Question_Done;
  END {of real_chooser};

{$I INITQUES.IN1} {all the exam specific material should be in here}

BEGIN      { MAIN question }
  ClrScr;
  question2 := '';
  Initialize;
  Init_question;


{ question posing section }

  PoseQuestion(5,question);
  (* use the next only if  length of question is > 255 *)
  PoseQuestion(7,question2);

  Real_Chooser(Choice_Line,true_answer);
  {this problem requires a "real" answer'}

  IF (Question_Done AND Problem_Right)
  THEN Grade := 100;

       {substitute next line}
  PROTO
        := Question_Done; {which is the right usage?
                  pass grade back in case student
                  quit the exam, remember that
                  Problem_Right has the value true
                  if problem was done correctly.}

   GenTempPtr := RootErrorPtr; {clean up errors from heap so that
                                no memory problems occur}
   TempPtr := GenTempPtr^.Next;
   Dispose(GenTempPtr);
   WHILE TempPtr <> NIL DO
     BEGIN
       GenTempPtr := TempPtr^.Next;
       Dispose(TempPtr);
       TempPtr := GenTempPtr;
     END;

   GenTempDebugPtr := RootDebugLinePtr; {clean up debug from heap so that
                                no memory problems occur}

   TempDebugLinePtr := GenTempDebugPtr^.Next;
   Dispose(GenTempDebugPtr);
   WHILE TempDebugLinePtr <> NIL DO
     BEGIN
       GenTempDebugPtr := TempDebugLinePtr^.Next;
       Dispose(TempDebugLinePtr);
       TempDebugLinePtr := GenTempDebugPtr;
     END;
  IF Problem_Right
    THEN Pause(1,25,'Question Done Correctly, Press any key.')
    ELSE Pause(1,25,'Exiting Question, Press any key.');
    ClrScr;

END {substitute next line}
{PROTO};
{$IFNDEF Overlaying}

VAR
    Done : Boolean;
    Grade : Integer;

BEGIN {this is the MAIN entry for testing the question as a function}
    Escape_struck := False;
  REPEAT
    IF Escape_struck
      THEN noise(Acknowledge);
    Done := {substitute next line}
             PROTO
             (grade);{this is a function call to the question begin debugged}
    UNTIL Done;

{Record student's success now}
{$ENDIF}
END.