-
-
Save i-rinat/45f41d44d1cd4839a07b53017234b8e6 to your computer and use it in GitHub Desktop.
Nonograms in Turbo Pascal
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{ japan crosswords } | |
{.$DEFINE DumpEveryTime} | |
{$Define CheckInfinityLoop} | |
{$Define Skipping} | |
{$Define SkippingNotChanged} | |
{$Define Progress_bar} | |
{$Define FastClean1} | |
{/$L+,D+,Q+,R+,S+} | |
uses dos,crt; | |
const Diver : double = 2.0; | |
const EMPTY = 0; | |
UNKNOWN = -1; | |
FULL = 1; | |
DONTCHANGE = -2; | |
WORKING = 128; | |
STD_DRAW = 64; | |
SIZE_MAX = 100; | |
NUM_COUNT= 20; | |
var a :array[0..SIZE_MAX-1,0..SIZE_MAX-1]of shortint; | |
h_line,v_line :array[0..SIZE_MAX-1]of boolean; | |
h_size,v_size :integer; | |
i,j :integer; | |
task_h,task_v :array[0..SIZE_MAX-1,0..NUM_COUNT] of byte; | |
task_h_size, | |
task_v_size :array[0..SIZE_MAX-1]of double; | |
v_changed,h_changed :array[0..SIZE_MAX-1]of boolean; | |
work1,work2,work3 :array[0..SIZE_MAX-1]of shortint; | |
{ work1 - à ¡®ç¨© ¬ áᨢ, work2- ®¡à §¥æ, work3 - á㬬 â®à } | |
cellsize :integer; | |
x_ofs,y_ofs :integer; | |
cont_calc :boolean; | |
filename :string; | |
_time :longint; | |
oldExitProc :pointer; | |
{$IFDEF SkippingNotChanged} | |
size_change :integer; | |
{$ENDIF} | |
{$IFDEF Skipping} | |
var | |
skip:boolean; | |
KbdIntVec : Procedure; | |
{$F+} | |
procedure Keyclick; interrupt; | |
begin | |
if Port[$60] = $01 then {esc} | |
begin | |
skip:=true; | |
end; | |
inline ($9C); { PUSHF -- Push flags } | |
{ Call old ISR using saved vector } | |
KbdIntVec; | |
end; | |
{$F-} | |
{$ENDIF} | |
procedure SetRgb(c,r,g,b:byte); | |
begin | |
port[$3c8]:=c; port[$3c9]:=r; | |
port[$3c9]:=g; port[$3c9]:=b; | |
end; | |
function getdostimer:longint; | |
var hour,minute,sec,sec100:word; | |
temp:longint; | |
begin | |
gettime(hour,minute,sec,sec100); | |
temp:=hour; temp:=temp*60+minute; temp:=temp*60+sec; | |
getdostimer:=temp; | |
end; | |
procedure myExitProc; far; | |
begin | |
_time:=getdostimer-_time; | |
if _time<0 then inc(_time,86400); | |
writeln(_time,' sec'); | |
{$IFDEF Skipping} | |
SetIntVec($9,@KbdIntVec); | |
{$ENDIF} | |
ExitProc:=OldExitProc; | |
end; | |
procedure process_command_string; | |
procedure Usage; | |
begin | |
writeln('usage jpn_cwrd.exe [/n] <taskfile>'); | |
halt(0); | |
end; | |
begin | |
cont_calc:=true; | |
if paramcount<1 then Usage; | |
if (paramStr(1)='/n')or(paramStr(1)='/N') then begin | |
cont_calc:=false; | |
if paramcount<2 then Usage; | |
filename:=paramStr(2); | |
end else filename:=paramStr(1); | |
delete(filename,pos('.',filename),length(filename)-pos('.',filename)+1); | |
end; | |
procedure dump_state; | |
var df:file; | |
i,j:integer; | |
begin | |
assign(df,FILENAME+'.sol'); | |
filemode:=2; | |
rewrite(df,1); | |
blockwrite(df,h_size,2); | |
blockwrite(df,v_size,2); | |
for j:=0 to v_size-1 do | |
for i:=0 to h_size-1 do | |
blockwrite(df,a[i,j],1); | |
close(df); | |
end; | |
function FileExist(FileName: String): Boolean; | |
var F: file; | |
begin | |
{$I-} | |
Assign(F, FileName); | |
FileMode := 0; | |
Reset(F); | |
Close(F); | |
{$I+} | |
FileExist := (IOResult = 0) and (FileName <> ''); | |
end; { FileExists } | |
procedure read_state; | |
var df:file; | |
i,j:integer; | |
s:shortint; | |
begin | |
h_size:=0; v_size:=0; | |
{$I-} | |
assign(df,FILENAME+'.sol'); | |
filemode:=2; | |
reset(df,1); | |
if IOResult<>0 then begin cont_calc:=false; exit end; | |
{$I+} | |
blockread(df,h_size,2); | |
blockread(df,v_size,2); | |
for j:=0 to v_size-1 do | |
for i:=0 to h_size-1 do | |
blockread(df,a[i,j],1); | |
close(df); | |
end; | |
procedure SetMode(mode:byte); | |
var reg:registers; | |
begin | |
reg.ah:=0; | |
reg.al:=mode; | |
intr($10,reg); | |
end; | |
procedure PutCell(x,y,w:integer); | |
var i,j,nx,ny:integer; | |
c:byte; | |
ofs:word; | |
begin | |
nx:=x_ofs+x*cellsize; | |
ny:=y_ofs+y*cellsize; | |
ofs:=word(ny)*320+nx; | |
case w of | |
UNKNOWN, FULL, EMPTY : c:=STD_DRAW+w; | |
WORKING+UNKNOWN, | |
WORKING+FULL, | |
WORKING+EMPTY : c:=w; | |
else c:=1; | |
end; | |
for j:=0 to cellsize-1 do | |
begin | |
for i:=0 to cellsize-1 do mem[segA000:ofs+i]:=c; | |
inc(ofs,320); | |
end; | |
end; | |
function check(first,last:integer):boolean; | |
var i:integer; | |
f:boolean; | |
begin | |
f:=true; i:=first; | |
while (i<=last) do begin | |
if (work2[i]=FULL) and (work1[i]=EMPTY) then begin i:=last+1;f:=false; end else | |
if (work2[i]=EMPTY) and (work1[i]=FULL) then begin i:=last+1;f:=false; end; | |
inc(i); | |
end; | |
check:=f; | |
end; | |
procedure process_h(linenum:integer); | |
var k:integer; | |
old:boolean; | |
procedure walk_h(num,firstavail:integer); | |
var i,minpos,maxpos,lastpos:integer; | |
begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
if num>task_h[linenum,0] then | |
begin | |
for i:=firstavail to h_size-1 do work1[i]:=EMPTY; | |
if check(firstavail,h_size-1) then | |
for i:=0 to h_size-1 do begin | |
if work3[i]=UNKNOWN then work3[i]:=work1[i] | |
else if (work3[i]=FULL) and (work1[i]=EMPTY) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end | |
else if (work3[i]=EMPTY) and (work1[i]=FULL) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end; | |
end; | |
exit; | |
end; | |
minpos:=firstavail; | |
maxpos:=h_size-1; | |
for i:=num+1 to task_h[linenum,0] do maxpos:=maxpos-task_h[linenum,i]-1; | |
maxpos:=maxpos-task_h[linenum,num]+1; | |
for i:=minpos to maxpos do begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
for j:=0 to task_h[linenum,num]-1 do work1[j+i]:=FULL; | |
lastpos:=i+task_h[linenum,num]; | |
if lastpos<h_size then work1[lastpos]:=EMPTY else lastpos:=h_size-1; | |
if check(firstavail,lastpos) then | |
walk_h(num+1,lastpos+1); | |
{$IFDEF FastClean1} | |
work1[i]:=EMPTY; | |
{$ELSE} | |
for j:=i to h_size-1 do work1[j]:=EMPTY; | |
{$ENDIF FastClean1} | |
end; | |
end; | |
{$IFDEF Progress_bar} | |
procedure walk_h1(num,firstavail:integer); | |
var i,minpos,maxpos,lastpos:integer; | |
next_pos,pos,k:integer; | |
incer,real_pos:double; | |
begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
if num>task_h[linenum,0] then | |
begin | |
for i:=firstavail to h_size-1 do work1[i]:=EMPTY; | |
if check(firstavail,h_size-1) then | |
for i:=0 to h_size-1 do begin | |
if work3[i]=UNKNOWN then work3[i]:=work1[i] | |
else if (work3[i]=FULL) and (work1[i]=EMPTY) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end | |
else if (work3[i]=EMPTY) and (work1[i]=FULL) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end; | |
end; | |
exit; | |
end; | |
minpos:=firstavail; | |
maxpos:=h_size-1; | |
for i:=num+1 to task_h[linenum,0] do maxpos:=maxpos-task_h[linenum,i]-1; | |
maxpos:=maxpos-task_h[linenum,num]+1; | |
if maxpos=minpos then incer:=1 else incer:=maxpos-minpos; | |
incer:=320.0/incer; | |
pos:=0; next_pos:=0; real_pos:=0.0; | |
for i:=minpos to maxpos do begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
for j:=0 to task_h[linenum,num]-1 do work1[j+i]:=FULL; | |
lastpos:=i+task_h[linenum,num]; | |
if lastpos<h_size then work1[lastpos]:=EMPTY else lastpos:=h_size-1; | |
if check(firstavail,lastpos) then | |
walk_h(num+1,lastpos+1); | |
{$IFDEF FastClean1} | |
work1[i]:=EMPTY; | |
{$ELSE} | |
for j:=i to h_size-1 do work1[j]:=EMPTY; | |
{$ENDIF FastClean1} | |
real_pos:=real_pos+incer; | |
next_pos:=trunc(real_pos); | |
while (pos<next_pos)and(pos<320)do begin mem[segA000:pos]:=4;inc(pos);end; | |
end; | |
for i:=0 to 319 do mem[SegA000:i]:=0; | |
end; | |
{$ENDIF} | |
begin | |
{$IFDEF Skipping} | |
old:=h_changed[linenum]; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
size_change:=0; | |
{$ENDIF} | |
h_changed[linenum]:=false; | |
for k:=0 to h_size-1 do begin | |
work3[k]:=UNKNOWN; | |
work2[k]:=a[k,linenum]; | |
work1[k]:=UNKNOWN; | |
{$IFDEF SkippingNotChanged} | |
if work2[k]=UNKNOWN then inc(size_change); | |
{$ENDIF} | |
end; | |
{$IFDEF Progress_Bar} | |
walk_h1(1,0); | |
{$ELSE} | |
walk_h(1,0); | |
{$ENDIF} | |
{$IFDEF Progress_bar} | |
{$IFDEF Skipping} | |
if skip then for k:=0 to 319 do mem[SegA000:k]:=0; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then for k:=0 to 319 do mem[SegA000:k]:=0; | |
{$ENDIF} | |
{$ENDIF} {progress_bar} | |
{$IFDEF Skipping} | |
if skip then h_changed[linenum]:=old; | |
if not skip then | |
{$ENDIF} | |
for i:=0 to h_size-1 do begin | |
if ((work3[i]=FULL)or(work3[i]=EMPTY))and(work3[i]<>a[i,linenum]) then | |
begin | |
v_changed[i]:=true; | |
a[i,linenum]:=work3[i]; | |
end; | |
end; | |
{$IFDEF Skipping} | |
skip:=false; | |
{$ENDIF} | |
end; | |
procedure process_v(colnum:integer); | |
var k:integer; | |
old:boolean; | |
procedure walk_v(num,firstavail:integer); | |
var i,minpos,maxpos,lastpos:integer; | |
begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
if num>task_v[colnum,0] then | |
begin | |
for i:=firstavail to v_size-1 do work1[i]:=EMPTY; | |
if check(firstavail,v_size-1) then | |
for i:=0 to v_size-1 do begin | |
if work3[i]=UNKNOWN then work3[i]:=work1[i] | |
else if (work3[i]=FULL) and (work1[i]=EMPTY) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end | |
else if (work3[i]=EMPTY) and (work1[i]=FULL) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end; | |
end; | |
exit; | |
end; | |
minpos:=firstavail; | |
maxpos:=v_size-1; | |
for i:=num+1 to task_v[colnum,0] do maxpos:=maxpos-task_v[colnum,i]-1; | |
maxpos:=maxpos-task_v[colnum,num]+1; | |
for i:=minpos to maxpos do begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
for j:=0 to task_v[colnum,num]-1 do work1[j+i]:=FULL; | |
lastpos:=i+task_v[colnum,num]; | |
if lastpos<v_size then work1[lastpos]:=EMPTY else lastpos:=v_size-1; | |
if check(firstavail,lastpos) then walk_v(num+1,lastpos+1); | |
{$IFDEF FastClean1} | |
work1[i]:=EMPTY; | |
{$ELSE} | |
for j:=i to v_size-1 do work1[j]:=EMPTY; | |
{$ENDIF FastClean1} | |
end; | |
end; | |
{$IFDEF Progress_Bar} | |
procedure walk_v1(num,firstavail:integer); | |
var i,minpos,maxpos,lastpos:integer; | |
next_pos,pos,k:integer; | |
incer,real_pos:double; | |
begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
if num>task_v[colnum,0] then | |
begin | |
for i:=firstavail to v_size-1 do work1[i]:=EMPTY; | |
if check(firstavail,v_size-1) then | |
for i:=0 to v_size-1 do begin | |
if work3[i]=UNKNOWN then work3[i]:=work1[i] | |
else if (work3[i]=FULL) and (work1[i]=EMPTY) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end | |
else if (work3[i]=EMPTY) and (work1[i]=FULL) then begin | |
work3[i]:=DONTCHANGE; {$IFDEF SkippingNotChanged}dec(size_change);{$ENDIF}end; | |
end; | |
exit; | |
end; | |
minpos:=firstavail; | |
maxpos:=v_size-1; | |
if maxpos=minpos then incer:=1 else incer:=maxpos-minpos; | |
incer:=320.0/incer; | |
pos:=0; next_pos:=0; real_pos:=0.0; | |
for i:=num+1 to task_v[colnum,0] do maxpos:=maxpos-task_v[colnum,i]-1; | |
maxpos:=maxpos-task_v[colnum,num]+1; | |
for i:=minpos to maxpos do begin | |
{$IFDEF Skipping} | |
if skip then exit; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then exit; | |
{$ENDIF} | |
for j:=0 to task_v[colnum,num]-1 do work1[j+i]:=FULL; | |
lastpos:=i+task_v[colnum,num]; | |
if lastpos<v_size then work1[lastpos]:=EMPTY else lastpos:=v_size-1; | |
if check(firstavail,lastpos) then walk_v(num+1,lastpos+1); | |
{$IFDEF FastClean1} | |
work1[i]:=EMPTY; | |
{$ELSE} | |
for j:=i to v_size-1 do work1[j]:=EMPTY; | |
{$ENDIF FastClean1} | |
real_pos:=real_pos+incer; | |
next_pos:=trunc(real_pos); | |
while (pos<next_pos)and(pos<320)do begin mem[segA000:pos]:=4;inc(pos);end; | |
end; | |
for i:=0 to 319 do mem[SegA000:i]:=0; | |
end; | |
{$ENDIF} | |
begin | |
{$IFDEF Skipping} | |
old:=v_changed[colnum]; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
size_change:=0; | |
{$ENDIF} | |
v_changed[colnum]:=false; | |
for k:=0 to v_size-1 do begin | |
work3[k]:=UNKNOWN; | |
work2[k]:=a[colnum,k]; | |
work1[k]:=UNKNOWN; | |
{$IFDEF SkippingNotChanged} | |
if work2[k]=UNKNOWN then inc(size_change); | |
{$ENDIF} | |
end; | |
{$IFDEF Progress_bar} | |
walk_v1(1,0); | |
{$ELSE} | |
walk_v(1,0); | |
{$ENDIF} | |
{$IFDEF Progress_bar} | |
{$IFDEF Skipping} | |
if skip then for k:=0 to 319 do mem[SegA000:k]:=0; | |
{$ENDIF} | |
{$IFDEF SkippingNotChanged} | |
if size_change=0 then for k:=0 to 319 do mem[SegA000:k]:=0; | |
{$ENDIF} | |
{$ENDIF} {progress_bar} | |
{$IFDEF Skipping} | |
if skip then v_changed[colnum]:=old; | |
if not skip then | |
{$ENDIF} | |
for i:=0 to v_size-1 do begin | |
if ((work3[i]=FULL)or(work3[i]=EMPTY))and(work3[i]<>a[colnum,i]) then | |
begin | |
h_changed[i]:=true; | |
a[colnum,i]:=work3[i]; | |
end; | |
end; | |
{$IFDEF Skipping} | |
skip:=false; | |
{$ENDIF} | |
end; | |
procedure read_task; | |
var f:text; | |
i,j,nx,ny:integer; | |
procedure size_fail_proc; | |
begin | |
SetMode($3); | |
close(f); | |
writeln('size too big'); | |
halt(1); | |
end; | |
begin | |
assign(f,FILENAME+'.jcs'); | |
reset(f); | |
read(f,h_size,v_size); | |
if (h_size>SIZE_MAX)or(v_size>SIZE_MAX) then size_fail_proc; | |
readln(f); | |
for i:=0 to v_size-1 do h_changed[i]:=true; | |
for i:=0 to h_size-1 do v_changed[i]:=true; | |
for i:=0 to h_size-1 do | |
for j:=0 to v_size-1 do a[i,j]:=UNKNOWN; | |
for i:=0 to h_size-1 do | |
begin | |
task_v[i,0]:=0; | |
while not eoln(f) do | |
begin inc(task_v[i,0]); if task_v[i,0]>NUM_COUNT then size_fail_proc; | |
read(f,task_v[i,task_v[i,0]]); end; | |
readln(f); | |
end; | |
readln(f); | |
for i:=0 to v_size-1 do | |
begin | |
task_h[i,0]:=0; | |
while not eoln(f) do | |
begin inc(task_h[i,0]); if task_h[i,0]>NUM_COUNT then size_fail_proc; | |
read(f,task_h[i,task_h[i,0]]); end; | |
readln(f); | |
end; | |
close(f); | |
nx:=0; ny:=0; cellsize:=0; | |
while (nx<=300) and (ny<=180) and (cellsize<10) do begin | |
inc(nx,h_size); | |
inc(ny,v_size); | |
inc(cellsize); | |
end; | |
dec(nx,h_size); | |
dec(ny,v_size); | |
dec(cellsize); | |
x_ofs:=(320-nx)div 2; | |
y_ofs:=(200-ny)div 2; | |
for i:=0 to h_size-1 do v_line[i]:=true; | |
for i:=0 to v_size-1 do h_line[i]:=true; | |
for i:=0 to h_size-1 do begin | |
task_v_size[i]:=0; | |
for j:=1 to task_v[i,0] do task_v_size[i]:=task_v_size[i]+task_v[i,j]; | |
task_v_size[i]:=exp(task_v[i,0]*ln(v_size-task_v_size[i]-task_v[i,0]+2)); | |
end; | |
for i:=0 to v_size-1 do begin | |
task_h_size[i]:=0; | |
for j:=1 to task_h[i,0] do task_h_size[i]:=task_h_size[i]+task_h[i,j]; | |
task_h_size[i]:=exp(task_h[i,0]*ln(h_size-task_h_size[i]-task_h[i,0]+2)); | |
end; | |
end; | |
procedure solve; | |
var i,j:integer; | |
l_now,l_last:longint; | |
s:integer; | |
f:boolean; | |
procedure stop_and_dump; | |
begin | |
case readkey of | |
'q','Q': begin | |
dump_state; | |
SetMode($3); | |
halt; | |
end; | |
's','S': begin | |
dump_state; | |
end; | |
end; | |
end; | |
begin | |
l_now:=longint(h_size)*longint(v_size); | |
if (cont_calc) and fileExist(FILENAME+'.sol') then begin | |
read_state; | |
end; | |
for i:=0 to h_size-1 do | |
for j:=0 to v_size-1 do PutCell(i,j,a[i,j]); | |
repeat | |
l_last:=l_now; | |
{ hor : x line} | |
for j:=0 to v_size-1 do if (task_h_size[j]<Diver) then if h_line[j] then begin | |
for i:=0 to h_size-1 do PutCell(i,j,WORKING+a[i,j]); | |
if keypressed then stop_and_dump; | |
if h_changed[j] then process_h(j); | |
s:=h_size; | |
for i:=0 to h_size-1 do begin | |
PutCell(i,j,a[i,j]);if a[i,j]<>UNKNOWN then dec(s);end; | |
if s=0 then h_line[j]:=false; | |
end; | |
{ vert : y line } | |
for i:=0 to h_size-1 do if (task_v_size[i]<Diver) then if (v_line[i]) then begin | |
for j:=0 to v_size-1 do PutCell(i,j,WORKING+a[i,j]); | |
if keypressed then stop_and_dump; | |
if v_changed[i] then process_v(i); | |
s:=v_size; | |
for j:=0 to v_size-1 do begin | |
PutCell(i,j,a[i,j]);if a[i,j]<>UNKNOWN then dec(s);end; | |
if s=0 then v_line[i]:=false; | |
end; | |
{$IFDEF DumpEveryTime} | |
dump_state; | |
{$ENDIF} | |
for i:=0 to v_size-1 do task_h_size[i]:=task_h_size[i]/Diver; | |
for i:=0 to h_size-1 do task_v_size[i]:=task_v_size[i]/Diver; | |
l_now:=0; | |
for i:=0 to h_size-1 do | |
for j:=0 to v_size-1 do if a[i,j]=UNKNOWN then inc(l_now); | |
{$IFDEF CheckInfinityLoop} | |
f:=false; | |
for i:=0 to h_size-1 do f:=f or v_changed[i] or (task_v_size[i]>Diver); | |
for i:=0 to v_size-1 do f:=f or h_changed[i] or (task_h_size[i]>Diver); | |
if (not f)and(l_now>0) then begin | |
SetMode($3); | |
writeln(filename,' : error (infinity loop)'); | |
dump_state; | |
halt(1); | |
end; | |
{$EndIf} | |
until (l_now=0); | |
end; | |
procedure initVideo; | |
const deep:double=0.3; | |
begin | |
SetMode($13); | |
SetRgb(STD_DRAW+UNKNOWN,42,42,42); | |
SetRgb(STD_DRAW+EMPTY ,21,21,21); | |
SetRgb(STD_DRAW+FULL ,63,63,63); | |
SetRgb(WORKING+EMPTY,trunc(0*deep+(1-deep)*21),trunc(42*deep+(1-deep)*21),trunc(0*deep+(1-deep)*21)); | |
SetRgb(WORKING+FULL,trunc(0*deep+(1-deep)*63),trunc(42*deep+(1-deep)*63),trunc(0*deep+(1-deep)*63)); | |
SetRgb(WORKING+UNKNOWN,trunc(0*deep+(1-deep)*42),trunc(42*deep+(1-deep)*42),trunc(0*deep+(1-deep)*42)); | |
end; | |
begin | |
{$IFDEF Skipping} | |
GetIntVec($9,@KbdIntVec); | |
SetIntVec($9,Addr(Keyclick)); | |
skip:=false; | |
{$ENDIF} | |
oldExitProc:=ExitProc; | |
ExitProc:=@myExitProc; | |
_time:=getdostimer; | |
process_command_string; | |
initVideo; | |
read_task; | |
solve; | |
dump_state; | |
SetMode($3); | |
writeln(filename,' : no errors'); | |
end. |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
uses crt,dos; | |
const EMPTY = 0; | |
UNKNOWN = -1; | |
FULL = 1; | |
DONTCHANGE = -2; | |
WORKING = 3; | |
SIZE_MAX = 100; | |
NUM_COUNT= 20; | |
var a :array[0..SIZE_MAX-1,0..SIZE_MAX-1]of shortint; | |
h_size,v_size :integer; | |
i,j :integer; | |
cellsize :integer; | |
x_ofs,y_ofs :integer; | |
filename :string; | |
nx,ny :integer; | |
done :boolean; | |
x,y,xold,yold:integer; | |
var mouse_x,mouse_y:integer; | |
pressed_l,pressed_r:boolean; | |
mouse_present:boolean; { ᫨ ¬ëèì ¯à¨áãâáâ¢ã¥â, íâ ¯¥à¥¬¥ ï ¨¬¥¥â § 票¥ true } | |
number_of_mouse_buttons:word; { ®«¨ç¥á⢮ ª®¯®ª ¬ëè¨ } | |
function init_mouse:boolean; | |
var temp:word; | |
begin | |
asm | |
mov ax,0 | |
int 33h | |
mov temp,ax | |
mov number_of_mouse_buttons,bx | |
end; | |
init_mouse:=(temp=$FFFF); | |
end; | |
procedure hide_mouse;assembler; | |
asm | |
mov ax,2 | |
int 33h | |
end; | |
procedure show_mouse;assembler; | |
asm | |
mov ax,1 | |
int 33h | |
end; | |
procedure get_mouse; | |
var temp:word; | |
begin | |
asm | |
mov ax,3 | |
int 33h | |
mov mouse_x,cx | |
mov mouse_y,dx | |
mov temp,bx | |
end; | |
pressed_l:=(temp and 1 = 1); | |
pressed_r:=(temp and 2 = 2); | |
end; | |
procedure read_state; | |
var df:file; | |
i,j:integer; | |
s:shortint; | |
begin | |
h_size:=0; v_size:=0; | |
{$I-} | |
assign(df,FILENAME); | |
filemode:=2; | |
reset(df,1); | |
if IOResult<>0 then exit; | |
{$I+} | |
blockread(df,h_size,2); | |
blockread(df,v_size,2); | |
for j:=0 to v_size-1 do | |
for i:=0 to h_size-1 do | |
blockread(df,a[i,j],1); | |
close(df); | |
end; | |
procedure SetMode(mode:byte); | |
var reg:registers; | |
begin | |
reg.ah:=0; | |
reg.al:=mode; | |
intr($10,reg); | |
end; | |
procedure PutCell(x,y,w:integer); | |
var i,j,nx,ny:integer; | |
c:byte; | |
ofs:word; | |
begin | |
nx:=x_ofs+x*cellsize; | |
ny:=y_ofs+y*cellsize; | |
ofs:=word(ny)*320+nx; | |
case w of | |
UNKNOWN : c:=7; | |
FULL : c:=15; | |
EMPTY : c:=8; | |
WORKING : c:=2; | |
else c:=1; | |
end; | |
for j:=0 to cellsize-1 do | |
begin | |
for i:=0 to cellsize-1 do mem[$a000:ofs+i]:=c; | |
inc(ofs,320); | |
end; | |
end; | |
function lz(x:integer):string; | |
var tmp,tmp2:string[2]; | |
begin | |
str((x mod 100)div 10,tmp); | |
str(x mod 10,tmp2); | |
lz:=tmp+tmp2; | |
end; | |
begin | |
if paramCount<1 then begin | |
Writeln('Usage: sol_view <solfile.sol>'); | |
halt(1); | |
end; | |
filename:=paramstr(1); | |
read_state; | |
nx:=0; ny:=0; cellsize:=0; | |
while (nx<=300) and (ny<=180) and (cellsize<10) do begin | |
inc(nx,h_size); | |
inc(ny,v_size); | |
inc(cellsize); | |
end; | |
dec(nx,h_size); | |
dec(ny,v_size); | |
dec(cellsize); | |
x_ofs:=(320-nx)div 2; | |
y_ofs:=(200-ny)div 2; | |
SetMode($13); | |
for i:=0 to h_size-1 do | |
for j:=0 to v_size-1 do Putcell(i,j,a[i,j]); | |
init_mouse; | |
Show_Mouse; | |
done:=false; | |
directVideo:=false; | |
xold:=-1; yold:=-1; | |
repeat | |
get_mouse; | |
mouse_x:=mouse_x div 2; | |
x:=mouse_x-x_ofs; | |
y:=mouse_y-y_ofs; | |
x:=x div cellsize; | |
y:=y div cellsize; | |
if (x>=0)and(y>=0)and(x<h_size)and(y<v_size)and((x<>xold)or(y<>yold)) then begin | |
xold:=x; yold:=y; | |
gotoxy(1,1); | |
write(lz(x),':',lz(y),' -> ',a[x,y],' '); | |
end; | |
if keypressed then | |
case readkey of | |
#27:done:=true; | |
end; | |
until done; | |
SetMode($3); | |
end. |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
50 35 | |
14 1 | |
1 3 1 3 1 | |
2 12 2 1 | |
2 2 2 1 | |
2 2 1 13 1 | |
1 2 1 1 1 1 1 1 | |
2 2 1 1 1 1 1 1 | |
1 2 1 13 1 | |
2 2 1 1 1 1 1 1 | |
1 1 2 1 1 1 1 1 1 | |
1 2 2 1 13 1 | |
2 1 2 2 1 | |
2 2 2 8 1 4 1 | |
1 1 2 1 1 1 1 2 2 | |
2 2 2 1 1 1 1 1 1 | |
1 1 2 1 1 1 1 1 2 1 | |
2 2 2 8 1 1 1 | |
2 1 2 1 1 1 1 2 2 | |
1 1 2 1 1 1 1 4 1 | |
2 2 2 1 1 1 1 2 1 | |
2 1 2 8 1 2 1 | |
1 1 2 1 1 1 1 2 1 | |
2 2 2 1 1 1 1 2 1 | |
1 1 2 8 1 2 1 | |
2 2 2 1 1 1 1 2 1 | |
2 4 1 1 1 1 2 1 | |
1 4 8 1 2 1 | |
6 2 1 | |
5 1 13 1 | |
4 1 1 1 1 1 1 | |
3 1 1 1 1 1 1 | |
3 1 13 1 | |
2 1 1 1 1 1 1 | |
2 1 1 1 1 1 1 | |
2 1 13 1 | |
2 2 1 | |
2 8 1 4 1 | |
2 1 1 1 1 2 2 | |
2 1 1 1 1 1 1 | |
2 1 1 1 1 1 2 1 | |
2 1 1 1 1 1 1 | |
2 8 1 2 2 | |
2 4 1 | |
2 7 2 1 | |
2 2 2 2 1 | |
2 1 1 3 1 | |
2 1 2 2 1 1 | |
2 12 1 1 | |
5 4 1 | |
3 1 | |
2 3 | |
2 2 | |
2 3 | |
3 3 | |
3 2 | |
3 3 | |
3 2 | |
3 3 | |
3 3 | |
4 2 | |
4 3 | |
3 2 | |
6 | |
7 | |
48 | |
49 | |
3 2 | |
3 7 15 7 6 5 | |
1 1 1 1 1 1 1 1 1 2 2 | |
1 1 7 15 7 6 1 1 | |
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 | |
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 | |
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 | |
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 | |
1 1 1 1 1 15 1 1 1 6 2 1 | |
3 7 7 4 | |
1 1 1 1 15 1 1 1 6 2 | |
1 1 1 1 1 1 1 1 | |
1 1 1 1 5 1 1 1 5 3 | |
2 7 2 2 7 2 2 2 1 | |
4 1 3 1 11 1 3 1 4 1 | |
12 1 19 1 7 | |
2 2 2 2 | |
5 5 | |
13 19 8 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment