home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 1065.dms / 1065.adf / Cross / txt / CPCDosIO.mod < prev    next >
Text File  |  1987-06-04  |  18KB  |  808 lines
  1. IMPLEMENTATION MODULE CPCDosIO;
  2.  
  3.  
  4.  
  5. FROM Arts
  6.  IMPORT BreakPoint,CurrentLevel,Terminate,TermProcedure;
  7.  
  8. FROM ASCII
  9.  IMPORT lf,nul,esc;
  10.  
  11. FROM Conversions
  12.  IMPORT ValToStr,StrToVal;
  13.  
  14. FROM CPCError
  15.  IMPORT myAssert;
  16.  
  17. FROM FileReq
  18.  IMPORT FileRequestData,MakeFRD,FileReq,FileString;
  19.  
  20. FROM CPCGlobal
  21.  IMPORT string,lstring,stringlen,lstringlen,msg,maxmsg,window,maxwords,
  22.         puzzlewords,maxgrid,column,field,wordfield,puzzlewordfield,text,
  23.         kwr,words,hori,vert,xmax,ymax;
  24.  
  25. FROM CPCRequesters
  26.  IMPORT YesOrNo;
  27.  
  28. FROM CPCSleep
  29.  IMPORT NormalPointer,SleepPointer;
  30.  
  31. FROM Dos
  32.  IMPORT Open,Read,Write,newFile,FileHandlePtr;
  33. IMPORT  Dos;
  34.  
  35. FROM FileMessage
  36.  IMPORT ResponseText,StrPtr;
  37.  
  38. FROM FileSystem
  39.  IMPORT Response,File,Lookup,Close,ReadChar,WriteBytes,WriteChar,ReadBytes;
  40.  
  41. FROM InOut
  42.  IMPORT WriteLn,WriteString,WriteHex,WriteInt;
  43. IMPORT InOut;
  44.  
  45. FROM RandomNumber
  46.  IMPORT RND,PutSeed;
  47.  
  48. FROM Requester
  49.  IMPORT Text,SetReqBorderPen,SetReqTextPen,ReqFlags,ReqFlagSet;
  50.  
  51. FROM RequesterSet
  52.  IMPORT BooleanRequest;
  53.  
  54. FROM Strings
  55.  IMPORT Copy,Compare,Length;
  56.  
  57. FROM SYSTEM
  58.  IMPORT ADDRESS,ADR,CAST;
  59.  
  60.  
  61.  
  62. CONST
  63.  errReadingMsg="ERROR READING MSG.TXT:";
  64.  ioErrReadingMsg="I/O-ERROR READING MSG.TXT:";
  65.  defworddir="Cross:data/";
  66.  defwordfile="words01.crw";
  67.  defdatadir="Cross:data/";
  68.  defdatafile="puzzle01.crd";
  69.  defmsg="Cross:data/msgtxt.data";
  70.  
  71.  
  72.  
  73. TYPE
  74.  IOMode=(readW,readC,writeC,printC,printS);
  75.  
  76.  
  77.  
  78. VAR
  79.  printer,parallel: FileHandlePtr;
  80.  myfile: File;
  81.  filepresent: BOOLEAN;
  82.  initialized: BOOLEAN;
  83.  dataReq,wordReq: FileRequestData;
  84.  
  85.  
  86.  
  87. PROCEDURE CoolDown;
  88.  BEGIN
  89.   IF printer#NIL THEN
  90.    Dos.Close(printer);
  91.   END;
  92.   IF parallel#NIL THEN
  93.    Dos.Close(parallel);
  94.   END;
  95.  END CoolDown;
  96.  
  97.  
  98.  
  99. PROCEDURE InitCPCDosIO;
  100.  BEGIN
  101.   IF NOT initialized THEN
  102.    initialized:=TRUE;
  103.    MakeFRD("",defwordfile,defworddir,CAST(ADDRESS,window),wordReq);
  104.    MakeFRD("",defdatafile,defdatadir,CAST(ADDRESS,window),dataReq);
  105.   END;
  106.  END InitCPCDosIO;
  107.  
  108.  
  109.  
  110. PROCEDURE Value(a: ARRAY OF CHAR): INTEGER;
  111.  VAR err,sgn: BOOLEAN;
  112.      val: LONGINT;
  113.      l: INTEGER;
  114.  BEGIN
  115.   FOR l:=0 TO 3 DO
  116.    IF (a[l]=" ") THEN
  117.     a[l]:="0";
  118.    END;
  119.   END;
  120.   sgn:=FALSE;
  121.   StrToVal(a,val,sgn,10,err);
  122.   IF (err) THEN
  123.    val:=-1;
  124.   END;
  125.   RETURN INTEGER(val);
  126.  END Value;
  127.  
  128.  
  129.  
  130. PROCEDURE AppendStr(VAR a: ARRAY OF CHAR; b: ARRAY OF CHAR);
  131.  VAR l,x,pos: INTEGER;
  132.  BEGIN
  133.   l:=Length(a);
  134.   FOR x:=0 TO Length(b)-1 DO
  135.    a[l+x]:=b[x];
  136.   END;
  137.   pos:=Length(b);
  138.   a[pos+l]:=nul;
  139.  END AppendStr;
  140.  
  141.  
  142.  
  143. PROCEDURE MakeComStr(VAR s: ARRAY OF CHAR; c0,c1,c2,c3,c4,c5,c6,c7: CHAR);
  144.  BEGIN
  145.   s[0]:=c0;
  146.   s[1]:=c1;
  147.   s[2]:=c2;
  148.   s[3]:=c3;
  149.   s[4]:=c4;
  150.   s[5]:=c5;
  151.   s[6]:=c6;
  152.   s[7]:=c7;
  153.   s[8]:=nul;
  154.  END MakeComStr;
  155.  
  156.  
  157.  
  158. PROCEDURE PutPRT(s: StrPtr; l: LONGINT): BOOLEAN; (* TRUE if error *)
  159.  VAR
  160.   act: LONGINT;
  161.  BEGIN
  162.   myAssert(printer#NIL,ADR(msg[66]),ADR(msg[67]));
  163.   act:=Write(printer,s,l);
  164.   RETURN (act#l);
  165.  END PutPRT;
  166.  
  167.  
  168.  
  169. PROCEDURE PutPAR(s: StrPtr; l: LONGINT): BOOLEAN; (* TRUE if ERROR *)
  170.  VAR
  171.   act: LONGINT;
  172.  BEGIN
  173.   myAssert(parallel#NIL,ADR(msg[66]),ADR(msg[68]));
  174.   act:=Write(parallel,s,l);
  175.   RETURN (act#l);
  176.  END PutPAR;
  177.  
  178.  
  179.  
  180. PROCEDURE readline(VAR f: File; VAR a,number: lstring; m: msgmode);
  181.  VAR c: CHAR;
  182.      n: INTEGER;
  183.      sp: StrPtr;
  184.  BEGIN
  185.   n:=0;
  186.   ReadChar(f,c);
  187.   IF ((ORD(c)>=ORD("0")) AND (ORD(c)<=ORD("9"))) THEN
  188.    a[n]:=c;
  189.    INC(n);
  190.    REPEAT
  191.     myAssert(n<=lstringlen,ADR(errReadingMsg),ADR("STRING TOO LONG"));
  192.     ReadChar(f,c);
  193.     ResponseText(f.res,sp);
  194.     myAssert(f.res=done,ADR(ioErrReadingMsg),sp);
  195.     a[n]:=c;
  196.     INC(n);
  197.    UNTIL (c=" ");
  198.    a[n-1]:=nul;
  199.    number:=a;
  200.    IF (m=nonumbers) THEN
  201.     n:=0;
  202.     a[0]:=nul;
  203.    ELSE
  204.     DEC(n);
  205.    END;
  206.   ELSE
  207.    number:="illegal";
  208.    a[0]:=c;
  209.    n:=1;
  210.   END;
  211.   REPEAT
  212.    myAssert(n<=lstringlen,ADR(errReadingMsg),ADR("STRING TOO LONG"));
  213.    ReadChar(f,c);
  214.    ResponseText(f.res,sp);
  215.    myAssert(f.res=done,ADR(ioErrReadingMsg),sp);
  216.    IF (c="@") THEN
  217.     c:=" ";
  218.    END;
  219.    a[n]:=c;
  220.    INC(n);
  221.   UNTIL (c=lf);
  222.   a[n-1]:=nul;
  223.  END readline;
  224.  
  225.  
  226.  
  227. PROCEDURE ReadMsg(m: msgmode);
  228.  VAR c: CHAR;
  229.      lcount,i,k,l,n,langno: INTEGER;
  230.      a,num: lstring;
  231.      b: ARRAY[1..9] OF lstring;
  232.      sp: StrPtr;
  233.  BEGIN
  234.   Lookup(myfile,defmsg,5000,FALSE);
  235.   filepresent:=TRUE;
  236.   myAssert(myfile.res=done,ADR(ioErrReadingMsg),ADR("CAN'T OPEN MSGTXT.DATA"));
  237.   ReadChar(myfile,c);
  238.   myAssert((c>"0")&(c<":"),ADR(errReadingMsg),ADR("ILLEGAL LANGUAGE COUNT"));
  239.   lcount:=(ORD(c)-ORD("0"));
  240.   ReadChar(myfile,c);
  241.   ResponseText(myfile.res,sp);
  242.   myAssert(myfile.res=done,ADR(ioErrReadingMsg),sp);
  243.   myAssert(c=lf,ADR(errReadingMsg),ADR("LC IS LONGER THAN ONE CHAR"));
  244.   WriteLn; WriteLn;
  245.   WriteString("Crossword Puzzle Creator: Language selection.");
  246.   WriteLn; WriteLn;
  247.   FOR l:=1 TO lcount DO
  248.    n:=0;
  249.    REPEAT
  250.     myAssert(n<=lstringlen,ADR("ERROR IN MSG.TXT:"),ADR("STRING TOO LONG"));
  251.     ReadChar(myfile,c);
  252.     ResponseText(myfile.res,sp);
  253.     myAssert(myfile.res=done,ADR(ioErrReadingMsg),sp);
  254.     a[n]:=c;
  255.     INC(n);
  256.    UNTIL (c=lf);
  257.    a[n-1]:=nul;
  258.    b[l]:=a;
  259.    WriteInt(l,1); WriteString(": ");
  260.    WriteString(b[l]);
  261.    WriteLn;
  262.   END;
  263.   WriteLn;
  264.   REPEAT
  265.    WriteString("Please select (press return when finished): ");
  266.    InOut.Read(c);
  267.    langno:=ORD(c)-ORD("0");
  268.   UNTIL ((langno>=1) AND (langno<=lcount));
  269.   WriteLn; WriteLn;
  270.   WriteString("Reading program messages... please wait!");
  271.   WriteLn;
  272.   WriteString("LANGUAGE="); WriteString(b[langno]);
  273.   WriteLn;
  274.   k:=1;
  275.   REPEAT
  276.    FOR l:=1 TO lcount DO
  277.     readline(myfile,a,num,m);
  278.     IF (l=langno) THEN
  279.      msg[k]:=a;
  280.      IF ((k#Value(num)) AND (Value(num)#999)) THEN
  281.       IF (Value(num)>=0) THEN
  282.        WriteString("illegal message number encountered in msgtxt.data...");
  283.        WriteLn;
  284.        WriteString("message number should be..... "); WriteInt(k,0);
  285.        WriteLn;
  286.        WriteString("message number is actually... "); WriteInt(Value(num),0);
  287.        WriteLn;
  288.        WriteString("string read: '"); WriteString(a); WriteString("'");
  289.        WriteLn;
  290.        myAssert(FALSE,ADR(errReadingMsg),
  291.                       ADR("ILLEGAL MESSAGE NUMBER"));
  292.       ELSE
  293.        WriteString("message number missing in msgtxt.data...");
  294.        WriteLn;
  295.        WriteString("message number should be "); WriteInt(k,0);
  296.        WriteLn;
  297.        WriteString("string read: '"); WriteString(a); WriteString("'");
  298.        WriteLn;
  299.        myAssert(FALSE,ADR(errReadingMsg),
  300.                       ADR("MESSAGE NUMBER MISSING"));
  301.       END;
  302.      END;
  303.     END;
  304.    END;
  305.    INC(k);
  306.    myAssert(k<=maxmsg,ADR(errReadingMsg),
  307.                       ADR("TOO MANY MESSAGES"));
  308.   UNTIL (Value(num)=999);
  309.   WriteLn; WriteLn;
  310.   IF filepresent THEN
  311.    filepresent:=FALSE;
  312.    Close(myfile);
  313.   END;
  314.  END ReadMsg;
  315.  
  316.  
  317.  
  318. PROCEDURE HandleIOErr(action: IOMode; body: ARRAY OF CHAR): BOOLEAN;
  319.  VAR
  320.   header: lstring;
  321.   t: ARRAY[0..1] OF Text;
  322.   result: BOOLEAN;
  323.  BEGIN
  324.   CASE action OF
  325.    |readW:  Copy(t[0],msg[5],0,1000);
  326.    |readC:  Copy(t[0],msg[6],0,1000);
  327.    |writeC: Copy(t[0],msg[7],0,1000);
  328.    |printC: Copy(t[0],msg[8],0,1000);
  329.    |printS: Copy(t[0],msg[9],0,1000);
  330.    |ELSE    myAssert(FALSE,ADR(msg[10]),ADR(msg[11]));
  331.   END;
  332.   Copy(t[1],body,0,1000);
  333.   SetReqBorderPen(1);
  334.   SetReqTextPen(0);
  335.   NormalPointer;
  336.   result:=BooleanRequest(window,50,200,540,50,t,ADR(msg[12]),ADR(msg[13]),
  337.                          nul,nul,ReqFlagSet{reqBorder,reqShadow});
  338.   SleepPointer;
  339.   RETURN result;
  340.  END HandleIOErr;
  341.  
  342.  
  343.  
  344. PROCEDURE ReadWords(forcewords: BOOLEAN): INTEGER;
  345.  VAR alldone,worddone,again,quit: BOOLEAN;
  346.      num,cnt,length: INTEGER;
  347.      c: CHAR;
  348.      s: string;
  349.      body: lstring;
  350.      name: FileString;
  351.  BEGIN
  352.   LOOP
  353.    Copy(wordReq.h,msg[69],0,1000);
  354.    REPEAT
  355.     NormalPointer;
  356.     FileReq(wordReq,name);
  357.     SleepPointer;
  358.     quit:=FALSE;
  359.     IF (forcewords) AND (Length(name)=0) THEN
  360.      NormalPointer;
  361.      quit:=YesOrNo(msg[79]);
  362.      SleepPointer;
  363.     END;
  364.    UNTIL (NOT forcewords) OR (Length(name)>0) OR quit;
  365.    num:=0;
  366.    IF quit THEN
  367.     Terminate(CurrentLevel());
  368.    END;
  369.    IF Length(name)=0 THEN EXIT END;
  370.    LOOP
  371.     alldone:=FALSE;
  372.     body:=msg[16];
  373.     Lookup(myfile,name,5000,FALSE);
  374.     filepresent:=TRUE;
  375.     IF (myfile.res#done) THEN EXIT END;
  376.     WHILE (NOT alldone) AND (NOT myfile.eof) DO
  377.      worddone:=FALSE;
  378.      cnt:=0;
  379.      body:=msg[17];
  380.      WHILE (NOT worddone) AND (NOT myfile.eof) DO
  381.       ReadChar(myfile,c);
  382.       IF (myfile.res#done) THEN
  383.        num:=0;
  384.        EXIT;
  385.       END;
  386.       IF (c>="a") AND (c<="z") THEN
  387.        c:=CHAR(INTEGER(c)-INTEGER("a")+INTEGER("A"));
  388.       END;
  389.       IF ( ((c<"A") OR (c>"Z"))
  390.            AND (c#lf) AND (c#"*") ) THEN
  391.        body:=msg[18];
  392.        num:=0;
  393.        EXIT;
  394.       END;
  395.       worddone:=(c=lf);
  396.       IF (NOT worddone) THEN
  397.        s[cnt]:=c;
  398.        INC(cnt);
  399.        IF (cnt>stringlen) THEN
  400.         body:=msg[19];
  401.         num:=0;
  402.         EXIT;
  403.        END;
  404.       END;
  405.      END;
  406.      IF (myfile.eof) AND (NOT worddone) THEN
  407.       num:=0;
  408.       body:=msg[20];
  409.       EXIT;
  410.      END;
  411.      s[cnt]:=nul;
  412.      IF (Compare(s,0,Length(s),"***END***",FALSE)#0) THEN
  413.       IF (num>maxwords) THEN
  414.        num:=0;
  415.        body:=msg[21];
  416.        EXIT;
  417.       END;
  418.       words[num]:=s;
  419.       INC(num);
  420.      ELSE
  421.       DEC(num);
  422.       alldone:=TRUE;
  423.      END;
  424.      IF (myfile.eof) AND (NOT alldone) THEN
  425.       num:=0;
  426.       body:=msg[22];
  427.       EXIT;
  428.      END;
  429.     END;
  430.     EXIT;
  431.    END;
  432.    IF (myfile.res#done) OR (num=0) THEN
  433.     again:=forcewords OR HandleIOErr(readW,body);
  434.    ELSE
  435.     again:=FALSE;
  436.    END;
  437.    IF (NOT again) THEN
  438.     EXIT;
  439.    END;
  440.    IF filepresent THEN
  441.     filepresent:=FALSE;
  442.     Close(myfile);
  443.    END;
  444.   END;
  445.   IF filepresent THEN
  446.    filepresent:=FALSE;
  447.    Close(myfile);
  448.   END;
  449.   RETURN num;
  450.  END ReadWords;
  451.  
  452.  
  453.  
  454. PROCEDURE SaveData();
  455.  VAR a: FileString;
  456.      s: string;
  457.      act: LONGINT;
  458.      x,y,l,length: INTEGER;
  459.      err,again: BOOLEAN;
  460.      body: lstring;
  461.  BEGIN
  462.   LOOP
  463.    Copy(dataReq.h,msg[70],0,1000);
  464.    NormalPointer;
  465.    FileReq(dataReq,a);
  466.    SleepPointer;
  467.    IF Length(a)=0 THEN EXIT END;
  468.    LOOP
  469.     body:=msg[16];
  470.     Lookup(myfile,a,5000,TRUE);
  471.     filepresent:=TRUE;
  472.     IF (myfile.res#done) THEN EXIT END;
  473.     body:=msg[25];
  474.     WriteBytes(myfile,ADR("cpcdata!"),8,act);
  475.     IF (myfile.res#done) THEN EXIT END;
  476.     ValToStr(hori,FALSE,s,10,4," ",err);
  477.     WriteBytes(myfile,ADR(s),4,act);
  478.     IF (myfile.res#done) THEN EXIT END;
  479.     ValToStr(vert,FALSE,s,10,4," ",err);
  480.     WriteBytes(myfile,ADR(s),4,act);
  481.     IF (myfile.res#done) THEN EXIT END;
  482.     ValToStr(xmax,FALSE,s,10,4," ",err);
  483.     WriteBytes(myfile,ADR(s),4,act);
  484.     IF (myfile.res#done) THEN EXIT END;
  485.     ValToStr(ymax,FALSE,s,10,4," ",err);
  486.     WriteBytes(myfile,ADR(s),4,act);
  487.     IF (myfile.res#done) THEN EXIT END;
  488.     FOR y:=1 TO ymax DO
  489.      FOR x:=1 TO xmax DO
  490.       WriteChar(myfile,text[x,y]);
  491.       IF (myfile.res#done) THEN EXIT END;
  492.      END;
  493.     END;
  494.     FOR l:=0 TO hori+vert-1 DO
  495.      WriteBytes(myfile,ADR(kwr[l]),Length(kwr[l]),act);
  496.      IF (myfile.res#done) THEN EXIT END;
  497.      WriteChar(myfile,lf);
  498.      IF (myfile.res#done) THEN EXIT END;
  499.     END;
  500.     EXIT;
  501.    END;
  502.    IF (myfile.res#done) THEN
  503.     again:=HandleIOErr(writeC,body);
  504.    ELSE
  505.     again:=FALSE;
  506.    END;
  507.    IF (NOT again) THEN EXIT END;
  508.    IF filepresent THEN
  509.     filepresent:=FALSE;
  510.     Close(myfile);
  511.    END;
  512.   END;
  513.   IF filepresent THEN
  514.    filepresent:=FALSE;
  515.    Close(myfile);
  516.   END;
  517.  END SaveData;
  518.  
  519.  
  520.  
  521. PROCEDURE LoadData();
  522.  VAR a: FileString;
  523.      s: string;
  524.      act: LONGINT;
  525.      x,y,l,cnt,length: INTEGER;
  526.      err,again: BOOLEAN;
  527.      val: LONGINT;
  528.      body: lstring;
  529.  BEGIN
  530.   LOOP
  531.    Copy(dataReq.h,msg[71],0,1000);
  532.    NormalPointer;
  533.    FileReq(dataReq,a);
  534.    SleepPointer;
  535.    IF Length(a)=0 THEN EXIT END;
  536.    LOOP
  537.     body:=msg[16];
  538.     Lookup(myfile,a,5000,FALSE);
  539.     filepresent:=TRUE;
  540.     IF (myfile.res#done) THEN EXIT END;
  541.     body:=msg[34];
  542.     ReadBytes(myfile,ADR(s),8,act);
  543.     IF (myfile.res#done) THEN EXIT END;
  544.     IF Compare(s,0,8,"cpcdata!",TRUE)#0 THEN
  545.      body:=msg[35];
  546.      myfile.res:=notdone;
  547.      EXIT;
  548.     ELSE
  549.      s[4]:=nul;
  550.      ReadBytes(myfile,ADR(s),4,act);
  551.      IF (myfile.res#done) THEN EXIT END;
  552.      hori:=Value(s);
  553.      ReadBytes(myfile,ADR(s),4,act);
  554.      IF (myfile.res#done) THEN EXIT END;
  555.      vert:=Value(s);
  556.      ReadBytes(myfile,ADR(s),4,act);
  557.      IF (myfile.res#done) THEN EXIT END;
  558.      xmax:=Value(s);
  559.      ReadBytes(myfile,ADR(s),4,act);
  560.      IF (myfile.res#done) THEN EXIT END;
  561.      ymax:=Value(s);
  562.      FOR x:=0 TO maxgrid DO
  563.       FOR y:=0 TO maxgrid DO
  564.        text[x,y]:=nul;
  565.       END;
  566.      END;
  567.      FOR y:=1 TO ymax DO
  568.       FOR x:=1 TO xmax DO
  569.        ReadChar(myfile,text[x,y]);
  570.        IF (myfile.res#done) THEN EXIT END;
  571.       END;
  572.      END;
  573.      FOR l:=0 TO hori+vert-1 DO
  574.       cnt:=-1;
  575.       REPEAT
  576.        INC(cnt);
  577.        ReadChar(myfile,s[cnt]);
  578.        IF (myfile.res#done) THEN EXIT END;
  579.       UNTIL (s[cnt]=lf);
  580.       s[cnt]:=nul;
  581.       kwr[l]:=s;
  582.      END;
  583.     END;
  584.     EXIT;
  585.    END;
  586.    IF (myfile.res#done) THEN
  587.     again:=HandleIOErr(readC,body);
  588.    ELSE
  589.     again:=FALSE;
  590.    END;
  591.    IF (NOT again) THEN EXIT END;
  592.    IF filepresent THEN
  593.     filepresent:=FALSE;
  594.     Close(myfile);
  595.    END;
  596.   END;
  597.   IF filepresent THEN
  598.    filepresent:=FALSE;
  599.    Close(myfile);
  600.   END;
  601.  END LoadData;
  602.  
  603.  
  604.  
  605. PROCEDURE PrintSolution;
  606.  VAR s: string;
  607.      a,b: INTEGER;
  608.      body: lstring;
  609.      err,again: BOOLEAN;
  610.  BEGIN
  611.   LOOP
  612.    LOOP
  613.     err:=TRUE;
  614.     body:=msg[36];
  615.     printer:=Open(ADR("PRT:"),newFile);
  616.     IF (printer=NIL) THEN
  617.      body:=msg[37];
  618.      EXIT;
  619.     END;
  620.  
  621.     MakeComStr(s,esc,"c",nul,nul,nul,nul,nul,nul);
  622.     IF PutPRT(ADR(s),3) THEN EXIT END;
  623.  
  624.     MakeComStr(s,esc,"[","0","z",nul,nul,nul,nul);
  625.     IF PutPRT(ADR(s),5) THEN EXIT END;
  626.  
  627.     FOR a:=1 TO ymax DO
  628.      FOR b:=1 TO xmax DO
  629.       IF (text[b,a]=nul) THEN
  630.        s[0]:=" ";
  631.        IF PutPRT(ADR(s),1) THEN EXIT END;
  632.       ELSE
  633.        IF PutPRT(ADR(text[b,a]),1) THEN EXIT END;
  634.       END;
  635.      END;
  636.      s[0]:=lf;
  637.      IF PutPRT(ADR(s),1) THEN EXIT END;
  638.     END;
  639.  
  640.     MakeComStr(s,esc,"c",nul,nul,nul,nul,nul,nul);
  641.     IF PutPRT(ADR(s),Length(s)) THEN EXIT END;
  642.     err:=FALSE;
  643.     EXIT;
  644.    END;
  645.    IF (err) THEN
  646.     again:=HandleIOErr(printS,body);
  647.    ELSE
  648.     again:=FALSE;
  649.    END;
  650.    IF (NOT again) THEN EXIT END;
  651.    Dos.Close(printer);
  652.    printer:=NIL;
  653.   END;
  654.  
  655.   Dos.Close(printer);
  656.   printer:=NIL;
  657.  END PrintSolution;
  658.  
  659.  
  660.  
  661. PROCEDURE PrintCross;
  662.  VAR full: ARRAY [0..10] OF string;
  663.      mt: ARRAY [1..2] OF string;
  664.      graphon,graphoff,temp: string;
  665.      out: ARRAY [0..100] OF CHAR;
  666.      POW2: ARRAY[0..7] OF INTEGER;
  667.      m,n,ou,x,y,width: INTEGER;
  668.      s: CHAR;
  669.      act: LONGINT;
  670.      sorted,err,again: BOOLEAN;
  671.      pos,dotno: INTEGER;
  672.      body: lstring;
  673.      l1,l2: INTEGER;
  674.      lastlen: INTEGER;
  675.      converr: BOOLEAN;
  676.  BEGIN
  677.   LOOP
  678.    LOOP
  679.     err:=TRUE;
  680.     body:=msg[38];
  681.     parallel:=Open(ADR("PAR:"),newFile);
  682.     IF (parallel=NIL) THEN
  683.      body:=msg[39];
  684.      EXIT;
  685.     END;
  686.  
  687.     width:=640 DIV xmax;
  688.     IF (width>16) THEN
  689.      width:=16;
  690.     END;
  691.     POW2[0]:=1; POW2[1]:=2; POW2[2]:=4; POW2[3]:=8;
  692.     POW2[4]:=16; POW2[5]:=32; POW2[6]:=64; POW2[7]:=128;
  693.     FOR m:=0 TO 10 DO
  694.      FOR n:=1 TO width-1 DO
  695.       dotno:=RND(8);
  696.       temp[n]:=CHAR(POW2[dotno]);
  697.      END;
  698.      temp[width]:=nul;
  699.      full[m]:=temp;
  700.     END;
  701.     mt[1,0]:=CHAR(255);
  702.     mt[2,0]:=CHAR(255);
  703.     FOR n:=1 TO width-2 DO
  704.      mt[1,n]:=CHAR(128);
  705.      mt[2,n]:=CHAR(1);
  706.     END;
  707.     mt[1,width-1]:=CHAR(255);
  708.     mt[2,width-1]:=CHAR(255);
  709.  
  710.     MakeComStr(graphon,esc,"A",CHAR(8),esc,"*",CHAR(4),
  711.                CHAR((xmax*width) MOD 256),CHAR((xmax*width) DIV 256));
  712.     MakeComStr(graphoff,esc,"A",lf,nul,nul,nul,nul,nul);
  713.  
  714.     FOR y:=1 TO ymax DO
  715.      FOR ou:=1 TO 2 DO
  716.       IF PutPAR(ADR(graphon),Length(graphon)) THEN EXIT END;
  717.       FOR x:=1 TO xmax DO
  718.        IF (text[x,y]=nul) THEN
  719.         n:=RND(11);
  720.         IF PutPAR(ADR(full[n]),width) THEN EXIT END;
  721.        ELSE
  722.         IF PutPAR(ADR(mt[ou]),width) THEN EXIT END;
  723.        END;
  724.       END;
  725.       s:=lf;
  726.       IF PutPAR(ADR(s),1) THEN EXIT END;
  727.      END;
  728.     END;
  729.     IF PutPAR(ADR(graphoff),Length(graphoff)) THEN EXIT END;
  730.  
  731.     REPEAT
  732.      sorted:=TRUE;
  733.      FOR n:=1 TO hori+vert-1 DO
  734.       l1:=Length(kwr[n-1]);
  735.       l2:=Length(kwr[n]);
  736.       IF (l1<l2) OR ((l1=l2) AND (Compare(kwr[n-1],0,l1,kwr[n],FALSE)<0)) THEN
  737.        temp:=kwr[n-1];
  738.        kwr[n-1]:=kwr[n];
  739.        kwr[n]:=temp;
  740.        sorted:=FALSE;
  741.       END;
  742.      END;
  743.     UNTIL sorted;
  744.  
  745.     out[0]:=lf;
  746.     IF PutPAR(ADR(out),1) THEN EXIT END;
  747.     n:=-1;
  748.     lastlen:=10000;
  749.     REPEAT
  750.      INC(n);
  751.      IF Length(kwr[n])#lastlen THEN
  752.       lastlen:=Length(kwr[n]);
  753.       ValToStr(Length(kwr[n]),FALSE,out,10,2," ",converr);
  754.       out[2]:=":";
  755.       out[3]:=" ";
  756.       out[4]:=nul;
  757.      ELSE
  758.       out:="    ";
  759.      END;
  760.      AppendStr(out,kwr[n]);
  761.      AppendStr(out," ");
  762.      REPEAT
  763.       INC(n);
  764.       IF Length(kwr[n])=lastlen THEN
  765.        AppendStr(out,kwr[n]);
  766.        AppendStr(out," ");
  767.       END;
  768.      UNTIL (n>=hori+vert-1) OR (Length(out)+Length(kwr[n+1])+2>=78)
  769.                             OR (Length(kwr[n])#lastlen);
  770.      IF (n>=hori+vert-1) THEN
  771.       REPEAT
  772.        pos:=Length(out);
  773.        IF (out[pos-1]=" ") THEN
  774.         out[pos-1]:=nul;
  775.        END;
  776.       UNTIL (out[pos-1]#nul);
  777.      END;
  778.      IF Length(kwr[n])#lastlen THEN
  779.       DEC(n);
  780.      END;
  781.      IF PutPAR(ADR(out),Length(out)) THEN EXIT END;
  782.      out[0]:=lf;
  783.      IF PutPAR(ADR(out),1) THEN EXIT END;
  784.     UNTIL (n>=hori+vert-1);
  785.     err:=FALSE;
  786.     EXIT;
  787.    END;
  788.    IF (err) THEN
  789.     again:=HandleIOErr(printC,body);
  790.    ELSE
  791.     again:=FALSE;
  792.    END;
  793.    IF (NOT again) THEN EXIT END;
  794.    Dos.Close(parallel);
  795.    parallel:=NIL;
  796.   END;
  797.  
  798.   Dos.Close(parallel);
  799.   parallel:=NIL;
  800.  END PrintCross;
  801.  
  802. BEGIN
  803.  TermProcedure(CoolDown);
  804.  printer:=NIL;
  805.  parallel:=NIL;
  806.  filepresent:=FALSE;
  807. END CPCDosIO.
  808.