home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 1065.dms / 1065.adf / Cross / txt / Cross.mod < prev    next >
Text File  |  1987-06-04  |  18KB  |  750 lines
  1. (***************************************************************************
  2.  :Program.    Cross
  3.  :Author.     Jürgen Weinelt
  4.  :Address.    Zur Kanzel 1, D-8783 Hammelburg, Germany
  5.  :Version.    V3.3
  6.  :Copyright.  Freeware; copy it, but don't sell it!
  7.  :Language.   Modula-II
  8.  :Translator. M2Amiga V3.32d
  9.  :Imports.    CPCDosIO
  10.  :Imports.    CPCError
  11.  :Imports.    CPCGads
  12.  :Imports.    CPCGlobal
  13.  :Imports.    CPCPrint
  14.  :Imports.    CPCRequesters
  15.  :Imports.    CPCShowAll
  16.  :Imports.    CPCSleep
  17.  :Imports.    FileReq
  18.  :Contents.   Program to create crossword puzzles.
  19.  :Contents.   Features Intuition interface, filerequesters, and a special
  20.  :Contents.   message data file to allow easy translation into any
  21.  :Contents.   (human) language without changing the source code.
  22.  :History.    V3.2  08-jan-91  first major release of M2 version on AMOK
  23.  :History.    V3.3  06-feb-91  PAL/NTSC support added
  24.  **************************************************************************)
  25.  
  26.  
  27.  
  28. MODULE Cross;
  29.  
  30.  
  31.  
  32. FROM Arguments
  33.  IMPORT NumArgs,GetArg;
  34.  
  35. FROM Arts
  36.  IMPORT TermProcedure,Assert,Terminate,CurrentLevel;
  37.  
  38. FROM ASCII
  39.  IMPORT nul;
  40.  
  41. FROM Conversions
  42.  IMPORT ValToStr;
  43.  
  44. FROM CPCDosIO
  45.  IMPORT Value,ReadWords,LoadData,SaveData,ReadMsg,PrintCross,PrintSolution,
  46.         InitCPCDosIO,msgmode;
  47.  
  48. FROM CPCError
  49.  IMPORT myAssert;
  50.  
  51. FROM CPCGads
  52.  IMPORT ShowCommands,AllGadsOff;
  53.  
  54. FROM CPCGlobal
  55.  IMPORT string,lstring,stringlen,lstringlen,rastport,viewport,msg,maxmsg,
  56.         switch,search,show,screen,window,stat,column,field,yoff,blankC,
  57.         wordfield,puzzlewordfield,text,kwr,words,hori,vert,xmax,ymax,
  58.         maxgrid,topaz;
  59.  
  60. FROM CPCPrint
  61.  IMPORT Cls,Print,PrintAtC,PrintAtS,ClrLine;
  62.  
  63. FROM CPCRequesters
  64.  IMPORT HoriOrVert,InputLine,YesOrNo;
  65.  
  66. FROM CPCShowAll
  67.  IMPORT CharPos,ShowAll;
  68.  
  69. FROM CPCSleep
  70.  IMPORT NormalPointer,SleepPointer;
  71.  
  72. FROM Graphics
  73.  IMPORT SetRGB4;
  74.  
  75. FROM InOut
  76.  IMPORT WriteLn,WriteString,WriteInt;
  77.  
  78. FROM IntuiIO
  79.  IMPORT OpenScreen,CloseScreen,GetViewPort,OpenWindow,CloseWindow,
  80.         WindowRastPort,GetMessage,ReadMessage,GetGadgetId,AddIntuiMsg,
  81.         ScreenRastPort,GetMouse,
  82.         WINDOW,SCREEN,GADGET,ScreenType,ScreenTypeSet,
  83.         IntuiMsg,IntuiMsgSet,WindowType,WindowTypeSet,MousPos;
  84.  
  85. IMPORT IntuiIO;
  86.  
  87. FROM Intuition
  88.  IMPORT CurrentTime,IntuitionBasePtr;
  89.  
  90. IMPORT Intuition;
  91.  
  92. FROM RandomNumber
  93.  IMPORT RND,PutSeed;
  94.  
  95. FROM Strings
  96.  IMPORT Copy,Compare,Length;
  97.  
  98. FROM Str
  99.  IMPORT CapString;
  100.  
  101. FROM SYSTEM
  102.  IMPORT ADR;
  103.  
  104.  
  105.  
  106. CONST
  107.  progtitle="Crossword Puzzle Creator V3.3 *** ©1991 by J.Weinelt";
  108.  spcs="                                                                           ";
  109.  limitbase=24;
  110.  lowerylimit=5;
  111. (* upperylimit=35; !!! now VAR: PAL/NTSC support added 06-feb-91 !!! *)
  112. (* defmsgline=27;  ^^^ same as above ^^^ *)
  113.  defxsize=19;
  114.  defysize=19;
  115.  lowerxlimit=5;
  116.  upperxlimit=39;
  117.  
  118.  
  119.  
  120. TYPE
  121.  direction=(horizontal,vertical);
  122.  
  123.  
  124.  
  125. VAR
  126.  dir,dir0: direction;
  127.  w,progname,tmp: string;
  128.  loop,word,wlen,x,y,cmp,num: INTEGER;
  129.  xloop,yloop,x0,y0,w0,len0,outerloop: INTEGER;
  130.  val0,tempH,tempV: INTEGER;
  131.  doH,booldummy: BOOLEAN;
  132.  limit,dummy,narg,msgline: INTEGER;
  133.  sec,micro: LONGINT;
  134.  msgmd: msgmode;
  135.  underl,scrname,winname: lstring;
  136.  ibase: IntuitionBasePtr;
  137.  pal: BOOLEAN;
  138.  upperylimit,defmsgline: INTEGER;
  139.  
  140.  
  141.  
  142. PROCEDURE CoolDown;
  143.  BEGIN
  144.   IF (window#NIL) THEN
  145.    CloseWindow(window);
  146.   END;
  147.   IF (screen#NIL) THEN
  148.    CloseScreen(screen);
  149.   END;
  150.  END CoolDown;
  151.  
  152.  
  153.  
  154. PROCEDURE MakeString(b: INTEGER; c: CHAR; VAR a: ARRAY OF CHAR);
  155.  VAR loop: INTEGER;
  156.  BEGIN
  157.   FOR loop:=0 TO b-1 DO
  158.    a[loop]:=c;
  159.   END;
  160.   a[b]:=nul;
  161.  END MakeString;
  162.  
  163.  
  164.  
  165. PROCEDURE check(w: ARRAY OF CHAR): BOOLEAN;
  166.  VAR
  167.   f: BOOLEAN;
  168.   loop: INTEGER;
  169.  BEGIN
  170.   f:=FALSE;
  171.   FOR loop:=0 TO hori+vert DO
  172.    f:=f OR (Compare(kwr[loop],0,stringlen,w,FALSE)=0);
  173.   END;
  174.   RETURN f;
  175.  END check;
  176.  
  177.  
  178.  
  179. PROCEDURE testH(VAR w: ARRAY OF CHAR; x,y,len,rlen,ref: INTEGER): INTEGER;
  180.  VAR v,loop: INTEGER;
  181.      f: BOOLEAN;
  182.  BEGIN
  183.   IF (x+len<=xmax) AND (text[x-1,y]=nul) AND (text[x+len+1,y]=nul) THEN
  184.    f:=FALSE;
  185.    v:=0;
  186.    FOR loop:=x TO x+len DO
  187.     IF (w[loop-x]=text[loop,y]) THEN
  188.      v:=v+1;
  189.      (* if char matches AND there's a non-nul char before OR after *)
  190.      (* this position, then we better get out of here... to avoid  *)
  191.      (* something like "life" being matched with "lifeforms"!      *)
  192.      IF (text[loop-1,y]#nul) OR (text[loop+1,y]#nul) THEN
  193.       loop:=x+len+1;
  194.       f:=TRUE;
  195.      END;
  196.     ELSE
  197.      IF (text[loop,y-1]#nul) OR (text[loop,y+1]#nul) OR (text[loop,y]#nul) THEN
  198.       loop:=x+len+1;
  199.       f:=TRUE;
  200.      END;
  201.     END;
  202.    END;
  203.    IF (NOT f) THEN
  204.     IF (v>ref) OR
  205.        ((v=ref) AND (ref>0) AND ((len>rlen) OR
  206.                                 ((len=rlen) AND (RND(10)<2)))) THEN
  207.      RETURN v;
  208.     END;
  209.    END;
  210.   END;
  211.   RETURN -1;
  212.  END testH;
  213.  
  214.  
  215.  
  216. PROCEDURE testV(VAR w: ARRAY OF CHAR; x,y,len,rlen,ref: INTEGER): INTEGER;
  217.  VAR v,loop: INTEGER;
  218.      f: BOOLEAN;
  219.  BEGIN
  220.   IF (y+len<=ymax) AND (text[x,y-1]=nul) AND (text[x,y+len+1]=nul) THEN
  221.    f:=FALSE;
  222.    v:=0;
  223.    FOR loop:=y TO y+len DO
  224.     IF (w[loop-y]=text[x,loop]) THEN
  225.      v:=v+1;
  226.      (* if char matches AND there's a non-nul char before OR after *)
  227.      (* this position, then we better get out of here... to avoid  *)
  228.      (* something like "life" being matched with "lifeforms"!      *)
  229.      IF (text[x,loop-1]#nul) OR (text[x,loop+1]#nul) THEN
  230.       loop:=y+len+1;
  231.       f:=TRUE;
  232.      END;
  233.     ELSE
  234.      IF (text[x-1,loop]#nul) OR (text[x+1,loop]#nul) OR (text[x,loop]#nul) THEN
  235.       loop:=y+len+1;
  236.       f:=TRUE;
  237.      END;
  238.     END;
  239.    END;
  240.    IF (NOT f) THEN
  241.     IF (v>ref) OR
  242.        ((v=ref) AND (ref>0) AND ((len>rlen) OR
  243.                                 ((len=rlen) AND (RND(10)<2)))) THEN
  244.      RETURN v;
  245.     END;
  246.    END;
  247.   END;
  248.   RETURN -1;
  249.  END testV;
  250.  
  251.  
  252.  
  253. PROCEDURE Place(a: ARRAY OF CHAR; x,y,len: INTEGER; d: direction);
  254.  VAR
  255.   loop: INTEGER;
  256.  BEGIN
  257.   Copy(kwr[hori+vert],a,0,stringlen);
  258.   IF (d=horizontal) THEN
  259.    INC(hori);
  260.    FOR loop:=x+1 TO x+len+1 DO
  261.     text[loop,y+1]:=a[loop-x-1];
  262.    END;
  263.   ELSE
  264.    INC(vert);
  265.    FOR loop:=y+1 TO y+len+1 DO
  266.     text[x+1,loop]:=a[loop-y-1];
  267.    END;
  268.   END;
  269.  END Place;
  270.  
  271.  
  272.  
  273. PROCEDURE status;
  274.  VAR tmp: string;
  275.      dummy: BOOLEAN;
  276.      lx,ly: INTEGER;
  277.      cnt,net: LONGINT;
  278.  BEGIN
  279.   cnt:=0; net:=0;
  280.   FOR lx:=1 TO xmax DO
  281.    FOR ly:=1 TO ymax DO
  282.     IF (text[lx,ly]#nul) THEN
  283.      INC(cnt);
  284.      IF ((text[lx+1,ly]#nul) OR (text[lx-1,ly]#nul)) AND
  285.         ((text[lx,ly+1]#nul) OR (text[lx,ly-1]#nul)) THEN
  286.       INC(net);
  287.      END;
  288.     END;
  289.    END;
  290.   END;
  291.   PrintAtS(stat-1,0,msg[26]);
  292.   ValToStr(limit,FALSE,tmp,10,2,"0",dummy);
  293.   Print(tmp,0);
  294.   PrintAtS(stat+Length(msg[26])+2,0,msg[27]);
  295.   ValToStr(hori,FALSE,tmp,10,2,"0",dummy);
  296.   Print(tmp,0);
  297.   PrintAtS(stat+Length(msg[26])+Length(msg[27])+5,0,msg[28]);
  298.   ValToStr(vert,FALSE,tmp,10,2,"0",dummy);
  299.   Print(tmp,0);
  300.   PrintAtS(stat-1,1,msg[29]);
  301.   ValToStr(((cnt*100) DIV (LONGINT(xmax*ymax))),FALSE,tmp,10,2,"0",dummy);
  302.   Print(tmp,0);
  303.   PrintAtS(stat+Length(msg[29])+2,1,msg[30]);
  304.   IF (hori+vert#0) THEN
  305.    ValToStr(((net*200) DIV (LONGINT(hori+vert))),FALSE,tmp,10,3,"0",dummy);
  306.   ELSE
  307.    tmp:="000";
  308.   END;
  309.   Print(tmp,0);
  310.  END status;
  311.  
  312.  
  313.  
  314. PROCEDURE AskCommand;
  315.  VAR cmd: CHAR;
  316.      dummy,length,x,y: INTEGER;
  317.      word: string;
  318.      dummyStr: ARRAY[0..1] OF CHAR;
  319.      imsg: IntuiMsg;
  320.      gadID: INTEGER;
  321.  BEGIN
  322.   imsg:=GetMessage(window);
  323.   IF (imsg=gadgetUp) THEN
  324.    gadID:=GetGadgetId(window);
  325.    CASE gadID OF
  326.     |1: IF (search=on) THEN
  327.          search:=off;
  328.         ELSE
  329.          search:=on;
  330.         END;
  331.         ShowCommands;
  332.  
  333.     |2: AllGadsOff;
  334.         SleepPointer;
  335.         ClrLine(msgline);
  336.         IF (xmax>ymax) THEN
  337.          length:=xmax;
  338.         ELSE
  339.          length:=ymax;
  340.         END;
  341.         NormalPointer;
  342.         InputLine(word,msg[40],
  343.                   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz",
  344.                   length);
  345.         SleepPointer;
  346.         CapString(word);
  347.         IF Length(word)>0 THEN
  348.          IF (check(word)) THEN
  349.           ClrLine(msgline);
  350.           Print(msg[41],0);
  351.          ELSE
  352.           x:=1; y:=1;
  353.           ClrLine(msgline);
  354.           Print(msg[42],0);
  355.           AddIntuiMsg(window,IntuiMsgSet{mouseButtons});
  356.           NormalPointer;
  357.           REPEAT
  358.            REPEAT
  359.             imsg:=GetMessage(window);
  360.            UNTIL imsg=mouseButtons;
  361.            x:=GetMouse(window,curentX);
  362.            y:=GetMouse(window,curentY);
  363.            CharPos(x,y);
  364.           UNTIL (x>=0) AND (y>=0);
  365.           SleepPointer;
  366.           ClrLine(msgline);
  367.  
  368.           NormalPointer;
  369.           IF HoriOrVert(msg[43]) THEN
  370.            IF (testH(word,x+1,y+1,Length(word)-1,0,-1)>=0) THEN
  371.             SleepPointer;
  372.             Place(word,x,y,Length(word)-1,horizontal);
  373.             ShowAll;
  374.             ClrLine(msgline);
  375.            ELSE
  376.             SleepPointer;
  377.             ClrLine(msgline);
  378.             Print(msg[44],0);
  379.            END;
  380.           ELSE
  381.            IF (testV(word,x+1,y+1,Length(word)-1,0,-1)>=0) THEN
  382.             Place(word,x,y,Length(word)-1,vertical);
  383.             ShowAll;
  384.             ClrLine(msgline);
  385.            ELSE
  386.             ClrLine(msgline);
  387.             Print(msg[44],0);
  388.            END;
  389.           END;
  390.          END;
  391.         END;
  392.         status;
  393.         ShowAll;
  394.         NormalPointer;
  395.         ShowCommands;
  396.  
  397.     |3: AllGadsOff;
  398.         SleepPointer;
  399.         ClrLine(msgline);
  400.         Print(msg[46],0);
  401.         PrintCross;
  402.         ClrLine(msgline);
  403.         NormalPointer;
  404.         ShowCommands;
  405.  
  406.     |4: AllGadsOff;
  407.         SleepPointer;
  408.         ClrLine(msgline);
  409.         Print(msg[47],0);
  410.         PrintSolution;
  411.         ClrLine(msgline);
  412.         NormalPointer;
  413.         ShowCommands;
  414.  
  415.     |5: AllGadsOff;
  416.         SleepPointer;
  417.         LoadData;
  418.         Cls;
  419.         ShowAll;
  420.         status;
  421.         NormalPointer;
  422.         ShowCommands;
  423.  
  424.     |6: AllGadsOff;
  425.         SleepPointer;
  426.         SaveData;
  427.         ClrLine(msgline);
  428.         NormalPointer;
  429.         ShowCommands;
  430.  
  431.     |7: AllGadsOff;
  432.         SleepPointer;
  433.         num:=ReadWords(FALSE);
  434.         ClrLine(msgline);
  435.         status;
  436.         NormalPointer;
  437.         ShowCommands;
  438.  
  439.     |8: ClrLine(msgline);
  440.         limit:=limitbase;
  441.         Print(msg[49],0);
  442.         status;
  443.  
  444.     |0: AllGadsOff;
  445.         IF YesOrNo(msg[50]) THEN
  446.          WriteLn; WriteString(msg[51]); WriteLn; WriteLn;
  447.          Terminate(CurrentLevel());
  448.         END;
  449.         ShowCommands;
  450.  
  451.     |ELSE (* NOP *)
  452.    END;
  453.   END;
  454.  END AskCommand;
  455.  
  456.  
  457.  
  458. BEGIN
  459.  TermProcedure(CoolDown);
  460.  
  461.  scrname:=progtitle;
  462.  MakeString(Length(scrname),"-",underl);
  463.  narg:=NumArgs();
  464.  xmax:=-1;
  465.  ymax:=-1;
  466.  msgmd:=nonumbers;
  467.  
  468.  ibase:=ADR(Intuition);
  469.  IF (ibase^.firstScreen#NIL) THEN
  470.   (* try to figure out if this is a PAL or NTSC machine: *)
  471.   (* look at the "height" field of first screen and hope there's any *)
  472.   (* significance to this value *)
  473.   IF ibase^.firstScreen^.height=256 THEN
  474.    (* this is pal resolution *)
  475.    upperylimit:=35;
  476.    defmsgline:=27;
  477.    pal:=TRUE;
  478.   ELSE
  479.    (* anything else means "not pal", i like being on the safe side *)
  480.    upperylimit:=25;
  481.    defmsgline:=20;
  482.    pal:=FALSE;
  483.   END;
  484.  ELSE
  485.   (* there's probably no use showing any error messages if there's no *)
  486.   (* screen present at all... i guess this will never be executed anyway *)
  487.   Terminate(CurrentLevel());
  488.  END;
  489.  
  490.  FOR loop:=1 TO narg DO
  491.   GetArg(loop,tmp,dummy);
  492.   IF (tmp[0]="-") THEN
  493.    tmp[0]:="0";
  494.    CASE tmp[1] OF
  495.     |"x","X": tmp[1]:="0";
  496.               xmax:=Value(tmp);
  497.               IF ((xmax<lowerxlimit) OR (xmax>upperxlimit) OR (ODD(xmax+1))) THEN
  498.                xmax:=-1;
  499.                WriteString("Illegal value for XSIZE; assuming default value");
  500.                WriteLn;
  501.               END;
  502.     |"y","Y": tmp[1]:="0";
  503.               ymax:=Value(tmp);
  504.               IF ((ymax<lowerylimit) OR (ymax>upperylimit) OR (ODD(ymax+1))) THEN
  505.                ymax:=-1;
  506.                WriteString("Illegal value for YSIZE; assuming default value");
  507.                WriteLn;
  508.               END;
  509.     |"d","D": msgmd:=numbers;
  510.     |ELSE
  511.    END;
  512.   END;
  513.  END;
  514.  
  515.  GetArg(0,progname,dummy);
  516.  IF (xmax=-1) THEN
  517.   xmax:=defxsize;
  518.  END;
  519.  IF (ymax=-1) THEN
  520.   ymax:=defysize;
  521.  END;
  522.  GetArg(1,tmp,dummy);
  523.  IF (tmp[0]="?") THEN
  524.   WriteLn;
  525.   WriteString(scrname); WriteLn;
  526.   WriteString(underl); WriteLn;
  527.   WriteString("Copyright ©1991 by Jürgen Weinelt, Zur Kanzel 1, D-8783 Hammelburg, Germany."); WriteLn; WriteLn;
  528.   WriteString("Please Note: CPC is FREEWARE; you may copy it, but do not sell it!"); WriteLn; WriteLn;
  529.   WriteString("Usage:"); WriteLn;
  530.   WriteString(progname); WriteString(" [?] [-xXSIZE] [-yYSIZE] [-d]"); WriteLn;
  531.   WriteString(" XSIZE: xsize in chars, ");
  532.   WriteInt(lowerxlimit,0); WriteString("<=x<=");
  533.   WriteInt(upperxlimit,0); WriteString(", default: ");
  534.   WriteInt(defxsize,0); WriteLn;
  535.   WriteString(" YSIZE: ysize in chars, ");
  536.   WriteInt(lowerylimit,0); WriteString("<=y<=");
  537.   WriteInt(upperylimit,0); WriteString(", default: ");
  538.   WriteInt(defysize,0); WriteLn;
  539.   WriteString(" -d:    turn on message numbers (for word file debugging only!)");
  540.   WriteLn;
  541.   WriteString("Please note: XSIZE and YSIZE must be odd!"); WriteLn; WriteLn;
  542.  END;
  543.  
  544.  IF (tmp[0]#"?") THEN
  545.   ReadMsg(msgmd);
  546.  
  547.   IF pal THEN
  548.    screen:=OpenScreen(scrname,0,0,640,256,1,ScreenTypeSet{hires});
  549.   ELSE
  550.    screen:=OpenScreen(scrname,0,0,640,200,1,ScreenTypeSet{hires});
  551.   END;
  552.   Assert(screen#NIL,ADR(msg[52]));
  553.  
  554.   viewport:=GetViewPort(screen);
  555.   SetRGB4(viewport, 0,  0, 0, 0);  (* 0=black *)
  556.   SetRGB4(viewport, 1, 15,15,15);  (* 1=white *)
  557.   SetRGB4(viewport,17,  6, 6, 6);
  558.   SetRGB4(viewport,18, 11,11,11);
  559.   SetRGB4(viewport,19, 15,15,15);
  560.  
  561.  
  562.   winname:=scrname;
  563.   IF pal THEN
  564.    window:=OpenWindow(winname,0,0,640,256,
  565.                       WindowTypeSet{activWindow,backDrop,borderless},screen);
  566.   ELSE
  567.    window:=OpenWindow(winname,0,0,640,200,
  568.                       WindowTypeSet{activWindow,backDrop,borderless},screen);
  569.   END;
  570.   Assert(window#NIL,ADR(msg[61]));
  571.   rastport:=WindowRastPort(window);
  572.   topaz:=rastport^.font;
  573.   AddIntuiMsg(window,IntuiMsgSet{gadgetUp});
  574.   InitCPCDosIO;
  575.  
  576.   msgline:=defmsgline;
  577.  
  578.   Print("",1);
  579.   Print(scrname,1);
  580.   Print(underl,2);
  581.   Print("©1991 by",1);
  582.   Print("Jürgen Weinelt",1);
  583.   Print("Zur Kanzel 1",1);
  584.   Print("D-8783 Hammelburg",1);
  585.   Print("Germany",2);
  586.  
  587.   Print("Last changed: 06-Feb-91",2);
  588.  
  589.   Print("Please note: CPC is FREEWARE; you may copy it, but do not sell it!",2);
  590.  
  591.   Print("This program was created using M2Amiga and the IntuitionReport and",1);
  592.   Print("GraphicsReport support libraries. Thanks to A+L for these powerful tools.",2);
  593.  
  594.   Print("Special thanks to the ARP people for their file requester.",2);
  595.  
  596.   Print(msg[62],0);
  597.  
  598.   SleepPointer;
  599.   num:=ReadWords(TRUE);
  600.  
  601.   hori:=0; vert:=0;
  602.  
  603.   CurrentTime(ADR(sec),ADR(micro));
  604.   PutSeed(sec);
  605.  
  606.   IF (num>0) THEN
  607.    (* first word *)
  608.    cmp:=10;
  609.    IF (cmp>xmax-2) THEN
  610.     cmp:=xmax-2;
  611.    END;
  612.    REPEAT
  613.     word:=RND(num);
  614.    UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=xmax-2);
  615.    w:=words[word];
  616.    wlen:=Length(w)-1;
  617.    x:=1;
  618.    y:=1;
  619.    dir:=horizontal;
  620.    Place(w,x-1,y-1,wlen,dir);
  621.    words[word]:="";
  622.  
  623.    (* second word *)
  624.    REPEAT
  625.     word:=RND(num);
  626.    UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=xmax-2);
  627.    w:=words[word];
  628.    wlen:=Length(w)-1;
  629.    x:=xmax-wlen;
  630.    y:=ymax;
  631.    dir:=horizontal;
  632.    Place(w,x-1,y-1,wlen,dir);
  633.    words[word]:="";
  634.  
  635.    (* third word *)
  636.    cmp:=10;
  637.    IF (cmp>ymax-2) THEN
  638.     cmp:=ymax-2;
  639.    END;
  640.    REPEAT
  641.     word:=RND(num);
  642.    UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=ymax-2);
  643.    w:=words[word];
  644.    wlen:=Length(w)-1;
  645.    x:=xmax;
  646.    y:=1;
  647.    dir:=vertical;
  648.    Place(w,x-1,y-1,wlen,dir);
  649.    words[word]:="";
  650.  
  651.    (* fourth word *)
  652.    REPEAT
  653.     word:=RND(num);
  654.    UNTIL (Length(words[word])>=cmp) AND (Length(words[word])<=ymax-2);
  655.    w:=words[word];
  656.    wlen:=Length(w)-1;
  657.    x:=1;
  658.    y:=ymax-wlen;
  659.    dir:=vertical;
  660.    Place(w,x-1,y-1,wlen,dir);
  661.    words[word]:="";
  662.   END;
  663.  
  664.   Cls;
  665.   search:=off; show:=on;
  666.  
  667.   ShowCommands;
  668.   limit:=limitbase;
  669.   status;
  670.   ShowAll;
  671.   NormalPointer;
  672.  
  673.   (* main loop is "endless"; termination via Assert *)
  674.   (* in procedure AskCommand                        *)
  675.   LOOP
  676.    val0:=-1; len0:=0;
  677.    IF (show=off) THEN
  678.     show:=on;
  679.     ShowCommands;
  680.    END;
  681.    AskCommand;
  682.    IF (search=on) THEN
  683.     ShowCommands;
  684.     show:=off;
  685.     FOR outerloop:=0 TO num DO
  686.      word:=outerloop;
  687.      w:=words[word];
  688.      AskCommand;
  689.      IF (Length(w)>0) THEN
  690.       wlen:=Length(w)-1;
  691.       IF (wlen<limit) OR (wlen>limit+4) OR
  692.          (wlen+1<val0+val0) OR (wlen<=0) THEN
  693.        (* NOP *)
  694.       ELSIF (check(w)) THEN
  695.        words[word]:="";
  696.       ELSE
  697.        FOR xloop:=1 TO xmax DO
  698.         IF ((xloop MOD 2)=1) OR (limit<2) THEN
  699.          doH:=(xloop+wlen<=xmax);
  700.          FOR yloop:=1 TO ymax DO
  701.           IF ((yloop MOD 2)=1) OR (limit<2) THEN
  702.            tempH:=-1; tempV:=-1;
  703.            IF (doH) THEN
  704.             tempH:=testH(w,xloop,yloop,wlen,len0,val0);
  705.            END;
  706.            IF (yloop+wlen<=ymax) THEN
  707.             tempV:=testV(w,xloop,yloop,wlen,len0,val0);
  708.            END;
  709.            IF (tempH#-1) AND (tempH>=tempV) THEN
  710.             val0:=tempH; x0:=xloop; y0:=yloop;
  711.             w0:=word; dir0:=horizontal; len0:=wlen;
  712.             ClrLine(msgline);
  713.             Print(w,0);
  714.            ELSIF (tempV#-1) THEN
  715.             val0:=tempV; x0:=xloop; y0:=yloop;
  716.             w0:=word; dir0:=vertical; len0:=wlen;
  717.             ClrLine(msgline);
  718.             Print(w,0);
  719.            END;
  720.           END;
  721.          END;
  722.         END;
  723.        END;
  724.       END;
  725.      END;
  726.     END;
  727.  
  728.     IF (val0>=1) THEN
  729.      Place(words[w0],x0-1,y0-1,Length(words[w0])-1,dir0);
  730.      ShowAll;
  731.      ClrLine(msgline);
  732.      Print(words[w0],0);
  733.      Print(msg[64],0);
  734.      words[w0]:="";
  735.     ELSE
  736.      IF (limit>1) THEN
  737.       limit:=limit-2;
  738.      ELSE
  739.       ClrLine(msgline);
  740.       Print(msg[65],0);
  741.       search:=off;
  742.      END;
  743.     END;
  744.     status;
  745.     ShowAll;
  746.    END;
  747.   END;
  748.  END;
  749. END Cross.
  750.