PROGRAM crossword(input,output); uses dos,crt,graph; LABEL stop,last; VAR data,start:file of integer; done:array[1..6] of 0..1; f:array[1..15] of char; a,d:array[1..25] of integer; p,q:array[0..14,0..14] of integer; count,x,ch3,i,j,k,kp,l,m,n,b,c,mp:integer; sum,code,prevk,errorcode,gd,gm:integer; cluey1,cluey2,cluey3,cluey4,cluey5,cluey6:text; cl,path:string; clues:array[1..14] of string; ans,ch1,ch2,ch5,ch6:char; error:boolean; PROCEDURE PUTPART(X1,Y1,X2,Y2:WORD;VAR F:FILE); VAR BLOCK_START:POINTER; BLOCK_SIZE:WORD; BEGIN BLOCK_SIZE:=IMAGESIZE(X1,Y1,X2,Y2); GETMEM(BLOCK_START,BLOCK_SIZE); BLOCKREAD(F,BLOCK_START^,BLOCK_SIZE); PUTIMAGE(X1,Y1,BLOCK_START^,0); FREEMEM(BLOCK_START,BLOCK_SIZE); END; PROCEDURE LOADSCREEN(INPUT_STRING:STRING); VAR F:FILE; X:WORD; I:BYTE; BEGIN X:=GETMAXX DIV 4; ASSIGN(F,INPUT_STRING); RESET(F,1); FOR I:=0 TO 3 DO PUTPART((I*X),0,(X*(I+1)),GETMAXY,F); CLOSE(F); END; PROCEDURE SAVEPART(X1,Y1,X2,Y2:WORD;VAR F:FILE); VAR BLOCK_START:POINTER; BLOCKSIZE:WORD; BEGIN BLOCKSIZE:=IMAGESIZE(X1,Y1,X2,Y2); GETMEM(BLOCK_START,BLOCKSIZE); GETIMAGE(X1,Y1,X2,Y2,BLOCK_START^); BLOCKWRITE(F,BLOCK_START^,BLOCKSIZE); FREEMEM(BLOCK_START,BLOCKSIZE); END; PROCEDURE SAVESCREEN(INPUT_STRING:STRING); VAR F:FILE; X:WORD; I:BYTE; BEGIN X:=GETMAXX DIV 4; ASSIGN(F,INPUT_STRING); REWRITE(F,1); FOR I:=0 TO 3 DO SAVEPART((X*I),0,(X*(I+1)),GETMAXY,F); CLOSE(F); END; PROCEDURE PRINTSCREEN; VAR REGS:REGISTERS; BEGIN FILLCHAR(REGS,SIZEOF(REGS),0); REGS.AH:=$05; INTR($5,REGS); END; PROCEDURE open; BEGIN CASE x OF 0:reset(cluey1); 1:reset(cluey2); 2:reset(cluey3); 3:reset(cluey4); 4:reset(cluey5); 5:reset(cluey6); END; END; PROCEDURE closef; BEGIN CASE x OF 0:close(cluey1); 1:close(cluey2); 2:close(cluey3); 3:close(cluey4); 4:close(cluey5); 5:close(cluey6); END; END; PROCEDURE readdata; BEGIN CASE x OF 0:readln(cluey1,cl); 1:readln(cluey2,cl); 2:readln(cluey3,cl); 3:readln(cluey4,cl); 4:readln(cluey5,cl); 5:readln(cluey6,cl); END; END; PROCEDURE z; BEGIN clearviewport; setviewport(0,430,639,460,clipon); END; PROCEDURE box; BEGIN window(14,8,66,17); clrscr; window(1,1,80,25); gotoxy(20,8); write('Ú'); gotoxy(61,8); write('¿'); gotoxy(20,18); write('À'); gotoxy(61,18); write('Ù'); gotoxy(20,13); write('³'); gotoxy(61,13); write('³'); for k:= 1 to 2 do begin for i:=1 to 4 do begin gotoxy(20,i+8+(k-1)*5); write('³'); gotoxy(61,i+8+(k-1)*5); write('³'); for j:=1 to 40 do begin gotoxy(j+20,k*10-2); write('Ä'); gotoxy(j+20,i+8+(k-1)*5); write('²'); end; end; for m:= 1 to 10 do begin gotoxy(m+(k-1)*30+20,13); write('²'); end; end; gotoxy(29,12); write('ENTER CORRECT BGI PATH:'); END; PROCEDURE highlight; BEGIN b:=round((kp-257)/12)+1; setviewport(0,kp,639,kp+10,clipon); clearviewport; if mp=0 then begin setcolor(yellow); setviewport(mp,kp,290,kp+12,clipon); outtextxy(0,0,clues[b]); setcolor(white); setviewport(300,kp,639,kp+12,clipon); outtextxy(-300,0,clues[b]); end else begin setcolor(yellow); setviewport(300,kp,639,kp+12,clipon); outtextxy(-300,0,clues[b]); setcolor(white); setviewport(0,kp,290,kp+12,clipon); outtextxy(0,0,clues[b]); end; END; PROCEDURE change; BEGIN b:=round((prevk-257)/12)+1; setviewport(0,prevk,639,prevk+10,clipon); clearviewport; setviewport(0,0,639,479,clipon); outtextxy(0,prevk,clues[b]); highlight; END; PROCEDURE exit; BEGIN setviewport(0,0,639,479,clipon); clearviewport; PRINTSCREEN; case x of 0:LOADSCREEN('C0'); 1:loadscreen('c1'); 2:loadscreen('c2'); 3:loadscreen('c3'); 4:loadscreen('c4'); 5:loadscreen('c5'); end; setviewport(10,450,639,479,clipon); setcolor(lightred); outtextxy(0,0,'Press spacebar to exit this crossword'); setcolor(white); repeat ch2:=readkey; until ch2=' '; closegraph; textcolor(green); write('DO YOU WANT ANOTHER CROSSWORD(Y/N)?'); repeat gotoxy(36,1); clreol; readln(ans); ans:=upcase(ans); until (ans='Y') or (ans='N'); END; PROCEDURE solve; BEGIN setviewport(0,0,639,479,clipon); case ch1 of 'd':begin for i:= 1 to j do begin n:=d[ch3]+(i-1)*17; if f[i]=' ' then begin if (q[b+1,c]<>1) and(q[b-1,c]<>1) then begin setviewport(k,n,k+8,n+8,clipon); clearviewport; q[b,c]:=0; end; setviewport(0,0,639,479,clipon); for m:=1 to 25 do begin str(m,cl); outtextxy(a[m]-5,12+((d[m] div 17)-1)*17,cl); end; end else begin setcolor(green); outtextxy(k,n,f[i]); setcolor(white); q[b,c]:=1; end; c:=c+1; end; end; 'a':begin for i:=1 to j do begin n:=a[ch3]+(i-1)*17; if f[i]=' ' then begin if (q[b,c+1]<>1) and (q[b,c-1]<>1) then begin setviewport(n,k,n+8,k+8,clipon); clearviewport; q[b,c]:=0; end; setviewport(0,0,639,479,clipon); for m:= 1 to 25 do begin str(m,cl); outtextxy(a[m]-5,12+((d[m] div 17)-1)*17,cl); end; end else begin setcolor(green); outtextxy(n,k,f[i]); setcolor(white); q[b,c]:=1; end; b:=b+1; end; end; end; END; BEGIN clrscr; assign(cluey1,'clues1.txt'); assign(cluey2,'clues2.txt'); assign(cluey3,'clues3.txt'); assign(cluey4,'clues4.txt'); assign(cluey5,'clues5.txt'); assign(cluey6,'clues6.txt'); assign(data,'data'); assign(start,'start'); for i:=1 to 6 do done[i]:=0; count:=0; repeat repeat randomize; x:=random(6); until (done[x+1]=0) and (count<>6);; done[x+1]:=1; count:=count+1; gd:=detect; if error=true then initgraph(gd,gm,path) else initgraph(gd,gm,'c:\turbo\bgi'); errorcode:=graphresult; while errorcode<>grok do begin write(#7); error:=true; clrscr; {obtains correct BGI path} box; gotoxy(31,13); readln(path); gd:=detect; initgraph(gd,gm,path); errorcode:=graphresult; end; rectangle(140,10,361,231); i:=27; while i<>231 do begin line(140,i,361,i); i:=i+17; end; i:=157; while i<>361 do begin line(i,10,i,231); i:=i+17; end; for i:=0 to 14 do for j:=0 to 14 do q[i,j]:=0; reset(data); for i:=1 to 13 do for j:=1 to 13 do begin read(data,p[j,i]); if p[j,i]=1 then floodfill(128+j*17,i*17,white); end; reset(start); for i:=1 to 25 do begin read(start,a[i],d[i]); str(i,cl); k:=d[i] div 17; outtextxy(a[i]-5,12+(k-1)*17,cl); end; close(start); open; i:=233; mp:=0; kp:=257; prevk:=kp; for j:=1 to 16 do begin readdata; if j>2 then clues[j-2]:=cl; if j=3 then begin highlight; setviewport(0,0,639,479,clipon); end else outtextxy(1,i,cl); i:=i+12; end; closef; setcolor(lightred); outtextxy(0,465,'Press spacebar to exit and see answers'); setcolor(white); repeat setviewport(0,0,639,479,clipon); ch2:=' '; while ch2 <> #13 do begin ch2:=readkey; if ch2=#0 then ch2:=readkey; case ch2 of #75:begin {left arrow} if mp=300 then mp:=0 else begin if kp=257 then kp:=413 else kp:=kp-12; mp:=300; end; change; prevk:=kp; end; #77:begin {right arrow} if mp=0 then mp:=300 else begin if kp=413 then kp:=257 else kp:=kp+12; mp:=0; end; change; prevk:=kp; end; #72:begin {up arrow} if kp=257 then kp:=413 else kp:=kp-12; change; prevk:=kp; end; #80:begin {down arrow} if kp=413 then kp:=257 else kp:=kp+12; change; prevk:=kp; end; ' ':begin exit; goto stop; end; end; end; if mp=0 then ch1:='a' else ch1:='d'; case ch1 of 'a':begin case kp of 257:ch3:=1; 269:ch3:=4; 281:ch3:=7; 293:ch3:=8; 305:ch3:=9; 317:ch3:=12; 329:ch3:=14; 341:ch3:=15; 353:ch3:=16; 365:ch3:=18; 377:ch3:=22; 389:ch3:=23; 401:ch3:=24; 413:ch3:=25; end; setviewport(100,440,115,450,clipon); z; case ch3 of 1,4,14,15,24,25:j:=6; 7,23:j:=4; 8,22:j:=8; 9,18:j:=7; 12,16:j:=3; end; end; 'd':begin case kp of 257:ch3:=1; 269:ch3:=2; 281:ch3:=3; 293:ch3:=4; 305:ch3:=5; 317:ch3:=6; 329:ch3:=10; 341:ch3:=11; 353:ch3:=12; 365:ch3:=13; 377:ch3:=17; 389:ch3:=19; 401:ch3:=20; 413:ch3:=21; end; setviewport(100,440,115,450,clipon); z; case ch3 of 1,2,12,13:j:=9; 3,4,6,10,11,17,19,20:j:=5; 5,21:j:=4; end; end; end; sum:=0; case ch1 of 'd':begin k:=a[ch3]; b:=trunc((k-128)/17); c:=trunc(d[ch3]/17); for i:=c to c+j-1 do sum:=sum+q[b,i]; end; 'a':begin k:=d[ch3]; c:=trunc(k/17); b:=trunc((a[ch3]-128)/17); for i:=b to b+j-1 do sum:=sum+q[i,c]; end; end; for i:=1 to 15 do f[i]:=' '; setviewport(0,430,639,460,clipon); if sumj+1) then begin setcolor(cyan); outtextxy(0,20,'No. of characters is less-continue entering'); setcolor(white); end else begin while f[i]=#8 do begin setviewport(100+8*(i-1),430,100+9*i,450,clipon); z; i:=i-1; if i=0 then i:=1; f[i]:=upcase(readkey); end; if f[i]<>#13 then outtextxy(100+8*i,5,f[i]); if (f[i]=#13) and (i<>j+1) then begin setcolor(cyan); outtextxy(0,20,'No. of characters is less-continue entering'); setcolor(white); goto last; end; i:=i+1; end; last:end; end else begin setcolor(cyan); outtextxy(1,20,'The required answer has been deleted.'); setcolor(white); delay(8000); end; clearviewport; solve; until readkey=' '; exit; stop: until (ans='N') or (count=6); end.