program EntangledRectangles; {$ifdef touchscreen} uses sensor; {$endif} const maxrects=9; maxentas=1000; //maxentas=max allowed entaglements minmargin=2; //min margin when creating solution shufflesteps=30; type gamerec=record rects,entas,selrect,selside,maxentas,maxx,maxy,grid,maxgrid: integer; //game.maxentas=max possible for current number of rects solved: boolean; end; entanglement=record rect1,side1,rect2,side2,value,r,g,b: integer; end; rect=record x1,y1,x2,y2,r,g,b: integer; end; var rects: array[0..maxrects] of rect; entas: array[0..maxentas] of entanglement; game: gamerec; inside: boolean; keycode: integer; cmdclicked,cmdok,cmdsettings,cmdhelp,cmdquit: command; fancy: boolean; {$ifdef touchscreen} pgss,pddx,pddy,pdddx,pdddy,pdx,pdy,px,py,pstate: integer; {$endif} function moveside(rect,side,amount:integer):boolean; var a: integer; b: boolean; begin if side=0 then rects[rect].y1:=rects[rect].y1+amount else if side=1 then rects[rect].x2:=rects[rect].x2+amount else if side=2 then rects[rect].y2:=rects[rect].y2+amount else rects[rect].x1:=rects[rect].x1+amount; //check bounds b:= (rects[rect].x1>0) and (rects[rect].x10) and (rects[rect].x20) and (rects[rect].y10) and (rects[rect].y20) and (rects[entas[a].rect2].x10) and (rects[entas[a].rect2].x20) and (rects[entas[a].rect2].y10) and (rects[entas[a].rect2].y2=0) and (pos<=1) then givecolor:=trunc(pos*255); if (pos>1) and (pos<2) then givecolor:=trunc((2-pos)*255); end; procedure setrects; //generate solution, initialize rectangles & fancy mode colors var a,rect,side,amount,x,y,w,h: integer; pos,posstep:real; begin //generate solution x:=random(game.maxx-minmargin*3)+minmargin; y:=random(game.maxy-minmargin*3)+minmargin; w:=random(game.maxx-x-minmargin*2)+minmargin; h:=random(game.maxy-y-minmargin*2)+minmargin; posstep:=3/rabs(game.rects); //rabs to operate as real pos:=random(30)/rabs(10); //set all rects to it for a:=0 to game.rects-1 do begin rects[a].x1:=x; rects[a].x2:=x+w; rects[a].y1:=y; rects[a].y2:=y+h; pos:=rmod3(pos+posstep); rects[a].r:=givecolor('r',pos); rects[a].g:=givecolor('g',pos); rects[a].b:=givecolor('b',pos); end; //shuffle for a:=0 to shufflesteps do begin rect:=random(game.rects); side:=random(4); amount:=random(2)*2-1; //-1 or 1 if not moveside(rect,side,amount) then if not moveside(rect,side,amount*-2) then //try the opposite direction inside:=moveside(rect,side,amount); //just return where it was end; end; function num2enta(num,value:integer):entanglement; var ost: integer; found: entanglement; begin found.rect1:=num div (game.maxentas/game.rects); ost:=num mod (game.maxentas/game.rects); found.side1:=ost div (game.rects*4-1); ost:=ost mod (game.rects*4-1); found.rect2:=ost div 4; found.side2:=ost mod 4; if (found.rect2>found.rect1) or ((found.rect2=found.rect1) and (found.side2>=found.side1)) then begin if found.side2<3 then found.side2:=found.side2+1 else begin found.side2:=0; found.rect2:=found.rect2+1; end; end; found.value:=value; num2enta:=found; end; procedure setentas; var a,b: integer; pool: array[0..maxentas] of integer; poollimit: integer; begin for a:=0 to game.maxentas-1 do pool[a]:=a; poollimit:=a+1; for a:=0 to game.entas-1 do begin b:=random(poollimit); entas[a]:=num2enta(pool[b],random(2)); if entas[a].value=0 then entas[a].value:=-1; poollimit:=poollimit-1; pool[b]:=pool[poollimit]; end; end; {$ifdef touchscreen} procedure drawbuttons; begin setcolor(128,128,128); drawrect(0,0,10,10); setcolor(255,255,255); drawline(3,5,5,7); drawline(5,7,7,3); //ok, quit setcolor(128,128,128); drawrect(getwidth-1-10,0,10,10); setcolor(255,255,255); drawline(getwidth-1-10+3,3,getwidth-1-10+7,7); drawline(getwidth-1-10+3,7,getwidth-1-10+7,3); end; {$endif} procedure drawback; var a,x,y: integer; begin if not fancy then begin setcolor(40,40,127); fillrect(0,0,getwidth,getheight); setcolor(60,60,133); for a:=0 to game.maxx do drawline(a*game.grid,0,a*game.grid,game.maxy*game.grid); for a:=0 to game.maxy do drawline(0,a*game.grid,game.maxx*game.grid,a*game.grid); end; else for x:=0 to game.maxx do for y:=0 to game.maxy do begin //za settings menu a:=40+10*((x+y) mod 2); setcolor(a,a,a); fillrect(x*game.grid,y*game.grid,game.grid,game.grid); end; {$ifdef touchscreen} drawbuttons; {$endif} end; procedure setgame(rects,entas,grid:integer); var narrower: integer; begin game.rects:=rects; game.entas:=entas; if game.rects<2 then game.rects:=2; else if game.rects>maxrects then game.rects:=maxrects; if game.entas<1 then game.entas:=1; else if game.entas>maxentas then game.entas:=maxentas; game.maxentas:=(game.rects*4-1)*game.rects*4; //max entanglements possible for this number of rects if game.maxentas>maxentas then game.maxentas:=maxentas; if game.entas>game.maxentas then game.entas:=game.maxentas; game.grid:=grid; if game.grid<1 then game.grid:=1; fancy:=fancy and (game.grid>5); if getheight=x1) and (x=y1) and (y=x1) and (x<=x2) and (y>=y1) and (y<=y2); end; function clickedrect(x,y:integer):integer; var found,r: integer; begin found:=game.selrect; r:=(game.selrect+1) mod game.rects; while (found=game.selrect) and (r<>game.selrect) do begin if isnearrect(x,y,rects[r].x1,rects[r].y1,rects[r].x2,rects[r].y2) then found:=r; r:=(r+1) mod game.rects; end; clickedrect:=found; end; function sidenear(x,y:integer):integer; var x1,x2,y1,y2: integer; begin x1:=rects[game.selrect].x1; y1:=rects[game.selrect].y1; x2:=rects[game.selrect].x2; y2:=rects[game.selrect].y2; if isnearrect(x,y,x1,y1,x2,y1) then sidenear:=0; else if isnearrect(x,y,x2,y1,x2,y2) then sidenear:=1; else if isnearrect(x,y,x1,y2,x2,y2) then sidenear:=2; else if isnearrect(x,y,x1,y1,x1,y2) then sidenear:=3; else sidenear:=-1; end; {$endif} procedure drawfancy; var r,g,b,a,x,y:integer; begin for x:=0 to game.maxx do for y:=0 to game.maxy do begin r:=40+10*((x+y) mod 2); g:=r; b:=r; for a:=0 to game.rects-1 do if isinrect(x,y,a) then begin r:=r+rects[a].r; g:=g+rects[a].g; b:=b+rects[a].b; end; if r>255 then r:=255; if g>255 then g:=255; if b>255 then b:=255; setcolor(r,g,b); fillrect(x*game.grid,y*game.grid,game.grid,game.grid); end; {$ifdef touchscreen} drawbuttons; {$endif} end; procedure drawrects; var a,x,y,w,h: integer; solution: rect; begin if fancy then drawfancy; else drawback; game.solved:=false; if not fancy then setcolor(190,190,211) else setcolor(0,0,0); for a:=0 to game.rects-1 do begin if rects[a].x1game.selrect) then begin if not fancy and (game.grid>4) then begin drawrect(x-1,y-1,w+2,h+2); drawrect(x+1,y+1,w-2,h-2); end; else drawrect(x,y,w,h); end; //check if solved, using solution rect if a=0 then begin game.solved:=true; solution.x1:=x; solution.y1:=y; solution.x2:=w; solution.y2:=h; end; game.solved:=game.solved and (x=solution.x1) and (y=solution.y1) and (w=solution.x2) and (h=solution.y2); end; //selrect setcolor(255,255,255); if rects[game.selrect].x14) then begin drawrect(x-1,y-1,w+2,h+2); drawrect(x+1,y+1,w-2,h-2); setcolor(255,255,255); //color for selected side end; else begin drawrect(x,y,w,h); if fancy then begin setcolor(111,111,111); //color also for selected side drawrect(x-1,y-1,w+2,h+2); end; else setcolor(255,0,0); //color for selected side end; //if solved... if game.solved then begin if not fancy then setcolor(255,0,0) else setcolor(0,0,0); fillrect(x+1,y+1,w-1,h-1); end; //draw selected side if game.selside=0 then drawline( rects[game.selrect].x1*game.grid, rects[game.selrect].y1*game.grid, rects[game.selrect].x2*game.grid, rects[game.selrect].y1*game.grid ) else if game.selside=1 then drawline( rects[game.selrect].x2*game.grid, rects[game.selrect].y1*game.grid, rects[game.selrect].x2*game.grid, rects[game.selrect].y2*game.grid ) else if game.selside=2 then drawline( rects[game.selrect].x2*game.grid, rects[game.selrect].y2*game.grid, rects[game.selrect].x1*game.grid, rects[game.selrect].y2*game.grid ) else if game.selside=3 then drawline( rects[game.selrect].x1*game.grid, rects[game.selrect].y2*game.grid, rects[game.selrect].x1*game.grid, rects[game.selrect].y1*game.grid ) { drawtext( integertostring(entas[0].rect1)+','+ integertostring(entas[0].side1)+'-'+ integertostring(entas[0].rect2)+','+ integertostring(entas[0].side2),0,0 ); } repaint; end; procedure centertext(txt:string; y:integer; bold:boolean;); begin setcolor(255,255,255); drawtext(txt,(getwidth-getstringwidth(txt))/2,y); if bold then drawtext(txt,(getwidth-getstringwidth(txt))/2-1,y); end; procedure showsettingsmenu(option:integer); const manyoptions=4; var h,y: integer; begin h:=getstringheight('Xj')+2; drawback; if manyoptions*h*2',y,false); y:=y+h; centertext('entanglements',y,option=1); y:=y+h; centertext('< '+integertostring(game.entas)+' >',y,false); y:=y+h; centertext('grid',y,option=2); y:=y+h; centertext('< '+integertostring(game.grid)+' >',y,false); y:=y+h; centertext('view',y,option=3); y:=y+h; if fancy then centertext('< realistic >',y,false); else centertext('< blueprint >',y,false); repaint; end; procedure changeoption(option,amount:integer); var narrower:integer; begin if option=0 then game.rects:=game.rects+amount; else if option=1 then game.entas:=game.entas+amount; else if option=2 then game.grid:=game.grid+amount; else fancy:=not fancy; setgame(game.rects,game.entas,game.grid); end; procedure showsettings; var h,keyclicked,menuoption:integer; begin {$ifdef touchscreen} h:=getstringheight('Xj')+2; sensor.init; pdx:=-1; pddx:=-1; pdddx:=-1; py:=-1; pdddy:=-1; //ok flag {$endif} menuoption:=0; showsettingsmenu(0); repeat keyclicked:=getkeyclicked; cmdclicked:=getclickedcommand; {$ifdef touchscreen} pstate:=pointer_state; if pstate=1 then begin if py=-1 then begin //new click py:=pointer_pressed_y; pddx:=pointer_pressed_x; if (py>2) and (py<2+8*h) then begin menuoption:=(py-2)/h/2; showsettingsmenu(menuoption); end; end; pdx:=pointer_dragged_x; if pdx=pdddx then pdx:=pointer_pressed_x; //if drag not updated yet, revert if (abs(pdx-pddx)>=5) then begin changeoption(menuoption,(pdx-pddx)/5); showsettingsmenu(menuoption); pddx:=pdx; end; end; else begin //pen lifted if (keyclicked=KE_KEY0) or ( (pointer_pressed_x>0) and (pointer_released_x>0) and (pointer_pressed_y>0) and (pointer_released_y>0) and (pointer_pressed_x<=10) and (pointer_released_x<=10) and (pointer_pressed_y<=10) and (pointer_released_y<=10) ) then cmdclicked:=cmdok; if (pointer_pressed_x>getwidth-1-10) and (pointer_released_x>getwidth-1-10) and (pointer_pressed_y>0) and (pointer_released_y>0) and (pointer_pressed_x<=getwidth-1) and (pointer_released_x<=getwidth-1) and (pointer_pressed_y<=10) and (pointer_released_y<=10) then cmdclicked:=cmdquit; pdddx:=pointer_dragged_x; pdddy:=pointer_dragged_y; py:=-1; end; {$endif} if keytoaction(keyclicked)=GA_DOWN then menuoption:=(menuoption+1) mod 4; else if keytoaction(keyclicked)=GA_UP then menuoption:=(4+menuoption-1) mod 4; else if keytoaction(keyclicked)=GA_LEFT then changeoption(menuoption,-1); else if keytoaction(keyclicked)=GA_RIGHT then changeoption(menuoption,1); if (keyclicked<>0) or (cmdclicked=cmdok) then showsettingsmenu(menuoption) until (cmdclicked<>emptycommand) or (cmdclicked=cmdok) or (keytoaction(keyclicked)=GA_FIRE); setgame(game.rects,game.entas,game.grid); setentas; setrects; drawrects; end; procedure showhelp; begin end; begin {$ifdef touchscreen} sensor.init; px:=-1; py:=-1; pddx:=-1; pddy:=-1; pdddx:=-1; pdddy:=-1; {$endif} fancy:=true; cmdok:=createcommand('Next',CM_OK,1); cmdsettings:=createcommand('New',CM_SCREEN,2); //cmdhelp:=createcommand('Help',CM_HELP,3); cmdquit:=createcommand('Quit',CM_EXIT,4); addcommand(cmdok); addcommand(cmdsettings); {addcommand(cmdhelp);} addcommand(cmdquit); setgame(2,5,10); showsettings; repeat keycode:=getkeyclicked; //if cmdquit leaked out from the 1st showsettings, don't overwrite it: if cmdclicked<> cmdquit then cmdclicked:=getclickedcommand; {$ifdef touchscreen} pstate:=pointer_state; if pstate=1 then begin if (px=-1) then begin //if the click is new... px:=pointer_pressed_x; py:=pointer_pressed_y; pdx:=px; pdy:=py; pddx:=pdx; pddy:=pdy; game.selside:=sidenear(pointer_pressed_x,pointer_pressed_y); end; else begin pddx:=pointer_dragged_x; pddy:=pointer_dragged_y; //if dragged didn't update, revert: if (pddx=pdddx) then pddx:=pdx; if (pddy=pdddy) then pddy:=pdy; end; if ((game.selside=0) or (game.selside=2)) and (abs(pddy-pdy)>=game.grid) then begin inside:=moveside(game.selrect,game.selside,(pddy-pdy)/game.grid); pdy:=pddy; pdddy:=-1; //was moved flag drawrects; end; else if ((game.selside=1) or (game.selside=3)) and (abs(pddx-pdx)>=game.grid) then begin inside:=moveside(game.selrect,game.selside,(pddx-pdx)/game.grid); pdx:=pddx; pdddx:=-1; //was moved flag drawrects; end; end; else begin //when pen lifted if not ((pdddx=-1) or (pdddy=-1)) and //was not moved (pointer_released_x>=px-game.grid/2) and //released at the same spot +- tolerance... (pointer_released_y>=py-game.grid/2) and (pointer_released_x<=px+game.grid/2) and (pointer_released_y<=py+game.grid/2) then begin game.selrect:=clickedrect(px,py); drawrects; end; if (keycode=KE_KEY0) or ( (px>0) and (pointer_released_x>0) and (py>0) and (pointer_released_y>0) and (px<=10) and (pointer_released_x<=10) and (py<=10) and (pointer_released_y<=10) ) then cmdclicked:=cmdsettings; if (keycode=KE_POUND) or ( (px>getwidth-1-10) and (pointer_released_x>getwidth-1-10) and (py>0) and (pointer_released_y>0) and (px<=getwidth-1) and (pointer_released_x<=getwidth-1) and (py<=10) and (pointer_released_y<=10) ) then cmdclicked:=cmdquit; px:=-1; py:=-1; pddx:=-1; pddy:=-1; pdddx:=pointer_dragged_x; pdddy:=pointer_dragged_y; end; {$endif} if (keytoaction(keycode)=GA_FIRE) or (cmdclicked=cmdok) then begin game.selrect:=(game.selrect+1) mod game.rects; if game.solved then showsettings; end; else if keytoaction(keycode)=GA_UP then begin if (game.selside=0) or (game.selside=2) then inside:=moveside(game.selrect,game.selside,-1); else if rects[game.selrect].y10) or (cmdclicked=cmdok) then drawrects; if cmdclicked=cmdsettings then showsettings; else if cmdclicked=cmdhelp then showhelp; until cmdclicked=cmdquit; end.