{$M+}
{$E+}

PROGRAM Mock;


{$I i:\opus.i}
{$I i:\gctv.inc}

{$I i:\auxsubs.def}
{$I i:\gemsubs.def}

PROCEDURE INT_TO_STRING ( a : INTEGER; VAR b : STR10 );
   EXTERNAL;


{

  VDI calls,

             n_ints = number of integers passed ** these mean to count ALL **
             n_pts  = number of point pairs passed
}


PROCEDURE VDI_Call (     cmd,sub_cmd : INTEGER; n_ints,n_pts : INTEGER;
                     VAR control : Control_Parms;
                     VAR int_in  : Int_In_Parms; VAR int_out : Int_Out_Parms;
                     VAR pts_in  : Pts_In_Parms; VAR pts_out : Pts_Out_Parms;
                         translate   : BOOLEAN );
   EXTERNAL;

PROCEDURE Set_Char_Height ( height : INTEGER );
   BEGIN
       pts_in[0] := 0;
       pts_in[1] := height;
       VDI_Call ( 12,0,0,1,control,int_in,int_out,pts_in,pts_out,FALSE );
   END; { Set_Char_Height }


PROCEDURE Text_Alignment ( horizontal : VDI_Just; vertical : INTEGER );
   {
     affects the justification of text outputted with Draw_Just, and
     Draw_String for that matter
   }
   BEGIN
       int_in[0] := horizontal;
       int_in[1] := vertical;
       VDI_Call ( 39,0,2,0,control,int_in,int_out,pts_in,pts_out,FALSE )
   END;

PROCEDURE Draw_Just ( x, y          : INTEGER;
                      justification : VDI_Just;
                      output_string : STR255   );
   {
     VDI_Left  - begins at x,y
     VDI_Center- begins so that center of string is at x,y
     VDI_Right - begins so that end of string is at x,y
   }
   BEGIN
       { bottom of character box; all Opus calls to this routine want this }
       Text_Alignment(justification,3);
       Draw_String(x,y,output_string)
   END; { DRAW_JUST }

(*
   {
     this is the actual vst_justify call, which allows one to specify the
     length of the string and padding. However, this is quite useless as the
     "padding" doesn't erase the background! Moreover, calling with parameters
     of x,y,30,VDI_Right,'doug' results in 'doug' being placed at the far left
     instead of the far right! Really worthless... Use Draw_Just above if
     anything.
   }
PROCEDURE Draw_Just ( x,y,text_length,
                      justification   : INTEGER;
                      output_string   : STR255 );
   VAR i,n_ints        : INTEGER;
   BEGIN
       Text_Alignment ( justification );
       int_in[0] := 1; { space between words to achieve effect }
       int_in[1] := 0; { don't space between characters }
       FOR i := 1 TO LENGTH (output_string) DO
           int_in[i+1] := ORD(output_string[i]);
       n_ints := LENGTH(output_string)+2;
       pts_in[0] := x;
       pts_in[1] := y;
       pts_in[2] := text_length*8;
       VDI_Call ( 11,10,n_ints,2,control,int_in,int_out,pts_in,pts_out,FALSE );
   END;
*)

(*
PROCEDURE Rotate_Baseline ( angle : INTEGER );
   { angle is a # between 0-3600, in 90 degree increments, i.e. 900=90 deg }
   BEGIN
       int_in[0] := angle;
       VDI_Call ( 13,0,1,0,control,int_in,int_out,pts_in,pts_out,FALSE );
   END;
*)

PROCEDURE Create_User_Line_Type ( linetype : INTEGER );
   BEGIN
       int_in[0] := linetype;
       VDI_Call ( 113,0,1,0,control,int_in,int_out,pts_in,pts_out,FALSE );
   END;

PROCEDURE User_Line_Style;
   BEGIN
       int_in[0] := 7; { user-defined line type }
       VDI_Call ( 15,0,1,0,control,int_in,int_out,pts_in,pts_out,FALSE );
   END;

(*
PROCEDURE VQ_Mouse ( VAR x,y,button : INTEGER );
   BEGIN
       VDI_Call ( 124,0,0,0,control,int_in,int_out,pts_in,pts_out,FALSE );
       button := int_out[0];
       x := pts_out[0];
       y := pts_out[1]
   END;
*)

PROCEDURE Extended_Inquire ( info_flag : INTEGER );
   BEGIN
       int_in[0] := info_flag; { 0=v_opnvwks; 1=extended parameters }
       VDI_Call ( 102,0,1,0,control,int_in,int_out,pts_in,pts_out,FALSE )
   END; { Extended_Inquire }

PROCEDURE Blit ( src,dst                              : Mfdb;
                 from_x,from_y,to_x,to_y,width,height : INTEGER  );
   VAR temp : LONG_INTEGER;
   FUNCTION Addr ( VAR what : Mfdb ) : LONG_INTEGER;
      EXTERNAL;
   BEGIN { Blit }
            temp := Addr(src);
            control[7] := ShR(temp,16);     { high }
            control[8] := temp & $0000FFFF; { low  }
            temp := Addr(dst);
            control[9] := ShR(temp,16);
            control[10] := temp & $0000FFFF;
            int_in[0] := 3;      { replace mode }
            pts_in[0] := from_x;
            pts_in[1] := from_y;
            pts_in[2] := from_x+width-1;
            pts_in[3] := from_y+height-1;
            pts_in[4] := to_x;
            pts_in[5] := to_y;
            pts_in[6] := to_x+width-1;
            pts_in[7] := to_y+height-1;
            VDI_Call ( 109,0,1,4,control,int_in,int_out,pts_in,pts_out,FALSE );
   END; { Blit }


(*****************************************************************************)

{

  AES calls

}

PROCEDURE AES_Call ( op : INTEGER;
                     VAR int_in : Int_In_Parms; VAR int_out : Int_Out_Parms;
                     VAR addr_in:Addr_In_Parms; VAR addr_out:Addr_Out_Parms);
   EXTERNAL;

FUNCTION PTR_TO_LONG ( addr : Generic_Ptr ) : LONG_INTEGER;
   { convert the address contained in the tree pointer into a long }
   VAR change : RECORD
                     CASE byte OF
                        1 : ( original : Generic_Ptr );
                        2 : ( final : LONG_INTEGER );
                     END;
   BEGIN
       change.original := addr;
       ptr_to_long := change.final
   END; { PTR_TO_LONG }

PROCEDURE Write_Message ( ap_id,n_bytes : INTEGER;
                          VAR msg_area  : Message_Buffer );
   FUNCTION Addr ( VAR what : Message_Buffer ) : LONG_INTEGER;
      EXTERNAL;
   BEGIN
       int_in[0] := ap_id;
       int_in[1] := n_bytes;
       addr_in[0] := Addr(msg_area);
       AES_Call ( 12,int_in,int_out,addr_in,addr_out )
   END; { Write_Message }

PROCEDURE Read_Message ( ap_id,n_bytes : INTEGER;
                         VAR msg_area  : Message_Buffer );
   FUNCTION Addr ( VAR what : Message_Buffer ) : LONG_INTEGER;
      EXTERNAL;
   BEGIN
       int_in[0] := ap_id;
       int_in[1] := n_bytes;
       addr_in[0] := Addr(msg_area);
       AES_Call ( 11,int_in,int_out,addr_in,addr_out );
   END; { Read_Message }

PROCEDURE Get_Text (     tree  : Generic_Ptr;
                         index : Tree_Index;
                     VAR p_s   : P_EdText );
   { complementary to Set_Text below }
   CONST 
         obj_len                              = 24;            
   TYPE  
         C_EdTextPtr                          = ^C_EdText;
   VAR
         i                                    : INTEGER;
         ob_spec_addr,ted_info_addr,text_addr : LONG_INTEGER;
         c_s                                  : C_EdTextPtr;
   FUNCTION Ptr ( where : LONG_INTEGER ) : C_EdTextPtr;
      EXTERNAL;
   BEGIN
       ob_spec_addr := ptr_to_long(tree)+index*obj_len+12;
       ted_info_addr := Lpeek(ob_spec_addr);
       text_addr := Lpeek (ted_info_addr); { first thing in tedinfo }
       c_s := Ptr(text_addr); { get a pointer to the tedinfo string }
       p_s := ''; { and convert c-string to Pascal string }
       i := 1;
       WHILE c_s^[i] <> CHR(0) DO BEGIN
          p_s := CONCAT(p_s,c_s^[i]);
          i := i+1
       END
   END; { Get_Text }

PROCEDURE Set_Text (     tree       : Generic_Ptr; { dialog ptr }
                         index      : INTEGER;     { which item }
                         p_str      : STR255;      { a pascal string to show }
                     VAR c_str      : C_EdText;    { C string ptr }
                         text_len   : INTEGER );   { max length of the text }

   { Procedure to replace both Set_DText & Set_DEdit. Must pass a pascal
     string, even a null, and a C string of type C_EdText.
     Set_Text allows you to use an RCS and leave the text fields unoccupied,
     save for template and validation if FTEXT, and then in Pascal, avoid the
     use of SetDEdit which REQUIRES you to enter the temp, val, and initial
     string fields as its parameters, wasting lots of memory ( and a pain ).
     And you can read the text fields with Get_DEdit, which still works fine,
     or use Get_Text above to avoid Get_DEdit's requirement of a STR255 }
 
   CONST
         obj_len                              = 24;
   VAR 
         i                                    : INTEGER;
         ob_spec_addr,ted_info_addr,text_addr : LONG_INTEGER;
   FUNCTION Addr ( VAR a : C_EdText ) : LONG_INTEGER;
      EXTERNAL;
   BEGIN { Set_Text }
       { convert pascal string to a C string, terminated with a zero-byte }
       FOR i := 1 TO LENGTH(p_str) DO
           c_str[i] := p_str[i];
       c_str[LENGTH(p_str)+1] := CHR(0);
       { address of string = area the form manager writes in when user
         modifies editable text fields }
       text_addr := Addr(c_str); 
       {
         now calculate the address within this item's object tree of this
         item's object spec, which equals:
         address of the tree ( Dialog_Ptr )
           PLUS
            item index*obj_len; obj_len = 24, since each item in a tree
            has a 24 byte entry defining it, and these block begin at the tree
            address. The root has index 0, and the rest are numbered 1,2,3...n
           PLUS
         12, the offset within an item's block for the object spec, which in
             the case of any TEXT type object, contains a pointer to a
             TEDINFO data structure
       }
       ob_spec_addr := ptr_to_long(tree)+index*obj_len+12;
       ted_info_addr := Lpeek(ob_spec_addr); { peek into this address }
       { poke address of the string to be outputted,and if FTEXT mixed with the
         template, into the first field of tedinfo }
       Lpoke(ted_info_addr,text_addr);
       { and finally poke the maximum length of the string into tedinfo. NOTE
         the max length includes the zero-byte terminator! }
       Wpoke(ted_info_addr+24,text_len+1);
   END; { Set_Text }

FUNCTION Map_Tree ( tree                  : Generic_Ptr;
                    start_index,end_index : Tree_Index;
                    action                : MapAction    ) : Tree_Index;
   { func to traverse an entire form tree, visiting every node and depending
     on the value of 'action', deselecting all the selectable objects or
     returning the value of the selected one. If the whole tree is to be
     traversed, start_index should = 'Root' and end_index should equal
     'Null_Index', i.e. 0 and -1. This is the case to deselect every
     object with action = 'clear_Selected'. To determine which object is
     selected, a range should be passed, i.e. the first radio button to
     the last in a set of radio buttons, and action should = 'return_Selected'.
     It returns the index of the LAST selected item it found within the range.
     If none were found, or action = clear_Selected, Null_Index is returned.
     This is taken from Tim Oren's Pro Gem column 5.
     Be warned- no error checking is done! }
   CONST
        next                                 = 0;   
        head                                 = 2;   
        tail                                 = 4;         
        obj_len                              = 24;     
   VAR 
        tree_addr                            : LONG_INTEGER;
        temp,cur_index                       : Tree_Index;
   { these function return the contents of the Ob_next, Ob_head, and
     Ob_tail fields of the object specified by index 'temp' }
   FUNCTION Obj_Next ( temp : Tree_Index ) : INTEGER;
      BEGIN
          Obj_Next := Wpeek(tree_addr+temp*obj_len+next)
      END;
   FUNCTION Obj_Head ( temp : Tree_Index ) : INTEGER;
      BEGIN
          Obj_Head := Wpeek(tree_addr+temp*obj_len+head)
      END;
   FUNCTION Obj_Tail ( temp : Tree_Index ) : INTEGER;
      BEGIN
          Obj_Tail := Wpeek(tree_addr+temp*obj_len+tail)
      END;
   BEGIN
       Map_Tree := Null_Index;
       tree_addr := ptr_to_long(tree);
       cur_index := start_index;
       temp := start_index;
       { note Tim Oren had specified current_index instead of temp in the first
         comparison in the WHILE. This would cause you NOT to check the
         last item! temp is the correct variable. }
       WHILE (temp <> end_index) AND (cur_index <> Null_Index) DO
           IF Obj_Tail(cur_index) <> temp THEN BEGIN { through with node? }
              temp := cur_index; { no, save it's index for comparison later }
              IF action = ClearSelected THEN
                 IF (Obj_Flags(tree,temp) & 1) <> 0 THEN { Selectable? }
                    Obj_SetState (tree,temp,Normal,FALSE) { yes, make it nl }
                 ELSE
              ELSE { see if selected - note it assumes proper range was
                     sent. otherwise it returns the value of the last
                     selected object it encountered; if none were found,
                     Null_Index is returned  }
                 IF (Obj_State(tree,temp) & Selected) <> 0 THEN
                    Map_Tree := temp;
              cur_index := Obj_Head(temp); { child? if so advance to it }
              IF cur_index = Null_Index THEN  { no kids, so get next object }
                 cur_index := Obj_Next(temp)
           END
           ELSE BEGIN { obj_tail = current index, so we've done this node and
                        any children it had. Go to next node. }
              temp := cur_index;
              cur_index := Obj_Next(temp)
           END
   END; { Map_Tree }

PROCEDURE Form_Center ( box : Dialog_Ptr;
                        VAR fo_x,fo_y,fo_w,fo_h : INTEGER );
   BEGIN
       addr_in[0] := ptr_to_long(box);
       AES_Call ( 54,int_in,int_out,addr_in,addr_out );
       fo_x := int_out[1];
       fo_y := int_out[2];
       fo_w := int_out[3];
       fo_h := int_out[4];
   END; { Form_Center }
   
PROCEDURE Form_Anywhere ( box     : Dialog_Ptr;
                          x,y     : INTEGER;
                          VAR w,h : INTEGER    );
   VAR addr : LONG_INTEGER;
   BEGIN
      addr := ptr_to_long(box);
      WPoke(addr+16,x);
      WPoke(addr+18,y);
      w := WPeek(addr+20);
      h := WPeek(addr+22)
   END; { Form_Anywhere }

PROCEDURE Form_Dial ( fn,little_x,little_y,little_w,little_h,
                         big_x,big_y,big_w,big_h : INTEGER );
   BEGIN
       int_in[0] := fn;
       int_in[1] := little_x;
       int_in[2] := little_y;
       int_in[3] := little_w;
       int_in[4] := little_h;
       int_in[5] := big_x;
       int_in[6] := big_y;
       int_in[7] := big_w;
       int_in[8] := big_h;
       AES_Call ( 51,int_in,int_out,addr_in,addr_out );
   END; { Form_Dial }

FUNCTION Form_Do ( box : Dialog_Ptr; index : Tree_Index ) : Tree_Index;
   BEGIN
       int_in[0] := index;
       addr_in[0] := ptr_to_long(box);
       AES_Call(50,int_in,int_out,addr_in,addr_out);
       form_do := int_out[0] & $7FFF { if double click on EXIT item, then }
   END; { Form_Do }                  { high bit will be set. To suppress. }

PROCEDURE Rubber_Box ( x,y,sm_w,sm_h              : INTEGER;
                       VAR last_width,last_height : INTEGER );
   BEGIN
         int_in[0] := x;
         int_in[1] := y;
         int_in[2] := sm_w;
         int_in[3] := sm_h;
         AES_Call ( 70,int_in,int_out,addr_in,addr_out );
         last_width := int_out[1]; { return values to caller }
         last_height := int_out[2];
     END; { Rubber_Box }
     
PROCEDURE Drag_Box ( inner_x,inner_y,
                     inner_w,inner_h,
                     outer_x,outer_y,
                     outer_w,outer_h         : INTEGER;
                     VAR n_inner_x,n_inner_y : INTEGER );
   BEGIN
       int_in[0] := inner_w;
       int_in[1] := inner_h;
       int_in[2] := inner_x;
       int_in[3] := inner_y;
       int_in[4] := outer_x;
       int_in[5] := outer_y;
       int_in[6] := outer_w;
       int_in[7] := outer_h;
       AES_Call ( 71,int_in,int_out,addr_in,addr_out );
       n_inner_x := int_out[1];
       n_inner_y := int_out[2];
   END;

PROCEDURE Form_Error ( tos_error_num : INTEGER );
   VAR temp,temp1 : STR255;
   BEGIN
       Set_Mouse(M_Arrow);
       IF tos_error_num >= -17 THEN BEGIN
          int_to_string(ABS(tos_error_num),temp1);
          temp1 := CONCAT('[1][BIOS error # -',temp1);
          CASE tos_error_num OF
             -1,-12 : temp := 'General error';
             -2 : temp := 'Drive was not ready';
             -3 : temp := 'Unknown command';
             -4 : temp := 'CRC error';
             -5 : temp := 'Bad request';
             -6 : temp := 'Seek error';
             -7 : temp := 'Unknown media';
             -8 : temp := 'Sector not found';
             -9 : temp := 'No paper';
             -10 : temp := 'Write error';
             -11 : temp := 'Read error';
             -13 : temp := 'Disk is write-protected';
             -14 : temp := 'Media was changed';
             -15 : temp := 'Unknown device';
             -16 : temp := 'Bad sector';
             -17 : temp := 'Insert disk'
          END;
          temp := CONCAT(temp1,'| |   ',temp,'.][ Cancel ]');
          alert := Do_Alert(temp,1)
       END   
       ELSE BEGIN
          IF ((tos_error_num <= -33) AND (tos_error_num >= -36)) OR
             (tos_error_num = -39) OR (tos_error_num = -46) OR
             (tos_error_num = -49) THEN
             int_in[0] := -(tos_error_num+31)
          ELSE
             int_in[0] := tos_error_num;   
          AES_Call(53,int_in,int_out,addr_in,addr_out)
       END   
   END; (* Form_Error *)    

FUNCTION Obj_Find ( tree          : Dialog_Ptr; 
                    firstob,depth : Tree_Index;
                    x,y           : INTEGER;
                    VAR result    : Tree_Index ) : BOOLEAN;
   BEGIN
      int_in[0] := firstob;
      int_in[1] := depth;
      int_in[2] := x;
      int_in[3] := y;
      addr_in[0] := ptr_to_long(tree);
      AES_Call(43,int_in,int_out,addr_in,addr_out);
      result := int_out[0];
      IF result < 0 THEN
         Obj_Find := FALSE
      ELSE
         Obj_Find := TRUE
   END; { Obj_Find }
   
FUNCTION Wind_Find ( x,y : INTEGER ) : INTEGER;
   BEGIN
      int_in[0] := x;
      int_in[1] := y;
      AES_Call(106,int_in,int_out,addr_in,addr_out);
      Wind_Find := int_out[0]
   END; { Wind_Find }
      
PROCEDURE Graf_MKState ( VAR x,y,btn_state,key_state : INTEGER );
   BEGIN
      AES_Call(79,int_in,int_out,addr_in,addr_out);
      x := int_out[1];
      y := int_out[2];
      btn_state := int_out[3];
      key_state := int_out[4]
   END; { Graf_MKState }
   
{   
PROCEDURE Grow_Shrink( cmd, small_x, small_y, small_w, small_h,
                       big_x, big_y, big_w, big_h : INTEGER );
   BEGIN
      int_in[0] := small_x;
      int_in[1] := small_y;
      int_in[2] := small_w;
      int_in[3] := small_h;
      int_in[4] := big_x;
      int_in[5] := big_y;
      int_in[6] := big_w;
      int_in[7] := big_h;
      AES_Call( cmd, int_in, int_out, addr_in, addr_out );
   END;

PROCEDURE Grow_Box ( small_x, small_y, small_w, small_h,
                       big_x, big_y, big_w, big_h : INTEGER );
    BEGIN
      Grow_Shrink ( 73, small_x, small_y, small_w, small_h,
                    big_x, big_y, big_w, big_h );
    END;

PROCEDURE Shrink_Box ( big_x, big_y, big_w, big_h,
                         small_x, small_y, small_w, small_h : INTEGER );
    BEGIN
      Grow_Shrink ( 74, small_x, small_y, small_w, small_h,
                    big_x, big_y, big_w, big_h );
    END;


PROCEDURE Set_Resource_Address ( res_type,res_index : INTEGER;
                                 VAR res_addr : Generic_Ptr );
   BEGIN
       int_in[0] := res_type;
       int_in[1] := res_index;
       addr_in[0] := res_addr;
       AES_Call ( 113,int_in,int_out,addr_in,addr_out );
   END;

PROCEDURE Obj_Edit ( index,character,next_pos,edit_fn : INTEGER;
                     res_addr                         : Generic_Ptr );
   BEGIN
       int_in[0] := index;
       int_in[1] := character;
       int_in[2] := next_pos;
       int_in[3] := edit_fn;
       addr_in[0] := res_addr;
       AES_Call ( 46,int_in,int_out,addr_in,addr_out );
   END;

FUNCTION Menu_Register ( ap_id : INTEGER; VAR acc_name : STR255 ) : INTEGER;
   EXTERNAL;

PROCEDURE Graf_MKState ( VAR x,y,buttons,keys : INTEGER );
   BEGIN
       AES_Call ( 79,int_in,int_out,addr_in,addr_out );
       x := int_out[1];
       y := int_out[2];
       buttons := int_out[3];
       keys := int_out[4];
   END;

PROCEDURE Move_Box ( o_x,o_y,w,h,n_x,n_y : INTEGER );
   BEGIN
       int_in[1] := w;
       int_in[2] := h;
       int_in[3] := o_x;
       int_in[4] := o_y;
       int_in[5] := n_x;
       int_in[6] := n_y;
       AES_Call ( 72,int_in,int_out,addr_in,addr_out );
   END;


}


BEGIN
END.