(setq standalone t)
(readlsp "\\tools\\lisp\\inc\\winini.lsp")
(readlsp "\\tools\\lisp\\inc\\winuser.lsp")
(readlsp "\\tools\\lisp\\inc\\wingdi.lsp")
(readlsp "\\tools\\lisp\\inc\\kernel32.lsp")
(readlsp "\\tools\\lisp\\inc\\gdi32.lsp")
(readlsp "\\tools\\lisp\\inc\\user32.lsp")
(cond ((nilp _add) (setq _add add)))
(cond ((nilp _sub) (setq _sub sub)))
(cond ((nilp _mul) (setq _mul mul)))
(cond ((nilp _div) (setq _div div)))
(cond ((nilp _sin) (setq _sin sin)))
(cond ((nilp _cos) (setq _cos cos)))
(cond ((nilp _mod) (setq _mod mod)))



(qsetq "HelpNew" "Type in the name of your new button <cr> to finish, or hit <esc> to cancel")
(qsetq "HelpRename" "Type in the new name of the button, hit <cr> to finish")
(qsetq "HelpMove" "Use the arrow keys to move the button, hit <cr> or left mouseclick to finish")
(qsetq "HelpCopy" "Use the arrow keys to move the button, hit <cr> or left mouseclick to finish")
(qsetq "Helpmovecopydelete" "Click on the move, the copy, the rename, or the delete button")

(de helpstr (x)
   (eval (strcat '"Help" x))
)

(de packlong (lw hw)
    (_add lw (mul 65536 hw))
)
(de lowword (w)
    (mod w 65536)
)
(de highword (w)
    (_div w 65536)
)

(de reverse (x)
    (cond  
        ((not (is_list x)) x)
        ((cdr x) 
            (nonc (reverse (cdr x)) (list (reverse (car x))))
        )
        (t 
            (cond
                ((is_list (car x))
                    (list (reverse (car x)))
                )
                (t (list (car x)))
            )
        )
    )
)

(de maplist (x fn)
    (cond
        ((cdr x) (concons (fn (car x)) (maplist (cdr x) fn)))
        (t (list (fn (car x))))
    )
)

(de for (x ifn)
    (while x
        (ifn (car x))
        (setq x (cdr x))
    )
)

(de forpair (x y ifn)
    (cond  
        ((and (cdr x) (cdr y))
            (ifn (car x) (car y)) (forpair (cdr x) (cdr y) ifn))
        (t
            (ifn (car x) (car y))
        )
    )
)

(de forlist (_forlist_x ifn ret)
    (while _forlist_x
        (cond  
            (ret (nonc ret (list (ifn (car _forlist_x)))))
            (t (setq ret (list (ifn (car _forlist_x)))))
        )
        (setq _forlist_x (cdr _forlist_x))
    )
    ret
)



(de lbsethscroll (hwndlist item hwnd lpSize hdc)
    (setq item (sendmessageandwait hwndlist LB_GETCURSEL 0 0))
    (setq item (sendmessage hwndlist LB_GETTEXT item nil))
    (setq hdc (GetDC hwndlist))
    (setq lpSize (new 8))
    (GetTextExtentPoint32 hdc item (strlen item) lpSize)
    (sendmessageandwait hwndlist LB_SETHORIZONTALEXTENT (_add (deref lpSize 4) 8) 0)
    (delete lpSize)
    (setq lpSize nil)
    (ReleaseDC hwnd hdc)
)


(de deletewindow (hwndchild)
    (sendmessageandwait hwndchild WM_CLOSE 0 0)
)

(de unmovecopydelete (x)
    (deletewindow hmove)
    (deletewindow hcopy)
    (deletewindow hdelete)
    (deletewindow hrename)
    (poplist)
)

(de unmovecopydelete1 (x)
    (DestroyMenu hmenupopup)
    (DestroyMenu hmenubutton)
)

(de Move (x) 
    (unmovecopydelete)
    (setq state '"Move")
    (pushlist (helpstr state))
)

(de Copy (x) 
    (setq lastx (_add lastx 25) lasty (_add lasty 25))
    (setq x (createwindow hwnd '"TimCButton"  
        (strcat (sendmessage lastbutton WM_GETTEXT 20 nil) "'")
        (bitor BS_PUSHBUTTON WS_CHILD WS_VISIBLE WS_THICKFRAME WS_TABSTOP)
           lastx lasty 50 25))
    (setq lastbutton x)
    (unmovecopydelete)
    (setq state '"Copy")
    (pushlist (helpstr state))
)

(de Delete (x) 
    (sendmessageandwait lastbutton WM_CLOSE 0 0)
    (setq state nil) 
    (unmovecopydelete)
)

(de Rename (x) 
    (cond 
        (inplayback
            (sendmessageandwait lastbutton WM_SETTEXT 0 x)
            (set (quality x '"hwnd") lastbutton)
            (unmovecopydelete)
            (setq state '"Rename") 
            (pushlist (helpstr state))
        )
        (t
            (sendmessageandwait lastbutton WM_SETTEXT 0 (chr 0))
            (unmovecopydelete)
            (setq state '"Rename") 
            (pushlist (helpstr state))
        )
    )
)

(qsetq "Move" (Move))
(qsetq "Copy" (Copy))
(qsetq "Delete" (Delete))
(qsetq "Rename" (Rename))

(de movecopydelete1 (hwndchild x y)
    (setq hmenubutton (CreateMenu))
    (setq hmenupopup (CreateMenu))
    (AppendMenu hmenupopup MF_STRING 0 "&Move")
    (AppendMenu hmenupopup MF_STRING 1 "&Copy")
    (AppendMenu hmenupopup MF_STRING 2 "&Delete")
    (AppendMenu hmenupopup MF_STRING 3 "&Rename")
    (AppendMenu hmenubutton MF_POPUP hmenupopup "foo")
    (SetMenu hwndchild hmenubutton)
)

(de position (hwndchild)
    (sendmessageandwait hwnd WM_MYSETLEFT lastx hwndchild)
    (sendmessageandwait hwnd WM_MYSETTOP lasty hwndchild)
    (sendmessageandwait hwnd WM_MYSETRIGHT (_add lastx lastdx) hwndchild)
    (sendmessageandwait hwnd WM_MYSETBOTTOM (_add lasty lastdy) hwndchild)
)

(de moveleft (hwndchild)
    (cond (inplayback  (setq hwndchild lastbutton)))
    (setq lastx (_sub lastx 1))
    (cond ((lt lastx 0) (setq lastx 0)))
    (position hwndchild)
)

(de moveup (hwndchild)
    (cond (inplayback  (setq hwndchild lastbutton)))
    (setq lasty (_sub lasty 1))
    (cond ((lt lasty 0) (setq lasty 0)))
    (position hwndchild)
)

(de moveright (hwndchild)
    (cond (inplayback  (setq hwndchild lastbutton)))
    (setq lastx (_add lastx 1))
    (position hwndchild)
)

(de movedown (hwndchild)
    (cond (inplayback  (setq hwndchild lastbutton)))
    (setq lasty (_add lasty 1))
    (position hwndchild)
)

(de movecopydelete (hwndchild x y)
    (setq state '"movecopydelete")
    (setq lastx (sendmessageandwait hwnd WM_MYGETLEFT 0 hwndchild))
    (setq lasty (sendmessageandwait hwnd WM_MYGETTOP 0 hwndchild))
    (setq lastdx (_sub (sendmessageandwait hwnd WM_MYGETRIGHT 0 hwndchild) lastx))
    (setq lastdy (_sub (sendmessageandwait hwnd WM_MYGETBOTTOM 0 hwndchild) lasty))

    (setq lastbutton hwndchild)

    (setq hmove (createwindow hwnd '"TimCButton"  '"Move" 
        (bitor BS_PUSHBUTTON WS_CHILD WS_VISIBLE WS_THICKFRAME WS_TABSTOP) 
           (add lastx 25) (add lasty 25) 80 25 t))
    (setq hcopy (createwindow hwnd '"TimCButton"  '"Copy" 
        (bitor BS_PUSHBUTTON WS_CHILD WS_VISIBLE WS_THICKFRAME WS_TABSTOP) 
           (add lastx 25) (add lasty 50) 80 25 t))
    (setq hdelete (createwindow hwnd '"TimCButton"  '"Delete" 
        (bitor BS_PUSHBUTTON WS_CHILD WS_VISIBLE WS_THICKFRAME WS_TABSTOP) 
           (add lastx 25) (add lasty 75) 80 25 t))
    (setq hrename (createwindow hwnd '"TimCButton"  '"Rename" 
        (bitor BS_PUSHBUTTON WS_CHILD WS_VISIBLE WS_THICKFRAME WS_TABSTOP) 
           (add lastx 25) (add lasty 100) 80 25 t))
    (pushlist (helpstr "movecopydelete"))
)

(de newbutton (hwnd lparm lastx lasty)

    (setq lastx (lowword lparm))
    (setq lasty (highword lparm))
    (setq lastbutton (createwindow hwnd '"TimCButton"  (chr 0)
        (bitor BS_PUSHBUTTON WS_CHILD WS_VISIBLE WS_THICKFRAME WS_TABSTOP) 
           (_add lastx 25) (_add lasty 25) 80 25))
    (setq state '"New")
    (pushlist (helpstr state))
)

(de replay (xlist)
    (print "xlist=" xlist)
    (while xlist
        (eval (eval (car xlist)))
        (setq xlist (cdr xlist))
    )
)

(de wm_char_func (hwndchild message wparm lparm)
    (iasgn kbdmousebuffer 4 WM_CHAR)
    (iasgn (add kbdmousebuffer 4) 4 wparm)
    (iasgn (add kbdmousebuffer 8) 4 lparm)
    (writefile hkm nil kbdmousebuffer 16)
    t
)

(de wm_mousemove_func (hwndchild message wparm lparm)
    (setq gx (lowword lparm))
    (setq gy (highword lparm))
    (iasgn kbdmousebuffer 4 WM_MOUSEMOVE)
    (iasgn (add kbdmousebuffer 8) 4 gx)
    (iasgn (add kbdmousebuffer 12) 4 gy)
    (writefile hkm nil kbdmousebuffer 16)
    t
)

(de wm_timer_func (hwndchild message wparm lparm)
    (cond
        ((lt wparm (array timers))
            (setq fn (eval (string_to_atom (array timers wparm))))
            (fn)
        )
    )
)

(de wm_command_func (hwndchild message wparm lparm)
    (cond 
        ((and (gt wparm 0) (le wparm 1000))
            (setq keyhit (sendmessage (invidind lparm) WM_GETTEXT 20 nil))
            (cond
                ((and (eqv recordstate '"recording") 
                      (nilp (eqv keyhit '"StopRecording")))
                    (cond 
                        (inputtingchars
                            (setq lastfn (nonc lastfn 
                                (list (list 'bldstr (toplist))))
                            )
                            (setq lastfn (nonc lastfn 
                                (list (list 'enter)))
                            )
                        )
                    )
                    (setq lastfn (nonc lastfn (list keyhit)))
                )
            )
            (eval (eval keyhit))
            (setq inputtingchars nil)
        )
    )
    t
)

(de wm_rbuttonup_func (hwndchild message wparm lparm)
    (iasgn kbdmousebuffer 4 WM_RBUTTONUP)
    (iasgn (add kbdmousebuffer 4) 4 wparm)
    (iasgn (add kbdmousebuffer 8) 4 gx)
    (iasgn (add kbdmousebuffer 12) 4 gy)
    (writefile hkm nil kbdmousebuffer 4)
    t
)

(de wm_lbuttonup_func (hwndchild message wparm lparm)
    (iasgn kbdmousebuffer 4 WM_LBUTTONUP)
    (iasgn (add kbdmousebuffer 4) 4 wparm)
    (iasgn (add kbdmousebuffer 8) 4 gx)
    (iasgn (add kbdmousebuffer 12) 4 gy)
    t
)

(de wm_lbuttondblclk_func (hwndchild message wparm lparm x item place prex preitem)
    (iasgn kbdmousebuffer 4 WM_LBUTTONDBLCLK)
    (iasgn (add kbdmousebuffer 4) 4 wparm)
    (iasgn (add kbdmousebuffer 8) 4 gx)
    (iasgn (add kbdmousebuffer 12) 4 gy)
    t
)

(de wm_rbuttondblclk_func (hwndchild message wparm lparm x item place prex preitem)
    (iasgn kbdmousebuffer 4 WM_RBUTTONDBLCLK)
    (iasgn (add kbdmousebuffer 4) 4 wparm)
    (iasgn (add kbdmousebuffer 8) 4 gx)
    (iasgn (add kbdmousebuffer 12) 4 gy)
    t
)

(de wm_keydown_func (hwndchild message wparm lparm)
    (iasgn kbdmousebuffer 4 WM_KEYDOWN)
    (iasgn (add kbdmousebuffer 4) 4 wparm)
    (iasgn (add kbdmousebuffer 8) 4 gx)
    (iasgn (add kbdmousebuffer 12) 4 gy)
    t
)

;wm_paint_func is only used if redraw paint messages have to be handled here.
(de wm_paint_func (hwndchild message wparm lparm hdc)
    (cond
        (hdcgraphics
            (setq hdc (GetDC hwnd))
            (BitBlt hdc GRAPH_START_X GRAPH_START_Y GRAPH_WIDTH GRAPH_HEIGHT hdcgraphics 0 0 SRCCOPY)
            (ReleaseDC hwnd hdc)
        )
    )
    t
)

(de wm_size_func (hwndchild message wparm lparm)
    (set (quality (ltoa hwndchild 10) '"x") (lowword lparm))
    (set (quality (ltoa hwndchild 10) '"y") (highword lparm))
    t
)

(de wm_close_func (hwndchild message wparm lparm)
    (exit 0)
    t
)

(de wm_default_func (hwndchild message wparm lparm)
    nil
)

(setq wm_func_table (array (_mul 2 WM_USER)))

(setq i 0)

(while (lt i (_mul 2 WM_USER))
    (array wm_func_table i wm_default_func)
    (setq i (_add i 1))
)

(array wm_func_table WM_CHAR wm_char_func)
(array wm_func_table WM_COMMAND wm_command_func)
(array wm_func_table WM_RBUTTONUP wm_rbuttonup_func)
(array wm_func_table WM_LBUTTONUP wm_lbuttonup_func)
(array wm_func_table WM_LBUTTONDBLCLK wm_lbuttondblclk_func)
(array wm_func_table WM_RBUTTONDBLCLK wm_lbuttondblclk_func)
(array wm_func_table WM_KEYDOWN wm_keydown_func)
(array wm_func_table WM_MYCHILDHWND wm_mychildhwnd_func)
(array wm_func_table WM_PAINT wm_paint_func)
(array wm_func_table WM_SIZE wm_size_func)
(array wm_func_table WM_CLOSE wm_close_func)
(array wm_func_table WM_EXIT wm_close_func)
(array wm_func_table WM_MOUSEMOVE wm_mousemove_func)
(array wm_func_table WM_TIMER wm_timer_func)

(de dochar (msg hwndchild message wparm lparm text thisfunc)
    (setq hwndchild (car msg))
    (setq message (cdar msg))
    (setq wparm (cddar msg))
    (setq lparm (car (cdddr msg)))
    (cond 
        ((nilp message)
            nil
        )
        ((array wm_func_table message)
            (setq thisfunc (array wm_func_table message))
            (thisfunc hwndchild message wparm lparm)
        )
        (t
            nil
        )
    )
)

(de oncethrough (hwnd msg)
    (setq fdebug nil)
    (setq msg (getmessage hwnd))
    (cond 
        ((eqv msg nil) t)
        (t 
            (setq fdebug t)
            (dochar msg)
            (setq fdebug nil)
        )
    )
)

(de savewinstate (fname)
    (forlist windowlist changewindowdims)
    (setq inistream (fopen fname "w"))
    (writelsp inistream (list 'qsetq 'newwindowlist windowlist))
    (fclose inistream)
)

(de recoverwinstate (fname)
    (cond 
        ((readlsp fname)
            (for newwindowlist setwindowdims)
        )
    )
)