include "hlxdll.inc"

GLOBAL PREDICATES
  unsigned srch_ch(string STR,char CH) -(i,i) language asm

  str_wrap(string Text,unsigned MaxLen,char Newline,string TxBuf) -(i,i,i,i) language asm

  str_wrap3(string Text,unsigned MaxLen,string TxBuf) -(i,i,i) language asm

  lowup_ctb(string) -(o) language c

  uplow_ctb(string) -(o) language c

  grk_win_ctb(string) -(o) language c

  grk_dos_ctb(string) -(o) language c

  nonalf_ctb(string) -(o) language c

  grk_upper(STRING) -(i) language asm

  grk_lower(STRING) -(i) language asm

  grk_winify(STRING) -(i) language asm

  grk_dosify(STRING) -(i) language asm

  ctb_xlat(STRING,string) -(i,i) language asm

  ctb_set(string,STRING,STRING) -(i,i,i) language asm

  ctb_init(string) -(i) language asm

  unsigned ctb_search(string,STRING,CHAR) -(i,i,i) language asm

  ctb_del(STRING,STRING,CHAR) -(i,i,i) language asm

  ctb_del2(STRING,STRING,CHAR,CHAR) -(i,i,i,i) language asm

  del_ch(STRING,CHAR) -(i,i) language asm

  subst_ch(STRING,CHAR,CHAR) -(i,i,i) language asm

  unsigned count_chars(STRING,CHAR,unsigned) -(i,i,i) language asm

GLOBAL PREDICATES
 PROCEDURE unsigned search_ch(string STR,char CH) -(i,i) language stdcall

 PROCEDURE unsigned count_ch(string STR,char CH,unsigned Len) -(i,i,i) language stdcall

% the one below tests how "newly-allocated PDC strings" can pass into DLLs
 PROCEDURE string concatx(string S1,string S2) -(i,i) language stdcall

 PROCEDURE string del_char(string STR,char CH) -(i,i) language stdcall

 PROCEDURE string ctb_xlatx(string STR,string CTB) -(i,i) language stdcall

 PROCEDURE movstr(string Source,string Dest, UNSIGNED Len) -( i, i, i )
        language c as "_MEM_MovMem"

 procedure unsigned srchchar(string Source,char Char) -(i,i) language stdcall

 procedure string set_str_pos(string STR,unsigned POS,char Ch) -(i,i,i) language stdcall

 procedure MEM_MovMem(string Source,string Destination,unsigned Length) -(i,i,i) language c

 procedure STACKMARK dll_mark_gstack   language stdcall

 procedure dll_release_gstack(STACKMARK) - (i) language stdcall

 procedure string upxstr(string In) - (i) language stdcall

 procedure integer add_ints(integer X,integer Y) - (i,i) language stdcall

 procedure string ctb_def(integer N) -(i) language stdcall

 procedure string ctb_delx(string CTB,string S,char Ch) -(i,i,i) language stdcall

 procedure unsigned ctb_srch(string CTB,string S,char Ch) -(i,i,i) language stdcall

 procedure string cut_atchar(string STR,char CHAR) -(i,i) language stdcall

 procedure string cut_atchar2(string STR,char CHAR,string S2x) -(i,i,o) language stdcall

 procedure string subst_substr(string S1,string S2,string S3) -(i,i,i) language stdcall

 procedure unsigned next_nonalf(string STR) -(i) language stdcall

 procedure unsigned next_alf(string STR) -(i) language stdcall

 procedure string get_wordsep(string STR,char CHsep) -(i,i) language stdcall

 procedure string get_words(string STR) -(i) language stdcall

 procedure string wrap_str(string Text,unsigned MaxLineLen,char CHsep) -(i,i,i) language stdcall

 procedure string wrap_text(string Text,unsigned MaxLineLen) -(i,i) language stdcall

 procedure string subst_char(string Text,char Old,char New) -(i,i,i) language stdcall

 procedure concx(string S1,string S2,string Sx) -(i,i,o) language stdcall

 procedure setstring(string S) -(i) language stdcall

 procedure delstring(string S) -(i) language stdcall

 procedure string getstring language stdcall
 

DATABASE - dll_database
  s(string)

CLAUSES
  setstring(In):- assert(s(In)).

  getString(String):- s(String), !; String="".

  delstring(S):- retract(s(S)), !; bound(S).

/*
  Important note:
  getString should be surrounded in calling program in following way:
  dll_mark_gstack(Stack)
  getString(String)
  [saving String in variable of calling program]
  dll_release_gstack(Stack)
*/

 concatx(S1,S2,Sx):- concat(S1,S2,Sx), !.

 concx(S1,S2,Sx):- concat(S1,S2,Sx), !.

 subst_char(Tx,Ch1,Chnew,Txout):- subst_ch(Tx,Ch1,Chnew), Txout = Tx, !
   ;
   Txout=Tx.

 wrap_text(Text,MaxLineLen,TextX):-
   str_wrap3(Text,MaxLineLen,Text), TextX = Text, !
   ;
   TextX = Text, bound(MaxLineLen), !.

 wrap_str(Text,MaxLineLen,CHsep,TextX):-
   str_wrap(Text,MaxLineLen,CHsep,Text), TextX = Text, !
   ;
   TextX = Text, bound(MaxLineLen), !.

 get_wordsep(Text,SepC,WordsX):- nonalf_ctb(CTB),
   ctb_del2(CTB,Text,' ',SepC), WordsX = Text, !;
   Wordsx="", !.

 count_ch(S,Ch,Len,Nx):- N = count_chars(S,Ch,Len), Nx=N, !;
   Nx=0, bound(S), bound(Ch), bound(Len), !.

 get_words(Text,WordsX):- nonalf_ctb(CTB),
   ctb_del2(CTB,Text,' ','\13'), WordsX = Text, !;
  Wordsx="", !.

 ctb_xlatx(CTB,Str,Sx):- ctb_xlat(Str,CTB), Sx=Str,!; Sx=Str.

 ctb_def(N,CTBx):- N=1, lowup_ctb(B), CTBx=B, !
   ;
 N=2, uplow_ctb(B), CTBx=B, !
 ;
 N=3, grk_win_ctb(B), CTBx=B, !
 ;
 N=4, grk_dos_ctb(B), CTBx=B, !
 ;
 N=5, nonalf_ctb(B), CTBx=B, !
 ;
 str_len(S,256), bound(N), CTBx=S, !.

 del_char(STR,Ch,Sx):- del_ch(STR,Ch), Sx=STR, !;Sx=STR.

 ctb_delx(CTB,STR,Ch,Sx):- ctb_del(CTB,STR,Ch), Sx=STR, !; Sx=STR.

 ctb_srch(CTB,STR,Ch,Px):- Px=ctb_search(CTB,STR,Ch), !.

 next_nonalf(STR,Px):- nonalf_ctb(CTB), ctb_xlat(CTB,STR),
   searchchar(STR,' ',P), Px=P, !; Px=0.

 next_alf(STR,Px):- nonalf_ctb(CTB), ctb_xlat(CTB,STR),
   searchchar(STR,'@',P), Px=P, !; Px=0.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% cut_atchar/4 splits an input-string(arg1) into a leftward(=arg3)
% and rightward(=arg4) substrings around a "separator char"(=arg2)
%
%% This predicate was optimised (as regards memory usage) by using
%% PDC-specific predicate "ptr_dword/3" to create string-addresses
%% which do NOT waste memory by creating "new copies" of the input
%% string for further (recursive) processing. (Such memory-wastage
%% is implicit within PDC's "frontchar/3", "frontstr/4" etc, since
%% in the most general case "fresh copies of strings" ARE required
%% (when passing strings as output-arguments). But in many special
%% instances no fresh strings are needed; in such cases, use THIS:

PREDICATES
 subst_substr4(STRING,STRING,STRING,unsigned)

CLAUSES
 subst_substr(Str,Sub,New,Sx):- str_len(Sub,L), str_len(New,L2), L2=L,
   subst_substr4(Str,Sub,New,L), Sx=Str, !
   ;
   Sx=Str, bound(Sub), bound(New).

 subst_substr4(STR,Sub,NewSub,Len):-
   searchstring(STR,Sub,P), ptr_dword(STR,Seg,Off),
   OffP = Off+P-1, ptr_dword(S2,Seg,OffP), movstr(NewSub,S2,Len),
   Offx=OffP+Len+1, ptr_dword(STR2,Seg,Offx),
   !, subst_substr4(STR2,Sub,NewSub,Len).
 subst_substr4(_,_,_,_):- !.

/*
 cut_atchar(S,Sep,S1x,S2x):- searchchar(S,Sep,P), P>0, P1 = P-1,
 substring(S,1,P1,S1x), ptr_dword(S,Seg,Offset),
 Offset2 = Offset+P, ptr_dword(S2x,Seg,Offset2), !.
 cut_atchar(S,_,S,""):- !.
*/
 cut_atchar(S,Sep,S2x):- searchchar(S,Sep,P), P>0, %P1 = P-1,
 ptr_dword(S,Seg,Offset),
 Offset2 = Offset+P, ptr_dword(S2x,Seg,Offset2), !
 ;
 S2x = S, !.

 cut_atchar2(S,Sep,S1x,S2x):- searchchar(S,Sep,P), P>0,
 ptr_dword(S,Seg,Offset), Offset1 = Offset+P-1,
 membyte(Seg,Offset1,0), S1x = S,
 Offset2 = Offset+P, ptr_dword(S2x,Seg,Offset2), !
 ;
 S1x = "", S2x=S, !.

/* OK:
  upxstr(S,Sx):- upper_lower(Us,S), str_len(S,L), mem_MovMem(Us,S,L),
   Sx=S, !.
*/

  upxstr(S,Sx):- grk_lower(S), Sx=S, !; Sx=S.

  srchchar(Str,Ch,Px):- searchchar(Str,Ch,Px), !; Px=0.

  add_ints(A,B,X):- X = A+B.

  dll_mark_gstack(STACKMARK):- STACKMARK=mem_MarkGStack().

  dll_release_gstack(STACKMARK):-mem_ReleaseGStack(STACKMARK).

  set_str_pos(S,P,Ch,Sx):- ptr_dword(S,Seg,Off),
   Off2 = Off+P-1, membyte(Seg,Off2,Ch), Sx=S, !.

  search_ch(Str,Ch,Posx):- Posx = srch_ch(Str,Ch), !; Posx=0.

/*
  Important note:
  getString should be surrounded in calling program in following way:
  dll_mark_gstack(Stack)
  getstring(String)
  [saving String in variable of calling program]
  dll_release_gstack(Stack)
*/

GOAL
  true.
 

• Download your own copy of a Visual Prolog DLL (full of Optimised ASM- goodies!)
• Write your own 32-bit DLL (using Visual Prolog 5.* and TASM Assembler 4.*+) 
• Learn how to use LPA Prolog's gfx-grafics to make more flexible Windows-menus