This is a full-featured Sudoku program incorporating facilities such as game generation, import and export in various formats, game-playing aids (including snapshot/restore, multiple undo/redo, candidate elimination, number highlighting, auto-tidy) and printing. It will solve any Sudoku puzzle and check whether a puzzle is valid. Use the Help menu option for more details.
| Download SUDOKU.BBC | Run SUDOKU.EXE |
|---|
REM SUDOKU, by R.T.Russell and M.G.Marten
REM Version 3.20 (RTR), 24-Nov-2010
Version$ = "3.20 (RTR)"
SYS "SetWindowText", @hwnd%, "Sudoku version "+Version$+" in BBC BASIC for Windows"
INSTALL @lib$+"WINLIB" : REM Toolbar and Statusbar
INSTALL @lib$+"WINLIB2" : REM Dialogs
REM!WC Windows Constants
_LOGPIXELSX = 88
IDCANCEL = 2
IDOK = 1
MB_ICONWARNING = &30
IDNO = 7
IDYES = 6
MAX_PATH = 260
MB_ICONQUESTION = &20
MB_YESNOCANCEL = &3
NULL = 0
PD_PRINTSETUP = &40
PD_RETURNDC = &100
TBM_SETPOS = &405
SB_SETTEXT = &401
TB_SETSTATE = &411
GMEM_DDESHARE = &2000
GMEM_MOVEABLE = &2
TBM_GETPOS = &400
TBM_SETRANGE = &406
SB_SETPARTS = &404
SWP_NOMOVE = &2
SWP_NOZORDER = &4
WS_MAXIMIZEBOX = &10000
WS_SIZEBOX = &40000
GWL_STYLE = -16
CF_TEXT = 1
REM Set window style to disallow resizing
SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
ws% AND= NOT(WS_SIZEBOX OR WS_MAXIMIZEBOX)
SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws%
REM Set window size initially for XP Styles
VDU 23,22,453;532;8,20,16,128
OFF
REM Set up menus
AM$ = "AppendMenu"
SYS "CreatePopupMenu" TO hsub1%
SYS AM$, hsub1%, 0, 145, "1"+CHR$9+"F1"
SYS AM$, hsub1%, 0, 146, "2"+CHR$9+"F2"
SYS AM$, hsub1%, 0, 147, "3"+CHR$9+"F3"
SYS AM$, hsub1%, 0, 148, "4"+CHR$9+"F4"
SYS AM$, hsub1%, 0, 149, "5"+CHR$9+"F5"
SYS AM$, hsub1%, 0, 150, "6"+CHR$9+"F6"
SYS AM$, hsub1%, 0, 151, "7"+CHR$9+"F7"
SYS AM$, hsub1%, 0, 152, "8"+CHR$9+"F8"
SYS AM$, hsub1%, 0, 153, "9"+CHR$9+"F9"
SYS AM$, hsub1%, 0, 154, "Clear Filters"
SYS "CreatePopupMenu" TO hsub2%
SYS AM$, hsub2%, 0, 161, "1"+CHR$9+"Shift+F1"
SYS AM$, hsub2%, 0, 162, "2"+CHR$9+"Shift+F2"
SYS AM$, hsub2%, 0, 163, "3"+CHR$9+"Shift+F3"
SYS AM$, hsub2%, 0, 164, "4"+CHR$9+"Shift+F4"
SYS AM$, hsub2%, 0, 165, "5"+CHR$9+"Shift+F5"
SYS AM$, hsub2%, 0, 166, "6"+CHR$9+"Shift+F6"
SYS AM$, hsub2%, 0, 167, "7"+CHR$9+"Shift+F7"
SYS AM$, hsub2%, 0, 168, "8"+CHR$9+"Shift+F8"
SYS AM$, hsub2%, 0, 169, "9"+CHR$9+"Shift+F9"
SYS AM$, hsub2%, 0, 154, "Clear Filters"
SYS "CreatePopupMenu" TO hpop1%
SYS AM$, hpop1%, 0, 14, "&New"+CHR$9+"Ctrl+N"
SYS AM$, hpop1%, 0, 15, "&Open"+CHR$9+"Ctrl+O"
SYS AM$, hpop1%, 0, 19, "&Save"+CHR$9+"Ctrl+S"
SYS AM$, hpop1%, 0, 6, "Save &As"
SYS AM$, hpop1%, &800, 0, 0
SYS AM$, hpop1%, 0, 16, "&Print"+CHR$9+"Ctrl+P "
SYS AM$, hpop1%, &800, 0, 0
SYS AM$, hpop1%, 0, 12, "E&xit"
SYS "CreatePopupMenu" TO hpop2%
SYS AM$, hpop2%, 0, 26, "&Undo"+CHR$9+"Ctrl+Z"
SYS AM$, hpop2%, 0, 25, "&Redo"+CHR$9+"Ctrl+Y"
SYS AM$, hpop2%, &800, 0, 0
SYS AM$, hpop2%, 0, 24, "Cu&t All"+CHR$9+"Ctrl+X"
SYS AM$, hpop2%, 0, 3, "&Copy All"+CHR$9+"Ctrl+C"
SYS AM$, hpop2%, 0, 22, "&Paste Cells"+CHR$9+"Ctrl+V"
SYS AM$, hpop2%, 0, 14, "Clear &all"
SYS "CreatePopupMenu" TO hpop3%
SYS AM$, hpop3%, 0, 4, "Sna&pshot"
SYS AM$, hpop3%, 0, 18, "&Restore"+CHR$9+"Ctrl+R"
SYS AM$, hpop3%, 1, 8, "&Tidy Grid"+CHR$9+"Bkspc"
SYS AM$, hpop3%, 16, hsub2%, "&Highlight"
SYS AM$, hpop3%, 16, hsub1%, "&Filter"
SYS AM$, hpop3%, &800, 0,0
SYS AM$, hpop3%, 0, 23, "&Count Solutions"
SYS AM$, hpop3%, 0, 11, "Generate &New"
SYS "CreatePopupMenu" TO hpop4%
SYS AM$, hpop4%, 0, 7, "&Grid on/off"+CHR$9+"Ctrl+G"
SYS AM$, hpop4%, 1, 2, "&Reveal on/off"
SYS AM$, hpop4%, 0, 9, "&Auto-Count on/off"+CHR$9+"Tab"
SYS "CreatePopupMenu" TO hpop5%
SYS AM$, hpop5%, 0, 17, "&Help"
SYS AM$, hpop5%, &800, 0, 0
SYS AM$, hpop5%, 0, 1, "&Solve"
SYS AM$, hpop5%, 0, 21, "Show &Cell"
SYS AM$, hpop5%, &800, 0, 0
SYS AM$, hpop5%, 0, 5, "&About"
SYS "CreateMenu" TO H%
SYS AM$, H%, 16, hpop1%, "&File "
SYS AM$, H%, 16, hpop2%, "&Edit "
SYS AM$, H%, 16, hpop4%, "&Options "
SYS AM$, H%, 16, hpop3%, "&Tools "
SYS AM$, H%, 16, hpop5%, "&Help "
SYS AM$, H%, 0, 20, "&Website"
SYS "SetMenu",@hwnd%,H%
SYS "DrawMenuBar",@hwnd%
REM Create toolbar
nbutts% = 17
DIM button%(nbutts%-1),bindex%(nbutts%-1)
button%() = 6,7,8,14,0,3,4,0,1,2,5,0,12,0,15,0,16
bindex%() = 14,15,19,16,0,26,25,24,3,22,135,0,21,0,-7,0,4
ht% = FN_createtoolbar(nbutts%,button%(),bindex%())
REM Add tooltips to toolbar
DIM buttip$(nbutts%-1)
buttip$() = "New", "Open", "Save","Print","","Undo","Redo","Cut All","Copy All","Paste Cells","Reset Cell","","Show Cell","","Grid On/Off","","Snapshot"
PROC_addtooltips(ht%,nbutts%,buttip$(),bindex%())
REM Add some button bitmaps
S% = FN_custombutton(ht%,@dir$+"grid.bmp",7)
S% = FN_custombutton(ht%,@dir$+"snapshot.bmp",4)
REM Define a PRINTDLG structure
DIM Pd{ \
\ lStructSize%, \
\ hwndOwner%, \ A handle to the window that owns the dialog box.
\ hDevMode%, \ If both hDevMode and hDevNames are NULL,
\ hDevNames%, \ PrintDlg uses the current default printer.
\ hDC%, \ A handle to the printer's device context
\ Flags%, \
\ nFromPage{l&,h&}, \
\ nToPage{l&,h&}, \
\ nMinPage{l&,h&}, \
\ nMaxPage{l&,h&}, \
\ nCopies{l&,h&}, \
\ hInstance%, \
\ lCustData%, \
\ lpfnPrintHook%, \
\ lpfnSetupHook%, \
\ lpPrintTemplateName%, \
\ lpSetupTemplateName%, \
\ hPrintTemplate%, \
\ hSetupTemplate% }
REM Populate PRINTDLG structure
Pd.lStructSize% = DIM(Pd{})
Pd.hwndOwner% = @hwnd%
Pd.Flags% = PD_RETURNDC OR PD_PRINTSETUP
REM Global arrays and structures
DIM A%(8,8), Q%(8,8), Archive{(999)R&,C&,F&,Data%}
Empty% = %111111111 : REM one bit position for each number possible
A%() = Empty%
Q%() = Empty%
REM Create status bar
hs% = FN_createstatusbar("")
REM Adjust window size according 'style'
DIM rc{l%,t%,r%,b%} : REM RECT structure for Windows "GetWindowRect"
SYS "GetWindowRect", hs% , rc{}
status_bar_height% = rc.b%-rc.t%
SYS "GetWindowRect", ht% , rc{}
tool_bar_height% = rc.b%-rc.t%
rc.l% = 0
rc.r% = 453
rc.t% = 0
rc.b% = 453 + status_bar_height% + tool_bar_height%
SYS "AdjustWindowRect", rc{}, ws%, 1
SYS "SetWindowPos", @hwnd%, 0, 0, 0, rc.r%-rc.l%, rc.b%-rc.t%, SWP_NOMOVE OR SWP_NOZORDER
VDU 26
ORIGIN 0,2*status_bar_height%
PROC_removestatusbar :REM It would be in the wrong place if we resize
hs% = FN_createstatusbar("")
REM Partition Status bar
num_parts% = 2
DIM edge%(num_parts%-1)
edge%() = @vdu.tr%-155, -1 : REM position of RH edges
SYS "SendMessage", hs%, SB_SETPARTS, num_parts%, ^edge%(0)
REM Set up Structure for OpenFileName API call later
DIM Sofn{ \ OPENFILENAME Structure
\ lStructSize%, \ Size of structure
\ hwndOwner%, \ Calling Window handle
\ hInstance%, \
\ lpstrFilter%, \ Pointer to filter string
\ lpstrCustomFilter%, \
\ nMaxCustFilter%, \
\ nFilterIndex%, \ Index to selected filter starts at 1
\ lpstrFile%, \ Pointer to string to give/receive FileName
\ nMaxFile%, \ Size of FileName string
\ lpstrFileTitle%, \ Pointer to FileName string less path
\ nMaxFileTitle%, \
\ lpstrInitialDir%, \
\ lpstrTitle%, \ Pointer to string that displays in title bar
\ Flags%, \ Sets dialog box behaviour
\ nFileOffset{l&,h&}, \
\ nFileExtension{l&,h&}, \ Read Offset to where extension starts, 0 if none
\ lpstrDefExt%, \
\ lCustData%, \
\ lpfnHook%, \
\ lpTemplateName%}
REM populate structure
DIM ft% 80
DIM fn% MAX_PATH
Sofn.lStructSize% = DIM(Sofn{})
Sofn.hwndOwner% = @hwnd%
Sofn.nFilterIndex% = 1
Sofn.lpstrFileTitle% = ft%
Sofn.nMaxFileTitle% = 80
Sofn.lpstrFile% = fn%
Sofn.nMaxFile% = MAX_PATH
Sofn.Flags% = 6
REM Set up dialog box
dlg% = FN_newdialog("Select difficulty",125,40,153,61,8,400)
PROC_dlgitem(dlg%,"",101,10,10,130,12,&50000001,0)
temp% = dlg%!12-8
SYS "MultiByteToWideChar", 0, 0, "msctls_trackbar32", 17, temp%, 256 TO Len%
dlg%!12 = temp%+2*Len%+6
PROC_static(dlg%,"Easier",100,10,24,40,16,0)
PROC_static(dlg%,"Harder",100,100,24,40,16,2)
PROC_pushbutton(dlg%,"OK",1,22,40,42,14,&20001)
PROC_pushbutton(dlg%,"Cancel",2,89,40,42,14,&0)
REM draw the main grid
FOR L% = 0 TO 9
LINE 2,L%*100+2,902,L%*100+2
IF (L% MOD 3)=0 LINE 2,L%*100,902,L%*100 : LINE 2,L%*100+4,902,L%*100+4
LINE L%*100+2,2,L%*100+2,902
IF (L% MOD 3)=0 LINE L%*100,2,L%*100,902 : LINE L%*100+4,2,L%*100+4,902
NEXT
REM Initialise global variables
FileName$ = ""
Entry% = TRUE
Grid% = FALSE
Count% = FALSE
Reveal% = FALSE
Solved% = FALSE
Changed% = FALSE
Filter% = 0
Hilite% = 0
UndoPtr% = 0
MinPtr% = 0
MaxPtr% = 0
Click% = -1
REM Set up interrupts
ON MOUSE Click% = 10 : RETURN
ON SYS Click% = @wparam% : RETURN
ON CLOSE PROCexit : RETURN
ON ERROR IF ERR<>17 SYS "MessageBox",@hwnd%,REPORT$,0,MB_ICONWARNING ELSE PROCshow
PROCreset
COLOUR 8,255,224,224
REM Main Program loop
REPEAT
PROCstat2(FNstatus)
SYS "EnableMenuItem",hpop1%,19,ABSNOTChanged%
SYS "EnableMenuItem",hpop2%,26,ABSNOT(UndoPtr%<>MinPtr%)
SYS "EnableMenuItem",hpop2%,25,ABSNOT(UndoPtr%<>MaxPtr%)
SYS "EnableMenuItem",hpop3%,8,ABSNOTGrid%
SYS "EnableMenuItem",hpop4%,2,ABSNOTSolved%
SYS "EnableMenuItem",hpop5%,21,ABSNOTEntry%
SYS "SendMessage", ht%, TB_SETSTATE, 7, 4-Grid%
REM highlight current active square (Invert color)
GCOL 4,0
*ESC OFF
IF Entry% RECTANGLE FILL Col%*100+4,Row%*100+2,98,98
REPEAT
REM Program spends nearly all the time polling this loop.
REM If a menu or toolbutton pressed or the mouse clicked we move on
REM and act on the ID of the menu item or button, or 10 for mouse
REM which is held in K%.
K% = INKEY(1)
REM if no key then check input from mouse.
IF K%=-1 SWAP Click%,K%
UNTIL K%<>-1
IF Entry% RECTANGLE FILL Col%*100+4,Row%*100+2,98,98
*ESC ON
CASE K% OF
WHEN 10 : REM get mouse position
MOUSE X%,Y%,B%
IF X%>=2 AND Y%>=2 AND X%<902 AND Y%<902 AND B%>1 THEN
Col% = (X%-2)DIV100 : Row% = (Y%-2)DIV100
P% = A%(Row%,Col%)
IF NOT Reveal% Entry% = TRUE
REM switch on or off grid of possible entries if there is more than 1
IF Grid% IF NOT Reveal% IF P% AND (P%-1) THEN
X% = ((X%-2)MOD100)DIV33 : Y% = ((Y%-2)MOD100)DIV33
Changed% = TRUE : PROCsaveold(Row%,Col%,P%,0)
A%(Row%,Col%) EOR = 2^(X%+6-Y%*3)
REM write result to cell
PROCcell(A%(),Row%,Col%,4)
ENDIF
ELSE
Entry% = FALSE
ENDIF
:
WHEN 1,23 : REM menu items Solve (Ctrl+A) and Count (Ctrl+W)
Entry% = FALSE
PROCcheck_solutions(K%)
:
WHEN 2 : REM Reveal (Ctrl+B)
IF Solved% THEN
Entry% = FALSE : Reveal% = NOT Reveal% : PROCshow
IF Reveal% THEN
PROCstat1("Select Options...Reveal again to hide solution")
ELSE
PROCstat1("")
ENDIF
ENDIF
:
WHEN 3 : PROCcopy(FALSE) : REM Copy (Ctrl+C)
:
WHEN 4 : REM Snapshot (Ctrl+D)
Reveal% = FALSE : PROCshow
PROCsaveDat(FNspecialfolder(26)+"SUDOKU.DAT")
PROCstat1("Select Tools...Restore to load saved snapshot")
:
WHEN 5 : PROCabout
:
WHEN 6 : IF FNsaveAs Changed% = FALSE ELSE PROCstat1("File not saved!") : REM SaveAs
:
WHEN 7 : REM Toggle grid (Ctrl+G)
Grid% = NOT Grid%
PROCshow
IF NOT Reveal% THEN
IF Grid% THEN
PROCstat1("Click on small numbers to eliminate them")
ELSE
PROCstat1("Enter your choice : Numbers 0 - 9")
ENDIF
ENDIF
:
WHEN 8 : IF Grid% IF NOT Reveal% THEN PROCtidy : REM Tidy (Backsp)
:
WHEN 9 : Count% = NOT Count% : REM Toggle count (Tab)
:
REM WHEN 10 used for mouse
:
WHEN 11 : IF FNch PROCgenerate
:
WHEN 12 : PROCexit
:
REM WHEN 13 is return, used later
:
WHEN 14 : IF FNch PROCnew : REM Clear All / File New
:
WHEN 15 : IF FNch PROCload
:
WHEN 16 : PROCprint
:
WHEN 17 : PROChelp
:
WHEN 18 : REM Restore (Ctrl-R)
PROCloadDat(FNspecialfolder(26)+"SUDOKU.DAT")
Changed% = TRUE : Reveal% = FALSE : PROCshow
:
WHEN 19 : IF FNsave Changed% = FALSE : PROCstat1("File saved!") : REM Save
:
WHEN 20 : SYS "ShellExecute", 0, 0, "http://www.rtrussell.co.uk/", 0, "", 0
:
WHEN 21 : REM Show Cell
IF Entry% THEN
IF NOT Solved% PROCcheck_solutions(1)
Changed% = TRUE
PROCsaveold(Row%,Col%,A%(Row%,Col%),0)
A%(Row%,Col%) = Q%(Row%,Col%)
PROCcell(A%(),Row%,Col%,4)
ENDIF
:
WHEN 22 : PROCpaste : Reveal% = FALSE : PROCshow
:
WHEN 24 : PROCcopy(TRUE) : PROCshow : REM Cut (Ctrl+X)
:
WHEN 25 : IF NOT Reveal% PROCredo(Row%,Col%)
:
WHEN 26 : IF NOT Reveal% PROCundo(Row%,Col%)
:
WHEN 32,48,49,50,51,52,53,54,55,56,57,135 : REM Number entry
IF Entry% IF NOT Reveal% THEN
P% = A%(Row%,Col%)
REM If number input data is a 1 shifted n times
REM Space, 0 or Del removes an entry
Changed% = TRUE : PROCsaveold(Row%,Col%,P%,0)
IF K%<=48 OR K%=135 A%(Row%,Col%) = Empty% ELSE A%(Row%,Col%) = 1 << (K%-49)
PROCcell(A%(),Row%,Col%,4)
ENDIF
:
REM cursor key moves
WHEN 136 : Entry% = NOTReveal% : Col% -= 1 : IF Col%<0 Col% = 8 : Row% += 1 : IF Row%>8 Row% = 0
WHEN 13, 137 : Entry% = NOTReveal% : Col% += 1 : IF Col%>8 Col% = 0 : Row% -= 1 : IF Row%<0 Row% = 8
WHEN 138 : Entry% = NOTReveal% : Row% -= 1 : IF Row%<0 Row% = 8 : Col% += 1 : IF Col%>8 Col% = 0
WHEN 139 : Entry% = NOTReveal% : Row% += 1 : IF Row%>8 Row% = 0 : Col% += 1 : IF Col%>8 Col% = 0
:
REM Function keys
WHEN 145,146,147,148,149,150,151,152,153 :
IF Grid% THEN
Entry% = FALSE
IF Filter% = K%-144 Filter% = 0 ELSE Filter% = K%-144
PROCshow
IF Filter% PROCstat1("Remove filter by pressing F10 or F"+STR$Filter%) ELSE PROCstat1("")
ENDIF
:
WHEN 154 : Hilite% = 0 : Filter% = 0 : PROCshow : PROCstat1("") : REM F10
:
REM Shift+Function keys
WHEN 161,162,163,164,165,166,167,168,169 :
Entry% = FALSE
IF Hilite% = K%-160 Hilite% = 0 ELSE Hilite% = K%-160
PROCshow
IF Hilite% PROCstat1("Remove highlight by pressing F10 or Shift F"+STR$Hilite%) ELSE PROCstat1("")
ENDCASE
IF Solved% Solved% = (A%(Row%,Col%) AND Q%(Row%,Col%)) <> 0
UNTIL FALSE
END
DEFPROCreset
Grid% = FALSE : Filter% = 0 : Hilite% = 0
Reveal% = FALSE : Solved% = FALSE : PROCshow
UndoPtr% = 0 : MinPtr% = 0 : MaxPtr% = 0
Entry% = FALSE : Changed% = FALSE
Col% = 0 : Row% = 8
PROCstat1("Load file or enter numbers into the cells")
ENDPROC
DEFPROCnew : REM GLOBAL A%(), Q%(), Empty%, FileName$
A%() = Empty%
Q%() = Empty%
PROCreset
FileName$ = "" : PROCtitle(FileName$)
ENDPROC
DEF FNstatus : REM GLOBAL Changed%, Count%
LOCAL A$
IF Changed% A$ = "Changed : " ELSE A$ = "Unchanged : "
IF Count% A$ += "Auto count on" ELSE A$ += "Auto count off"
= A$
REM GLOBAL hs% . Sends text strings to status bar.
DEF PROCstat1(A$) : SYS "SendMessage",hs%,SB_SETTEXT,0,A$ : ENDPROC
DEF PROCstat2(A$) : SYS "SendMessage",hs%,SB_SETTEXT,1,A$ : ENDPROC
DEF PROCcheck_solutions(K%) : REM GLOBAL A%(), Q%(), Solved%
LOCAL S%,T%
Q%() = A%()
Solved% = FALSE
PROCstat1("Working (press Esc to abort)...")
S% = FNsolve(Q%(),K% = 1,T%)
REM K% = 1 is solve menu item
IF K% = 1 THEN
IF S% THEN
Solved% = TRUE
PROCstat1("Solved : Select Options...Reveal to show solution")
ELSE
PROCstat1("Impossible")
ENDIF
ELSE
IF S% = 1 THEN
PROCstat1("There is 1 solution")
ELSE
PROCstat1("There are "+STR$S%+" solutions")
ENDIF
ENDIF
ENDPROC
DEF PROCshow : REM GLOBAL A%(), Q%(), Reveal%
LOCAL C%,R%
FOR C% = 0 TO 8
FOR R% = 0 TO 8
IF Reveal% PROCcell(Q%(),R%,C%,2) ELSE PROCcell(A%(),R%,C%,4)
NEXT
NEXT
ENDPROC
DEF PROCcell(P%(),R%,C%,K%) : REM GLOBAL Grid%, Filter%, Hilite%
LOCAL P%,G%
P% = P%(R%,C%)
IF P% AND (P%-1) IF P%<>Empty% GCOL 8 ELSE GCOL 15
RECTANGLE FILL C%*100+6,R%*100+4,94,94
IF P% AND (P%-1) THEN
IF NOT Grid% ENDPROC
*FONT
REM draw grid
GCOL 7
FOR G% = 1 TO 2
LINE C%*100+6,R%*100+G%*32+4,C%*100+98,R%*100+G%*32+4
LINE C%*100+G%*32+4,R%*100+6,C%*100+G%*32+4,R%*100+98
NEXT
REM write numbers at graphics cursor
GCOL K%
FOR G% = 0 TO 8
MOVE C%*100+22+(G%MOD3)*32-@vdu%!216,R%*100+84-(G%DIV3)*32+@vdu%!220
IF Filter% THEN
IF G% = Filter%-1 GCOL K% ELSE GCOL 2
ENDIF
IF P% AND 2^G% VDU 5,G%+49,4
NEXT
ELSE
REM write a big number
GCOL K%
*FONT Arial,28
IF P% G% = LOGP%/.3 : REM Bit position to decimal conversion, we want LOG to base 2
REM to get the bit position which equals LOG base 10 divided by 2 LOG 10 or 0.3010.
REM e.g. %000010000 equivalent to 4. Shift to 5 occurs as we print it.
MOVE C%*100+50-@vdu%!216,R%*100+50+@vdu%!220
IF Hilite% THEN
IF G%=Hilite%-1 GCOL K% ELSE GCOL 11
ENDIF
VDU 5,G%+49,4 : REM 49 is ASCII for 1 so result from %000010000 is to print a 5
*FONT
ENDIF
ENDPROC
DEF PROCprint : REM GLOBAL A%(), Q%(), Reveal%, Pd{}
LOCAL ok%,dpix%,thin%,thick%,S%,L%,T%,X%,Y%,R%,C%,P%
SYS "PrintDlg", Pd{} TO ok%
IF ok% THEN
SYS "DeleteDC", @prthdc%
@prthdc% = Pd.hDC%
*printerfont Arial,20
*MARGINS 10,10,10,10
SYS "GetDeviceCaps", @prthdc%, _LOGPIXELSX TO dpix%
S% = dpix%/2.5
L% = @vdu%!232
T% = @vdu%!240
REM Screen Off, Printer On
VDU 2,21,32
SYS "CreatePen", 0, S%/32, 0 TO thin%
SYS "CreatePen", 0, S%/16, 0 TO thick%
X% = L%
FOR C% = 0 TO 9
IF (C% MOD 3)=0 THEN
SYS "SelectObject", @prthdc%, thick%
ELSE
SYS "SelectObject", @prthdc%, thin%
ENDIF
SYS "MoveToEx", @prthdc%, X%, T%, 0
SYS "LineTo", @prthdc%, X%, T% + 9*S%
X% += S%
NEXT
Y% = T%
FOR R% = 0 TO 9
IF (R% MOD 3)=0 THEN
SYS "SelectObject", @prthdc%, thick%
ELSE
SYS "SelectObject", @prthdc%, thin%
ENDIF
SYS "MoveToEx", @prthdc%, L%, Y%, 0
SYS "LineTo", @prthdc%, L% + 9*S%, Y%
Y% += S%
NEXT
FOR R% = 0 TO 8
FOR C% = 0 TO 8
@vdu%!-12 = L% + C%*S% + S%*0.3
@vdu%!-8 = T% + R%*S% + S%*0.15
IF Reveal% P% = Q%(8-R%,C%) ELSE P% = A%(8-R%,C%)
IF (P% AND (P%-1))=0 VDU LOGP%/.3 + 49
NEXT
NEXT
REM Screen On Printer Off
VDU 12,6,3
SYS "DeleteObject", thin%
SYS "DeleteObject", thick%
ENDIF
ENDPROC
DEF FNsolve(p%(),F%,RETURN H%)
REM F% is -1 for solve, 0 for count, 1 for tidy
LOCAL C%,D%,E%,M%,N%,R%,X%,Y%,q%()
PRIVATE T%
IF T% > H% H% = T%
DIM q%(8,8)
REPEAT
REM clear out the col, row and block exposed candidates
q%() = p%()
FOR R% = 0 TO 8
FOR C% = 0 TO 8
D% = p%(R%,C%)
IF (D% AND (D%-1))=0 THEN
REM only 1 chosen value bit
M% = NOT D%
REM set mask
FOR X% = 0 TO 8
REM mask off this value bit from all other row/col cells
IF X%<>C% p%(R%,X%) AND= M%
IF X%<>R% p%(X%,C%) AND= M%
NEXT
REM similarly for the rest of the block
FOR X% = C%DIV3*3 TO C%DIV3*3+2
FOR Y% = R%DIV3*3 TO R%DIV3*3+2
IF X%<>C% IF Y%<>R% p%(Y%,X%) AND= M%
NEXT
NEXT
ENDIF
NEXT
NEXT
q%() -= p%()
REM q%() still = p%() means we have made no more discoveries
UNTIL SUMq%() = 0
REM Tidy part of function exits here : removed all the simple candidates
IF F%=1 : = D%
REM Scan the grid to find the one with the fewest possibilities
M% = 10
FOR R% = 0 TO 8
FOR C% = 0 TO 8
D% = p%(R%,C%)
IF D%=0 M% = 0 : REM this only happens if Sudoku rules not adhered to
REM find number of bits set (candidates) if more than 1
IF D% AND (D%-1) THEN
N% = 0
REPEAT N% += (D% AND 1)
D% DIV = 2
UNTIL D% = 0
REM N% must be 2 - 9
IF N%<M% M% = N% : X% = C% : Y% = R%
ENDIF
NEXT
NEXT
REM if we get here with M% = 10 then the grid is complete already.
REM 0 solutions, impossible or 1 solution?
IF M%=0 THEN = 0
IF M%=10 THEN = 1
REM At this stage we have the coordinates of the (First) cell with lowest number of candidates
D% = 0
FOR M% = 0 TO 8
REM Check to see if it's a possible candidate, if so try this one
E% = 1 << M%
IF p%(Y%,X%) AND E% THEN
q%() = p%()
q%(Y%,X%) = E% : REM try possible number in this cell and test. Could be a Magic Number!
T% += 1
C% = FNsolve(q%(),F%,H%) : REM reentrant call
T% -= 1
D% += C%
IF C% IF F% p%() = q%() : = D%
ENDIF
NEXT
= D%
DEF PROCtidy : REM GLOBAL A%(), UndoPtr%, Changed%
LOCAL q%(),C%,R%,P%,F%
DIM q%(8,8)
REM Save old values so we can undo.
Changed% = TRUE
q%() = A%()
P% = FNsolve(A%(),1,C%)
FOR C% = 0 TO 8
FOR R% = 0 TO 8
P% = q%(R%,C%)
IF A%(R%,C%)<>P% PROCsaveold(R%,C%,P%,F%) : F%=TRUE
PROCcell(A%(),R%,C%,4)
NEXT
NEXT
ENDPROC
REM Get last value of Archive{}, decode and present to screen
DEF PROCundo(RETURN R%, RETURN C%)
REM GLOBAL A%(), Archive{}, UndoPtr%, MinPtr%, Changed%
IF UndoPtr%<>MinPtr% THEN
REPEAT
UndoPtr% = (UndoPtr%+999) MOD 1000
R% = Archive{(UndoPtr%)}.R&
C% = Archive{(UndoPtr%)}.C&
REM Now we have to display the data
SWAP A%(R%,C%),Archive{(UndoPtr%)}.Data%
PROCcell(A%(),R%,C%,4)
UNTIL Archive{(UndoPtr%)}.F&=0 OR UndoPtr%=MinPtr%
Changed% = TRUE
PROCstat1("")
ELSE
VDU 7 : PROCstat1("Nothing to Undo!")
ENDIF
ENDPROC
DEFPROCredo(RETURN R%, RETURN C%)
REM GLOBAL A%(), Archive{}, UndoPtr%, MaxPtr%, Changed%
IF UndoPtr%<>MaxPtr% THEN
REPEAT
R% = Archive{(UndoPtr%)}.R&
C% = Archive{(UndoPtr%)}.C&
REM Now we have to display the data
SWAP A%(R%,C%),Archive{(UndoPtr%)}.Data%
PROCcell(A%(),R%,C%,4)
UndoPtr% = (UndoPtr%+1) MOD 1000
UNTIL Archive{(UndoPtr%)}.F&=0 OR UndoPtr%=MaxPtr%
Changed% = TRUE
PROCstat1("")
ELSE
VDU 7 : PROCstat1("Nothing to Redo!")
ENDIF
ENDPROC
DEF PROCsaveold(R%,C%,P%,F%) : REM GLOBAL Archive{}, UndoPtr%, MinPtr%, MaxPtr%
Archive{(UndoPtr%)}.Data% = P%
Archive{(UndoPtr%)}.R& = R%
Archive{(UndoPtr%)}.C& = C%
Archive{(UndoPtr%)}.F& = F%
UndoPtr% = (UndoPtr%+1) MOD 1000
MaxPtr% = UndoPtr%
IF MinPtr%=MaxPtr% MinPtr% = (MinPtr%+1) MOD 1000
ENDPROC
DEF PROCload : REM GLOBAL Sofn{}, FileName$, Count%, A%(), Q%(), Empty%
LOCAL GOFN%, filter$
filter$ = "Sudoku files"+CHR$0+"*.DAT;*.TXT;*.SDK;*.SS"+CHR$0+"All Files"+CHR$0+"*.*"+CHR$0+CHR$0
Sofn.lpstrFilter% = !^filter$
SYS "GetOpenFileName",Sofn{} TO GOFN%
IF GOFN% THEN
FileName$ = $$Sofn.lpstrFile%
PROCtitle($$Sofn.lpstrFileTitle%)
ELSE
PROCstat1("File Open Aborted!") : ENDPROC
ENDIF
A%() = Empty% : Q%() = Empty%
CASE RIGHT$(FileName$,4) OF
WHEN ".DAT",".dat": PROCloadDat(FileName$)
OTHERWISE: PROCloadTxt(FileName$)
ENDCASE
PROCreset
IF Count% PROCcheck_solutions(0)
ENDPROC
DEF PROCloadDat(F$) : REM GLOBAL A%()
LOCAL F%,R%,C%
F% = OPENIN(F$)
IF F% THEN
FOR R% = 0 TO 8
FOR C% = 0 TO 8
IF F% PROCsaveold(R%,C%,A%(R%,C%),(C%+R%)<>0) : INPUT #F%,A%(R%,C%)
NEXT
NEXT
CLOSE #F%
ELSE
SYS "MessageBox",@hwnd%,"Failed to open file "+F$,0,MB_ICONWARNING
ENDIF
ENDPROC
DEF PROCloadTxt(F$) : REM GLOBAL A%(), Empty%
LOCAL P%,R%,C%,F%,SS%,SDK%,V%,D$
F% = OPENIN(F$)
IF F% THEN
IF RIGHT$(F$,4)=".sdk" OR RIGHT$(F$,4)=".SDK" SDK% = TRUE : REM for Sudo Cue files
IF RIGHT$(F$,3)=".ss" OR RIGHT$(F$,3)=".SS" SS% = TRUE : REM for non-archival Simple Sudoku files
FOR R% = 8 TO 0 STEP -1
FOR C% = 0 TO 8
REM Now do some integrity checks and extract data
REM Works with tab, comma, bracket or no delimiter
REM Empty cell as Space, 0, x or "." to get most common txt formats
REPEAT
P% = BGET#F%
V% = TRUE
CASE P% OF
WHEN 32 : IF NOT SS% A%(R%,C%) = Empty% ELSE V% = FALSE
WHEN 48,46,88,120 : A%(R%,C%) = Empty%
WHEN 49,50,51,52,53,54,55,56,57 : A%(R%,C%) = 1 << (P%-49)
WHEN 35 : V% = FALSE : IF SDK% INPUT #F%,D$
OTHERWISE V% = FALSE
ENDCASE
UNTIL V% OR EOF#F%
NEXT
NEXT
CLOSE #F%
ELSE
SYS "MessageBox",@hwnd%,"Failed to open file "+F$,0,MB_ICONWARNING
ENDIF
ENDPROC
DEF FNsaveAs : REM GLOBAL Sofn{}, FileName$
LOCAL G%,E%,filter$
filter$ = "Text File (*.TXT)"+CHR$0+"*.TXT"+CHR$0+\
\ "Sudoku File (*.SS)" +CHR$0+"*.SS" +CHR$0+\
\ "Snapshot File (*.DAT)"+CHR$0+"*.DAT"+CHR$0+CHR$0
Sofn.lpstrFilter% = !^filter$
IF FileName$="" THEN $$Sofn.lpstrFile%="Untitled"
SYS "GetSaveFileName",Sofn{} TO G%
IF G% THEN
FileName$ = $$Sofn.lpstrFile%
E% = Sofn.nFileExtension.l&
IF E% FileName$ = LEFT$(FileName$,E%-1)
CASE Sofn.nFilterIndex% OF
REM Get File filter index nFilterIndex
WHEN 1 : FileName$ += ".txt" PROCsaveTxt(FileName$)
WHEN 2 : FileName$ += ".ss" PROCsaveSS(FileName$)
WHEN 3 : FileName$ += ".dat" PROCsaveDat(FileName$)
ENDCASE
PROCtitle($$Sofn.lpstrFileTitle%)
ENDIF
= G%
DEF FNsave : REM GLOBAL FileName$
IF FileName$ = "" THEN = FNsaveAs
CASE RIGHT$(FileName$,4) OF
WHEN ".dat",".DAT" : PROCsaveDat(FileName$)
WHEN ".txt",".TXT" : PROCsaveTxt(FileName$)
OTHERWISE:
CASE RIGHT$(FileName$,3) OF
WHEN ".ss", ".SS" : PROCsaveSS(FileName$)
OTHERWISE: PROCsaveTxt(FileName$+".txt")
ENDCASE
ENDCASE
= TRUE
DEF PROCsaveDat(F$) : REM GLOBAL A%()
LOCAL R%,C%,F%
F% = OPENOUT(F$)
IF F% THEN
FOR R% = 0 TO 8
FOR C% = 0 TO 8
PRINT #F%,A%(R%,C%)
NEXT
NEXT
CLOSE #F%
ELSE
SYS "MessageBox",@hwnd%,"Failed to save file "+F$,0,MB_ICONWARNING
ENDIF
ENDPROC
DEF PROCsaveTxt(F$) : REM GLOBAL A%()
LOCAL P%,R%,C%,F%
F% = OPENOUT(F$)
IF F% THEN
FOR R% = 8 TO 0 STEP -1
FOR C% = 0 TO 8
P% = A%(R%,C%)
IF P% AND (P%-1) BPUT#F%,48 ELSE BPUT#F%, LOGP%/.3 + 49
NEXT
NEXT
CLOSE #F%
ELSE
SYS "MessageBox",@hwnd%,"Failed to save file "+F$,0,MB_ICONWARNING
ENDIF
ENDPROC
DEF PROCsaveSS(F$) : REM GLOBAL A%()
LOCAL P%,R%,C%,F%
F% = OPENOUT(F$)
IF F% THEN
FOR R% = 8 TO 0 STEP -1
FOR C% = 0 TO 8
P% = A%(R%,C%)
IF P% AND (P%-1) BPUT#F%,46 ELSE BPUT#F%, LOGP%/.3 + 49
IF C%=2 OR C%=5 BPUT#F%,124
NEXT
BPUT#F%,13
IF R%=3 OR R%=6 PRINT#F%, "-----------"
NEXT
CLOSE #F%
ELSE
SYS "MessageBox",@hwnd%,"Failed to save file "+F$,0,MB_ICONWARNING
ENDIF
ENDPROC
DEF PROChelp
LOCAL H$
H$ = "A left mouse click on any cell activates Entry mode; a right click deactivates Entry mode."+CHR$13
H$+= "Valid inputs are the numbers 123456789; Space, Delete or 0 can be used to reset a cell."+CHR$13
H$+= "Enter moves the input cursor to the right so new puzzles can be put in using the keypad."+CHR$13
H$+= "In Grid mode a left mouse click toggles a candidate on/off. Cells in which candidates have"+CHR$13
H$+= "been removed have a pink background; Solve only finds solutions from remaining candidates."+CHR$13
H$+= "The program accepts formatted or unformatted puzzle data cut from many Web sources and" +CHR$13
H$+= "most Sudoku data files. See http://www.sudocue.net/guide.htm for some solving techniques."+CHR$13+CHR$13
H$+= "File : 'Open' (Ctrl+O) reads most text formatted Sudoku puzzles and '.dat' files."+CHR$13
H$+= " 'Save' (Ctrl+S) saves the puzzle to a file in '.ss', '.txt' or '.dat' format."+CHR$13
H$+= "Edit : 'Undo' (Ctrl-Z) undoes clicks, key inputs, Show Cell, Tidy, Restore, Cut or Paste."+CHR$13
H$+= " 'Redo' (Ctrl-Y) undoes the Undo! Great for testing chains."+CHR$13
H$+= " 'Cut All' (Ctrl-X) copies the puzzle to the clipboard and clears all cells."+CHR$13
H$+= " 'Copy All' (Ctrl-C) copies the puzzle to the clipboard as a text block."+CHR$13
H$+= " 'Paste All' (Ctrl-V) pastes text blocks from the clipboard into the cells."+CHR$13
H$+= " Use for copying puzzles from other applications or text editors."+CHR$13
H$+= " 'Clear All' resets all pointers and clears the puzzle. Same as File : New."+CHR$13
H$+= "Options : 'Grid on/off' shows possible candidate list for each cell or just completed cells."+CHR$13
H$+= " 'Auto-Count on/off' allows for Count of number of solutions when file is Opened."+CHR$13
H$+= " 'Reveal on/off' toggles display of a puzzle solution. Use Help : Solve to get solution!"+CHR$13
H$+= "Tools : 'Snapshot' saves current puzzle data to file SUDOKU.DAT; Restore recovers this file"+CHR$13
H$+= " and resets the program. All history is lost and the previous Snapshot is overwritten."+CHR$13
H$+= " 'Tidy' : In Grid mode removes all possible candidates that would give rise to "+CHR$13
H$+= " duplications in rows, columns or blocks. Backspace is the shortcut key for this action."+CHR$13
H$+= " 'Highlight' and 'Filter' colour particular numbers using Function and Shift Function keys."+CHR$13
H$+= " Selecting again toggles the selection or F10 removes both effects."+CHR$13
H$+= " 'Count Solutions' determines how many solutions are possible from the currrent state."+CHR$13
H$+= " 'Generate New' makes new random puzzles with a user selected difficulty."+CHR$13
H$+= " You may not agree with the program's assessment of difficulty!"+CHR$13
H$+= "Help : 'Solve' finds the first valid solution (if any) from the current state."+CHR$13
H$+= " 'Show Cell' enters the answer for the selected cell if there is a valid solution."+CHR$13 +CHR$13
H$+= "To find out more about the BBC BASIC language click on the 'Website' link on the menu bar."+CHR$13+CHR$13
H$+= CHR$9+CHR$9+CHR$9+" RTR and MGM Nov 2010"
SYS "MessageBox",@hwnd%, H$,"Help",0
ENDPROC
DEF PROCabout : REM GLOBAL Version$
LOCAL H$
H$ = " Original Program by R.T.Russell Dec 2005"+CHR$13
H$+= "Also uses code from LibTutor examples by Jon Ripley" +CHR$13
H$+= " Additions by M.G.Marten"+CHR$13
H$+= " Coded in BBC BASIC for WINDOWS V5.91b"+CHR$13
H$+= " Program Version "+Version$+" Nov 2010"
SYS "MessageBox",@hwnd%,H$,"About Sudoku",0
ENDPROC
REM Generate a random puzzle
DEF PROCgenerate : REM GLOBAL A%(), Q%(), Empty%
LOCAL I%,P%,R%,C%,S%,D%,T%,R&()
DIM R&(80)
FOR I% = 0 TO 80 : R&(I%) = I% : NEXT
REM Randomize numbers 0 to 80
FOR I% = 0 TO 80 : SWAP R&(I%),R&(RND(81)-1) : NEXT
D% = FNdifficulty
IF D%>=0 THEN
A%() = Empty%
PROCreset
FOR I% = 0 TO 8
A%(R&(I%) DIV 9,R&(I%) MOD 9) = 1 << I%
NEXT
REM Solve to get a matrix
PROCcheck_solutions(1)
Solved% = FALSE
A%() = Q%()
FOR I% = 9 TO 80
PROCstat1("Puzzle Creation countdown "+STR$(81-I%) +" (Esc to terminate)")
REM Remove cells and check it is still solvable and not too difficult
R% = R&(I%) DIV 9 : C% = R&(I%) MOD 9
P% = Empty%
SWAP A%(R%,C%),P%
Q%() = A%()
T% = 0
S% = FNsolve(Q%(),0,T%)
IF S%<>1 OR T%>D% A%(R%,C%) = P% : REM Put last removal back
NEXT I%
PROCshow
PROCstat1("New Puzzle generated!")
FileName$ = "" : REM Reset name
PROCtitle(FileName$)
ENDIF
ENDPROC
REM Get difficulty from a Dialog Box
DEF FNdifficulty : REM GLOBAL dlg%
LOCAL click%
PRIVATE diff%
PROC_showdialog(dlg%)
REM Set range 0-8
SYS "SendDlgItemMessage", !dlg%, 101, TBM_SETRANGE, 1, &60000
REM Set initial value
SYS "SendDlgItemMessage", !dlg%, 101, TBM_SETPOS, 1, diff%
REM Pretend to be a modal dialog box
SYS "EnableWindow", @hwnd%, 0
REM Use ON SYS LOCAL to handle dialogue box events
ON SYS LOCAL click% = @wparam% AND &FFFF : RETURN
REPEAT WAIT 10 : UNTIL click% = IDOK OR click% = IDCANCEL OR !dlg% = 0
ON SYS OFF
REM Handle results if click% = 1 "OK"
IF click%=1 THEN
SYS "SendDlgItemMessage", !dlg%, 101, TBM_GETPOS, 0, 0 TO diff%
ENDIF
REM Re-enable main window and close dialog
SYS "EnableWindow", @hwnd%, 1
SYS "BringWindowToTop", @hwnd%
PROC_closedialog(dlg%)
IF click%=1 THEN = diff% ELSE = -1
REM Copy grid to clipboard in Text format
DEFPROCcopy(cut%) : REM GLOBAL A%(), Empty%
LOCAL R%,C%,P%,S%,H%,L%,F%
REM block size 9*11+1 characters
SYS "GlobalAlloc", GMEM_MOVEABLE OR GMEM_DDESHARE, 100 TO H%
SYS "GlobalLock", H% TO L%
REM Now move data to memory block
FOR R% = 8 TO 0 STEP -1
FOR C% = 0 TO 8
P% = A%(R%,C%)
IF cut% PROCsaveold(R%,C%,P%,F%) : A%(R%,C%) = Empty%: F% = TRUE
IF P% AND (P%-1) ?L% = 46 ELSE ?L% = LOGP%/.3 + 49 : REM ASCII 46 is blank cell
L% += 1
NEXT
?L% = 13 : L% += 1
?L% = 10 : L% += 1
NEXT
?L% = 0
SYS "OpenClipboard", @hwnd% TO S%
IF S% THEN
SYS "EmptyClipboard"
SYS "SetClipboardData", CF_TEXT, H%
SYS "CloseClipboard"
ENDIF
SYS "GlobalUnlock",H%
ENDPROC
REM Get data from clipboard in Text format and parse into cells
DEFPROCpaste
LOCAL S%,H%,L%
SYS "IsClipboardFormatAvailable", CF_TEXT TO S%
IF S% THEN
SYS "OpenClipboard", @hwnd% TO S%
IF S% THEN
REM Get clipboard handle to data
SYS "GetClipboardData", CF_TEXT TO H%
IF H% THEN
REM Get actual memory location of data block
SYS "GlobalLock", H% TO L%
REM get data out of memory block
REM L% points to first data byte
PROCextract(L%)
REM release lock so others can use data
SYS "GlobalUnlock",H%
ENDIF
ENDIF
SYS "CloseClipboard"
ENDIF
ENDPROC
REM Attempts to get grid numbers from a Text format clipboard
DEFPROCextract(S%) : REM GLOBAL A%(),Changed%
LOCAL R%,C%,P&,V%,F%
FOR R% = 8 TO 0 STEP -1
FOR C% = 0 TO 8
PROCsaveold(R%,C%,A%(R%,C%),F%)
F% = TRUE
A%(R%,C%) = Empty%
REPEAT
P& = ?S%
V% = TRUE
CASE P& OF
WHEN 9,48,46,88,120 :
WHEN 49,50,51,52,53,54,55,56,57 : A%(R%,C%) = 1 << (P&-49)
OTHERWISE V% = FALSE
ENDCASE
IF P& S% += 1
UNTIL V% OR P& = 0
NEXT
NEXT
Changed% = TRUE
ENDPROC
DEF FNch : REM GLOBAL Changed%
LOCAL R%
IF NOT Changed% THEN = TRUE
SYS "MessageBox", @hwnd%, "Save current puzzle?", "Confirm", MB_ICONQUESTION OR MB_YESNOCANCEL TO R%
IF R%=IDYES IF FNsave : Changed% = FALSE : = TRUE
IF R%=IDNO Changed% = FALSE : = TRUE
= FALSE
DEF PROCexit
IF FNch THEN
PROC_removestatusbar
PROC_removetoolbar
QUIT
ENDIF
ENDPROC
DEF PROCtitle(F$) : REM GLOBAL Version$
IF F$="" F$="(untitled)"
SYS "SetWindowText",@hwnd%,"Sudoku version "+Version$+" - "+F$
ENDPROC
DEF FNspecialfolder(id%)
LOCAL ppidl%, folder%, malloc%
DIM folder% LOCAL 255
SYS "SHGetSpecialFolderLocation", @hwnd%, id%, ^ppidl%
SYS "SHGetPathFromIDList", ppidl%, folder%
SYS "SHGetMalloc", ^malloc%
SYS !(!malloc%+20), malloc%, ppidl% : REM. IMalloc::Free
= $$folder% + "\"
