MAKEWIN

\ use to make FWIN
\ e.g. in a console run "kernel" and then "fload makewin"
\ extend the kernel to create the window.

fload primutil        \ primitive utilities
fload dump
fload forget
fload dthread

2 to #threads           \ default number of dictionary threads

fload order
fload assert
fload primhash        \ primitive hash functions for OOP later
fload see
fload interpif        \ interpretive conditionals
fload debug
fload build           \ experimental version of BUILD DO: defining wordset
fload words
fload pasm
fload disarm
fload utils           \ load other misc utility words
fload args            \ local variable support
fload ed


fload sprites

\ Object oriented support

fload class
fload classdeb
fload colours
fload icons
fload menus
fload windows
fload controls


variable seed

: initiate-seed ( -- )  74755 seed ! ;

: random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;

: rnd random swap mod ;


application ForthApp

:object infobox <super dialog
rtextlabel nam1
displayfield nam2
rtextlabel pur1
displayfield pur2
rtextlabel aut1
displayfield aut2
rtextlabel ver1
displayfield ver2

:m ClassInit:  ( -- )
     ClassInit: super
     WF_StayOnScreen [ WF_Outside invert ] literal ChangeWFlags ;m

:m On_Init:    ( -- )

     initSprites
     720 220  2dup  SetSize  SetWaSize
     c" About this Program"  SetTitleText: self
     
     BeginIcons

       self Start: nam1
          c"    Name:" SetText: nam1  134  -56 Move: nam1

       self Start: nam2                  32 SetLength: nam2
          c" !WimpForth" SetText: nam2  180  -56 Move: nam2

       self Start: pur1
       c"  Purpose:" SetText: pur1  134 -108 Move: pur1

       self Start: pur2                  32 SetLength: pur2
       c" Forth to create Wimp programs" SetText: pur2  180 -108 Move: pur2

       self Start: aut1
        c"  Author:" SetText: aut1  134 -160 Move: aut1

       self Start: aut2                  32 SetLength: aut2
        c" Martin Läuter" SetText: aut2  180 -160 Move: aut2

       self Start: ver1
       c" Version:" SetText: ver1  134 -212 Move: ver1

       self Start: ver2                  32 SetLength: ver2
       s" 1.0 (" temp$ place compile-version >date" temp$ +place
       s" )" temp$ +place
       temp$ dup +null SetText: ver2  180 -212 Move: ver2

     EndIcons ;m

:m Build:      ( ad -- ad' )
     Build: super
     Build: nam1 Build: nam2 Build: pur1 Build: pur2
     Build: aut1 Build: aut2 Build: ver1 Build: ver2 ;m
;object

popup ibpopup "WimpForth"
  subwindow "Info" infobox
  menuseparator
  menuitem "Quit" bye ;

ibpopup to barpopup

popup fpopup "WimpForth"

 menuitem "Refresh" Redraw: mainwindow ;
 
 menuitem "Stack" s" .s" "pushkeys 13 pushkey ;

 menuitem "Graphics On"
  initSprites
  1 to spron
  Redraw: mainwindow ;

 menuitem "Graphics off"
  0 to spron
  Redraw: mainwindow ;

 :menuitem ord "Order" order ;

  menuitem "Error Test"  z" &11 This is an error Test" ErrorBox . ;

  submenu "File" "File"
    menuitem "Open" beep ;
    menuitem "Close" beep ;
    menuitem "Load"  ;
  endsubmenu

 :menuitem caps-flag "Ignore Case" caps @ 0= caps ! ;
  menuseparator
  menuitem "Quit"  bye ;

PreMenu:
   caps @ Check: caps-flag ;
false Enable: ord
fpopup &Popup: mainwindow !

\ ****************************
\ do something at boot time


create hello$ 0 c, 260 allot

: hello+"       ( -<text">- )                   \ append to hello string
                '"' word count hello$ +place ;

hello+" Forth for Risc OS"

0 value &config

: config"       ( -<config_file_name">- )
                here to &config
                '"' word count here place
                here c@ 1+ allot 0 c, ;

config" config"


: turn-cursor-off HideCaret: mainwindow ;

: turn-cursor-on ShowCaret: mainwindow ;


\ ........ set the default system access strings ..........

align

: hello         ( -- )                          \ startup stuff
                ?loading off                    \ we aren't loading initially
                only forth also definitions
                decimal
                0 to source-id                  \ not loading from a file yet
                initialization-chain do-chain

                initSprites
                start: ForthApp

                center: mainwindow start: mainwindow

                [']  turn-cursor-off is cursor-off
                [']  turn-cursor-on is cursor-on

                window-io
                cls  hello$ count type
                cr .words ." words in the dictionary"

                GainCaret: mainwindow

                &config count ( "path-file ) "open nip 0=  \ if found
                if      &config ['] $fload catch ?dup
                        if      message
                                sp0 @ sp!
                                quit
                        then
                then ;

' hello is boot

mark empty

here fence !

\ cur-file off            \ clear the default file
\ cur-line off            \ clear the current line

cr cr .( Extensions Loaded, ) count-words . .( words in dictionary) cr

fsave FWIN

bye