(*---
  FileName : EDGRA3.pas                       Version : July 24, 1986
                                              made by : JOS
  Objective:
      This is the EXTENDED graphics editor. version 3
Last Changes
Aug 21, 1986 => expansion of the help feature.
Sep 26, 1986 => Addition of the CircleSegment routine. NOTE Active Color = 'E'
---*)
program GRAPHICS_EDITOR;
{$V-}    {V = avoid String Checking in passing parameters}
{$I \JOS\JOS-var.pas}

               (* Variables Used for ED-GRA *)
type
   STRING10 = STRING[10];
var
   POSI, TOPP1, TNUMBP1, ITM,
   X, Y, INCX, INCY, I, J,
   ACTIVE_COLOR, COLOR         : integer;
   HIRES_MODE, SAVE_FILE       : boolean;
   FNAME                       : STRING8;
   RESP, CH_MOVE               : char;

   { procedure to re-assign values to the variable  NUMB }
procedure ASSIGN_VALUES (SYS_NUM, SHEET_NUM, CODE : integer); begin  end;
{$I \jos\graph.p}
{$I \JOS\JOS-UTIL.PAS}
{$I \JOS\JOS-UTI2.pas}
{$I \JOS\JOS-UTI3.pas}
{$I \JOS\JOS-GRA2.PAS}

(*---   NOT VERY EFFICIENT ROUTINE IS NOT USED IN THIS FILE !!!!!!!
   Procedure to fill a square (defined by x1,y1,x2,y2) of the screen
      with a character number NCHAR.
      if MODE = 0 is TextMode and CODE = 0 -> fill character byte.
                                  CODE = 1 -> fill atribute byte.
      MODE = 1 is HiRes, coordinates in Hires: 0 <= X <= 639, 0 <= Y <= 199.
      MODE = 2 is HiRes, coordinates in TextMode: 0 <= X <= 80, 0 <= Y <= 25.
---*)

procedure CLR_AREA (X1, Y1, X2, Y2, NCHAR, MODE, CODE : INTEGER);
VAR
   X, Y  : INTEGER;
begin
   CASE MODE OF
    0 : for Y := Y1 TO Y2 do
            for X := X1 TO X2 do
               MEM [$B800:$0 + (Y-1)*160 + (X-1)*2 + CODE] := NCHAR;
    1 : for Y := Y1 TO Y2 do
            if (Y MOD 2) = 0 then     
               for X := (X1 DIV 8) TO (X2 DIV 8) do
                  MEM [$B800:$0 + (Y DIV 2)*80 + X] := NCHAR
            ELSE                      
               for X := (X1 DIV 8) TO (X2 DIV 8) do
                  MEM [$BA00:$0 + (Y DIV 2)*80 + X] := NCHAR;
    2 : begin
           Y1 := (Y1-1)*8;            Y2 := (Y2-1)*8 + 7;
           for Y := Y1 TO Y2 do
            if (Y MOD 2) = 0 then
               for X := X1 TO X2 do  begin
                  MEM [$B800:$0 + (Y DIV 2)*80 + X-1] := NCHAR;
                  MEM [$BA00:$0 + (Y DIV 2)*80 + X-1] := NCHAR;
               end;
        end;
   end;
end;

procedure CODE_WRITE;
begin
   rewrite (CODEFILE);
   for I := 1 to TOP do
      case COMM[I] of
       '*', ' ','@','#', 'T' :  writeln (CODEFILE, COMM[I], STNG[I]);
       'N'  : begin
                  write (CODEFILE, COMM[I]);
                  for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4);
                  J := PAR [I,3];
                  writeln (CODEFILE, FORMAT[J,1]:4, FORMAT[J,2]:4,' ',
                       NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]);
              end;
      else begin
              write (CODEFILE, COMM[I]);
              for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4);
              writeln (CODEFILE, ' ', STNG[i]);     end;
      end; { case }
   writeln (CODEFILE, 'Q    end of file set by EDGRA3');
   writeln (TOP:10, 'Lineas written');
   close (CODEFILE);
end;

procedure CODE_LIST;
var CH, CH2 : char;   LFR, LTO, LE, i, j : integer;
   procedure LIST;
   begin
      ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas');
      gotoxy (10,5); write ('Give starting line :');
      gotoxy (10,6); write ('Give ending line   :');
      LFR := trunc(INPUT_REAL(34,5,LFR,  1, TOP-1, 5,0, CH));
      LTO := trunc(INPUT_REAL(34,6,LTO,  LFR+1, TOP, 5,0, CH)); gotoxy(1,8);
      for I := LFR to LTO do begin
         write (i:3, ' => ');
         case COMM[I] of
          '*', ' ','@','#','Q', 'T' :  writeln (COMM[I], STNG[I]);
          'N'  : begin
                     write (COMM[I]);
                     for J := 1 to NPAR do write (PAR[I,J]:4);
                     J := PAR [I,3];
                     writeln (FORMAT[J,1]:4, FORMAT[J,2]:4,' ',
                          NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]);
                 end;
         else begin
                 write (COMM[I]);
                 for J := 1 to NPAR do write (PAR[I,J]:4);
                 writeln (' ', STNG[i]);     end;
         end; { case }
      end;
      writeln; writeln; writeln;
   end;

   procedure EDIT_L;
   begin
      CLR_LINES(23,25);
      gotoxy (1,23); write ('EDIT #',LE:4,' => ', COMM [LE]:1,' ');
      for i := 1 to NPAR do write(PAR [LE,i]:6); I := 1;
      repeat
         PAR [LE,i] := trunc(INPUT_REAL(13+6*i,23,PAR[LE,i],0,640,4,0,CH));
         i := CURSOR_MOVE (i, 1, NPAR, CH);
      until ch in [^M, ^[, ^R,^C ];
   end;

begin
   ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas');
   LE := 1; CH := ^E;   LFR := 1; LTO := TOP;
   if TOP > 0 then begin
      repeat
         if CH in [^A,^E,^R, ^Z,^X,^C] then LIST;
         gotoxy (1,24); write ('<Esc> = exit. Enter line # to edit :');
         LE := trunc(INPUT_REAL (38,24,LE, 1, TOP, 3, 0, CH));
         if CH in [^M,^A,^E,^R, ^Z,^X,^C] then EDIT_L;
      until CH = ^[;
   end;
end;

function  STAT(K : integer) : string80;
var
   NUM : array [1..npar] of string10;
   J   : integer;
begin
   if (0 < K) and (K <= TOP) then
      if COMM [K] in ['A','B','C','D','W','N'] then begin
         STR (PAR[K,1], NUM[1]);
         for j := 2 to NPAR do begin
            STR (PAR[K,J]:2, NUM[J]);  NUM[J] := CONCAT (',',NUM[J]);
         end;
         CASE COMM[K] OF
         'A':STAT:=CONCAT ('ARROW (',NUM[1],NUM[2],NUM[3],NUM[4],');');
         'B':STAT:=CONCAT ('BOX   (',NUM[1],NUM[2],NUM[3],NUM[4],');');
         'C':STAT:=CONCAT ('CIRCLE(',NUM[1],NUM[2],NUM[3],');');
         'D':STAT:=CONCAT ('DRAW  (',NUM[1],NUM[2],NUM[3],NUM[4],');');
         'W':STAT:=CONCAT ('WRS   (',NUM[1],NUM[2],',''', STNG [K],''');');
        end;
      end;
end;
                                       (*----  Make draws begin  ----*)
procedure CURSOR (COLOR : integer);
begin
   DRAW (X-5,Y-5,  X+5, Y+5, COLOR);    DRAW (X-5,Y+5, X+5,Y-5, COLOR);
   (*   DRAW (X-5, Y,   X+5, Y, COLOR);    DRAW (X,   Y-5, X  , Y+5, COLOR);*)
end;

procedure MOVE_CURSOR;
begin
   repeat
      CH_MOVE := GET_CHAR;
      case CH_MOVE of
       'X' : INCX := INCX + 1;     'x' : INCX := INCX - 1;
       'Y' : INCY := INCY + 1;     'y' : INCY := INCY - 1;
      end;
      if Upcase (CH_MOVE) in ['X','Y'] then begin
         gotoxy(16, YTEXT1); write(INCX:2);  gotoxy(22,YTEXT1); write(INCY:2);
      end;
   until CH_MOVE IN [^A,^E,^R, ^S,^D,  ^Z,^X,^C, ' '];
   CURSOR (0);
   CASE CH_MOVE OF
     ^A, ^E, ^R : Y := Y - INCY;  {UP }
     ^Z, ^X, ^C : Y := Y + INCY;  {DOWN }
     ^S : X := X - INCX;  {LEFT }
     ^D : X := X + INCX;  {RIGHT }
   end;
   CASE CH_MOVE OF
     ^A, ^Z : X := X - INCX;  {LEFT }
     ^R, ^C : X := X + INCX;  {RIGHT }
   end;
   IF X < 0 THEN X := 0;   IF X > 639 THEN X := 639;
   IF Y < 0 THEN Y := 0;   IF Y > 199 THEN Y := 199;
   IF CH_MOVE <> ' ' THEN CURSOR (1);
   gotoxy (3,YTEXT1);write(X:3);  gotoxy(9,YTEXT1);  write(Y:3);
end;

procedure COLOR_BOXES;
begin
 if not HIRES_MODE then begin
   BOX (280, YTEXT2*8-8,288,YTEXT2*8-1, 1); fillShape (284, YTEXT2*8-4,0,1);
   BOX (290, YTEXT2*8-8,298,YTEXT2*8-1, 1); fillShape (294, YTEXT2*8-4,1,1);
   BOX (300, YTEXT2*8-8,308,YTEXT2*8-1, 1); fillShape (304, YTEXT2*8-4,2,1);
   BOX (310, YTEXT2*8-8,318,YTEXT2*8-1, 1); fillShape (314, YTEXT2*8-4,3,1);
 end;
end;

procedure ASK_POSITION;
var
   CH3 : CHAR;     ST : STRING80;  TMP : REAL;
begin
   repeat
      if HIRES_MODE then
       CH3:=SCRIO_CHAR(1,YTEXT1,'<RETURN>=add line, <R>=replace, <Esc>=cancel')
      else
       CH3:=SCRIO_CHAR(1,YTEXT1,'<RET>=add, <R>eplace, <Esc>=Exit');
   until CH3 in ['R', 'I', ^M, ^[ ];
   case CH3  of
    'R' : begin
            gotoxy(1,YTEXT1); write (' ':39);
            TMP := SCRIO_REAL (1,YTEXT1,'Replace line #', 0, TOP, 3,0);
            POSI := TRUNC(TMP);
            if POSI > 0 then begin
               ST := STAT (POSI);  gotoxy (1,YTEXT1);
               write ('Replacing..<RETURN>=con.,<Esc>=Cancel');
               gotoxy (1,YTEXT3); write (ST);
               CH3 := INPUT_CHAR;
               if CH3 = ^M then begin
                  EXEC (POSI, false);
                  COMM[POSI] := COMM [TOPP1];  STNG [POSI] := STNG [TOPP1];
                  FOR I := 1 TO NPAR DO PAR[POSI,I] := PAR [TOPP1,I];
               end;
               gotoxy (1,YTEXT3); write (' ':50);
            end;
         end;
    ^M  :  begin
              TOP := TOP + 1;   { Return }
              if COMM [TOP] = 'N' then TOP_NUMB := TOP_NUMB + 1;
           end;
    ^[  :  EXEC (TOPP1, false);  { Esc }
   end {case}
end;

procedure  MAKE (CODE : char; ST_CODE : string10);
var
   LEN1, CP, TAKEN, F1, F2, F3   : integer;    EC : char;

   procedure SECOND_POINT;
   begin
      repeat
         MOVE_CURSOR;
         EXEC (TOPP1, false);
         case CODE of
          'C', 'S' :   PAR[TOPP1,3] :=
                  round( SQRT( SQR( PAR[TOPP1,1]-X ) + SQR( PAR[TOPP1,2]-Y ) ));
          'A','B','D','G' : begin
                  PAR [TOPP1,3] := X;     PAR [TOPP1,4] := Y;    end;
          'N'  : begin
                  PAR [TOPP1,1] := (X div 8)+1;   PAR [TOPP1,2] := (Y div 8)+1;
                  gotoxy (LEN1,YTEXT2);
                  write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end;
          'W' : begin
                 PAR [TOPP1,1] := X;  PAR [TOPP1,2] := Y;
                  gotoxy (LEN1,YTEXT2);
                  write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end;
         end;
         EXEC (TOPP1,true);
      until CH_MOVE = ' ';
   end;

begin
   TOPP1 := TOP + 1;
   for i := 1 to NPAR do PAR [TOPP1,I] := 0;
   STNG [TOPP1] := '';
   COMM [TOPP1] := CODE;
   PAR [TOPP1,5] := ACTIVE_COLOR;
   LEN1 := LENGTH (ST_CODE) + 1;
   case CODE of
    'W' : begin  gotoxy (1,YTEXT2);  write('String ? ');  read (STNG [TOPP1]);
            write(' Direction ?'); readln (PAR [TOPP1,3]);
            INCX := 8;   INCY := 8;  end;
    'G' : begin  gotoxy (1,YTEXT2);  write('Function # ? ');read (STNG [TOPP1]);
          end;
    'S' : begin { Circle Segment }
            gotoxy (1,YTEXT2); write ('Ang Begin & End :'); 
            readln (PAR [TOPP1,4],PAR [TOPP1,5]);
          end;
    'N' : begin
            TNUMBP1 := TOP_NUMB + 1;   gotoxy (1,YTEXT2); write (' ':40);
            gotoxy (1,YTEXT3);  write('# Pos = --    # Dec = --');
            gotoxy (1,YTEXT2);  write(' Indx = --    Value =       ');
            CP := 1;  TAKEN := 0; F1 := 2; F2 := 0; F3 := 0; NUMB[TNUMBP1] := 0;
            repeat
               case CP of
               1 : F1 := trunc(INPUT_REAL  (8,YTEXT3,F1,  1,40, 3,0,EC));
               2 : F2 := trunc(INPUT_REAL (22,YTEXT3,F2,  0, 9, 3,0,EC));
               3 : F3 := trunc(INPUT_REAL (8,YTEXT2, F3,-99,99, 3,0,EC));
               4 : numb [TNUMBP1] := INPUT_REAL (22,YTEXT2, NUMB[TNUMBP1],
                     -9.9E9, 9.9E9,F1, F2, EC);
               end;
               TAKEN := TAKEN or (1 shl (CP-1));
               CP := CURSOR_MOVE (CP, 1, 4, EC);
            until (EC = ^M) and (TAKEN = $0F);
            CLR_LINES (YTEXT2,YTEXT3);   FORMAT [TNUMBP1,1]:=F1;
            FORMAT [TNUMBP1,2]:=F2;      PAR [TOPP1,4] := F3;
            PAR [TOPP1,3] := TNUMBP1;    NUM_IDX [TNUMBP1] := TOPP1;
            X := (X div 8) * 8; Y := (Y div 8) * 8;
            INCX := 8;  INCY := 8;  end;
    'F' : begin
            COLOR_BOXES;
            gotoxy (1,YTEXT2);  write ('FillColor :','Border :':12);
            PAR [TOPP1,5]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
            PAR [TOPP1,4] := trunc (INPUT_REAL (25,YTEXT2,0,0,3,2,0,ec));
          end;
   end;
   CLR_LINES(YTEXT2,YTEXT2);   gotoxy (1,YTEXT2);   write(ST_CODE);
   CURSOR (1);
   repeat
      MOVE_CURSOR;
   until CH_MOVE = ' ';
   PAR [TOPP1,1] := X;     PAR [TOPP1,2] := Y;
   case CODE of
    'N'      : begin                   { from HIRES to TEXTMODE }
            PAR [TOPP1,1] := (X div 8)+1;   PAR [TOPP1,2] := (Y div 8)+1; end;
    'A','B','D','G' : begin
            PAR [TOPP1,3] := X;     PAR [TOPP1,4] := Y;    end;
   end;
   gotoxy (LEN1,YTEXT2); write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ',');
   CURSOR (1);
   if CODE in ['W','N'] then EXEC (TOPP1, true);
   if CODE = 'F' then begin
       CURSOR (0);  exec_all (false);
       EXEC (TOPP1, true) ; end
   else
      SECOND_POINT;
   gotoxy (LEN1 + 8,YTEXT2);  write (PAR[TOPP1,3]:3, ',',PAR[TOPP1,4]:3, ')');
   ASK_POSITION;
end;


procedure  CHNG_INPUT_AREA;
begin
   if YTEXT1 = 1 then begin   CLR_AREA (1,1, 80,3, $0, 2,0);
      YTEXT1 := 25;     YTEXT2 := 24;     YTEXT3 := 23;     YGRAPH := 180; end
   else begin  CLR_AREA (1,23, 80,25, $0, 2,0);
      YTEXT1 := 1;      YTEXT2 := 2;      YTEXT3 := 3;      YGRAPH := 20; end;
   EXEC_ALL (false);
end;

procedure PROMPED (S : STRING15);
begin
   CLR_LINES (YTEXT1, YTEXT2);
   draw (0,YGRAPH, 639,YGRAPH,1);   gotoxy (1,YTEXT1);
   write ('X=',X:3,' Y=',Y:3,' Ix=',INCX:2,' IY=',INCY:2,' # S=',TOP:3);
   gotoxy (1,YTEXT2); write ( S );
end;

procedure HELP;
var BUFFER : array [1..16287] of byte;

   procedure HELP_CTRL (PAGE : integer);
   var  CH : char;   code : integer;
   begin
      repeat
         clrscr;  gotoxy (1,1); write ('Page:', (PAGE-1):3);
         display_page (PAGE,0,0);
         gotoxy (1,24); write ('<Esc> = Exit, (1-5) = Help page #');
         CH := GET_CHAR;
         if CH in ['1'..'5'] then
            begin Val (CH,page,code); page := page + 1;  end;
      until CH in [^[, ^M];
   end;

begin
   if SCR_MODE < 4  then
      HELP_CTRL (2)
   else begin
      if HIRES_MODE then
         GetPic (BUFFER, 0,0,639, 199) else GetPic (BUFFER, 0,0,319, 199);
      TextMode;    HELP_CTRL (2);
      if HIRES_MODE then  HiRes  else GraphColorMode;
      PutPic (BUFFER, 0,199);
   end;
end;

{   ========================== }

procedure SETP (CODE : char; ST_CODE : string10);
var    EC : char;
begin
   gotoxy (1,YTEXT2); write (ST_CODE);
   case CODE of
    'C' : begin
            COLOR_BOXES;
            ACTIVE_COLOR:=trunc(INPUT_REAL(16,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
          end;
    'P' : begin
            TOPP1 := TOP + 1;
            for i := 1 to NPAR do PAR [TOPP1,i] := 0;   STNG [TOPP1] := '';
            COMM [TOPP1] := 'P';
            PAR [TOPP1,1]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
            exec (TOPP1, true);
            ASK_POSITION;
          end;
    '@','#','T' : begin
            TOP := TOP + 1;
            for i := 1 to NPAR do PAR [TOP,i] := 0;   COMM [TOP] := CODE;
            read (STNG [TOP] );
          end;
   end;
end;

procedure EDIT;
var   SW_EXIT, SW_MODE, SW_CARD  : boolean;    PROM_STR : STRING15;
begin
   clrscr;
   if SCRIO_CHAR (30, 12, 'Hires or Graphics mode ? (H/G)') = 'H' then begin
      HIRES_MODE := true; hires;     hirescolor (1);    X := 320;    end
   else begin
      HIRES_MODE := false; graphColorMode;      X := 160;
   end;
   SW_MODE := false;  PROM_STR := 'COMMAND ?';
   if SW_CARD  then begin
      fillchar ( mem[$BC00:0], 16384, 0 );         { see NOTE 1 }
      port [$3D9] := 32;    PORT [$3DD] := 32;
   end;
   Y := 100;  INCX := 8;  INCY := 5;    SW_EXIT := false;
   YTEXT1 := 25;     YTEXT2 := 24;   YTEXT3 := 23; YGRAPH := 180;
   ACTIVE_COLOR := 1;
   EXEC_ALL (FALSE);
   repeat
       PROMPED ( PROM_STR );
       RESP := Upcase (INPUT_CHAR);
       if SW_MODE and (RESP in ['A'..'Z']) then SAVE_FILE := true;
       if SW_MODE then
         CASE RESP OF
          'A' : MAKE ('A', 'ARROW (');
          'B' : MAKE ('B', 'BOX (');
          'C' : MAKE ('C', 'CIRCLE (');
          'S' : MAKE ('S', 'CircSeg (');
          'D' : MAKE ('D', 'DRAW (');
          'G' : MAKE ('G', 'GRAPH (');
          'N' : MAKE ('N', 'NUMBER (');
          'W' : MAKE ('W', 'write (');
          'F' : MAKE ('F', 'Fill (');
{????}    'E' : SETP ('C', 'Active-color :');
          'P' : SETP ('P', 'Pallete :');
          '@' : SETP ('@', '@ Segment Comment :');
          '#' : SETP ('#', '# End Seg.Comment :');
          'T' : SETP ('T', 'T title   Comment :');
          '?' : HELP;
          ^[  : begin PROM_STR := 'COMMAND ?';  SW_MODE := false; end;
         else  write (^G);
         end
       else
         CASE UPCASE(RESP) OF
          'P' : begin CLR_AREA (0,0, 639,199,$0,1,0); EXEC_ALL (TRUE);
                  readln(KBD);  end;
          'R' : EXEC_ALL (FALSE);
          'S' : begin   CODE_WRITE;    SAVE_FILE := false;  end;
          'I' : CHNG_INPUT_AREA;
          '?' : HELP;
          'K' : begin graphWindow (20,20,50,50);
                READLN (I);  HIRESCOLOR (I);  end;
          'D' : begin PROM_STR := 'DRAWING ?';  SW_MODE := true; end;
          ^[  : SW_EXIT := true;
         else  write (^G);
       end;
   until SW_EXIT;
   textmode;
end;

function CHECK_SAVE : boolean;
begin
   gotoxy (5,25); write (^g, ^g, 'The file in memory :',CODE_in_MEM,
   'has not been saved, SAVE IT ? (Y/N)');
   repeat
      RESP := Upcase (INPUT_CHAR);
   until RESP in ['Y','N'];
   CHECK_SAVE := (RESP = 'Y');
end;

procedure NO_DEF;
begin
   gotoxy (10,22);   writeln ('There in NO file name defined', ^G, ^G);
   writeln ('Use the CREATE, LOAD or RENAME options to define a name');
   readln;
end;

procedure GET_FN;
begin
   write ('The existing file names are:':53);
   LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP);
   gotoxy (20,21);  write ('Give NEW File Name (w/o ext.) ?:');
   read (FNAME);
   if FNAME <> '' then begin
      CFNAME := FNAME + '.cod';
      CODE_in_MEM := CFNAME;
      assign (CODEFILE, CFNAME);
   end;
end;

begin { MAIN }
{   for i := 1 to NLIM do STNG [i] := ''; }
   TOP := 0; SW_CARD := True;  SAVE_FILE := false;

   CODE_in_MEM := '-none-';
   READ_SCREENS ('EDGRA.men');     ITM := 1;
   repeat
      DISPLAY_PAGE (1, 0, 1);
      gotoxy (28,3); write (DefaultDrive);
      gotoxy (28,4); write (CODE_in_MEM);
      ITM := CHOOSE_LINES (1, ITM, 10, 0);
      case ITM of
        1 : HELP;
{ed}    2 : if CODE_in_MEM = '-none-' then NO_DEF else EDIT;
{Run}   3 : if CODE_in_MEM = '-none-' then NO_DEF else begin
               SW_COLOR := true;    SW_CARD := true;
               HIRES_MODE := true;  INCX := 2;
               RUN_GRAFI (CFNAME, INCX, resp, 0, 0);
            end;
{List}  4 : if CODE_in_MEM = '-none-' then NO_DEF else CODE_LIST;
{Crea}  5 : begin
               if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;
               ClrScr; writeln ('C R E A T E':45);
               GET_FN;
               if FNAME <> '' then begin
                  TOP := 0;  TOP_SEGMENT := 0;  TOP_NUMB := 0; end
            end;
{Load}  6 : begin
               if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;
               ClrScr;
               LIST_GET_FILEN ('G', '????????.cod-', FNAME, RESP);
               if RESP <> ^[ then begin
                  CFNAME := FNAME + '.cod';
                  CODE_in_MEM := CFNAME;
                  assign (CODEFILE, CFNAME);
                  CODE_READ;
               end;
            end;
{Save}  7 : if CODE_in_MEM = '-none-' then NO_DEF else begin
               CODE_WRITE;
               SAVE_FILE := false;
            end;

        8 : begin ClrScr; writeln ('R E N A M E':45);
               GET_FN;
           end;
        9 : SET_DRIVE ( SCRIO_CHAR (10, 21,'Enter new drive') );
       10 : begin ClrScr; LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP);
           end;
      end;
   until ITM = 0;
   if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;  CLRSCR;
end.


        '@'     : begin                           { Define Segment }
                     if TOP_SEGMENT >= TOPSEG_LIM then  ERROR (3)
                     else begin
                        TOP_SEGMENT := TOP_SEGMENT + 1;
                        COLOR_SEG [TOP_SEGMENT,1] := TOP + 1;  { begin_line }
                        COLOR_SEG [TOP_SEGMENT,2] := 0;        { end_line }
                        if TOP_SEGMENT > 1 then
                           COLOR_SEG [TOP_SEGMENT-1,2] := TOP - 1; { end_line }
                        read (CODEFILE, STNG[TOP]);
                     end;
                  end;
        '#'     : if TOP_SEGMENT > 0 then
                           COLOR_SEG [TOP_SEGMENT,2] := TOP - 1; { end_line }

        'T'     : begin TITLE_SEG [1] := TOP + 1;                { Tiles !! }
                        read (CODEFILE, STNG[TOP]);  end;

        'Q'     : begin                                          { End Ploting }
                  TOP := TOP - 1;  { Do NOT keep Q }
                  if (TOP_SEGMENT > 0) and (COLOR_SEG [TOP_SEGMENT,2] = 0) then
                           COLOR_SEG [TOP_SEGMENT,2] := TOP; { end_line }
                  TITLE_SEG [2] := TOP;
                  end;


