| Florian Cramer on Thu, 23 Oct 2003 22:04:33 +0200 (CEST) |
[Date Prev] [Date Next] [Thread Prev] [Thread Next] [Date Index] [Thread Index]
| <nettime> unstable digest vol 70 [extra issue] |
To: syndicate@anart.no, list@rhizome.org, _arc.hive_@lm.va.com.au,
From: "[__lo-y. ]" <loy@myrealbox.com>
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. ]" <loy@myrealbox.com>
To: syndicate@anart.no, list@rhizome.org, _arc.hive_@lm.va.com.au,
lurking editors
beatrice beaubien <webmaven@i2eye.com>
7-11 nettime-bold thingist
florian cramer <cantsin@zedat.fu-berlin.de>
7-11 _arc.hive_ eu-gene o-o rhizome rohrpost webartery wryting
alan sondheim <sondheim@panix.com>
7-11 _arc.hive_ poetics siratori trAce webartery wryting
$Id: digestunstable.pl,v 1.13 2003/01/26 18:51:21 paragram Exp $
# distributed via <nettime>: no commercial use without permission
# <nettime> is a moderated mailing list for net criticism,
# collaborative text filtering and cultural politics of the nets
# more info: majordomo@bbs.thing.net and "info nettime-l" in the msg body
# archive: http://www.nettime.org contact: nettime@bbs.thing.net