program graphicsOnOkidata;
{(c) 1984 by Neil J. Rubenking}
var
  ToggleByte     : byte absolute $40:$17;
  ScrollLock     : byte;
  BigRow, BigCol,        {BigRow & LastRow go from 1 to 55 by threes}
  LastRow, LastCol,      {BigCol & LastCol go from 1 to 561 by forties}
  rows,cols,
  ScreenSeg      : integer;
  up, color      : boolean;
  Key1,Key2      : char;
  ScreenDots     : array[1..42] of array[1..80] of boolean;
  Graffix        : array[1..60] of array[1..640] of byte;
  PosX, PosY     : integer;
  GrafxFile      : text;
  GrafxFileName  : string[14];
  BlankLine      : string[79];
{============================================================================}
function ReadScreen(col,row:byte):char;
var
  LocationCode : integer;
  begin
    LocationCode := (col-1)*2 + (row-1)*160;
    ReadScreen   := chr(Mem[ScreenSeg:LocationCode]);
  end;
{============================================================================}
procedure WriteScrn(col, row: byte; thisChar:char);
var
  LocationCode : integer;
begin
  LocationCode := (col-1)*2 + (row-1)*160;
  Mem[ScreenSeg:locationCode] := ord(ThisChar);
end;
{============================================================================}
procedure blankScreen;
var
  LocationCode : integer;
  col, row     : byte;
begin
  for col := 1 to 80 do
    begin
      for row := 1 to 21 do
        begin
          LocationCode := (col-1)*2 + (row-1)*160;
          Mem[ScreenSeg:locationCode] := 32;      { a blank }
          Mem[ScreenSeg:locationCode+1] := 112;
        end;
    end;
end;
{============================================================================}
{This procedure takes the array "GRAFFIX", which contains the graphics printer
codes, and converts it into an array that can be shown on the screen       }

procedure MakeScreen(bigCol,bigRow:integer);
var
  thisByte,
  bits      : byte;
  M, N      : integer;
  thisChar  : char;
begin
  for M := BigCol to BigCol + 79 do
    begin
      for N := BigRow to BigRow + 5 do
        begin
        thisByte := Graffix[N][M];
        for bits := 1 to 7 do
          begin
            if odd(thisbyte) then
               screenDots[(N-BigRow)*7 + bits][M-BigCol+1] := true
            else
               screenDots[(N-BigRow)*7 + bits][M-BigCol+1] := false;
            thisByte := thisByte div 2;
          end;  {for bits}
        end;  {for N := 1 to 6}
      for N := 1 to 21 do
        begin
          if screenDots[2*N-1][M-BigCol+1] then
            begin
              if screenDots[2*N][M-BigCol+1] then
                begin
                  ThisChar := 'Û';
                end
              else ThisChar := 'ß'
            end
          else
            begin
              if screenDots[2*N][M-BigCol+1] then
                begin
                  ThisChar := 'Ü';
                end
              else ThisChar := ' ';
            end;
          writeScrn((M-BigCol+1),N,thisChar);
        end;  {for N := 1 to 21}
    end;   {for M}
end;   {procedure}
{============================================================================}
{Converts the current screen into printer graphics codes}
procedure SaveScreen;
var
  dotPos, chNum, doubler : byte;
  N, M                   : integer;
begin
  for M := 1 to 80 do
    begin
      for N := 1 to 21 do
        begin
          case ReadScreen(M,N) of
               'ß': begin
                      ScreenDots[(N*2)-1][M] := true;
                      ScreenDots[(N*2)][M] := false;
                    end;
               'Ü': begin
                      ScreenDots[(N*2)-1][M] := false;
                      ScreenDots[(N*2)][M] := true;
                    end;
               ' ': begin
                      ScreenDots[(N*2)-1][M] := false;
                      ScreenDots[(N*2)][M] := false;
                    end;
               'Û': begin
                      ScreenDots[(N*2)-1][M] := true;
                      ScreenDots[(N*2)][M] := true;
                    end;
          end;  {case}
        end;  {for N := 1 to 21}
      for N := 1 to 6 do
        begin
          doubler := 1;
          chNum   := 0;
          for dotPos := 1 to 7 do
            begin
              if ScreenDots[7*(N-1)+dotPos][M] then chNum := chNum + doubler;
              doubler := 2*doubler;
            end;
          Graffix[N+BigRow-1][M+BigCol-1] := chNum;
        end;  {for N := 1 to 6}
    end;    {for M := 1 to 80}
end;
{============================================================================}
{Prints to either Printer or file--the printer can qualify as a "text file"  }
procedure doPrint(var which:text);
var
  N, M: byte;
begin
  write(which,chr(3));                {turn on graphics}
  for N := 1 to LastRow + 5 do
    begin
      for M := 1 to LastCol + 79 do
        begin
          write(which,chr(Graffix[N][M]));                 {in order to print}
          if Graffix[N][M] = 3 then write(which,chr(3));  {chr(3) you must  }
        end;   {for M}                                     {print it twice   }
      Write(which, chr(3),chr(14));    {end of graphics line code}
    end;  {for N}
  write(which,chr(3),chr(2));          {turn off graphics}
end;
{============================================================================}
procedure PrintInstructions;
begin
  GotoXY(1,23);
  writeln(BlankLine);
  write(BlankLine);
  gotoXY(1,23);
   Write('F1=set  F2=erase  F3=save/print  F4=retrieve  F7=start over  ');
   WriteLn('F9=blank  F10=end');
   Write('Ctrl-left, right, PgUp, PgDn move "window".  ');
 WriteLn('Ctrl-home & end go to extremes.  ');
end;
{============================================================================}
procedure cursorSet(mode : char);
type
  regpack = record
              ax,bx,cx,dx,bp,di,si,ds,es,flags: integer;
            end;

var
  recpack:          regpack;             {assign record}
  ah,al,ch,cl,dh:   byte;

begin
  ah := 1;
  if color then
    case mode of
      'h': begin ; ch := 0 ; cl := 3 ; end;
      'l': begin ; ch := 4 ; cl := 7 ; end;
      'n': begin ; ch := 6 ; cl := 7 ; end;
    end
  else
      case mode of
      'h': begin ; ch := 0 ; cl := 6 ; end;
      'l': begin ; ch := 7 ; cl := 13 ; end;
      'n': begin ; ch := 12 ; cl := 13 ; end;
    end;
  with recpack do
  begin
    ax := ah shl 8;
    cx := ch shl 8 + cl;
  end;
  intr($10,recpack);                     {call interrupt}
end;
{============================================================================}
procedure AskPrint;
var
  pick : char;
  SaveX,SaveY : byte;
begin
  SaveX := WhereX;
  SaveY := WhereY;
  CursorSet('n');
  window(1,1,80,25);
  gotoXY(1,23);
  writeln(BlankLine);
  write(BlankLine);
  gotoXY(1,23);
  Write('P for Printer, F for File: ');
  repeat
    read(pick);
    write(chr(8));
    until UpCase(pick) in ['P','F'];
  if UpCase(pick) = 'P' then DoPrint(Lst)
  else
    begin
      gotoXY(1,23);
      write('Enter FileName--no  extension.');
      read(GrafxFileName);
      GrafxFileName :=  GrafxFileName + '.OKI';
      Assign(GrafxFile, GrafxFileName);
      rewrite(GrafxFile);
      DoPrint(GrafxFile);
      close(GrafxFile);
    end;
  PrintInstructions;
  window(1,1,80,22);
  GotoXY(SaveX,SaveY);
  if up then CursorSet('h') else CursorSet('l');
end;
{============================================================================}
procedure initialize;
begin
  IF (Mem[0000:1040] AND 48) <> 48 THEN
    begin
      ScreenSeg := $B800;
      color     := true;
    end
   ELSE
     begin
       ScreenSeg := $B000;
       color     := false;
     end;
   window(1,1,80,25);
   textcolor(black);
   textBackground(white);
   GotoXY(1,23);
   Write('I N I T I A L I Z I N G . . . .');
   BlankScreen;
   for rows := 1 to 60 do
     for cols := 1 to 640 do
       Graffix[rows][cols] := 0;
   printInstructions;
   window(1,1,80,22);
   BlankLine := '                                       ';
   BlankLine := BlankLine + BlankLine;
   gotoXY(1,1);
   up := true;
   BigRow := 1;
   LastRow := 1;
   BigCol := 1;
   LastCol := 1;
   CursorSet('h');
end;
{============================================================================}
procedure DoRetrieve(var ThisFile : text);
var
  This, Next, ThrowOut : char;
  row         : byte;
  MaxCol, col : integer;
begin
  initialize;
  row := 1;
  col := 1;
  this := chr(0);
  next := chr(0);
  reset(ThisFile);
  read(ThisFile,ThrowOut);
  while not EOF(ThisFile) do
    begin
      read(ThisFile,this);
      if this = chr(3) then
        begin
          read(ThisFile,next);
          case ord(Next) of
              3: begin
                   Graffix[row][col] := ord(this);
                   col := col + 1;
                 end;
             14: begin
                   row := row + 1;
                   col := 1;
                 end;
              2: ;
          else
            Graffix[row][col] := ord(this);
            col := col + 1;
            Graffix[row][col] := ord(next);
            col := col + 1;
          end;  {case}
        end    {if}
      else
        begin
          Graffix[row][col] := ord(this);
          col := col + 1;
        end;
      if col > MaxCol then MaxCol := col;
    end;  {while}
  LastRow := row - 5;
  LastCol := MaxCol - 79;
  close(Thisfile);
  MakeScreen(BigCol,BigRow);
  window(1,1,80,25);
  PrintInstructions;
  window(1,1,80,22);
  gotoXY(1,1);
  up := true;
  CursorSet('h');
end;
{============================================================================}
procedure AskRetrieve;
begin
  CursorSet('n');
  window(1,1,80,25);
  gotoXY(1,23);
  writeln(BlankLine);
  write(BlankLine);
  gotoXY(1,23);
  WriteLn('Enter FileName--no extension: ');
  read(GrafxFileName);
  GrafxFileName := GrafxFileName + '.OKI';
  Assign(GrafxFile,GrafxFileName);
  DoRetrieve(GrafxFile);
end;
{============================================================================}
procedure DoInsert;   {Not yet implemented}
begin
end;
{============================================================================}
procedure TakeOrders;
     {--------------------------------------}
     procedure GoUp;
     begin
       if not up then
         begin
           up := true;
           CursorSet('h');
         end
       else
         if WhereY > 1 then
           begin
             up := false;
             CursorSet('l');
             GotoXY(WhereX,WhereY-1);
           end
         else
           begin
             up := false;
             CursorSet('l');
             GotoXY(WhereX,21);
           end;
     end;
     {--------------------------------------}
     procedure GoDown;
     begin
       if  up then
         begin
           up := false;
           CursorSet('l');
         end
       else
         if WhereY < 21 then
           begin
             up := true;
             CursorSet('h');
             GotoXY(WhereX,WhereY+1);
           end
         else
           begin
             up := true;
             CursorSet('h');
             GotoXY(WhereX,1);
           end;
     end;
     {--------------------------------------}
     procedure GoLeft;
     begin
       if WhereX > 1 then gotoXY(WhereX-1,WhereY) else gotoXY(80,WhereY);
     end;
     {--------------------------------------}
     procedure GoRight;
     begin
       if WhereX < 80 then GotoXY(WhereX+1,WhereY) else gotoXY(1,WhereY);
     end;
     {--------------------------------------}
     procedure WriteADot;
     begin
       if up then
         begin
           if ReadScreen(WhereX,WhereY) = 'Ü' then writeScrn(WhereX,WhereY,'Û')
              else writeScrn(WhereX,WhereY,'ß'); {if low then whl else high}
         end
       else
         begin
           if ReadScreen(WhereX,WhereY) = 'ß' then writeScrn(WhereX,WhereY,'Û')
             else writeScrn(WhereX,WhereY,'Ü');{if high then whl else low}
         end;
     end;
     {--------------------------------------}
     procedure EraseADot;
     begin
     if up then
       begin
         if ReadScreen(WhereX,WhereY) = 'Û' then writeScrn(WhereX,WhereY,'Ü')
           else writeScrn(WhereX,WhereY,' ');
       end                        {if whl then low else space}
     else
       begin
         if ReadScreen(WhereX,WhereY) = 'Û' then writeScrn(WhereX,WhereY,'ß')
           else writeScrn(WhereX,WhereY,' ');
       end;                       {if whl then high else space}
     end;
     {--------------------------------------}

begin
  repeat until keypressed;
  read(Kbd,Key1);
  if Key1 = chr(27) then
    begin
      read(Kbd,Key2);
      case Key2 of
      {home}   'G': begin
                      if ScrollLock = 16 then WriteADot;
                      GoUp;
                      GoLeft;
                    end;
      {up}     'H': begin
                      if ScrollLock = 16 then WriteADot;
                      GoUp;
                    end;
      {PgUp}   'I': begin
                      if ScrollLock = 16 then WriteADot;
                      GoUp;
                      GoRight;
                    end;
      {left}   'K': begin
                      if ScrollLock = 16 then WriteADot;
                      GoLeft;
                    end;
      {right}  'M': begin
                      if ScrollLock = 16 then WriteADot;
                      GoRight;
                    end;
      {end}    'O': begin
                      if ScrollLock = 16 then WriteADot;
                      GoDown;
                      GoLeft;
                    end;
      {down}   'P': begin
                      if ScrollLock = 16 then WriteADot;
                      GoDown;
                    end;
      {PgDn}   'Q': begin
                      if ScrollLock = 16 then WriteADot;
                      GoDown;
                      GoRight;
                    end;
   {Ctrl-home} 'w': begin           {goes to top right of "Big Picture"}
                      SaveScreen;
                      BigRow := 1;
                      BigCol := 1;
                      MakeScreen(BigCol,BigRow);
                      GotoXY(1,1);
                      up := true;
                      CursorSet('h');
                    end;   {ctrl-home}
   {Ctrl-PgDn} 'v': if BigRow < 55 then  {moves "window" down « screen}
                      begin
                        SaveScreen;
                        BlankScreen;
                        BigRow := BigRow + 3;
                        if LastRow < BigRow then LastRow := BigRow;
                        MakeScreen(BigCol,BigRow);
                    end;   {ctrl-pgUp}
   {Ctrl-left} 's': if BigCol > 40 then   {moves "window" to left « screen}
                      begin
                        SaveScreen;
                        BlankScreen;
                        BigCol := BigCol - 40;
                        MakeScreen(BigCol,BigRow);
                      end;
   {Ctrl-right}'t': if BigCol < 561 then   {moves "window" to right « screen}
                      begin
                        SaveScreen;
                        BlankScreen;
                        BigCol := BigCol + 40;
                        if LastCol < BigCol then LastCol := BigCol;
                        MakeScreen(BigCol,BigRow);
                      end;
   {Ctrl-end}  'u': begin          {goes to bottom right of "big picture"}
                      SaveScreen;
                      BigRow := LastRow;
                      BigCol := LastCol;
                      MakeScreen(BigCol,BigRow);
                      GotoXY(80,21);
                      up := false;
                      CursorSet('l');
                    end;     {ctrl-end}
    {Ctrl-PgUp}'„': if BigRow > 3 then  {moves "window" up « screen}
                      begin
                        SaveScreen;
                        BlankScreen;
                        BigRow := BigRow - 3;
                        MakeScreen(BigCol,BigRow);
                    end;     {ctrl-PgDn}
    {F1}       ';': WriteADot;
    {F2}       '<': EraseADot;
    {F3}       '=': begin
                      SaveScreen;
                      AskPrint;
                    end;
    {F4}       '>': AskRetrieve;
    {F5}       '?':;
    {F6}       '@':;
    {F7}       'A':initialize;
    {F8}       'B':;
    {F9}       'C': BlankScreen;
   {Ins}       'R': DoInsert;
      end;  {case statement}
   end;   {"if Key1 = chr(27)"}
end;  {procedure}
{============================================================================}
begin
  initialize;
  repeat
    ScrollLock := ToggleByte and 16;
    TakeOrders;
  until Key2 = 'D';
  window(1,1,80,25);
  ClrScr;
  gotoXY(1,24);
  CursorSet('n');
end.