home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / wimpforth_2 / !WimpForth / extend < prev    next >
Encoding:
Text File  |  1996-03-21  |  4.3 KB  |  157 lines
  1. \ extend the kernel
  2.  
  3. fload primutil        \ primitive utilities
  4. fload dump
  5. fload forget
  6. fload dthread
  7.  
  8. 2 to #threads           \ default number of dictionary threads
  9.  
  10. fload order
  11. fload assert
  12. fload primhash        \ primitive hash functions for OOP later
  13. fload see
  14. fload interpif        \ interpretive conditionals
  15. fload debug
  16. fload build           \ experimental version of BUILD DO: defining wordset
  17. fload words
  18. fload pasm
  19. fload disarm
  20. fload utils           \ load other misc utility words
  21. fload args            \ local variable support
  22.  
  23. \ Object oriented support
  24.  
  25. fload class
  26. fload classdebug
  27. fload colours
  28. fload icons
  29. fload menus
  30. fload windows
  31. fload controls
  32.  
  33. \ *********************************
  34. \ the wimp objects WimpForth uses
  35. \ please look at the last 7 files
  36.  
  37. application ForthApp
  38.  
  39. :object infobox <super dialog
  40. rtextlabel nam1
  41. displayfield nam2
  42. rtextlabel pur1
  43. displayfield pur2
  44. rtextlabel aut1
  45. displayfield aut2
  46. rtextlabel ver1
  47. displayfield ver2
  48. :m ClassInit:  ( -- )
  49.      ClassInit: super
  50.      WF_StayOnScreen [ WF_Outside invert ] literal ChangeWFlags ;m
  51. :m On_Init:    ( -- )
  52.      688 216  2dup  SetSize  SetWaSize
  53.      c" About this Program"  SetTitleText: self
  54.      BeginIcons
  55.        self Start: nam1
  56.           c" Name:" SetText: nam1  144  -56 Move: nam1
  57.        self Start: nam2                  32 SetLength: nam2
  58.           c" !WimpForth" SetText: nam2  160  -56 Move: nam2
  59.        self Start: pur1
  60.        c" Purpose:" SetText: pur1  144 -108 Move: pur1
  61.        self Start: pur2                  32 SetLength: pur2
  62.        c" Forth to create Wimp programs" SetText: pur2  160 -108 Move: pur2
  63.        self Start: aut1
  64.         c" Author:" SetText: aut1  144 -160 Move: aut1
  65.        self Start: aut2                  32 SetLength: aut2
  66.         c" Martin Läuter" SetText: aut2  160 -160 Move: aut2
  67.        self Start: ver1
  68.        c" Version:" SetText: ver1  144 -212 Move: ver1
  69.        self Start: ver2                  32 SetLength: ver2
  70.        s" 1.0 (" temp$ place compile-version >date" temp$ +place
  71.        s" )" temp$ +place
  72.        temp$ dup +null SetText: ver2  160 -212 Move: ver2
  73.      EndIcons ;m
  74. :m Build:      ( ad -- ad' )
  75.      Build: super
  76.      Build: nam1 Build: nam2 Build: pur1 Build: pur2
  77.      Build: aut1 Build: aut2 Build: ver1 Build: ver2 ;m
  78. ;object
  79.  
  80. popup ibpopup "WimpForth"
  81.   subwindow "Info" infobox
  82.   menuseparator
  83.   menuitem "Quit" bye ;
  84.  
  85. ibpopup to barpopup
  86.  
  87. popup fpopup "WimpForth"
  88.   menuitem "Stack" s" .s" "pushkeys 13 pushkey ;
  89.  :menuitem ord "Order" order ;
  90.   menuitem "Error Test"  z" &11 This is an error Test" ErrorBox . ;
  91.   submenu "File" "File"
  92.     menuitem "Open" beep ;
  93.     menuitem "Close" beep ;
  94.     menuitem "Load" ;
  95.   endsubmenu
  96.  :menuitem caps-flag "Ignore Case" caps @ 0= caps ! ;
  97.   menuseparator
  98.   menuitem "Quit" bye ;
  99.  
  100. PreMenu:
  101.    caps @ Check: caps-flag ;
  102. false Enable: ord
  103. fpopup &Popup: mainwindow !
  104.  
  105. \ ****************************
  106. \ do something at boot time
  107.  
  108. create hello$ 0 c, 260 allot
  109.  
  110. : hello+"       ( -<text">- )                   \ append to hello string
  111.                 '"' word count hello$ +place ;
  112.  
  113. hello+" Forth for Risc OS"
  114.  
  115. 0 value &config
  116.  
  117. : config"       ( -<config_file_name">- )
  118.                 here to &config
  119.                 '"' word count here place
  120.                 here c@ 1+ allot 0 c, ;
  121.  
  122. config" config"
  123.  
  124. \ ........ set the default system access strings ..........
  125.  
  126. : hello         ( -- )                          \ startup stuff
  127.                 ?loading off                    \ we aren't loading initially
  128.                 only forth also definitions
  129.                 decimal
  130.                 0 to source-id                  \ not loading from a file yet
  131.                 initialization-chain do-chain
  132.                 start: ForthApp
  133.                 Center: mainwindow start: mainwindow GetTheCaret: mainwindow
  134.                 window-io
  135.                 cls     hello$ count type
  136.                 cr .words ." words in the dictionary"
  137.                 &config count ( "path-file ) "open nip 0=  \ if found
  138.                 if      &config ['] $fload catch ?dup
  139.                         if      message
  140.                                 sp0 @ sp!
  141.                                 quit
  142.                         then
  143.                 then ;
  144.  
  145. ' hello is boot
  146.  
  147. mark empty
  148.  
  149. here fence !
  150.  
  151. \ cur-file off            \ clear the default file
  152. \ cur-line off            \ clear the current line
  153.  
  154. cr cr .( Extensions Loaded, ) count-words . .( words in dictionary) cr
  155.  
  156. fsave F
  157.