Program Card_Maker;

Const
    {$I Gemconst.Pas}

Type
    Col1 = Array [1..128] Of String[80];
    Col2 = Array [1..128] Of String[80];
    Col3 = Array [1..128] Of String[80];
    Col4 = Array [1..128] Of String[80];
    Col5 = Array [1..128] Of String[80];
    OUT  = Array [1..5] of Boolean;
    {$I Gemtype.Pas}

Var Run,MF,LI,Ci,RS,
    MRF         :Boolean;
    Command,
    Title       :String[80];
    H,TH,
    CNum,
    Cl1,Cl2,Cl3,
    Cl4,Cl5,
    Dummy,TST,
    IST         :Integer;
    Sauto,Ce    :Char;
    Data1       :Col1;
    Data2       :Col2;
    Data3       :Col3;
    Data4       :Col4;
    Data5       :Col5;
    t           :1..5;
    C1,C2,C3,
    C4,C5       :1..100;
    Flag        :out;
    s           :1..200;
    cf          :Integer;
    XStyle      :Char;
    Style       :Char;
    name        :String[80];
    Fv          :File of text;

{$I Gemsubs.Pas}
{$I Screen.Pas}

Procedure GRInit;

Begin
   s:=8;
   TST:=$00;
   IST:=$00;
   Mf:=False;
   LI:=False;
   Ci:=False;
   cf:=2;
   Mrf:=false;
End;

Procedure TClean;

Begin
   NormVideo;
   Gotoxy(24,1);
Write('                                                                     ');
Write('           ');
End;

Procedure Clean;

Begin
   InverseVideo;
   Gotoxy(24,1);
Write('                                                                     ');
Write('       ');
End;

Procedure Get_Command;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,5);
Write('                                                                     ');
Write('       ');
   Gotoxy(24,25);
   Write('Text ',Xstyle);
   Write(' - Title ',style);
   If (Mf<>false) or (Mrf<>false) Then Write(' Frame');
   If (LI<>false) Then Write(' Line');
   If (Flag[1]=true) Then write(' 1');
   If (Flag[2]=true) Then write(' 2');
   If (Flag[3]=true) Then write(' 3');
   If (Flag[4]=true) Then write(' 4');
   If (Flag[5]=true) Then write(' 5');
   Write(' Tl=',H);
   Write(' Tx=',th);
   Write(' V 1.1');
   Gotoxy(24,1);
   Write('Command>');
   CursOn;
   Readln(Command);
   InverseVideo;
End;

Procedure text_Height ( height : integer );

Type Ctrl_Parms         = Array [ 0..11 ] of integer;
     Int_in_Parms       = Array [ 0..15 ] of integer;
     Int_Out_Parms      = Array [ 0..45 ] of integer;
     Pts_in_Parms       = Array [ 0..11 ] of integer;
     Pts_Out_Parms      = Array [ 0..11 ] of integer;

Var
   Control      :Ctrl_Parms;
   int_in       :Int_in_Parms;
   int_out      :Int_out_parms;
   pts_in       :Pts_in_Parms;
   pts_out      :Pts_Out_Parms;

Procedure VDI_Call( cmd, sub_cmd, nints, npts : Integer;
    Var ctrl:ctrl_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;

Begin
   pts_in[0]:= 0;
   pts_in[1]:= height;
   VDI_Call( 12,0,0,2, control, int_in, int_out, pts_in, pts_out, false );
End;

Procedure Set_Title;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Enter size of title in pixels :');
   InverseVideo;
   Readln(H);
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Enter title :');
   InverseVideo;
   Readln(title);
End;

Procedure Set_Colomns;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('How many colomns will you have? ( Max = 5 ) :');
   InverseVideo;
   Readln(CNum);
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Automatic setting (y/n) ? :');
   InverseVideo;
   Readln(SAuto);
   If (SAuto='n') Or (Sauto='N') Then
      Begin
         Clean;
         InverseVideo;
         Gotoxy(24,1);
         Write('Enter colomn length #1 :');
         InverseVideo;
         Readln(CL1);
         Clean;
         InverseVideo;
         Gotoxy(24,1);
         Write('Enter colomn length #2 :');
         InverseVideo;
         Readln(CL2);
         Clean;
         InverseVideo;
         Gotoxy(24,1);
         Write('Enter colomn length #3 :');
         InverseVideo;
         Readln(CL3);
         Clean;
         InverseVideo;
         Gotoxy(24,1);
         Write('Enter colomn length #4 :');
         InverseVideo;
         Readln(CL4);
         Clean;
         InverseVideo;
         Gotoxy(24,1);
         Write('Enter colomn length #5 :');
         InverseVideo;
         Readln(CL5);
      End
   Else
      Begin
         Cl1:=trunc((80/Cnum));
         Cl2:=trunc((80/Cnum));
         Cl3:=trunc((80/Cnum));
         Cl4:=trunc((80/Cnum));
         Cl5:=trunc((80/Cnum));
      End;
End;

Procedure Enter_Data;

Var which       :Integer;
    Sentence    :String[80];
    j,k         :1..129;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Start entering at colomn #');
   inverseVIdeo;
   readln(which);
   If (Which<1) then which:=1;
   If (Which>5) Then which:=5;
   Sentence:='????';
   Clean;
   If (flag[which]=true) And (which=1) Then
      begin
         Gotoxy(24,1);
         Write('Start at row number :');
         Readln(k);
         If (k>C1) or (k>128) or (k<1) Then k:=C1;
      End;
   If (flag[which]=true) And (which=2) Then
      begin
         Gotoxy(24,1);
         Write('Start at row number :');
         Readln(k);
         If (k>C2) or (k>128) or (k<1) Then k:=C2;
      End;
   If (flag[which]=true) And (which=3) Then
      begin
         Gotoxy(24,1);
         Write('Start at row number :');
         Readln(k);
         If (k>C3) or (k>128) or (k<1) Then k:=C3;
      End;
   If (flag[which]=true) And (which=4) Then
      begin
         Gotoxy(24,1);
         Write('Start at row number :');
         Readln(k);
         If (k>c4) or (k>128) or (k<1) Then k:=C4;
      End;
   If (flag[which]=true) And (which=5) Then
      begin
         Gotoxy(24,1);
         Write('Start at row number :');
         Readln(k);
         If (k>c5) or (k>128) or (k<1) Then k:=C5;
      End;
   If (flag[which]=false) Then k:=1;
   j:=k;
   Flag[which]:=true;
   Repeat
      Clean;
      InverseVideo;
      If which=1 Then
         Begin
            Gotoxy(24,(4+CL1));
            Writeln('<');
         End;
      If which=2 Then
         Begin
            Gotoxy(24,(4+CL2));
            Writeln('<');
         End;
      If which=3 Then
         Begin
            Gotoxy(24,(4+CL3));
            Writeln('<');
         End;
      If which=4 Then
         Begin
            Gotoxy(24,(4+CL4));
            Writeln('<');
         End;
      If which=5 Then
         Begin
            Gotoxy(24,(4+CL5));
            Writeln('<');
         End;
      Gotoxy(24,1);
      Write('#',j,' >');
      InverseVideo;
      Readln(sentence);
      If (which = 1) and (Length(sentence)>Cl1) then
         Begin
            Clean;
            InverseVideo;
            Gotoxy(24,1);
            Write('#',j,' >');
            InverseVideo;
            Readln(sentence);
         End;
      if (which = 2) and (Length(sentence)>Cl2) then
         Begin
            Clean;
            InverseVideo;
            Gotoxy(24,1);
            Write('#',j,' >');
            InverseVideo;
            Readln(sentence);
         End;
      if (which = 3) and (Length(sentence)>Cl3) then
         Begin
            Clean;
            InverseVideo;
            Gotoxy(24,1);
            Write('#',j,' >');
            InverseVideo;
            Readln(sentence);
         End;
      if (which = 4) and (Length(sentence)>Cl4) then
         Begin
            Clean;
            InverseVideo;
            Gotoxy(24,1);
            Write('#',j,' >');
            InverseVideo;
            Readln(sentence);
         End;
      if (which = 5) and (Length(sentence)>Cl5) then
         Begin
            Clean;
            InverseVideo;
            Gotoxy(24,1);
            Write('#',j,' >');
            InverseVideo;
            Readln(sentence);
         End;
      j:=j+1;
      If j>128 Then j:=128;
      If (sentence<>'Stop') then
      begin
      if (which=1) Then Data1[j]:=sentence;
      if (which=2) Then Data2[j]:=sentence;
      if (which=3) Then Data3[j]:=sentence;
      if (which=4) Then Data4[j]:=sentence;
      if (which=5) Then Data5[j]:=sentence;
      end;
   Until sentence='Stop';
      if (which=1) Then C1:=j;
      if (which=2) Then C2:=j;
      if (which=3) Then C3:=j;
      if (which=4) Then C4:=j;
      if (which=5) Then C5:=j;
End;

Procedure Set_Text;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Enter text size :');
   InverseVideo;
   Readln(TH);
End;

Procedure Set_S;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Enter spacing ( in pixels, max = 200) :');
   InverseVideo;
   Readln(s);
   While (S>200) or (S<1) Do
      Begin
         Clean;
         InverseVideo;
         Gotoxy(24,1);
         Write('Enter spacing ( in pixels, max = 200) :');
         InverseVideo;
         Readln(s);
      End;
End;

Procedure Set_Center;

begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Centering title (y/n) ? :');
   InverseVideo;
   Readln(ce);
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Centering factor :');
   InverseVideo;
   Readln(cf);
End;

Procedure TxStyle;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Text style:');
   InverseVideo;
   Readln(XStyle);
   If (xStyle='a') Or (xStyle='A') Then TST:=$00;
   If (xStyle='b') Or (xStyle='B') Then TST:=$01;
   If (xStyle='c') Or (xStyle='C') Then TST:=$02;
   If (xStyle='d') Or (xStyle='D') Then TST:=$04;
   If (xStyle='e') Or (xStyle='E') Then TST:=$08;
   If (xStyle='f') Or (xStyle='F') Then TST:=$10;
   If (xStyle='g') Or (xStyle='G') Then TST:=$20;
End;

Procedure TiStyle;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Title style:');
   InverseVideo;
   Readln(Style);
   If (Style='a') Or (Style='A') Then IST:=$00;
   If (Style='b') Or (Style='B') Then IST:=$01;
   If (Style='c') Or (Style='C') Then IST:=$02;
   If (Style='d') Or (Style='D') Then IST:=$04;
   If (Style='e') Or (Style='E') Then IST:=$08;
   If (Style='f') Or (Style='F') Then IST:=$10;
   If (Style='g') Or (Style='G') Then IST:=$20;
End;

Procedure RFormat;

Var which       :1..5;
    l           :1..128;

Begin
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Refromat colomn #');
   Readln(which);
   If which>5 Then which:=5;
   If which<1 Then which:=1;
   Clean;
   InverseVideo;
   Gotoxy(24,1);
   Write('Reformating Colomn #',which);
   InverseVideo;
   If which=1 Then
      For l:=1 to C1 Do
          If (Length(Data1[l]))>Cl1 Then
             Delete(Data1[l],cl1,(Length(Data1[l])-cl1));
   If which=2 Then
      For l:=1 to C2 Do
          If (Length(Data2[l]))>Cl2 Then
             Delete(Data2[l],cl2,(Length(Data2[l])-cl2));
   If which=3 Then
      For l:=1 to C3 Do
          If (Length(Data3[l]))>Cl3 Then
             Delete(Data3[l],cl3,(Length(Data3[l])-cl3));
   If which=4 Then
      For l:=1 to C4 Do
          If (Length(Data4[l]))>Cl4 Then
             Delete(Data4[l],cl4,(Length(Data4[l])-cl4));
   If which=5 Then
      For l:=1 to C5 Do
          If (Length(Data5[l]))>Cl5 Then
             Delete(Data5[l],cl5,(Length(Data5[l])-cl5));
End;

Procedure PPrint;

Var dum         :char;

Begin
   TClean;
   InverseVideo;
   Gotoxy(24,1);
   Write('If you want to print this paper, use the Alternate Help dump.');
   InverseVideo;
   CursOff;
   Readln(dum);
   TClean;
   readln(dum);
End;

Procedure Scale_Line;

Var yesno       :Char;

Begin
   Clean;
   Gotoxy(24,1);
   Write('Scale line (y/n) ? :');
   Readln(yesno);
   If (yesno='y') or (yesno='Y') Then rs:=true
   Else rs:=false;
End;

Procedure Proc;

Begin
   If (Command='QUIT') Or (Command='Quit') Or (Command='quit') Then
      Run:=false;
   If (Command='EXIT') Or (Command='Exit') Or (Command='exit') Then
      Run:=false;
   If (Command='BYE') Or (Command='Bye') Or (Command='bye') Then
      Run:=false;
   If (Command='TITLE') Or (Command='Title') Or (Command='title') Then
      Set_Title;
   If (Command='COLOMNS') Or (Command='Colomns') Or (Command='colomns') Then
      Set_Colomns;
   If (Command='ENTER') Or (Command='Enter') Or (Command='enter') Then
      Enter_Data;
   If (Command='TEXT') Or (Command='Text') Or (Command='text') Then
      Set_text;
   If (Command='SPACING') Or (Command='Spacing') Or (Command='spacing') Then
      Set_s;
   If (Command='CENTER') Or (Command='Center') Or (Command='center') Then
      Set_center;
   If (Command='TSTYLE') Or (Command='Tstyle') Or (Command='tstyle') Then
      TiStyle;
   If (Command='XSTYLE') Or (Command='Xstyle') Or (Command='xstyle') Then
      TxStyle;
   If (Command='FRAME') Or (Command='Frame') Or (Command='frame') Then
      MF:=True;
   If (Command='RFRAME') Or (Command='Rframe') Or (Command='rframe') Then
      MRF:=True;
   If (Command='TLINE') Or (Command='Tline') or (Command='tline') Then
      LI:=True;
   If (Command='CLINE') Or (Command='Cline') or (Command='cline') Then
      CI:=True;
   If (Command='GINIT') Or (Command='Ginit') or (Command='ginit') Then
      GRInit;
   If (Command='REFORMAT') Or (Command='Reformat') or (Command='reformat') Then
      RFormat;
   If (Command='PRINT') Or (Command='Print') or (Command='print') Then
      PPRint;
   If (Command='SLINE') Or (Command='Sline') or (Command='sline') Then
      Scale_Line;
End;

Procedure Out_Put;

Var i,j,k       :Integer;

Begin
   Clrscr;
   CursOff;
   If Mrf=true Then
      Frame_Round_Rect( 0,0,639,180 );
   If title<>'@' Then
      Begin
         text_Style(IST);
         text_Height(H);
         If Ce='n' Then
            Draw_String(5,((H)+3),title)
         Else
            Begin
               i:=(((Length(title))*(H div cf)));
               j:=(640-i) div 2;
               Draw_String(J,((H)+3),title)
            End;
         If (Li=true) and (rs=false) Then
            Line(5,(H+7),634,(H+7));
         if (li=true) and (rs=false) Then
            Line(5,(H+7),((Length(title))*8),(H+7));
      End;
   Text_Height(TH);
   Text_Style(TST);
   If flag[1]=true then
      For i:=1 to C1 Do
          Draw_String(5,((i*(th+s))+h+10),Data1[i]);
   If flag[2]=true then
      For i:=1 to C2 Do
          Draw_String((Cl1*8+th),((i*(th+s))+h+10),Data2[i]);
   If flag[3]=true then
      For i:=1 to C3 Do
          Draw_String(((Cl2+Cl1)*8+th),((i*(th+s))+h+10),Data3[i]);
   If flag[4]=true then
      For i:=1 to C4 Do
          Draw_String(((Cl3+cl1+cl2)*8+th),((i*(th+s))+h+10),Data4[i]);
   If flag[5]=true then
      For i:=1 to C5 Do
          Draw_String(((Cl3+Cl2+Cl1+Cl4)*8+th),((i*(th+s))+h+10),Data5[i]);
   If Mf=true Then
      Frame_Rect( 0,0,639,180 );
   if ci=true Then
      Begin
         If Flag[2]=true then
            Line((Cl1*8+(th div cf)-13),((2*H)+7),(Cl1*8+(th div cf)-13),(176));
         If Flag[3]=true then
Line(((Cl2+Cl1)*8+(th div cf)-13),((2*H)+7),(Cl2*8+(th div cf)-13),(176));
         If Flag[4]=true then
Line(((Cl2+Cl1+Cl3)*8+(th div cf)-13),((2*H)+7),(Cl3*8+(th div cf)-13),(176));
         If Flag[5]=true then
Line((640-(Cl4*8+(th div cf)-13)),((2*H)+7),(Cl4*8+(th div cf)-13),(176));
      End;
End;

Begin
 If init_gem>=0 Then
  Begin
   Rs:=false;
   Run:=true;
   Init_Mouse;
   Hide_Mouse;
   title:='@';
   Ce:='n';
   Clrscr;
   CursOn;
   H:=8;
   TH:=4;
   s:=8;
   TST:=$00;
   IST:=$00;
   Mf:=False;
   LI:=False;
   Ci:=False;
   cf:=2;
   Mrf:=false;
   Xstyle:='A';
   style:='A';
   For t:=1 to 5 Do
       Flag[t]:=false;
       Dummy:=
 Do_Alert('[1][The Card Maker V 1.1 | Programmed by Yaron Kidron][  OK  ]',0);
   While run=true Do
      Begin
         Get_Command;
         Proc;
         Out_Put;
      End;
  End;
 CursOff;
 Show_Mouse;
 Exit_Gem;
 NormVideo;
End.