home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CLIPWHAT.ZIP / PAS_SRC.ARC / BINDSCRN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-20  |  16.9 KB  |  429 lines
  1. PROGRAM bindscrn(Input, Output);
  2.  
  3.  
  4.     TYPE
  5.         Str8   = STRING[8];
  6.         Str64  = String[64];
  7.  
  8.    CONST
  9.         Max_Screens = 25;
  10. VAR
  11.       In_file,Out_file,
  12.       Do_file,HomeDir,legal,
  13.       In_path, Out_path           : Str64;
  14.       Scrn_counter,Retval         : Integer;
  15.       Scrn_list,Proc_list         : Array[1..Max_Screens] of Str8;
  16.       Scrn_Process,newpath        : Boolean;
  17.  
  18.  
  19.  
  20.  {------------------------------------------------------------------------}
  21.  { GETFIELD:                                                              }
  22.  {    Read in a field of data into IBUF, only allowing characters found   }
  23.  {    in LEGAL, until SIZE characters have been entered, with the last    }
  24.  {    key code returned in KEYVAL.  The field will be placed at position  }
  25.  {    ROW,COL with colors specified in ATTRIB.                            }
  26.  {------------------------------------------------------------------------}
  27.  type
  28.    Option_Type = set of 0..7;
  29.  
  30.  procedure GetField(var KeyVal       : integer;
  31.                     var Legal        : str64;
  32.                     var Ibuf         : str64;
  33.                         Atrib,
  34.                         Row,Col,Size : integer;
  35.                         Options      : Option_Type);
  36.  
  37.        external 'GETFIELD.BIN';
  38.  
  39. {*******************************************************************}        
  40. function Scrn_name(Base_name : Str64): Str64;
  41.  
  42. begin
  43.     if length(Base_name) = 8 then
  44.         Scrn_name := 'X' + copy(Base_name,1,7)
  45.     else
  46.         Scrn_name := 'X' + Base_name
  47. end;
  48.  
  49. Procedure GetPath(row,col : integer; VAR pathname : Str64);
  50.  
  51. const
  52.     blank : Str64 = '                             ';
  53. function dir_exists(path : Str64) : boolean;
  54.  
  55. var
  56.     result   : boolean;
  57. {$I-}
  58. begin
  59.     chdir(path);
  60.     if IOResult = 0 then
  61.         begin
  62.             chdir(HomeDir);
  63.             result := TRUE
  64.         end
  65.     else
  66.         begin
  67.  
  68.             GoToXY(col,row); Write('Not a valid directory');
  69.             delay(2000);
  70.             result := FALSE
  71.         end;
  72. {$I+}
  73.     dir_exists := result
  74. end;
  75. begin
  76.     repeat
  77.        GotoXY(col,row);
  78.         write(blank);
  79.         pathname := ' ';
  80.         gotoxy(col,row);
  81.         read(pathname);
  82.    If length(pathname)>1 then
  83.       If copy(pathname,length(pathname),1  ) = '\' then
  84.             pathname := copy(pathname,1,length(pathname)-1)
  85.     until dir_exists(pathname) or (length(pathname) = 0);
  86. pathname := pathname + '\';  { make sure the path ends properly }
  87.     if length(pathname) = 1 then
  88.     begin
  89.         pathname := homedir+'\';
  90.         gotoxy(col,row); write(pathname)
  91. end
  92. end;
  93.  
  94. function file_exists(var thefile : Str64) : boolean;
  95.    type
  96.       Registertype = record
  97.                      AX,BX,CX,DX,
  98.                      BP,SI,DI,DS,ES,flags: integer;
  99.       end;
  100.  
  101.    var
  102.       registers:registertype;
  103.  
  104.    begin
  105.       thefile := thefile + #0;
  106.       with registers do
  107.       begin
  108.          ds := seg(thefile);
  109.          dx := ofs(thefile)+1;
  110.          ax := $4E00;
  111.          cx := $0000
  112.       end;
  113.       intr($21,registers);
  114.       file_exists := not ((registers.flags and $0001) = $0001)
  115. end;
  116.  
  117. Procedure Primary_screen; external 'bindscrn.sqz';
  118.  
  119.  
  120. {==========================================================================}
  121. Procedure Convt_screen(Base_name : Str64);
  122.  
  123. Type
  124.        hexval = STRING [4];
  125.  
  126.         CONST
  127.             Base_Overhd = 259.0;         { result is going to be Real }
  128.             Incremental_Overhd = 65.0;   { to allow for > 32767 }
  129.  
  130. VAR
  131.         outval: ARRAY [1..4096] OF hexval;
  132.         Scrn_file: FILE OF BYTE;
  133.         Dat_file: TEXT;
  134.         inchar: BYTE;
  135.         inname, outname: Str64;
  136.         counter, x: INTEGER;
  137.         Out_size           : Real;
  138.         dbsize: STRING [4];
  139.         outstr: STRING [127];
  140.  
  141.  
  142. FUNCTION to_hex(inval: BYTE): hexval;
  143.                                    {convert the byte to its hex string
  144.                                       equivilent }
  145.  
  146.         CONST
  147.             hex: ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  148.  
  149.         VAR
  150.             lchar, rchar: CHAR;
  151.  
  152.         BEGIN
  153.             IF inval < 16 THEN
  154.                 BEGIN
  155.                 lchar := '0';
  156.                 rchar := hex[inval]
  157.                 END
  158.             ELSE
  159.                 BEGIN
  160.                 rchar := hex[inval MOD 16];
  161.                 lchar := hex[((inval DIV 16) MOD 16)]
  162.                 END;
  163.             IF lchar IN ['A'..'F'] THEN
  164.                 to_hex := '0' + lchar + rchar + 'H'
  165.             ELSE
  166.                 to_hex := lchar + rchar + 'H';
  167.         END;
  168.  
  169.     BEGIN {convt_scrn}
  170.        inname := In_path+Base_name + '.SQZ';
  171.          outname := Out_path + Scrn_name(Base_name) + '.DAT';
  172.        Assign(Scrn_file, inname);
  173.        Reset(Scrn_file);
  174.        {open the input file}
  175.        Assign(Dat_file, outname);
  176.        Rewrite(Dat_file); {create and open the output file }
  177.        counter := 0;
  178.        WHILE NOT Eof(Scrn_file) DO
  179.           BEGIN
  180.              {loading the screen file into a hex text file
  181.              to merge into an assembly language source file}
  182.              counter := counter + 1; 
  183.              Read(Scrn_file, inchar);
  184.              outval[counter] := to_hex(inchar)
  185.           END;
  186.         Close(Scrn_file);
  187.       if Scrn_counter = 1 then
  188.          Out_size := Base_Overhd + counter
  189.       else
  190.          Out_size := Out_size + Incremental_Overhd + counter;
  191.       GotoXY(68,23); write(Out_size:5:0);
  192.  
  193. { it's all in the array, now send it out in assembler compatible
  194.   format}
  195.         outstr := Scrn_name(Base_name) + #9 + 'DB' + #9;
  196.         {label first time only}
  197.         x := 1;
  198.         WHILE x < counter DO {no comma after the last one}
  199.             BEGIN
  200.          {   Writeln(outval[x]); }
  201.             IF (x MOD 10 <> 0) THEN {string them together 10 at a time}
  202.                 outstr := outstr + outval[x] + ','
  203.             ELSE { it's long enough - send it out }
  204.                 BEGIN
  205.                 outstr := outstr + outval[x];
  206.                 {no comma on this last one }
  207.                 Writeln(Dat_file, outstr);
  208.                 outstr := #9 + 'DB' + #9
  209.                 {tab + asm directive + tab}
  210.                 END;
  211.             x := x + 1
  212.             END;
  213.         outstr := outstr + outval[counter];
  214.         Writeln(Dat_file, outstr); {send the last one out}
  215.         Writeln(Dat_file, '; End of ', Scrn_name(Base_name), ' data');
  216.         Flush(Dat_file);
  217.         Close(Dat_file);
  218.     END; {Convt_scrn}
  219.  
  220. Procedure gen_head_file;
  221.  
  222. TYPE
  223.    Str127 = String[127];
  224.  
  225. CONST
  226.             Padblank = '        ';
  227.  
  228.  
  229. VAR
  230.    i : Integer;
  231.    Out_Str : Str127;
  232.    LEA_Str : Str8;
  233.     Asm_file : Text;
  234. begin
  235.    i := 1;
  236.    Assign(Asm_file, Out_file);
  237.    Rewrite(Asm_file); {create and open the output file }
  238.     if Scrn_Counter > 1 then
  239.     begin
  240.       Repeat   { make each screen name a  'public name'}
  241.       Out_Str := '        PUBLIC ';
  242.       While (i < Scrn_Counter) and ((length(Out_Str) + length(Proc_list[i+1]) + 1) < 119) do
  243.          begin
  244.             Out_Str := Out_Str + Proc_list[i] + ', ';
  245.             i := i + 1
  246.          end;
  247.          Out_Str := Out_Str + Proc_list[i];  { no comma on the last element in a line }
  248.          i := i + 1;                          { set counter for next pass (or exit) }
  249.          WriteLn(Asm_file,Out_Str);
  250.       Until i >= Scrn_Counter
  251.     end
  252.     else
  253.      WriteLn(Asm_file,'        PUBLIC ',Proc_list[1]);
  254.      { Now write the rest of the initial portion of
  255.        the header file }
  256.      WriteLn(Asm_file,'        EXTRN   _RET:FAR');
  257.      WriteLn(Asm_file,'_PROG   SEGMENT BYTE');
  258.      WriteLn(Asm_file,'        ASSUME CS:_PROG');
  259.      WriteLn(Asm_file,'COMMA   EQU     '',''');
  260.      WriteLn(Asm_file,';************************ local subroutines ***************************');
  261.      WriteLn(Asm_file,';');
  262.      WriteLn(Asm_file,'; ===================== the "main (sub)routine" =======================');
  263.      WriteLn(Asm_file,';');
  264.      WriteLn(Asm_file,'MAIN:   MOV     BX,OFFSET STORAGE        ; put the offset of the screen data into ax');
  265.      WriteLn(Asm_file,'        MOV     SI,10                    ; set the index to the end of the');
  266.      WriteLn(Asm_file,'                                         ; string area because well do the');
  267.      WriteLn(Asm_file,'                                         ; conversion backwards');
  268.      WriteLn(Asm_file,'        CALL    TO_ASC                   ; convert the offset to a string');
  269.      WriteLn(Asm_file,'        MOV     [BX][SI],BYTE PTR COMMA  ; put the comma into the string');
  270.      WriteLn(Asm_file,'        DEC     SI                       ; back up the pointer again');
  271.      WriteLn(Asm_file,'; now get the segment and convert it');
  272.      WriteLn(Asm_file,'        MOV     AX,CS                    ; get the segment address into ax');
  273.      WriteLn(Asm_file,'        CALL    TO_ASC                   ; convert the segment to a string');
  274.      WriteLn(Asm_file,'; now we have the string assembled as SEG,OFS');
  275.      WriteLn(Asm_file,'; it resides at the label "STORAGE" plus any value remaining in SI');
  276.      WriteLn(Asm_file,'; send the command string to vidpop');
  277.      WriteLn(Asm_file,'        CALL    POPCOMMD');
  278.      WriteLn(Asm_file,'        RET                              ; to proc');
  279.      WriteLn(Asm_file,';');
  280.      WriteLn(Asm_file,'; ============= convert hex value in DX to ascii char =================');
  281.      WriteLn(Asm_file,';');
  282.      WriteLn(Asm_file,'TO_ASC: MOV     BP,10                    ; set divisor to 10');
  283.      WriteLn(Asm_file,'        XOR     DX,DX                    ; clear the high word');
  284.      WriteLn(Asm_file,'AGAIN:  DIV     BP                       ; div AX by BP put remainder into DX');
  285.      WriteLn(Asm_file,'        OR      DX,30H                   ; convert remainder to ASCII digit');
  286.      WriteLn(Asm_file,'        MOV     [BX][SI],DL              ; move the char into the string (STORAGE) backwards');
  287.      WriteLn(Asm_file,'        XOR     DX,DX                    ; clear the remainder for next divide');
  288.      WriteLn(Asm_file,'        DEC     SI                       ; adjust pointer for next char        ');
  289.      WriteLn(Asm_file,'        OR      AX,AX                    ; all done with the offset?');
  290.      WriteLn(Asm_file,'        JNZ     AGAIN                    ; no, go get next char from the dividend');
  291.      WriteLn(Asm_file,'        RET                              ; yes, go back to main');
  292.      WriteLn(Asm_file,';');
  293.      WriteLn(Asm_file,'; ================= send the commands to vidpop =======================');
  294.      WriteLn(Asm_file,';');
  295.      WriteLn(Asm_file,'POPCOMMD:                     ; Using Straight Line code because it works');
  296.      WriteLn(Asm_file,'        MOV        AH,14      ; set up for INT 10 function "TTY"');
  297.      WriteLn(Asm_file,'        MOV        AL,255     ; VIDPOP"s wake up character');
  298.      WriteLn(Asm_file,'        INT        10H');
  299.      WriteLn(Asm_file,'        INT        10H        ; send it twice to awaken vidpop');
  300.      WriteLn(Asm_file,'        MOV        AL,''C''');
  301.      WriteLn(Asm_file,'        INT        10H        ');
  302.      WriteLn(Asm_file,'        MOV        AL,''S''');
  303.      WriteLn(Asm_file,'        INT        10H        ');
  304.      WriteLn(Asm_file,'        MOV        AL,'' ''');
  305.      WriteLn(Asm_file,'        INT        10H        ');
  306.      WriteLn(Asm_file,'        MOV        AL,''L''');
  307.      WriteLn(Asm_file,'        INT        10H        ');
  308.      WriteLn(Asm_file,'        MOV        AL,''O''');
  309.      WriteLn(Asm_file,'        INT        10H        ');
  310.      WriteLn(Asm_file,'        MOV        AL,''A''');
  311.      WriteLn(Asm_file,'        INT        10H        ');
  312.      WriteLn(Asm_file,'        MOV        AL,''D''');
  313.      WriteLn(Asm_file,'        INT        10H        ');
  314.      WriteLn(Asm_file,'        MOV        AL,'' ''');
  315.      WriteLn(Asm_file,'        INT        10H        ; the end of the fixed part of the command        ');
  316.      WriteLn(Asm_file,';');
  317.      WriteLn(Asm_file,'; now send out the converted string');
  318.      WriteLn(Asm_file,';');
  319.      WriteLn(Asm_file,'                              ; in the conversion, SI was decremented');
  320.      WriteLn(Asm_file,'                              ; to a position one char before the');
  321.      WriteLn(Asm_file,'                              ; start of SEG,OFS so now we will');
  322.      WriteLn(Asm_file,'        INC     SI            ; move it back one to point properly');
  323.      WriteLn(Asm_file,'        ADD     SI,BX         ; to get pointer for output string');
  324.      WriteLn(Asm_file,'        MOV     AL,[SI]       ; move the character into al');
  325.      WriteLn(Asm_file,'MORE:   INT     10h           ; send it out');
  326.      WriteLn(Asm_file,'        INC     SI            ; increment the pointer');
  327.      WriteLn(Asm_file,'        MOV     AL,[SI]       ; get the next char');
  328.      WriteLn(Asm_file,'        CMP     AL,0          ; see it we"re past the end ');
  329.      WriteLn(Asm_file,'        JNZ     MORE          ; no, go get another char');
  330.      WriteLn(Asm_file,'                              ; yes, finish up');
  331.      WriteLn(Asm_file,'        MOV     AL,''/''        ; and terminate the command to vidpop');
  332.      WriteLn(Asm_file,'        INT     10H');
  333.      WriteLn(Asm_file,'        RET');
  334.      WriteLn(Asm_file,';');
  335.      WriteLn(Asm_file,';*********************** end of local subroutines **************************');
  336.      WriteLn(Asm_file,';');
  337.      WriteLn(Asm_file,'STORAGE:        DB 12 DUP (0)            ; a place to store the string SEG,OFS');
  338.      WriteLn(Asm_file,';');
  339.      WriteLn(Asm_file,';********************** begin screen procs *********************************');
  340.      { now write the individual procedures }
  341.      for i := 1 to Scrn_Counter do
  342.      begin
  343.        Out_Str := Proc_list[i];
  344.        LEA_Str := Scrn_list[i];
  345.        if length(Out_Str) <8 then
  346.          Out_Str := Out_Str +   copy(Padblank,1,7-length(Out_Str));
  347.         WriteLn(Asm_file,Out_Str,' PROC    FAR');
  348.         WriteLn(Asm_file,'        PUSH    SS                        ; save registers and set up per Clipper');
  349.         WriteLn(Asm_file,'        PUSH    ES');
  350.         WriteLn(Asm_file,'        PUSH    BP             ');
  351.         WriteLn(Asm_file,'        PUSH    DS');
  352.         WriteLn(Asm_file,';');
  353.         WriteLn(Asm_file,'        LEA     AX,',LEA_Str,'                 ; load the address of the screen data');
  354.         WriteLn(Asm_file,'        CALL        MAIN ');
  355.         WriteLn(Asm_file,'; now clean up the stack and ...');
  356.         WriteLn(Asm_file,'        POP     DS                       ');
  357.         WriteLn(Asm_file,'        POP     BP');
  358.         WriteLn(Asm_file,'        POP     ES');
  359.         WriteLn(Asm_file,'        POP     SS      ');
  360.         WriteLn(Asm_file,'        CALL    _RET                     ;Clipper stack check');
  361.         WriteLn(Asm_file,'        RET                              ; go back to Clipper');
  362.         WriteLn(Asm_file,Out_Str,' ENDP');
  363.         WriteLn(Asm_file,';*********************************************************************')
  364.    end;  { for i - write procedures }
  365.    { now add the INCLUDE directives }
  366.    for i := 1 to Scrn_Counter    do
  367.     begin
  368.       WriteLn(Asm_file,'INCLUDE ',Scrn_list[i],'.DAT');
  369.         Writeln(Asm_file,'        DB  0')
  370.    end; { for i - write include directives }
  371.     Writeln(Asm_file,'_PROG ENDS');
  372.     Writeln(Asm_file,'END');
  373.    Flush(Asm_file);
  374.    Close(Asm_file)
  375.     
  376. end;  { gen_head_file }
  377.  
  378. begin {main}
  379.    ClrScr;
  380.    {Init variables}
  381.    In_path :='';
  382.    Out_path := '';
  383.    Scrn_counter := 0;
  384.    Scrn_Process := TRUE;
  385.    legal := '';
  386.     Out_file :='';
  387.     GetDir(0,HomeDir);      { Where are we now?)
  388.    { Call in the main screen }
  389.    writeln(chr(255),chr(255),'CS LOAD ',cseg,',',ofs(Primary_screen),'/');
  390.    { Get constant data for source and target paths and Output file name }
  391.     getpath(12,10,In_path);      {the initial source directory}
  392.    getpath(12,50,out_path);  { the target directory for all output files }
  393.     repeat
  394.       GetField(RetVal,legal,Out_file,$30,13,54,8,[1]) { the name for the '.ASM' file }
  395.     until length(Out_file)>0;
  396.    Out_file := Out_path + Out_file+ '.ASM';
  397.    While Scrn_Process do begin
  398.        repeat
  399.            newpath := FALSE;
  400.             In_file := '';
  401.            GetField(RetVal,legal,In_file,$30,13,11,8,[1]); { the name for the screen }
  402.           if RetVal=27 then                                             { and '.DAT' file    }
  403.             begin
  404.                newpath := TRUE;
  405.               getpath(12,10,In_path)
  406.             end;
  407.           if (length(In_file) = 0) and not newpath  then
  408.              Scrn_Process := FALSE
  409.             else
  410.             Do_file := In_path + In_file + '.SQZ'{Put the path and file together}
  411.          until file_exists(Do_file) or not Scrn_Process;
  412.       if scrn_Process then
  413.       begin
  414.         Scrn_Counter := Scrn_Counter + 1;
  415.          GotoXY(67,22); write(Scrn_Counter);
  416.          Scrn_list[Scrn_Counter] := Scrn_name(In_file);
  417.             Proc_list[Scrn_Counter] := In_file;
  418.          Convt_screen(In_file);
  419.          if Scrn_Counter = Max_Screens then
  420.             Scrn_Process := FALSE;
  421.       end;
  422.    end;  { Scrn_Process }
  423.    { Now that all of the screens are converted we
  424.      must write the controlling assembler file   }
  425.     if Scrn_Counter > 0 then
  426.    gen_head_file;
  427.    ClrScr
  428. END.
  429.