To: syndicate@anart.no, list@rhizome.org, _arc.hive_@lm.va.com.au, From: "[__lo-y. ]" Subject: Re: . | " || 11-10-2003-13:13 | Date: Wed, 15 Oct 2003 13:53:22 +0200 At 2003-10-12 08:27:21, Florian Cramer wrytinged: > Johan uses self-written Perl scripts which he frequently processes through themselves, > and with loy, my suspicion is that he is simply one single Perl script ;-). ( http://groups.google.de/groups?dq=&hl=de&lr=&ie=UTF-%208&threadm=fa.ld656p1.1piqb3d%40ifi.uio.no&prev=/%20groups%3Fhl%3Dde%26lr%3D%26ie%3DUTF-8%26group%3Dfa.fiction-of-philosophy - it is highly recommended not to read the rest of the thread ) ( not a perl script ) ( but good old powerbasic ) ( and some manual editing ) #DEBUG ERROR ON #COMPILE EXE "lo_y.txt.proc.exe" #REGISTER NONE #OPTION VERSION4 #DIM ALL #RESOURCE "mktxt.pbr" #INCLUDE "c:\b\pb\winapi\win32api.inc" #INCLUDE "c:\b\pb\winapi\commctrl.inc" #INCLUDE "c:\b\pb\winapi\comdlg32.inc" #INCLUDE "c:\b\pb\winapi\richedit.inc" TYPE AlgoType naam AS STRING * 32 cptr AS DWORD 'not in use yet flags AS DWORD question AS STRING * 64 END TYPE TYPE AlgoParamsType Algo AS AlgoType siz AS DWORD inpstring AS STRING PTR 'contains the text to work on inpstring2 AS STRING PTR 'if multiple input required (flag), buffered text is put here outpstring AS STRING PTR datfile AS STRING PTR num AS DWORD 'parameter END TYPE DECLARE FUNCTION MkTxt_CreateEditWindow AS LONG DECLARE FUNCTION Mktxt_CreateBufferWindow AS LONG DECLARE CALLBACK FUNCTION MkTxt_Edit_DlgProc () AS LONG DECLARE FUNCTION UpdateAlgoParams(BYREF AP AS AlgoParamsType, BYVAL buf$) AS LONG DECLARE CALLBACK FUNCTION CBInp AS LONG DECLARE FUNCTION MkTxt_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Prok_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Prok2_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Prok3_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Dechar_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION LPF_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION LPF2_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION LPF_TD_PROC (AP AS AlgoPAramsType) AS LONG DECLARE FUNCTION Spacer_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION GrandMix_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION GrandMix_Rand_Proc (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Wrap (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Format (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION Repl (AP AS AlgoParamsType) AS LONG DECLARE FUNCTION MakeFont(BYVAL Fnt AS STRING, BYVAL PointSize AS LONG) AS LONG DECLARE FUNCTION MkTxt_FileOpenName(hParent AS LONG) AS STRING DECLARE FUNCTION MkTxt_FileSaveName(hPArent AS LONG) AS STRING DECLARE FUNCTION MkTxt_FileDataName(hParent AS LONG) AS STRING DECLARE FUNCTION RE_TextBeforeSelection(LONG) AS STRING DECLARE FUNCTION RE_TextAfterSelection(LONG) AS STRING DECLARE FUNCTION RE_SelectedText(LONG) AS STRING DECLARE FUNCTION File2String(BYVAL filn AS STRING) AS STRING DECLARE SUB myMsgbox (hparent AS LONG, b$) DECLARE CALLBACK FUNCTION CBmyMsgbox GLOBAL done AS LONG GLOBAL myhInst AS LONG GLOBAL hWEdit AS LONG GLOBAL hEdit AS LONG GLOBAL hBuf AS LONG GLOBAL Algo() AS AlgoType %MK_A_REQSIZ = &B1 '@algotype.flags meaning algorithm requires size param %MK_A_MULTINP = &B10 ' more then one input string %MK_A_REQDAT = &B100 ' data file %MK_A_REQNUMPARAM = &B1000 'requires numeric param %MK_A_REQSTRING = &B10000 'requires string as param - ptr put in datfile field FUNCTION WINMAIN(BYVAL hInst AS LONG, BYVAL hPrev AS LONG, lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG RANDOMIZE TIMER LOCAL hw AS LONG LOCAL txt AS STRING LOCAL i AS LONG ' i = loadlibrary ("c:\windows\system\richedi20.dll") ' if isfalse i then i = getlasterror myhInst = hInst DIM Algo(0 TO 13) Algo(0).naam = " mrkv" Algo(0).flags = %MK_A_REQSIZ Algo(0).cptr = CODEPTR(MkTxt_Proc) Algo(1).naam = " lo_y pass" Algo(1).flags = 0 Algo(1).cptr = CODEPTR(LPF_Proc) Algo(2).naam = " lo_y pass.frmt" Algo(2).flags = 0 Algo(2).cptr = CODEPTR(LPF2_Proc) Algo(3).naam = " lo_y pass.dom: tim" Algo(3).flags = 0 Algo(3).cptr = CODEPTR(LPF_TD_Proc) Algo(4).naam = " mix@buf" Algo(4).flags = %MK_A_REQSIZ OR %MK_A_MULTINP Algo(4).cptr = CODEPTR(GrandMix_Proc) Algo(5).naam = " mix@buf.rnd" Algo(5).flags = %MK_A_REQSIZ OR %MK_A_MULTINP Algo(5).cptr = CODEPTR(GrandMix_Rand_Proc) Algo(6).naam = " prk: rep" Algo(6).flags = %MK_A_REQSIZ Algo(6).cptr = CODEPTR(Prok_Proc) Algo(7).naam = " prk: simp" Algo(7).flags = %MK_A_REQSIZ Algo(7).cptr = CODEPTR(Prok2_Proc) Algo(8).naam = " prk: vanilla" Algo(8).flags = %MK_A_REQSIZ Algo(8).cptr = CODEPTR(Prok3_Proc) Algo(9).naam = " re: plac < file" Algo(9).flags = %MK_A_REQDAT Algo(9).cptr = CODEPTR(Dechar_Proc) Algo(10).naam = " spc" Algo(10).flags = 0 Algo(10).cptr = CODEPTR(Spacer_Proc) Algo(11).naam = " wrap" Algo(11).flags = %MK_A_REQNUMPARAM Algo(11).question = " line length:" Algo(11).cptr = CODEPTR(Wrap) Algo(12).naam = " frmt@buf" Algo(12).flags = %MK_A_MULTINP Algo(12).cptr = CODEPTR(format) Algo(13).naam = " rplc < inp" Algo(13).flags = %MK_A_REQSTRING Algo(13).question = "[original]:[replacement] - white space sensitive!" Algo(13).cptr = CODEPTR(repl) MkTxt_CreateEditWindow 'call this one after control window, sets hWEdit ' CHDIR "c:\b\pb\mktxt\" IF TRIM$(COMMAND$) <> "" THEN txt = File2String(COMMAND$) SetWindowText hEdit, BYVAL STRPTR(txt) END IF DO DIALOG DOEVENTS LOOP UNTIL done IF hWEdit THEN DIALOG END hWEdit END FUNCTION FUNCTION MkTxt_CreateEditWindow EXPORT AS LONG LOCAL i AS LONG LOCAL hicon AS LONG LOCAL hFont AS LONG 'should be called after controlwindow, otherwhise it will end up being a desktop child... IF LoadLibrary("RICHED20.DLL") = 0 THEN myMSGBOX 0, "Unable to load RICHED20.DLL. This dll is required to run this program!" EXIT FUNCTION 'is this correct? At least it seems to terminate properly.. END IF DIALOG FONT "lucida console", 10 DIALOG NEW 0 ," <__lo-y.txt.proc_>",, , 600, 400, %WS_THICKFRAME OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_SYSMENU TO hwEdit DIALOG SET COLOR hwEdit, -1, &H99BBDD 'a richedit control contains the text we work on CONTROL ADD "Richedit20a", hWEdit, 10000, "",3,93,524,395, %WS_CHILD OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR _ %WS_HSCROLL OR %ES_AUTOVSCROLL OR %ES_AUTOHSCROLL OR %ES_WANTRETURN ', %WS_EX_CLIENTEDGE CONTROL HANDLE hWEdit, 10000 TO hEdit CALL SendMessage(hEdit, %EM_SETBKGNDCOLOR, 0, &H88AACC) CALL SendMessage (hEdit, %EM_SETUNDOLIMIT, 64, 0) 'we might try to make an undo ourselves... CONTROL ADD LABEL, hWEdit, 1, "< ofn >", 2, 2, 48, 10, %SS_CENTER OR %SS_NOTIFY'puts contents of a file in the richedit - further we leave the file alone CONTROL ADD LABEL, hWEdit, 2, "< ns.rt >", 53, 2, 48, 10, %SS_CENTER OR%SS_NOTIFY 'insert contents of fiel @ cursor CONTROL ADD LABEL, hwEdit, 3, "< r.z >", 104, 2, 48, 10, %SS_CENTER OR%SS_NOTIFY 'empty richedit window CONTROL ADD LABEL, hwEdit, 10, "< sav >", 2, 16, 48, 10, %SS_CENTER OR%SS_NOTIFY 'save - prompt for filename CONTROL ADD LABEL, hwEdit, 11, "< cpy >", 53, 16, 48, 10, %SS_CENTER OR%SS_NOTIFY OR %WS_DISABLED'copy to buffer window (!= win clipboard!! use ctr + c for that) CONTROL ADD LABEL, hwEdit, 12, "< ml_t >", 104, 16, 48, 10, %SS_CENTER OR%SS_NOTIFY OR %WS_DISABLED 'should call kameel with selected texts- not functonal yet CONTROL SET COLOR hwedit, 1, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 2, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 3, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 10, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 11, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 12, %BLACK,&H88AACC 'add combo with algo's CONTROL ADD COMBOBOX, hwEdit,251,, 2,46, 99, 220, %CBS_DROPDOWNLIST OR %WS_TABSTOP CONTROL SET COLOR hwedit, 251, %BLACK,&H88AACC FOR i = LBOUND(Algo) TO UBOUND(Algo) COMBOBOX ADD hwEdit, 251, Algo(i).naam NEXT COMBOBOX SELECT hwEdit, 251, 1 CONTROL ADD LABEL, hWEdit, 1000, "< >> >",104,47,48,10, %SS_CENTER OR %SS_NOTIFY CONTROL ADD LABEL, hwEdit, 200, "txt.lng :", 2, 64, 51, 10, %SS_CENTER '%SS_CENTER 'size of result (in characters) - some algo's ignore it CONTROL ADD TEXTBOX, hwEdit, 201, "3000", 54, 64, 47, 10, %ES_NUMBER OR %ES_CENTER '4, CONTROL ADD TEXTBOX, hwEdit, 300, "", 4,78,97, 10, 4 CONTROL ADD LABEL, hwEdit, 301, "< find >", 104, 78, 48, 10, %SS_CENTER OR %SS_NOTIFY CONTROL ADD LABEL, hwEdit, 400, "< ndo >", 2, 31, 50, 10, %SS_CENTER OR %SS_NOTIFY CONTROL ADD LABEL, hwEdit, 500, "< buf >", 53, 31, 48, 10, %SS_CENTER OR %SS_NOTIFY 'selected text to bufferwin CONTROL ADD LABEL, hwEdit, 501, "< ld_bf >", 104, 31, 48, 10, %SS_CENTER OR %SS_NOTIFY 'buffer win 2 @cursor CONTROL SET COLOR hwedit, 400, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 1000, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 200, %BLACK,&H99BBDD CONTROL SET COLOR hwedit, 201, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 300, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 301, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 500, %BLACK,&H88AACC CONTROL SET COLOR hwedit, 501, %BLACK,&H88AACC 'bufferwin richedit CONTROL ADD "Richedit20a", hWEdit, 10100, "",154,2,227,88, %WS_CHILD OR %WS_CLIPCHILDREN OR %WS_VISIBLE OR %ES_MULTILINE OR %WS_VSCROLL OR _ %WS_HSCROLL OR %ES_AUTOVSCROLL OR %ES_AUTOHSCROLL OR %ES_WANTRETURN ', %WS_EX_CLIENTEDGE CONTROL HANDLE hWEdit, 10100 TO hBuf CALL SendMessage(hbuf, %EM_SETBKGNDCOLOR, 0, &H88AACC) hicon = LoadIcon (myhInst, "ICO_MKTXT") SetClassLong hwEdit, %GCL_HICON, hicon DIALOG SHOW MODELESS hWEdit CALL MkTxt_Edit_DlgProc CONTROL SET FOCUS hwEdit, 10000 'Showwindow hwEdit, %SW_MAXIMIZE END FUNCTION CALLBACK FUNCTION MkTxt_Edit_DlgProc () AS LONG STATIC hFont AS LONG STATIC x AS LONG STATIC y AS LONG LOCAL hDC AS LONG LOCAL e AS LONG LOCAL lf AS LOGFONT LOCAL bmpfile AS ASCIIZ * 64 LOCAL filn AS STRING * 300 LOCAL hFile AS LONG LOCAL TXT AS STRING LOCAL toptext AS STRING LOCAL mdltextin AS STRING LOCAL mdltextout AS STRING LOCAL bottomtext AS STRING LOCAL buf$ LOCAL AP AS AlgoParamsType SELECT CASE CBMSG CASE %WM_INITDIALOG 'set fonts for dialogs hFont = MakeFont("Lucida Console", 10) CONTROL SEND CBHNDL, 1 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 2 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 3 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 10 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 11 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 12 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 200 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 201 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 251 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 300 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 301 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 400 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 500 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 501 , %WM_SETFONT,hFont, 1 CONTROL SEND CBHNDL, 1000, %WM_SETFONT,hFont, 1 DIALOG DOEVENTS DIALOG GET SIZE CBHNDL TO x, y DIALOG UNITS CBHNDL, x, y TO PIXELS x, y 'use our own cursors- from lo_y-crt.exe resource ' hCursor = LoadCursor(myhInst, "CURSOR_MKTXT") ' SetSystemCursor hCursor, %OCR_NORMAL ' hCursor = LoadCursor(myhInst, "CURSOR_MKTXTTP") ' SetSystemCursor hCursor,%OCR_IBEAM ' hCursor = LoadCursor(myhInst, "CURSOR_MKTXTWT") ' SetSystemCursor hCursor,%OCR_WAIT ' hCursor = LoadCursor(myhInst, "CURSOR_MKTXTMOV") ' SetSystemCursor hCursor,%OCR_SIZEALL ' hCursor = LoadCursor(myhInst, "CURSOR_MKTXTSIZ") ' SetSystemCursor hCursor,%OCR_SIZENESW ' SetSystemCursor hCursor,%OCR_SIZENS ' SetSystemCursor hCursor,%OCR_SIZENWSE ' SetSystemCursor hCursor,%OCR_SIZEWE FUNCTION = 1 CASE %WM_EXITSIZEMOVE, %WM_MOVE 'resize richedits when main window resized LOCAL rct AS rect GetClientRect CBHNDL, rct y = rct.nbottom ' - 20 x = rct.nright '(rct.nright - rct.nleft) - 185 DIALOG PIXELS CBHNDL, x, y TO UNITS x, y x = x - 7 '176 y = y - 96 '3 CONTROL SET SIZE hwEdit, 10000, x, y CONTROL SET SIZE hwEdit, 10100, x- 151, 88' y - 158 '168 CASE %WM_CLOSE done =%true CASE %WM_COMMAND SELECT CASE CBCTL 'process buttons CASE 1 IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION 'new file to richedit box filn = MkTxt_FileOpenName(CBHNDL) IF TRIM$(filn)<> "" THEN txt = File2String(filn) SetWindowText hEdit, BYVAL STRPTR(txt) END IF CASE 2 IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION 'insert new text filn = MkTxt_FileOpenName(CBHNDL) IF TRIM$(filn) <> "" THEN toptext = RE_TextBeforeSelection(hEdit) bottomtext = RE_TextAfterSelection(hEdit) mdltextin = File2String(filn) txt = LEFT$(toptext, LEN(toptext) - 1) + mdltextin + bottomtext SetWindowText hEdit, BYVAL STRPTR(txt) END IF CASE 3 IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION 'erase box txt = "" SetWindowText hEdit, BYVAL STRPTR(txt) CASE 10 'save selected text IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION mdltextin = RE_SelectedText(hEdit) IF TRIM$(mdltextin) = "" THEN toptext = RE_TextBeforeSelection(hEdit) bottomtext = RE_TextAfterselection(hEdit) toptext = TRIM$(REMOVE$(toptext, CHR$(0))) bottomtext = TRIM$(REMOVE$(bottomtext, CHR$(0))) mdltextin = toptext + bottomtext toptext = "" bottomtext = "" END IF hFile = FREEFILE buf$ = MkTxt_FileSaveName(hWEdit) IF TRIM$(buf$) = "" THEN EXIT FUNCTION IF PARSECOUNT (buf$, ".") = 1 THEN buf$ = TRIM$(buf$) + ".txt" OPEN buf$ FOR OUTPUT AS hFile PRINT# hFile, mdltextin CLOSE hFile CASE 11 'copy to clipboard myMSGBOX hwEdit, "not functional yet" CASE 12 'send to kameel - ( option not yet supported in mktxt nor kameel! ) myMSGBOX hwedit, "not functional yet" CASE 301 'find text in textbox 300 IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION CONTROL GET TEXT CBHNDL, 300 TO buf$ buf$ = buf$ + CHR$(0) LOCAL ft AS FindTextApi CALL SendMessage(hEdit, %EM_EXGETSEL, 0, VARPTR(ft.chrg)) INCR ft.chrg.cpmin 'so if we have it selected we find the next - 'one must b really stupid 2 set the cursor @ a text + then search it (methinks) ft.chrg.cpmax = &H7FFF ft.lpStrText = STRPTR(buf$) CALL SendMessage (hEdit, %EM_FINDTEXT,0, VARPTR(ft)) TO e ft.chrg.cpmin = e ft.chrg.cpmax = e + LEN(buf$)- 1 IF e >= 0 THEN CONTROL SET FOCUS CBHNDL, 10000 CALL SendMessage (hEdit, %EM_EXSETSEL,0, VARPTR(ft.chrg)) ELSE myMSGBOX hwedit, REMOVE$(buf$, CHR$(0)) + " not found" END IF CASE 400 'undo CALL SendMessage(hEdit, %EM_CANUNDO, 0, 0) TO e IF ISFALSE e THEN mymsgBOX hwedit, "windows doesn't know what to undo right now" EXIT FUNCTION END IF CALL SendMessage(hEdit, %EM_UNDO, 0, 0) TO e CASE 500 'buffer toptext = RE_TextBeforeSelection(hEdit) bottomtext = RE_TextAfterselection(hEdit) mdltextin = RE_SelectedText(hEdit) toptext = TRIM$(REMOVE$(toptext, CHR$(0))) bottomtext = TRIM$(REMOVE$(bottomtext, CHR$(0))) mdltextin = TRIM$(REMOVE$(mdltextin, CHR$(0))) IF TRIM$(mdltextin) = "" THEN mdltextin = toptext + bottomtext toptext = "" bottomtext = "" END IF SetWindowText hBuf, BYVAL STRPTR(mdltextin) CASE 501 'load buffer to main window mdltextin = RE_SelectedText(hBuf) IF TRIM$(mdltextin) = "" THEN mdltextin = toptext + bottomtext toptext = "" bottomtext = "" END IF toptext = RE_TextBeforeSelection(hEdit) bottomtext = RE_TextAfterselection(hEdit) mdltextin = TRIM$(REMOVE$(mdltextin, CHR$(0))) toptext = TRIM$(REMOVE$(toptext, CHR$(0))) bottomtext = TRIM$(REMOVE$(bottomtext, CHR$(0))) mdltextin = toptext + mdltextin + bottomtext SetWindowText hEdit, BYVAL STRPTR(Mdltextin) CASE 1000 'start algo on selection IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION toptext = RE_TextBeforeSelection(hEdit) toptext = TRIM$(REMOVE$(toptext, CHR$(0))) bottomtext = RE_TextAfterselection(hEdit) bottomtext = TRIM$(REMOVE$(bottomtext, CHR$(0))) mdltextin = RE_SelectedText(hEdit) mdltextin = TRIM$(REMOVE$(mdltextin, CHR$(0))) IF mdltextin = "" THEN mdltextin = toptext + MID$(bottomtext, 2) toptext = "" bottomtext = "" END IF IF TRIM$(mdltextin) = "" THEN mymsgbox hwedit, "please write something in the big box first": EXIT FUNCTION COMBOBOX GET TEXT hwEdit, 251 TO buf$ IF UpdateAlgoParams(AP, buf$) < 0 THEN EXIT FUNCTION MOUSEPTR 11 AP.inpString = VARPTR(mdltextin) IF ISFALSE(AP.Algo.flags AND %MK_A_REQSIZ) THEN AP.Siz = LEN(mdltextin) END IF mdltextout = REPEAT$(MAX(LEN(mdltextin), AP.Siz), " ") AP.outpString = VARPTR(mdltextout) CALL DWORD AP.Algo.cptr USING MkTxt_Proc(AP) TO x IF ISFALSE x THEN EXIT FUNCTION mdltextout = TRIM$(REMOVE$(mdltextout, CHR$(0))) txt = LEFT$(toptext, LEN(toptext) - 1) + mdltextout + bottomtext txt = TRIM$(REMOVE$(txt, CHR$(0))) SetWindowText hEdit, BYVAL STRPTR(txt) MOUSEPTR 0 END SELECT END SELECT END FUNCTION SUB myMsgbox (hparent AS LONG, b$) LOCAL hD AS LONG DIALOG FONT "Lucida Console", 12 DIALOG NEW hparent , "<__lo-y. >", , ,MAX(70, 10 + 8 * LEN(b$) / (PARSECOUNT(b$, CHR$(13)) + 1)), 34 + 12 * PARSECOUNT(b$, CHR$(13)), %WS_POPUP OR %WS_BORDER OR _ '%DS_3DLOOK OR %WS_DLGFRAME or %DS_MODALFRAME %WS_CAPTION OR %WS_CAPTION OR _ %WS_MINIMIZEBOX OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR _ %DS_SETFOREGROUND OR %DS_NOFAILCREATE _ OR %DS_SETFONT, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR _ %WS_EX_CONTEXTHELP OR %WS_EX_APPWINDOW OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR OR %WS_EX_TOOLWINDOW, TO hD CONTROL ADD LABEL, hd, 1, b$, 5, 5, MAX(60, 8 * LEN(b$) / (PARSECOUNT(b$, CHR$(13)) + 1)), 12 * PARSECOUNT(b$, CHR$(13)), %SS_CENTER CONTROL ADD LABEL, hd, 2, " < ok >", 5, 12 + 12 * PARSECOUNT(b$, CHR$(13)), MAX(60, 8 * LEN(b$) / (PARSECOUNT(b$, CHR$(13)) + 1)),10, %SS_NOTIFY OR %SS_CENTER CONTROL SET COLOR hD, 1, %BLACK, &H99BBDD CONTROL SET COLOR hD, 2, %BLACK, &H88aacc DIALOG SET COLOR hD, %BLACK, &H99BBDD DIALOG SHOW MODAL hd CALL CBmyMsgBox END SUB CALLBACK FUNCTION CBmyMsgbox IF CBMSG = %WM_COMMAND AND CBCTLMSG = %STN_CLICKED THEN DIALOG END CBHNDL, CBCTL END FUNCTION FUNCTION UpdateAlgoParams(BYREF AP AS AlgoParamsType, BYVAL buf$) AS LONG LOCAL i AS LONG STATIC fdname AS STRING FUNCTION = -1 FOR i = LBOUND(Algo) TO UBOUND(Algo) + 1 IF TRIM$(Algo(i).naam) = TRIM$(buf$) THEN EXIT FOR NEXT IF i = UBOUND(Algo) + 1 THEN myMSGBOX hwedit, "error: invalid algo: " + buf$ 'invalid algo name EXIT FUNCTION END IF AP.Algo = Algo(i) IF AP.Algo.flags AND %MK_A_REQSIZ THEN CONTROL GET TEXT hwEdit, 201 TO buf$ i = VAL(buf$) IF ISFALSE i THEN myMSGBOX hwedit, "size requierd !!" 'siz required but not given EXIT FUNCTION END IF Ap.Siz = i END IF IF (AP.Algo.flags AND %MK_A_MULTINP) THEN LOCAL toptext AS STRING LOCAL bottomtext AS STRING STATIC mdltextin AS STRING toptext = RE_TextBeforeSelection(hBuf) bottomtext = RE_TextAfterselection(hBuf) mdltextin = "" mdltextin = RE_SelectedText(hBuf) IF TRIM$(mdltextin) = "" THEN mdltextin = toptext + bottomtext toptext = "" bottomtext = "" END IF mdltextin = REMOVE$(TRIM$(mdltextin), CHR$(0)) IF TRIM$(mdltextin) = "" THEN myMSGBOX hwedit, "you might want to buffer something first" END IF AP.InpString2 = VARPTR(mdltextin) END IF IF (AP.Algo.flags AND %MK_A_REQDAT) THEN fdname = MkTxt_FileDataName(hwEdit) Ap.datfile = VARPTR(fdname) END IF IF (AP.Algo.flags AND %MK_A_REQNUMPARAM) THEN LOCAL hDlginp AS LONG DIALOG NEW hwEdit, Ap.Algo.question, 50, 50, 109, 17 TO hDlgInp DIALOG SET COLOR hDlgInp, -1, &H99bbdd CONTROL ADD TEXTBOX, hDlgInp, 1,"",3, 4, 50, 10, %SS_CENTER OR %SS_NOTIFY CONTROL ADD BUTTON, hDlgInp, 20,"0k", 56, 3, 50, 10, %BS_DEFAULT OR %BS_FLAT CALL CBInp CONTROL SET COLOR hDlgInp, 1, 0, &H88aacc CONTROL SET COLOR hDlgInp, 20, 0, &H88aacc DIALOG SHOW MODAL hDlgInp TO Ap.num END IF IF (AP.Algo.flags AND %MK_A_REQSTRING) THEN fdname = INPUTBOX$(Ap.Algo.question, Ap.Algo.question) Ap.datfile = VARPTR(fdname) END IF FUNCTION = 1 END FUNCTION CALLBACK FUNCTION CBInp AS LONG STATIC buf$ IF CBCTLMSG <> %BN_CLICKED THEN EXIT FUNCTION CONTROL GET TEXT CBHNDL, 1 TO buf$ DIALOG END CBHNDL, VAL(buf$) END FUNCTION FUNCTION File2String(BYVAL filn AS STRING) EXPORT AS STRING LOCAL hFile AS LONG LOCAL txt AS STRING IF TRIM$(filn) = "" THEN EXIT FUNCTION hFile = FREEFILE 'simple file-to-string OPEN filn FOR BINARY AS hFile IF ERRCLEAR THEN myMSGBOX hwedit, "couldn't open " + filn: FUNCTION = "":EXIT FUNCTION GET$ hFile, LOF(hFile), txt CLOSE hFile FUNCTION = txt END FUNCTION FUNCTION RE_TextBeforeSelection(h AS LONG) AS STRING LOCAL txt AS STRING, l AS LONG, pd AS CHARRANGE LOCAL tr AS textRange CALL SendMessage(h, %EM_EXGETSEL, 0, VARPTR(pd)) tr.chrg.cpMin = 0 tr.chrg.cpMax = pd.cpMin + 1 txt = REPEAT$(tr.chrg.cpmax, " ") tr.lpStrText = STRPTR(txt) SendMessage(h, %EM_GETTEXTRANGE, 0, VARPTR(tr) FUNCTION = txt END FUNCTION FUNCTION RE_TextAfterSelection(h AS LONG) AS STRING LOCAL txt AS STRING, l AS LONG, pd AS CHARRANGE CALL SendMessage(h, %EM_EXGETSEL, 0, VARPTR(pd)) txt = REPEAT$(32000, " ") GetWindowText h, BYVAL STRPTR(txt), 32000 txt = MID$(txt, pd.cpmax + 1) FUNCTION = txt END FUNCTION FUNCTION RE_SelectedText(h AS LONG) AS STRING LOCAL txt AS STRING, l AS LONG, pd AS CHARRANGE LOCAL tr AS textRange CALL SendMessage(h, %EM_EXGETSEL, 0, VARPTR(pd)) tr.chrg.cpMin = pd.cpMin '+ 1 tr.chrg.cpMax = pd.cpMax txt = REPEAT$(tr.chrg.cpmax, " ") tr.lpStrText = STRPTR(txt) SendMessage(h, %EM_GETTEXTRANGE, 0, VARPTR(tr) FUNCTION = txt END FUNCTION FUNCTION MkTxt_FileOpenName(hParent AS LONG) AS STRING 'basically calls winapi getopenfilename 'hParent is only important for positioning of open window - may be 0 LOCAL ofn AS OPENFILENAME LOCAL shortfiln AS STRING * 28 LOCAL filnnopath AS STRING * 80 LOCAL filn AS STRING * 300 LOCAL titl AS STRING * 30 LOCAL filtr AS STRING * 200 LOCAL exts AS STRING * 3 LOCAL inidir AS STRING * 256 ofn.lStructSize = SIZEOF(ofn) ofn.hwndOwner = hParent ofn.hInstance = myhInst MID$(filn,1) = CHR$(0) ofn.lpStrFile = VARPTR(filn) ofn.nMaxfile = 300 filtr = ".txt" + CHR$(0) + "*.txt" + CHR$(0) + ".raw" + CHR$(0) + "*.raw" + CHR$(0) +"whatever" + CHR$(0) + "*.*" + CHR$(0,0,0,0) ofn.lpStrFilter = VARPTR(filtr) ofn.nFilterIndex=1 titl = "input:" ofn.lpStrTitle= VARPTR(titl) ofn.flags = %OFN_FILEMUSTEXIST OR %OFN_LONGNAMES OR %OFN_HIDEREADONLY GetOpenFileName ofn FUNCTION = ofn.@lpStrFile END FUNCTION FUNCTION MkTxt_FileSaveName(hPArent AS LONG) AS STRING LOCAL ofn AS OPENFILENAME LOCAL shortfiln AS STRING * 28 LOCAL filnnopath AS STRING * 80 LOCAL filn AS STRING * 300 LOCAL titl AS STRING * 30 LOCAL filtr AS STRING * 200 LOCAL exts AS STRING * 3 LOCAL inidir AS STRING * 256 ofn.lStructSize = SIZEOF(ofn) ofn.hwndOwner = hParent ofn.hInstance = myhInst MID$(filn,1) = CHR$(0) ofn.lpStrFile = VARPTR(filn) ofn.nMaxfile = 300 filtr = ".txt" + CHR$(0) + "*.txt" + CHR$(0) +"whatever" + CHR$(0) + "*.*" + CHR$(0,0,0,0) ofn.lpStrFilter = VARPTR(filtr) ofn.nFilterIndex=1 titl = "destination:" ofn.lpStrTitle= VARPTR(titl) ofn.flags = %OFN_FILEMUSTEXIST OR %OFN_LONGNAMES OR %OFN_HIDEREADONLY GetSaveFileName ofn FUNCTION = ofn.@lpStrFile END FUNCTION FUNCTION MkTxt_FileDataName(hParent AS LONG) AS STRING 'hParent is only important for positioning of open window - may be 0 LOCAL ofn AS OPENFILENAME LOCAL shortfiln AS STRING * 28 LOCAL filnnopath AS STRING * 80 LOCAL filn AS STRING * 300 LOCAL titl AS STRING * 30 LOCAL filtr AS STRING * 200 LOCAL exts AS STRING * 3 LOCAL inidir AS STRING * 256 ofn.lStructSize = SIZEOF(ofn) ofn.hwndOwner = hParent ofn.hInstance = myhInst MID$(filn,1) = CHR$(0) ofn.lpStrFile = VARPTR(filn) ofn.nMaxfile = 300 inidir = "c:\b\pb\mktxt" ofn.lpStrInitialDir = VARPTR(inidir) filtr = ".dat" + CHR$(0) + "*.dat" + CHR$(0) + ".txt" + CHR$(0) + "*.txt" + CHR$(0) +"whatever" + CHR$(0) + "*.*" + CHR$(0,0,0,0) ofn.lpStrFilter = VARPTR(filtr) ofn.nFilterIndex=1 titl = "data file:" ofn.lpStrTitle= VARPTR(titl) ofn.flags = %OFN_FILEMUSTEXIST OR %OFN_LONGNAMES OR %OFN_HIDEREADONLY GetOpenFileName ofn FUNCTION = ofn.@lpStrFile END FUNCTION FUNCTION MkTxt_Proc(AP AS AlgoParamsType) EXPORT AS LONG 'statistical ana of n$ as source for 3rd gen markov chain out 'eats way too much memory for what it does.. LOCAL i AS BYTE, j AS BYTE, k AS BYTE, c AS LONG LOCAL s AS STRING * 1 LOCAL buf AS LONG LOCAL pos AS LONG DIM ar(1 TO 255, 1 TO 255, 1 TO 255) AS LONG pos = 1 s = MID$(ap.@inpstring, pos, 1) INCR pos k = ASC(s) s = MID$(ap.@inpstring, pos, 1) INCR pos j = ASC(s) DO UNTIL pos > LEN(ap.@inpstring) s = MID$(ap.@inpstring, pos, 1) INCR pos IF ISFALSE (pos MOD 50) THEN IF done THEN EXIT FUNCTION END IF END IF i = ASC(s) IF i > 255 THEN i = ASC(".") ELSEIF i < 10 THEN i = ASC(".") END IF INCR ar(k, j, i) k = j: j = i LOOP s = MID$(ap.@inpstring, 1, 1) i = ASC(s) s = MID$(ap.@inpstring, 2, 1) j = ASC(s) s = CHR$(i) ap.@outpstring = s s = CHR$(j) ap.@outpstring = ap.@outpstring + s DIM p(1 TO 5) AS LOCAL BYTE DIM v(1 TO 5) AS LOCAL LONG FOR c = 3 TO ap.siz IF ISFALSE (c MOD 50) THEN END IF rsm: IF done THEN EXIT FUNCTION END IF FOR k = 1 TO 254 IF ar(i, j, k) >= v(1) THEN p(5) = p(4): p(4) = p(3): p(3) = p(2): p(2) = p(1): p(1) = k v(5) = v(4): v(4) = v(3): v(3) = v(2): v(2) = v(1): v(1) = ar(i,j,k) ELSEIF ar(i,j,k) >= v(2) THEN p(5) = p(4): p(4) = p(3): p(3) = p(2): p(2) = k v(5) = v(4): v(4) = v(3): v(3) = v(2): v(2) = ar(i,j,k) ELSEIF ar(i,j,k) >= v(3) THEN p(5) = p(4): p(4) = p(3): p(3) = k v(5) = v(4): v(4) = v(3): v(3) = ar(i,j,k) ELSEIF ar(i,j,k) >= v(4) THEN p(5) = p(4): p(4) = k v(5) = v(4): v(4) = ar(i,j,k) ELSEIF ar(i,j,k) >= v(5) THEN p(5) = k v(5) = ar(i,j,k) END IF NEXT IF ISFALSE v(1) THEN INCR i IF i = 127 THEN i = 10 INCR j IF j = 127 THEN myMSGBOX hwedit, "je m'en fous - no match found!" FUNCTION = 0 EXIT FUNCTION END IF END IF GOTO rsm ELSE IF ISFALSE v(2) THEN p(2) = p(1) IF ISFALSE v(3) THEN p(3) = p(2) IF ISFALSE v(4) THEN p(4) = p(3) IF ISFALSE v(5) THEN p(5) = p(4) i = j IF RND > .66 THEN j = p(1) ELSEIF RND > .66 THEN j = p(2) ELSEIF RND > .66 THEN j = p(3) ELSEIF RND > .33 THEN j = p(4) ELSE j = p(5) END IF s = CHR$(j) ap.@outpstring = ap.@outpstring + s FOR k = 1 TO 5: v(k) = 0: NEXT END IF NEXT FUNCTION = 1 END FUNCTION FUNCTION Prok_Proc(AP AS AlgoParamsType) EXPORT AS LONG 'crawls through file, repperprpeatatatiiingng 'truncates input at ap.siz th character RANDOMIZE TIMER LOCAL i AS LONG LOCAL c AS LONG LOCAL a AS STRING LOCAL b AS STRING LOCAL buf$ LOCAL count AS LONG buf$ = AP.@inpstring 'REMOVE$(AP.@inpstring, " ") DIM arr(0 TO (LEN(buf$) - 1) ) AS LOCAL STRING * 1 AT STRPTR(buf$) prmn: i = -5 FOR c = 5 TO LEN(buf$) 'ap.siz IF done THEN EXIT FUNCTION INCR count IF count > ap.siz THEN EXIT FOR IF i < 0 THEN b = arr(c) ELSE b = arr(CEIL((c-i) + RND * i) ) END IF IF RND > .3 THEN INCR i ELSE DECR i END IF IF b = CHR$(10) THEN i = -5 a = REMOVE$(a, CHR$(0)) AP.@outpstring = Ap.@outpString + a + CHR$(13, 10) a="" ITERATE FOR END IF IF b = " " THEN i = 1 IF b="" THEN INCR i: b = "" a = a + b NEXT IF count < ap.siz THEN c = 0: GOTO prmn FUNCTION = 1 END FUNCTION FUNCTION Prok2_Proc(AP AS AlgoParamsType) EXPORT AS LONG 'like prok but les rerrepperepeateaeatterrishishiishhshsh RANDOMIZE TIMER LOCAL i AS LONG LOCAL c AS LONG LOCAL lasti AS LONG LOCAL LOeP AS LONG LOCAL a AS STRING LOCAL b AS STRING LOCAL buf$ buf$ = REMOVE$(AP.@inpstring, CHR$(13)) DIM arr(0 TO LEN(AP.@inpstring) - 1) AS LOCAL STRING * 1 AT STRPTR(buf$) a = arr(0) + arr(1) + arr(2) lasti = 1 FOR c = 3 TO ap.siz IF done THEN EXIT FUNCTION END IF DO INCR i IF i > (UBOUND(arr) - 5) THEN i = 0 IF i = lasti THEN INCR loep IF loep > 1 THEN i = INT(RND * UBOUND(arr)) a = a + arr(i) a = a + arr(i+1) a = a + arr(i+2) loep = 0 ITERATE FOR END IF END IF IF arr(i) = MID$(a, LEN(a) - 2, 1) THEN IF arr(i + 1) = MID$(a,LEN(a)-1,1) THEN IF arr(i+2) = MID$(a,LEN(a),1) THEN IF arr(i + 3) = CHR$(10) THEN lasti = i a = REMOVE$(a, CHR$(0)) AP.@outpString = AP.@outpString + a + CHR$(13, 10) a = arr(i+4) + arr(i+5) ELSE a = a + arr(i + 3) INCR i END IF EXIT LOOP END IF END IF END IF LOOP NEXT FUNCTION = 1 END FUNCTION FUNCTION Prok3_Proc(AP AS AlgoParamsType) EXPORT AS LONG 'like proc2, result is closer to original syntax... RANDOMIZE TIMER LOCAL i AS LONG LOCAL c AS LONG LOCAL f AS LONG LOCAL lasti AS LONG LOCAL LOeP AS LONG LOCAL a AS STRING LOCAL b AS STRING LOCAL buf$ buf$ = REMOVE$(AP.@inpString, CHR$(13)) DIM arr(0 TO LEN(AP.@inpString) - 1) AS LOCAL STRING * 1 AT STRPTR(buf$) a = arr(0) + arr(1) + arr(2) lasti = 1 FOR c = 3 TO ap.siz IF ISFALSE (c MOD 50) THEN IF done THEN CLOSE f EXIT FUNCTION END IF END IF DO INCR i IF i > (UBOUND(arr) - 5) THEN i = 0 IF i = lasti THEN INCR loep IF loep > 1 THEN i = INT(RND * UBOUND(arr)) DO UNTIL (arr(i) <> CHR$(10) AND arr(i+1) <> CHR$(10) AND arr(i+2) <> CHR$(10)) i = INT(RND * UBOUND(arr)) LOOP a = a + arr(i) a = a + arr(i+1) a = a + arr(i+2) loep = 0 ITERATE FOR END IF END IF IF arr(i) = MID$(a, LEN(a) - 2, 1) THEN IF arr(i + 1) = MID$(a,LEN(a)-1,1) THEN IF arr(i+2) = MID$(a,LEN(a),1) THEN IF arr(i + 3) = CHR$(10) THEN lasti = i AP.@outpString = AP.@outpString + a + CHR$(13, 10) a = "" IF arr(i+4) <> CHR$(10) THEN a = a + arr(i+4) IF arr(i+5)<> CHR$(10) THEN a = a + arr(i+5) ELSE a = a + arr(i + 3) IF arr(i + 3) = "." THEN a = a + " " a = a + arr(i+4) IF arr(i + 4) = "." THEN a = a + " " i = INT(RND * UBOUND(arr)) END IF EXIT LOOP END IF END IF END IF LOOP NEXT FUNCTION = 1 END FUNCTION FUNCTION Dechar_Proc(AP AS AlgoParamsType) EXPORT AS LONG '1:1 character replacement, .dat file as input LOCAL f AS LONG LOCAL buf$ LOCAL i AS LONG LOCAL j AS LONG LOCAL k AS LONG LOCAL l AS LONG LOCAL c AS LONG 'do dialog stuff.... f = FREEFILE OPEN AP.@datfile FOR INPUT AS f DO IF EOF(f) THEN GOTO ivrpfil LINE INPUT #f, buf$ LOOP WHILE MID$(TRIM$(buf$),1,1) = "'" IF EOF(f) THEN GOTO ivrpfil i = VAL(buf$) IF i<= 0 THEN GOTO ivrpfil IF EOF(f) THEN GOTO ivrpfil DIM rp(1 TO i, 0 TO 10) AS BYTE FOR j = 1 TO i LINE INPUT #f, buf$ buf$ = TRIM$(buf$) rp(j,0) = ASC(TRIM$(PARSE$(buf$,1))) FOR k = 2 TO PARSECOUNT(buf$) IF k > 11 THEN EXIT FOR rp(j, k-1) = ASC(PARSE$(buf$,k)) NEXT k IF EOF(f) THEN EXIT FOR NEXT j CLOSE f AP.@outpString = AP.@inpString FOR i = 1 TO LEN(AP.@inpstring) c = ASC(MID$(AP.@inpString, i, 1)) FOR j = 1 TO UBOUND(Rp, 1) IF RP(j, 0) = c THEN IF ISFALSE rp(j,1) THEN ITERATE FOR FOR k = 2 TO 10 IF ISFALSE rp(j,k) THEN DECR k:DECR k k = 1 + k * RND EXIT FOR END IF NEXT k MID$(AP.@outpString, i, 1) = CHR$(rp(j,k)) EXIT FOR END IF NEXT NEXT FUNCTION = 1 relw: EXIT FUNCTION ivrpfil: CLOSE f myMSGBOX hwedit, "invalid data file@lo_y.replacer" FUNCTION = 0 GOTO relw END FUNCTION FUNCTION LPF_Proc (AP AS AlgoParamsType) EXPORT AS LONG LOCAL i AS LONG LOCAL count AS LONG LOCAL buf$ DIM arstat(0 TO 255) AS LOCAL LONG DIM tagarstat(0 TO 255) AS LOCAL LONG DIM arbuf AS STRING arbuf = AP.@inpString DIM ardat(0 TO LEN(arbuf)) AS LOCAL BYTE AT STRPTR(arbuf) FOR i = 0 TO 255 tagarstat(i) = i NEXT FOR count = 0 TO UBOUND(ardat) i = ardat(count) INCR arstat(i) NEXT IF done THEN GOTO qbort ARRAY SORT arstat() , TAGARRAY tagarstat() FOR count = 0 TO UBOUND(ardat) ardat(count) = tagarstat(ardat(count)) NEXT FOR count = UBOUND(ardat) TO 1 STEP -1 ardat(count) = INT((ardat(count-1) + 5 * ardat(count)) / 6) NEXT IF done THEN GOTO qbort FOR count = 1 TO UBOUND(ardat) FOR i = 0 TO 255 IF ardat(count) = tagarstat(i) THEN ardat(count) = i EXIT FOR END IF NEXT NEXT ARRAY SORT tagarstat() , TAGARRAY arstat() IF done THEN GOTO qbort buf$ = "" FOR count = 0 TO UBOUND(ardat) pnieuw: IF ardat(count) >= ASC(" ")THEN IF ISFALSE arstat(ardat(count)) THEN DECR ardat(count) GOTO pnieuw END IF ELSE IF RND < .8 THEN ardat(count) = ASC(" ") ELSE ardat(count) = 13 END IF END IF NEXT REPLACE CHR$(13) WITH CHR$(13, 10) IN arbuf AP.@outpstring = arbuf DIALOG DOEVENTS DIALOG DOEVENTS qbort: DIALOG DOEVENTS FUNCTION = 1 END FUNCTION FUNCTION LPF_TD_PROC(AP AS AlgoPAramsType) AS LONG LOCAL i AS LONG LOCAL x1 AS BYTE LOCAL x2 AS BYTE LOCAL x3 AS BYTE LOCAL x4 AS BYTE LOCAL x5 AS BYTE LOCAL x6 AS BYTE DIM arbuf AS STRING arbuf = AP.@inpstring DIM ardat(0 TO LEN(arbuf)) AS LOCAL BYTE AT STRPTR(arbuf) FOR i = 0 TO UBOUND(ardat) x6 = x4 x5 = x4 x4 = x3 x3 = x2 x2 = x1 x1 = ardat(i) IF ardat(i) < 48 THEN ITERATE FOR IF CHR$(ardat(i)) <> " " THEN ardat(i) = INT((ardat(i) + x1 + x4 + 3 * x6) / 6! ) NEXT arbuf = REMOVE$(arbuf, CHR$(10)) REPLACE CHR$(13) WITH $CRLF IN arbuf AP.@outpstring = arbuf FUNCTION = 1 END FUNCTION FUNCTION LPF2_Proc (AP AS AlgoParamsType) EXPORT AS LONG LOCAL i AS LONG LOCAL count AS LONG LOCAL buf$ LOCAL arbuf AS STRING DIM arstat(0 TO 255) AS LOCAL LONG DIM tagarstat(0 TO 255) AS LOCAL LONG arbuf = AP.@inpString DIM ardat(0 TO LEN(ArBuf)) AS LOCAL BYTE AT STRPTR(arbuf) FOR i = 0 TO 255 tagarstat(i) = i NEXT FOR count = 0 TO UBOUND(ardat) IF ISFALSE (count MOD 500) THEN END IF i = ardat(count) IF i > 32 THEN INCR arstat(i) NEXT IF done THEN GOTO qbort IF count > UBOUND(ardat) THEN count = UBOUND(ardat) ARRAY SORT arstat() , TAGARRAY tagarstat() FOR count = 0 TO UBOUND(ardat) IF ardat(count) > 32 THEN ardat(count) = tagarstat(ardat(count)) END IF NEXT FOR count = UBOUND(ardat) TO 1 STEP -1 IF ardat(count) > 32 THEN ardat(count) = 32 + INT((ardat(count-1) + 2 * ardat(count)) / 3) 'was 5 & 6 END IF NEXT FOR count = 1 TO UBOUND(ardat) IF ISFALSE (count MOD 500) THEN IF done THEN GOTO qbort END IF IF ardat(count)> 32 THEN FOR i = 0 TO 255 IF ardat(count) - 32 = tagarstat(i) THEN ardat(count) = i + 32 EXIT FOR END IF NEXT END IF NEXT ARRAY SORT tagarstat() , TAGARRAY arstat() buf$ = "" FOR count = 0 TO UBOUND(ardat) IF ISFALSE (count MOD 500) THEN IF done THEN GOTO qbort END IF pnieuw: IF ardat(count) > 32 THEN IF arstat(ardat(count)-32) THEN ardat(count) = ardat(count) - 32 ELSE DECR ardat(count) GOTO pnieuw END IF END IF NEXT REPLACE CHR$(0) WITH " " IN arbuf AP.@outpString = arbuf qbort: FUNCTION = 1 END FUNCTION FUNCTION Spacer_Proc (AP AS AlgoParamsType) EXPORT AS LONG 'add spaces REGISTER i AS DWORD REGISTER j AS DWORD LOCAL count AS LONG LOCAL b AS STRING * 1 i = SQR(RND) * 4 + (RND ^ 2) * 6 j = 2 + SQR(RND) * 3 + (RND ^ 2) * 10 FOR count = 1 TO LEN(AP.@inpString) IF ISFALSE i THEN IF ISFALSE j THEN AP.@outpString = AP.@outpString + CHR$(13, 10) j = 2 + SQR(RND) * 3 + (RND ^ 2) * 4 i = SQR(RND) * 4 + (RND ^ 2) * 5 END IF AP.@outpString = AP.@outpString + " " i = SQR(RND) * 4 + (RND ^ 2) * 5 DECR j END IF AP.@outpString = AP.@outpString + MID$(AP.@inpString, count, 1) IF MID$(AP.@inpString, count, 1) = CHR$(13) THEN AP.@outpString = AP.@outpString + CHR$(10) INCR count END IF DECR i NEXT FUNCTION = 1 END FUNCTION FUNCTION GrandMix_Rand_Proc(AP AS AlgoParamsType) EXPORT AS LONG 'mix main richedit with buffer LOCAL buf$ LOCAL i AS LONG LOCAL circount AS LONG LOCAL pos AS LONG FOR i = 1 TO ap.siz pos = (i/ap.siz) * LEN(AP.@inpstring) - 3 + RND * 6 IF pos > LEN(AP.@inpstring) THEN pos = LEN(AP.@inpstring) ELSEIF pos < 0 THEN pos = 0 END IF buf$ = MID$(AP.@inpstring, pos, 1) AP.@outpstring = AP.@outpstring + buf$ pos = (i/ap.siz) * LEN(AP.@inpstring2) - 3 + RND * 6 IF pos > LEN(AP.@inpstring2) THEN pos = LEN(AP.@inpstring2) ELSEIF pos < 0 THEN pos = 0 END IF buf$ = MID$(AP.@inpstring2, pos, 1) AP.@outpstring = AP.@outpstring + buf$ NEXT FUNCTION = 1 END FUNCTION FUNCTION GrandMix_Proc(AP AS AlgoParamsType) EXPORT AS LONG LOCAL buf$ LOCAL i AS LONG LOCAL pos AS LONG FOR i = 1 TO ap.siz pos = (i/ap.siz) * LEN(AP.@inpstring) buf$ = MID$(AP.@inpstring, pos, 1) IF buf$ = CHR$(13) THEN buf$ = buf$ + CHR$(10) IF buf$ = CHR$(10) THEN buf$ = "" 'CHR$(13) + buf$ AP.@outpstring = AP.@outpstring + buf$ pos = (i/ap.siz) * LEN(AP.@inpString2) buf$ = MID$(AP.@inpstring2, pos, 1) IF buf$ = CHR$(13) THEN buf$ = "" 'buf$ + CHR$(10) 'only accept line breaks in main edit win IF buf$ = CHR$(10) THEN buf$ = "" 'CHR$(13) + buf$ AP.@outpstring = AP.@outpstring + buf$ NEXT FUNCTION = 1 END FUNCTION FUNCTION Wrap(AP AS AlgoParamsType) EXPORT AS LONG LOCAL pos AS LONG LOCAL c AS LONG LOCAL buf$ AP.@inpString = REMOVE$(AP.@inpString, CHR$(10)) FOR pos = 1 TO LEN(AP.@inpstring) IF MID$(AP.@inpString, pos, 1) = CHR$(13) THEN IF ISFALSE c THEN ITERATE FOR c = 0 AP.@outpString = AP.@outpstring + buf$ + CHR$(13, 10) buf$ = "" ITERATE FOR END IF INCR c buf$ = buf$ + MID$(AP.@inpString, pos, 1) IF c >= AP.num THEN FOR c = LEN(buf$) TO 0 STEP - 1 IF MID$(buf$, c, 1) = " " THEN EXIT FOR IF MID$(buf$, c, 1) = "-" THEN EXIT FOR IF MID$(buf$, c, 1) = "_" THEN EXIT FOR IF MID$(buf$, c, 1) = "," THEN EXIT FOR IF MID$(buf$, c, 1) = ";" THEN EXIT FOR NEXT IF c > 0 THEN pos = pos - LEN(buf$) + c AP.@outpString = AP.@outpString + MID$(buf$, 1, c) + CHR$(13, 10) buf$ = "" c = 0 ELSE AP.@outpString = AP.@outpString + buf$ + CHR$(13, 10) buf$ = "" c = 0 END IF ITERATE FOR END IF NEXT FUNCTION = 1 END FUNCTION FUNCTION Format(AP AS AlgoParamsType) EXPORT AS LONG LOCAL i AS LONG AP.@inpstring = LCASE$(REMOVE$(AP.@inpstring, ANY CHR$(13, 10) + " ")) AP.@InpString2 = REMOVE$(AP.@inpstring2, CHR$(10)) FOR i = 1 TO MIN(LEN(AP.@inpstring), LEN(AP.@inpstring2)) SELECT CASE MID$(AP.@inpstring2, i, 1) CASE ".", "'", ";", ",", "#", "@", "*", "\", "/", "+", "=", "|", " ", "[", "]", "(", ")", "{", "}", "-", "_", $DQ, "%", ":" AP.@outpstring = AP.@outpstring + MID$(AP.@inpstring2, i, 1) CASE " " SELECT CASE MID$(AP.@inpstring2, i+1, 1) CASE "-", "_", "+", "=", "@", ">", "<", "#", "[", "]", "(", ")", "{", "}" IF MID$(AP.@inpstring2, i+2, 1) = " " THEN AP.@outpstring = AP.@outpstring + MID$(AP.@inpstring2, i, 3) i = i + 2 ITERATE FOR END IF AP.@outpstring = AP.@outpstring + MID$(AP.@inpstring2, i, 2) INCR i CASE ELSE AP.@outpstring = AP.@outpstring + MID$(AP.@InpString, i, 1) END SELECT CASE CHR$(13) AP.@outpstring = AP.@outpstring + CHR$(13, 10) CASE "[", "]", "(", ")", "{", "}" AP.@outpstring = AP.@outpstring + MID$(AP.@inpstring2, i, 1) CASE "A" TO "Z" AP.@outpstring = AP.@outpstring + UCASE$(MID$(AP.@inpstring, i, 1)) CASE ELSE AP.@outpstring = AP.@outpstring + MID$(AP.@inpstring, i, 1) END SELECT NEXT IF i<2 THEN EXIT FUNCTION FUNCTION = 1 END FUNCTION FUNCTION Repl (AP AS AlgoParamsType) AS LONG LOCAL buf$ LOCAL fr$ LOCAL t$ buf$ = Ap.@Datfile IF PARSECOUNT(buf$, ":")<> 2 THEN myMSGBOX hwedit, "try syntax 'fromstring:tostring'": EXIT FUNCTION fr$ = PARSE$(buf$, ":", 1) t$ = PARSE$(buf$, ":", 2) buf$ = AP.@inpstring REPLACE fr$ WITH t$ IN buf$ AP.@outpstring = buf$ FUNCTION = 1 END FUNCTION FUNCTION MakeFont(BYVAL Fnt AS STRING, BYVAL PointSize AS LONG) AS LONG LOCAL hDC AS LONG LOCAL CyPixels AS LONG hDC = GetDC(%HWND_DESKTOP) CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY) ReleaseDC %HWND_DESKTOP, hDC PointSize = (PointSize * CyPixels) \ 72 FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _ %ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _ %DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY Fnt) END FUNCTION 'EOF nettime unstable digest vol 70 Fri Oct 17 17:45:11 2003 Subject: Re: . | " || 11-10-2003-13:13 | From: "[__lo-y. ]" To: syndicate@anart.no, list@rhizome.org, _arc.hive_@lm.va.com.au, lurking editors beatrice beaubien 7-11 nettime-bold thingist florian cramer 7-11 _arc.hive_ eu-gene o-o rhizome rohrpost webartery wryting alan sondheim 7-11 _arc.hive_ poetics siratori trAce webartery wryting $Id: digestunstable.pl,v 1.13 2003/01/26 18:51:21 paragram Exp $