home *** CD-ROM | disk | FTP | other *** search
/ Between Heaven & Hell 2 / BetweenHeavenHell.cdr / 500 / 496 / edmac.pas < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  38KB  |  1,001 lines

  1. { EdMac - MacPaint file compatible graphics editor }
  2. { Ver. 1.00   03/16/87   by S.D. Gorrell }
  3.  
  4. program EdMac (input, output);
  5.  
  6.   const Vseg0   = $B800;     { Video memory map segment for lines 0,2,4, etc. }
  7.         Vseg1   = $BA00;     { '                          ' lines 1,3,5, etc. }
  8.  
  9.         Pwide   = 71;      { McPaint picture width-1 in characters (576 bits) }
  10.         Plines  = 799;                         { Max number of loadable lines }
  11.         RO      = 8;                                      { Screen row offset }
  12.         CO      = 4;                                   { Screen column offset }
  13.         NR      = 200;                                { Number of screen rows }
  14.  
  15.   type  Picrec  = array [1..128] of CHAR;                { File record buffer }
  16.         Str     = string [255];                      { General purpose string }
  17.  
  18.   var   Plc     : INTEGER;                               { Picture line count }
  19.         Pic     : array [0..Plines, 0..Pwide] of CHAR;        { Picture array }
  20.  
  21.         Mrow,                                            { Magnify row origin }
  22.         Mcol    : INTEGER;                            { Magnify column origin }
  23.         Mag     : Array [0..47, 0..Pwide] of CHAR;            { Magnify array }
  24.  
  25.         Cursor,                                                   { Cursor on }
  26.         Fast,                                          { Fast cursor movement }
  27.         Pen,                                                       { Pen down }
  28.         Erasr,                                                 { Draw / erase }
  29.         Magnify : BOOLEAN;                                       { Magnify on }
  30.  
  31.         Mload   : BOOLEAN;                        { Magnify array loaded flag }
  32.  
  33.         CRT     : array [0..$3FFF] of CHAR absolute Vseg0:$0000; { Screen mem }
  34.  
  35.         Picfile,                                               { Picture file }
  36.         Newfile : file of Picrec;                       { Edited picture file }
  37.  
  38.   {---------------------------------------------------------------------------}
  39.  
  40.   function Next_byte (var Rec    : Picrec;         { Read next byte from file }
  41.                       var RP,
  42.                           Recno,
  43.                           Nrecs  : INTEGER) : CHAR;
  44.  
  45.     begin { Next_byte }
  46.  
  47.       if RP > 128 then                                  { Wrap to next record }
  48.         begin
  49.           Recno := Recno + 1;
  50.           RP := 1;
  51.           if Recno < Nrecs then
  52.             begin
  53.               seek (Picfile, Recno);
  54.               read (Picfile, Rec);
  55.               gotoXY (25,25);
  56.               write (Recno+1:3)
  57.             end
  58.         end;
  59.  
  60.       if Recno < Nrecs then
  61.         begin
  62.           Next_byte := Rec[RP];                            { Return next byte }
  63.           RP := RP + 1
  64.         end
  65.       else
  66.         Next_byte := #0                              { ...or null if past eof }
  67.  
  68.     end;  { Next_byte }
  69.  
  70.   {---------------------------------------------------------------------------}
  71.  
  72.   procedure Load_pic;                                { Load picture from file }
  73.  
  74.     var I,J,K  : INTEGER;
  75.         C      : CHAR;
  76.         S      : Str;
  77.  
  78.         RP,                                             { Record char pointer }
  79.         Recno,                                        { Current record number }
  80.         Nrecs  : INTEGER;                         { Number of records in file }
  81.  
  82.         Rec    : Picrec;                                   { Record from file }
  83.  
  84.     begin { Load_pic }
  85.  
  86.       assign (Picfile, paramstr(1));
  87.       reset (Picfile);
  88.       Nrecs := filesize(Picfile);
  89.  
  90.       read (Picfile, Rec);                                    { Header record }
  91.       I := ord(Rec[2]);
  92.       S := copy(Rec,3,I);                                             { Title }
  93.       gotoXY ((80-I) div 2, 1);
  94.       write (S);
  95.       gotoXY (1,25);
  96.       write ('Now processing record     0  of  ', Nrecs:4, '.');
  97.  
  98.       RP := 129;         { Init record char pointer to end of previous record }
  99.       Recno := 4;                              { Picture starts at byte $0280 }
  100.       Plc := 0;                                          { Picture line count }
  101.  
  102.       K := 0;
  103.  
  104.       repeat                                                 { Unpack picture }
  105.         C := Next_byte (Rec, RP, Recno, Nrecs);                  { Count byte }
  106.         I := ord (C);
  107.  
  108.         if I < 128 then                       { Unpack next (I+1) chars as is }
  109.           begin
  110.             for J := 0 to I do
  111.               if Plc <= Plines then
  112.                 begin
  113.                   C := Next_byte (Rec, RP, Recno, Nrecs);
  114.                   Pic[Plc, K] := chr(ord(C) xor 255);
  115.                   K := (K+1) mod (Pwide+1);
  116.                   if K = 0 then Plc := Plc + 1
  117.                 end
  118.             end
  119.         else                            { Repeat next char (2's comp I) times }
  120.           begin
  121.             C := Next_byte (Rec, RP, Recno, Nrecs);
  122.             for J := 0 to 256-I do
  123.               if Plc <= Plines then
  124.                 begin
  125.                   Pic[Plc, K] := chr(ord(C) xor 255);
  126.                   K := (K+1) mod (Pwide+1);
  127.                   if K = 0 then Plc := Plc + 1
  128.                 end
  129.           end
  130.       until (Recno >= Nrecs) or (Plc > Plines);
  131.  
  132.       close (Picfile);
  133.       gotoXY (1,25);
  134.       write (Plc:4, '  displayable lines loaded. <RET> ');
  135.       repeat until keypressed;
  136.       read (kbd, C);
  137.       gotoXY (1,25);
  138.       write (' ':33)
  139.  
  140.     end;  { Load_pic }
  141.  
  142.   {---------------------------------------------------------------------------}
  143.  
  144.   procedure Show_pic (Top : INTEGER);                       { Display picture }
  145.  
  146.     var I,J,K : INTEGER;
  147.  
  148.     begin { Show_pic }
  149.  
  150.       I := (RO div 2) * 80 + CO;                        { Screen array offset }
  151.       J := Top;                                                  { Array line }
  152.       K := (NR div 2) * 80 + CO;                              { End of screen }
  153.  
  154.       repeat
  155.         move (Pic[J, 0], CRT[I], Pwide+1);          { Write to even line page }
  156.         move (Pic[J+1, 0], CRT[I+$2000], Pwide+1);   { Write to odd line page }
  157.         I := I + 80;
  158.         J := J + 2
  159.       until (I = K) or (J = Plc)
  160.  
  161.     end;  { Show_pic }
  162.  
  163.   {---------------------------------------------------------------------------}
  164.  
  165.   procedure Load_mag (Top, Csr, Csc : INTEGER);          { Load magnify array }
  166.  
  167.     var I,J,K,R,C : INTEGER;
  168.         B         : BYTE;
  169.  
  170.     begin { Load_mag }
  171.  
  172.       Mrow := Csr - 24;                                      { Set row origin }
  173.       if Mrow < 0 then Mrow := 0
  174.         else if Mrow > 144 then Mrow := 144;
  175.  
  176.       Mcol := Csc - 9;                                    { Set column origin }
  177.       if Mcol < 0 then Mcol := 0
  178.         else if Mcol > 54 then Mcol := 54;
  179.  
  180.       C := 0;                                          { Array row and column }
  181.  
  182.       for I := 0 to 47 do                                          { 48 lines }
  183.         begin
  184.           for J := 0 to 17 do                                 { 18 characters }
  185.             begin
  186.               K := 128;                                              { 8 bits }
  187.               repeat
  188.                 B := 0;
  189.                 if (ord(Pic[Top+Mrow+I, Mcol+J]) and K) > 0  { Isolate hi bit }
  190.                   then B := $F0;
  191.                 K := K div 2;
  192.  
  193.                 if (ord(Pic[Top+Mrow+I, Mcol+J]) and K) > 0  { Isolate lo bit }
  194.                   then B := B or $0F;
  195.                 K := K div 2;
  196.  
  197.                 Mag[I,C] := chr(B);
  198.                 C := (C + 1) mod 72
  199.               until K = 0
  200.             end
  201.         end;
  202.  
  203.       Mload := TRUE                           { Set magnify array loaded flag }
  204.  
  205.     end;  { Load_mag }
  206.  
  207.   {---------------------------------------------------------------------------}
  208.  
  209.   procedure Show_mag;                             { Display magnified picture }
  210.  
  211.     var I,J   : INTEGER;
  212.  
  213.     begin { Show_mag }
  214.  
  215.       I := (RO div 2) * 80 + CO;                        { Screen array offset }
  216.  
  217.       for J := 0 to 47 do
  218.         begin
  219.           move (Mag[J, 0], CRT[I], Pwide+1);        { Write to even line page }
  220.           move (Mag[J, 0], CRT[I+$2000], Pwide+1);   { Write to odd line page }
  221.           I := I + 80;
  222.  
  223.           move (Mag[J, 0], CRT[I], Pwide+1);        { Write to even line page }
  224.           move (Mag[J, 0], CRT[I+$2000], Pwide+1);   { Write to odd line page }
  225.           I := I + 80
  226.         end
  227.  
  228.     end;  { Show_mag }
  229.  
  230.   {---------------------------------------------------------------------------}
  231.  
  232.   procedure Adjust_mag (var Csr, Csc, Csb : INTEGER);    { Adjust for magnify }
  233.  
  234.     var I : INTEGER;
  235.  
  236.     begin { Adjust_mag }
  237.  
  238.       Csr := (Csr-Mrow) * 4 + 2;                                 { Adjust row }
  239.       Csc := (Csc-Mcol) * 4;                                  { Adjust column }
  240.  
  241.       I := Csb;                                                 { Adjust byte }
  242.       Csb := 32;
  243.       if I < 128 then
  244.         repeat
  245.           Csb := Csb div 16;
  246.           if Csb = 0 then
  247.             begin
  248.               Csc := Csc + 1;
  249.               Csb := 32
  250.             end;
  251.           I := I * 2
  252.         until I = 128
  253.  
  254.     end;  { Adjust_mag }
  255.  
  256.   {---------------------------------------------------------------------------}
  257.  
  258.   procedure CRT_bit (Row, Col, Bit : INTEGER;             { Wiggle bit on CRT }
  259.                      Op            : CHAR);      { (S)et, (R)eset, (T)oggle   }
  260.  
  261.     var I,J : INTEGER;
  262.         B   : BYTE;
  263.  
  264.         MO  : INTEGER;                                        { Memory offset }
  265.  
  266.     begin { CRT_bit }
  267.  
  268.       if Magnify then                                    { Adjust for magnify }
  269.         begin
  270.           Adjust_mag (Row, Col, Bit);
  271.           if Bit < 16 then Bit := $0F else Bit := $F0;
  272.           Row := Row - 2;
  273.           I := 3
  274.         end
  275.       else I := 0;
  276.  
  277.       for J := 0 to I do
  278.         begin
  279.           MO := ((Row+RO+J) div 2) * 80 + Col + CO; { Calculate memory offset }
  280.           if (Row+RO+J) mod 2 = 0 then
  281.             B := Mem[Vseg0 : MO]                      { Get byte in even line }
  282.           else
  283.             B := Mem[Vseg1 : MO];                      { Get byte in odd line }
  284.  
  285.           case Op of
  286.             'S' : B := B and (Bit xor $FF);                { Set bit to black }
  287.             'R' : B := B or Bit;                         { Clear bit to white }
  288.             'T' : B := B xor Bit                                 { Toggle bit }
  289.           end; { case }
  290.  
  291.           if (Row+RO+J) mod 2 = 0 then
  292.             Mem[Vseg0 : MO] := B                      { Put byte in even line }
  293.           else
  294.             Mem[Vseg1 : MO] := B                       { Put byte in odd line }
  295.         end
  296.  
  297.     end;  { CRT_bit }
  298.  
  299.   {---------------------------------------------------------------------------}
  300.  
  301.   procedure Ary_bit (Top, Row, Col, Bit : INTEGER;      { Wiggle bit in array }
  302.                      Op                 : CHAR);   { (S)et, (R)eset, (T)oggle }
  303.  
  304.     var B : BYTE;
  305.  
  306.     begin { Ary_bit }
  307.  
  308.       B := ord(Pic[Row+Top, Col]);                      { Get byte from array }
  309.  
  310.       case Op of
  311.         'S' : B := B and (Bit xor $FF);                    { Set bit to black }
  312.         'R' : B := B or Bit;                             { Clear bit to white }
  313.         'T' : B := B xor Bit                                     { Toggle bit }
  314.       end; { case }
  315.  
  316.       Pic[Row+Top, Col] := chr(B);                        { Put byte in array }
  317.  
  318.       if Mload then                             { Wiggle bit in magnify array }
  319.         begin
  320.           Adjust_mag (Row, Col, Bit);                    { Adjust for magnify }
  321.           if Bit < 16 then Bit := $0F else Bit := $F0;
  322.           Row := (Row - 2) div 4;
  323.  
  324.           B := ord(Mag[Row, Col]);                      { Get byte from array }
  325.  
  326.           case Op of
  327.             'S' : B := B and (Bit xor $FF);                { Set bit to black }
  328.             'R' : B := B or Bit;                         { Clear bit to white }
  329.             'T' : B := B xor Bit                                 { Toggle bit }
  330.           end; { case }
  331.  
  332.           Mag[Row, Col] := chr(B)                         { Put byte in array }
  333.         end
  334.  
  335.     end;  { CRT_bit }
  336.  
  337.   {---------------------------------------------------------------------------}
  338.  
  339.   procedure Set_csr (Csr, Csc, Csb : INTEGER);               { Display cursor }
  340.  
  341.     var I,J,K : INTEGER;
  342.  
  343.         Mflag : BOOLEAN;                                  { Temp magnify flag }
  344.  
  345.     begin { Set_csr }
  346.  
  347.       if Magnify then                                    { Adjust for magnify }
  348.         begin
  349.           Adjust_mag (Csr, Csc, Csb);
  350.           Mflag := True;                                  { Save magnify flag }
  351.           Magnify := False                             { Don't magnify cursor }
  352.         end
  353.       else Mflag := False;
  354.  
  355.       I := Csc;                                             { Left bar of '+' }
  356.       J := Csb;
  357.       for K := 1 to 6 do
  358.         begin
  359.           J := J * 2;
  360.           if J > 128 then                                         { Next byte }
  361.             begin
  362.               J := 1;
  363.               I := I - 1
  364.             end;
  365.           if (I >= 0) and (K > 1) then CRT_bit (Csr, I, J, 'T')
  366.         end;
  367.  
  368.       I := Csc;                                            { Right bar of '+' }
  369.       J := Csb;
  370.       for K := 1 to 6 do
  371.         begin
  372.           J := J div 2;
  373.           if J < 1 then                                           { Next byte }
  374.             begin
  375.               J := 128;
  376.               I := I + 1
  377.             end;
  378.           if (I <= Pwide) and (K > 1) then CRT_bit (Csr, I, J, 'T')
  379.         end;
  380.  
  381.       for I := Csr-4 to Csr-2 do                             { Top bar of '+' }
  382.           if I >=0 then CRT_bit (I, Csc, Csb, 'T');
  383.  
  384.       for I := Csr+2 to Csr+4 do                          { Bottom bar of '+' }
  385.           if I < NR-RO then CRT_bit (I, Csc, Csb, 'T');
  386.  
  387.       Magnify := Mflag                                 { Restore magnify flag }
  388.  
  389.     end;  { Set_csr }
  390.  
  391.   {---------------------------------------------------------------------------}
  392.  
  393.   procedure Clr_csr (Csr, Csc, Csb : INTEGER);                 { Blank cursor }
  394.  
  395.     begin { Clr_csr }
  396.  
  397.       Set_csr (Csr, Csc, Csb)                                   { Same as set }
  398.  
  399.     end;  { Clr_csr }
  400.  
  401.   {---------------------------------------------------------------------------}
  402.  
  403.   procedure Set_status;                                      { Display status }
  404.  
  405.     begin { Set_status }
  406.  
  407.       GotoXY (1,23);
  408.       if Fast then write ('Fast') else write ('Slow');
  409.  
  410.       GotoXY (1,24);
  411.       if Pen then write ('Down') else write (' Up ');
  412.  
  413.       GotoXY (1,25);
  414.       if Erasr then write ('Eras') else write ('Draw');
  415.  
  416.       GotoXY (77,23);
  417.       if Cursor then write ('    ') else write ('+Off');
  418.  
  419.       GotoXY (77,24);
  420.       if Magnify then write ('Zoom') else write ('    ')
  421.  
  422.     end;  { Set_status }
  423.  
  424.   {---------------------------------------------------------------------------}
  425.  
  426.   procedure Edit_pic;                                        { Picture editor }
  427.  
  428.     var I,J   : INTEGER;
  429.         C     : CHAR;
  430.  
  431.         Csr,                                              { Screen cursor row }
  432.         Csc,                                           { Screen cursor column }
  433.         Csb,                                              { Screen cursor bit }
  434.  
  435.         Top   : INTEGER;                                    { Top line number }
  436.  
  437.         K     : CHAR;                               { Character from keyboard }
  438.  
  439.         Kptr  : INTEGER;                                  { Key macro pointer }
  440.         Kmac  : Str;                                       { Key macro string }
  441.  
  442.     begin { Edit_pic }
  443.  
  444.       Top := 0;                                             { Initial display }
  445.       Show_pic (Top);
  446.  
  447.       Csr := 0;
  448.       Csc := 0;
  449.       Csb := 128;
  450.       Set_csr (Csr, Csc, Csb);                               { Display cursor }
  451.  
  452.       Cursor  := TRUE;                                       { Display cursor }
  453.       Fast    := TRUE;                                       { Fast cursor    }
  454.       Pen     := FALSE;                                      { Pen up         }
  455.       Erasr   := FALSE;                                      { Draw           }
  456.       Magnify := FALSE;                                      { Magnify off    }
  457.  
  458.       Mload   := FALSE;                            { Magnify array not loaded }
  459.  
  460.       Kptr := 0;                                 { Init keyboard macro string }
  461.       Kmac := '';
  462.  
  463.       Set_status;
  464.  
  465.       K := #0;
  466.  
  467.       repeat
  468.         if Kptr = 0 then
  469.           begin
  470.             repeat until keypressed;                          { Read keyboard }
  471.             read (kbd, K);
  472.             K := upcase (K);
  473.  
  474.             if keypressed then                                 { Function key }
  475.               begin
  476.                 read (kbd, K);
  477.                 K := chr(ord(K)+128)                           { Set high bit }
  478.               end
  479.           end
  480.         else
  481.           begin
  482.             K := Kmac[Kptr];                              { Read macro string }
  483.             Kptr := Kptr + 1;
  484.             if Kptr > length (Kmac) then Kptr := 0;
  485.           end;
  486.  
  487.         case K of                                            { Key processing }
  488.  
  489.           '!'  : Set_status;                                  { Update status }
  490.  
  491.           ' '  : begin                                 { Toggle bit at cursor }
  492.                    if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
  493.                    CRT_bit (Csr, Csc, Csb, 'T');
  494.                    Ary_bit (Top, Csr, Csc, Csb, 'T');
  495.                    if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
  496.                  end;
  497.  
  498.           'C'  : if not Cursor then                           { Toggle cursor }
  499.                    begin
  500.                      Cursor := True;
  501.                      Set_csr (Csr, Csc, Csb);
  502.                      if Kptr = 0 then Set_status
  503.                    end
  504.                  else
  505.                    begin
  506.                      Cursor := False;
  507.                      Clr_csr (Csr, Csc, Csb);
  508.                      if Kptr = 0 then Set_status
  509.                    end;
  510.  
  511.           'F'  : if (not Fast) and (not Magnify) then              { Set fast }
  512.                    begin
  513.                      Fast := True;
  514.                      if Kptr = 0 then Set_status
  515.                    end;
  516.  
  517.           'S'  : if Fast then                                      { Set slow }
  518.                    begin
  519.                      Fast := False;
  520.                      if Kptr = 0 then Set_status
  521.                    end;
  522.  
  523.           '.'  : if not Magnify then                            { Toggle fast }
  524.                    begin
  525.                      Fast := not Fast;
  526.                      if Kptr = 0 then Set_status
  527.                    end;
  528.  
  529.           #13,'P'  : begin                                       { Toggle pen }
  530.                    Pen := not Pen;
  531.                    if Pen then
  532.                      begin
  533.                        if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
  534.                        if Erasr then C := 'R' else C := 'S';   { Draw / erase }
  535.                        CRT_bit (Csr, Csc, Csb, C);           { Set /reset bit }
  536.                        Ary_bit (Top, Csr, Csc, Csb, C);
  537.                        if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
  538.                      end;
  539.                    if Kptr = 0 then Set_status
  540.                  end;
  541.  
  542.           #211,'-' : if not Erasr then                                { Erase }
  543.                    begin
  544.                      Erasr := True;
  545.                      if Pen then
  546.                        begin
  547.                          if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
  548.                          CRT_bit (Csr, Csc, Csb, 'R');            { Reset bit }
  549.                          Ary_bit (Top, Csr, Csc, Csb, 'R');
  550.                          if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
  551.                        end;
  552.                      if Kptr = 0 then Set_status
  553.                    end;
  554.  
  555.           #210,'+' : if Erasr then                                     { Draw }
  556.                    begin
  557.                      Erasr := False;
  558.                      if Pen then
  559.                        begin
  560.                          if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
  561.                          CRT_bit (Csr, Csc, Csb, 'S');              { Set bit }
  562.                          Ary_bit (Top, Csr, Csc, Csb, 'S');
  563.                          if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
  564.                        end;
  565.                      if Kptr = 0 then Set_status
  566.                    end;
  567.  
  568.           'M'  : if not Magnify then                         { Toggle magnify }
  569.                    begin
  570.                      Magnify := True;
  571.                      if not Mload then Load_mag (Top, Csr, Csc);
  572.                      Show_mag;
  573.                      Fast := False;                               { Auto slow }
  574.                      if Cursor then Set_csr (Csr, Csc, Csb);
  575.                      if Kptr = 0 then Set_status
  576.                    end
  577.                  else
  578.                    begin
  579.                      Magnify := False;
  580.                      Show_pic (Top);
  581.                      if Cursor then Set_csr (Csr, Csc, Csb);
  582.                      if Kptr = 0 then Set_status
  583.                    end;
  584.  
  585.           #201,'U' : if (Top > 0) and not Magnify then              { Page up }
  586.                    begin
  587.                      if Pen then                                { Auto pen up }
  588.                        begin
  589.                          Pen := not Pen;
  590.                          if Kptr = 0 then Set_status
  591.                        end;
  592.  
  593.                      Top := Top - (NR-RO) div 8;
  594.                      if Top < 0 then Top := 0;
  595.                      Show_pic (Top);
  596.                      if Cursor then Set_csr (Csr, Csc, Csb);
  597.                      Mload := FALSE
  598.                    end;
  599.  
  600.           #209,'D' : if (Top < Plc-(NR-RO)) and not Magnify then  { Page down }
  601.                    begin
  602.                      if Pen then                                { Auto pen up }
  603.                        begin
  604.                          Pen := not Pen;
  605.                          if Kptr = 0 then Set_status
  606.                        end;
  607.  
  608.                      Top := Top + (NR-RO) div 8;
  609.                      if Top > Plc-(NR-RO) then Top := Plc-(NR-RO);
  610.                      Show_pic (Top);
  611.                      if Cursor then Set_csr (Csr, Csc, Csb);
  612.                      Mload := FALSE
  613.                    end;
  614.  
  615.           '8',#200 : if ((Csr > 0) and not Magnify)               { Cursor up }
  616.                      or ((Csr > Mrow) and Magnify) then
  617.                    begin
  618.                      if Cursor then Clr_csr (Csr, Csc, Csb);   { Blank cursor }
  619.  
  620.                      if (Csr < 4) or not Fast then             { Repeat count }
  621.                        I := 1 else I := 4;
  622.  
  623.                      for J := 1 to I do
  624.                        begin
  625.                          Csr := Csr - 1;                      { Move up a row }
  626.                          if Pen then
  627.                            begin
  628.                              if Erasr then
  629.                                C := 'R' else C := 'S';         { Draw / erase }
  630.                              CRT_bit (Csr, Csc, Csb, C);     { Set /reset bit }
  631.                              Ary_bit (Top, Csr, Csc, Csb, C)
  632.                            end
  633.                        end;
  634.  
  635.                      if Cursor then Set_csr (Csr, Csc, Csb);
  636.                      if not Magnify then Mload := FALSE
  637.                    end;
  638.  
  639.           '2',#208 : if ((Csr < (NR-RO-1)) and not Magnify)     { Cursor down }
  640.                      or ((Csr < Mrow+47) and Magnify) then
  641.                    begin
  642.                      if Cursor then Clr_csr (Csr, Csc, Csb);   { Blank cursor }
  643.  
  644.                      if (Csr >= (NR-RO-4)) or not Fast then    { Repeat count }
  645.                        I := 1 else I := 4;
  646.  
  647.                      for J := 1 to I do
  648.                        begin
  649.                          Csr := Csr + 1;                    { Move down a row }
  650.                          if Pen then
  651.                            begin
  652.                              if Erasr then
  653.                                C := 'R' else C := 'S';         { Draw / erase }
  654.                              CRT_bit (Csr, Csc, Csb, C);     { Set /reset bit }
  655.                              Ary_bit (Top, Csr, Csc, Csb, C)
  656.                            end
  657.                        end;
  658.  
  659.                      if Cursor then Set_csr (Csr, Csc, Csb);
  660.                      if not Magnify then Mload := FALSE
  661.                    end;
  662.  
  663.           '4',#203 : if ((Csc > 0) and not Magnify)             { Cursor left }
  664.                      or ((Csc > Mcol) and Magnify) or (Csb < 128) then
  665.                    begin
  666.                      if Cursor then Clr_csr (Csr, Csc, Csb);   { Blank cursor }
  667.  
  668.                      if ((Csc = 0) and (Csb > 8))              { Repeat count }
  669.                        or not Fast then I := 1 else I := 4;
  670.  
  671.                      for J := 1 to I do
  672.                        begin
  673.                          Csb := Csb * 2;                    { Move left a bit }
  674.                          if Csb = 256 then
  675.                            begin
  676.                              Csc := Csc - 1;
  677.                              Csb := 1
  678.                            end;
  679.                          if Pen then
  680.                            begin
  681.                              if Erasr then
  682.                                C := 'R' else C := 'S';         { Draw / erase }
  683.                              CRT_bit (Csr, Csc, Csb, C);     { Set /reset bit }
  684.                              Ary_bit (Top, Csr, Csc, Csb, C)
  685.                            end
  686.                        end;
  687.  
  688.                      if Cursor then Set_csr (Csr, Csc, Csb);
  689.                      if not Magnify then Mload := FALSE
  690.                    end;
  691.  
  692.           '6',#205 : if ((Csc < Pwide) and not Magnify) or     { Cursor right }
  693.                      ((Csc < Mcol+17) and Magnify) or (Csb > 1) then
  694.                    begin
  695.                      if Cursor then Clr_csr (Csr, Csc, Csb);   { Blank cursor }
  696.  
  697.                      if ((Csc = Pwide) and (Csb < 16))         { Repeat count }
  698.                        or not Fast then I := 1 else I := 4;
  699.  
  700.                      for J := 1 to I do
  701.                        begin
  702.                          Csb := Csb div 2;                 { Move right a bit }
  703.                          if Csb = 0 then
  704.                            begin
  705.                              Csc := Csc + 1;
  706.                              Csb := 128
  707.                            end;
  708.                          if Pen then
  709.                            begin
  710.                              if Erasr then
  711.                                C := 'R' else C := 'S';         { Draw / erase }
  712.                              CRT_bit (Csr, Csc, Csb, C);     { Set /reset bit }
  713.                              Ary_bit (Top, Csr, Csc, Csb, C)
  714.                            end
  715.                        end;
  716.  
  717.                      if Cursor then Set_csr (Csr, Csc, Csb);
  718.                      if not Magnify then Mload := FALSE
  719.                    end;
  720.  
  721.           '7'  : begin                                     { Cursor up & left }
  722.                    Kptr := 1;
  723.                    if not Pen then                                { Just move }
  724.                      Kmac := '84'
  725.                    else
  726.                      if not Fast then
  727.                        Kmac := 'P84P'                           { Move & draw }
  728.                      else
  729.                        Kmac := 'SP84PP84PP84PP84PF';        { Move & draw (4) }
  730.                    if Cursor then
  731.                      Kmac := 'C' + Kmac + 'C'    { Cursor off for faster move }
  732.                  end;
  733.  
  734.           '9'  : begin                                    { Cursor up & right }
  735.                    Kptr := 1;
  736.                    if not Pen then                                { Just move }
  737.                      Kmac := '86'
  738.                    else
  739.                      if not Fast then
  740.                        Kmac := 'P86P'                           { Move & draw }
  741.                      else
  742.                        Kmac := 'SP86PP86PP86PP86PF';        { Move & draw (4) }
  743.                    if Cursor then
  744.                      Kmac := 'C' + Kmac + 'C'    { Cursor off for faster move }
  745.                  end;
  746.  
  747.           '1'  : begin                                   { Cursor down & left }
  748.                    Kptr := 1;
  749.                    if not Pen then                                { Just move }
  750.                      Kmac := '24'
  751.                    else
  752.                      if not Fast then
  753.                        Kmac := 'P24P'                           { Move & draw }
  754.                      else
  755.                        Kmac := 'SP24PP24PP24PP24PF';        { Move & draw (4) }
  756.                    if Cursor then
  757.                      Kmac := 'C' + Kmac + 'C'    { Cursor off for faster move }
  758.                  end;
  759.  
  760.           '3'  : begin                                  { Cursor down & right }
  761.                    Kptr := 1;
  762.                    if not Pen then                                { Just move }
  763.                      Kmac := '26'
  764.                    else
  765.                      if not Fast then
  766.                        Kmac := 'P26P'                           { Move & draw }
  767.                      else
  768.                        Kmac := 'SP26PP26PP26PP26PF';        { Move & draw (4) }
  769.                    if Cursor then
  770.                      Kmac := 'C' + Kmac + 'C'    { Cursor off for faster move }
  771.                  end
  772.  
  773.         end { case }
  774.  
  775.       until K = #27
  776.  
  777.     end;  { Edit_pic }
  778.  
  779.   {---------------------------------------------------------------------------}
  780.  
  781.   function Pac_rec (S : Str) : Str;                             { Pack record }
  782.  
  783.     var I,J,K : INTEGER;
  784.         C     : CHAR;
  785.         S1    : Str;
  786.  
  787.     begin { Pac_rec }
  788.  
  789.       I := 2;                                               { Start of window }
  790.       J := 2;                                                 { End of window }
  791.       K := 1;                                                    { S1 pointer }
  792.  
  793.       repeat
  794.         if J < length(S) then
  795.           begin
  796.             repeat
  797.               J := J + 1;
  798.             until (S[J] <> S[I]) or (J > length (S));
  799.  
  800.             if J > I+1 then
  801.               begin
  802.                 S1[K] := chr(257+I-J);             { 2's comp of repeat count }
  803.                 S1[K+1] := S[I];                        { Character to repeat }
  804.                 K := K + 2;
  805.                 I := J
  806.               end
  807.             else J := I
  808.           end;
  809.  
  810.         if J <= length(S) then
  811.           begin
  812.             repeat
  813.               J := J + 1;
  814.             until ((J-I > 2) and (S[J] = S[J-1]) and (S[J] = S[J-2]))
  815.             or (J > length (S));
  816.  
  817.             if J <= length(S) then J := J - 2;
  818.             S1[K] := chr(J-I-1);                                 { Copy count }
  819.             move (S[I], S1[K+1], J-I);                   { Characters to copy }
  820.             K := K + (J-I) + 1;
  821.             I := J
  822.           end
  823.         until I > length(S);
  824.  
  825.       S1[0] := chr(K-1);                                         { Set length }
  826.       Pac_rec := S1                                    { Return packed record }
  827.  
  828.     end;  { Pac_rec }
  829.  
  830.   {---------------------------------------------------------------------------}
  831.  
  832.   function Save_pic : CHAR;                             { Save edited picture }
  833.  
  834.     var I,J,K : INTEGER;
  835.         C     : CHAR;
  836.         S     : Str;
  837.  
  838.         Pt    : INTEGER;                                     { Record pointer }
  839.         Rec   : Picrec;                                              { Record }
  840.  
  841.     begin { Save_pic }
  842.  
  843.       GotoXY (20,25);                                                  { Save }
  844.       write ('      Save edited picture (Y/N): _      ');
  845.       GotoXY (53,25);
  846.  
  847.       C := #0;
  848.  
  849.       repeat
  850.         repeat until keypressed;
  851.         read (kbd, C);
  852.         C := upcase (C);
  853.         if C = #27 then                                       { Blank display }
  854.           begin
  855.             HiRes;
  856.             GotoXY (34,25);
  857.             write ('Save (Y/N): _');
  858.             GotoXY (46,25)
  859.           end
  860.       until (C = 'Y') or (C = 'N');
  861.       write (C);
  862.  
  863.       if C = 'Y' then
  864.         begin
  865.           S := paramstr(1);                             { Build .BAK filename }
  866.           I := pos ('.', S);
  867.           if I > 0 then S := copy (S, 1, I-1);
  868.           S := S + '.BAK';
  869.  
  870.           assign (Picfile, S);                         { Delete old .BAK file }
  871.           {$I-} erase (Picfile) {$I+};
  872.           I := IOresult;
  873.  
  874.           assign (Picfile, paramstr(1));                 { Rename source file }
  875.           rename (Picfile, S);
  876.  
  877.           assign (Newfile, paramstr(1));                      { Open new file }
  878.           reset (Picfile);
  879.           rewrite (Newfile);
  880.  
  881.           for I := 0 to 4 do                       { Copy 1st 5 records as is }
  882.             begin
  883.               read(Picfile, Rec);
  884.               write(Newfile, Rec)
  885.             end;
  886.  
  887.           GotoXY (20,25);
  888.           write ('  Now processing line     0  of  ', Plc:4, '.  ');
  889.  
  890.           Pt := 1;                                           { Record pointer }
  891.  
  892.           for I := 0 to Plc-1 do                                      { Lines }
  893.             begin
  894.               GotoXY (43,25); write (I+1:4);
  895.  
  896.               S[0] := chr (Pwide+2);          { Pre-compression string length }
  897.               S[1] := chr (Pwide);               { Length-1 of 1st data block }
  898.  
  899.               for J := 0 to Pwide do                                  { Chars }
  900.                 begin
  901.                   S[J+2] := chr(ord(Pic[I, J]) xor $FF);    { Char from array }
  902.                 end;
  903.  
  904.               S := Pac_rec (S);                             { Pack the record }
  905.  
  906.               if length (S) < 129-Pt then { Data does not fill current record }
  907.                 begin
  908.                   move (S[1], Rec[Pt], length(S));    { Move data into record }
  909.                   Pt := Pt + length(S)                      { Advance pointer }
  910.                 end
  911.               else                                { Data fills current record }
  912.                 begin
  913.                   move (S[1], Rec[Pt], 129-Pt);       { Move data into record }
  914.                   write (Newfile, Rec);                        { Write record }
  915.                   if Pt+length(S) = 129 then              { Data fits exactly }
  916.                     Pt := 1
  917.                   else                            { Overflow into next record }
  918.                     begin
  919.                       move (S[130-Pt], Rec[1], length(S)+Pt-129); { Move data }
  920.                       Pt := length(S)+Pt-128                 { Adjust pointer }
  921.                     end
  922.                 end
  923.             end;
  924.  
  925.           if Pt > 1 then                                   { Fill last record }
  926.             begin
  927.               for I := Pt to 128 do Rec[I] := #0;
  928.               write (Newfile, Rec)
  929.             end;
  930.  
  931.           close (Picfile);                                      { Close files }
  932.           close (Newfile)
  933.  
  934.         end;
  935.  
  936.       GotoXY (20,25);                                                  { Exit }
  937.       write ('        Continue editing (Y/N): _       ');
  938.       GotoXY (52,25);
  939.  
  940.       C := #0;
  941.  
  942.       repeat
  943.         repeat until keypressed;
  944.         read (kbd, C);
  945.         C := upcase (C)
  946.       until (C = 'Y') or (C = 'N');
  947.       write (C);
  948.  
  949.       Save_pic := C                                     { Return final answer }
  950.  
  951.     end;  { Save_pic }
  952.  
  953.   {===========================================================================}
  954.  
  955.   begin { EdMac }
  956.  
  957.     if paramcount <> 1 then
  958.       begin
  959.         TextColor (LightGray);
  960.         clrscr;
  961.         writeln ('EdMac - MacPaint file compatible graphics editor');
  962.         writeln ('Ver. 1.00   03/16/87   FreeWare by S.D. Gorrell');
  963.         writeln;
  964.         writeln;
  965.  
  966.         writeln ('Usage -  Edmac [drive:][path/]filename.ext');
  967.         writeln;
  968.         writeln;
  969.  
  970.         writeln ('Cursor Keys   - Move up, down, left, right');
  971.         writeln ('Num Pad       - Move up, down, left, right, and diagonal');
  972.         writeln ('U, <PgUp>     - Scroll screen back');
  973.         writeln ('D, <PgDn>     - Scroll screen forward');
  974.  
  975.         writeln ('F             - Set fast cursor movement');
  976.         writeln ('S             - Set slow cursor movement');
  977.         writeln ('.             - Toggle cursor movement fast / slow');
  978.  
  979.         writeln ('P, <CR>       - Toggle pen up / down');
  980.         writeln ('+, <Ins>      - Set mode to draw');
  981.         writeln ('-, <Del>      - Set mode to erase');
  982.         writeln ('<Space>       - Toggle bit under cursor');
  983.  
  984.         writeln ('C             - Toggle cursor on / off');
  985.         writeln ('M             - Toggle magnifiaction on / off');
  986.         writeln;
  987.  
  988.         writeln ('<Esc>         - Exit with optional save');
  989.         writeln
  990.       end
  991.     else
  992.       begin
  993.         HiRes;                                     { High resolution graphics }
  994.         Load_pic;                                         { Load picture file }
  995.         repeat
  996.           Edit_pic                                                  { Edit it }
  997.         until Save_pic = 'N';                           { Save edited picture }
  998.         TextMode                                          { Back to text mode }
  999.       end
  1000.  
  1001.   end.  { EdMac }