-
Notifications
You must be signed in to change notification settings - Fork 1
/
MAKEWIN
221 lines (151 loc) · 4.96 KB
/
MAKEWIN
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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
\ 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