/* -------------------------------------------------------------- */ 
/* KIO'S FONTEDITOR ... FOR ATARI ST / RTOS VS. 2.0 / MONOCHROME  */ 
/* -------------------------------------------------------------- */ 
                  /* VERSION 1.1  18/10/1987 */ 
/*-L              /* ----------------------- */ 
/*+M              /* (C) BY GÜNTER WOIGK     */ 
/*+T              /*     alias KIO           */ 
                  /*     GABELSBERGERSTR. 5  */ 
SC=$4000;         /*     8520 ERLANGEN       */ 
                  /* ----------------------- */ 
MODULE FONTED;    /* KIO-BOX E R L A N G E N */ 
                  /*         09131 - 20 7996 */ 
                  /* ----------------------- */ 
                  /* WRITTEN FOR C'T-PD-POOL */ 
SYSTEM;           /* ----------------------- */ 

DATEI: F0.DIES/IST/NUR/EIN/PLATZHALTER (NE) <->; 
XC; 

PROBLEM; 

/* --------------------------------------------------------- */ 
/*     COPY FÜR PROGRAMME, DIE DEN MAUSTREIBER BENUTZEN      */ 
/* --------------------------------------------------------- */ 
/* - */ 
/* - */ LENGTH BIT(1),FIXED(15),CHAR(1),FLOAT(23); 
/* - */ 
/* - */ TYPE FIX FIXED,BTX BIT(16),BTZ BIT(32),SEM SEMA,TXT CHAR(80), 
/* - */      BTN STRUCT (/ (L,R,O,U)FIX /), 
/* - */      STR STRUCT (/ LEN FIX, TXT TXT /); 
/* - */ 
/* - */ DCL (TRUE,FALSE) INV BIT INIT('1'B,'0'B); 
/* - */ 
/* - */ SPC A1 DATION INOUT ALPHIC CONTROL(ALL) GLOBAL; 
/* - */ 
/* - */ SPC MSEM                SEM GLOBAL, 
/* - */     GANZERSCREEN        BTN GLOBAL, 
/* - */     BUTTON()            BTN GLOBAL, 
/* - */     (MAUSF,LMT,RMT)     BIT GLOBAL, 
/* - */     (MX,MY,TX,TY,TASTE) FIX GLOBAL; 
/* - */ 
/* - */ SPC ADR      LONG GLOBAL, 
/* - */     REFB REF CHAR GLOBAL, 
/* - */     REFW REF FIX  GLOBAL, 
/* - */     REFL REF LONG GLOBAL; 
/* - */ 
/* - */ SPC (SCRSET,SCKILL,SCRCHG,CLEAR,PEN,TEXT,SPRITL,SPRITS, 
/* - */    SHOWMAUS,HIDEMAUS,STARTMAUS,STOPMAUS,WARTE,PAUSE,FRAME, 
/* - */    CLEARWINDOW,FRAMEWINDOW,OPENWINDOW,CLOSEWINDOW,ADDBUTTON, 
/* - */    TEXTCENTERED,INFOFENSTER,AUSWAEHLEN,BESTAETIGUNG,INPUT, 
/* - */    MAUSCOPYRIGHT,MAUSGRENZEN,BOXSIZER,BOXMOVER,CENTERWINDOW, 
/* - */    MAUSZEIGERAENDERN,MAUSPFEIL,INITMAUS,EXITMAUS) ENTRY GLOBAL; 

SPC DATEI  DATION INOUT ALPHIC CONTROL(ALL), 
    XC     DATION OUT   ALPHIC CONTROL(ALL); 
SPC ASSIGN ENTRY GLOBAL; 

DCL CHAR1(1,16) BTX; 
DCL CHAR2(1,16) BTX; 
DCL CHARX(1,16) BTX;             /* AKTUELL BEARBEITETES ZEICHEN */ 
DCL CHARY(1,16) BTX;             /* 'ALTE' VERSION DAVON -> UNDO */ 

DCL PIX0(1,16)  BTX;             /* GRAFIK FÜR 0-BIT IN MATRIX   */ 
DCL PIX1(1,16)  BTX;             /*            1                 */ 

DCL SCREEN  INV CHAR(5) INIT('FNTED'); 

/* ================================================================= */ 

LEN:PROC(S TXT) RETURNS(FIX); 
  FOR I FROM 80 BY -1 TO 1 REPEAT; 
    IF S.CHAR(I)/=' ' THEN RETURN(I);FIN; 
    END; 
  RETURN(0); 
  END; 

COPYRIGHTMESSAGE:PROC; 
  DCL F(30,200)BTX,D(200)BTX,S(09)TXT ; 
  S(01)='KIO's Fonteditor vs. 2.0 - 10/87'; 
  S(02)='--------------------------------'; 
  S(03)=''; 
  S(04)='(c) by Günter Woigk 1987 !'; 
  S(05)=''; 
  S(06)='Der Fonteditor ist Public Domain.'; 
  S(07)='Er darf weitergegeben werden, wenn'; 
  S(08)='- an Programm und Umfang nichts geändert wird -'; 
  S(09)='- dabei kein Gewinn erziehlt wird -'; 
  CALL INFOFENSTER(S,F); 
  END; 

WEITEREINFORMATIONEN:PROC; 
  DCL F(31,300)BTX,D(300)BTX,S(17)TXT ; 
  S(1)='Fonteditor (c) G.Woigk'; 
  S(2)='----------------------'; 
  S(3)=''; 
  S(4)='Version: 2.0'; 
  S(5)='Für Atari ST mit Monochrom-Monitor'; 
  S(6)='ab RTOS-Version 2.0.'; 
  S(7)=''; 
  S(8)='Alle Funktionen werden mit der Maus angesprochen.'; 
  S(9)=''; 
  S(10)='Eine einfache Anleitung gibt es unter <Hilfe>.'; 
  S(11)=''; 
  S(12)='Eine genaue Anleitung und die neueste Version dieses'; 
  S(13)='Programmes erhält man gegen Einsendung von 20 DM an:'; 
  S(14)=''; 
  S(15)='Günter Woigk'; 
  S(16)='Gabelsbergerstr. 5'; 
  S(17)='D-8520 Erlangen'; 
  CALL INFOFENSTER(S,F); 
  END; 

DOC:PROC; 
  DCL F(32,300)BTX,D(300)BTX,S(15)TXT; 
  S(01)='Bedienung des KIO-Fonteditors:'; 
  S(02)='------------------------------'; 
  S(03)=''; 
  S(04)='Beenden des Programms mit STOP oder UNLOAD'; 
  S(05)='Unterbrechen der Arbeit mit PAUSE'; 
  S(06)='Der Editor-Screen wird bei jedem Maus-Klick angezeigt.'; 
  S(07)='Evtl. löst man damit aber eine Aktion aus. => Benutze PAUSE !'; 
  S(08)='Die linke und rechte Maustaste werden nur im Arbeitsfeld'; 
  S(09)='unterschieden: Links = Malen und Rechts = Löschen.'; 
  S(10)=''; 
  S(11)='COPY kopiert Fonts zwischen folgenden Stellen:'; 
  S(12)=''; 
  S(13)='1. ED. F0. F1. und HD. (incl. Subdirectories)'; 
  S(14)='2. Font-Puffer des Fonteditors              .'; 
  S(15)='3. Systemfont von RTOS                      .'; 
  CALL INFOFENSTER(S,F); 
  END; 

GRUESSE:PROC; 
  DCL F(18,112)BTX,D(112)BTX,S(6)TXT; 
  S(1)='Heavy many greetings to'; 
  S(2)=''; 
  S(3)='Lord,Maggi,Gommel,Punx,Rose'; 
  S(4)='Hirsch,Peterl,Rambarbar,OS-9'; 
  S(5)='AXN, Mufix, Felix, SCI'; 
  S(6)='C Persson, W.Gerth, K.Koerth'; 
  CALL INFOFENSTER(S,F); 
  END; 

INFOUEBERFEHLER:PROC; 
  DCL F(30,264)BTX,D(264)BTX,S(13)TXT; 
  S(01)='Fehler im Programm.'; 
  S(02)='-------------------'; 
  S(03)=''; 
  S(04)='1. Manchmal erscheint die Meldung:     .'; 
  S(05)='   INTERRUPT not suspended (CONTINUE)  .'; 
  S(06)='   (lästig, aber nicht tragisch)       .'; 
  S(07)=''; 
  S(08)='2. Wie kann man die Zeichen < TOCHAR(32)'; 
  S(09)='   und >= TOCHAR(127) ausdrucken ??    .'; 
  S(10)=''; 
  S(11)='3. Wie kriegt man die Umlaut-Umschaltung'; 
  S(12)='   geregelt, ohne daß der alte Zeichen -'; 
  S(13)='   satz (teilweise) restauriert wird ???'; 
  CALL INFOFENSTER(S,F); 
  END; 

BEENDEPROGRAMM:PROC; 
  DCL F(16,130)BTX,D(130)BTX,S(6)TXT; 
  S(1)='Programm beenden.'; 
  S(2)='-----------------'; 
  S(3)=''; 
  S(4)='Sind Sie sicher ??'; 
  CALL BESTAETIGUNG(S,F); 
  IF ABS(TASTE)==1 THEN CALL STOPMAUS;CALL EXITMAUS;TERMINATE;FIN; 
  END; 

LOESCHEN:PROC; 
  DCL F(18,140)BTX,D(140)BTX,S(7)TXT; 
  S(1)='Das Programm beenden und'; 
  S(2)='aus dem Speicher löschen'; 
  S(3)='------------------------'; 
  S(4)=''; 
  S(5)='Sind Sie sicher ??'; 
  CALL BESTAETIGUNG(S,F); 
  IF ABS(TASTE)==1 
    THEN 
      CALL STOPMAUS; 
      CALL EXITMAUS; 
      PUT 'UNLOAD MAUS*,MAUS*,FONTED*' TO XC BY A,SKIP; 
    FIN; 
  END; 

/* =================================================================== */ 

/* ZEICHEN AUS FONT HOLEN */ 
/* ---------------------- */ 

FROMFONT:PROC(N FIX,C(,)BTX IDENT,F(,)BIT(8)IDENT); 
FOR I TO 16 REPEAT; 
  C(1,I)=F(N,I); 
  END; 
END; 


/* ZEICHEN IN FONT KOPIEREN */ 
/* ------------------------ */ 

TOFONT:PROC(N FIX,C(,)BTX IDENT,F(,)BIT(8)IDENT); 
FOR I TO 16 REPEAT; 
  F(N,I)=C(1,I); 
  END; 
END; 


/* ZEICHEN N IM SCREEN AUSGEBEN */ ; /* BEACHTET MAUS */ 
/* ---------------------------- */ 

PRINTN:PROC(N FIX,F(,)BIT(8)IDENT); 

DCL (X,Y) FIX; 
DCL B BTN;B=BUTTON(08); 
DCL C(1,16)BTX ; 
IF MAUSF 
  THEN CALL HIDEMAUS; 
       CALL PRINTN(N,F); 
       CALL SHOWMAUS; 
  ELSE 
    Y=(N-1)//16; 
    X=(N-1)-Y*16; 
    X=B.L+4+X*15; 
    Y=B.O+3+Y*21; 
    CALL FROMFONT(N,C,F); 
    CALL SPRITS(X,Y,8,16,SCREEN,C); 
  FIN; 
END; 


/* FELD MIT ALLEN ZEICHEN ZEICHNEN */ ; /* BEACHTET MAUS */ 
/* ------------------------------- */ 

PRINTFONT:PROC(F(,)BIT(8)IDENT) REENT; 

DCL B BTN; 
IF MAUSF 
  THEN CALL HIDEMAUS; 
       CALL PRINTFONT(F); 
       CALL SHOWMAUS; 
  ELSE 
    B=BUTTON(08); 
    FOR I FROM B.L BY 15 TO B.R REPEAT; 
      CALL LINE(I,B.O,I,B.U,1); 
      END; 
    FOR I FROM B.O BY 21 TO B.U REPEAT; 
      CALL LINE(B.L,I,B.R,I,1); 
      END; 
    FOR I TO 256 REPEAT; 
      CALL PRINTN(I,F); 
      END; 
  FIN; 
END; 


/* DEN AKTUELLEN SYSTEM-FOND ÜBERNEHMEN */ 
/* ------------------------------------ */ 

GETSYSFOND:PROC(F(,)BIT(8)IDENT); 

/* FOND LIEGT AB ($81E)+$320 = $D6F4C */ 
/* UND STARTET MIT SPACE. 255 ZEICHEN */ ; /* ????? */ 

FOR I TO 256 REPEAT; 
  FOR J TO 8 REPEAT; 
    F(I,J+J-1)=SYSF(J,I); 
    F(I,J+J)  =SYSF(J,I) SHIFT 8; 
    END; 
  END; 
END; 


/* DEN SYSTEMFOND ÜBERSCHREIBEN */ 
/* ---------------------------- */ 

PUTSYSFOND:PROC(F(,)BIT(8)IDENT); 
DCL B BTX ; 
FOR I TO 256 REPEAT; 
  FOR J TO 8 REPEAT; 
    B=F(I,J+J); 
    SYSF(J,I)=F(I,J+J-1) OR (B SHIFT (-8)); 
    END; 
  END; 
END; 


/* FONT AUS ED.DATEI LESEN */ 
/* ----------------------- */ 

LESEN:PROC(N CHAR(5),F(,)BIT(8)IDENT); 
OPEN DATEI BY IDF(N); 
CALL REWIND(DATEI); 
FOR I TO 256 REPEAT; 
  FOR J TO 16 REPEAT; 
    GET F(I,J) FROM DATEI BY B4 ; 
    END; 
  END; 
CLOSE DATEI; 
END; 


/* FONT IN ED.DATEI SCHREIBEN */ 
/* -------------------------- */ 

SCHREIBEN:PROC(N CHAR(5),F(,)BIT(8)IDENT); 
OPEN DATEI BY IDF(N); 
CALL REWIND(DATEI); 
FOR I TO 256 REPEAT; 
  FOR J TO 16 REPEAT; 
    PUT F(I,J) TO DATEI BY B4 ; 
    END; 
  END; 
CLOSE DATEI; 
END; 


/* FONT KOPIEREN */ 
/* ------------- */ 

KOPIEREN:PROC(H(,)BIT(8)IDENT); 

DCL G(256,16)BIT(8); 
DCL E BTN; 
DCL F(22,141)BTX ; 
DCL (Q,Z)FIX; 
DCL B(6) BTN; 
DCL T FIX; 

FOR I TO 6 REPEAT; 
  B(I)=BUTTON(I); 
  END; 
CALL CENTERWINDOW(E,F); 
CALL OPENWINDOW(E,F); 
CALL PRINTCENTERED('*** Font kopieren ***',16,E); 
CALL PRINTCENTERED('-------------',32,E); 
CALL ADDBUTTON(1,218,E.O+085,'ED.FONT1',    TRUE); 
CALL ADDBUTTON(2,288,E.O+085,'ED.FONT2',    TRUE); 
CALL ADDBUTTON(3,358,E.O+085,'ED.FONT3',    TRUE); 
CALL ADDBUTTON(4,233,E.O+107,'Arbeitsfont', TRUE); 
CALL ADDBUTTON(5,327,E.O+107,'Systemfont',  TRUE); 
BUTTON(6)=GANZERSCREEN; 

CALL PRINTCENTERED('QUELLE festlegen:',53,E); 
WHEN KLICK RESUME;PREVENT FONTEDITOR; 
T=ABS(TASTE); 
IF T/=6 
  THEN 
    CALL PRINTCENTERED('<<<< loading >>>>',53,E); 
    CASE T 
      ALT CALL LESEN('FONT1',G); 
      ALT CALL LESEN('FONT2',G); 
      ALT CALL LESEN('FONT3',G); 
      ALT /* ARBEITSFOND */ 
        FOR I TO 256 REPEAT; 
          FOR J TO 16 REPEAT; 
            G(I,J)=H(I,J); 
            END; 
          END; 
      OUT /* SYSTEMFOND */ 
        CALL GETSYSFOND(G); 
      FIN; 
    CALL PRINTCENTERED(' ZIEL  festlegen:',53,E); 
    WHEN KLICK RESUME;PREVENT FONTEDITOR; 
    T=ABS(TASTE); 
    IF T/=6 
      THEN 
        CALL PRINTCENTERED('<<<< copying >>>>',53,E); 
        CASE T 
          ALT CALL SCHREIBEN('FONT1',G); 
          ALT CALL SCHREIBEN('FONT2',G); 
          ALT CALL SCHREIBEN('FONT3',G); 
          ALT /* ARBEITSFOND */ 
            FOR I TO 256 REPEAT; 
              FOR J TO 16 REPEAT; 
                H(I,J)=G(I,J); 
                END; 
            END; 
          OUT /* SYSTEMFOND */ 
            CALL PUTSYSFOND(G); 
          FIN; 
      FIN; 
  FIN; 
FOR I TO 6 REPEAT; 
  BUTTON(I)=B(I); 
  END; 
CALL CLOSEWINDOW(E,F); 
IF T==4 THEN CALL PRINTFONT(G);FIN; 
END; 


/* ZEICHEN IN EDITIERBOX ÜBERNEHMEN */ 
/* -------------------------------- */ 

LADECHAR:PROC(C(,)BTX IDENT,A(,)BTX IDENT) REENT; 
DCL (X,Y,L,O) FIX; 

IF MAUSF 
  THEN CALL HIDEMAUS;CALL LADECHAR(C,A);CALL SHOWMAUS; 
  ELSE 
    FOR I TO 16 REPEAT; 
      CHARY(1,I)=A(1,I);     /* ALTE VERSION BESETZEN */ 
      CHARX(1,I)=C(1,I);     /* AKTUELLE VERSION      */ 
      END; 
    L=BUTTON(10).L-1; 
    O=BUTTON(10).O-1; 
    Y=BUTTON(09).O; 
    FOR I TO 16 REPEAT; 
      X=BUTTON(09).L; 
      FOR J TO 8 REPEAT; 
        IF C(1,I).BIT(J) 
          THEN CALL SPRITS(X,Y,16,16,SCREEN,PIX1); 
               CALL SETPIX(L+J,O+I,1); 
          ELSE CALL SPRITS(X,Y,16,16,SCREEN,PIX0); 
               CALL SETPIX(L+J,O+I,0); 
          FIN; 
        X=X+16; 
        END; 
      Y=Y+16; 
      END; 
  FIN; 
END; 


/* ZEICHEN IN EDITIERBOX LÖSCHEN */ 
/* ----------------------------- */ 

CLEARCHAR:PROC; 
  FOR I TO 16 REPEAT; 
    CHARX(1,I)='00'B4; 
    END; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN IN EDITIERBOX INVERTIEREN */ 
/* --------------------------------- */ 

INVERTCHAR:PROC; 
  FOR I TO 16 REPEAT; 
    CHARX(1,I)=NOT CHARX(1,I); 
    END; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN NACH LINKS ROLLEN */ 
/* ------------------------- */ 

LROLLCHAR:PROC; 
  FOR I TO 16 REPEAT; 
    CHARX(1,I).BIT(9)=CHARX(1,I).BIT(1); 
    CHARX(1,I)=CHARX(1,I) CSHIFT 1; 
    END; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN NACH RECHTS SCHIEBEN */ 
/* ---------------------------- */ 

RROLLCHAR:PROC; 
  FOR I TO 16 REPEAT; 
    CHARX(1,I)=CHARX(1,I) CSHIFT(-1); 
    CHARX(1,I).BIT(1)=CHARX(1,I).BIT(9); 
    END; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN HOCHROLLEN */ 
/* ------------------ */ 

UROLLCHAR:PROC; 
  DCL Z BIT(8); 
  Z=CHARX(1,1); 
  FOR I TO 15 REPEAT; 
    CHARX(1,I)=CHARX(1,I+1); 
    END; 
  CHARX(1,16)=Z; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN RUNTERROLLEN */ 
/* -------------------- */ 

DROLLCHAR:PROC; 
  DCL Z BIT(8); 
  Z=CHARX(1,16); 
  FOR I FROM 16 BY -1 TO 2 REPEAT; 
    CHARX(1,I)=CHARX(1,I-1); 
    END; 
  CHARX(1,1)=Z; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN VERTIKAL SPIEGELN */ 
/* ------------------------- */ 

VMC:PROC; 
  DCL Z BIT(8); 
  FOR I TO 8 REPEAT; 
    Z=CHARX(1,I); 
    CHARX(1,I)=CHARX(1,17-I); 
    CHARX(1,17-I)=Z; 
    END; 
  END; 

VMIRRORCHAR:PROC; 
  CALL VMC; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN HORIZONTAL SPIEGELN */ 
/* --------------------------- */ 

HMC:PROC; 
  DCL (B,C) BIT(8); 
  FOR I TO 16 REPEAT; 
    B=CHARX(1,I); 
    FOR J TO 8 REPEAT;C.BIT(J)=B.BIT(9-J);END; 
    CHARX(1,I)=C; 
    END; 
  END; 

HMIRRORCHAR:PROC; 
  CALL HMC; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* ZEICHEN UM 180 GRAD DREHEN */ 
/* -------------------------- */ 

XMIRRORCHAR:PROC; 
  CALL HMC; 
  CALL VMC; 
  CALL LADECHAR(CHARX,CHARY); 
  END; 


/* BUTTONS INITIALISIEREN */ 
/* ---------------------- */ 

INITIALISIEREBUTTONS:PROC; 

DCL B BTN,F(1,40)BTX,C BTX,N FIX; 

CALL ADDBUTTON(08, 10,  5,'(c)'); 
CALL ADDBUTTON(09, 39,  5,'Info'); 
CALL ADDBUTTON(13, 76,  5,'Hilfe'); 
CALL ADDBUTTON(16,121,  5,'Bugs'); 
CALL ADDBUTTON(11,158,  5,'Grüße'); 
CALL ADDBUTTON(07,203,  5,'Exit'); 
CALL ADDBUTTON(10,240,  5,'Unload'; 
CALL ADDBUTTON(15,293,  5,'< Pause >'); 
CALL ADDBUTTON(12,370,  5,'<< COPY >>'); 
CALL ADDBUTTON(14,539,303,'Undo'); 
CALL ADDBUTTON(02,531,325,'Invert'); 
CALL ADDBUTTON(03,535,347,'Clear'); 
CALL ADDBUTTON(18,470,  5,'<----'); 
CALL ADDBUTTON(22,514,  5,'<--->'); 
CALL ADDBUTTON(19,558,  5,'---->'); 
CALL ADDBUTTON(17,605,  5,'><'); 

FOR I TO 16 REPEAT;             /* '<--->' GESTÜRZT EINLESEN */ 
  FOR J TO 16 REPEAT; 
    CALL GETPIX(513+I,4+J,N); 
    C.BIT(J)=(N/=0); 
    END; 
  F(1,I)=C; 
  END; 
FOR I FROM 9 TO 32 REPEAT; 
  F(1,I+8)=F(1,I); 
  END; 

B.L=605;B.R=620;B.O=030;B.U=111; 
BUTTON(20)=B;CALL FRAME(B);        /* HOCHROLLEN */ 
CALL SPRITS(605,51,16,40,SCREEN,F); 
FOR I TO 8 REPEAT; 
  F(1,41-I)=F(1,I); 
  END; 
B.O=117;B.U=198; 
BUTTON(01)=B;CALL FRAME(B);        /* V SPIEGELN */ 
CALL SPRITS(605,138,16,40,SCREEN,F); 
B.O=204;B.U=285; 
FOR I TO 8 REPEAT; 
  F(1,I)=F(1,I+8); 
  END; 
BUTTON(21)=B;CALL FRAME(B);        /* RUNTERROLLEN */ 
CALL SPRITS(605,225,16,40,SCREEN,F); 

B.L=010;B.R=250;B.O=030;B.U=366; 
BUTTON(06)=B;CALL FRAME(B);       /* BOX MIT ALLEN ZEICHEN DES FONTS */ 

B.L=470;B.R=597;B.O=030;B.U=285; 
BUTTON(05)=B;CALL FRAME(B);          /* BOX MIT VERGRÖßERTEM ZEICHEN */ 

B.O=300;B.U=366;CALL FRAME(B); 
CALL ADDBUTTON(04,490,347,'$'); 
CALL LINE(494,300, 510,316, 1);              /* PFEIL ^ */ 
CALL LINE(494,300, 478,316, 1); 
CALL LINE(478,316, 486,316, 1); 
CALL LINE(510,316, 501,316, 1); 
CALL LINE(486,316, 490,342, 1); 
CALL LINE(501,316, 497,342, 1); 
CALL LINE(490,342, 497,342, 1); 

END; 


/* MAUSZEIGER ALS BUCHSTABE DARSTELLEN */ 
/* ----------------------------------- */ 

MAUSBUCHSTABE:PROC; 
  DCL M(22)BTZ; 
  M(01)='00000000000000'B; 
  M(02)='00111111111100'B; 
  M(03)='01000000000010'B; 
  M(20)='01000000000010'B; 
  M(21)='00111111111100'B; 
  M(22)='00000000000000'B; 
  FOR I TO 16 REPEAT; 
    M(I)='01000000000010'B OR (CHAR(1,I) SHIFT(-3)); 
    END; 
  CALL MAUSZEIGERAENDERN(M,7,7,14,22); 
  END; 


/* MAUSZEIGER ALS SCHREIBSTIFT DARSTELLEN */ 
/* -------------------------------------- */ 

MAUSSTIFT:PROC; 
  DCL M(14)BTZ;
  M(01)='0000000000000000'B;
  M(02)='0000000011110000'B;
  M(03)='0000000111111110'B;
  M(04)='0000001000011100'B;
  M(05)='0000010010001000'B;
  M(06)='0000100100110000'B;
  M(07)='0001001001100000'B;
  M(08)='0010010011000000'B;
  M(09)='0111100110000000'B;
  M(10)='0111111110000000'B;
  M(11)='0111111000000000'B;
  M(12)='0111100000000000'B;
  M(13)='0110000000000000'B;
  M(14)='0000000000000000'B;
  CALL MAUSZEIGERAENDERN(M,1,13,16,14);
  END; 


/* MAUSZEIGER ALS RADIERGUMMI DARSTELLEN */ 
/* ------------------------------------- */ 

MAUSRADIERGUMMI:PROC; 
  DCL M(14)BTZ;
  M(01)='0000000000000000'B;
  M(02)='0000000001111000'B;
  M(03)='0000000010000100'B;
  M(04)='0000000100000010'B;
  M(05)='0000001000000100'B;
  M(06)='0000011000001000'B;
  M(07)='0000111110010000'B;
  M(08)='0001111111100000'B;
  M(09)='0010001111000000'B;
  M(10)='0111110110000000'B;
  M(11)='0111110100000000'B;
  M(12)='0011111000000000'B;
  M(13)='0001110000000000'B;
  M(14)='0000000000000000'B;
  CALL MAUSZEIGERAENDERN(M,4,11,16,14);
  END; 


/* TESTE, OB MAUSZEIGER AUF EIN PIXEL ZEIGT */ 
/* ---------------------------------------- */ 

ONPIXEL:PROC((X,Y)FIX IDENT) RETURNS(BIT); 
  X=(X-2-BUTTON(09).L)//2; 
  Y=(Y-2-BUTTON(09).O)//2; 
  IF X<0 OR X>60 OR Y<0 OR Y>124 THEN RETURN(FALSE);FIN; 
  IF (X REM 8)>=6 OR (Y REM 8)>=6 THEN RETURN(FALSE);FIN; 
  X=1+X//8; 
  Y=1+Y//8; 
  RETURN(TRUE); 
  END; 


/* PROZEDUR ZUM ZEICHEN MALEN */ 
/* -------------------------- */ 

PAINT:PROC(B BIT); /* TRUE: SETZEN, FALSE: LÖSCHEN */ 

DCL (X,Y) FIX; 
IF B THEN CALL MAUSSTIFT;ELSE CALL MAUSRADIERGUMMI;FIN; 
WHILE ML OR MR REPEAT; 
  X=MX;Y=MY; 
  IF ONPIXEL(X,Y) 
    THEN 
      IF CHARX(1,Y).BIT(X)/=B 
        THEN 
          CHARX(1,Y).BIT(X)=B; 
          CALL HIDEMAUS; 
          CALL SETPIX(BUTTON(10).L-1+X,BUTTON(10).O-1+Y,TOFIX(B)); 
          X=BUTTON(09).L-16+16*X; 
          Y=BUTTON(09).O-16+16*Y; 
          IF B THEN CALL SPRITS(X,Y,16,16,SCREEN,PIX1); 
               ELSE CALL SPRITS(X,Y,16,16,SCREEN,PIX0); 
               FIN; 
          CALL SHOWMAUS; 
        FIN; 
    FIN; 
  AFTER 0.02 SEC RESUME; 
  END; 
CALL MAUSZEIGER;
END; 


/* BESTIMME, WELCHES ZEICHEN IM FONT GEMEINT IST */ 
/* --------------------------------------------- */ 

BESTIMMECHAR:PROC RETURNS(FIX); 
DCL (X,Y)FIX; 
X=(BX-BUTTON(08).L)//15; 
Y=(BY-BUTTON(08).O)//21; 
IF X<0 OR Y<0 OR X>=16 OR Y>=16 
  THEN RETURN(0); 
  ELSE RETURN(X+16*Y+1); 
  FIN; 
END; 


/* VERSCHIEBE EIN ZEICHEN IM SCREEN */ 
/* -------------------------------- */ 

MOVECHAR:PROC(C(,)BTX IDENT,F(,)BIT(8)IDENT); 

DCL N FIX; 

FOR I TO 16 REPEAT; 
  CHAR1(1,I)=C(1,I); 
  END; 
CALL MAUSBUCHSTABE;
CALL WARTE;
CASE ABS(TASTE)-25 
  ALT;/* AKT.CHAR */ 
    CALL LADECHAR(C,C);    /* ALTE UND AKT. VERSION BESETZEN */ 
  ALT; 
  ALT;/* FONT */ 
    N=BESTIMMECHAR; 
    IF N/=0 
      THEN CALL TOFONT(N,C,F); 
           CALL PRINTN(N,F); 
      FIN; 
  OUT; 
  FIN; 
CALL MAUSPFEIL;
END; 


/* ZEICHEN AUS DEM FONT AUFNEHMEN */ 
/* ------------------------------ */ 

MOVEFROMFONT:PROC(F(,)BIT(8)IDENT); 
  DCL N FIX; 
  N=BESTIMMECHAR;IF N==0 THEN RETURN;FIN; 
  CALL FROMFONT(N,CHAR1,F); 
  CALL MOVECHAR(CHAR1,F); 
  END; 


/* VERTEILER FUER MAUS-MENUE (UNTERSTER LEVEL) */ 
/* ------------------------------------------- */ 

HAUPTMENUE:PROC(F(,)BIT(8) IDENT); 

REPEAT; 
  CALL WARTE; 
  CASE ABS(TASTE) 
    ALT /* 01 */;CALL WEITEREINFORMATIONEN; 
    ALT /* 02 */;CALL COPYRIGHTMESSAGE;CALL MAUSCOPYRIGHT;
    ALT /* 03 */;CALL BEENDEPROGRAMM; 
    ALT /* 04 */;CALL MOVEFROMFONT(F);      /* GES-FONT    */ 
    ALT /* 05 */;CALL PAINT(TASTE>0);       /* EDITIER-BOX */ 
    ALT /* 06 */;CALL MOVECHAR(CHARX,F);    /* AKT.CHAR.ORIG.GRÖßE */ 
    ALT /* 07 */;CALL CLEARCHAR;            /* AKT.CHAR.LÖSCHEN */ 
    ALT /* 08 */;CALL INVERTCHAR;           /* EDIT-FELD INVERTIEREN */ 
    ALT /* 09 */;CALL VMIRRORCHAR; 
    ALT /* 10 */;CALL LOESCHEN; 
    ALT /* 11 */;CALL GRUESSE; 
    ALT /* 12 */;CALL KOPIEREN(F); 
    ALT /* 13 */;CALL DOC; 
    ALT /* 14 */;CALL LADECHAR(CHARY,CHARY);   /* UNDO */ 
    ALT /* 15 */;CALL PAUSE; 
    ALT /* 16 */;CALL INFOUEBERFEHLER; 
    ALT /* 17 */;CALL XMIRRORCHAR; 
    ALT /* 18 */;CALL LROLLCHAR; 
    ALT /* 19 */;CALL RROLLCHAR; 
    ALT /* 20 */;CALL UROLLCHAR; 
    ALT /* 21 */;CALL DROLLCHAR; 
    ALT /* 22 */;CALL HMIRRORCHAR; 
    OUT /* 23 */; 
    FIN; 
  END; 
END; 


/* ALLGEMEINE INITIALISIERUNGEN */ 
/* ---------------------------- */ 

ALLGINIT:PROC; 
  PIX0(1,01)='FFFF'B4; 
  PIX0(1,16)='FFFF'B4; 
  FOR I FROM 2 TO 15 REPEAT;PIX0(1,I)='8001'B4;END; 
  FOR I TO 16 REPEAT;PIX1(1,I)=NOT PIX0(1,I);END; 
  CALL INITIALISIEREBUTTONS; 
  END; 


/* DIE HAUPTTASK ! */ 
/* --------------- */ 

FONTEDITOR:TASK PRIO 6; 
  DCL FONT(256,16) BIT(8); 
  CALL INITMAUS(SCREEN);
  CALL ALLGINIT; 
  CALL STARTMAUS; 
  CALL GETSYSFOND(FONT); 
  CALL PRINTFONT(FONT); 
  CALL FROMFONT(5,CHARX,FONT);   /* '$' */ 
  CALL LADECHAR(CHARX,CHARX); 
  CALL HAUPTMENUE(FONT); 
  END; 

MODEND;