// Augmented reality - Takuzu - Sylvain Huet - 2015 - www.sylvain-huet.com var CELL=30;; var DETECT=15;; var LEN=CELL*10;; var CORNER=LEN/3;; var width=480;; var height=480;; var width=LEN+2;; var height=LEN+2;; var offd=(CELL-DETECT)/2;; var offw=(width-LEN)/2;; var offh=(height-LEN)/2;; var widthcam=640;; var heightcam=480;; //var widthcam=1920;; //var heightcam=1080;; var bmp;; var bmpsrc;; var bmpdisplay;; var bmpcam;; var bmpcam0;; var win;; var cam;; var bmpres;; var font;; var enable=1;; //------------------------------- SOLVER fun copy tb= let newtab 140 nil -> t in ( for i=0;i<140 do set t.i=tb.i; t );; fun solvethree tb i j p v0= ( (i>=2) && (v0==tb.(p-1))&&(v0==tb.(p-2)) ) || ( (i>=1) && (i<=8) && (v0==tb.(p-1)) && (v0==tb.(p+1)) ) || ( (i<=7) && (v0==tb.(p+1))&&(v0==tb.(p+2)) ) || ( (j>=2) && (v0==tb.(p-10))&&(v0==tb.(p-20)) ) || ( (j>=1) && (j<=8) && (v0==tb.(p-10)) && (v0==tb.(p+10)) ) || ( (j<=7) && (v0==tb.(p+10))&&(v0==tb.(p+20)) );; // play i,j,val and return 0 if ok, -1 if impossible fun solveplay tb i j val= // Secho "play ";Iecho i;Secho ",";Iecho j; Secho " : ";Iecho val; Secho " -> ";Iecholn if solvethree tb i j i+10*j val then -1 else if (tb.(100+10*val+i))>=5 then -1 else if (tb.(100+20+10*val+j))>=5 then -1 else ( set tb.(i+j*10)=val; set tb.(100+10*val+i)=1+tb.(100+10*val+i); set tb.(100+20+10*val+j)=1+tb.(100+20+10*val+j); if (tb.(100+10*val+i))>5 then -1 else if (tb.(100+20+10*val+j))>5 then -1 else 0 );; fun fillcolumn tb i val= for j=0;j<10 do if nil==tb.(i+j*10) then if solveplay tb i j val then return -1; 0;; fun fillrow tb j val= for i=0;i<10 do if nil==tb.(i+j*10) then if solveplay tb i j val then return -1; 0;; var T0;; fun findbest tb= let nil -> besti in let nil -> bestj in let nil -> bestv in let 0 -> bestn in ( for i=0;i<10 do for j=0;j<10 do let i+j*10 -> p in if nil==tb.p then let (if (i>0)&&(nil!=tb.(p-1)) then 1 else 0)+ (if (i<9)&&(nil!=tb.(p+1)) then 1 else 0)+ (if (j>0)&&(nil!=tb.(p-10)) then 1 else 0)+ (if (j<9)&&(nil!=tb.(p+10)) then 1 else 0) -> n in if n>bestn then ( set bestn=n; set besti=i; set bestj=j; set bestv= if (i>0)&&(nil!=tb.(p-1)) then tb.(p-1) else if (i<9)&&(nil!=tb.(p+1)) then tb.(p+1) else if (j>0)&&(nil!=tb.(p-10)) then tb.(p-10) else if (j<9)&&(nil!=tb.(p+10)) then tb.(p+10); ); [besti bestj bestv] );; fun solvebasic tb= let 0->again in ( if (time_ms-T0)>1000 then return nil; for i=0;i<10 do for j=0;j<10 do let i+j*10 -> p in if nil==tb.p then if solvethree tb i j p 0 then ( if solveplay tb i j 1 then return nil; set again=1 ) else if solvethree tb i j p 1 then ( if solveplay tb i j 0 then return nil; set again=1 ); for i=0;i<10 do ( if (5==tb.(100+i))&&(5!=tb.(100+10+i)) then ( if fillcolumn tb i 1 then return nil; set again=1 ) else if (5!=tb.(100+i))&&(5==tb.(100+10+i)) then ( if fillcolumn tb i 0 then return nil; set again=1 ); if (5==tb.(120+i))&&(5!=tb.(120+10+i)) then ( if fillrow tb i 1 then return nil; set again=1 ) else if (5!=tb.(120+i))&&(5==tb.(120+10+i)) then ( if fillrow tb i 0 then return nil; set again=1 ) ); if again then solvebasic tb else let findbest tb ->[i j val] in if val==nil then tb else let copy tb -> tb2 in let if !solveplay tb2 i j val then solvebasic tb2 -> tb3 in if tb3!=nil then tb3 else if !solveplay tb i j 1-val then solvebasic tb );; fun solve tb= set T0= time_ms ; solvebasic tb;; //------------------------------- GUI var buffer= bufNew widthcam*heightcam;; fun gray x k= let min 255 ftoi x*.255.*.k-> v in v+(v<<8)+(v<<16);; fun winupdate = bitmapToBitmap bmpdisplay 0 0 bmpsrc 0 0 nil nil nil; // bitmapBox bmpdisplay offw offh LEN LEN 0xff0000; bitmapToWindow win 0 0 bmpdisplay 0 0 nil nil; bitmapToWindow win width 0 bmp 0 0 nil nil; 0;; fun destroy w= camStop cam; 0;; fun balance bmp= let 0->s in let 0->mx in let 255->mn in ( for i=0;i v in ( set mn=min mn v; set mx=max mx v; set s=s+v ); [mn mx s/(LEN*LEN)] );; fun detect bmpdst bmpsrc= let newtab 140 nil-> tb in ( for i=0;i<10 do for j=0;j<10 do let offw+i*CELL+offd -> x in let offh+j*CELL+offd -> y in let 0->full in let 0->sum in let 0->sum2 in ( for di=0;di ink in ( bitmapPlot bmpdst x+di y+dj if ink then 0xffffff else 0xff; if ink then ( set full=full+1; set sum=sum+di; set sum2=sum2+di*di ) ); if full>15 then let sum2/full-(sum*sum)/(full*full) -> delta in // let (Iecho delta; Secho " ") -> _ in let if delta>=6 then 0 else 1 -> val in // let if full>90 then 0 else if full>25 then 1 -> val in if val!=nil then ( for di=0;di p0 in let (255&bitmapGet bmpsrc offw+i+1 offh+j) -> p1 in let (255&bitmapGet bmpsrc offw+i offh+j+1) -> p2 in let ((abs p1-p0)+(abs p2-p0))>2*thrigger -> ink in // let (255&bitmapGet bmpsrc offw+i offh+j) ink in bitmapPlot bmpdst offw+i offh+j if ink then 0xffffff else 0;; fun cornerTL bmpsrc thrigger= for i=0;i[mn mx ave] in let (mx-mn)/10 -> thrigger in ( separate bmpsrc bmpsrc thrigger; filteralone bmpsrc; let cornerTL bmpsrc thrigger -> [xtl ytl] in let cornerTR bmpsrc thrigger -> [xtr ytr] in let cornerBL bmpsrc thrigger -> [xbl ybl] in let cornerBR bmpsrc thrigger -> [xbr ybr] in if (enable)&&(xtl!=nil)&&(xtr!=nil)&&(xbl!=nil)&&(xbr!=nil) then ( bitmapPoly bmp [offw offh xtl ytl]::[offw offh+LEN xbl ybl]::[offw+LEN offh+LEN xbr ybr]::[offw+LEN offh xtr ytr]::nil bmpsrc nil; bitmapErase bmpres 0; let detect bmp bmp -> tb0 in let solve copy tb0 -> tb in // let tb0 -> tb in if tb!=nil then for i=0;i<100 do if (tb.i)!=(tb0.i) then ( bitmapText bmp offw+CELL*(i%10)+CELL/2 offh+CELL*(i/10)+offd+DETECT ALIGN_CENTER+ALIGN_BOTTOM if (tb.i) then "1" else "0" font 0xffffff nil; bitmapText bmpres offw+CELL*(i%10)+CELL/2 offh+CELL*(i/10)+offd+DETECT ALIGN_CENTER+ALIGN_BOTTOM if (tb.i) then "1" else "0" font 0xff0000 nil; ); bitmapToBitmap bmpsrc 0 0 bmpcam0 (widthcam-width)/2 (heightcam-height)/2 width height nil; bitmapPoly bmpsrc [xtl ytl offw offh]::[xbl ybl offw offh+LEN]::[xbr ybr offw+LEN offh+LEN]::[xtr ytr offw+LEN offh]::nil bmpres 0; ) else bitmapToBitmap bmpsrc 0 0 bmpcam0 (widthcam-width)/2 (heightcam-height)/2 width height nil; 0 );; fun key w virt= if virt==32 then ( Iecholn set enable=1-enable; save bitmapToPng bmpcam 0 Secholn "out.png"; ); 0;; fun cb c= bitmapToBitmap bmpcam0 0 0 bmpcam 0 0 nil nil nil; bitmapRgb2Yuv bmpcam; bitmapExtract buffer bmpcam 0; bitmapInsert bufToS buffer bmpcam 1; bitmapInsert bufToS buffer bmpcam 2; manage; winupdate; 0;; fun main= setlogmask LOG_USER; set font=fontCreate "Arial" 16 FONT_BOLD|FONT_PIXEL; listlistSecho camList; set bmpcam=bitmapCreate widthcam heightcam; set bmpcam0=bitmapCreate widthcam heightcam; set bmpsrc=bitmapCreate width height; set bmpdisplay=bitmapCreate width height; set bmp=bitmapCreate width height; set bmpres=bitmapCreate width height; set win=windowCreate nil nil width*1 height 0 "takuzu"; windowCbDestroy win #destroy; windowCbKeydown win #key; set cam=camStart 0 bmpcam #cb 200; if cam==nil then Secholn "error"; 0;;