home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Source Code 1992 March
/
Source_Code_CD-ROM_Walnut_Creek_March_1992.iso
/
msdos
/
mac
/
edmac.arc
/
EDMAC.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1980-01-01
|
38KB
|
1,001 lines
{ EdMac - MacPaint file compatible graphics editor }
{ Ver. 1.00 03/16/87 by S.D. Gorrell }
program EdMac (input, output);
const Vseg0 = $B800; { Video memory map segment for lines 0,2,4, etc. }
Vseg1 = $BA00; { ' ' lines 1,3,5, etc. }
Pwide = 71; { McPaint picture width-1 in characters (576 bits) }
Plines = 799; { Max number of loadable lines }
RO = 8; { Screen row offset }
CO = 4; { Screen column offset }
NR = 200; { Number of screen rows }
type Picrec = array [1..128] of CHAR; { File record buffer }
Str = string [255]; { General purpose string }
var Plc : INTEGER; { Picture line count }
Pic : array [0..Plines, 0..Pwide] of CHAR; { Picture array }
Mrow, { Magnify row origin }
Mcol : INTEGER; { Magnify column origin }
Mag : Array [0..47, 0..Pwide] of CHAR; { Magnify array }
Cursor, { Cursor on }
Fast, { Fast cursor movement }
Pen, { Pen down }
Erasr, { Draw / erase }
Magnify : BOOLEAN; { Magnify on }
Mload : BOOLEAN; { Magnify array loaded flag }
CRT : array [0..$3FFF] of CHAR absolute Vseg0:$0000; { Screen mem }
Picfile, { Picture file }
Newfile : file of Picrec; { Edited picture file }
{---------------------------------------------------------------------------}
function Next_byte (var Rec : Picrec; { Read next byte from file }
var RP,
Recno,
Nrecs : INTEGER) : CHAR;
begin { Next_byte }
if RP > 128 then { Wrap to next record }
begin
Recno := Recno + 1;
RP := 1;
if Recno < Nrecs then
begin
seek (Picfile, Recno);
read (Picfile, Rec);
gotoXY (25,25);
write (Recno+1:3)
end
end;
if Recno < Nrecs then
begin
Next_byte := Rec[RP]; { Return next byte }
RP := RP + 1
end
else
Next_byte := #0 { ...or null if past eof }
end; { Next_byte }
{---------------------------------------------------------------------------}
procedure Load_pic; { Load picture from file }
var I,J,K : INTEGER;
C : CHAR;
S : Str;
RP, { Record char pointer }
Recno, { Current record number }
Nrecs : INTEGER; { Number of records in file }
Rec : Picrec; { Record from file }
begin { Load_pic }
assign (Picfile, paramstr(1));
reset (Picfile);
Nrecs := filesize(Picfile);
read (Picfile, Rec); { Header record }
I := ord(Rec[2]);
S := copy(Rec,3,I); { Title }
gotoXY ((80-I) div 2, 1);
write (S);
gotoXY (1,25);
write ('Now processing record 0 of ', Nrecs:4, '.');
RP := 129; { Init record char pointer to end of previous record }
Recno := 4; { Picture starts at byte $0280 }
Plc := 0; { Picture line count }
K := 0;
repeat { Unpack picture }
C := Next_byte (Rec, RP, Recno, Nrecs); { Count byte }
I := ord (C);
if I < 128 then { Unpack next (I+1) chars as is }
begin
for J := 0 to I do
if Plc <= Plines then
begin
C := Next_byte (Rec, RP, Recno, Nrecs);
Pic[Plc, K] := chr(ord(C) xor 255);
K := (K+1) mod (Pwide+1);
if K = 0 then Plc := Plc + 1
end
end
else { Repeat next char (2's comp I) times }
begin
C := Next_byte (Rec, RP, Recno, Nrecs);
for J := 0 to 256-I do
if Plc <= Plines then
begin
Pic[Plc, K] := chr(ord(C) xor 255);
K := (K+1) mod (Pwide+1);
if K = 0 then Plc := Plc + 1
end
end
until (Recno >= Nrecs) or (Plc > Plines);
close (Picfile);
gotoXY (1,25);
write (Plc:4, ' displayable lines loaded. <RET> ');
repeat until keypressed;
read (kbd, C);
gotoXY (1,25);
write (' ':33)
end; { Load_pic }
{---------------------------------------------------------------------------}
procedure Show_pic (Top : INTEGER); { Display picture }
var I,J,K : INTEGER;
begin { Show_pic }
I := (RO div 2) * 80 + CO; { Screen array offset }
J := Top; { Array line }
K := (NR div 2) * 80 + CO; { End of screen }
repeat
move (Pic[J, 0], CRT[I], Pwide+1); { Write to even line page }
move (Pic[J+1, 0], CRT[I+$2000], Pwide+1); { Write to odd line page }
I := I + 80;
J := J + 2
until (I = K) or (J = Plc)
end; { Show_pic }
{---------------------------------------------------------------------------}
procedure Load_mag (Top, Csr, Csc : INTEGER); { Load magnify array }
var I,J,K,R,C : INTEGER;
B : BYTE;
begin { Load_mag }
Mrow := Csr - 24; { Set row origin }
if Mrow < 0 then Mrow := 0
else if Mrow > 144 then Mrow := 144;
Mcol := Csc - 9; { Set column origin }
if Mcol < 0 then Mcol := 0
else if Mcol > 54 then Mcol := 54;
C := 0; { Array row and column }
for I := 0 to 47 do { 48 lines }
begin
for J := 0 to 17 do { 18 characters }
begin
K := 128; { 8 bits }
repeat
B := 0;
if (ord(Pic[Top+Mrow+I, Mcol+J]) and K) > 0 { Isolate hi bit }
then B := $F0;
K := K div 2;
if (ord(Pic[Top+Mrow+I, Mcol+J]) and K) > 0 { Isolate lo bit }
then B := B or $0F;
K := K div 2;
Mag[I,C] := chr(B);
C := (C + 1) mod 72
until K = 0
end
end;
Mload := TRUE { Set magnify array loaded flag }
end; { Load_mag }
{---------------------------------------------------------------------------}
procedure Show_mag; { Display magnified picture }
var I,J : INTEGER;
begin { Show_mag }
I := (RO div 2) * 80 + CO; { Screen array offset }
for J := 0 to 47 do
begin
move (Mag[J, 0], CRT[I], Pwide+1); { Write to even line page }
move (Mag[J, 0], CRT[I+$2000], Pwide+1); { Write to odd line page }
I := I + 80;
move (Mag[J, 0], CRT[I], Pwide+1); { Write to even line page }
move (Mag[J, 0], CRT[I+$2000], Pwide+1); { Write to odd line page }
I := I + 80
end
end; { Show_mag }
{---------------------------------------------------------------------------}
procedure Adjust_mag (var Csr, Csc, Csb : INTEGER); { Adjust for magnify }
var I : INTEGER;
begin { Adjust_mag }
Csr := (Csr-Mrow) * 4 + 2; { Adjust row }
Csc := (Csc-Mcol) * 4; { Adjust column }
I := Csb; { Adjust byte }
Csb := 32;
if I < 128 then
repeat
Csb := Csb div 16;
if Csb = 0 then
begin
Csc := Csc + 1;
Csb := 32
end;
I := I * 2
until I = 128
end; { Adjust_mag }
{---------------------------------------------------------------------------}
procedure CRT_bit (Row, Col, Bit : INTEGER; { Wiggle bit on CRT }
Op : CHAR); { (S)et, (R)eset, (T)oggle }
var I,J : INTEGER;
B : BYTE;
MO : INTEGER; { Memory offset }
begin { CRT_bit }
if Magnify then { Adjust for magnify }
begin
Adjust_mag (Row, Col, Bit);
if Bit < 16 then Bit := $0F else Bit := $F0;
Row := Row - 2;
I := 3
end
else I := 0;
for J := 0 to I do
begin
MO := ((Row+RO+J) div 2) * 80 + Col + CO; { Calculate memory offset }
if (Row+RO+J) mod 2 = 0 then
B := Mem[Vseg0 : MO] { Get byte in even line }
else
B := Mem[Vseg1 : MO]; { Get byte in odd line }
case Op of
'S' : B := B and (Bit xor $FF); { Set bit to black }
'R' : B := B or Bit; { Clear bit to white }
'T' : B := B xor Bit { Toggle bit }
end; { case }
if (Row+RO+J) mod 2 = 0 then
Mem[Vseg0 : MO] := B { Put byte in even line }
else
Mem[Vseg1 : MO] := B { Put byte in odd line }
end
end; { CRT_bit }
{---------------------------------------------------------------------------}
procedure Ary_bit (Top, Row, Col, Bit : INTEGER; { Wiggle bit in array }
Op : CHAR); { (S)et, (R)eset, (T)oggle }
var B : BYTE;
begin { Ary_bit }
B := ord(Pic[Row+Top, Col]); { Get byte from array }
case Op of
'S' : B := B and (Bit xor $FF); { Set bit to black }
'R' : B := B or Bit; { Clear bit to white }
'T' : B := B xor Bit { Toggle bit }
end; { case }
Pic[Row+Top, Col] := chr(B); { Put byte in array }
if Mload then { Wiggle bit in magnify array }
begin
Adjust_mag (Row, Col, Bit); { Adjust for magnify }
if Bit < 16 then Bit := $0F else Bit := $F0;
Row := (Row - 2) div 4;
B := ord(Mag[Row, Col]); { Get byte from array }
case Op of
'S' : B := B and (Bit xor $FF); { Set bit to black }
'R' : B := B or Bit; { Clear bit to white }
'T' : B := B xor Bit { Toggle bit }
end; { case }
Mag[Row, Col] := chr(B) { Put byte in array }
end
end; { CRT_bit }
{---------------------------------------------------------------------------}
procedure Set_csr (Csr, Csc, Csb : INTEGER); { Display cursor }
var I,J,K : INTEGER;
Mflag : BOOLEAN; { Temp magnify flag }
begin { Set_csr }
if Magnify then { Adjust for magnify }
begin
Adjust_mag (Csr, Csc, Csb);
Mflag := True; { Save magnify flag }
Magnify := False { Don't magnify cursor }
end
else Mflag := False;
I := Csc; { Left bar of '+' }
J := Csb;
for K := 1 to 6 do
begin
J := J * 2;
if J > 128 then { Next byte }
begin
J := 1;
I := I - 1
end;
if (I >= 0) and (K > 1) then CRT_bit (Csr, I, J, 'T')
end;
I := Csc; { Right bar of '+' }
J := Csb;
for K := 1 to 6 do
begin
J := J div 2;
if J < 1 then { Next byte }
begin
J := 128;
I := I + 1
end;
if (I <= Pwide) and (K > 1) then CRT_bit (Csr, I, J, 'T')
end;
for I := Csr-4 to Csr-2 do { Top bar of '+' }
if I >=0 then CRT_bit (I, Csc, Csb, 'T');
for I := Csr+2 to Csr+4 do { Bottom bar of '+' }
if I < NR-RO then CRT_bit (I, Csc, Csb, 'T');
Magnify := Mflag { Restore magnify flag }
end; { Set_csr }
{---------------------------------------------------------------------------}
procedure Clr_csr (Csr, Csc, Csb : INTEGER); { Blank cursor }
begin { Clr_csr }
Set_csr (Csr, Csc, Csb) { Same as set }
end; { Clr_csr }
{---------------------------------------------------------------------------}
procedure Set_status; { Display status }
begin { Set_status }
GotoXY (1,23);
if Fast then write ('Fast') else write ('Slow');
GotoXY (1,24);
if Pen then write ('Down') else write (' Up ');
GotoXY (1,25);
if Erasr then write ('Eras') else write ('Draw');
GotoXY (77,23);
if Cursor then write (' ') else write ('+Off');
GotoXY (77,24);
if Magnify then write ('Zoom') else write (' ')
end; { Set_status }
{---------------------------------------------------------------------------}
procedure Edit_pic; { Picture editor }
var I,J : INTEGER;
C : CHAR;
Csr, { Screen cursor row }
Csc, { Screen cursor column }
Csb, { Screen cursor bit }
Top : INTEGER; { Top line number }
K : CHAR; { Character from keyboard }
Kptr : INTEGER; { Key macro pointer }
Kmac : Str; { Key macro string }
begin { Edit_pic }
Top := 0; { Initial display }
Show_pic (Top);
Csr := 0;
Csc := 0;
Csb := 128;
Set_csr (Csr, Csc, Csb); { Display cursor }
Cursor := TRUE; { Display cursor }
Fast := TRUE; { Fast cursor }
Pen := FALSE; { Pen up }
Erasr := FALSE; { Draw }
Magnify := FALSE; { Magnify off }
Mload := FALSE; { Magnify array not loaded }
Kptr := 0; { Init keyboard macro string }
Kmac := '';
Set_status;
K := #0;
repeat
if Kptr = 0 then
begin
repeat until keypressed; { Read keyboard }
read (kbd, K);
K := upcase (K);
if keypressed then { Function key }
begin
read (kbd, K);
K := chr(ord(K)+128) { Set high bit }
end
end
else
begin
K := Kmac[Kptr]; { Read macro string }
Kptr := Kptr + 1;
if Kptr > length (Kmac) then Kptr := 0;
end;
case K of { Key processing }
'!' : Set_status; { Update status }
' ' : begin { Toggle bit at cursor }
if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
CRT_bit (Csr, Csc, Csb, 'T');
Ary_bit (Top, Csr, Csc, Csb, 'T');
if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
end;
'C' : if not Cursor then { Toggle cursor }
begin
Cursor := True;
Set_csr (Csr, Csc, Csb);
if Kptr = 0 then Set_status
end
else
begin
Cursor := False;
Clr_csr (Csr, Csc, Csb);
if Kptr = 0 then Set_status
end;
'F' : if (not Fast) and (not Magnify) then { Set fast }
begin
Fast := True;
if Kptr = 0 then Set_status
end;
'S' : if Fast then { Set slow }
begin
Fast := False;
if Kptr = 0 then Set_status
end;
'.' : if not Magnify then { Toggle fast }
begin
Fast := not Fast;
if Kptr = 0 then Set_status
end;
#13,'P' : begin { Toggle pen }
Pen := not Pen;
if Pen then
begin
if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
if Erasr then C := 'R' else C := 'S'; { Draw / erase }
CRT_bit (Csr, Csc, Csb, C); { Set /reset bit }
Ary_bit (Top, Csr, Csc, Csb, C);
if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
end;
if Kptr = 0 then Set_status
end;
#211,'-' : if not Erasr then { Erase }
begin
Erasr := True;
if Pen then
begin
if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
CRT_bit (Csr, Csc, Csb, 'R'); { Reset bit }
Ary_bit (Top, Csr, Csc, Csb, 'R');
if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
end;
if Kptr = 0 then Set_status
end;
#210,'+' : if Erasr then { Draw }
begin
Erasr := False;
if Pen then
begin
if Cursor and Magnify then Clr_csr (Csr, Csc, Csb);
CRT_bit (Csr, Csc, Csb, 'S'); { Set bit }
Ary_bit (Top, Csr, Csc, Csb, 'S');
if Cursor and Magnify then Set_csr (Csr, Csc, Csb)
end;
if Kptr = 0 then Set_status
end;
'M' : if not Magnify then { Toggle magnify }
begin
Magnify := True;
if not Mload then Load_mag (Top, Csr, Csc);
Show_mag;
Fast := False; { Auto slow }
if Cursor then Set_csr (Csr, Csc, Csb);
if Kptr = 0 then Set_status
end
else
begin
Magnify := False;
Show_pic (Top);
if Cursor then Set_csr (Csr, Csc, Csb);
if Kptr = 0 then Set_status
end;
#201,'U' : if (Top > 0) and not Magnify then { Page up }
begin
if Pen then { Auto pen up }
begin
Pen := not Pen;
if Kptr = 0 then Set_status
end;
Top := Top - (NR-RO) div 8;
if Top < 0 then Top := 0;
Show_pic (Top);
if Cursor then Set_csr (Csr, Csc, Csb);
Mload := FALSE
end;
#209,'D' : if (Top < Plc-(NR-RO)) and not Magnify then { Page down }
begin
if Pen then { Auto pen up }
begin
Pen := not Pen;
if Kptr = 0 then Set_status
end;
Top := Top + (NR-RO) div 8;
if Top > Plc-(NR-RO) then Top := Plc-(NR-RO);
Show_pic (Top);
if Cursor then Set_csr (Csr, Csc, Csb);
Mload := FALSE
end;
'8',#200 : if ((Csr > 0) and not Magnify) { Cursor up }
or ((Csr > Mrow) and Magnify) then
begin
if Cursor then Clr_csr (Csr, Csc, Csb); { Blank cursor }
if (Csr < 4) or not Fast then { Repeat count }
I := 1 else I := 4;
for J := 1 to I do
begin
Csr := Csr - 1; { Move up a row }
if Pen then
begin
if Erasr then
C := 'R' else C := 'S'; { Draw / erase }
CRT_bit (Csr, Csc, Csb, C); { Set /reset bit }
Ary_bit (Top, Csr, Csc, Csb, C)
end
end;
if Cursor then Set_csr (Csr, Csc, Csb);
if not Magnify then Mload := FALSE
end;
'2',#208 : if ((Csr < (NR-RO-1)) and not Magnify) { Cursor down }
or ((Csr < Mrow+47) and Magnify) then
begin
if Cursor then Clr_csr (Csr, Csc, Csb); { Blank cursor }
if (Csr >= (NR-RO-4)) or not Fast then { Repeat count }
I := 1 else I := 4;
for J := 1 to I do
begin
Csr := Csr + 1; { Move down a row }
if Pen then
begin
if Erasr then
C := 'R' else C := 'S'; { Draw / erase }
CRT_bit (Csr, Csc, Csb, C); { Set /reset bit }
Ary_bit (Top, Csr, Csc, Csb, C)
end
end;
if Cursor then Set_csr (Csr, Csc, Csb);
if not Magnify then Mload := FALSE
end;
'4',#203 : if ((Csc > 0) and not Magnify) { Cursor left }
or ((Csc > Mcol) and Magnify) or (Csb < 128) then
begin
if Cursor then Clr_csr (Csr, Csc, Csb); { Blank cursor }
if ((Csc = 0) and (Csb > 8)) { Repeat count }
or not Fast then I := 1 else I := 4;
for J := 1 to I do
begin
Csb := Csb * 2; { Move left a bit }
if Csb = 256 then
begin
Csc := Csc - 1;
Csb := 1
end;
if Pen then
begin
if Erasr then
C := 'R' else C := 'S'; { Draw / erase }
CRT_bit (Csr, Csc, Csb, C); { Set /reset bit }
Ary_bit (Top, Csr, Csc, Csb, C)
end
end;
if Cursor then Set_csr (Csr, Csc, Csb);
if not Magnify then Mload := FALSE
end;
'6',#205 : if ((Csc < Pwide) and not Magnify) or { Cursor right }
((Csc < Mcol+17) and Magnify) or (Csb > 1) then
begin
if Cursor then Clr_csr (Csr, Csc, Csb); { Blank cursor }
if ((Csc = Pwide) and (Csb < 16)) { Repeat count }
or not Fast then I := 1 else I := 4;
for J := 1 to I do
begin
Csb := Csb div 2; { Move right a bit }
if Csb = 0 then
begin
Csc := Csc + 1;
Csb := 128
end;
if Pen then
begin
if Erasr then
C := 'R' else C := 'S'; { Draw / erase }
CRT_bit (Csr, Csc, Csb, C); { Set /reset bit }
Ary_bit (Top, Csr, Csc, Csb, C)
end
end;
if Cursor then Set_csr (Csr, Csc, Csb);
if not Magnify then Mload := FALSE
end;
'7' : begin { Cursor up & left }
Kptr := 1;
if not Pen then { Just move }
Kmac := '84'
else
if not Fast then
Kmac := 'P84P' { Move & draw }
else
Kmac := 'SP84PP84PP84PP84PF'; { Move & draw (4) }
if Cursor then
Kmac := 'C' + Kmac + 'C' { Cursor off for faster move }
end;
'9' : begin { Cursor up & right }
Kptr := 1;
if not Pen then { Just move }
Kmac := '86'
else
if not Fast then
Kmac := 'P86P' { Move & draw }
else
Kmac := 'SP86PP86PP86PP86PF'; { Move & draw (4) }
if Cursor then
Kmac := 'C' + Kmac + 'C' { Cursor off for faster move }
end;
'1' : begin { Cursor down & left }
Kptr := 1;
if not Pen then { Just move }
Kmac := '24'
else
if not Fast then
Kmac := 'P24P' { Move & draw }
else
Kmac := 'SP24PP24PP24PP24PF'; { Move & draw (4) }
if Cursor then
Kmac := 'C' + Kmac + 'C' { Cursor off for faster move }
end;
'3' : begin { Cursor down & right }
Kptr := 1;
if not Pen then { Just move }
Kmac := '26'
else
if not Fast then
Kmac := 'P26P' { Move & draw }
else
Kmac := 'SP26PP26PP26PP26PF'; { Move & draw (4) }
if Cursor then
Kmac := 'C' + Kmac + 'C' { Cursor off for faster move }
end
end { case }
until K = #27
end; { Edit_pic }
{---------------------------------------------------------------------------}
function Pac_rec (S : Str) : Str; { Pack record }
var I,J,K : INTEGER;
C : CHAR;
S1 : Str;
begin { Pac_rec }
I := 2; { Start of window }
J := 2; { End of window }
K := 1; { S1 pointer }
repeat
if J < length(S) then
begin
repeat
J := J + 1;
until (S[J] <> S[I]) or (J > length (S));
if J > I+1 then
begin
S1[K] := chr(257+I-J); { 2's comp of repeat count }
S1[K+1] := S[I]; { Character to repeat }
K := K + 2;
I := J
end
else J := I
end;
if J <= length(S) then
begin
repeat
J := J + 1;
until ((J-I > 2) and (S[J] = S[J-1]) and (S[J] = S[J-2]))
or (J > length (S));
if J <= length(S) then J := J - 2;
S1[K] := chr(J-I-1); { Copy count }
move (S[I], S1[K+1], J-I); { Characters to copy }
K := K + (J-I) + 1;
I := J
end
until I > length(S);
S1[0] := chr(K-1); { Set length }
Pac_rec := S1 { Return packed record }
end; { Pac_rec }
{---------------------------------------------------------------------------}
function Save_pic : CHAR; { Save edited picture }
var I,J,K : INTEGER;
C : CHAR;
S : Str;
Pt : INTEGER; { Record pointer }
Rec : Picrec; { Record }
begin { Save_pic }
GotoXY (20,25); { Save }
write (' Save edited picture (Y/N): _ ');
GotoXY (53,25);
C := #0;
repeat
repeat until keypressed;
read (kbd, C);
C := upcase (C);
if C = #27 then { Blank display }
begin
HiRes;
GotoXY (34,25);
write ('Save (Y/N): _');
GotoXY (46,25)
end
until (C = 'Y') or (C = 'N');
write (C);
if C = 'Y' then
begin
S := paramstr(1); { Build .BAK filename }
I := pos ('.', S);
if I > 0 then S := copy (S, 1, I-1);
S := S + '.BAK';
assign (Picfile, S); { Delete old .BAK file }
{$I-} erase (Picfile) {$I+};
I := IOresult;
assign (Picfile, paramstr(1)); { Rename source file }
rename (Picfile, S);
assign (Newfile, paramstr(1)); { Open new file }
reset (Picfile);
rewrite (Newfile);
for I := 0 to 4 do { Copy 1st 5 records as is }
begin
read(Picfile, Rec);
write(Newfile, Rec)
end;
GotoXY (20,25);
write (' Now processing line 0 of ', Plc:4, '. ');
Pt := 1; { Record pointer }
for I := 0 to Plc-1 do { Lines }
begin
GotoXY (43,25); write (I+1:4);
S[0] := chr (Pwide+2); { Pre-compression string length }
S[1] := chr (Pwide); { Length-1 of 1st data block }
for J := 0 to Pwide do { Chars }
begin
S[J+2] := chr(ord(Pic[I, J]) xor $FF); { Char from array }
end;
S := Pac_rec (S); { Pack the record }
if length (S) < 129-Pt then { Data does not fill current record }
begin
move (S[1], Rec[Pt], length(S)); { Move data into record }
Pt := Pt + length(S) { Advance pointer }
end
else { Data fills current record }
begin
move (S[1], Rec[Pt], 129-Pt); { Move data into record }
write (Newfile, Rec); { Write record }
if Pt+length(S) = 129 then { Data fits exactly }
Pt := 1
else { Overflow into next record }
begin
move (S[130-Pt], Rec[1], length(S)+Pt-129); { Move data }
Pt := length(S)+Pt-128 { Adjust pointer }
end
end
end;
if Pt > 1 then { Fill last record }
begin
for I := Pt to 128 do Rec[I] := #0;
write (Newfile, Rec)
end;
close (Picfile); { Close files }
close (Newfile)
end;
GotoXY (20,25); { Exit }
write (' Continue editing (Y/N): _ ');
GotoXY (52,25);
C := #0;
repeat
repeat until keypressed;
read (kbd, C);
C := upcase (C)
until (C = 'Y') or (C = 'N');
write (C);
Save_pic := C { Return final answer }
end; { Save_pic }
{===========================================================================}
begin { EdMac }
if paramcount <> 1 then
begin
TextColor (LightGray);
clrscr;
writeln ('EdMac - MacPaint file compatible graphics editor');
writeln ('Ver. 1.00 03/16/87 FreeWare by S.D. Gorrell');
writeln;
writeln;
writeln ('Usage - Edmac [drive:][path/]filename.ext');
writeln;
writeln;
writeln ('Cursor Keys - Move up, down, left, right');
writeln ('Num Pad - Move up, down, left, right, and diagonal');
writeln ('U, <PgUp> - Scroll screen back');
writeln ('D, <PgDn> - Scroll screen forward');
writeln ('F - Set fast cursor movement');
writeln ('S - Set slow cursor movement');
writeln ('. - Toggle cursor movement fast / slow');
writeln ('P, <CR> - Toggle pen up / down');
writeln ('+, <Ins> - Set mode to draw');
writeln ('-, <Del> - Set mode to erase');
writeln ('<Space> - Toggle bit under cursor');
writeln ('C - Toggle cursor on / off');
writeln ('M - Toggle magnifiaction on / off');
writeln;
writeln ('<Esc> - Exit with optional save');
writeln
end
else
begin
HiRes; { High resolution graphics }
Load_pic; { Load picture file }
repeat
Edit_pic { Edit it }
until Save_pic = 'N'; { Save edited picture }
TextMode { Back to text mode }
end
end. { EdMac }
