(***************************************************************************
 :Program.    Cross
 :Author.     Jürgen Weinelt
 :Address.    Zur Kanzel 1, D-8783 Hammelburg, Germany
 :Version.    V3.3
 :Copyright.  Freeware; copy it, but don't sell it!
 :Language.   Modula-II
 :Translator. M2Amiga V3.32d
 :Imports.    CPCDosIO
 :Imports.    CPCError
 :Imports.    CPCGads
 :Imports.    CPCGlobal
 :Imports.    CPCPrint
 :Imports.    CPCRequesters
 :Imports.    CPCShowAll
 :Imports.    CPCSleep
 :Imports.    FileReq
 :Contents.   Program to create crossword puzzles.
 :Contents.   Features Intuition interface, filerequesters, and a special
 :Contents.   message data file to allow easy translation into any
 :Contents.   (human) language without changing the source code.
 :History.    V3.2  08-jan-91  first major release of M2 version on AMOK
 :History.    V3.3  06-feb-91  PAL/NTSC support added
 **************************************************************************)



MODULE Cross;



FROM Arguments
 IMPORT NumArgs,GetArg;

FROM Arts
 IMPORT TermProcedure,Assert,Terminate,CurrentLevel;

FROM ASCII
 IMPORT nul;

FROM Conversions
 IMPORT ValToStr;

FROM CPCDosIO
 IMPORT Value,ReadWords,LoadData,SaveData,ReadMsg,PrintCross,PrintSolution,
        InitCPCDosIO,msgmode;

FROM CPCError
 IMPORT myAssert;

FROM CPCGads
 IMPORT ShowCommands,AllGadsOff;

FROM CPCGlobal
 IMPORT string,lstring,stringlen,lstringlen,rastport,viewport,msg,maxmsg,
        switch,search,show,screen,window,stat,column,field,yoff,blankC,
        wordfield,puzzlewordfield,text,kwr,words,hori,vert,xmax,ymax,
        maxgrid,topaz;

FROM CPCPrint
 IMPORT Cls,Print,PrintAtC,PrintAtS,ClrLine;

FROM CPCRequesters
 IMPORT HoriOrVert,InputLine,YesOrNo;

FROM CPCShowAll
 IMPORT CharPos,ShowAll;

FROM CPCSleep
 IMPORT NormalPointer,SleepPointer;

FROM Graphics
 IMPORT SetRGB4;

FROM InOut
 IMPORT WriteLn,WriteString,WriteInt;

FROM IntuiIO
 IMPORT OpenScreen,CloseScreen,GetViewPort,OpenWindow,CloseWindow,
        WindowRastPort,GetMessage,ReadMessage,GetGadgetId,AddIntuiMsg,
        ScreenRastPort,GetMouse,
        WINDOW,SCREEN,GADGET,ScreenType,ScreenTypeSet,
        IntuiMsg,IntuiMsgSet,WindowType,WindowTypeSet,MousPos;

IMPORT IntuiIO;

FROM Intuition
 IMPORT CurrentTime,IntuitionBasePtr;

IMPORT Intuition;

FROM RandomNumber
 IMPORT RND,PutSeed;

FROM Strings
 IMPORT Copy,Compare,Length;

FROM Str
 IMPORT CapString;

FROM SYSTEM
 IMPORT ADR;



CONST
 progtitle="Crossword Puzzle Creator V3.3 *** ©1991 by J.Weinelt";
 spcs="                                                                           ";
 limitbase=24;
 lowerylimit=5;
(* upperylimit=35; !!! now VAR: PAL/NTSC support added 06-feb-91 !!! *)
(* defmsgline=27;  ^^^ same as above ^^^ *)
 defxsize=19;
 defysize=19;
 lowerxlimit=5;
 upperxlimit=39;



TYPE
 direction=(horizontal,vertical);



VAR
 dir,dir0: direction;
 w,progname,tmp: string;
 loop,word,wlen,x,y,cmp,num: INTEGER;
 xloop,yloop,x0,y0,w0,len0,outerloop: INTEGER;
 val0,tempH,tempV: INTEGER;
 doH,booldummy: BOOLEAN;
 limit,dummy,narg,msgline: INTEGER;
 sec,micro: LONGINT;
 msgmd: msgmode;
 underl,scrname,winname: lstring;
 ibase: IntuitionBasePtr;
 pal: BOOLEAN;
 upperylimit,defmsgline: INTEGER;



PROCEDURE CoolDown;
 BEGIN
  IF (window#NIL) THEN
   CloseWindow(window);
  END;
  IF (screen#NIL) THEN
   CloseScreen(screen);
  END;
 END CoolDown;



PROCEDURE MakeString(b: INTEGER; c: CHAR; VAR a: ARRAY OF CHAR);
 VAR loop: INTEGER;
 BEGIN
  FOR loop:=0 TO b-1 DO
   a[loop]:=c;
  END;
  a[b]:=nul;
 END MakeString;



PROCEDURE check(w: ARRAY OF CHAR): BOOLEAN;
 VAR
  f: BOOLEAN;
  loop: INTEGER;
 BEGIN
  f:=FALSE;
  FOR loop:=0 TO hori+vert DO
   f:=f OR (Compare(kwr[loop],0,stringlen,w,FALSE)=0);
  END;
  RETURN f;
 END check;



PROCEDURE testH(VAR w: ARRAY OF CHAR; x,y,len,rlen,ref: INTEGER): INTEGER;
 VAR v,loop: INTEGER;
     f: BOOLEAN;
 BEGIN
  IF (x+len<=xmax) AND (text[x-1,y]=nul) AND (text[x+len+1,y]=nul) THEN
   f:=FALSE;
   v:=0;
   FOR loop:=x TO x+len DO
    IF (w[loop-x]=text[loop,y]) THEN
     v:=v+1;
     (* if char matches AND there's a non-nul char before OR after *)
     (* this position, then we better get out of here... to avoid  *)
     (* something like "life" being matched with "lifeforms"!      *)
     IF (text[loop-1,y]#nul) OR (text[loop+1,y]#nul) THEN
      loop:=x+len+1;
      f:=TRUE;
     END;
    ELSE
     IF (text[loop,y-1]#nul) OR (text[loop,y+1]#nul) OR (text[loop,y]#nul) THEN
      loop:=x+len+1;
      f:=TRUE;
     END;
    END;
   END;
   IF (NOT f) THEN
    IF (v>ref) OR
       ((v=ref) AND (ref>0) AND ((len>rlen) OR
                                ((len=rlen) AND (RND(10)<2)))) THEN
     RETURN v;
    END;
   END;
  END;
  RETURN -1;
 END testH;



PROCEDURE testV(VAR w: ARRAY OF CHAR; x,y,len,rlen,ref: INTEGER): INTEGER;
 VAR v,loop: INTEGER;
     f: BOOLEAN;
 BEGIN
  IF (y+len<=ymax) AND (text[x,y-1]=nul) AND (text[x,y+len+1]=nul) THEN
   f:=FALSE;
   v:=0;
   FOR loop:=y TO y+len DO
    IF (w[loop-y]=text[x,loop]) THEN
     v:=v+1;
     (* if char matches AND there's a non-nul char before OR after *)
     (* this position, then we better get out of here... to avoid  *)
     (* something like "life" being matched with "lifeforms"!      *)
     IF (text[x,loop-1]#nul) OR (text[x,loop+1]#nul) THEN
      loop:=y+len+1;
      f:=TRUE;
     END;
    ELSE
     IF (text[x-1,loop]#nul) OR (text[x+1,loop]#nul) OR (text[x,loop]#nul) THEN
      loop:=y+len+1;
      f:=TRUE;
     END;
    END;
   END;
   IF (NOT f) THEN
    IF (v>ref) OR
       ((v=ref) AND (ref>0) AND ((len>rlen) OR
                                ((len=rlen) AND (RND(10)<2)))) THEN
     RETURN v;
    END;
   END;
  END;
  RETURN -1;
 END testV;



PROCEDURE Place(a: ARRAY OF CHAR; x,y,len: INTEGER; d: direction);
 VAR
  loop: INTEGER;
 BEGIN
  Copy(kwr[hori+vert],a,0,stringlen);
  IF (d=horizontal) THEN
   INC(hori);
   FOR loop:=x+1 TO x+len+1 DO
    text[loop,y+1]:=a[loop-x-1];
   END;
  ELSE
   INC(vert);
   FOR loop:=y+1 TO y+len+1 DO
    text[x+1,loop]:=a[loop-y-1];
   END;
  END;
 END Place;



PROCEDURE status;
 VAR tmp: string;
     dummy: BOOLEAN;
     lx,ly: INTEGER;
     cnt,net: LONGINT;
 BEGIN
  cnt:=0; net:=0;
  FOR lx:=1 TO xmax DO
   FOR ly:=1 TO ymax DO
    IF (text[lx,ly]#nul) THEN
     INC(cnt);
     IF ((text[lx+1,ly]#nul) OR (text[lx-1,ly]#nul)) AND
        ((text[lx,ly+1]#nul) OR (text[lx,ly-1]#nul)) THEN
      INC(net);
     END;
    END;
   END;
  END;
  PrintAtS(stat-1,0,msg[26]);
  ValToStr(limit,FALSE,tmp,10,2,"0",dummy);
  Print(tmp,0);
  PrintAtS(stat+Length(msg[26])+2,0,msg[27]);
  ValToStr(hori,FALSE,tmp,10,2,"0",dummy);
  Print(tmp,0);
  PrintAtS(stat+Length(msg[26])+Length(msg[27])+5,0,msg[28]);
  ValToStr(vert,FALSE,tmp,10,2,"0",dummy);
  Print(tmp,0);
  PrintAtS(stat-1,1,msg[29]);
  ValToStr(((cnt*100) DIV (LONGINT(xmax*ymax))),FALSE,tmp,10,2,"0",dummy);
  Print(tmp,0);
  PrintAtS(stat+Length(msg[29])+2,1,msg[30]);
  IF (hori+vert#0) THEN
   ValToStr(((net*200) DIV (LONGINT(hori+vert))),FALSE,tmp,10,3,"0",dummy);
  ELSE
   tmp:="000";
  END;
  Print(tmp,0);
 END status;



PROCEDURE AskCommand;
 VAR cmd: CHAR;
     dummy,length,x,y: INTEGER;
     word: string;
     dummyStr: ARRAY[0..1] OF CHAR;
     imsg: IntuiMsg;
     gadID: INTEGER;
 BEGIN
  imsg:=GetMessage(window);
  IF (imsg=gadgetUp) THEN
   gadID:=GetGadgetId(window);
   CASE gadID OF
    |1: IF (search=on) THEN
         search:=off;
        ELSE
         search:=on;
        END;
        ShowCommands;

    |2: AllGadsOff;
        SleepPointer;
        ClrLine(msgline);
        IF (xmax>ymax) THEN
         length:=xmax;
        ELSE
         length:=ymax;
        END;
        NormalPointer;
        InputLine(word,msg[40],
                  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz",
                  length);
        SleepPointer;
        CapString(word);
        IF Length(word)>0 THEN
         IF (check(word)) THEN
          ClrLine(msgline);
          Print(msg[41],0);
         ELSE
          x:=1; y:=1;
          ClrLine(msgline);
          Print(msg[42],0);
          AddIntuiMsg(window,IntuiMsgSet{mouseButtons});
          NormalPointer;
          REPEAT
           REPEAT
            imsg:=GetMessage(window);
           UNTIL imsg=mouseButtons;
           x:=GetMouse(window,curentX);
           y:=GetMouse(window,curentY);
           CharPos(x,y);
          UNTIL (x>=0) AND (y>=0);
          SleepPointer;
          ClrLine(msgline);

          NormalPointer;
          IF HoriOrVert(msg[43]) THEN
           IF (testH(word,x+1,y+1,Length(word)-1,0,-1)>=0) THEN
            SleepPointer;
            Place(word,x,y,Length(word)-1,horizontal);
            ShowAll;
            ClrLine(msgline);
           ELSE
            SleepPointer;
            ClrLine(msgline);
            Print(msg[44],0);
           END;
          ELSE
           IF (testV(word,x+1,y+1,Length(word)-1,0,-1)>=0) THEN
            Place(word,x,y,Length(word)-1,vertical);
            ShowAll;
            ClrLine(msgline);
           ELSE
            ClrLine(msgline);
            Print(msg[44],0);
           END;
          END;
         END;
        END;
        status;
        ShowAll;
        NormalPointer;
        ShowCommands;

    |3: AllGadsOff;
        SleepPointer;
        ClrLine(msgline);
        Print(msg[46],0);
        PrintCross;
        ClrLine(msgline);
        NormalPointer;
        ShowCommands;

    |4: AllGadsOff;
        SleepPointer;
        ClrLine(msgline);
        Print(msg[47],0);
        PrintSolution;
        ClrLine(msgline);
        NormalPointer;
        ShowCommands;

    |5: AllGadsOff;
        SleepPointer;
        LoadData;
        Cls;
        ShowAll;
        status;
        NormalPointer;
        ShowCommands;

    |6: AllGadsOff;
        SleepPointer;
        SaveData;
        ClrLine(msgline);
        NormalPointer;
        ShowCommands;

    |7: AllGadsOff;
        SleepPointer;
        num:=ReadWords(FALSE);
        ClrLine(msgline);
        status;
        NormalPointer;
        ShowCommands;

    |8: ClrLine(msgline);
        limit:=limitbase;
        Print(msg[49],0);
        status;

    |0: AllGadsOff;
        IF YesOrNo(msg[50]) THEN
         WriteLn; WriteString(msg[51]); WriteLn; WriteLn;
         Terminate(CurrentLevel());
        END;
        ShowCommands;

    |ELSE (* NOP *)
   END;
  END;
 END AskCommand;



BEGIN
 TermProcedure(CoolDown);

 scrname:=progtitle;
 MakeString(Length(scrname),"-",underl);
 narg:=NumArgs();
 xmax:=-1;
 ymax:=-1;
 msgmd:=nonumbers;

 ibase:=ADR(Intuition);
 IF (ibase^.firstScreen#NIL) THEN
  (* try to figure out if this is a PAL or NTSC machine: *)
  (* look at the "height" field of first screen and hope there's any *)
  (* significance to this value *)
  IF ibase^.firstScreen^.height=256 THEN
   (* this is pal resolution *)
   upperylimit:=35;
   defmsgline:=27;
   pal:=TRUE;
  ELSE
   (* anything else means "not pal", i like being on the safe side *)
   upperylimit:=25;
   defmsgline:=20;
   pal:=FALSE;
  END;
 ELSE
  (* there's probably no use showing any error messages if there's no *)
  (* screen present at all... i guess this will never be executed anyway *)
  Terminate(CurrentLevel());
 END;

 FOR loop:=1 TO narg DO
  GetArg(loop,tmp,dummy);
  IF (tmp[0]="-") THEN
   tmp[0]:="0";
   CASE tmp[1] OF
    |"x","X": tmp[1]:="0";
              xmax:=Value(tmp);
              IF ((xmax<lowerxlimit) OR (xmax>upperxlimit) OR (ODD(xmax+1))) THEN
               xmax:=-1;
               WriteString("Illegal value for XSIZE; assuming default value");
               WriteLn;
              END;
    |"y","Y": tmp[1]:="0";
              ymax:=Value(tmp);
              IF ((ymax<lowerylimit) OR (ymax>upperylimit) OR (ODD(ymax+1))) THEN
               ymax:=-1;
               WriteString("Illegal value for YSIZE; assuming default value");
               WriteLn;
              END;
    |"d","D": msgmd:=numbers;
    |ELSE
   END;
  END;
 END;

 GetArg(0,progname,dummy);
 IF (xmax=-1) THEN
  xmax:=defxsize;
 END;
 IF (ymax=-1) THEN
  ymax:=defysize;
 END;
 GetArg(1,tmp,dummy);
 IF (tmp[0]="?") THEN
  WriteLn;
  WriteString(scrname); WriteLn;
  WriteString(underl); WriteLn;
  WriteString("Copyright ©1991 by Jürgen Weinelt, Zur Kanzel 1, D-8783 Hammelburg, Germany."); WriteLn; WriteLn;
  WriteString("Please Note: CPC is FREEWARE; you may copy it, but do not sell it!"); WriteLn; WriteLn;
  WriteString("Usage:"); WriteLn;
  WriteString(progname); WriteString(" [?] [-xXSIZE] [-yYSIZE] [-d]"); WriteLn;
  WriteString(" XSIZE: xsize in chars, ");
  WriteInt(lowerxlimit,0); WriteString("<=x<=");
  WriteInt(upperxlimit,0); WriteString(", default: ");
  WriteInt(defxsize,0); WriteLn;
  WriteString(" YSIZE: ysize in chars, ");
  WriteInt(lowerylimit,0); WriteString("<=y<=");
  WriteInt(upperylimit,0); WriteString(", default: ");
  WriteInt(defysize,0); WriteLn;
  WriteString(" -d:    turn on message numbers (for word file debugging only!)");
  WriteLn;
  WriteString("Please note: XSIZE and YSIZE must be odd!"); WriteLn; WriteLn;
 END;

 IF (tmp[0]#"?") THEN
  ReadMsg(msgmd);

  IF pal THEN
   screen:=OpenScreen(scrname,0,0,640,256,1,ScreenTypeSet{hires});
  ELSE
   screen:=OpenScreen(scrname,0,0,640,200,1,ScreenTypeSet{hires});
  END;
  Assert(screen#NIL,ADR(msg[52]));

  viewport:=GetViewPort(screen);
  SetRGB4(viewport, 0,  0, 0, 0);  (* 0=black *)
  SetRGB4(viewport, 1, 15,15,15);  (* 1=white *)
  SetRGB4(viewport,17,  6, 6, 6);
  SetRGB4(viewport,18, 11,11,11);
  SetRGB4(viewport,19, 15,15,15);


  winname:=scrname;
  IF pal THEN
   window:=OpenWindow(winname,0,0,640,256,
                      WindowTypeSet{activWindow,backDrop,borderless},screen);
  ELSE
   window:=OpenWindow(winname,0,0,640,200,
                      WindowTypeSet{activWindow,backDrop,borderless},screen);
  END;
  Assert(window#NIL,ADR(msg[61]));
  rastport:=WindowRastPort(window);
  topaz:=rastport^.font;
  AddIntuiMsg(window,IntuiMsgSet{gadgetUp});
  InitCPCDosIO;

  msgline:=defmsgline;

  Print("",1);
  Print(scrname,1);
  Print(underl,2);
  Print("©1991 by",1);
  Print("Jürgen Weinelt",1);
  Print("Zur Kanzel 1",1);
  Print("D-8783 Hammelburg",1);
  Print("Germany",2);

  Print("Last changed: 06-Feb-91",2);

  Print("Please note: CPC is FREEWARE; you may copy it, but do not sell it!",2);

  Print("This program was created using M2Amiga and the IntuitionReport and",1);
  Print("GraphicsReport support libraries. Thanks to A+L for these powerful tools.",2);

  Print("Special thanks to the ARP people for their file requester.",2);

  Print(msg[62],0);

  SleepPointer;
  num:=ReadWords(TRUE);

  hori:=0; vert:=0;

  CurrentTime(ADR(sec),ADR(micro));
  PutSeed(sec);

  IF (num>0) THEN
   (* first word *)
   cmp:=10;
   IF (cmp>xmax-2) THEN
    cmp:=xmax-2;
   END;
   REPEAT
    word:=RND(num);
   UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=xmax-2);
   w:=words[word];
   wlen:=Length(w)-1;
   x:=1;
   y:=1;
   dir:=horizontal;
   Place(w,x-1,y-1,wlen,dir);
   words[word]:="";

   (* second word *)
   REPEAT
    word:=RND(num);
   UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=xmax-2);
   w:=words[word];
   wlen:=Length(w)-1;
   x:=xmax-wlen;
   y:=ymax;
   dir:=horizontal;
   Place(w,x-1,y-1,wlen,dir);
   words[word]:="";

   (* third word *)
   cmp:=10;
   IF (cmp>ymax-2) THEN
    cmp:=ymax-2;
   END;
   REPEAT
    word:=RND(num);
   UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=ymax-2);
   w:=words[word];
   wlen:=Length(w)-1;
   x:=xmax;
   y:=1;
   dir:=vertical;
   Place(w,x-1,y-1,wlen,dir);
   words[word]:="";

   (* fourth word *)
   REPEAT
    word:=RND(num);
   UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=ymax-2);
   w:=words[word];
   wlen:=Length(w)-1;
   x:=1;
   y:=ymax-wlen;
   dir:=vertical;
   Place(w,x-1,y-1,wlen,dir);
   words[word]:="";
  END;

  Cls;
  search:=off; show:=on;

  ShowCommands;
  limit:=limitbase;
  status;
  ShowAll;
  NormalPointer;

  (* main loop is "endless"; termination via Assert *)
  (* in procedure AskCommand                        *)
  LOOP
   val0:=-1; len0:=0;
   IF (show=off) THEN
    show:=on;
    ShowCommands;
   END;
   AskCommand;
   IF (search=on) THEN
    ShowCommands;
    show:=off;
    FOR outerloop:=0 TO num DO
     word:=outerloop;
     w:=words[word];
     AskCommand;
     IF (Length(w)>0) THEN
      wlen:=Length(w)-1;
      IF (wlen<limit) OR (wlen>limit+4) OR
         (wlen+1<val0+val0) OR (wlen<=0) THEN
       (* NOP *)
      ELSIF (check(w)) THEN
       words[word]:="";
      ELSE
       FOR xloop:=1 TO xmax DO
        IF ((xloop MOD 2)=1) OR (limit<2) THEN
         doH:=(xloop+wlen<=xmax);
         FOR yloop:=1 TO ymax DO
          IF ((yloop MOD 2)=1) OR (limit<2) THEN
           tempH:=-1; tempV:=-1;
           IF (doH) THEN
            tempH:=testH(w,xloop,yloop,wlen,len0,val0);
           END;
           IF (yloop+wlen<=ymax) THEN
            tempV:=testV(w,xloop,yloop,wlen,len0,val0);
           END;
           IF (tempH#-1) AND (tempH>=tempV) THEN
            val0:=tempH; x0:=xloop; y0:=yloop;
            w0:=word; dir0:=horizontal; len0:=wlen;
            ClrLine(msgline);
            Print(w,0);
           ELSIF (tempV#-1) THEN
            val0:=tempV; x0:=xloop; y0:=yloop;
            w0:=word; dir0:=vertical; len0:=wlen;
            ClrLine(msgline);
            Print(w,0);
           END;
          END;
         END;
        END;
       END;
      END;
     END;
    END;

    IF (val0>=1) THEN
     Place(words[w0],x0-1,y0-1,Length(words[w0])-1,dir0);
     ShowAll;
     ClrLine(msgline);
     Print(words[w0],0);
     Print(msg[64],0);
     words[w0]:="";
    ELSE
     IF (limit>1) THEN
      limit:=limit-2;
     ELSE
      ClrLine(msgline);
      Print(msg[65],0);
      search:=off;
     END;
    END;
    status;
    ShowAll;
   END;
  END;
 END;
END Cross.