program CD(input,output);
(* JOYCE Character Designer *)

(* Disassembliert und manuell recompiliert *)

type
  CD_MCode     = array[0..100] of byte;
  CD_KCode     = array[0..2047] of byte;
  str14        = string[14];
  bytMtx       = array[0..7] of char;
  chMtx        = array[0..63] of char;
var
  lc065        : bytMtx absolute $C065;
  CD_MProg     : CD_MCode absolute $C000;
  CD_KProg     : CD_KCode absolute $C865;
  lc03f        : array[0..1359] of byte;      (* Schreibpuffer fuer 17 Rekords *)
  lbf47        : file;
  lbf38        : str14;
  lbf29        : str14;
  lbf28        : boolean;
  lbf27        : boolean;
  lbf26        : char;
  lbf1e        : bytMtx;
  lbf16        : bytMtx;
  lbf0e        : bytMtx;
  lbece        : chMtx;
  lbe8e        : chMtx;
  lbe8c        : integer;
  lbe8b        : byte;
  lbe4f        : string[59];
  lbe23        : string[43];

  mc000        : array[0..100] of byte absolute $c000;

const
  l20ff        : CD_MCode =
     ($01,$09,$C0,$CD,$5A,$FC,$E9,$00,$C9,$21,$00,$B8,$11,$65,
      $C8,$01,$00,$08,$ED,$B0,$C9,$01,$1E,$C0,$CD,$5A,$FC,$E9,
      $00,$C9,$21,$65,$C8,$11,$00,$B8,$01,$00,$08,$ED,$B0,$C9,
      $01,$33,$C0,$CD,$5A,$FC,$E9,$00,$C9,$21,$00,$B8,$11,$65,
      $C0,$01,$00,$08,$ED,$B0,$C9,$21,$11,$01,$11,$50,$C0,$01,
      $16,$08,$ED,$B0,$CD,$50,$C0,$C3,$00,$00,$01,$59,$C0,$CD,
      $5A,$FC,$E9,$00,$C9,$21,$65,$C0,$11,$00,$B8,$01,$00,$08,
      $ED,$B0,$C9);

procedure lc015; external $c015; (* Arbeitsmatrix in vorhandene Matrix kopieren *)
procedure lc02a; external $c02a; (* Vorhandene Matrix lesen *)
procedure lc050; external $c050; (* Speicher in vorhandene Matrix kopieren *)

{$I CD1.INC}

procedure l33a5;
(* Ueberpruefen der korrekten Programmversion *)
var
  lbd6a        : byte;
  lbd69        : byte;
  lbd68        : byte;
  lbd66        : integer;
  lbd64        : integer;
Begin
  lbd66:=$08fd;
  for lbd6a:=$00 to $64 do lbd66:=lbd66+mc000[lbd6a];
  lbd69:=$17;
  for lbd6a:=$00 to $64 do lbd69:=lbd69 xor mc000[lbd6a];
  lbd64:=$08fd;
  for lbd6a:=1 to length(lbe4f) do lbd64:=lbd64+ord(copy(lbe4f,lbd6a,1));
  for lbd6a:=1 to length(lbe23) do lbd64:=lbd64+ord(copy(lbe23,lbd6a,1));
  lbd68:=$17;
  for lbd6a:=1 to length(lbe4f) do lbd68:=lbd68 xor ord(copy(lbe4f,lbd6a,1));
  for lbd6a:=1 to length(lbe23) do lbd68:=lbd68 xor ord(copy(lbe23,lbd6a,1));
  if (lbd66<>$33c0) or (lbd69<>$06) or (lbd64<>$2369) or (lbd68<>$23) then
  begin
    clrscr;
    gotoxy(27,15);
    write(#7,'Programmpr}fsumme nicht in Ordnung!');
    delay(10000);
    port[$F8]:=1;                        (* Maschinenneustart erzwingen *)
    while true do;
  end;
End;

procedure l35f5;
var
  lbd5b        : byte;
  lbd5a        : byte;
  lbd59        : byte;
  lbd58        : byte;
  lbd57        : boolean;
  lbd56        : boolean;
  lbd55        : boolean;
  lbd54        : boolean;
  lbd53        : boolean;
  lbd52        : char;

  procedure l35f8(lbd51:byte);
  (* Zeichen ausgeben, Kontrollzeichen speziell behandeln *)
  begin
    if (lbd51 shr 5)=0 then write(#$1b,chr(lbd51))
                       else write(chr(lbd51))
  end;

  procedure l3641(lbd48,lbd47:byte);
  begin
    gotoxy(lbd47*2+24,lbd48*2+10);
    l35f8(lbd48*32+lbd47);
  end;

  procedure l3693(lbd3e:byte);
  begin
    gotoxy((lbd3e and $1F)*2+24,(lbd3e shr 5)*2+11);
  end;

  procedure l36da(lbd35:byte);
  begin
    lc015;
    l3693(lbd35);
    write('^');
    l3693(lbd35);
    lc050;
  end;

  procedure l3708(lbd2c:byte);
  begin
    lc015;
    l3693(lbd2c);
    write(' ');
    l3693(lbd2c);
    lc050;
  end;

  procedure l3736(lbd23:byte);
  begin
    gotoxy(4+(lbd23 and 7),10+(lbd23 shr 3));
  end;

  procedure l376d;
  var
    lbd12      : byte;
    lbd11      : byte;
  begin
    for lbd12:=0 to 7 do
      for lbd11:=7 downto 0 do
      if (ord(lbf1e[lbd12]) and
         (1 shl lbd11))<>0 then lbece[(lbd12 shl 3)+7-lbd11]:=#$BC
                           else lbece[(lbd12 shl 3)+7-lbd11]:=' ';
  end;

  procedure l3837;
  var
    lbd08      : byte;
    lbd07      : byte;
  begin
    lc015;
    for lbd08:=0 to 7 do
    begin
      gotoxy(4,lbd08+10);
      for lbd07:=0 to 7 do write(lbece[(lbd08 shl 3)+lbd07]);
    end;
    lc050;
  end;

  procedure l38b7;
  begin
    lc015;
    write(#$BC);
    lc050;
  end;

  procedure l38ca;
  begin
    lc015;
    write(' ');
    lc050;
  end;

  procedure l38dd;
  var
    lbcee      : byte;
    lbced      : byte;
  begin
    for lbcee:=0 to 7 do
    begin
      lbf1e[lbcee]:=#0;
      for lbced:=0 to 7 do
      if lbece[(lbcee shl 3)+7-lbced]=#$BC then lbf1e[lbcee]:=chr(ord(lbf1e[lbcee]) or (1 shl lbced));
    end;
  end;

  procedure l3996(var lbceb,lbce9);
  var
    a1         : byte absolute lbceb;
    a2         : byte absolute lbce9;
    lbce0      : byte;
  begin
    lbce0:=a1;
    a1:=a2;
    a2:=lbce0;
  end;

  procedure l39c2;
  var
    lbcd7      : byte;
  begin
    l38dd;
    for lbcd7:=0 to 7 do lc065[(lbd58 shl 3)+lbcd7]:=lbf1e[lbcd7];
    lc050;
    gotoxy(17,13);
    l35f8(lbd58);
  end;

  procedure l3a29;
  var
    lbcce      : byte;
  begin
    for lbcce:=0 to 7 do lbf1e[lbcce]:=lc065[(lbd58 shl 3)+lbcce];
    l376d;
    l3837;
    l39c2;
  end;

  procedure l3a80;
  begin
    lc015;
    gotoxy(15,17);
    write('      ');
    lbd54:=false;
    lc050;
  end;

  procedure l3aa8(lbcc5:byte);
  var
    lbcbc      : byte;
    lbcbb      : byte;
    lbcba      : byte;
    lbcb9      : byte;
    lbcb8      : char;
  begin
    lbcba:=lbd58;
    for lbcb9:=0 to 255 do
    begin
      lbd58:=(lbcb9+lbcba) and $FF;
      for lbcbc:=0 to 7 do lbf1e[lbcbc]:=lc065[(lbd58 shl 3)+lbcbc];
      l376d;
      case lbcc5 of
        3: for lbcbc:=0 to 7 do
             for lbcbb:=0 to 7 do
               if lbece[(lbcbc shl 3)+lbcbb]=#$BC then lbece[(lbcbc shl 3)+lbcbb]:=' '
                                                  else lbece[(lbcbc shl 3)+lbcbb]:=#$BC;
        4: for lbcbc:=0 to 31 do l3996(lbece[lbcbc],lbece[63-lbcbc]);
        5: for lbcbc:=0 to 3 do
             for lbcbb:=0 to 7 do l3996(lbece[(lbcbc shl 3)+lbcbb],lbece[((7-lbcbc) shl 3)+lbcbb]);
        6: for lbcbc:=0 to 7 do
             for lbcbb:=0 to 3 do l3996(lbece[(lbcbc shl 3)+lbcbb],lbece[(lbcbc shl 3)+7-lbcbb]);
        7: begin
             for lbcbc:=0 to 7 do
               for lbcbb:=0 to 7 do lbe8e[((lbcbb shl 3)+7)-lbcbc]:=lbece[(lbcbc shl 3)+lbcbb];
             lbece:=lbe8e;
           end;
        8: begin
             for lbcbc:=0 to 7 do
               for lbcbb:=0 to 7 do lbe8e[((7-lbcbb) shl 3)+lbcbc]:=lbece[(lbcbc shl 3)+lbcbb];
             lbece:=lbe8e;
           end;
        9: begin
             for lbcbc:=1 to 7 do
               for lbcbb:=0 to 7 do lbece[((lbcbc-1) shl 3)+lbcbb]:=lbece[(lbcbc shl 3)+lbcbb];
             for lbcbb:=0 to 7 do lbece[56+lbcbb]:=' ';
           end;
        0: begin
             for lbcbc:=6 downto 0 do
               for lbcbb:=0 to 7 do lbece[((lbcbc+1) shl 3)+lbcbb]:=lbece[(lbcbc shl 3)+lbcbb];
             for lbcbb:=0 to 7 do lbece[lbcbb]:=' ';
           end;
      end;
      l3837;
      l39c2;
      l3641(lbd58 shr 5,lbd58 and $1F);
      if keypressed then
      begin
        read(kbd,lbcb8);
        if lbcb8=^M then exit;
      end;
    end;
    lbd58:=lbcba;
    for lbcbc:=0 to 7 do lbf1e[lbcbc]:=lc065[(lbd58 shl 3)+lbcbc];
    l376d;
    l3837;
    l39c2;
    l3a80;
  end;

Begin {l35f5}
  for lbd5b:=8 to 30 do
  begin
    gotoxy(2,lbd5b);
    clreol;
    gotoxy(90,lbd5b);
    write(#$95);                                (* Vertikale Linie *)
  end;
  gotoxy(3,8);
  write('  Editor   Original                        Z e i c h e n s a t z');
  gotoxy(3,9);
  write(#$96);                                 (* Obere linke Ecke *)
  for lbd5b:=1 to 8 do write(#$9a);           (* Horizontale Linie *)
  write(#$9c);                                (* Obere rechte Ecke *)
  gotoxy(23,9);
  write(#$96);                                 (* Obere linke Ecke *)
  for lbd5b:=1 to 63 do write(#$9a);          (* Horizontale Linie *)
  write(#$9c);                                (* Obere rechte Ecke *)
  for lbd5b:=0 to 7 do
  begin
    gotoxy(3,10+lbd5b);
    write(#$95);                                (* Vertikale Linie *)
    gotoxy(12,10+lbd5b);
    write(#$95);                                (* Vertikale Linie *)
    gotoxy(23,10+lbd5b);
    write(#$95);                                (* Vertikale Linie *)
    gotoxy(87,10+lbd5b);
    write(#$95);                                (* Vertikale Linie *)
  end;
  for lbd5b:=8 to 15 do
  begin
    gotoxy(23,10+lbd5b);
    write(#$95);                                (* Vertikale Linie *)
    gotoxy(87,10+lbd5b);
    write(#$95);                                (* Vertikale Linie *)
  end;
  gotoxy(3,18);
  write(#$93);                                (* Untere linke Ecke *)
  for lbd5b:=1 to 8 do write(#$9a);           (* Horizontale Linie *)
  write(#$99);                               (* Untere rechte Ecke *)
  gotoxy(23,26);
  write(#$93);                                (* Untere linke Ecke *)
  for lbd5b:=1 to 63 do write(#$9a);          (* Horizontale Linie *)
  write(#$99);                               (* Untere rechte Ecke *)
  gotoxy(16,12);
  write(#$96,#$9a,#$9c);    (* Oben links, horizontal, oben rechts *)
  gotoxy(16,13);
  write(#$95,' ',#$95);         (* Vertikal, Leerzeichen, vertikal *)
  gotoxy(16,14);
  write(#$93,#$9a,#$99);  (* Unten links, horizontal, unten rechts *)
  gotoxy(3,20);
  lowvideo;
  write('Cursortasten:');
  normvideo;
  gotoxy(3,21);
  write('      Bewegung');
  gotoxy(3,22);
  lowvideo;
  write('ENTER:');
  normvideo;
  write('umschalten');
  gotoxy(3,23);
  lowvideo;
  write('+:');
  normvideo;
  write('    Punkt setzen');
  gotoxy(3,24);
  lowvideo;
  write('-:');
  normvideo;
  write('    Punkt l|schen');
  gotoxy(3,25);
  lowvideo;
  write('EXIT:');
  normvideo;
  write(' Arbeitsende');
  gotoxy(3,27);
  lowvideo;
  write('1:');
  normvideo;
  write('leeren ');
  lowvideo;
  write('2:');
  normvideo;
  write('f}llen ');
  lowvideo;
  write('3:');
  normvideo;
  write('invert. ');
  lowvideo;
  write('4:');
  normvideo;
  write('punktspiegeln ');
  lowvideo;
  write('5:');
  normvideo;
  write('waagerecht spiegeln ');
  lowvideo;
  write('6:');
  normvideo;
  write('senkrecht spiegeln');
  gotoxy(3,28);
  lowvideo;
  write('7:');
  normvideo;
  write('im Uhrzeigersinn drehen ');
  lowvideo;
  write('8:');
  normvideo;
  write('gegen Uhrzeigersinn drehen ');
  lowvideo;
  write('9:');
  normvideo;
  write('hochschieben ');
  lowvideo;
  write('0:');
  normvideo;
  write('runterschieben');
  gotoxy(3,29);
  lowvideo;
  write('G:');
  normvideo;
  write('n{chster Befehl global     ');
  lowvideo;
  write('W:');
  normvideo;
  write('wiederherstellen     ');
  lowvideo;
  write('S:');
  normvideo;
  write('speichern  ');
  lowvideo;
  write('E:');
  normvideo;
  write('einf}gen  ');
  lowvideo;
  write('L:');
  normvideo;
  write('l|schen');
  gotoxy(3,30);
  write('Quelldatei: ',lbf38,'       ');
  lowvideo;
  write('STOP:');
  normvideo;
  write('Abbruch         Bestimmungsdatei: ',lbf29);
  lc050;
  for lbd5b:=0 to 7 do
    for lbd5a:=0 to 31 do l3641(lbd5b,lbd5a);
  lbd59:=0;
  lbd58:=0;
  lbd56:=false;
  lbd55:=false;
  repeat
    lbd57:=false;
    if lbd55 then
    begin
      lbd57:=false;
      l3a80;
      l3736(lbd59);
      repeat
        while not keypressed do;
        read(kbd,lbd52);
        lbd52:=upcase(lbd52);
        case lbd52 of
          ^D: begin (* Cursor rechts *)
                lbd59:=(lbd59+1) and $3F;
                l3736(lbd59);
              end;
          ^S: begin (* Cursor links *)
                lbd59:=(lbd59-1) and $3F;
                l3736(lbd59);
              end;
          ^E: begin (* Cursor hoch *)
                lbd59:=(lbd59-8) and $3F;
                l3736(lbd59);
              end;
          ^X: begin (* Cursor runter *)
                lbd59:=(lbd59+8) and $3F;
                l3736(lbd59);
              end;
          ^[: begin (* EXIT *)
                lbd57:=true;
                lbd56:=true;
              end;
          ^C: begin (* STOP *)
                lbd57:=true;
                lbd56:=true;
                lbf28:=false;
              end;
          ^M: begin (* ENTER *)
                lbd57:=true;
                l3a80;
                l3641(lbd58 shr 5,lbd58 and $1F);
              end;
         '+': begin (* Punkt setzen *)
                lbece[lbd59]:=#$BC;
                l3736(lbd59);
                l38b7;
                l39c2;
                lbd59:=(lbd59+1) and $3F;
                l3736(lbd59);
              end;
         '-': begin (* Punkt loeschen *)
                lbece[lbd59]:=' ';
                l3736(lbd59);
                l38ca;
                l39c2;
                lbd59:=(lbd59+1) and $3F;
                l3736(lbd59);
              end;
         '1': begin (* Leeren *)
                if lbd54 then l3a80
                else
                  begin
                    for lbd5b:=0 to 7 do
                      for lbd5a:=0 to 7 do lbece[(lbd5b shl 3)+lbd5a]:=' ';
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '2': begin (* Fuellen *)
                if lbd54 then l3a80
                else
                  begin
                    for lbd5b:=0 to 7 do
                      for lbd5a:=0 to 7 do lbece[(lbd5b shl 3)+lbd5a]:=#$BC;
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '3': begin (* Invertieren *)
                if lbd54 then l3aa8(3)
                else
                  begin
                    for lbd5b:=0 to 7 do
                      for lbd5a:=0 to 7 do
                        if lbece[(lbd5b shl 3)+lbd5a]=#$BC then lbece[(lbd5b shl 3)+lbd5a]:=' '
                                                           else lbece[(lbd5b shl 3)+lbd5a]:=#$BC;
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '4': begin (* Um den Punkt spiegeln *)
                if lbd54 then l3aa8(4)
                else
                  begin
                    for lbd5b:=0 to 31 do l3996(lbece[lbd5b],lbece[63-lbd5b]);
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '5': begin (* Horizontal spiegeln *)
                if lbd54 then l3aa8(5)
                else
                  begin
                    for lbd5b:=0 to 3 do
                      for lbd5a:=0 to 7 do l3996(lbece[(lbd5b shl 3)+lbd5a],lbece[((7-lbd5b) shl 3)+lbd5a]);
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '6': begin (* Vertikal spiegeln *)
                if lbd54 then l3aa8(6)
                else
                  begin
                    for lbd5b:=0 to 7 do
                      for lbd5a:=0 to 3 do l3996(lbece[(lbd5b shl 3)+lbd5a],lbece[(lbd5b shl 3)+7-lbd5a]);
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '7': begin (* Im Uhrzeigersinn drehen *)
                if lbd54 then l3aa8(7)
                else
                  begin
                    for lbd5b:=0 to 7 do
                      for lbd5a:=0 to 7 do lbe8e[(lbd5a shl 3)+7-lbd5b]:=lbece[(lbd5b shl 3)+lbd5a];
                    lbece:=lbe8e;
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '8': begin (* Gegen Uhrzeigersinn drehen *)
                if lbd54 then l3aa8(8)
                else
                  begin
                    for lbd5b:=0 to 7 do
                      for lbd5a:=0 to 7 do lbe8e[((7-lbd5a) shl 3)+lbd5b]:=lbece[(lbd5b shl 3)+lbd5a];
                    lbece:=lbe8e;
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '9': begin (* Hochschieben *)
                if lbd54 then l3aa8(9)
                else
                  begin
                    for lbd5b:=1 to 7 do
                      for lbd5a:=0 to 7 do lbece[((lbd5b-1) shl 3)+lbd5a]:=lbece[(lbd5b shl 3)+lbd5a];
                    for lbd5a:=0 to 7 do lbece[56+lbd5a]:=' ';
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         '0': begin (* Runterschieben *)
                if lbd54 then l3aa8(0)
                else
                  begin
                    for lbd5b:=6 downto 0 do
                      for lbd5a:=0 to 7 do lbece[((lbd5b+1) shl 3)+lbd5a]:=lbece[(lbd5b shl 3)+lbd5a];
                    for lbd5a:=0 to 7 do lbece[lbd5a]:=' ';
                    l3837;
                    l39c2;
                  end;
                l3736(lbd59);
              end;
         'G': begin (* Globales Kommando *)
                lc015;   
                gotoxy(15,17);
                if lbd54 then
                begin
                  write('      ');
                  lbd54:=false;
                end else
                begin
                  lowvideo;
                  write('Global');
                  normvideo;
                  lbd54:=true;
                end;
                lc050;
                l3736(lbd59);
              end;
         'W': begin (* Matrix wiederherstellen *)
                lbf1e:=lbf16;
                l376d;
                l3837;
                l39c2;
                l3736(lbd59);
              end;
         'S': begin (* Matrix abspeichern *)
                lbf0e:=lbf1e;
                lbd53:=true;
                lc015;
                gotoxy(14,15);
                lowvideo;
                write('Speicher');
                normvideo;
                lc050;
                l3736(lbd59);
              end;
         'E': begin (* Einfuegen *)
                if lbd53 then
                begin
                  lbf1e:=lbf0e;
                  l376d;
                  l3837;
                  l39c2;
                  l3736(lbd59);
                end;
              end;
         'L': begin (* Loeschen *)
                lbd53:=false;
                lc015;
                gotoxy(14,15);
                write('        ');
                lc050;
                l3736(lbd59);
              end;
        end;
      until lbd57;
      lbd55:=false;
      end else
      begin
        l3a29;
        l36da(lbd58);
        lbd57:=false;
        repeat
          while not keypressed do;
          read(kbd,lbd52);
          case lbd52 of
            ^S: begin (* Cursor links *)
                  l3708(lbd58);
                  lbd58:=lbd58-1;
                  l3a29;
                  l36da(lbd58);
                end;
            ^D: begin (* Cursor rechts *)
                  l3708(lbd58);
                  lbd58:=lbd58+1;
                  l3a29;
                  l36da(lbd58);
                end;
            ^E: begin (* Cursor hoch *)
                  l3708(lbd58);
                  lbd58:=lbd58-32;
                  l3a29;
                  l36da(lbd58);
                end;
            ^X: begin (* Cursor runter *)
                  l3708(lbd58);
                  lbd58:=lbd58+32;
                  l3a29;
                  l36da(lbd58);
               end;
            ^M: begin (* ENTER *)
                  lbd57:=true;
                  lbd55:=true;
                  lbf16:=lbf1e;
                end;
            ^[: begin (* EXIT *)
                  lbd57:=true;
                  lbd56:=true;
                 end;
            ^C: begin (* STOP *)
                  lbd56:=true;
                  lbd57:=true;
                  lbf28:=false;
                end;
          end;
        until lbd57;
      end;
  until lbd56;
End;

label 999;
BEGIN
  l2164;
  CD_MProg:=l20ff;
  CD_KProg:=l227a;
  lbe4f:='J O Y C E   C H A R A C T E R D E S I G N E R   Version 1.0';
  lbe23:=' 23.11.86 by Michael Anton & Michael Wegmer';
  l33a5;
  lc02a;
  lc015;
  repeat
    lbf27:=false;
    l2ae5;
    case lbf26 of
      '1': begin (* Load and edit character set *)
999:         l30f6;
             if not lbf27 then
             begin
               l3021;
               if not lbf27 then
               begin
                 l326d;
                 lbe8c:=$08fd;
                 for lbe8b:=0 to 100 do lbe8c:=lbe8c+mc000[lbe8b];
                 if lbe8c<>$33c0 then
                 begin
                   gotoxy(24,28);
                   write(#7,'kein Zeichensatz!');
                   CD_MProg:=l20ff;
                   lc02a;
                   goto 999;
                 end;
                 l35f5;
                 if lbf28 then l3309;
               end;
             end;
           end;
      '2': begin (* Edit current character set *)
             lbf38:=' (k e i n e !)';
             l3021;
             if not lbf27 then
             begin
               l35f5;
               if lbf28 then l3309;
             end;
         end;
    end;
  until not lbf27;
  if keypressed then
  repeat
    read(kbd,lbf26);
  until not keypressed;
  gotoxy(1,31);
END.