home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG043.ARC / LABMAK.IN1 < prev    next >
Text File  |  1979-12-31  |  18KB  |  553 lines
  1. Procedure Start;
  2.  
  3. Var i:integer;
  4.     j:integer;
  5.  
  6. Begin
  7.      For i:=1 to Maxlines do For j:=1 to MaxCharComp do Text[i,j]:=Space;
  8.      For i:=1 to MaxLines do
  9.          Begin
  10.               LineInit[i,1]:=Null;
  11.               LineInit[i,2]:=Null;
  12.               Italic[i]:=False;
  13.               Under[i]:=False;
  14.               MaxChars[i]:=0;
  15.          End;
  16. End;
  17.  
  18. Procedure RemovePrev;
  19. Var i,
  20.     j :integer;
  21. Begin
  22.      For i:=5 to 11 do
  23.          Begin
  24.               Gotoxy(10,i);
  25.               For j:=1 to 68 do Write (Space);
  26.          End
  27. End;
  28.  
  29. procedure EnterCharSize;
  30.  
  31. Var SizeNum : char;
  32. Begin
  33.      RemovePrev;
  34.      gotoxy(10,5);
  35.      write ('Enter character size for line number ',LineNumber);
  36.      Gotoxy(10,8);
  37.      Write('Select option, <RETURN> for normal, or <ESC> to exit ');
  38.      Gotoxy(50,5);
  39.      Write ('1) Normal');
  40.      gotoxy(50,6);
  41.      Write ('2) Enlarged');
  42.      gotoxy(50,7);
  43.      Write ('3) Condensed');
  44.      repeat
  45.            Read(kbd,SizeNum);
  46.            SizeNum:=UpCase(SizeNum);
  47.      until (SizeNum in ['1','2','3','N','E','C']) or (SizeNum=CR) or (SizeNum=Esc);
  48.      If SizeNum=Esc then
  49.         Begin
  50.              Aborted:=True;
  51.              Exit;
  52.         End;
  53.      if SizeNum=cr then SizeNum:='1';
  54.      case SizeNum of
  55.           '1','N':Begin
  56.                  LineInit[LineNumber,1]:=Null;{No action taken}
  57.                      Gotoxy(65,LineNumber+16);
  58.                  Write('Norm');
  59.                  MaxChars[LineNumber]:=MaxCharNorm
  60.             End;
  61.           '2','E':Begin
  62.                  LineInit[LineNumber,1]:=Enlgd;
  63.                  MaxChars[LineNumber]:=MaxCharEnlgd;
  64.                  Gotoxy(65,LineNumber+16);
  65.                  Write ('Enlg')
  66.               End;
  67.           '3','C':Begin
  68.                  LineInit[LineNumber,1]:=Comp;
  69.                  MaxChars[LineNumber]:=MaxCharComp;
  70.                  Gotoxy(65,LineNumber+16);
  71.                  Write('Comp')
  72.               End
  73.      end {case};
  74.      For i:=MaxChars[LineNumber] to MaxCharComp do Text[LineNumber,i]:=Space;
  75. End;
  76.  
  77. Procedure EnterCharStyle;
  78. Var StyleNum: Char;
  79. Begin
  80.      RemovePrev;
  81.      Gotoxy(10,5);
  82.      Write('Enter print style for line number ',LineNumber);
  83.      Gotoxy(10,8);
  84.      Write('Select option, or <RETURN> for normal');
  85.      Gotoxy(50,5);
  86.      Write ('1) Normal');
  87.      gotoxy(50,6);
  88.      Write('2) Bold');
  89.      if (LineInit[LineNumber,1]<>Comp) then
  90.         Begin
  91.              gotoxy(50,7);
  92.              Write('3) Emphasized')
  93.         End;
  94.      Repeat
  95.            Read(kbd,StyleNum)
  96.      Until ((StyleNum in ['1','2']) or ((LineInit[LineNumber,1]<>Comp)and (StyleNum='3'))or (ord(StyleNum)=13));
  97.      if ord(StyleNum)=13 then StyleNum:='1';
  98.      Case StyleNum of
  99.           '1': Begin
  100.                     LineInit[LineNumber,2]:=Null;
  101.                     Gotoxy(70,LineNumber+16);
  102.                     Write('    ')
  103.                     End;
  104.           '2': Begin
  105.                     LineInit[LineNumber,2]:=Bold;
  106.                     Gotoxy(70,LineNumber+16);
  107.                     Write('Bold')
  108.                End;
  109.           '3': Begin
  110.                     LineInit[LineNumber,2]:=Emph;
  111.                     Gotoxy(70,LineNumber+16);
  112.                     Write('Emph')
  113.                End;
  114.      End {Case}
  115. End;
  116.  
  117. Procedure EnterSpecFeat;
  118.  
  119. Var SpecNum:Char;
  120.  
  121. Begin
  122.      Italic[LineNumber]:=False;
  123.      Under[LineNumber]:=False;
  124.      RemovePrev;
  125.      SpecNum:=' ';
  126.      gotoxy(10,5);
  127.      Write('Enter special printing feature');
  128.      gotoxy(10,8);
  129.      Write('Select either, both or <RETURN> for none');
  130.      gotoxy(50,5);
  131.      Write('1) Italics');
  132.      gotoxy(50,6);
  133.      Write('2) Underline');
  134.  While Ord(SpecNum)<>13 do
  135.      Begin
  136.         Repeat
  137.            Read(Kbd,SpecNum);
  138.         Until ((SpecNum in ['1','2','i','I','U','u']) or (ord(SpecNum)=13));
  139.         Case SpecNum of
  140.             '1','I','i':Begin
  141.                    Italic[LineNumber]:=Not(Italic[LineNumber]);
  142.                    Gotoxy(50,5);
  143.                    If Italic[LineNumber] then
  144.                       LowVideo;
  145.                    Write('1) Italics');
  146.                    NormVideo;
  147.                 End; {1}
  148.              '2','U','u':Begin
  149.                    Under[LineNumber]:=Not(Under[LineNumber]);
  150.                    Gotoxy(50,6);
  151.                    If Under[LineNumber] then
  152.                       LowVideo;
  153.                    Write('2) Underline');
  154.                    NormVideo;
  155.                 End {1}
  156.          End; {Case}
  157.     End; {While}
  158. if (Italic[LineNumber]) then
  159.    Begin
  160.         Gotoxy(75,LineNumber+16);
  161.         Write('I')
  162.    End; {if}
  163. If (Under[LineNumber]) then
  164.    Begin
  165.         Gotoxy(77,LineNumber+16);
  166.         Write('U')
  167.    End {if}
  168. End {Procedure};
  169.  
  170. Procedure RightJust (NumChars:Integer);
  171.  
  172. Var i:Integer;
  173. Begin
  174.      NumChars:=NumChars-1;
  175.      gotoxy(5,LineNumber+16);
  176.      for i:=1 to MaxChars[LineNumber] do Write(Space);
  177.      For i:= NumChars Downto 1 do Text[LineNumber,MaxChars[LineNumber]-NumChars+i]:= Text[LineNumber,i];
  178.      For i:= MaxChars[LineNumber]-NumChars downto 1 do Text[LineNumber,i]:=space;
  179.       Gotoxy(5,LineNumber+16);
  180.       For i:= 1 to MaxChars[LineNumber] do Write(Text[LineNumber,i]);
  181. End;
  182.  
  183. Procedure LeftJust;
  184. Var i,
  185.     Last : integer;
  186. Begin
  187.      Last:=0;
  188.      For i:=1 to MaxChars[LineNumber] do If Text[LineNumber,i]<>Space then Last:=i;
  189.      If Last<>0 then
  190.        While (Text[LineNumber,1]=Space) do
  191.            Begin
  192.                 For i:=2 to MaxChars[LineNumber] do Text[LineNumber,i-1]:=Text[LineNumber,i];
  193.                 Text[LineNumber,MaxChars[LineNumber]]:=Space;
  194.                 gotoxy(5,LineNumber+16);
  195.                 For i:=1 to MaxChars[LineNumber] do Write (Text[LineNumber,i]);
  196.                 Gob;
  197.                 Delay(50);
  198.            End;
  199. End;
  200.  
  201.  
  202. Procedure Centre;
  203.  
  204. Var i,
  205.     j,
  206.     Last :Integer;
  207. Begin
  208.      j:=0;
  209.      While (j<=MaxChars[LineNumber]) and (Text[LineNumber,1]=Space) do
  210.            Begin
  211.                 For i:=2 to MaxChars[LineNumber] do Text[LineNumber,i-1]:=Text[LineNumber,i];
  212.                 Text[LineNumber,MaxChars[LineNumber]]:=Space;
  213.                 j:=Succ(j);
  214.            End;
  215.      Last:=0;
  216.      For i:=1 to MaxChars[LineNumber] do If Text[LineNumber,i]<>Space then Last:=i;
  217.      If Last<>0 then
  218.        For i:=1 to (MaxChars[LineNumber] div 2)-(Last div 2) do
  219.          Begin
  220.               For j:=MaxChars[LineNumber] downto 2 do Text[LineNumber,j]:=Text[LineNumber,j-1];
  221.               Text[LineNumber,1]:=Space;
  222.               Gob;
  223.               gotoxy(5,LineNumber+16);
  224.               For j:= 1 to MaxChars[LineNumber] do Write(Text[LineNumber,j]);
  225.          End;
  226. End;
  227.  
  228. Procedure EnterText(Editing : Boolean);
  229. Type WorkString = String[255];
  230.  
  231. Const
  232.      Inon : String[2]=#27#41;
  233.      InOff : String[2]=#27#40;
  234.  
  235. Var CharNum:Integer {Pointer for entered character};
  236.     TempChar:Char;
  237.     EndChar : Integer;
  238.     I,
  239.     Last    : Integer;
  240.  
  241. Function EditString (StringOp     : WorkString ;
  242.                      MaxChars,x,y : integer) : WorkString;
  243.  
  244. Var
  245.    LetterFound,
  246.    SpaceFound,
  247.    Next,
  248.    Completed        : Boolean;
  249.    i,
  250.    CharNum          : Integer;
  251.    Chr              : Char;
  252.  
  253.  
  254. Begin
  255.   Abort := False;
  256.   Next:=False;
  257.   CharNum:=Length(StringOp)+1;
  258.   {If Length(StringOp)=MaxChars then CharNum:=Pred(CharNum);}
  259.   For i:=Length(StringOp)+1 to MaxChars do StringOp[i]:=Space;
  260.   StringOp[0]:=Char(MaxChars);
  261.   Repeat
  262.      Gotoxy(x,y);
  263.      For i:=1 to MaxChars do Write (StringOp[i]);
  264.      Gotoxy(x+CharNum-1,y);
  265.      Repeat
  266.            Read (Kbd,Chr);
  267.      Until (Chr in [' '..'~',^E,^X,^A,^S,^D,^F,^G,^T,^Y,BS,Del,cr,Esc]);
  268.      If Chr = ^E then Chr := Esc;
  269.      If Chr = ^X then Chr := CR;
  270.      Case Chr of
  271.                Esc : Abort:=True;
  272.           ' '..'~' : Begin
  273.                           If (StringOp[MaxChars]<>Space) or (CharNum>MaxChars) then
  274.                              Begin
  275.                                   Write (^G);
  276.                              End
  277.                           Else
  278.                               Begin
  279.                                    Insert (Chr,StringOp,CharNum);
  280.                                    CharNum:=Succ(CharNum);
  281.                               End;
  282.                       End;
  283.           ^A        : Begin
  284.                            i:=CharNum;
  285.                            LetterFound:=False;
  286.                            SpaceFound:=False;
  287.                            Completed:=False;
  288.                            Repeat
  289.                                  I:=i-1;
  290.                                  If (StringOp[i] in ['!'..'~']) then LetterFound:=True;
  291.                                  If (LetterFound and (StringOp[i]=Space)) or (i=0) then
  292.                                     Begin
  293.                                          CharNum:=i+1;
  294.                                          Completed:=True;
  295.                                     End;
  296.                            Until Completed;
  297.                        End;
  298.           ^S         : If CharNum<>1 then CharNum:=Pred(CharNum);
  299.           ^D         : If CharNum<>MaxChars then CharNum:=Succ(CharNum);
  300.           ^F         : If CharNum<>MaxChars then
  301.                          Begin
  302.                            i:=CharNum;
  303.                            SpaceFound:=False;
  304.                            Completed:=False ;
  305.                            Repeat
  306.                                  I:=I+1;
  307.                                  If StringOp[i] =Space then SpaceFound:=True;
  308.                                  If (SpaceFound and (StringOp[i] in ['!'..'~'] )) or (i=MaxChars) then
  309.                                     Begin
  310.                                          CharNum:=i;
  311.                                          Completed:=True;
  312.                                     End;
  313.                            Until Completed;
  314.                        End;
  315.           BS         : Begin
  316.                             LetterFound:=False;
  317.                             For i:=CharNum to MaxChars do If StringOp[i] in ['!'..'~'] then LetterFound:=True;
  318.                             If LetterFound then
  319.                                Begin
  320.                                     If CharNum<>1 then CharNum:=Pred(CharNum);
  321.                                End
  322.                             Else
  323.                                 Begin
  324.                                      If CharNum<> 1 then
  325.                                         Begin
  326.                                              CharNum:=Pred(CharNum);
  327.                                              Delete(StringOp,CharNum,1);
  328.                                              StringOp[MaxChars]:=Space;
  329.                                              StringOp[0]:=Succ(StringOp[0]);
  330.                                         End;
  331.                                 End;
  332.                        End;
  333.           ^G         : Begin
  334.                            Delete(StringOp,CharNum,1);
  335.                            StringOp[MaxChars]:=Space;
  336.                            StringOp[0]:=Succ(StringOp[0]);
  337.                        End;
  338.           Del        : Begin
  339.                             If CharNum<> 1 then
  340.                                Begin
  341.                                     CharNum:=Pred(CharNum);
  342.                                     Delete(StringOp,CharNum,1);
  343.                                     StringOp[MaxChars]:=Space;
  344.                                     StringOp[0]:=Succ(StringOp[0]);
  345.                                End;
  346.                         End;
  347.           ^Y         : Begin
  348.                             CharNum:=1;
  349.                             For i:=1 to MaxChars do StringOp[i]:=Space;
  350.                             StringOp[0]:=Char(MaxChars);
  351.                        End;
  352.           ^T         : Begin
  353.                             While Stringop[CharNum] in ['!'..'~'] do
  354.                                   Begin
  355.                                        Delete(StringOp,CharNum,1);
  356.                                        Insert(Space,StringOP,MaxChars);
  357.                                   End;
  358.                             i:=CharNum;
  359.                             While (Stringop[CharNum]=Space) and (i<=MaxChars) do
  360.                                   Begin
  361.                                        Delete(Stringop,CharNum,1);
  362.                                        Insert(Space,StringOp,MaxChars);
  363.                                        i:=Succ(i);
  364.                                   End;
  365.                        End;
  366.           End;{Case}
  367.   Until (Chr=CR) or (Chr=Esc) ;
  368.   i:=MaxChars+1;
  369.   Repeat
  370.         i:=Pred(i);
  371.   Until (i=0) or (StringOp[i]<>Space);
  372.   StringOp[0]:=Char(i);
  373.   EditString:=StringOP;
  374. End;{Proc}
  375.  
  376. Begin
  377.      EndChar:=10+MaxChars[LineNumber];
  378.      RemovePrev;
  379.      gotoxy(10,5);
  380.      Write('Enter text for line number ',LineNumber);
  381.      gotoxy(10,8);
  382.      Write('Maximum of ',MaxChars[LineNumber],' characters');
  383.      Gotoxy(2,9);
  384.      Write ('  ',InOn,'^A',InOff,' Word left, ',inon,'^S',inoff,' Char left, ',inon,'^D',inoff,
  385.          ' Char right, ',inon,'^F',inoff,' Word right, ',inon,'^G',inoff,' Gobble char');
  386.      Gotoxy(2,10);
  387.      Write ('        ',inon,'^T',inoff,' Delete word, ',inon,'^Y',
  388.           inoff,' Delete entire text, ',inon,'Del',inoff,' Delete char left      ');
  389.      Gotoxy(EndChar,6);
  390.      Write('<');
  391.      Gotoxy(10,6);
  392.      Last:=0;
  393.      For i:=1 to MaxChars[LineNumber] do If Text[LIneNumber,i]<>Space then Last:=i;
  394.      If Last=0 then EditingString:=''
  395.      Else
  396.          Begin
  397.               For i:=1 to Last do EditingString[i]:=Text[LineNumber,i];
  398.               EditingString[0]:=Char(Last);
  399.          End;
  400.      EditingString:=EditString(EditingString,MaxChars[LineNumber],10,6);
  401.      For i:=1 to MaxChars[LineNumber] do
  402.          Begin
  403.               If i<=Length(EditingString) then Text[LineNumber,i]:=EditingString[i]
  404.               Else Text[LineNumber,i]:=Space;
  405.          End;
  406.      CharNum:=Succ(Length(EditingString));
  407.      Gotoxy(5,LineNumber+16);
  408.      for i:=1 to MaxChars[LineNumber] do
  409.          Write(Text[LineNumber,i]);
  410.      For i:=MaxChars[LineNumber] to MaxCharComp do Write (Space);
  411.      Gotoxy(5+MaxChars[LineNumber],LineNumber+16);
  412.      LowVideo;
  413.      Write('<');
  414.      NormVideo;
  415.      RemovePrev;
  416.      Gotoxy(2,9);
  417.      Write('        ');
  418.      Gotoxy(10,5);
  419.      Write ('Do you want this text to be');
  420.      Gotoxy(50,5);
  421.      Write ('1) Left Justified');
  422.      Gotoxy(50,6);
  423.      Write ('2) Right Justified');
  424.      Gotoxy(50,7);
  425.      Write ('3) Centered');
  426.      gotoxy(10,8);
  427.      Write('Select option or <RETURN> for Left Justified');
  428.      Repeat
  429.          Read(Kbd,TempChar);
  430.          TempChar:=UpCase(TempChar);
  431.      Until (TempChar in ['1','2','3','L','R','C',CR]) ;
  432.      Case TempChar of
  433.           '1','L':LeftJust;
  434.           '2','R':RightJust (CharNum);
  435.           '3','C':Centre ;
  436.      End
  437. End;
  438.  
  439. Procedure Edit;
  440.  
  441. Var Resp:Char;
  442. Begin
  443.      Aborted:=False;
  444.      RemovePrev;
  445.      Gotoxy(10,5);
  446.      Write('Which line do you wish to edit?');
  447.      Repeat
  448.            Read (Kbd,Resp);
  449.      Until Resp in ['1'..Char(48+MaxLines),Char(Esc)];
  450.      If Resp<>Char(Esc) then
  451.         Begin
  452.              LineNumber:=Ord(Resp)-48;
  453.              EnterCharSize;
  454.              If Not Aborted then
  455.                 Begin
  456.                      EnterCharStyle;
  457.                      EnterSpecFeat;
  458.                      EnterText(True);
  459.                 End
  460.         End; {if}
  461. End; {Proc}
  462.  
  463. Procedure Print;
  464.  
  465. Var i,
  466.     No,
  467.     P,
  468.     j:integer;
  469.  
  470. Begin
  471.      RemovePrev;
  472.      Gotoxy(10,5);
  473.      Write ('How many labels ( or <RETURN> for 1 ) :');
  474.      No := Entervalue;
  475.      If No = -2 then No := 1;
  476.      Gotoxy(10,6);
  477.      Write ('Printing label');
  478.    For p := 1 to No do
  479.     Begin
  480.      For i:=1 to MaxLines do
  481.          Begin
  482.               for j:=1 to 2 do
  483.                   Write (Lst,LineInit[i,j]);
  484.               if Italic[i] then
  485.                  Begin
  486.                       For j:=1 to MaxChars[i] do
  487.                       Begin
  488.                          if Under[i] then write(lst,Underline,#1);
  489.                          if (Under[i]) and (Text[i,j]=Space) then Write (Lst,Underline,#0);
  490.                          Write (Lst,Char(Ord(Text[i,j])+128));
  491.                       End;
  492.                       Writeln (lst);
  493.                       Write (Lst,LineReset);
  494.                  End
  495.               Else
  496.                  Begin
  497.                       For j:=1 to MaxChars[i] do
  498.                        Begin
  499.                            if Under[i] then write(lst,Underline,#1);
  500.                            if (Under[i]) and (Text[i,j]=Space) then Write (Lst,Underline,#0);
  501.                            write (Lst,Text[i,j]);
  502.                        End; {For}
  503.                       Writeln(lst);
  504.                       Write (Lst,LineReset);
  505.                  End
  506.         End;
  507.   Writeln(lst)
  508.  End;
  509. End;
  510.  
  511. Procedure CheckFinish;
  512. Var Ch : Char;
  513. Begin
  514.   Gotoxy( 50 , 10 );
  515.   Write ('Are you sure (Y/N) :');
  516.   Repeat
  517.     Read( Kbd,Ch );
  518.     Ch := UpCase( Ch );
  519.   Until Ch in ['Y' , 'N' ];
  520.   Ended := Ch = 'Y';
  521.   Gotoxy( 50 , 10);
  522.   Write ('                     ');
  523.  End;
  524.  
  525. Procedure Options;
  526.  
  527. Var Resp:Char;
  528.  
  529. Begin
  530.      RemovePrev;
  531.      gotoxy(10,5);
  532.      Write ('Do you wish to');
  533.      gotoxy(50,5);
  534.      Write ('1) Print label');
  535.      gotoxy(50,6);
  536.      Write('2) Start a new label');
  537.      gotoxy(50,7);
  538.      Write('3) Edit current label');
  539.      Gotoxy(50,8);
  540.      Write('4) Quit program');
  541.      Repeat
  542.              Read(Kbd,Resp);
  543.              Resp:=Upcase(Resp);
  544.         Until (Resp in ['1','P','2','S','3','E','4','Q']);
  545.      Case Resp of
  546.           '1','P': Print;
  547.           '2','S': Again:=True;
  548.           '3','E': Edit;
  549.           '4','Q': CheckFinish;
  550.      End
  551. End;
  552.  
  553.