-
Notifications
You must be signed in to change notification settings - Fork 1
/
EXTEND
158 lines (131 loc) · 4.37 KB
/
EXTEND
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
\ 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 classdeb
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
200 100 move: mainwindow
start: 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 F2