{$P-}

PROGRAM OpusPrinterConfigurationProgram;

LABEL 1;

{$I d:\pascal\gemsubs}
{$I d:\pascal\auxsubs}
{$I d:\opus\install.i}

TYPE
     STR10        = STRING[10];
     STR30        = STRING[30];
     C_EdText     = PACKED ARRAY [1..31] OF CHAR;
     P_EdText     = STR30;
     TwentyBytes  = PACKED ARRAY [1..20] OF BYTE;
     MapFunction  = ( ClearSelected,ReturnSelected );
     PrinterCodes = init..underoff;
     CodeStrings  = ARRAY [PrinterCodes] OF P_EdText;
     CCodeStrings = ARRAY [PrinterCodes] OF C_EdText;
     AllChars     = SET OF CHAR;
     Switcheroo   = RECORD
                        CASE BYTE OF
                           1 : ( str      : STR10 );
                           2 : ( switched : TwentyBytes )
                        END;
           
VAR 
    alert,fo_x,fo_y,fo_w,fo_h,handle : INTEGER;
    done                             : BOOLEAN;
    temp                             : STR255;
    c_name                           : C_STRING;
    buffer                           : Switcheroo;
    digits                           : AllChars;
    c1,c2                            : C_EdText;
    codes                            : CodeStrings;
    ccodes                           : CCodeStrings;
    dialog                           : Dialog_Ptr;
    index,action                     : Tree_Index;
    path                             : Path_Name;
    addr_in                          : Addr_In_Parms;
    addr_out                         : Addr_Out_Parms;
    int_in                           : Int_In_Parms;
    int_out                          : Int_Out_Parms;
     
FUNCTION TOS_Create ( VAR name : C_STRING ; attributes : INTEGER ) : INTEGER;
   GEMDOS ( $3C );
FUNCTION TOS_Open ( VAR name : C_STRING ; mode : INTEGER ) : INTEGER;
   GEMDOS ( $3D );
FUNCTION TOS_Close ( handle : INTEGER ) : INTEGER;
   GEMDOS ( $3E );   
FUNCTION TOS_Read ( handle  : INTEGER; 
                    count   : LONG_INTEGER;
                    VAR buf : TwentyBytes ) : LONG_INTEGER;
   GEMDOS ( $3F );
FUNCTION TOS_Seek ( offset      : LONG_INTEGER;
                    handle,mode : INTEGER        ) : LONG_INTEGER;
   GEMDOS ( $42 );
FUNCTION TOS_Write ( handle  : INTEGER;
                     count   : LONG_INTEGER;
                     VAR buf : TwentyBytes ) : LONG_INTEGER;
   GEMDOS ( $40 );

FUNCTION CHANGE_PTR ( tree_ptr : Dialog_Ptr ) : LONG_INTEGER;
   { Note none of the new AUXSUBS routines will do this! }
   VAR change : RECORD
                     CASE BYTE OF
                        1 : ( original : Dialog_Ptr );
                        2 : ( final    : LONG_INTEGER )
                     END;
   BEGIN
       change.original := tree_ptr;
       change_ptr := change.final
   END; { CHANGE_PTR }
   
PROCEDURE Get_Text (     tree  : Dialog_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 := change_ptr(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       : Dialog_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 }
   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 }
       FOR i := 1 TO LENGTH(p_str) DO
           c_str[i] := p_str[i];
       c_str[LENGTH(p_str)+1] := CHR(0);
       text_addr := Addr(c_str); 
       ob_spec_addr := change_ptr(tree)+index*obj_len+12;
       ted_info_addr := Lpeek(ob_spec_addr); { peek into this address }
       Lpoke(ted_info_addr,text_addr);
       Wpoke(ted_info_addr+24,text_len+1)
   END; { Set_Text }

FUNCTION Map_Tree ( tree                  : Dialog_Ptr;
                    start_index,end_index : Tree_Index;
                    action                : MapFunction  ) : Tree_Index;
   CONST
        next                                 = 0;   
        head                                 = 2;   
        tail                                 = 4;         
        obj_len                              = 24;     
   VAR 
        tree_addr                            : LONG_INTEGER;
        temp,cur_index                       : Tree_Index;
   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 := change_ptr(tree);
       cur_index := start_index;
       temp := start_index;
       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 
                 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] := change_ptr(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_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] := change_ptr(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. }

FUNCTION FORM_BEGIN ( box   : Dialog_Ptr; 
                      index : Tree_Index  ) : Tree_Index;
   BEGIN
       Hide_Mouse;
       Form_Center(box,fo_x,fo_y,fo_w,fo_h); 
       Form_Dial(0,fo_x,fo_y,fo_w,fo_h,fo_x,fo_y,fo_w,fo_h);
       Obj_Draw(box,Root,Max_Depth,fo_x,fo_y,fo_w,fo_h);
       Show_Mouse;
       form_begin := Form_Do(box,index)
   END; { FORM_BEGIN }
   
PROCEDURE FORM_END;
   BEGIN
       Hide_Mouse;
       Form_Dial(3,fo_x,fo_y,fo_w,fo_h,fo_x,fo_y,fo_w,fo_h);
       Show_Mouse
   END; { FORM_END }
   
PROCEDURE READ_ERROR;
   BEGIN
       alert := Do_Alert('[1][Read error.][ Abort ]',1);
       handle := TOS_Close(handle);
       GOTO 1
   END; { READ_ERROR }
   
PROCEDURE READ_BYTES ( n : LONG_INTEGER );
   BEGIN
       IF TOS_Read(handle,n,buffer.switched) <> n THEN
          read_error
   END; { READ_BYTES }
   
PROCEDURE WRITE_BYTES ( n : LONG_INTEGER );
   BEGIN
       IF TOS_Write(handle,n,buffer.switched) <> n THEN BEGIN
          alert := Do_Alert('[1][Write error.][ Abort ]',1);
          handle := TOS_Close(handle);
          GOTO 1
       END
   END; { WRITE_BYTES }
         
PROCEDURE INITIALIZE;
   VAR i : PrinterCodes;
   BEGIN
       done := FALSE;
       Show_Mouse;
       Set_Mouse(M_Arrow);
       IF NOT Load_Resource('INSTALL.RSC') THEN BEGIN
          temp := CONCAT('[3][INSTALL.RSC must live in|' , 
                             'the same directory as|' ,
                             'INSTALL.PRG!][ Abort ]');
          alert := Do_Alert(temp,1);
          Exit_Gem;
          HALT
       END;
       Find_Dialog(prntdial,dialog);
       index := Map_Tree(dialog,Root,Null_Index,ClearSelected);
       Set_Text(dialog,stdchr,'',c1,3);
       Set_Text(dialog,conchr,'',c2,3);
       FOR i := init TO underoff DO
           Set_Text(dialog,i,'',ccodes[i],30);       
       digits := ['0'..'9'];     
       Obj_SetState(dialog,parallel,Selected,FALSE)
   END; { INITIALIZE }

FUNCTION STR_TO_INT ( what : STR255 ) : INTEGER;
   VAR i,inc,result : INTEGER;
   BEGIN
       inc := 1;
       result := 0;
       FOR i := LENGTH(what) DOWNTO 1 DO BEGIN
           result := result+(ORD(what[i])-$30)*inc;
           inc := inc*10
       END;
       IF result > 255 THEN BEGIN
          alert := Do_Alert('[3][Bad Number!][  OK  ]',1);
          Obj_SetState(dialog,ok,Normal,TRUE);
          GOTO 1
       END;
       str_to_int := result
   END; { STR_TO_INT }
        
FUNCTION STR_TO_INT_TO_CHAR ( what : P_EdText ) : CHAR;
   BEGIN
       str_to_int_to_char := CHR(str_to_int(what))
   END; { STR_TO_INT_TO_CHAR }        
             
PROCEDURE PARSE ( VAR what : P_EdText );
   VAR x1,x2,i            : INTEGER;
       quit               : BOOLEAN;
       temp,temp1,newline : P_EdText;
   BEGIN
       temp := '';
       i := 1;
       WHILE i <= LENGTH(what) DO BEGIN
          temp1 := '';
          IF what[i] IN digits THEN BEGIN
             x1 := i;
             i := i+1;
             quit := FALSE;
             WHILE (i <= LENGTH(what)) AND (NOT quit) DO
                IF what[i] IN digits THEN
                   i := i+1
                ELSE
                   quit := TRUE;
                x2 := i-1;
                temp1 := COPY(what,x1,x2-x1+1);
                IF LENGTH(temp1) > 3 THEN BEGIN
                   alert := Do_Alert('[3][Bad Number!][  OK  ]',1);
                   Obj_SetState(dialog,ok,Normal,TRUE);
                   GOTO 1
                END;
                temp := CONCAT(temp,str_to_int_to_char(temp1))
          END
          ELSE
             i := i+1
       END; { WHILE }       
       what := temp
   END; { PARSE }
          
PROCEDURE EVALUATE;
   VAR i : PrinterCodes;
   BEGIN
       P_To_Cstr('PRINTER.INF',c_name);
       handle := TOS_Create(c_name,0);
       IF handle < 0 THEN BEGIN
          alert := Do_Alert('[1][Can not create PRINTER.INF.][  OK  ]',1);
          GOTO 1
       END;
       buffer.str := 'opus print';
       write_bytes(11);
       IF Obj_State(dialog,parallel) & Selected <> 0 THEN
          buffer.switched[1] := 3
       ELSE
          buffer.switched[1] := 2;
       Get_Text(dialog,stdchr,temp);
       buffer.switched[2] := str_to_int(temp);
       Get_Text(dialog,conchr,temp);
       buffer.switched[3] := str_to_int(temp);
       write_bytes(3);
       FOR i := init TO underoff DO BEGIN
           Get_Text(dialog,i,codes[i]);
           parse(codes[i]);
           buffer.str := codes[i];
           write_bytes(LENGTH(buffer.str)+1)
       END;
       done := TRUE;
       handle := TOS_Close(handle)
   END; { EVALUATE }

PROCEDURE INT_TO_STR ( a : INTEGER; VAR str : P_EdText );
   VAR inc,temp : INTEGER;
       leading    : BOOLEAN;
   BEGIN
       str := '';
       inc := 100;
       leading := TRUE;
       WHILE inc > 0 DO BEGIN
          temp := a DIV inc;
          IF temp > 0 THEN
             leading := FALSE;
          IF NOT leading THEN BEGIN
             str := CONCAT(str,CHR(temp+$30));
             a := a-temp*inc
          END;
          inc := inc DIV 10
       END;
       IF LENGTH(str) = 0 THEN
          str := '0'
   END; { INT_TO_STR }

PROCEDURE CHAR_TO_INT_TO_STR ( a : CHAR; VAR b : P_EdText );
   VAR str : P_EdText;
   BEGIN
       int_to_str(ORD(a),str);
       b := CONCAT(b,str,' ')
   END; { CHAR_TO_INT_TO_STR }
       
PROCEDURE LOAD_FILE;
   VAR i : PrinterCodes;
       j : INTEGER;
   BEGIN
       Obj_SetState(dialog,load,Normal,TRUE);
       P_To_Cstr('PRINTER.INF',c_name);
       handle := TOS_Open(c_name,0);
       IF handle >= 0 THEN BEGIN
          read_bytes(11);
          read_bytes(3);
          index := Map_Tree(dialog,Root,Null_Index,ClearSelected);
          IF buffer.switched[1] = 2 THEN 
             Obj_SetState(dialog,serial,Selected,TRUE)
          ELSE
             Obj_SetState(dialog,parallel,Selected,TRUE);
          Obj_Draw(dialog,serial,Max_Depth,fo_x,fo_y,fo_w,fo_h);
          Obj_Draw(dialog,parallel,Max_Depth,fo_x,fo_y,fo_w,fo_h);
          int_to_str(buffer.switched[2],temp);
          Set_Text(dialog,stdchr,temp,c1,3);
          Obj_Draw(dialog,stdchr,Max_Depth,fo_x,fo_y,fo_w,fo_h);
          int_to_str(buffer.switched[3],temp);
          Set_Text(dialog,conchr,temp,c2,3);
          Obj_Draw(dialog,conchr,Max_Depth,fo_x,fo_y,fo_w,fo_h);
          FOR i := Init TO Underoff DO BEGIN
              read_bytes(1);
              IF buffer.switched[1] > 0 THEN 
                 IF TOS_Seek(-1,handle,1) < 0 THEN
                    read_error
                 ELSE BEGIN
                    read_bytes(buffer.switched[1]+1);
                    codes[i] := '';
                    FOR j := 1 TO LENGTH(buffer.str) DO
                        char_to_int_to_str(buffer.str[j],codes[i]);
                    DELETE(codes[i],LENGTH(codes[i]),1)
                 END;
              Set_Text(dialog,i,codes[i],ccodes[i],30);
              Obj_Draw(dialog,i,Max_Depth,fo_x,fo_y,fo_w,fo_h)
          END;
          handle := TOS_Close(handle)
       END
       ELSE BEGIN
          alert := Do_Alert('[1][PRINTER.INF not found.][  OK  ]',1);
          GOTO 1
       END
   END; { LOAD_FILE }
             
BEGIN { main }
    IF Init_Gem >= 0 THEN BEGIN
       initialize;
       action := form_begin(dialog,stdchr);
       LOOP
          IF action = ok THEN
             evaluate
          ELSE IF action = load THEN 
             load_file;
          EXIT IF (done) OR (action = cancel);
1:        action := Form_Do(dialog,stdchr)
       END;
       form_end;
       Free_Resource;
       Exit_Gem
    END
END.