FPMATH questions

I have modified the file GIBBS.F and am having problems using
FPMATH functions to calculate points. Please excuse attaching the
whole file below.

xcal and ycal works fine; (used in PutPts)
xcalc and ycalc using FPMATH for the same thing causes GO to choke.
I need to redefine xcal and ycal requiring arcsin (fasin), hence the
attempt to use FPMATH.

PutPts, and polyline, run fine from the command line, using xcalc and
ycalc, with suitable arguments

There was a post that mentioned <<F<F>> pairs, and /NDP; I haven't
digested it.

Any suggestions anyone?
Thanks, Anil

*****************************************************************

ONLY FORTH ALSO DEFINITIONS DECIMAL
requires fpmath

\ Window creation.

CREATE AppName ,Z" HILLSIDE"

[SWITCH HillMsgs DEFWINPROC ( -- res )
      \ other code added later
SWITCH]

:NONAME MSG LOWORD HillMsgs ; 4 CB: WNDPROC

: MYWINDOW ( -- hwnd )
      0 \ extended style
      AppName \ window class name
      Z" Hillside Points Generator" \ caption
      WS_OVERLAPPEDWINDOW \ window style
      CW_USEDEFAULT \ initial x position
      CW_USEDEFAULT \ y
      CW_USEDEFAULT \ x size
      CW_USEDEFAULT \ y
      0 \ parent window handle
      0 \ window menu handle
      HINST \ program instance handle
      0 \ creation parameter
   CreateWindowEx ;

{ --------------------------------------------------------------------
 application specific CODE here.
---------------------------------------------------------------------- }

0 VALUE hwndHL
0 VALUE SW-hDC
1000 CONSTANT NUM
NUM 1+ CONSTANT NUM'

VARIABLE ns
0 VALUE wx
0 VALUE wy
0 value pr \ pipe rad

CREATE &ps 64 allot \ paintstruct
CREATE &pts NUM' 2* CELLS ALLOT

4 IMPORT: MoveToEx
3 IMPORT: LineTo
3 IMPORT: Polyline

CODE fF0 ( NDP: -- r )
    FLDZ RET END-CODE

CODE fFPI ( NDP: -- r )
    FLDPI RET END-CODE

CODE fF* ( NDP: r1 r2 -- r )
    FMULP RET END-CODE

CODE fF+ ( NDP: r1 r2 -- r )
    FADDP RET END-CODE

CODE fF/ ( NDP: r1 r2 -- r )
    fdivp RET END-CODE

CODE fFSIN ( NDP: r -- r )
    fsin RET END-CODE

CODE fFCOS ( NDP: r -- r )
    fcos RET END-CODE

CODE fS>F ( n -- ) ( N: -- r )
    0 [EBP] EBX XCHG 0 [EBP] DWORD FILD 4 # EBP ADD
    RET END-CODE

CODE fF>S ( -- n) ( N: r -- )
   4 # EBP SUB 0 [EBP] DWORD FISTP 0 [EBP] EBX XCHG RET END-CODE

: xcal 2* fS>F fFPI fF* ns @ fS>F fF/ fFCOS pr fS>F fF* fF>S wx 2/ + ;
: ycal 2* fS>F fFPI fF* ns @ fS>F fF/ fFSIN pr fS>F fF* fF>S wy 2/ + ;

: xcalc ( i-- n) 2* S>F PI F* ns @ S>F F/ FCOS pr S>F F* F>S wx 2/ + ;
: ycalc ( i-- n) 2* S>F PI F* ns @ S>F F/ FSIN pr S>F F* F>S wy 2/ + ;

: PutPts ( --- ) ns @ 1+
    0 do i xcal i 2* cells &pts + !
         i ycal i 2* cells &pts + cell+ !
      loop ;

[+SWITCH HillMsgs
   WM_CREATE RUN: 10 ns ! ;

   WM_SIZE RUN: LPARAM HILO TO wx To wy
                           wx 2/ 2/ to pr 0 ;

   WM_PAINT RUN: HWND &ps BeginPaint to SW-hDC
                           SW-hDC 0 wy 2 / NULL MoveToEx DROP
                           SW-hDC wx wy 2 / LineTo DROP
                           PutPts
                           SW-hDC &pts ns @ 1+ Polyline DROP
                           HWND &ps EndPaint
                           0 ;

   WM_DESTROY RUN: 0 PostQuitMessage ;
SWITCH]

{ == An example of a modless dialog.== }

DIALOG SetN
[MODELESS " Set No. of Points " 0 160 160 70
   (FONT 8, Fixedsys) ]
   [DEFPUSHBUTTON " OK" IDOK 130 20 20 15 ]
   [RTEXT 101 125 05 18 10 ]
   [LTEXT " Number of points around hole: "
                                       102 05 05 120 10 ]
   [PUSHBUTTON " Add 1" 103 05 20 30 15 ]
   [PUSHBUTTON " Add 10" 104 40 20 30 15 ]

   [PUSHBUTTON " Sub 1" 106 05 40 30 15 ]
   [PUSHBUTTON " Sub 10" 107 40 40 30 15 ]
END-DIALOG

0 VALUE hDlgModeless
: Hill-DONE ( -- res )
   SetN CELL- OFF
   hDlgModeless DestroyWindow DROP
   0 TO hDlgModeless ;

: Hill-ACTIVATE ( -- )
   WPARAM $FFFF AND IF hwndHL ELSE 0 THEN DLGACTIVE ! ;

: .ns ( -- )
   HWND 101 ns @ 0 SetDlgItemInt DROP ;

: REDO ( -- )
    hwndHL DUP 0 1 InvalidateRect DROP
    UpdateWindow DROP 0 ;

: INCR ( +n -- )
    ns DUP @ ROT + 50 MIN SWAP ! .ns REDO ;

: DECR ( +n -- )
    ns DUP @ ROT - 1 MAX SWAP ! .ns REDO ;

[SWITCH Hill-COMMANDS ZERO
   IDOK RUN: ( -- res ) DROP Hill-DONE ;
   IDCANCEL RUN: ( -- res ) DROP Hill-DONE ;

   103 RUN: ( -- res ) 1 INCR ;
   104 RUN: ( -- res ) 10 INCR ;
   106 RUN: ( -- res ) 1 DECR ;
   107 RUN: ( -- res ) 10 DECR ;
SWITCH]

[SWITCH Hill-Messages ZERO
   WM_CLOSE RUNS Hill-DONE
   WM_INITDIALOG RUN: ( -- res ) 10 ns ! .ns -1 ;
   WM_COMMAND RUN: ( -- res ) WPARAM $FFFF AND Hill-COMMANDS ;
   WM_ACTIVATE RUN: ( -- res ) Hill-ACTIVATE 0 ;
SWITCH]

:NONAME ( -- res ) MSG $FFFF AND Hill-Messages ; 4 CB: RUNHill

: SetNodlg
   HINST SetN hwndHL RUNHill 0
   CreateDialogIndirectParam TO hDlgModeless DUP
   SetN CELL- !
   hDlgModeless SW_SHOW ShowWindow DROP ;

\ ************************************************************************

CREATE &MSG ( -- addr ) 7 CELLS ALLOT

: DLG-MSGLOOP ( -- res )
    BEGIN
        &MSG 0 0 0 GetMessage
    WHILE
        hDlgModeless 0=
        hDlgModeless &MSG IsDialogMessage 0= OR
        IF
            &MSG TranslateMessage DROP
            &MSG DispatchMessage DROP
        THEN
    REPEAT
        &MSG 2 CELLS + @ ( wparam) LOWORD ;

-? : GO
    AppName WNDPROC DefaultClass DROP MYWINDOW TO hwndHL
    hwndHL DUP SW_SHOWDEFAULT ShowWindow DROP
    UpdateWindow DROP SetNodlg
    DLG-MSGLOOP DROP ;

: WINMAIN ( -- )
   GO 0 ExitProcess ;

 \ ' WINMAIN 'MAIN !
 \ -1 THRESHOLD ( do not save xref)
 \ PROGRAM hill
 \ BYE

CR
CR .( Type GO to run the demo.)
CR
----------------------------------------------------------------------
sftalk_at_forth.com The SwiftForth programming discussion email list
To unsubscribe, send subject "unsubscribe" to sftalk-request_at_forth.com
For list command help, send subject "help" to sftalk-request_at_forth.com
Message archives are located at http://www.forth.com/archive/sftalk
----------------------------------------------------------------------
This list is a forum for SwiftForth users. For product support and bug
reports, please send email to support_at_forth.com
----------------------------------------------------------------------
Received on Thu Jul 13 2006 - 08:52:38 PDT