program Sketch;  { 2/13/86    version 1.0 }

{  Program to draw lines and pixels and video attributes of characters }
{  on Kaypro '84 series CP/M computers with graphics.                  }

{  Written with Turbo Pascal Version 2                     }
{  By Eric Mausolf, Seattle, Washington.                   }

var
  Ch, Mode       : Char;
  V, H, VM, HM, code   : Integer;
  X              : Byte;

const
   HiBound        = 36;
   LoBound        = 131;
   RightBound     = 191;
   LeftBound      = 32;

Type
   String3 = String[3];

        { procedures to access Kaypro graphics }
procedure CursOn;     begin write(#27,'B4'); end;
procedure CursOff;    begin write(#27,'C4'); end;
procedure Gray;       begin write(#27,'B0',#27,'B1'); end;
procedure UnGray;     begin write(#27,'C0',#27,'C1'); end;
procedure Blink;      begin write(#27,'B2'); end;
procedure UnBlink;    begin write(#27,'C2'); end;
procedure Score;      begin write(#27,'B3'); end;
procedure UnScore;    begin write(#27,'C3'); end;
procedure Invert;     begin write(#27,'B0'); end;
procedure UnInvert;   begin write(#27,'C0'); end;
procedure Dim;        begin write(#27,'B1'); end;
procedure UnDim;      begin write(#27,'C1'); end;
procedure Normal;     begin UnGray;UnBlink;UnScore; end;
procedure Draw(V1,H1,V2,H2 : Byte);
   begin  write(#27,'L',chr(V1),chr(H1),chr(V2),chr(H2)); end;
procedure UnDraw(V1,H1,V2,H2 : Byte);
   begin  write(#27,'D',chr(V1),chr(H1),chr(V2),chr(H2)); end;

{$I Greet.mod}

procedure PixOn;  {write pixel at current position}
 begin      write(#27,'*',chr(V),chr(H));   end;

procedure PixOff;  {erase pixel at current position}
 begin      write(#27,' ',chr(V),chr(H));   end;

procedure StartMessage; { move cursor to message area }
 begin  GotoXY(50,1);  end;

procedure EraseMessage; { erase message at end of status line }
 begin
   Gray;
   StartMessage; write('                               ');
   unGray;
 end;

procedure GetChar(var answer : Char);
begin
  Read(kbd,answer);
  answer := UpCase(answer);
end;


Procedure ModeShow;
begin  Gray;
  GotoXY(9,1);
  Case Mode of
   'E' : write('Erase');
   'D' : write('Draw ');
  end;  UnGray;
end;

procedure VectShow;
begin  Gray;
  GotoXY(26,1); If mode = 'W' then write(H,' ') else write(V,' ');
  GotoXY(41,1); If mode = 'W' then write(V,' ') else write(H,' ');
  UnGray;
end;


procedure MemShow;  { show memory setting if it has been set yet }
begin
  EraseMessage; startmessage;
  If Mode <> 'W' then begin
     Gray;
     if HM = 0 then  write('    Press H for Help')
     else  write('    Mem: ',VM,'  /  ',HM);  UnGray;
  end;
end;


procedure Grayline;
begin
  GotoXY(1,1); Gray;
  for X := 1 to 80 do write(' ');
  GotoXY(1,1); UnGray;
end;


procedure StatLine;   { WRITE STATUS LINE }
begin
  Grayline; Gray;
  GotoXY(3,1);  write('Mode: ');
  GotoXY(20,1); If Mode = 'W' then write('   X: ') else write('Vert: ');
  GotoXY(34,1); If Mode = 'W' then write('    Y: ') else write('Horiz: ');
  If mode = 'W' then begin
     StartMessage; write(' Press <ESC> for options');
  end;
  ModeShow;
  VectShow;
  MemShow;
end;


procedure Help;
var Choose , press : char;
begin
  PixOn;       { keep cursor showing }
  choose := ' ';
  Grayline; Ungray;invert; write(' HELP ');Gray;
  write('  Describe which command?  E, D, Q, M, R, L, N, C, J, P, W, <ESC> to skip ');
  repeat
     GetChar(choose);
  until choose in ['E','D','Q','M','R','L','N','C','J','P','W',#27];
  Grayline;Gray;
  case choose of
   'E' : write(' E: Set cursor keys and functions to Erase (move w/o drawing).');
   'D' : write(' D: Set cursor keys and functions to Draw.');
   'Q' : write(' Q: Quit to system.');
   'M' : write(' M: Store current cursor position in Memory for use with R and L.');
   'R' : write(' R: Return cursor to position stored in Memory.');
   'L' : write(' L: Draw or Erase a Line to position stored in Memory.');
   'N' : write(' N: Clear Screen, retaining current Memory setting.');
   'J' : write(' J: Jump to position you specify (answer prompts).');
   'P' : write(' P: Draw or Erase line to position you specify (answer prompts).');
   'C' : write(' C: Draw or Erase circle of specified radius from cursor.');
   'W' : write(' W: Go into Write mode to write characters to the screen.');
  end;
  if choose <> #27 then begin
     repeat
       GotoXY(68,1);  write('Press <ESC>'); UnGray;
       GetChar(press);
     until press in [#27];
  end;
  Statline;
end;


procedure NewScreen;  { clear the screen, re-do status line }
begin
  ClrScr;
  StatLine;
end;


procedure Memory; { Memory function }
begin
  VM := V;
  HM := H;
  MemShow;
end;


procedure Line; { Line function to draw line from cursor to }
begin                          { coordinates in memory      }
 if  VM > 0 then
   Case Mode of
     'D' : Draw(V,H,VM,HM);
     'E' : UnDraw(V,H,VM,HM);
   end;
end;

procedure Return;  { function to return cursor to coordinates in memory }
begin
 if  VM > 0 then
   begin
     if Mode = 'E' then PixOff;  { to erase old cursor }
     V := VM;  H := HM;
     VectShow;
   end;
end;


procedure Circle;        { draw and erase circles }
var  Step  :  Real;
    VO, HO,  VN, HN, Radius      : Integer;
    RadiusStr: String3;
begin
    PixOn;  { preserve cursor }
    Repeat
       EraseMessage; StartMessage; Gray; write('    C: Radius = ');
       Read(RadiusStr);
       Val(RadiusStr, Radius,Code); If code <>0 then write(^G);
    Until Code = 0;
   UnGray;
   Step := 0.3;
   HO := H + Radius;  VO := V;
   for X := 1 to 21 do begin
      HN := Trunc(Radius * Cos(step) + H) ;
      VN := Trunc(- Radius * Sin(Step) + V);
      If Mode = 'D' then Draw(VO,HO, VN,HN)
          else UnDraw(VO,HO,VN,HN);
      HO := HN ; VO := VN;
      step := step + 0.3;
   end;
   MemShow;
end;

procedure Plot;
var OK  :  Boolean;   VN, HN,Code : Integer;
           VNStr, HNStr: String3;
begin
  PixOn;  { preserve cursor }
    Repeat
      Gray;
      StartMessage; write('P: Vertical Coord. = ');
      Read(VNStr); Val(VNstr,VN, Code);
      If not ((code = 0) and ( VN in [HiBound..LoBound] )) then write(^G);
      EraseMessage;
    Until (Code = 0) and ( VN in [HiBound..LoBound] ) ;
    Repeat
       StartMessage; Gray; write('P: Horizontal Coord. = ');
       Read(HNStr); Val(HNStr,HN,Code);
       If not ((code= 0) and (HN in [leftbound..rightbound]))then write(^G);
       EraseMessage;
   Until (Code =0) and (HN in [leftbound..rightbound]);
  EraseMessage; UnGray;
  Case Mode of
     'D' : Draw(V,H,VN,HN);
     'E' : UnDraw(V,H,VN,HN);
    end;
  MemShow;
end;


procedure Jump;
var  VN, HN,Code : Integer;
           VNStr, HNStr: String3;
begin
  PixOn;  { preserve cursor }
    Repeat
      Gray;
      StartMessage; write('J: Vertical Coord. = ');
      Read(VNStr); Val(VNstr,VN, Code);
      If not ((code = 0) and (VN in [hibound..lobound])) then write(^G);
      EraseMessage;
    Until (Code = 0) and ( VN in [HiBound..LoBound] ) ;
    Repeat
       StartMessage; Gray; write('J: Horizontal Coord. = ');
       Read(HNStr); Val(HNStr,HN,Code);
       If not ((code = 0) and (HN in [leftbound..rightbound])) then write(^G);
       EraseMessage;
   Until (Code =0) and (HN in [leftbound..rightbound]);
   EraseMessage; UnGray;
   if Mode = 'E' then PixOff;          { erase old cursor }
   V := VN; H := HN;
  VectShow;
  MemShow;
end;


procedure CursGen;  { Generates Blinking cursor, waits for input, }
begin               { Controls drawing functions                  }
 repeat
     delay(10);                              { This loop generates a blinking }
     if Mode = 'E' then PixOn else PixOff;   { cursor and leaves the pixel    }
     delay(10);                              { either on or off, depending on }
     if Mode = 'E' then PixOff else PixOn;   { Mode.  It generates the graph- }
 until KeyPressed;                           { ics controlled by cursor keys. }
    GetChar(Ch);
    Case Ch of
      'L' :  Line;               { Jump to various procedures }
      'M' :  Memory;             { that control functions.    }
      'P' :  Plot;
      'J' :  Jump;
      'R' :  Return;
      'C' :  Circle;
      'H' :  Help;
      'N' :  NewScreen;
    end; { of case }
 end;

procedure KeyFind;         { Determine what valid key was pressed }
begin
  Case Ch of
     ^E :  V := V - 1;
     ^X :  V := V + 1;
     ^S :  H := H - 1;
     ^D :  H := H + 1;
     'E' :  Mode := 'E';
     'D' :  Mode := 'D';
     'Q' :  Mode := 'Q';
     'W' :  Mode := 'W';
   end;  {of case statement}
      if V > LoBound    then V := LoBound;       { Keep cursor from     }
      if V < HiBound    then V := HiBound;       { exceeding boundaries }
      if H > RightBound then H := RightBound;
     if H < LeftBound  then H := LeftBound;
end;


procedure EraseMode;
begin
  Repeat                            { Until new mode requested }
    Repeat                             { Until acceptable answer gotten }
      CursGen;
    Until Ch in [^E,^X,^S,^D,'D','Q','W'];    { repeat return }
     KeyFind;
     VectShow;
  Until Mode in ['D','Q','W'];                { loop unless mode change }
  if Mode = 'D' then  ModeShow;
end;

procedure DrawMode;
begin
  Repeat                             { Until new mode requested }
    Repeat                           { Until acceptable answer gotten }
      CursGen;
    Until Ch in [^E,^X,^S,^D,'E','Q','W'];    { repeat return }
    KeyFind;
    VectShow;
  Until Mode in ['E','Q','W'];                { loop unless mode change }
  if Mode = 'E' then ModeShow;
end;

Procedure CoordShow(Xc,Yc: Integer);  { show coordinates in write mode }
begin
   Gray;
   GotoXY(26,1); write(Xc,'  ');
   GotoXY(41,1); write(Yc,'  ');
   ungray;
end;

Procedure writeshow;
begin
   Gray; GotoXY(1,1);
   write('  Mode: Write         X:             Y:           Press <ESC> for options   ');
   UnGray;
end;


procedure WriteMode;
   Var
      WChar, AttChar, OldMode  : Char;
      DimAtt,BlinkAtt, ScoreAtt,InvertAtt,GrayAtt : Boolean;

   Const
      Xcoord : Integer = 30;
      Ycoord : Integer = 15;

BEGIN
   Wchar := '*'; AttChar := '*';
   DimAtt := False; BlinkAtt := False; ScoreAtt := False;
   InvertAtt := False; GrayAtt := False;
   writeshow; CoordShow(Xcoord,Ycoord);
   GotoXY(Xcoord,Ycoord);
   CursOn;
   Repeat
     Read(kbd,WChar);
     Case WChar of
       ^S : Xcoord := Xcoord - 1;
       ^H : Xcoord := Xcoord - 1;
       ^D : Xcoord := Xcoord + 1;
       ^E : Ycoord := Ycoord - 1;
       ^X : Ycoord := Ycoord + 1;
      #127:  begin
               Xcoord := Xcoord - 1;
               GotoXY(Xcoord,Ycoord);
               Write(' ');
               GotoXY(Xcoord,Ycoord);
            end;
       else if Xcoord = 80 then Xcoord := 79;
     end;  { of case }
     If Xcoord < 1 then Xcoord :=1;
     If Ycoord < 2 then Ycoord := 2;
     If Xcoord > 80 then Xcoord := 80;
     If Ycoord > 25 then Ycoord := 25;
     {If (Wchar = ' ') and (Xcoord = 80) then Xcoord := 79;}
     if WChar = #27 then begin      {Options section}
       CursOff; Grayline; Gray;
       Write(' <D>im, <B>link, <U>nderline, <W>hite, <G>ray, <N>ormal, <ESC> change Mode');
       Repeat
         Read(kbd,AttChar); AttChar := UpCase(AttChar);
       Until AttChar in ['D','B','U','W','G','N',#27];
       Case Attchar of
          'D' : DimAtt    := True;
          'B' : BlinkAtt  := True;
          'U' : ScoreAtt  := True;
          'W' : InvertAtt := True;
          'G' : GrayAtt   := True;
          'N' : begin
                   DimAtt := False; BlinkAtt := False; ScoreAtt := False;
                   InvertAtt := False; GrayAtt := False;
                end;
         end;            {of case}
       Writeshow;
       CoordShow(Xcoord,Ycoord); GotoXY(Xcoord,YCoord); CursOn;
     end;                                         {of options section}
       if not (WChar in [^S,^X,^D,^E,^H,#27,#127]) then begin
         if DimAtt    = True then Dim;
         if BlinkAtt  = True then Blink;
         if ScoreAtt  = True then Score;
         if InvertAtt = True then Invert;
         if GrayAtt   = True then Gray;
         write(Wchar);
         Xcoord := Xcoord + 1; Normal
      end;
      CoordShow(xCoord,Ycoord); GotoXY(Xcoord,Ycoord); CursOn;
   Until AttChar = #27;
   Mode := 'E';
   CursOff; Statline;
END;



begin                            { MAIN BLOCK }
  CursOff;
  open;
    V := 82; H:= 112;
    VM := 0; HM := 0;
    ClrScr;
    Mode := 'E';
    Statline;
      While Mode <> 'Q' do       { Main Loop }
         begin Case Mode of
            'E' : EraseMode;
            'D' : DrawMode;
            'W' : WriteMode;
         end;
      end;
  ClrScr;CursOn;
end.