Greetings,

During my, often stumbling, efforts to learn how to deal with WINAPI I
have
been working on a stand alone dialog window like HexCalc.f. The code
below is
only a cutdown version of this, (adds two integers entered in two
EDITTEXT
controls) but is sufficient to demonstrate my problem. As the code
stands
it will compile a small dialog window app. and an exe -- testdlg.exe.
The
dialog can be opened interactively using the command - dlg -- and
EDITTEXT
etc. controls respond to Tab and Enter keys as I had planned. However,
when
the exe is opened, the Tab and Enter response turns into error-beeps --
can
anyone explain why?

Also, I tried to use the -APP test from CLICKS.F when processing
WM_DESTROY
but it didn't work for me - after some time playing arround opening the
exe
CtrlAltDel revealed a collection of dead testdlgs. The dev flag,
however,
seems to work.

All the best, Robin.

empty REQUIRES c:\swiftforth\src\options\DLGCLASS

0 VALUE htest

CREATE AppName Z," Test(DlgClass)"

SWITCH: dlg-messages DEFWINPROC ( -- res )

SWITCH: dlg-commands zero

:NONAME MSG LOWORD dlg-messages ; 4 CB: Rundlg

: /dlg-class ( -- hclass ) \ From HexCalc.f
   64 R-ALLOC DUP >R
      [ 0
         CS_OWNDC OR
         CS_HREDRAW OR
         CS_VREDRAW OR
      ] LITERAL !+ \ class style
      Rundlg !+ \ wndproc
      0 !+ \ class extra
      DLGWINDOWEXTRA !+ \ window extra
      HINST !+ \ hinstance
      HINST 100 LoadIcon !+ \ icon
      NULL IDC_ARROW LoadCursor !+ \ cursor
      COLOR_BTNFACE 1+ !+ \ background brush
      0 !+ \ no menu
      AppName !+ \ class name
   DROP R> RegisterClass ;

5 MODELESS AppName [WINDOW (dlg) " Dialog" 100 100 70 80
       (FONT 8, MS Sans Serif) ]
\ [control " default text" id xpos ypos xsiz ysiz ]
   [DEFPUSHBUTTON " OK" IDOK 10 5 50 15 ]
   [EDITTEXT 102 5 20 60 12 ]
   [EDITTEXT 103 5 35 60 12 ]
   [CTEXT 104 6 55 58 11 ]
   [GROUPBOX -1 5 48 60 19 ]

: dlg
   htest ?EXIT
   /dlg-class DROP
   HINST (dlg) 0 0 0 CreateDialogIndirectParam
   DUP TO htest OPENS EXIT
   DISPATCHER DROP ;

:PRUNE
   htest IF htest WM_CLOSE 0 0 SendMessage DROP THEN
   AppName HINST UnregisterClass DROP ;

: .n ( n id -- ) swap >r htest swap r> 0 SetDlgItemInt drop ;

: gocalc ( n -- )
   htest 102 0 0 GetDlgItemInt
   htest 103 0 0 GetDlgItemInt + 104 .n ;

[+SWITCH dlg-commands ( -- res )
   IDOK RUN: gocalc ;
SWITCH]

false value dev

[+SWITCH dlg-messages ( msg -- res )
   WM_CLOSE RUN: hwnd DestroyWindow drop 0 to htest 0 ;
   WM_ACTIVATE RUN: MODELESS-ACTIVATE ;
   WM_COMMAND RUN: WPARAM LOWORD dlg-commands ;
   WM_DESTROY RUN: 0 dev if exit then 0 PostQuitMessage DROP ;
SWITCH]

: WINMAIN ( -- ) dlg DISPATCHER 0 ExitProcess ; ' WINMAIN 'MAIN !

  PROGRAM testdlg true to dev

.

>From rvn_at_forth.com Mon Feb 1 06:27:21 1999
To: sftalk_at_forth.com
Message-Id: <m0000128_at_gerd.forthinc.com>
Subject: Dialog exe
From: "Rick VanNorman" <rvn_at_forth.com>
Date: Mon, 1 Feb 1999 06:27:21 -0800

>Original sender: Robin McIntosh <macro_at_ihug.co.nz>
>
>Greetings,
>
>During my, often stumbling, efforts to learn how to deal with WINAPI I
>have been working on a stand alone dialog window like HexCalc.f. The
>code below is only a cutdown version of this, (adds two integers
>entered in two EDITTEXT controls) but is sufficient to demonstrate my
>problem. As the code stands it will compile a small dialog window app.
>and an exe -- testdlg.exe. The dialog can be opened interactively using
>the command - dlg -- and EDITTEXT etc. controls respond to Tab and
>Enter keys as I had planned. However, when the exe is opened, the Tab
>and Enter response turns into error-beeps -- can anyone explain why?
>
>Also, I tried to use the -APP test from CLICKS.F when processing
>WM_DESTROY but it didn't work for me - after some time playing arround
>opening the exe CtrlAltDel revealed a collection of dead testdlgs. The
>dev flag, however, seems to work.

Robin,
First pass guess without trying to dissect your code:

The management of the tab keys etc is done by the standard dialog message
handler. During development, you were using the SwiftForth dispatch
loop (which is built into PAUSE (which is built in KEY)) which will end
up dispatching via the word IsDialogMessage api. When running stand-alone,
the message dispatcher is simply DISPATCHER which is

: DISPATCHER ( -- res )
   BEGIN
      WINMSG 0 0 0 GetMessage WHILE
      WINMSG TranslateMessage DROP
      WINMSG DispatchMessage DROP
   REPEAT WINMSG 2 CELLS + @ ( wparam) ;

and does not use IsDialogMessage. This is one of the pitfalls of the
technique of using a dialog as a main window.

This is an oversight in the hexcalc example, which I will correct
as soon as possible and post here.

Rick

.

>From mail_at_forthcad.com Mon Feb 1 19:05:17 1999
To: sftalk_at_forth.com
Message-Id: <m0000129_at_gerd.forthinc.com>
Subject: - OOF pre-final
From: ForthCAD <mail_at_forthcad.com>
Date: Mon, 1 Feb 1999 19:05:17 -0000

This is my pre-final OOF system. The final version will be send in +- 3 =
months because I think its now time to use it in reals applications to =
validate some (theorical) choises. Also I must now terminates other =
works...

The system use normals Forth definitions without any preambule nor =
postambule. So there is NO overhead on methods.=20

The overhead on data will be minimized: its just a offset calculation =
always necessary when seeking data in a buffer. (The same in any STRUCT =
systems)

Encapsulation is done by using unnnamed normal Forth wordlist.

Thanks to Will Baden: I think his proposal is very good: its a minimum =
that enable multiple models, with a very clear syntax. ( sometime I =
regret the BUILD word existence, but... )

So I hope this minimum will become near a ANSI standard extension.

Already some extra on the Yerk version are:=20

- easy to write: no multiple SELF, (ouf!)
- easy to read: same syntax as normal Forth, natural word sequence
- fastest: no pre/postambule on methods inside a class
- array of class: (I think Yerk only use "indexed objects" )
- virtual functions with constant small overhead
- true encapsulation: Yerk place all methods in the same vocabulary

(Source from here, wordset description at the bottom)
\ =
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
\ ANSI-CLASS minimum system
\ Version 0.9 - 31/01/1999
\ Author: Charles Melice
\ MAIL: mail_at_forthcad.com
\ WEB: www.forthcad.com
\ =
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D

ONLY FORTH ALSO DEFINITIONS

\ EMPTY

\ ------------------------------------------------
\ TO DEFINE IF MISSING
\ ------------------------------------------------

\ : @REL POSTPONE @ ; IMMEDIATE
\ : !REL POSTPONE ! ; IMMEDIATE
\ : ,REL POSTPONE , ; IMMEDIATE
\ +TO to replace by equivalence

\ ------------------------------------------------
\ WORDLISTS ENCAPSULATION
\ ------------------------------------------------

WORDLIST CONSTANT CLASS-WORDLIST

CLASS-WORDLIST SET-CURRENT

WORDLIST DUP CONSTANT PRIVATE-WORDLIST

FORTH-WORDLIST SWAP CLASS-WORDLIST 3 SET-ORDER

\ ------------------------------------------------
\ IMPORTANT VALUES
\ ------------------------------------------------

FORTH-WORDLIST SET-CURRENT

0 VALUE THIS \ seek the object-data base
0 VALUE ^CLASS \ seek the in-context class

\ ------------------------------------------------
\ SOME IMPLEMENTATION WORDS
\ ------------------------------------------------

PRIVATE-WORDLIST SET-CURRENT

CREATE ^PREV-ORDER 33 CELLS ALLOT
0 VALUE PREV-CURRENT

\ used later to define VIRTUAL:=20
DEFER attach-class-vtable
DEFER inherit-to-vtemp

: WID> ( class -- addr ) ; IMMEDIATE
: PARENT> ( class -- addr ) CELL+ ;
: SIZE> ( class -- addr ) CELL+ CELL+ ;
: VTABLE> ( class -- addr ) [ 3 CELLS ] LITERAL + ;

: ^SIZE ( -- addr ) ^CLASS SIZE> ;
: ^VTABLE ( -- addr ) ^CLASS VTABLE> ;
: ^PARENT ( -- addr ) ^CLASS CELL+ ;

: SaveSearchOrder ( -- )
    get-order dup \ s: widn .. wid1 n n
    ^prev-order ! \ s: widn .. wid1 n
    ^prev-order over cells + \ s: widn .. wid1 n addrmax
    swap 0 \ s: widn .. wid1 addrmax n 0
    ?DO dup >r ! r> cell- LOOP
    drop ;

: RestoreSearchOrder ( -- )
    only
    ^prev-order @ 1+ 1 \ s: n 0
    ?DO \ s: -
        i cells ^prev-order +
        @ context ! also
    LOOP
    previous ;

: AlsoClassSearchOrder ( ^class -- )
    dup parent> @rel ?dup \ have a parent ?
    IF RECURSE THEN \ yes -> SetParentClassSearchOrder
    also @ context ! ;

: SetClassSearchOrder ( -- )
    only forth
    also class-wordlist context !
    ^class AlsoClassSearchOrder ;

: ResetClassSearchOrder ( -- )
    ^class
    BEGIN \ s: -
        previous
        PARENT> @REL
        ?dup 0=3D
    UNTIL ;

: ClassView ( ^CLASS -- )
    to ^class SetClassSearchOrder ;

\ ------------------------------------------------
\ CLASS DEFINITION
\ ------------------------------------------------

FORTH-WORDLIST SET-CURRENT

: SUBCLASS ( <<name>> ^parent -- ) \ replace VOCABULARY
    wordlist=20
    create here to ^class \ S: ^parent ^wid
    , \ S: ^parent
    dup ,rel \ S: ^parent
    dup IF size> @ THEN , \ S: - PFA: <wid><parent><size>
    0 ,REL \ vtable^
    SaveSearchOrder
    get-current to prev-current
    SetClassSearchOrder
    ^class wid> @ set-current \ definitions
    inherit-to-vtemp
    DOES> ; ( -- ^CLASS )

: CLASS ( <<name>> -- )
    0 SUBCLASS ;

CLASS-WORDLIST SET-CURRENT

: END ( -- )
    attach-class-vtable
    RestoreSearchOrder
    prev-current set-current ;

\ ------------------------------------------------
\ DATA DEFINITION
\ ------------------------------------------------

CLASS-WORDLIST SET-CURRENT

: BUFFER: ( <<name>> size -- )
    create
    ^size @ ,
    ^size +!
    DOES> ( body -- offset+THIS )
        @ this + ;

: VARIABLE ( <<name>> -- ) cell BUFFER: ;

\ ------------------------------------------------
\ SPECIAL WORDLIST LOOKUP
\ ------------------------------------------------

CLASS-WORDLIST SET-CURRENT

: SUPER ( <<name>> -- )
    ^class cell+ @rel
    dup 0=3D abort" class have no parent"
    ^class >r to ^class
    previous
    '
    state @
    IF compile, ELSE execute THEN
    r> to ^class
    also ^class wid> @ context ! ;
                                IMMEDIATE

: COMMON ( <<name>> -- )
    RestoreSearchOrder
    '
    state @
    IF compile, ELSE execute THEN
    SetClassSearchOrder ;
                         IMMEDIATE

\ ------------------------------------------------
\ CLASS-OBJECTS INSTANCE
\ ------------------------------------------------

PRIVATE-WORDLIST SET-CURRENT

\ TODO: Possibles optimisations:
\ case...
\ A - data exist - size > 0
\ B - data exist with offset
\ C - virtual method exist vtable <> 0
\
\ A B C TODO:
\ -- -- -- ---------------
\ 0 0 0 compile,
\ 0 0 1 save-class compile, restore
\ 0 1 0 -
\ 0 1 1 -
\ 1 0 0 compile,
\ 1 0 1 save-class compile, restore
\ 1 1 0 save-this +to compile, restore
\ 1 1 1 save-class-this compile, restore
\

: execute-ivar ( ^obj xt -- ) \ not optimal
    ^class this 2>R
    swap
    dup @REL to ^class \ must because virtuals
    cell+ @ +to this
    execute
    2R> to this to ^class ;

: execute-ivar[] ( index ^obj xt -- ) \ not optimal
    ^class this 2>R
    swap
    dup @REL to ^class \ must because virtuals
    cell+ @ \ S: index xt offset
    rot ^size @ * + \ S: xt offset+index*size
    +to this
    execute
    2R> to this to ^class ;

: execute-iobj ( ^obj xt -- ) \ not optimal
    ^class this 2>R
    swap
    dup @REL to ^class \ must because virtuals
    cell+ to this
    execute
    2R> to this to ^class ;

: execute-iobj[] ( index ^obj xt -- )
    ^class this 2>R
    swap
    dup @REL to ^class \ must because virtuals
    cell+ rot \ S: xt ^base index=20
    ^size @ * + \ S: xt offset
    to this
    execute
    2R> to this to ^class ;

CLASS-WORDLIST SET-CURRENT

: BUILD ( <<objname>> ^CLASS -- )
    ^class >R ClassView \ set new class context
    ^size @ ^CLASS \ S: SIZE CLASS
    R> ClassView \ set original class context
    create
    ,REL ^size @ , \ PFA: <OBJCLASS><OFFSET>
    ^size +! \ S: -
    IMMEDIATE
    DOES>
        ^class >r \ save prev context
        dup @REL \ S: ^obj CLASS
        ClassView \ S: ^obj
        ' \ S: ^obj xt=20
        STATE @
        IF
            postpone 2literal
            postpone execute-ivar
        ELSE
            execute-ivar
        THEN
        r> dup to ^class
        ClassView ;

: BUILD[] ( <<objname>> count ^class -- )
    create
    dup ,REL ^size @ , \ PFA: <OBJCLASS><OFFSET>
    size> @ * ^size +! \ S: -
    IMMEDIATE
    DOES> ( index ^obj -- )
        ^class >r \ save prev context
        dup @REL \ S: index ^obj CLASS
        ClassView \ S: index ^obj
        ' \ S: index ^obj xt
        STATE @
        IF
            postpone 2literal
            postpone execute-ivar[]
        ELSE
            execute-ivar[]
        THEN
        r> dup to ^class
        ClassView ;

FORTH-WORDLIST SET-CURRENT

: BUILD ( <<objname>> ^class -- )
    create
    dup ,rel
    here swap \ S: here ^class
    size> @ dup allot \ PFA: <CLASS><..DATA..>
    0 fill \ proposal is to initialize
    IMMEDIATE
    DOES>
        SaveSearchOrder
        dup @REL \ S: ^obj CLASS
        ClassView \ S: ^obj
        ' \ S: ^obj xt
        STATE @
        IF
            postpone 2literal
            postpone execute-iobj
        ELSE
            execute-iobj
        THEN
        RestoreSearchOrder ;

: BUILD[] ( <<objname>> count ^class -- )
    create
    dup ,rel \ S: count ^class
    size> @ * \ S: count*size
    here swap \ S: here count*size
    dup allot \ PFA: <CLASS><..DATA..>
    0 fill \ proposal is to initialize
    IMMEDIATE
    DOES> ( index ^obj -- )
        SaveSearchOrder
        dup @REL \ S: index ^obj CLASS
        ClassView \ S: index ^obj
        ' \ S: index ^obj xt
        STATE @
        IF
            postpone 2literal
            postpone execute-iobj[]
        ELSE
            execute-iobj[]
        THEN
        RestoreSearchOrder ;

   =20

\ ------------------------------------------------
\ (optional) VIRTUAL: ( <<name>> -- )
\ define a virtual method
\ ------------------------------------------------

PRIVATE-WORDLIST SET-CURRENT

100 constant MAX-VIRTUAL

create vTblTemp 0 , MAX-VIRTUAL 2* cells allot

: virt-count ( -- addr )
    ^VTABLE @REL ;

: vtable[] ( n -- addr )
    2* 1+ cells virt-count + ;

:noname [ IS inherit-to-vtemp ] ( -- )
    0 vTblTemp !
    ^parent @REL
    IF
        ^class >r
        ^parent @REL to ^class
        ^vtable @REL
        IF
            virt-count @ vTblTemp !
            vTblTemp cell+
            virt-count @ 0
            ?DO
                i vtable[] @REL over !REL
                cell+
                i vtable[] cell+ @REL over !REL
                cell+
            LOOP
            drop
         THEN
         r> to ^class
    THEN
    vTblTemp ^vtable !REL ;

:noname [ IS attach-class-vtable ] ( -- )
    virt-count @
    IF
        here
        virt-count dup @ \ S: body addr count
        dup , 0 \ S: body addr count 0
        ?DO \ S: body addr
            cell+ dup @REL ,REL
            cell+ dup @REL ,REL
        LOOP
        drop
        ^vtable !REL
     ELSE
        0 ^vtable !REL
     THEN ;
           =20

: in-vtable ( body^ -- pos true | false )
    virt-count @ 0
    ?DO
        i vtable[] cell+ @REL over =3D
        IF drop i TRUE unloop EXIT THEN
    LOOP
    drop FALSE ;

: append-to-vtable ( body^ -- n )
    \ later, we should use allocate/resize
    virt-count @
    dup MAX-VIRTUAL >=3D abort" virtual table overflow - see =
MAX-VIRTUAL"

    vtable[] cell+ !REL
    virt-count @
    dup 1+ virt-count ! ;

: CreateVirtual: ( <<method>> -- vn )
    Create here \ S: bod
    append-to-vtable \ S: vn
    dup 2* 1+ cells , \ S: byte-offset
                            \ offset in bytes to speed-up
    DOES> \ TODO: better optimisation
        @ ^vtable @REL + \ this is the virtual overhead
        @REL execute ;=20

\ ------------------------------------------------
\ Extra words - not defined in ANSI proposal
\ ------------------------------------------------

CLASS-WORDLIST SET-CURRENT

: VIRTUAL: ( <<name>> -- )
>IN @
    bl word find
    IF \ S: in^ xt
>body in-vtable
        IF
            nip \ S: vn
        ELSE
>IN !
            CreateVirtual: \ S: vn
        THEN
    ELSE \ S: in^ cstr
        drop >IN ! \ S: -
        CreateVirtual: \ S: vn
    THEN
    :noname swap \ S: xt vn
    vtable[] !REL ;
       =20

FORTH-WORDLIST SET-CURRENT

: >THIS ( ^object -- ^membase ) \ usage ' obj >this
>body cell+ ;

: >CLASS ( ^object -- ^class ) \ usage ' obj >class
>body @REL ;

: USER> ( ^class -- addr ) \ ' obj >class user> @
    [ 4 CELLS ] LITERAL + ;

: NEW ( ^class -- ^obj )
    dup SIZE> @ cell+
    allocate abort" memory allocation error"
    swap over !REL ;

: NEW[] ( count ^class -- ^obj )
    dup SIZE> @ rot * cell+
    allocate abort" memory allocation error"
    swap over !REL ;

\ FREE DROP can be used - so no collision with RELEASE

: ->" ( <<obj]>> <<method>> -- )
    [char] " word count evaluate
    ^class >R
    dup @REL to ^class \ S: ^obj
    ^class AlsoClassSearchOrder
    ' \ S: ^obj xt
    state @
    IF
        postpone 2literal
        postpone execute-iobj
    ELSE
        execute-iobj
    THEN
    ResetClassSearchOrder
    R> to ^class ;
                    IMMEDIATE

: []->" ( index <<obj]>> <<method>> -- )
    [char] " word count evaluate
    ^class >R
    dup @REL to ^class \ S: index ^obj
    ^class AlsoClassSearchOrder
    ' \ S: index ^obj xt
    state @
    IF
        postpone literal
        postpone execute-iobj[]
    ELSE
        execute-iobj[]
    THEN
    ResetClassSearchOrder
    R> to ^class ;
                    IMMEDIATE

: .CLASSINFO ( ^class -- )
    SaveSearchOrder
    cr 0 >r
    BEGIN
        dup body> >name count
        swap over cr r@ spaces type cr
        r@ spaces 0 ?DO [char] - emit LOOP
        dup wid> @ context !
        cr r@ spaces words cr
        parent> @rel ?dup 0=3D
        r> 3 + >r=20
    UNTIL
    r> drop
    RestoreSearchOrder ;

: SIZEOF ( ^class -- size )
    size> @ ;

ONLY FORTH ALSO DEFINITIONS

\ ------------------------------------------------
\ SOURCE END
\ ------------------------------------------------

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3DWil Baden ANSI Class wordset =
proposal=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D

CLASS
    CLASS class
    Construct a class.
    A class is a defining word for a collection of future definitions.

SUBCLASS
    class SUBCLASS classname
    Construct an extension or specialization of a class.

VARIABLE WITHIN A CLASS
    VARIABLE membername
    Define a variable member of a class.

BUFFER: WITHIN A CLASS
    n CHARS BUFFER: membername
    n CELLS BUFFER: membername
    Define a data area member of a class.

CONSTANT WITHIN A CLASS
    n CONSTANT membername
    Define a constant member of a class.

: WITHIN A CLASS
    : membername ... ;
    Define a function member of a class.

; WITHIN A CLASS
    : membername ... ;
    Terminate the definition of a function member of a class.

END WITHIN A CLASS
    END
    Terminate the construction of a class.

BUILD
    class BUILD objectname
    Build object objectname as an instance of class .
    Objects are used object member .

COMMON WITHIN A CLASS
    COMMON forthword
    Compile forthword from standard dictionary.

SUPER WITHIN A CLASS
    SUPER member
    Compile a member, beginning lookup for it in the superclass.
    This disambiguates members with the same name.

=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3DMy extension in the above =
 object base memory adress.

^CLASS
    This value return the context class body adress.

.
Received on Mon Feb 01 1999 - 19:48:31 PST