MODULE SYMDES;
FROM SYSTEM IMPORT ADDRESS,ADR,WORD;
FROM MAINREAD IMPORT EDITPREP,EDIT,BLANK,entrych,exitch;
FROM NUMIO IMPORT STRTOCARD,WRCARD;
FROM STDIO IMPORT GOTOXY,WRSTR,WAITKEY,CLS,
               PRINTABLE,RDSTR,GETKEY,MODECHNG;
FROM SDHEX IMPORT side,HEIGHT,sidetyp,setside,SHRINK,
               MAGNIFY,SHOWSYMS,INVERT,SYMBOLX,sideoff,rightst,symwid;
FROM DATA IMPORT CLEAR,MOVE,SWAPBYTE;
FROM FASTO IMPORT WRITEAT;
FROM DRIVES IMPORT LOAD,SAVE,RDROOM,RDEXISTS,FileLen;
IMPORT GRAPH0,R2MATH;
CONST SYMLIST=0C000H;
CONST edit  =07I;
      left  =08I;
      right =09I;
      down  =0AI;
      up    =0BI;
      enter =0DI;
VAR   RW,sholen,bwid:SHORTCARD;
TYPE rowtyp=ARRAY [0..15] OF CHAR;
     SYMTYP=ARRAY [0..23] OF CARDINAL;
VAR [5800H] ATTRS:ARRAY [0..23] OF ARRAY [0..31] OF CHAR;
VAR LISTNO,LISTSIZ,SYMSIZ:CARDINAL;
    SY0,SY1,SY2:ADDRESS;
    SYMSTO:ARRAY [0..2] OF SYMTYP;
PROCEDURE EDITCARD(L:SHORTCARD;lo,hi:CARDINAL):CARDINAL;
VAR S:ARRAY [0..4] OF CHAR;
    OK:BOOLEAN;
    N:CARDINAL;
BEGIN EDITPREP(L);S[0]:='';
LOOP
  REPEAT EDIT(S) UNTIL exitch=enter;
  N:=STRTOCARD(S,OK);
  IF OK THEN
    IF (N>=lo) AND (N<=hi) THEN RETURN N
     ELSE GOTOXY(1,23);WRSTR('Not between ');WRCARD(lo,0);
      WRSTR(' and ');WRCARD(hi,0) END;
   ELSE WRITEAT(1,23,'Not a CARDINAL number') END;
  entrych:=WAITKEY();BLANK(1,23,22) END
END EDITCARD;

PROCEDURE GETCARD(VAR N:CARDINAL;X,Y,MAX:CARDINAL);
VAR ch:CHAR;
BEGIN
GOTOXY(X,Y);WRCARD(N,3);
LOOP
  ch:=WAITKEY();
  IF ch=enter THEN EXIT END;
  IF (ch>='0') AND (ch<='9') THEN 
    entrych:=ch;
    BLANK(X,Y,3);
    N:=EDITCARD(3,0,MAX);
    EXIT END END;
END GETCARD;

PROCEDURE CLEARA(HIGH:CARDINAL;AD:ADDRESS);
HEX C3 (@CLEAR) END CLEARA;
 
PROCEDURE BMODECHNG(ch:CHAR);
HEX 3C 3C 3C E6 07 D3 FE C9 END BMODECHNG;
 
PROCEDURE MOVEROW(SRC:ARRAY OF WORD;VAR DST:ARRAY OF WORD);
BEGIN
MOVE(ADR(SRC[0]),ADR(DST[0]),symwid)
END MOVEROW;
 
PROCEDURE NORMAT;
VAR I:CARDINAL;
BEGIN
FOR I:=0 TO HEIGHT-1 DO
  (* '8' = 38 hex = Normal attribute *)
  MOVEROW('8888888888888888',ATTRS[I,sideoff]) END
END NORMAT;
 
PROCEDURE LOOKCH(X,YD:CARDINAL):CHAR;
VAR ch:CHAR;
BEGIN
MAGNIFY(X,YD);
INVERT(X,YD);
ch:=WAITKEY();
INVERT(X,YD);
RETURN ch
END LOOKCH;

VAR SX,SYD:CARDINAL;
PROCEDURE SCRGRAB(SY:ADDRESS);
CONST sh=GRAPH0.height-1;
      sw=GRAPH0.width-1;
BEGIN
IF SX<sw DIV 2+symwid THEN setside(RIGHT)
 ELSE setside(LEFT) END;
LOOP
  CASE LOOKCH(SX,SYD) OF
   up:IF SYD>0 THEN DEC(SYD) END|
   down:IF SYD+HEIGHT<=sh THEN INC(SYD) END|
   left:IF SX>0 THEN
     IF SX=(sw-symwid) DIV 2 THEN NORMAT;setside(RIGHT) END;
     DEC(SX) END|
   right:IF SX+symwid<=sw THEN
      IF SX=(sw-symwid) DIV 2+1 THEN NORMAT;setside(LEFT) END;
     INC(SX) END|
   enter:SHRINK(SY);setside(RIGHT);RETURN END END;
END SCRGRAB;
 
PROCEDURE FROMLIST(SY:ADDRESS;N1:CARDINAL);
VAR NSHO,M,X:CARDINAL;
BEGIN
CLS;setside(RIGHT);M:=0;
LOOP
  NSHO:=LISTSIZ-N1;IF NSHO>sholen THEN NSHO:=sholen END;
  SHOWSYMS(SYMLIST+N1*SYMSIZ,NSHO);
  LOOP
    X:=symwid*M;
    CASE LOOKCH(X,0) OF
     right:IF M<NSHO-1 THEN INC(M)
       ELSIF N1+NSHO<LISTSIZ THEN INC(N1);EXIT END|
     left:IF M>0 THEN DEC(M)
       ELSIF N1>0 THEN DEC(N1);EXIT END|
     enter:SHRINK(SY);RETURN END END END
END FROMLIST;
 
PROCEDURE FROMEM(SY,AD:ADDRESS);
VAR X,M:CARDINAL;
BEGIN
CLS;setside(RIGHT);M:=0;
LOOP
  SHOWSYMS(AD,sholen);
  LOOP
    X:=symwid*M;
    CASE LOOKCH(X,0) OF
     right:IF M<sholen-1 THEN INC(M)
       ELSE (*$E- *) AD:=AD+SYMSIZ;EXIT END|
     left:IF M>0 THEN DEC(M)
       ELSE AD:=AD-SYMSIZ; (*$E/*) EXIT END|
     enter:SHRINK(SY);RETURN END END END
END FROMEM;

VAR SYMAD,SYMNO:CARDINAL;
    sname:ARRAY [0..10] OF CHAR;
PROCEDURE GETSYMBOL(SY:ADDRESS):BOOLEAN;
VAR n,y:CARDINAL;
    ch:CHAR;
    l:ARRAY [1..5] OF SHORTCARD;
BEGIN
CLS;l[1]:=10;l[2]:=3;l[3]:=5;l[4]:=10;l[5]:=4;
WRITEAT(2,1,'Options for loading symbol');
GOTOXY(1,4);WRSTR('Screen -    Name: ');WRSTR(sname);
GOTOXY(1,6);WRSTR('List   -  Number: ');WRCARD(SYMNO,2);
GOTOXY(1,8);WRSTR('Memory - Address: ');WRCARD(SYMAD,5);
WRITEAT(19,10,'New Symbol ');
WRITEAT(19,12,'Exit');
n:=1;
LOOP y:=2+2*n;
  GRAPH0.SETATTRS(19,y,l[n],30H);
  ch:=WAITKEY();
  GRAPH0.SETATTRS(19,y,l[n],38H);
  IF (PRINTABLE(ch) OR (ch=edit)) AND (n<=3) THEN
    entrych:=ch;ch:=enter;GOTOXY(19,y);
    CASE n OF
      1:RDSTR(sname)|
      2:SYMNO:=EDITCARD(5,0,LISTSIZ)|
      3:SYMAD:=EDITCARD(5,0,65535) END END;
  CASE ch OF
   up:IF n>1 THEN DEC(n) END|
   down:IF n<5 THEN INC(n) END|
   enter:CASE n OF
    1:LOAD(15,sname,4000H);
     IF NOT RDEXISTS(sname) AND (RDROOM()>=6) THEN
       SAVE(13,sname,4000H,1800H) END;
     SCRGRAB(SY)|
    2:FROMLIST(SY,SYMNO)|
    3:FROMEM(SY,SYMAD)|
    4:CLEARA(SYMSIZ-1,SY)|
    5:RETURN FALSE END;
   RETURN TRUE END END;
END GETSYMBOL;
 
PROCEDURE SWAPSYM(S1,S2:ADDRESS);
VAR ST:SYMTYP;
BEGIN
MOVE(S1,ADR(ST),SYMSIZ);
MOVE(S2,S1,SYMSIZ);
MOVE(ADR(ST),S2,SYMSIZ);
END SWAPSYM;

PROCEDURE WAITINT;
HEX FB 76 C9 END WAITINT;
 
VAR HW:INTEGER;
PROCEDURE DEMO;
VAR T:REAL2;
    IT:CARDINAL;
    X1,Y1,X2,Y2,
    X1OLD,Y1OLD,X2OLD,Y2OLD:INTEGER;
    HH,DY,DX:INTEGER;
BEGIN
CLS;IT:=0;HH:=HEIGHT DIV 2;
DX:=2;DY:=1;X2:=HW;Y2:=HH;
X1:=128;Y1:=96;
  SYMBOLX(X1,Y1,HEIGHT-1,SY1,2);
  SYMBOLX(X2,Y2,HEIGHT-1,SY1,2);
REPEAT
  X1OLD:=X1;X2OLD:=X2;Y1OLD:=Y1;Y2OLD:=Y2;
  INC(IT);
  T:=RL2(IT)/RL2(100);
  X1:=128+INT(RL2(144)*R2MATH.SIN(T));
  Y1:=96+INT(RL2(64)*R2MATH.SIN(RL2(2)*T));
  X2:=X2+DX;Y2:=Y2+DY;
  IF (X2<HW) OR (X2>255-HW) THEN DX:=-DX END;
  IF (Y2<HH) OR (Y2>191-HH) THEN DY:=-DY END;
  WAITINT;
  SYMBOLX(X1OLD,Y1OLD,HEIGHT-1,SY1,2);
  SYMBOLX(X1,Y1,HEIGHT-1,SY1,2);
  SYMBOLX(X2OLD,Y2OLD,HEIGHT-1,SY1,2);
  SYMBOLX(X2,Y2,HEIGHT-1,SY1,2);
  UNTIL GETKEY()=edit;
END DEMO;
 
VAR rowbuf:rowtyp;
    colbuf:ARRAY[0..23] OF CHAR;
PROCEDURE DESIGNSYMBOL;
VAR SH,X,Y,XSIZ,YSIZ,SIZ:CARDINAL;
    n,i:CARDINAL;
    CURP:POINTER TO CHAR;
    P1,P2,P3,P4:ADDRESS;
    ch,T,dch,direct:CHAR;
    dum,drag,vis2:BOOLEAN;
    B1,B2:BITSET;
    rowtemp:rowtyp;
BEGIN
CLS;
MOVE(SY1,SY0,SYMSIZ);
SH:=HEIGHT-1;
setside(RIGHT);
SHOWSYMS(SY1,2);MAGNIFY(0,0);
drag:=FALSE;direct:=right;vis2:=FALSE;
X:=0;Y:=0;
LOOP
  CURP:=ADR(ATTRS[Y,sideoff+X]);
  T:=CURP^;
  IF T=0I THEN CURP^:=24I ELSE CURP^:=7FI END;
  ch:=WAITKEY();
  CURP^:=T;
  CASE ch OF
   enter:EXIT|
   left..up:CASE ch OF
     up:IF Y>0 THEN DEC(Y) END|
     down:IF Y<SH THEN INC(Y) END|
     left:IF X>0 THEN DEC(X) END|
     right:IF X<RW THEN INC(X) END END;
    IF drag THEN ATTRS[Y,sideoff+X]:=dch END|
   ' ','0':
    IF ch=' ' THEN CURP^:=CHR(3FH)
     ELSE CURP^:=CHR(0) END;
    CASE direct OF
      right:IF X=RW THEN
        IF Y<>SH THEN INC(Y);X:=0 END
       ELSE INC(X) END|
      left:IF X=0 THEN
        IF Y<>SH THEN INC(Y);X:=RW END
       ELSE DEC(X) END|
      down:IF Y=SH THEN
        IF X<>RW THEN INC(X);Y:=0 END
       ELSE INC(Y) END|
      up:IF Y=0 THEN
        IF X<>RW THEN INC(X);Y:=SH END
       ELSE DEC(Y) END END|
   CHR(228):drag:=NOT drag;
    dch:=CURP^|
   CHR(8AH):P1:=ADR(ATTRS[Y,sideoff+0]);T:=CHAR(P1^);
    MOVE(P1+1,P1,RW);ATTRS[Y,sideoff+RW]:=T|
   CHR(89H):T:=ATTRS[SH,sideoff+X];
    FOR n:=SH TO 1 BY -1 DO
      ATTRS[n,sideoff+X]:=ATTRS[n-1,sideoff+X] END;
      ATTRS[0,sideoff+X]:=T;|
   CHR(88H):T:=ATTRS[0,sideoff+X];
    FOR n:=0 TO SH-1 DO
      ATTRS[n,sideoff+X]:=ATTRS[n+1,sideoff+X] END;
      ATTRS[SH,sideoff+X]:=T|
   CHR(8FH):P1:=ADR(ATTRS[Y,sideoff+0]);T:=ATTRS[Y,sideoff+RW];
    MOVE(P1,P1+1,RW);P1^:=WORD(T)|
   '+':FOR n:=SH TO Y+1 BY -1 DO
      MOVEROW(ATTRS[n-1,sideoff],ATTRS[n,sideoff]) END ;
    MOVEROW(rowbuf,ATTRS[Y,sideoff])|
   '-':MOVEROW(ATTRS[Y,sideoff],rowbuf);
    FOR n:=Y TO SH-1 DO
      MOVEROW(ATTRS[n+1,sideoff],ATTRS[n,sideoff]) END;
    (* '?' = 3F hex = white attribute *)
    MOVEROW('????????????????',ATTRS[SH,sideoff])|
   '*':FOR n:=0 TO SH DO P1:=ADR(ATTRS[n,sideoff+X]);
      MOVE(P1,P1+1,RW-X);P1^:=WORD(colbuf[n]) END |
   '/':FOR n:=0 TO SH DO P1:=ADR(ATTRS[n,sideoff+X]);
      colbuf[n]:=CHAR(P1^);MOVE(P1+1,P1,RW-X);
      ATTRS[n,sideoff+RW]:=3FI END|
   CHR(1FH):direct:=up|
   CHR(1EH):direct:=down|
   CHR(1DH):direct:=left|
   CHR(0):direct:=right|
   0C7I:FOR n:=SH TO 0 BY -1 DO
      FOR i:=RW TO 0 BY -1 DO
        ATTRS[n,sideoff+i]:=ATTRS[n DIV 2,sideoff+i DIV 2] END END|
   60I,0C5I,0C6I:MOVE(SY1,SY0,SYMSIZ);
    FOR n:=0 TO SH DO
      FOR i:=0 TO bwid-1 DO
        P1:=SY1+bwid*n+i;P2:=SY2+bwid*n+i;
        B1:=BITSET(P1^);B2:=BITSET(P2^);
        CASE ch OF
         60I:B1:=B1/B2|
         0C5I:B1:=B1+B2|
         0C6I:B1:=B1*B2 END;
        P1^:=WORD(B1) END END;
    SHOWSYMS(SY1,1);MAGNIFY(0,0)|
   '.':FOR n:=0 TO SH DIV 2 DO
      MOVEROW(ATTRS[n,sideoff],rowtemp);
      MOVEROW(ATTRS[SH-n,sideoff],ATTRS[n,sideoff]);
      MOVEROW(rowtemp,ATTRS[SH-n,sideoff]) END|
   ',':FOR n:=0 TO SH DO
      FOR i:=0 TO RW DIV 2 DO
        SWAPBYTE(ATTRS[n,sideoff+i],ATTRS[n,sideoff+RW-i]) END END|
   05I:FOR n:=0 TO SH DO
      P1:=ADR(ATTRS[n,sideoff]);
      FOR i:=0 TO RW DO
        P1^:=WORD({0..5}/BITSET(P1^));
        P1:=P1+1 END END|
   '<':SIZ:=RW;IF SIZ>SH THEN SIZ:=SH END;
    YSIZ:=SIZ DIV 2;XSIZ:=SIZ-YSIZ-1;
    FOR n:=0 TO YSIZ DO
      P1:=ADR(ATTRS[n,sideoff]);
      P2:=ADR(ATTRS[0,sideoff+SIZ-n]);
      P3:=ADR(ATTRS[SIZ-n,sideoff+SIZ]);
      P4:=ADR(ATTRS[SIZ,sideoff+n]);
      FOR i:=0 TO XSIZ DO
        T:=CHAR(P4^);P4^:=P3^;P3^:=P2^;
        P2^:=P1^;P1^:=WORD(T);
        P1:=P1+1;P2:=P2+32;P3:=P3-1;P4:=P4-32 END END|
   '@',12I,'=',edit:CASE ch OF
     '@':vis2:=NOT vis2|
     12I:SWAPSYM(SY1,SY2)|
     edit:DEMO|
     '=':dum:=GETSYMBOL(SY2) END;
    CLS;SHOWSYMS(SY1,2);MAGNIFY(0,0);
    setside(LEFT);
    IF vis2 THEN MAGNIFY(symwid,0)
     ELSE NORMAT END;setside(RIGHT)|
   18I:SWAPSYM(SY1,SY0);
     SHOWSYMS(SY1,1);MAGNIFY(0,0) END;
  SHRINK(SY1);
  SHOWSYMS(SY1,1) END
END DESIGNSYMBOL;
 
PROCEDURE PUTSYMBOL;
BEGIN
CLS;SYMNO:=LISTSIZ;
WRITEAT(1,4,'Position in list for symbol? ');
GETCARD(SYMNO,1,5,LISTSIZ);
MOVE(SY1,SYMLIST+SYMSIZ*SYMNO,SYMSIZ);
IF SYMNO=LISTSIZ THEN INC(LISTSIZ) END;
END PUTSYMBOL;
 
VAR lname:ARRAY [0..9] OF CHAR;
    l:CARDINAL;
BEGIN
CLS;SX:=0;SYD:=0;SYMAD:=49152;sname:='';SYMNO:=0;
WRITEAT(0,1,'Enter width of symbols (8 or 16)');
GOTOXY(0,2);symwid:=EDITCARD(2,8,16);
WRITEAT(0,4,'Enter height of symbols (1-24) ');
GOTOXY(0,5);HEIGHT:=EDITCARD(2,1,24);
IF symwid=8 THEN HW:=4;
  sholen:=24;bwid:=1;rightst:=24;
 ELSE symwid:=16;HW:=8;
  sholen:=8;bwid:=2;rightst:=16 END;
RW:=symwid-1;SYMSIZ:=bwid*HEIGHT;
SY0:=ADR(SYMSTO);
SY1:=SY0+SYMSIZ;SY2:=SY1+SYMSIZ;
FileLen:=SYMSIZ*20;
WRITEAT(0,7,'Enter name of file to load ');
GOTOXY(0,8);RDSTR(lname);
IF lname[0]<>0I THEN
  LOAD(15,lname,SYMLIST);
  l:=FileLen;
  LISTSIZ:=l DIV SYMSIZ;
 ELSE LISTSIZ:=0 END;
WRITEAT(0,10,'How many symbols?');
GETCARD(LISTSIZ,0,11,999);
CLEAR(rowbuf);CLEAR(colbuf);
LOOP
  IF NOT GETSYMBOL(SY1) THEN EXIT END;
  MODECHNG:=BMODECHNG;
  DESIGNSYMBOL;
  PUTSYMBOL END;
CLS;WRITEAT(0,5,'Enter name of file to save ');
GOTOXY(0,6);RDSTR(lname);
IF lname[0]<>0I THEN
  SAVE(15,lname,SYMLIST,SYMSIZ*LISTSIZ) END
END SYMDES.
