home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 12 / CD_ASCQ_12_0294.iso / maj / 535 / passrc2.pas < prev    next >
Pascal/Delphi Source File  |  1993-12-20  |  18KB  |  703 lines
  1. {Substitutions and fills in file, skel.dat
  2.   Area Fills
  3.   @ZZ0    Form the dialog in constructor
  4.   @ZZ1    Defined Control Names in Object Def.
  5.   @ZZ2    Data record def
  6.   @ZZ3    Load GetSubViewPtr
  7.   @ZZ4    Store PutSubViewPtr
  8.  
  9.   Substitutions
  10.   @XX0    Dialog's Pointer  (as  PMyDialog)
  11.   @XX1    Dialog's Symbol   (as  TMyDialog)
  12.   @XX2    Dialog's ancestor (usually TDialog)
  13.   @XX3    Dialog's registration TStreamRec (as RMyDialog)
  14.   @XX4    Unit name
  15.   @XX5    'Control1'
  16.   @XX6    uses clause items
  17.  
  18. }
  19. {$A-,B-,E+,F-,G-,I+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  20. {$M 16384,5000,655360}
  21.  
  22. Program PasSrc2;
  23.  
  24. uses Dos, Objects, Drivers, Views, Dialogs,
  25.      Editors, Validate, ReadScpt;
  26.  
  27. const
  28.   NeedControl1 : boolean = False;
  29. var
  30.   OutF : Text;
  31.   S : String;
  32.  
  33. PROCEDURE Subst(I : Integer);   {make a substitution for @XXn.  I is the
  34.   location of @XXn in S }
  35. var
  36.   N : Byte;
  37.   St : String;
  38.   Name : NameStr;
  39.   Ext : ExtStr;
  40. begin
  41. N := Ord(S[I+3]) - Ord('0');  {get the substitution number}
  42. Delete(S, I, 4);              {delete the @XXn }
  43. case N of
  44.   0 : Insert(Dialog^.MainBlock.Obj^, S, I);  {like PMyDialog}
  45.   1 : begin
  46.       St := Dialog^.MainBlock.Obj^;
  47.       if St[1] in ['P', 'p'] then Delete(St,1,1);
  48.       Insert('T', St, 1);
  49.       Insert(St, S, I);
  50.       end;
  51.   2 : Insert(Dialog^.MainBlock.BaseObj^, S, I);  {like TDialog}
  52.   3 : begin
  53.       St := Dialog^.MainBlock.Obj^;
  54.       if St[1] in ['P', 'p'] then Delete(St,1,1);
  55.       Insert('R', St, 1);
  56.       Insert(St, S, I);
  57.       end;
  58.   4 : begin   {unit name same as filename}
  59.       FSplit(ParamStr(2), St, Name, Ext);
  60.       Insert(Name, S, I);
  61.       end;
  62.   5 : if NeedControl1 then Insert(', Control1', S, I);
  63.   6 : begin
  64.       St := '';
  65.       if Present[CText] then St := ', ColorTxt';
  66.       if Present[ILong] then St := St+', InpLong';
  67.       if Present[Memo] then St := St+', Editors';
  68.       if ValidatorPresent then St := St+', Validate';
  69.       if St <> '' then Insert(St, S, I);
  70.       end;
  71.   end;
  72. end;
  73.  
  74. function Positn(Pat, Src : String; I : Integer) : Integer;
  75. {find the position of a substring in a string starting at the Ith char}
  76. var
  77.   N : Integer;
  78. begin
  79. if I < 1 then I := 1;
  80. Delete(Src, 1, I-1);
  81. N := Pos(Pat, Src);
  82. if N = 0 then Positn := 0
  83.   else Positn := N+I-1;
  84. end;
  85.  
  86. FUNCTION Quoted(S : string) : string;
  87. {If first char is '@' then removes the '@' and otherwise does nothing--
  88.    assumes string is a variable name.
  89.  else
  90.    Puts single quotes around a string and doubles any internal single quotes}
  91. var
  92.   I : Integer;
  93. begin
  94. I := Pos('@', S);
  95. if I = 1 then
  96.   begin
  97.   Quoted := Copy(S, 2, 255);
  98.   Exit;
  99.   end;
  100. I := Pos('''', S);
  101. while I > 0 do
  102.   begin
  103.   Insert('''', S, I);
  104.   I := Positn('''', S, I+2);
  105.   end;
  106. Insert('''', S, 1);
  107. Quoted := S+'''';
  108. end;
  109.  
  110. procedure RDotAssign(P : PScriptRec);
  111. begin
  112. with P^.MainBlock do
  113.   begin
  114.   WriteLn(Outf, 'R.Assign(', X1, ', ', Y1, ', ', X2,', ', Y2, ');');
  115.   end;
  116. end;
  117.  
  118. procedure DoOpEvent(P : PScriptRec; const Sym : string);
  119. var
  120.   S : string;
  121. begin
  122. with P^.MainBlock do
  123.   begin
  124.   if DefOptns <> Optns then
  125.     begin
  126.     Write(Outf, Sym, '^.Options := ');
  127.     S := OptionStr(Optns, DefOptns, GetOptionWords);
  128.     if S[1] = '$' then
  129.       WriteLn(OutF, S)
  130.     else WriteLn(OutF, Sym, '^.Options', S);
  131.     end;
  132.   if DefEvMsk <> EvMsk then
  133.     begin
  134.     Write(Outf, Sym, '^.EventMask := ');
  135.     S := OptionStr(EvMsk, DefEvMsk, GetEventWords);
  136.     if S[1] = '$' then
  137.       WriteLn(OutF, S)
  138.     else WriteLn(OutF, Sym, '^.EventMask', S);
  139.     end;
  140.   end;
  141. end;
  142.  
  143. (*--
  144. procedure DoOpEvent(P : PScriptRec; const Sym : string);
  145. begin
  146. with P^.MainBlock do
  147.   begin
  148.   if DefOptns <> Optns then
  149.     WriteLn(Outf, Sym, '^.Options := ', Sym, '^.Options',
  150.                   OptionStr(Optns, DefOptns, GetOptionWords));
  151.   if DefEvMsk <> EvMsk then
  152.     WriteLn(Outf, Sym, '^.EventMask := ', Sym, '^.EventMask',
  153.                   OptionStr(EvMsk, DefEvMsk, GetEventWords));
  154.   end;
  155. end;   ---*)
  156.  
  157. PROCEDURE WriteHelpCtx(Rf : PString; H : String; Ctx : word);
  158. Const
  159.   NoContext : String[11] = 'hcNoContext';
  160. begin
  161. if (H = '') and (Ctx > 0) then
  162.    Str(Ctx, H);
  163. if (H <> '') and not SameString(H, NoContext) then
  164.   if Rf <> Nil then
  165.     WriteLn(OutF, Rf^, '^.HelpCtx := ', H, ';' )
  166.   else WriteLn(OutF, 'HelpCtx := ', H, ';' )
  167. end;
  168.  
  169. procedure WriteButton(P : PScriptRec);
  170. var
  171.   S : string[55];
  172.  
  173.   function FlagStr : string;
  174.   var
  175.     S : string[55];
  176.   begin
  177.   with P^ do
  178.     begin
  179.     S := '';
  180.     if Flags = 0 then S := 'bfNormal'
  181.     else
  182.       begin
  183.       if Flags and 1 <> 0 then S := 'bfDefault+';
  184.       if Flags and 2 <> 0 then S := S+'bfLeftJust+';
  185.       if Flags and 4 <> 0 then S := S+'bfBroadcast+';
  186.       if Flags and 8 <> 0 then S := S+'bfGrabFocus+';
  187.       Dec(S[0]);  {remove extra '+'}
  188.       end;
  189.     end;
  190.   FlagStr := S;
  191.   end;
  192.  
  193. begin
  194. with P^, MainBlock do
  195.   begin
  196.   RDotAssign(P);
  197.   if SameString(Obj^, 'POptionButton') then  {a special TOptionButton}
  198.     WriteLn(OutF, VarName^, ' := New(', Obj^, ', Init(R, ', Param[1]^,
  199.          ', '+Param[2]^+'));' )
  200.   else
  201.     begin   {regular button}
  202.     if CommandName^ <> '' then S := CommandName^
  203.       else Str(CommandValue, S);
  204.     Write(OutF, VarName^, ' := New(', Obj^, ', Init(R, ',
  205.          Quoted(ButtonText^), ', '+S+', ' );
  206.     WriteLn(OutF, FlagStr+'));' );
  207.     end;
  208.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  209.   DoOpEvent(P, VarName^);
  210.   WriteLn(OutF, 'Insert(', VarName^, ');');
  211.   end;
  212. end;
  213.  
  214. procedure WriteInputLong(P : PScriptRec);
  215. begin
  216. with P^, MainBlock do
  217.   begin
  218.   RDotAssign(P);
  219.   WriteLn(OutF,
  220.          VarName^, ' := New('+Obj^+', Init(R, ', LongStrLeng,
  221.          ', ', LLim, ', ', ULim,  ', ', ILOptions, '));' );
  222.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  223.   DoOpEvent(P, VarName^);
  224.   WriteLn(OutF, 'Insert(', VarName^, ');');
  225.   end;
  226. end;
  227.  
  228. procedure WriteInputLine(P : PScriptRec);
  229. var
  230.   S : string[15];
  231.  
  232.   function DoubleInsideQuotes(St : string) : string;
  233.   var
  234.     I : integer;
  235.   begin
  236.   I := Pos('''', St);
  237.   while I > 0 do
  238.     begin
  239.     Insert('''', St, I);
  240.     I := Positn('''', St, I+2);
  241.     end;
  242.   DoubleInsideQuotes := St;
  243.   end;
  244.  
  245. begin
  246. with P^, MainBlock do
  247.   begin
  248.   RDotAssign(P);
  249.   WriteLn(OutF,
  250.          VarName^, ' := New('+Obj^+', Init(R, ', StringLeng, '));' );
  251.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  252.   DoOpEvent(P, VarName^);
  253.   WriteLn(OutF, 'Insert(', VarName^, ');');
  254.  
  255.   if ValKind in [Picture..StringLookup] then
  256.     begin
  257.     Write(OutF, '  ', Obj^+'('+VarName^+')^.Validator := New(', ValPtrName^,
  258.         ', Init(');
  259.     case ValKind of
  260.       Picture:
  261.          begin
  262.          if AutoFill <> 0 then S := 'True' else S := 'False';
  263.          {Note: PictureString may start with '@'}
  264.          WriteLn(OutF, '''', DoubleInsideQuotes(PictureString^), ''', ', S, '));');
  265.          end;
  266.       Range:
  267.          begin
  268.          WriteLn(OutF, LowLim, ', ', UpLim, '));');
  269.          if Transfer <> 0 then
  270.            WriteLn(OutF, '  ',
  271.                Obj^+'('+VarName^+')^.Validator^.Options := voTransfer;');
  272.          end;
  273.       Filter:
  274.          WriteLn(OutF, CharSet^, '));');
  275.       StringLookup:
  276.          WriteLn(OutF, List^, '));');
  277.       end;
  278.     end;
  279.   end;
  280. end;
  281.  
  282. procedure WriteMemo(P : PScriptRec);
  283. begin
  284. with P^, MainBlock do
  285.   begin
  286.   RDotAssign(P);
  287.   Write(OutF,
  288.          VarName^, ' := New('+Obj^+', Init(R, ');
  289.   if HScroll^ <> '' then
  290.     Write(OutF, 'PScrollbar(Control1), ')
  291.   else Write(OutF, 'Nil, ' );
  292.   if VScroll^ <> '' then
  293.     Write(OutF, 'PScrollbar(Control), ')
  294.   else Write(OutF, 'Nil, ' );
  295.   WriteLn(OutF, 'Nil, ', BufSize, '));');
  296.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  297.   DoOpEvent(P, VarName^);
  298.   WriteLn(OutF, 'Insert(', VarName^, ');');
  299.   end;
  300. end;
  301.  
  302. procedure WriteListBox(P : PScriptRec);
  303. begin
  304. with P^, MainBlock do
  305.   begin
  306.   RDotAssign(P);
  307.   Write(OutF,
  308.          VarName^, ' := New('+Obj^+', Init(R, ', Columns);
  309.   if Scrollbar^ <> '' then
  310.     WriteLn(OutF, ', PScrollbar('+ScrollBar^+')));')
  311.   else WriteLn(OutF, ', Nil));' );
  312.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  313.   DoOpEvent(P, VarName^);
  314.   WriteLn(OutF, 'Insert(', VarName^, ');');
  315.   end;
  316. end;
  317.  
  318. procedure WriteScrollBar(P : PScriptRec);
  319. begin
  320. with P^, MainBlock do
  321.   begin
  322.   RDotAssign(P);
  323.   WriteLn(OutF,
  324.          VarName^, ' := New('+Obj^+', Init(R));');
  325.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  326.   DoOpEvent(P, VarName^);
  327.   WriteLn(OutF, 'Insert(', VarName^, ');');
  328.   end;
  329. end;
  330.  
  331. procedure WriteCheckRadio(P : PScriptRec);
  332. var
  333.   I : integer;
  334. begin
  335. with P^, MainBlock do
  336.   begin
  337.   RDotAssign(P);
  338.   Write(OutF,
  339.          VarName^, ' := New('+Obj^+', Init(R, ');
  340.   for I := 0 to Items-1 do
  341.     Write(OutF, ^M^J'  NewSItem(', Quoted(PString(LabelColl^.At(I))^), ',');
  342.   Write(OutF, ' Nil)');
  343.   for I := 1 to Items -1 do
  344.     Write(OutF, ')');
  345.   if Kind = MultiCB then
  346.     Write(OutF, ', ', SelRange, ', ', MCBFlags, ', ', Quoted(States^));
  347.   WriteLn(OutF, '));');
  348.   if Mask <> -1 then
  349.     WriteLn(OutF, 'PCluster('+VarName^+')^.SetButtonState($', Hex8(not Mask), ', False);');
  350.   WriteHelpCtx(VarName, HelpCtxSym^, HCtx);
  351.   DoOpEvent(P, VarName^);
  352.   WriteLn(OutF, 'Insert(', VarName^, ');');
  353.   end;
  354. end;
  355.  
  356. procedure WriteHistory(P : PScriptRec);
  357. begin
  358. with P^, MainBlock do
  359.   begin
  360.   Write(OutF, '  ');
  361.   RDotAssign(P);
  362.   WriteLn(OutF, '  Insert(New(PHistory, Init(R, PInputline(',
  363.                     HistoryLink^, '), ', HistoryID, ')));');
  364.   end;
  365. end;
  366.  
  367. procedure WriteStaticText(P : PScriptRec);
  368.   procedure DoAtText;
  369.   var
  370.     S : string;
  371.     I : integer;
  372.   begin
  373.   S := P^.Text^;
  374.   I := Pos(^C, S);
  375.   while I > 0 do
  376.     begin
  377.     Delete(S, I, 1);  {remove ^C's}
  378.     I := Pos(^C, S);
  379.     end;
  380.   Delete(S, 1, 1);   {remove '@'}
  381.   I := Pos(^M, S);
  382.   while I > 0 do
  383.     begin
  384.     Delete(S, I, 1);  {remove ^M's}
  385.     I := Pos(^M, S);
  386.     end;
  387.   Write(OutF, S);
  388.   end;
  389.  
  390.   procedure DoText;  {split Text into short lines if it is long}
  391.                      {convert single quotes to double}
  392.   var
  393.     I, Count, TextLeng : Integer;
  394.     Ch : char;
  395.     S : string[20];
  396.   begin
  397.   Write(OutF, '''');
  398.   Count := 38;
  399.   with P^ do
  400.     begin
  401.     I := 1;
  402.     TextLeng := Length(Text^);
  403.     while I <= TextLeng do
  404.       begin
  405.       Ch := Text^[I];
  406.       if Ch = ^M then
  407.          begin
  408.          if I >= TextLeng then
  409.             S := ''    {on the end}
  410.          else S := '''^M+'^M^J'     ''';
  411.          Count := 0;
  412.          end
  413.       else if Ch = '''' then
  414.          S := ''''''    {one quote to two}
  415.       else S := Ch;
  416.       Write(OutF, S);
  417.       Inc(Count, Length(S));
  418.       if (Count >= 75) and (I < TextLeng) then
  419.         begin
  420.         Write(OutF, '''+'^M^J'     ''');
  421.         Count := 5;
  422.         end;
  423.       Inc(I);
  424.       end;
  425.     end;
  426.   Write(OutF, '''');
  427.   end;
  428.  
  429. begin
  430. with P^, MainBlock do
  431.   begin
  432.   RDotAssign(P);
  433.   Write(OutF, VarName^, ' := New('+Obj^+', Init(R, ');
  434.   if (Length(Text^) > 1) and ((Text^[1] = '@')
  435.          or (Text^[2] = '@')) then    {could be ^C'@'}
  436.     DoAtText
  437.   else
  438.     DoText;
  439.   if Kind = SText then
  440.     WriteLn(OutF, '));')
  441.   else
  442.     WriteLn(OutF, ', $', Hex2(Byte(Attrib)), '));');
  443.   DoOpEvent(P, VarName^);
  444.   WriteLn(OutF, 'Insert(', VarName^, ');');
  445.   end;
  446. end;
  447.  
  448. procedure WriteLabel(P : PScriptRec);
  449. begin
  450. with P^, MainBlock do
  451.   begin
  452.   Write(OutF, '  ');
  453.   RDotAssign(P);
  454.   WriteLn(OutF, '  Insert(New('+Obj^+', Init(R, '+
  455.           Quoted(LabelText^)+', ', LinkName^, ')));' );
  456.   end;
  457. end;
  458.  
  459. procedure FormDialog;
  460.  
  461.   procedure DoControls(P : PScriptRec); far;
  462.   begin
  463.   case P^.Kind of
  464.     Button: WriteButton(P);
  465.     InputL: WriteInputLine(P);
  466.     Labl: WriteLabel(P);
  467.     Histry: WriteHistory(P);
  468.     ILong: WriteInputLong(P);
  469.     CheckB, RadioB, MultiCB:
  470.            WriteCheckRadio(P);
  471.     ListB: WriteListBox(P);
  472.     ScrollB: WriteScrollBar(P);
  473.     Memo:  WriteMemo(P);
  474.     CText, SText: WriteStaticText(P);
  475.     end;
  476.   WriteLn(OutF);
  477.   end;
  478.  
  479. begin
  480. with Dialog^, MainBlock do
  481.   begin
  482.   RDotAssign(Dialog);
  483.   WriteLn(Outf, 'inherited Init(R, ', Quoted(Title^), ');');
  484.  
  485.   if DefOptns <> Optns then
  486.     begin
  487.     Write(Outf, 'Options := ');
  488.     S := OptionStr(Optns, DefOptns, GetOptionWords);
  489.     if S[1] = '$' then
  490.       WriteLn(OutF, S)
  491.     else WriteLn(OutF, 'Options', S);
  492.     end;
  493.   if DefEvMsk <> EvMsk then
  494.     begin
  495.     Write(Outf, 'EventMask := ');
  496.     S := OptionStr(EvMsk, DefEvMsk, GetEventWords);
  497.     if S[1] = '$' then
  498.       WriteLn(OutF, S)
  499.     else WriteLn(OutF, 'EventMask', S);
  500.     end;
  501.  
  502.   WriteHelpCtx(Nil, HelpCtxSym^, HCtx);
  503.   if Palette <> dpGrayDialog then
  504.     begin
  505.     if Palette = dpBlueDialog then S := 'dpBlueDialog'
  506.       else S := 'dpCyanDialog';
  507.     WriteLn(Outf, 'Palette := ', S, ';');
  508.     end;
  509.  
  510.   if WinFlags <> 5 then
  511.     WriteLn(Outf, 'Flags := Flags',
  512.                   OptionStr(WinFlags, 5, GetWinFlagWords));
  513.   WriteLn(OutF);
  514.  
  515.   ScriptColl^.ForEach(@DoControls);
  516.   end;
  517. end;
  518.  
  519. procedure DoTheVars;
  520. var
  521.   DidSomething : boolean;
  522.  
  523.   procedure DoVars(P : PScriptRec); far;
  524.   var
  525.     Control1 : boolean;
  526.   begin
  527.   with P^, MainBlock do
  528.     begin
  529.     Control1 := SameString(VarName^, 'Control1');
  530.     NeedControl1 := NeedControl1 or Control1;  {see if Control1 var will be needed}
  531.     if (VarName^ <> '') and not SameString(VarName^, 'Control')
  532.         and not Control1 then
  533.       begin
  534.       WriteLn(OutF, '    ', VarName^, ' : ', Obj^, ';');
  535.       DidSomething := True;
  536.       end;
  537.     end;
  538.   end;
  539. begin
  540. DidSomething := False;
  541. ScriptColl^.ForEach(@DoVars);
  542. if DidSomething then WriteLn(OutF);  {extra line}
  543. end;
  544.  
  545. procedure SubViewPtr(Load : boolean);
  546.  
  547.   procedure DoVars(P : PScriptRec); far;
  548.   begin
  549.   with P^, MainBlock do
  550.     if (VarName^ <> '') and not SameString(VarName^, 'Control')
  551.             and not SameString(VarName^, 'Control1') then
  552.         begin
  553.         if Load then Write(OutF, 'GetSubViewPtr(S, ')
  554.         else Write(OutF, 'PutSubViewPtr(S, ');
  555.         WriteLn(OutF, VarName^, ');');
  556.         end;
  557.   end;
  558. begin
  559. ScriptColl^.ForEach(@DoVars);
  560. end;
  561.  
  562. procedure DoDataRecord;
  563. var
  564.   First : boolean;
  565.  
  566.   procedure DoFields(P : PScriptRec); far;
  567.   var
  568.     S : string[15];
  569.   begin
  570.   with P^, MainBlock do
  571.     if FieldName^ <> '' then
  572.       begin
  573.       if First then  {at least one fieldname to output}
  574.         begin
  575.         WriteLn(OutF, '  ', Dialog^.MainBlock.FieldName^, ' = record');
  576.         First := False;
  577.         end;
  578.       Write(OutF, '    ', FieldName^);
  579.       case Kind of
  580.         CheckB, RadioB :
  581.            Write(OutF, ' : Word;');
  582.         MultiCB, ILong :
  583.            Write(OutF, ' : LongInt;');
  584.         InputL :
  585.           begin
  586.           if (ValKind = Range) and (Transfer <> 0) then
  587.              Write(OutF, ' : LongInt;')
  588.           else
  589.             begin
  590.             Str(StringLeng, S);
  591.             Write(OutF, ' : String['+S+'];');
  592.             end;
  593.           end;
  594.         ListB :
  595.           Write(OutF, ' : TListBoxRec;');
  596.         Memo :
  597.           begin
  598.           WriteLn(OutF, ' : Word;');
  599.           Str(BufSize, S);
  600.           Write(OutF, '    ', TextFieldName^, ' : Array[1..'+S+'] of Char;');
  601.           end;
  602.         end;
  603.       WriteLn(OutF);
  604.       end;
  605.   end;
  606.  
  607. begin
  608. with Dialog^, MainBlock do
  609.   if FieldName^ <> '' then
  610.     begin
  611.     if Present[ListB] then  {make sure TListBoxRec is defined}
  612.       WriteLn(OutF,
  613.       '  TListBoxRec = record    {<-- omit if TListBoxRec is defined elsewhere}'^M^J+
  614.       '    List: PCollection;'^M^J+
  615.       '    Selection: Word;'^M^J+
  616.       '  end;'^M^J);
  617.  
  618.     First := True;
  619.     ScriptColl^.ForEach(@DoFields);
  620.     if not First then    {if First still set, there is no data record}
  621.       begin
  622.       WriteLn(OutF, '    end;');
  623.       WriteLn(OutF, '  P'+FieldName^, ' = ^', FieldName^, ';');
  624.       end;
  625.     end;
  626. end;
  627.  
  628. function FindSkelDat: string;
  629. {look for 'skel.dat' in the directory where this file was found}
  630. var
  631.   EXEName, Dir : PathStr;
  632.   Ext : ExtStr;
  633.   Name : NameStr;
  634. begin
  635. if Lo(DosVersion) >= 3 then EXEName := ParamStr(0)
  636. else EXEName := FSearch('PASSRC2.EXE', GetEnv('PATH'));
  637. FSplit(EXEName, Dir, Name, Ext);
  638. if Dir[Length(Dir)] = '\' then Dec(Dir[0]);
  639. FindSkelDat := FSearch('SKEL.DAT', Dir);
  640. end;
  641.  
  642. function HeapFunc(Size : word) : integer; far;
  643. begin
  644. if Size > 0 then
  645.   begin
  646.   WriteLn('Out of memory');
  647.   Halt(1);
  648.   end;
  649. end;
  650.  
  651. var
  652.   I : Integer;
  653.   Inf : Text;
  654.  
  655. begin
  656. HeapError := @HeapFunc;
  657.  
  658. if ParamCount < 2 then
  659.   begin
  660.   WriteLn('Usage:  passrc2 <script filename> <source filename> [error filename]');
  661.   Halt(1);
  662.   end;
  663. if ParamCount >= 3 then
  664.   begin
  665.   Assign(OutPut, ParamStr(3));   {the error file}
  666.   ReWrite(Output);
  667.   end;
  668. {$I-}
  669. Assign(Inf, FindSkelDat);    {find the data file, skel.dat}
  670. Reset(Inf);
  671. ChkIOError('skel.dat');
  672.  
  673. ReadScriptFile( DefaultExt (ParamStr(1), '.SCP'));  {ParamStr(1) is script file}
  674.  
  675. Assign(OutF, DefaultExt (ParamStr(2), '.PAS'));    {ParamStr(2) is output source file}
  676. Rewrite(OutF);
  677. ChkIOError(DefaultExt (ParamStr(2), '.PAS'));
  678. {$I+}
  679.  
  680. while not Eof(Inf) do
  681.   begin
  682.   ReadLn(Inf, S);
  683.   if S = '@ZZ0' then FormDialog
  684.   else if S = '@ZZ1' then DoTheVars
  685.   else if S = '@ZZ2' then DoDataRecord
  686.   else if S = '@ZZ3' then SubViewPtr(True)
  687.   else if S = '@ZZ4' then SubViewPtr(False)
  688.   else
  689.     begin
  690.     I := Pos('@XX', S);
  691.     while I > 0 do
  692.       begin
  693.       Subst(I);
  694.       I := Pos('@XX', S);
  695.       end;
  696.     WriteLn(OutF, S)
  697.     end;
  698.   end;
  699. Close(InF);
  700. Close(OutF);
  701. end.
  702.  
  703.