{ GRAEDITOR.PAS                        Copyright (c) Martin Kolecek }
{ Program editor umoznuje vytvaret, ukladat i nacitat z disku       }
{ graficke soubory s priponou gra. Jedna se o muj vlastni format    }
{ ve kterem je zakodovana grafika 160x200 pixelu s barevnou hloubkou}
{ 16 barev vybranych ze 65535ti. Vysledny graficky soubor zabira    }
{ 9048 bajtu takze je vhodny pro prilinkovavani napr. do her v      }
{ assembleru.                                                       }
{                                                                   }
{ prvnich 8000 bajtu je grafika 160x200 (viz rozkodovani)           }
{ obsahuje same hodnoty 0 1 2 3                                     }
{                                                                   }
{ dalsich 1000 bajtu obsahuje ctverice bajtu pro kazdy ctverecek 8x8}
{ pixelu - zde uz jsou nahrany barvy 0-15                           }
{                                                                   }
{ poslednich 48 bajtu obsahuje barevnou paletu pro prvnich 16 barev.}
{                                                                   }
{ V programu je pouzito zakodovani a rozkodovani. Po rozkodovani    }
{ zabira stranka 160x200x16 32KB zakodovana 9KB.                    }
{                                                                   }
{ K zakodovani je pouzito prevodu decadickych cisel na binarni.     }
{ Takze 4 pixely zabiraji presne jeden bajt. 00 01 10 11 b          }
{                                                                   }
{ Program obsahuje napovedu ve ktere je ovladani editoru.           }
{ Vse je na klavesnici.                                             }
{                                                                   }
{ Zname chyby: kdyz se otevira soubor a zada se jmeno neexistujuciho}
{ souboru nebo nejak spatne dojde k padu programu (chybi File not   }
{ found funkce)                                                     }
{ druha znama chyba: v casti editoru kde se pracuje se schrankou se }
{ obsah schranky napravo zobrazuje spatne ale jinak schranka funguje}
{                                                                   }
{ Author: Martin Kolecek                                            }
{ Datum: 01.08.2008                           http://www.trsek.com  }
 
Program GraEditor;
Uses CRT;
 
Type
 TRGB= Record
         R: Byte;
         G: Byte;
         B: Byte;
       End;
 
Const
  FileNamePripona: string[4] = '.gra';
 
Var
  MMSelect: Byte;
  PalSelect: Byte;
 
  B4X,B4Y: Byte;
  B4X2,B4Y2: Byte;
  B4X3,B4Y3: Integer;
 
  EX,EY: Byte;
  EX2,EY2: Byte;
  Xs,Ys: Integer;
  Color: array[0..3] of Byte;
 
  F: File;
  FileName: string[12];
  FileNameJmeno: string[8];
 
  Clipboard: array[0..63] of Byte; {64B 8x8}
  Clipboard2: array[0..3] of Byte; {barvy 4}
 
  Grafika: array[0..7999] of Byte;
  Barvy4: array[0..999] of Byte;
  Paleta: array[0..47] of Byte;
  Barva: array[0..15] of TRGB;
 
  Buffer32,Buffer2: Pointer;
  BufferSeg32,BufferSeg2: Word;
 
  a7,a6,a5,a4,a3,a2,a1,a0: Byte;
  b7,b6,b5,b4,b3,b2,b1,b0: Byte;
 
 
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure NoBeep;
Begin
  While KeyPressed do ReadKey;
End;
 
 
Procedure Init320x200; Assembler;
Asm
  Mov AH, 00h
  Mov AL, 13h
  Int 10h
End;
 
 
Procedure Init80x25; Assembler;
Asm
  Mov AH, 00h
  Mov AL, 03h
  Int 10h
End;
 
 
Procedure WaitRetrace; Assembler;
Asm
    Mov dx,3DAh
@l1:
    In al,dx
    And al,08h
    Jnz @l1
@l2:
    In al,dx
    And al,08h
    Jz  @l2
End;
 
 
Procedure WritePixel (X:Word;Y,Barva:Byte);
Begin
  Mem[$A000:Y*320+X]:=Barva;
End;
 
 
Procedure Blok(x1,y1,x2,y2,Barva:Word);
Var x,y: Word;
Begin
   For y:=y1 to y2 do
   For x:=x1 to x2 do WritePixel(x,y,Barva);
End;
 
 
Procedure Ramecek (X1,Y1,X2,Y2,Barva: Word);
Var DelkaX,DelkaY,I: Word;
Begin
 DelkaX := X2-X1; DelkaY := Y2-Y1;
 For I := 0 to DelkaX do WritePixel (X1+I,Y1,Barva);
 For I := 0 to DelkaX do WritePixel (X1+I,Y2,Barva);
 For I := 0 to DelkaY do WritePixel (X1,Y1+I,Barva);
 For I := 0 to DelkaY do WritePixel (X2,Y1+I,Barva);
End;
 
 
Procedure GetPal(Color:Byte; Var R,G,B:Byte);
Begin
   Port[$3c7]:=Color;
   R:=Port[$3c9];
   G:=Port[$3c9];
   B:=Port[$3c9];
End;
 
 
Function GetPalR(Color:Byte): Byte;
Var R,G,B: Byte;
Begin
   Port[$3c7]:=Color;
   R:=Port[$3c9];
   G:=Port[$3c9];
   B:=Port[$3c9];
   GetPalR:=R;
End;
 
 
Function GetPalG(Color:Byte): Byte;
Var R,G,B: Byte;
Begin
   Port[$3c7]:=Color;
   R:=Port[$3c9];
   G:=Port[$3c9];
   B:=Port[$3c9];
   GetPalG:=G;
End;
 
 
Function GetPalB(Color:Byte): Byte;
Var R,G,B: Byte;
Begin
   Port[$3c7]:=Color;
   R:=Port[$3c9];
   G:=Port[$3c9];
   B:=Port[$3c9];
   GetPalB:=B;
End;
 
 
Procedure SetPal(Color:Byte; R,G,B:Byte);
Begin
   Port[$3c8]:=Color;
   Port[$3c9]:=R;
   Port[$3c9]:=G;
   Port[$3c9]:=B;
End;
 
 
Procedure SoundStorno;
Begin
  Sound(300); Delay(20); NoSound;
  Sound(250); Delay(20); NoSound;
  Sound(200); Delay(20); NoSound;
End;
 
 
Procedure SoundDone;
Begin
  Sound(200); Delay(20); NoSound;
  Sound(250); Delay(20); NoSound;
  Sound(300); Delay(20); NoSound;
  Sound(350); Delay(20); NoSound;
  Sound(400); Delay(20); NoSound;
  Sound(500); Delay(50); NoSound;
End;
 
 
Procedure InitBuffers;
Var I: Word;
Begin
  GetMem(Buffer32,32000); BufferSeg32:=Seg(Buffer32^);
  GetMem(Buffer2,2000); BufferSeg2:=Seg(Buffer2^);
  For I:=0 to 31999 do mem[BufferSeg32:I]:=0; {vymaz bufferu}
  For I:=0 to 1999 do mem[BufferSeg2:I]:=0;   {vymaz bufferu}
End;
 
 
Procedure ShutdownBuffers;
Begin
  FreeMem(Buffer32,32000);
  FreeMem(Buffer2,2000);
End;
 
 
Function Bin2Dec(b7,b6,b5,b4,b3,b2,b1,b0: Byte): Byte;
Var I: Byte;
Begin
  I:=0;
  If b7=1 then Inc(I,128);
  If b6=1 then Inc(I,64);
  If b5=1 then Inc(I,32);
  If b4=1 then Inc(I,16);
  If b3=1 then Inc(I,8);
  If b2=1 then Inc(I,4);
  If b1=1 then Inc(I,2);
  If b0=1 then Inc(I,1);
  Bin2Dec:=I;
End;
 
 
Procedure Dec2Bin(DCnum:Byte);
Begin
  If DCnum>=128 then Begin b7:=1; Dec(DCnum,128); End else b7:=0;
  If DCnum>=64  then Begin b6:=1; Dec(DCnum,64);  End else b6:=0;
  If DCnum>=32  then Begin b5:=1; Dec(DCnum,32);  End else b5:=0;
  If DCnum>=16  then Begin b4:=1; Dec(DCnum,16);  End else b4:=0;
  If DCnum>=8   then Begin b3:=1; Dec(DCnum,8);   End else b3:=0;
  If DCnum>=4   then Begin b2:=1; Dec(DCnum,4);   End else b2:=0;
  If DCnum>=2   then Begin b1:=1; Dec(DCnum,2);   End else b1:=0;
  If DCnum>=1   then Begin b0:=1; Dec(DCnum,1);   End else b0:=0;
End;
 
 
Procedure Zakodovat;
Var A,I: Word;
Begin
  A:=0; I:=0;
  Repeat
    Dec2Bin(mem[BufferSeg32:A+0]); a0:=b0; a1:=b1;
    Dec2Bin(mem[BufferSeg32:A+1]); a2:=b0; a3:=b1;
    Dec2Bin(mem[BufferSeg32:A+2]); a4:=b0; a5:=b1;
    Dec2Bin(mem[BufferSeg32:A+3]); a6:=b0; a7:=b1;
    Grafika[I]:=Bin2Dec(a7,a6,a5,a4,a3,a2,a1,a0);
    Inc(A,4);
    Inc(I);
  Until I=8000;
  A:=0; I:=0;
  Repeat
    Dec2Bin(mem[BufferSeg2:A+0]); a0:=b0; a1:=b1; a2:=b2; a3:=b3;
    Dec2Bin(mem[BufferSeg2:A+1]); a4:=b0; a5:=b1; a6:=b2; a7:=b3;
    Barvy4[I]:=Bin2Dec(a7,a6,a5,a4,a3,a2,a1,a0);
    Inc(A,2);
    Inc(I);
  Until I=1000;
  A:=0;
  For I:=0 to 15 do
  Begin
    Paleta[A+0]:=Barva[I].R;
    Paleta[A+1]:=Barva[I].G;
    Paleta[A+2]:=Barva[I].B;
    Inc(A,3);
  End;
End;
 
 
Procedure Rozkodovat;
Var A,I: Word;
Begin
  A:=0; I:=0;
  Repeat
    Dec2Bin(Grafika[I]);
    mem[BufferSeg32:A+0]:=Bin2Dec(0,0,0,0,0,0,b1,b0);
    mem[BufferSeg32:A+1]:=Bin2Dec(0,0,0,0,0,0,b3,b2);
    mem[BufferSeg32:A+2]:=Bin2Dec(0,0,0,0,0,0,b5,b4);
    mem[BufferSeg32:A+3]:=Bin2Dec(0,0,0,0,0,0,b7,b6);
    Inc(A,4);
    Inc(I);
  Until I=8000;
  A:=0; I:=0;
  Repeat
    Dec2Bin(Barvy4[I]);
    mem[BufferSeg2:A+0]:=Bin2Dec(0,0,0,0,b3,b2,b1,b0);
    mem[BufferSeg2:A+1]:=Bin2Dec(0,0,0,0,b7,b6,b5,b4);
    Inc(A,2);
    Inc(I);
  Until I=1000;
  A:=0;
  For I:=0 to 15 do
  Begin
    Barva[I].R:=Paleta[A+0];
    Barva[I].G:=Paleta[A+1];
    Barva[I].B:=Paleta[A+2];
    Inc(A,3);
  End;
End;
 
 
Procedure FnSave;
Begin
  Assign(F,Filename);
  Reset(F,1);
  Zakodovat;
  BlockWrite(F,Grafika,8000);
  BlockWrite(F,Barvy4,1000);
  BlockWrite(F,Paleta,48);
  Close(F);
  SoundDone;
End;
 
 
Procedure PrepareColors;
Var I: Byte;
Begin
  SetPal(251,0,0,0);     {Black}
  SetPal(252,63,63,63);  {White}
  SetPal(253,63,0,0);    {Red}
  SetPal(254,0,63,0);    {Green}
  SetPal(255,0,0,63);    {Blue}
  For I:=0 to 15 do
  SetPal(I,Barva[I].R,Barva[I].G,Barva[I].B);
End;
 
 
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure WriteEPScreen;
Var x,y,I: Word;
Begin
  {Nastaveni palety}
  For I:=0 to 15 do SetPal(I,Barva[I].R,Barva[I].G,Barva[I].B);
 
  {Oramovani}
  x:=0; y:=0; Ramecek(x,y,x+319,y+199,252);
 
  {Editovana barva}
  x:=140; y:=50; Ramecek(x,y,x+100,y+100,252);
  Blok(x+2,y+2,x+98,y+98,PalSelect);
 
  {Barvy + mazani kurzoru}
  x:=12; y:=10;
  For I:=0 to 15 do
  Begin
    Blok(x,y,x+7,y+7,I);
    Ramecek(x-2,y-2,x+9,y+9,252);
    Ramecek(x-4,y-4,x+11,y+11,251);
    Ramecek(x-6,y-6,x+13,y+13,251);
    Inc(x,19);
  End;
 
  {Kurzor}
  x:=12; y:=10; I:=0;
  While I<PalSelect do Begin Inc(x,19); Inc(I); End;
  Ramecek(x-4,y-4,x+11,y+11,252);
  Ramecek(x-6,y-6,x+13,y+13,252);
 
  x:=10; y:=30; Ramecek(x,y,x+62,y+138,252);
 
  {Editor palety + mazani policek RGB}
  x:=12; y:=32; Ramecek(x,y,x+18,y+8,253); Blok(x+2,y+2,x+16,y+6,253);
  x:=32; y:=32; Ramecek(x,y,x+18,y+8,254); Blok(x+2,y+2,x+16,y+6,254);
  x:=52; y:=32; Ramecek(x,y,x+18,y+8,255); Blok(x+2,y+2,x+16,y+6,255);
  x:=12; y:=42; For I:=0 to 62 do Begin Blok(x,y,x+18,y,251); Inc(y,2); End;
  x:=32; y:=42; For I:=0 to 62 do Begin Blok(x,y,x+18,y,251); Inc(y,2); End;
  x:=52; y:=42; For I:=0 to 62 do Begin Blok(x,y,x+18,y,251); Inc(y,2); End;
 
  {Policka s hodnotami RGB}
  x:=12; y:=42; I:=0;
  While I< Barva[PalSelect].R do
  Begin Blok(x,y,x+18,y,253); Inc(y,2); Inc(I); End;
  x:=32; y:=42; I:=0;
  While I< Barva[PalSelect].G do
  Begin Blok(x,y,x+18,y,254); Inc(y,2); Inc(I); End;
  x:=52; y:=42; I:=0;
  While I< Barva[PalSelect].B do
  Begin Blok(x,y,x+18,y,255); Inc(y,2); Inc(I); End;
End;
 
 
Procedure EditorPalety;
Var Ending: Boolean;
Begin
  PalSelect:=1;
  Ending:=False;
  Blok(0,0,319,199,251);
  Repeat
    WaitRetrace;
    WriteEPScreen;
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{Left}     75: Begin If PalSelect>0  then Dec(PalSelect) else PalSelect:=15; End;
{Right}    77: Begin If PalSelect<15 then Inc(PalSelect) else PalSelect:=0;  End;
{Insert}   82: Begin If Barva[PalSelect].R>0  then Dec(Barva[PalSelect].R) else Barva[PalSelect].R:=0;  End;
{Delete}   83: Begin If Barva[PalSelect].R<63 then Inc(Barva[PalSelect].R) else Barva[PalSelect].R:=63; End;
{Home}     71: Begin If Barva[PalSelect].G>0  then Dec(Barva[PalSelect].G) else Barva[PalSelect].G:=0;  End;
{End}      79: Begin If Barva[PalSelect].G<63 then Inc(Barva[PalSelect].G) else Barva[PalSelect].G:=63; End;
{PageUp}   73: Begin If Barva[PalSelect].B>0  then Dec(Barva[PalSelect].B) else Barva[PalSelect].B:=0;  End;
{PageDown} 81: Begin If Barva[PalSelect].B<63 then Inc(Barva[PalSelect].B) else Barva[PalSelect].B:=63; End;
{F2}       60: Begin FnSave; End;
{F8}       66: Begin SoundStorno; End;
{F7}       65: Begin SoundStorno; End;
{F6}       64: Begin SoundStorno; End;
{F5}       63: Begin Ending:=True; End;
{Esc}       1: Begin Ending:=True; End;
    End; {Case Port[$60] End}
  Until Ending=True;
  Blok(0,0,319,199,251);
End;
 
 
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure Setup4Colors;
Var I,X,Y,Offset: Word;
Begin
  X:=Trunc((EX*8+EX2)/8);
  Y:=Trunc((EY*8+EY2)/8);
  Offset:=(Y*20+X)*4;
  For I:=0 to 3 do
  Color[I]:=mem[BufferSeg2:Offset+I];
End;
 
 
Procedure WriteGScreen;
Var I,Xa,Ya,x,y,X1,Y1,Xp,Yp,Offset32,Offset2: Word;
Begin
  Ramecek(160,160,319,199,252);
 
  {Nastaveni spravnych barev 160x200 po krocich 8x8}
  For Ya:=0 to 24 do
  For Xa:=0 to 19 do
  Begin
    For y:=0 to 7 do
    For x:=0 to 7 do
    Begin
      X1:=Trunc((Xa*8+x)/8);
      Y1:=Trunc((Ya*8+y)/8);
      Offset2:=(Y1*20+X1)*4;
      Offset32:=((Ya*8+y)*160)+(Xa*8+x);
      Case mem[BufferSeg32:Offset32] of
        0: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+0]);
        1: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+1]);
        2: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+2]);
        3: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+3]);
      End; {Case End}
    End;
  End;
 
  {Kurzor 40x40}
  x:=EX*8; y:=EY*8;
  Ramecek(x,y,x+39,y+39,252);
 
  {Vykresleni obsahu 40x40}
  x:=160; y:=0;
  For Y1:=0 to 39 do
  Begin
    x:=160;
    For X1:=0 to 39 do
    Begin
      Xp:=Trunc((EX*8+X1)/8);
      Yp:=Trunc((EY*8+Y1)/8);
      Offset2:=(Yp*20+Xp)*4;
      Offset32:=(EY*8+Y1)*160+(EX*8+X1);
      Case mem[BufferSeg32:Offset32] of
        0: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+0]);
        1: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+1]);
        2: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+2]);
        3: Blok(x+1,y+1,x+2,y+2,mem[BufferSeg2:Offset2+3]);
      End; {Case End;}
      Inc(x,4);
    End;
    Inc(y,4);
  End;
 
  {Vymazavani kurzoru v editacnim poli}
  For Ya:=0 to 39 do
  For Xa:=0 to 39 do
  Begin
    x:=Xa*4+160; y:=Ya*4;
    Ramecek(x,y,x+3,y+3,251);
  End;
 
  {Kurzor v editacnim poli}
  x:=EX2*4+160; y:=EY2*4;
  Ramecek(x,y,x+3,y+3,252);
 
  {4 kreslici barvy ASDF}
  x:=160; y:=160;
  For I:=0 to 3 do
  Begin
    Ramecek(x,y,x+39,y+39,252);
    Blok(x+1,y+1,x+38,y+38,Color[I]);
    Inc(x,40);
  End;
 
End;
 
 
Procedure EditorGrafiky;
Var Ending: Boolean;
Begin
  EX:=0; EY:=0;
  EX2:=0; EY2:=0;
  Ending:=False;
  Blok(0,0,319,199,251);
  Repeat
    Setup4Colors;
    WaitRetrace;
    WriteGScreen;
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{J}     36: Begin If EX2>0  then Dec(EX2) else EX2:=39; End;
{L}     38: Begin If EX2<39 then Inc(EX2) else EX2:=0;  End;
{I}     23: Begin If EY2>0  then Dec(EY2) else EY2:=39; End;
{K}     37: Begin If EY2<39 then Inc(EY2) else EY2:=0;  End;
 
{A}     30: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=0; End;
{S}     31: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=1; End;
{D}     32: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=2; End;
{F}     33: Begin mem[BufferSeg32:((EY*8+EY2)*160)+(EX*8+EX2)]:=3; End;
 
{Left}  75: Begin If EX>0  then Dec(EX) else EX:=15; End;
{Right} 77: Begin If EX<15 then Inc(EX) else EX:=0;  End;
{Up}    72: Begin If EY>0  then Dec(EY) else EY:=20; End;
{Down}  80: Begin If EY<20 then Inc(EY) else EY:=0;  End;
 
{F2}    60: Begin FnSave; End;
{F8}    66: Begin SoundStorno; End;
{F7}    65: Begin SoundStorno; End;
{F6}    64: Begin SoundStorno; End;
{F5}    63: Begin Ending:=True; End;
{Esc}    1: Begin Ending:=True; End;
    End; {Case Port[$60] End}
  Until Ending=True;
  Blok(0,0,319,199,251);
End;
 
 
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure WriteE4Screen;
Var x,y,X1,Y1,I,I2: Word;
Begin
  Ramecek(160,0,319,199,252);
 
  {Vymazavani kurzoru - vyber barvy}
  x:=160; y:=0; I:=0;
  For Y1:=0 to 3 do
  Begin
    x:=160;
    For X1:=0 to 3 do
    Begin
      Ramecek(x+2,y+2,x+37,y+37,251);
      Blok(x+6,y+6,x+33,y+33,I);
      inc(x,40); Inc(I);
    End;
    Inc(y,40);
  End;
 
  {Kurzor - vyber barvy}
  x:=160+B4X2*40; y:=B4Y2*40;
  Ramecek(x+2,y+2,x+37,y+37,252);
 
  {nahled 4 vybranych barev}
  x:=160; y:=160;
  For I:=0 to 3 do
  Begin
    Ramecek(x,y,x+39,y+39,252);
    Blok(x+2,y+2,x+37,y+37,mem[BufferSeg2:B4Y3*20+B4X3+I]);
    Inc(x,40);
  End;
 
  {Vymazavani kurzoru a vykresleni 4barvy}
  x:=0; y:=0; I:=0;
  For Y1:=0 to 24 do
  Begin
    x:=0;
    For X1:=0 to 19 do
    Begin
      Ramecek(x,y,x+7,y+7,251);
      Blok(x+2,y+2,x+3,y+3,mem[BufferSeg2:I+0]);
      Blok(x+4,y+2,x+5,y+3,mem[BufferSeg2:I+1]);
      Blok(x+2,y+4,x+3,y+5,mem[BufferSeg2:I+2]);
      Blok(x+4,y+4,x+5,y+5,mem[BufferSeg2:I+3]);
      inc(x,8); Inc(I,4);
    End;
    Inc(y,8);
  End;
 
  {Kurzor}
  x:=B4X*8; y:=B4Y*8;
  Ramecek(x,y,x+7,y+7,252);
 
End;
 
 
Procedure Editor4Barvy;
Var Ending: Boolean;
    I: Word;
Begin
  B4X:=0; B4Y:=0;
  B4X2:=0; B4Y2:=0;
  B4X3:=0; B4Y3:=0;
  Ending:=False;
  Blok(0,0,319,199,251);
  Repeat
    WaitRetrace;
    WriteE4Screen;
    ReadKey; Delay(100); NoBeep;
    Case Port[$60] of
{J}     36: Begin
              If B4X>0  then Dec(B4X) else B4X:=19;
              If B4X3>0 then Dec(B4X3,4) else B4X3:=76;
            End;
{L}     38: Begin
              If B4X<19 then Inc(B4X) else B4X:=0;
              If B4X3<76 then Inc(B4X3,4) else B4X3:=0;
            End;
{I}     23: Begin
              If B4Y>0  then Dec(B4Y) else B4Y:=24;
              If B4Y3>0 then Dec(B4Y3,4) else B4Y3:=96;
            End;
{K}     37: Begin
              If B4Y<24 then Inc(B4Y) else B4Y:=0;
              If B4Y3<96 then Inc(B4Y3,4) else B4Y3:=0;
            End;
 
{A}     30: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+0]:=B4Y2*4+B4X2; End;
{S}     31: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+1]:=B4Y2*4+B4X2; End;
{D}     32: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+2]:=B4Y2*4+B4X2; End;
{F}     33: Begin mem[BufferSeg2:(B4Y3*20+B4X3)+3]:=B4Y2*4+B4X2; End;
 
{Left}  75: Begin If B4X2>0 then Dec(B4X2) else B4X2:=3; End;
{Right} 77: Begin If B4X2<3 then Inc(B4X2) else B4X2:=0; End;
{Up}    72: Begin If B4Y2>0 then Dec(B4Y2) else B4Y2:=3; End;
{Down}  80: Begin If B4Y2<3 then Inc(B4Y2) else B4Y2:=0; End;
{F2}    60: Begin FnSave; End;
{F8}    66: Begin SoundStorno; End;
{F7}    65: Begin SoundStorno; End;
{F6}    64: Begin SoundStorno; End;
{F5}    63: Begin Ending:=True; End;
{Esc}    1: Begin Ending:=True; End;
    End; {Case Port[$60] End}
  Until Ending=True;
  Blok(0,0,319,199,251);
End;
 
 
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Procedure Copy2ClipBoard;
Var Offset32,Offset2,X1,Y1,Xe,Ye,x,y,I: Word;
Begin
  {kopirovani do schranky 64B 8x8}
  x:=Xs*8; y:=Ys*8;
  For Ye:=0 to 7 do
  Begin
    For Xe:=0 to 7 do
    Begin
      Offset32:=((y+Ye)*160)+(x+Xe);
      Clipboard[I]:=mem[BufferSeg32:Offset32];
      Inc(I);
    End;
  End;
  {kopirovani do schranky barvy 4}
  x:=0; y:=0;
  X1:=Trunc((Xs*8+x)/8);
  Y1:=Trunc((Ys*8+y)/8);
  Offset2:=(Y1*20+X1)*4;
  For I:=0 to 3 do Clipboard2[I]:=mem[BufferSeg2:Offset2+I];
End;
 
 
Procedure RestoreFromClipBoard;
Var Offset32,Offset2,X1,Y1,Xe,Ye,x,y,I: Word;
Begin
  {vylozeni ze schranky 64B}
  x:=Xs*8; y:=Ys*8;
  For Ye:=0 to 7 do
  Begin
    For Xe:=0 to 7 do
    Begin
      Offset32:=((y+Ye)*160)+(x+Xe);
      mem[BufferSeg32:Offset32]:=Clipboard[I];
      Inc(I);
    End;
  End;
  {vylozeni ze schranky barvy 4}
  x:=0; y:=0;
  X1:=Trunc((Xs*8+x)/8);
  Y1:=Trunc((Ys*8+y)/8);
  Offset2:=(Y1*20+X1)*4;
  For I:=0 to 3 do mem[BufferSeg2:Offset2+I]:=Clipboard2[I];
 
End;
 
 
Procedure WriteEScreen;
Var Offset32,Offset2,Xa,Ya,X1,Y1,x,y,I,BarvaVeSchrance: Word;
Begin
  Ramecek(160,0,319,199,252);
 
  {Nastaveni spravnych barev 160x200 po krocich 8x8}
  For Ya:=0 to 24 do
  For Xa:=0 to 19 do
  Begin
    For y:=0 to 7 do
    For x:=0 to 7 do
    Begin
      X1:=Trunc((Xa*8+x)/8);
      Y1:=Trunc((Ya*8+y)/8);
      Offset2:=(Y1*20+X1)*4;
      Offset32:=((Ya*8+y)*160)+(Xa*8+x);
      Case mem[BufferSeg32:Offset32] of
        0: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+0]);
        1: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+1]);
        2: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+2]);
        3: WritePixel((Xa*8+x),(Ya*8+y),mem[BufferSeg2:Offset2+3]);
      End; {Case End}
    End;
  End;
 
  {Kurzor 8x8}
  x:=Xs*8; y:=Ys*8;
  Ramecek(x,y,x+7,y+7,252);
 
 
  {zobrazeni obsahu schranky - nahled barev}
  x:=194; y:=140;
  For I:=0 to 3 do
  Begin
    Blok(x,y,x+9,y+9,ClipBoard2[I]);
    Inc(x,10);
  End;
 
  {zobrazeni obsahu schranky - 8x8}
  Ramecek(194,49,276,131,252);
  x:=195; y:=50; I:=0;
  For Y1:=0 to 7 do
  Begin
    For X1:=0 to 7 do
    Begin
      Case ClipBoard[I] of
        0: Begin BarvaVeSchrance:=ClipBoard2[0]; End;
        1: Begin BarvaVeSchrance:=ClipBoard2[1]; End;
        2: Begin BarvaVeSchrance:=ClipBoard2[2]; End;
        3: Begin BarvaVeSchrance:=ClipBoard2[3]; End;
      End;
      Blok(x+1,y+1,x+9,y+9,BarvaVeSchrance);
      inc(x,10); Inc(I);
    End;
    x:=195; Inc(y,10);
  End;
 
End;
 
 
Procedure FnEditor;
Var Ending: Boolean;