home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dream 52
/
Amiga_Dream_52.iso
/
RiscOS
/
APP
/
DEVS
/
FORTH
/
WIMPFO.ZIP
/
!WimpForth
/
extend
< prev
next >
Wrap
Text File
|
1996-03-21
|
4KB
|
157 lines
\ extend the kernel
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
\ Object oriented support
fload class
fload classdebug
fload colours
fload icons
fload menus
fload windows
fload controls
\ *********************************
\ the wimp objects WimpForth uses
\ please look at the last 7 files
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: ( -- )
688 216 2dup SetSize SetWaSize
c" About this Program" SetTitleText: self
BeginIcons
self Start: nam1
c" Name:" SetText: nam1 144 -56 Move: nam1
self Start: nam2 32 SetLength: nam2
c" !WimpForth" SetText: nam2 160 -56 Move: nam2
self Start: pur1
c" Purpose:" SetText: pur1 144 -108 Move: pur1
self Start: pur2 32 SetLength: pur2
c" Forth to create Wimp programs" SetText: pur2 160 -108 Move: pur2
self Start: aut1
c" Author:" SetText: aut1 144 -160 Move: aut1
self Start: aut2 32 SetLength: aut2
c" Martin LΣuter" SetText: aut2 160 -160 Move: aut2
self Start: ver1
c" Version:" SetText: ver1 144 -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 160 -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 "Stack" s" .s" "pushkeys 13 pushkey ;
: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"
\ ........ set the default system access strings ..........
: 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
start: ForthApp
Center: mainwindow start: mainwindow GetTheCaret: mainwindow
window-io
cls hello$ count type
cr .words ." words in the dictionary"
&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 F