6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-11-26 02:49:17 +00:00
Code Issues Projects Releases Wiki Activity
211926629c
VolksForth/sources/AtariST/EDITOR.fth

1599 lines
98 KiB
Forth
Raw Normal View History

Tools: fb2fth (Forth-Block to Forth Source) in gforth
2020-07-20 21:47:02 +00:00
\ *** Block No. 0 Hexblock 0
\\ *** Screen-Editor *** 10aug86we
Dieses File enth<EFBFBD>lt den volksFORTH - Editor.
Er basiert auf dem Editor im F83 von Laxen/Perry, besitzt aber
erheblich erweiterte Funktionen (Zeichen- und Zeilenstack) und
ist ein vollst<EFBFBD>ndig in GEM integrierter Fullscreen-Editor.
Obwohl die Steuerung mit Maus und Menuzeile erfolgt, k<EFBFBD>nnen
ihn die 'Profis' auch vollst<EFBFBD>ndig <EFBFBD>ber Controltasten bedienen,
Die Dauerhilfe-Funktion macht eine Funktionsbeschreibung <EFBFBD>ber-
fl<EFBFBD>ssig. Solange im HILFE-Menu Dauerhilfe gew<EFBFBD>hlt ist, erscheint
vor der Ausf<EFBFBD>hrumg jeder Editor-Funktion ein erl<EFBFBD>uternder Text
mit der M<EFBFBD>glichkeit zum Abbruch. Dies gilt jedoch nicht, wenn
die Funktion per Tastendruck aufgerufen wurde.
\ *** Block No. 1 Hexblock 1
\ Load Screen for the Editor cas20130105
Onlyforth GEM also
include ediicon.fb
| Variable (dx 2 (dx ! | Variable (dy 4 (dy !
| : dx (dx @ ; | : dy (dy @ ;
\needs -text .( strings needed !!) abort
\needs file? .( Filesystem needed !!) abort
include gem\supergem.fb
include gem\gemdefs.fb
include edwindow.fb
Forth definitions
1 $2C +thru
\ *** Block No. 2 Hexblock 2
\ Editor Variable 10sep86we
Variable 'scr 1 'scr ! Variable 'r# 'r# off
Variable 'edifile
?head @ 1 ?head !
Variable changed Variable edistate
Variable edifile
Variable ycur
\ *** Block No. 3 Hexblock 3
\ Edi move cursor with position-checking or cyclic 30aug86we
: c ( n -- ) \ checks the cursor position
r# @ + dup 0 b/blk uwithin 0= abort" Border!" r# ! ;
\ : c ( n -- ) \ moves cyclic thru the screen
\ r# @ + b/blk mod r# ! ;
\ *** Block No. 4 Hexblock 4
\ Move the Editor's cursor around 08aug86we
: top ( -- ) r# off ;
: cursor ( -- n ) r# @ ;
: t ( n -- ) c/l * cursor - c ;
: line# ( -- n ) cursor c/l / ;
: col# ( -- n ) cursor c/l mod ;
: +t ( n -- ) line# + t ;
: 'start ( -- addr ) scr @ block ;
: 'cursor ( -- addr ) 'start cursor + ;
: 'line ( -- addr ) 'cursor col# - ;
: #after ( -- n ) c/l col# - ;
: #remaining ( -- n ) b/blk cursor - ;
: #end ( -- n ) #remaining col# + ;
\ *** Block No. 5 Hexblock 5
\ Move the Editors cursor 08aug86we
: curup c/l negate c ;
: curdown c/l c ;
: curleft -1 c ;
: curright 1 c ;
: +tab cursor $10 / 1+ $10 * cursor - c ;
: -tab cursor 8 mod negate dup 0= 8 * + c ;
: >""end 'start b/blk -trailing nip b/blk 1- min r# ! ;
: <cr> line# t curdown ;
\ *** Block No. 6 Hexblock 6
\ buffers 14sep86we
: modified ( -- ) scr @ block drop update
changed @ ?exit edistate off changed on ;
&84 Constant c/pad
&42 Constant c/buf
: 'work ( -- work-buf ) pad c/pad + ;
: 'insert ( -- ins-buf ) 'work c/pad + ;
: 'find ( -- find-buf ) 'insert c/buf + ;
: 'find+ ( n1 -- n2 ) 'find c@ + ;
\ *** Block No. 7 Hexblock 7
\ Errorchecking 09sep86we
: ?bottom ( -- ) 'start b/blk + c/l - c/l -trailing nip
abort" You would lose a line" ;
: ?end ( -- ) 'line c/l + 1- c@ bl -
abort" You would lose a char" ;
: ?range ( n -- n ) dup 0 capacity uwithin not
abort" Out of range!" ;
\ *** Block No. 8 Hexblock 8
\ Graphics for display 23aug86we
: lineclr ( line# -- )
wi_x swap cheight * wi_y +
over wi_width + over cheight + fbox ;
: lineinsert ( line# -- )
wi_x over cheight * wi_y +
wi_width over l/s 1- cheight * wi_y + swap -
2over cheight + scr>scr lineclr ;
: linedelete ( line# -- )
wi_x swap 1+ cheight * wi_y +
wi_width over l/s cheight * wi_y + swap -
2over cheight - scr>scr l/s 1- lineclr ;
\ *** Block No. 9 Hexblock 9
\ Editor-Window Title and Status-Line cas20130105
: 'workblank
'work dup $sum ! dup off dup 1+ c/l blank c/l + off ;
: update$ ( -- string )
scr @ updated? not IF " not updated" exit THEN " updated" ;
: .edistate edistate @ ?exit edistate on 'workblank
" Scr # " count $add scr @ extend <# # # # #> $add
'work c@ 2+ 'work c! update$ count $add
'work 1+ wi_status ;
\ *** Block No. 10 Hexblock A
\ screen display 30aug86we
: .edifile 'workblank 1 'work c!
isfile@ ?dup 0= IF " DIRECT" ELSE 2- >name THEN
count $add 'work count + 1+ c/l min off
'work 1+ wi_title ;
: 'line# ( line# -- addr count )
dup dy + dx at c/l * 'start + c/l ;
: .line ( line# -- ) dup lineclr 'line# -trailing type ;
: redisplay ( line# -- ) 'line# type ;
\ *** Block No. 11 Hexblock B
\ screen display 14sep86we
&18 Constant id-len
Create id id-len allot id id-len erase
: stamp id 1+ count 'start c/l + over - swap cmove ;
: ?stamp changed @ IF stamp THEN ;
: edilist edistate off changed off
vslide_size scr @ vslide
.edifile .edistate l/s 0 DO I .line LOOP ;
: undo scr @ block drop prev @ emptybuf edilist ;
: do_redraw hide_c wi_clear redraw_screen edilist ;
\ *** Block No. 12 Hexblock C
\ Edi Variables, 23aug86we
Variable (pad (pad off
: memtop ( -- addr ) sp@ $100 - ;
Variable chars Variable #chars
: 'chars ( -- addr ) chars @ #chars @ + ;
Variable lines Variable #lines
: 'lines ( -- addr ) lines @ #lines @ + ;
Variable (key
Variable imode imode off
\ *** Block No. 13 Hexblock D
\ Edi line handling 09aug86we
: linemodified modified line# redisplay ;
: clrline 'line c/l blank linemodified ;
: clrright 'cursor #after blank linemodified ;
: delline 'line #end c/l delete
line# linedelete modified ;
: backline curup delline ;
: instline ?bottom 'line c/l over #end insert
line# lineinsert clrline ;
\ *** Block No. 14 Hexblock E
\ Edi line handling 09aug86we
: @line 'lines memtop u> abort" line buffer full"
'line 'lines c/l cmove c/l #lines +! ;
: copyline @line curdown ;
: line>buf @line delline ;
: !line c/l negate #lines +! 'lines 'line c/l cmove
linemodified ;
: buf>line #lines @ 0= abort" line buffer empty"
?bottom instline !line ;
\ *** Block No. 15 Hexblock F
\ Edi char handling 09aug86we
: delchar 'cursor #after 1 delete linemodified ;
: backspace curleft delchar ;
: inst1 ?end 'cursor 1 over #after insert ;
: instchar inst1 bl 'cursor c! linemodified ;
: @char 'chars 1- lines @ u> abort" char buffer full"
'cursor c@ 'chars c! 1 #chars +! ;
: copychar @char curright ;
: char>buf @char delchar ;
: !char -1 #chars +! 'chars c@ 'cursor c! ;
: buf>char #chars @ 0= abort" char buffer empty"
inst1 !char linemodified ;
\ *** Block No. 16 Hexblock 10
\ from Screen to Screen ... 22oct86we
: setscreen ( n -- ) ?stamp ?range scr ! edilist ;
: n scr @ 1+ setscreen ;
: b scr @ 1- setscreen ;
: >shadow ( n1 -- n2 ) capacity 2/ 2dup < IF + ELSE - THEN ;
: w scr @ >shadow setscreen ;
: (mark scr @ 'scr ! r# @ 'r# ! isfile@ 'edifile ! ;
: mark (mark true abort" marked !" ;
: a ?stamp 'edifile @ [ Dos ] dup searchfile drop
isfile@ 'edifile ! !files
'r# @ r# @ 'r# ! r# !
'scr @ scr @ 'scr ! ?range scr ! edilist ;
\ *** Block No. 17 Hexblock 11
\ splitting a line, replace 17aug86we
: split ?bottom pad c/l 2dup blank
'cursor #remaining insert linemodified
col# <cr> line# lineinsert
'start cursor + c/l rot delete linemodified ;
: ins 'insert count under 'cursor #after insert c ;
: r
c/l 'line over -trailing nip -
'insert c@ 'find c@ - < abort" not enough room"
'find c@ dup negate c 'cursor #after rot delete ins
linemodified ;
\ *** Block No. 18 Hexblock 12
\ find und search 30aug86we
: >last? ( -- f ) :dfright state_gaddr l@ 1 and ;
: >last :dfright select :dfleft deselect ;
: >1st :dfleft select :dfright deselect ;
Variable fscreen
: find? ( - n f ) 'find count 'cursor #remaining search ;
: s BEGIN find? IF 'find+ c edilist exit THEN drop
fscreen @ scr @ - ?dup stop? 0= and
WHILE 0< IF -1 ELSE 1 THEN scr +! top scr @ vslide
REPEAT :sfind tree!
>last? IF >1st :df1st ELSE >last :dflast THEN
getnumber drop fscreen ! edilist true abort" not found" ;
\ *** Block No. 19 Hexblock 13
\ Search-Findbox auswerten 24aug86we
: initfind ( -- )
:dfmatch select :dfignore deselect >last
1 extend :df1st putnumber
capacity 1- extend :dflast putnumber ;
: getfind ( -- n )
:dfignore state_gaddr l@ 1 and caps !
>last? IF :dflast ELSE :df1st THEN getnumber drop
capacity 1- min
:dffstrin 'find getstring :dfrstrin 'insert getstring ;
: do_fbox ( -- button ) :sfind tree!
edifile @ isfile@ - IF isfile@ edifile ! initfind THEN
show_object :dffstrin form_do dup deselect hide_object ;
\ *** Block No. 20 Hexblock 14
\ Replacing ... 24aug86we
Variable ?replace
: show_replace ( -- )
&320 &200 &10 &10 little 4!
col# dx + 2- cwidth * line# dy + 1+ cheight *
2dup 0 objc_setpos 0 objc_getwh big 4!
big 4@ scr>mem1 1 little 4@ big 4@ form_dial
0 ( install) 3 ( depth) big 4@ objc_draw show_c ;
: replace ( -- )
:fbox tree! BEGIN
show_replace 0 form_do dup deselect hide_object
dup :fboxcanc - WHILE :fboxyes = IF r THEN s
REPEAT drop ;
\ *** Block No. 21 Hexblock 15
\ Editor's find and replace 24aug86we
Variable (findbox (findbox off
: repfind ( -- )
(findbox @ 'find c@ and 0= abort" use find first"
?stamp fscreen @ capacity 1- min fscreen !
s ?replace @ IF replace THEN ;
: edifind ( -- )
do_fbox :dfcancel case? ?exit
:dfreplac = ?replace swap IF on ELSE off THEN
:edimenu tree! :repeat 1 menu_ienable (findbox on
:sfind tree! getfind fscreen ! repfind ;
\ *** Block No. 22 Hexblock 16
\ exiting the Editor 30aug86we
Defer resetmouse
: done ( ff addr -- tf )
:edimenu tree! 0 menu_bar resetmouse hide_c
wi_close ycur @ 0 at cr ." Scr #" scr @ 3 .r 2 spaces
count type true ;
: cdone ( ff -- tf ) prev @ emptybuf " canceled" done ;
: sdone ( ff -- tf ) ?stamp save-buffers " saved" done ;
: xdone ( ff -- tf ) ?stamp update$ done ;
: ldone ( ff -- tf ) drop true
?stamp save-buffers " loading" done ;
\ *** Block No. 23 Hexblock 17
\ get User's ID, jump to screen 24aug86we
: do_getid
:sgetid tree! id 1+ :idtext putstring
show_object :idtext form_do dup deselect hide_object
:idcancel case? ?exit
:noid = IF id off exit THEN
:idtext id 1+ getstring ;
: get-id
id c@ ?exit 1 id c! do_getid ;
: jumpscreen :sgetscr tree!
pad dup off :scrnr putstring
show_object :scrnr form_do dup deselect hide_object
:sgcancel = ?exit :scrnr getnumber drop setscreen ;
\ *** Block No. 24 Hexblock 18
\ insert- and overwrite-mode 24aug86we
: mark_item ( item# -- ) 1 menu_icheck ;
: clr_item ( item# -- ) 0 menu_icheck ;
: setimode imode on :edimenu tree!
:imode mark_item :omode clr_item ;
: clrimode imode off :edimenu tree!
:omode mark_item :imode clr_item ;
\ *** Block No. 25 Hexblock 19
\ viewing words 24aug86we
: >view ( -- )
'find count pad place pad capitalize bl pad count + c!
find 0= abort" Haeh?"
>name ?dup 0= abort" no view-field"
4- @ ?dup 0= abort" hand made"
(view scr ! top curdown find? 0= IF drop exit THEN
'find+ c ;
: do_view ( -- )
:sview tree! pad dup off :svword putstring
show_object :svword form_do dup deselect hide_object
:idcancel case? ?exit
:svword 'find getstring :svmark = IF (mark THEN
>view edilist ;
\ *** Block No. 26 Hexblock 1A
\ Table of keystrokes 10aug86we
Create keytable
$4800 0 , , $4B00 0 , , $5000 0 , , $4D00 0 , ,
$4838 1 , , $4B34 1 , , $5032 1 , , $4D36 1 , ,
$5000 2 , , $7400 2 , ,
$0E08 0 , , $537F 0 , , $5200 0 , , $240A 2 , ,
$0E08 1 , , $537F 1 , , $5230 1 , , $6100 0 , ,
$1709 2 , , $180F 2 , , $1205 2 , , $531F 2 , ,
$1C0D 0 , , $1C0D 1 , , $0F09 0 , , $0F09 1 , ,
$4700 0 , , $4737 1 , , $2207 2 , , $2F16 2 , ,
$2106 2 , , $1312 2 , , $320D 2 , ,
$011B 0 , , $1F13 2 , , $2D18 2 , , $260C 2 , ,
$310E 2 , , $3002 2 , , $1E01 2 , , $1117 2 , ,
here keytable - 2/ 2/ Constant #keys
\ *** Block No. 27 Hexblock 1B
\ Table of actions 11aug86we
Create actiontable ]
curup curleft curdown curright
line>buf char>buf buf>line buf>char
copyline copychar
backspace delchar instchar jumpscreen
backline delline instline undo
setimode clrimode clrline clrright
<cr> split +tab -tab
top >""end do_getid do_view
edifind repfind mark
cdone sdone xdone ldone
n b a w
[ here actiontable - 2/ #keys - abort( # of actions)
\ *** Block No. 28 Hexblock 1C
\ Table of Menuevents 24aug86we
Create menutable
$FF c, $FF c, $FF c, $FF c,
:cutline c, :cutchar c, :pastelin c, :pastecha c,
:copyline c, :copychar c,
$FF c, $FF c, $FF c, :jump c,
:backline c, :delline c, :insline c, :undo c,
:imode c, :omode c, :eraselin c, :erasrest c,
$FF c, :split c, :tab c, :backtab c,
:home c, :toend c, :getid c, :view c,
:search c, :repeat c, :mark c,
:canceled c, :flushed c, :updated c, :loading c,
:next c, :back c, :alternat c, :shadow c,
here menutable - #keys - abort( # of menuitems)
\ *** Block No. 29 Hexblock 1D
\ Table of Help-Boxes 24aug86we
Create helptable
$FF c, $FF c, $FF c, $FF c,
:hlicut c, :hchcut c, :hlipaste c, :hchpaste c,
:hlicopy c, :hchcopy c,
$FF c, $FF c, $FF c, :hjump c,
:hliback c, :hlidel c, :hliins c, :hexundo c,
:hspins c, :hspover c, :hlierase c, :hlirest c,
$FF c, :hlisplit c, :hcutabr c, :hcutabl c,
:hcuhome c, :hcuend c, :hspgetid c, :hview c,
:hspfind c, :hsprepea c, :hscmark c,
:hexcancl c, :hexsave c, :hexupdat c, :hexload c,
:hscnext c, :hscback c, :hscalter c, :hscshado c,
here helptable - #keys - abort( # of menuitems)
\ *** Block No. 30 Hexblock 1E
\ Prepare multi-event 09sep86we
Variable mflag mflag off
: ediprepare
%00110111
1 1 1
mflag @
dx cwidth * dy cheight * c/l cwidth * l/s cheight *
0 0 0 0 0
0 0
intin $10 array! message >absaddr addrin 2! ;
' pause | Alias ev-timer
: ev-r1 1 mflag 1+ ctoggle ;
\ *** Block No. 31 Hexblock 1F
\ Button Event 24aug86we
Variable ?cursor ?cursor off
: curon ?cursor @ ?exit ?cursor on
3 swr_mode 1 sf_color 1 sf_interior 0 sf_perimeter
at? cwidth * swap cheight *
over cwidth 1- + over cheight + 1- bar ;
: curoff ?cursor off curon ?cursor off ;
: ev-button mflag @ 0= ?exit
intout 4+ @ cheight / dy - c/l *
intout 2+ @ cwidth / dx - + r# ! hide_c curoff ;
\ *** Block No. 32 Hexblock 20
\ Key event 17aug86we
: visible? ( key -- f ) $FF and ;
: putchar ( -- )
(key @ dup visible? 0= abort" What?"
imode @ IF inst1 THEN 'cursor c! linemodified curright ;
: findkey ( d_key -- addr )
['] putchar -rot
#keys 0 DO 2dup keytable I 2* 2* + 2@ d=
IF rot drop actiontable I 2* + @ -rot LEAVE THEN
LOOP 2drop ;
\ *** Block No. 33 Hexblock 21
\ Key event 23aug86we
Variable jingle jingle on
Variable ?mouse
: edit-at cursor c/l /mod dy + swap dx + at ;
: ev-key ?mouse off
intout &10 + dup @ dup (key ! hide_c edit-at curoff
swap 2- @ dup 1 and + 2/ findkey execute
jingle on .edistate BEGIN getkey 0= UNTIL ;
\ *** Block No. 34 Hexblock 22
\ Message events for window 30aug86we
: getmessage ( n -- n' ) 2* message + @ ;
: wm_arrowed
4 getmessage 1 and IF n exit THEN b ;
: wm_vslide
4 getmessage capacity 1- &1000 */ setscreen ;
: wm_moved
4 getmessage cwidth / 1 max &14 min (dx !
5 getmessage cheight / 1 max 5 min 3 + (dy !
wi_handle @ 5 wi_size wind_set redraw_screen ;
\ *** Block No. 35 Hexblock 23
\ Message events (the menuline) 02sep86we
Variable ?help ?help on
: do_help ( n -- )
helptable + c@ alert 1 = ?exit
true abort" Dann eben nicht !!" ;
: do_copyr :copyr tree!
show_object 0 form_do deselect hide_object ;
: do_menuhelp show_c :hhemenu alert hide_c
:edimenu tree! 1 and :menuhelp over menu_icheck
?help ! ;
\ *** Block No. 36 Hexblock 24
\ Message events from menuline 02sep86we
: do_other ( -- ) 4 getmessage
:menuhelp case? IF do_menuhelp exit THEN
:hmouse case? IF :hhemouse alert drop exit THEN
:hfuncts case? IF :hhef1f10 alert drop exit THEN
drop do_copyr ;
: menu-message ( -- ) message @ :mn_selected - ?exit
:edimenu tree! 3 getmessage 1 menu_tnormal
['] do_other 4 getmessage
#keys 0 DO dup menutable I + c@ =
IF ?help @ IF I do_help THEN
nip actiontable I 2* + @ swap LEAVE THEN
LOOP drop execute jingle on .edistate ;
\ *** Block No. 37 Hexblock 25
\ Handle message-event 24aug86we
: ev-message hide_c edit-at curoff
message @ :mn_selected case? IF menu-message exit THEN
:wm_arrowed case? IF wm_arrowed exit THEN
:wm_vslid case? IF wm_vslide exit THEN
:wm_moved case? IF wm_moved exit THEN
:wm_redraw case? IF do_redraw exit THEN
drop ;
\ *** Block No. 38 Hexblock 26
\ Handle all events 30aug86we
Create ev-flag
:mu_mesag c, :mu_m1 c, :mu_button c,
:mu_keybd c, :mu_timer c,
Create: event-actions
ev-message ev-r1 ev-button ev-key ev-timer ;
: handle-events ( which -- )
5 0 DO ev-flag I + c@ over and IF drop I LEAVE THEN LOOP
2* event-actions + perform ;
\ *** Block No. 39 Hexblock 27
\ Change mouse-movement Vector 10sep86we
2Variable savevec
Create newvector Assembler
?mouse pcrel) A0 lea true # A0 ) move
.l savevec pcrel) A0 move A0 ) jmp end-code
Code ?show_c ?mouse R#) tst 0= IF Next THEN ;c: show_c ;
: ex_motv ( pusrcode -- )
contrl &14 + 2! &126 0 0 VDI contrl &18 + 2@ savevec 2! ;
: setmousevec newvector >absaddr ex_motv ;
: resetmousevec savevec 2@ ex_motv ;
' resetmousevec Is resetmouse
\ *** Block No. 40 Hexblock 28
\ The Editor's LOOP 02sep86we
: ediloop r0 @ rp!
BEGIN edit-at curon ?show_c false
ediprepare evnt_multi handle-events UNTIL ;
: alarm bell jingle off ;
: edierror ( string -- )
jingle @ 0= IF drop ediloop THEN alarm
'workblank c/l 2/ 'work c! count c/l 2/ min $add
'work 1+ wi_status edistate off ediloop ;
\ *** Block No. 41 Hexblock 29
\ Installing the Editor 20nov86we
Create ediresource &12 allot
Variable edihandle
: setediresource ediresource ap_ptree &12 cmove ;
: ?clearbuffer
pad (pad @ = ?exit pad (pad !
'find b/blk + dup chars ! c/l 2* + lines !
#chars off #lines off 'find off 'insert off (findbox off ;
\ *** Block No. 42 Hexblock 2A
\ Installing the Editor 20nov86we
: finstall ( -- )
pad memtop u> abort" No room for buffers!"
get-id changed off row ycur ! setmousevec
?clearbuffer ?cursor off
ap_ptree &12 cpush setediresource
grhandle push edihandle @ grhandle !
wi_open :edimenu tree! 1 menu_bar
errorhandler push ['] edierror errorhandler !
r0 push rp@ r0 ! ediloop ;
\ *** Block No. 43 Hexblock 2B
\ Entering the Editor 11sep86we
Forth definitions ?head !
| : ?load 0= ?exit scr @ r# @ (load ;
: v ( -- ) scr @ ?range drop finstall ?load ;
: l ( scr -- ) 1 arguments ?range scr ! top v ;
| : >find bl word count 'find place ;
: view ( -- ) >find >view v ;
\ *** Block No. 44 Hexblock 2C
\ Init the Editor for different resolutions 18sep86we
| : q_extnd ( info_flag -- ) intin ! &102 0 1 VDI ;
| : setMFDB ( addr_of_MFDB -- ) >r
0 q_extnd intout 2@ r@ 4+ 2! intout @ $10 / r@ 6 + !
1 q_extnd intout 8 + @ r> &12 + ! ;
\ *** Block No. 45 Hexblock 2D
\ save-system for Editor cas20130105
| : edistart grinit rsrc_load" ediicon.rsc" 0 graf_mouse
grhandle @ edihandle ! ap_ptree ediresource &12 cmove
memMFDB1 setMFDB memMFDB2 setMFDB
['] noop [ ' drvinit >body ] Literal ! ;
: bye grexit bye ; grinit
: save-system id off r# off 1 scr ! 'r# off 1 'scr !
(findbox off (pad off
['] edistart [ ' drvinit >body ] Literal !
[ ' forth83.fb >body ] Literal 'edifile !
flush save-system bye ;
\ *** Block No. 46 Hexblock 2E
\ *** Block No. 47 Hexblock 2F
\\ *** Screen-Editor *** 17aug86we
In den Editor gelangt man mit l ( Screen-Nr. -- ), mit v oder
view. view verlangt als weitere Eingabe ein FORTH-Wort und
sucht dann den Screen, auf dem das Wort definiert wurde.
Alle Eingaben werden unmittelbar in den Blockbuffer geschrieben,
der den aktuellen Screen enth<EFBFBD>lt.
Die Position des Cursors h<EFBFBD>ngt von 2 Variablen ab:
scr enth<EFBFBD>lt die Nummer des aktuellen Screens;
r# bestimmt die Position des Cursors.
Beides sind Systemvariable, die auch beim Compilieren benutzt
werden. Bei Abbruch wegen eines Fehlers ruft man den Editor mit
v auf. Der Cursor steht hinter dem Wort, das den Abbruch
ausgel<EFBFBD>st hat.
\ *** Block No. 48 Hexblock 30
\ Load Screen for the Editor 24aug86we
bindet Vocabulary GEM mit in die Suchreihenfolge ein.
Labels f<EFBFBD>r Editor-Resource
(dx und (dy sind Variable, die die Lage des Editorfensters
relativ zur linken oberen Ecke des Bildschirms angeben.
Der Editor ben<EFBFBD>tigt einige Definitionen aus anderen Files.
- f<EFBFBD>r die Suchfunktionen.
- falls kein File-Interface vorhanden ist.
- f<EFBFBD>r das Fenster
Labels f<EFBFBD>r Gem-Aufrufe
\ *** Block No. 49 Hexblock 31
\ Editor Variable 26oct86we
Screen-Nr. und Cursorposition vom markierten Screen
File f<EFBFBD>r markierten Screen
Alle folgenden Definitionen werden headerless compiliert.
Flag f<EFBFBD>r <EFBFBD>nderungen am Screen; Flag, ob Statuszeile neu ge-
File, das editiert wird schrieben werden mu<EFBFBD>
ycur ist die Cursorposition beim Aufruf des Editors
\ *** Block No. 50 Hexblock 32
\ Edi move cursor with position-checking or cyclic 30aug86we
bewegt den Cursor um n Stellen vor- bzw. r<EFBFBD>ckw<EFBFBD>rts.
Wird der Cursor <EFBFBD>ber Anfang oder Ende des Screens hinausbewegt,
stehen zwei M<EFBFBD>glichkeiten zur Wahl:
- Kommando wird nicht ausgef<EFBFBD>hrt.
- Der Screen wird zyklisch durchlaufen.
W<EFBFBD>hlen Sie durch 'Wegkommentieren' und Neucompilieren des
Editors.
\ *** Block No. 51 Hexblock 33
\ Move the Editor's cursor around 05aug86we
setzt Cursor in die obere linke Ecke (Home).
n ist die aktuelle Position des Cursors (Offset von Home)
setzt Cursor auf Beginn der Zeile n.
n ist die Zeile, in der der Cursor steht.
n ist die Spalte, in der der Cursor steht.
bewegt Cursor um n Zeilen vor- bzw. r<EFBFBD>ckw<EFBFBD>rts auf Zeilenanfang.
addr ist die Anfangsadresse des aktuellen Blocks im Speicher.
addr ist die der Cursorposition entsprechende Speicheradresse.
addr ist die Speicheradresse des Beginns der Cursorzeile.
n ist die Stellenanzahl zwischen Cursorposition und Zeilenende.
n ist die Stellenanzahl zwischen Cursorposition und Blockende.
n ist die Stellenanzahl zwischen Cursorzeile und Blockende.
\ *** Block No. 52 Hexblock 34
\ Move the Editors cursor 07aug86we
setzt Cursor um eine Zeile nach oben.
setzt Cursor um eine Zeile nach unten.
setzt Cursor um ein Zeichen nach links.
setzt Cursor um ein Zeichen nach rechts.
setzt Cursor um eine Tabulatorposition nach vorn (s.unten).
setzt Cursor um eine Tabulatorposition zur<EFBFBD>ck (s.unten).
setzt Cursor auf das letzte Zeichen des Screens.
setzt Cursor auf Beginn der n<EFBFBD>chsten Zeile.
Vorw<EFBFBD>rtstabs:
+ + + +
R<EFBFBD>ckw<EFBFBD>rtstabs:
- - - - - - - -
\ *** Block No. 53 Hexblock 35
\ buffers 24aug86we
markiert einen ge<EFBFBD>nderten Block zum Zur<EFBFBD>ckschreiben auf Disk
setzt Flag f<EFBFBD>r ?stamp und l<EFBFBD>scht Flag f<EFBFBD>r .edistate
Byteanzahl in PAD (min. &84 nach 83-Standard!).
Byteanzahl in einem Buffer (&40 durch Resource vorgegeben).
'work, 'insert und 'find sind Buffer, die beim Aufruf des
Editors oberhalb von PAD eingerichtet werden.
'work dient zur Aufbreitung von Strings f<EFBFBD>r die Statuszeile
'find enth<EFBFBD>lt den Suchstring und 'insert den Replacestring.
n2 ist n1 zuz<EFBFBD>glich der L<EFBFBD>nge des Findbuffers.
\ *** Block No. 54 Hexblock 36
\ Errorchecking 17aug86we
bricht ab, wenn beim Einf<EFBFBD>gen einer Zeile kein Platz mehr ist.
bricht ab, wenn beim Einf<EFBFBD>gen eines Zeichens kein Platz mehr ist
bricht ab, wenn ein Screen au<EFBFBD>erhalb des aktuellen Files edi-
tiert werden soll.
\ *** Block No. 55 Hexblock 37
\ Graphics for display 23aug86we
l<EFBFBD>scht Zeile n durch <EFBFBD>berschreiben mit einem wei<EFBFBD>en Rechteck
x - und y - Koordinate der linken oberen Ecke
x - und y - Koordinate der rechten unteren Ecke
f<EFBFBD>gt auf dem Bildschirm an der Cursorposition eine Leerzeile ein
x - und y - Koordinate des zu verschiebenden Rechtecks
Breite setzen und H<EFBFBD>he berechnen
x - und y - Koordinate des Zielrechtecks ( 1 Zeile tiefer )
das ganze mit Pixelmove (schnell) verschieben und Zeile l<EFBFBD>schen
l<EFBFBD>scht auf dem Bildschirm die Cursorzeile
x - und y - Koordinate des zu verschiebenden Rechtecks
Breite setzen und H<EFBFBD>he berechnen
x - und y - Koordinate des Zielrechtecks ( 1 Zeile h<>her )
das ganze mit Pixelmove verschieben und unterste Zeile l<EFBFBD>schen
\ *** Block No. 56 Hexblock 38
\ Editor-Window Title and Status-Line 30aug86we
setzt 'work als Arbeitsspeicher und l<EFBFBD>scht ihn; 0 als Abschlu<EFBFBD>
f ist true, wenn der aktuelle Screen als updated markiert ist.
<EFBFBD>bergibt in Abh<EFBFBD>ngigkeit vom Updatezustand den richtigen String.
Statuszeile wird nur beschrieben, wenn sich etwas ver<EFBFBD>ndert hat.
Screennummer wird in 'work zusammengestellt,
2 Leerzeichen und dann die Updatemeldung.
das Ganze wird an .wi_state als 0-terminated String <EFBFBD>bergeben.
\ *** Block No. 57 Hexblock 39
\ screen display 30aug86we
gibt den Filenamen in der Titelzeile aus; 'work l<EFBFBD>schen
Adresse des Strings, der den Filenamen enth<EFBFBD>lt, ermitteln
und nach 'work bringen, maximal eine Zeile, Leerzeichen am Ende
als 0-terminated String an wi_title <EFBFBD>bergeben.
berechnet die Speicheradresse von Zeile line#,
setzt Cursor und bereitet die Parameter f<EFBFBD>r type auf.
l<EFBFBD>scht Zeile line# und gibt sie dann aus (schnell!!).
gibt Zeile line# neu aus (langsam, aber ohne Flackern).
\ *** Block No. 58 Hexblock 3A
\ screen display 14sep86we
maximale L<EFBFBD>nge der User-ID, die automatisch in die obere rechte
Ecke des Screens gesetzt wird, wenn dieser ge<EFBFBD>ndert wurde.
setzt ID rechtsb<EFBFBD>ndig (!) in die erste Zeile.
setzt ID, wenn der aktuelle Screen ver<EFBFBD>ndert wurde.
gibt einen Screen im Editorfenster aus. Flags f<EFBFBD>r ?stamp und
vertikaler Slider wird auf richtige Gr<EFBFBD><EFBFBD>e und Position gesetzt
.edistate werden zur<EFBFBD>ckgesetzt.
l<EFBFBD>scht den aktuellen Buffer und erzwingt so Neueinlesen von Disk
Der Blockzugriff ist f<EFBFBD>r Multitasking n<EFBFBD>tig.
zeichnet den gesamten Bildschirm neu (nach Accessory-Aufruf).
\ *** Block No. 59 Hexblock 3B
\ Edi Variables, putchar 17aug86we
Adresse von PAD beim Editieren f<EFBFBD>r ?clearbuffer.
Obergrenze f<EFBFBD>r Zeichen- (128 Zeichen) und Zeilenbuffer, der
oberhalb von PAD bis zur Speichergrenze reicht
Adresse des Zeichenbuffers Anzahl der Zeichen im Buffer
liefert die n<EFBFBD>chste freie Adresse im Zeichenbuffer.
Adresse des Zeilenbuffers Anzahl der Zeilen im Buffer
liefert die n<EFBFBD>chste freie Adresse im Zeilenbuffer.
speichert das zuletzt eingegebene Zeichen.
Insertmodus, voreingestellt aus
\ *** Block No. 60 Hexblock 3C
\ Edi line handling 17aug86we
erneuert gerade bearbeitete Zeile auf dem Bildschirm; setzt Flag
f<EFBFBD>r ?stamp.
l<EFBFBD>scht die Cursorzeile.
l<EFBFBD>scht vom Cursor bis zum Zeilenende.
l<EFBFBD>scht Cursorzeile und zieht Rest des Bildschirms nach oben.
l<EFBFBD>scht Zeile <EFBFBD>ber dem Cursor und zieht Rest des Bildschirms nach
oben.
f<EFBFBD>gt an der Cursorposition eine Leerzeile ein; Rest des Bild-
schirms wird nach unten geschoben.
\ *** Block No. 61 Hexblock 3D
\ Edi line handling 17aug86we
pr<EFBFBD>ft, ob Platz im Zeilenbuffer vorhanden ist, und kopiert
eine Zeile in den Zeilenbuffer.
kopiert eine Zeile in den Buffer, setzt Cursor auf die n<EFBFBD>chste.
kopiert eine Zeile in den Buffer und l<EFBFBD>scht sie.
setzt aus dem Zeilenbuffer eine Zeile in der Cursorzeile ein.
benutzt !line, pr<EFBFBD>ft vorher, ob Zeilen im Buffer sind.
F<EFBFBD>r die neue Zeile wird zuerst eine Leerzeile eingef<EFBFBD>gt.
\ *** Block No. 62 Hexblock 3E
\ Edi char handling 17aug86we
l<EFBFBD>scht Zeichen unter dem Cursor.
l<EFBFBD>scht Zeichen links neben dem Cursor.
f<EFBFBD>gt an der Cursorposition ein Zeichen im Buffer ein.
benutzt inst1, um ein Leerzeichen einzuf<EFBFBD>gen.
analog zu @line, kopiert ein Zeichen in den Zeichenbuffer.
kopiert ein Zeichen in den Buffer, setzt Cursor auf das n<EFBFBD>chste.
kopiert ein Zeichen in den Buffer und l<EFBFBD>scht es.
analog zu !line, setzt ein Zeichen aus dem Buffer bei Cursor ein
benutzt !char, pr<EFBFBD>ft vorher, ob Zeichen im Buffer sind.
F<EFBFBD>r das neue Zeichen wird zuerst ein Leerzeichen eingef<EFBFBD>gt.
\ *** Block No. 63 Hexblock 3F
\ from Screen to Screen ... 24aug86we
pr<EFBFBD>ft, ob der angeforderte Screen vorhanden ist und gibt ihn aus
geht auf den n<EFBFBD>chsten Screen.
geht auf den vorherigen Screen.
berechnet zu Screen n1 den Shadow-Screen n2 oder umgekehrt.
schaltet zwischen Original und Shadow hin und her.
markiert den aktuellen Screen mit File und Cursorposition.
s.o., jedoch mit Meldung.
vertauscht aktuellen und markierten Screen. Dabei wird auch das
File mitber<EFBFBD>cksichtigt. Dies erlaubt es, nach VIEW einen mar-
kierten Screen wieder zu benutzen.
\ *** Block No. 64 Hexblock 40
\ splitting a line, replace 17aug86we
setzt den Rest der Zeile ab Cursor auf den Anfang einer neu
eingef<EFBFBD>gten Zeile. Dazu wird erst eine komplette leere Zeile
eingef<EFBFBD>gt und dann von Cursorspalte bis Anfang der neuen
Zeile gel<EFBFBD>scht.
f<EFBFBD>gt den Insert-Buffer an der Cursorposition ein.
ersetzt den gefundenen String durch den Insert-Buffer.
berechnet Anzahl der Leerzeichen am Ende der Zeile.
Abbruch, wenn weniger als Differenz zwischen Find und Insert,
sonst Findstring l<EFBFBD>schen und Insert-Buffer einf<EFBFBD>gen
\ *** Block No. 65 Hexblock 41
\ find und search 30aug86we
f ist 1, wenn in Richtung last Screen gesucht wird, sonst 1.
schaltet Button in der Findbox auf Suche Richtung last screen.
schaltet Button in der Findbox auf Suche Richtung 1st screen.
Der Screen, bis zu dem gesucht werden soll
sucht von Cursor bis Screenende; n ist Offset zu Cursorposition.
sucht von Cursor bis Screen fscreen vorw<EFBFBD>rts oder r<EFBFBD>ckw<EFBFBD>rts.
solange bis fscreen erreicht ist oder Esc oder CTRL-C gedr<EFBFBD>ckt,
wird der n<EFBFBD>chste Screen aufgerufen.
Abbruch, falls nicht gefunden und Umschalten der Suchrichtung
in der Box und in fscreen.
Screen auflisten und Abbruchmeldung ausgeben.
\ *** Block No. 66 Hexblock 42
\ Search-Findbox auswerten 17aug86we
Vorbelegung der Buttons und Screennummern in der Find-box:
Gro<EFBFBD>-Kleinschreibung unterscheiden.
Aufsteigend suchen bis Fileende.
1 f<EFBFBD>r 1st Screen, letzten Screen im File als Last Screen
Filebox auswerten:
Variable caps entsprechend setzen.
Suchrichtung bestimmt, ob der erste oder letzte Screen
als Endscreen benutzt wird.
Strings in die entsprechenden Buffer <EFBFBD>bernehmen.
Falls das File gewechselt wurde, neu initialisieren, geschieht
auch automatisch, wenn sich PAD und damit Find- und Insert-
buffer ver<EFBFBD>ndert haben.
\ *** Block No. 67 Hexblock 43
\ Replacing ... 17aug86we
Flag f<EFBFBD>r Ersetzen des Find-Strings durch den Insert-String
O Schreck und Graus !!!
Die Replace-Box soll nat<EFBFBD>rlich nicht den gefundenen String
verdecken; die von form_center gelieferten Werte sind also
unbrauchbar. X- und Y-Position m<EFBFBD>ssen von Hand berechnet werden
und zwar so, da<EFBFBD> die linke obere Ecke der Box auf den Such-
string zeigt; zeichnen des Objects wie in show_object.
ersetzt solange den Suchstring durch den Insertstring, bis
CANCEL gedr<EFBFBD>ckt oder der Suchstring nicht gefunden wird.
Abbruch auch, wenn der Insertstring sich nicht einsetzen l<EFBFBD><EFBFBD>t.
Sonst wie bei Find Abbruch mit Esc. oder CTRL-C m<EFBFBD>glich.
\ *** Block No. 68 Hexblock 44
\ Editor's find and replace 17aug86we
Flag f<EFBFBD>r repfind, ob bereits eine Suche stattgefunden hat.
f<EFBFBD>hrt erneute Suche (und Ersetzen) durch ohne Find-Box.
Abbruch, wenn noch kein Aufruf der Find-Box oder Findbuffer
leer; sonst sicherstellen, da<EFBFBD> fscreen innerhalb des Files
liegt und s bzw replace ausf<EFBFBD>hren.
Das ist das aufrufende Wort; im CANCEL-Fall abbrechen,
sonst Flag f<EFBFBD>r replace setzen, wenn :dfreplac gew<EFBFBD>hlt wurde
Im Menubalken Repeatfind enable'n
Screennummer merken; suchen und ggf. ersetzen mit repfind.
\ *** Block No. 69 Hexblock 45
\ exiting the Editor 30aug86we
Setzt Mausvector zur<EFBFBD>ck, wird erst sp<EFBFBD>ter definiert.
gemeinsame Routine f<EFBFBD>r alle Exits
l<EFBFBD>scht (und restauriert) das Fenster, setzt Mausvector zur<EFBFBD>ck
gibt an der alten Cursorpositione eine Meldung aus
und setzt Flag zum Verlassen von ediloop.
wirft alle <EFBFBD>nderungen weg, falls man sich 'vereditiert' hat.
speichert den Screen auf Disk, falls er ver<EFBFBD>ndert wurde.
markiert den Screen, ohne ihn direkt zur<EFBFBD>ckzuschreiben.
speichert den Screen auf Disk, falls er ver<EFBFBD>ndert wurde
und compiliert ab Cursorposition.
\ *** Block No. 70 Hexblock 46
\ get User's ID, jump to screen 17aug86we
User-ID holen
bisherige ID im Fenster ausgeben
das <EFBFBD>bliche form-handling
bei Cancel nichts wie raus!
bei NO-ID wird sie gel<EFBFBD>scht; die Box erscheint dann bei n<EFBFBD>ch-
ster Gelegenheit wieder; sonst ID <EFBFBD>bernehmen (auch Leerstring)
User-ID nur holen, wenn noch keine vorhanden ist.
Wird beim Eintritt in den Editor benutzt.
springt auf beliebigen Screen im File.
Leerstring in die Box setzen.
das <EFBFBD>bliche form-handling
Screen-Nr. f<EFBFBD>r setscreen <EFBFBD>bernehmen und Screen ausgeben
\ *** Block No. 71 Hexblock 47
\ insert- and overwrite-mode 11aug86we
setzt im Pulldownmenu ein H<EFBFBD>kchen.
wie oben, nur umgekehrt.
Insert-Modus setzen und Pulldownmenu entsprechend <EFBFBD>ndern.
Overwrite-Modus setzen und Pulldownmenu entsprechend <EFBFBD>ndern.
\ *** Block No. 72 Hexblock 48
\ viewing words 17aug86we
Hilfswort f<EFBFBD>r do_view
Findbuffer wird nach PAD gebracht und f<EFBFBD>r find aufbereitet.
sucht CFA des Wortes im Findbuffer, um
das zugeh<EFBFBD>rige Name- und damit das View-Feld zu finden.
setzt File und Screen-Nr. und sucht auf dem Screen nach dem
Wort; falls gefunden, wird der Cursor dahinter positioniert.
l<EFBFBD>scht den String in der Box; das <EFBFBD>bliche form-handling
String in Findbuffer <EFBFBD>bernehmen, falls nicht Cancel gew<EFBFBD>hlt;
aktuellen Screen markieren, wenn MARK
angeklickt wurde, und gesuchten Screen aufrufen
Danach kann mit CTRL-A wieder auf den anderen Screen gewechselt
werden. Sehr n<EFBFBD>tzlich, um Zeilen aus anderen Files zu 'klauen'.
\ *** Block No. 73 Hexblock 49
\ Table of keystrokes 17aug86we
Diese Tabelle enth<EFBFBD>lt alle Tasten, die irgendwelche Sonder-
funktionen haben. Das jeweils erste Wort ist der Scancode der
Taste, das zweite die zus<EFBFBD>tzlich gedr<EFBFBD>ckten Tasten:
1 = linke oder rechte SHIFT-Taste
2 = CONTROL-Taste
4 = ALTERNATE-Taste ( wird nicht benutzt )
Auf die Funktionstasten wurde bewu<EFBFBD>t verzichtet, weil man damit
nicht vern<EFBFBD>nftig umgehen kann.
Zusatzvorschlag:
Alternate-Shift-Control bei gleichzeitig gedr<EFBFBD>ckter Enter- und
F10-Taste ---> l<EFBFBD>scht den Bildschirm.
\ *** Block No. 74 Hexblock 4A
\ Table of actions 17aug86we
Tabelle aller Editorfunktionen
Die Position eines Tabelleneintrags stimmt mit der des
zugeh<EFBFBD>rigen Tastendrucks <EFBFBD>berein, um die <EFBFBD>bersicht zu behalten.
Dies gilt auch f<EFBFBD>r die folgenden Screens.
pr<EFBFBD>ft, ob Anzahl der Funktionen mit Anzahl der Tasten <EFBFBD>berein-
stimmt. Wird nur w<EFBFBD>hrend der Compilation gebraucht.
\ *** Block No. 75 Hexblock 4B
\ Table of Menuevents 17aug86we
Tabelle der Menueintr<EFBFBD>ge.
Alle Editorfunktionen sind sowohl <EFBFBD>ber die Men<EFBFBD>leiste als auch
<EFBFBD>ber Tastendruck zu erreichen.
Bei allen Worten mit : am Anfang handelt es sich um 'kopflose'
Konstanten aus dem Resource-Definitionen-File (EDIICON.SCR),
das mit dem Programm CONVH.SCR aus EDIICON.H erzeugt wurde.
EDIICON.H wird vom 'Resource Construction Set' ausgegeben.
An dieser Stelle unser herzlicher Dank an Digital Research f<EFBFBD>r
dieses hervorragende Produkt. Nur ca. 80 Systemabst<EFBFBD>rze gab es
bei der Entwicklung, weil Icons bisweilen auf ungeraden Spei-
cheradressen abgelegt werden. Au<EFBFBD>erdem war bei knapp 10 kByte
L<EFBFBD>nge der Resource mein Speicher (1024 kByte!!!) grunds<EFBFBD>tzlich
voll bis absturzvoll. Dann bleibt das Programm stehen, nicht
ohne vorher die letzte lauff<EFBFBD>hige Resource zu l<EFBFBD>schen....
\ *** Block No. 76 Hexblock 4C
\ Table of Help-Boxes 17aug86we
Tabelle der Help-Boxen.
Zu jeder Editorfunktion gibt es eine Box, die die Funktion
beschreibt. W<EFBFBD>hlt man Dauerhilfe, erscheinen solche Boxen
immer, wenn ein Befehl aus der Menuleiste abgerufen wird.
Soll beim Einarbeiten in den Editor Hilfe leisten. Die Idee
dazu stammt aus 1st Word.
Gibt es zu einer Funktion keine Box (z.B. Cursortasten), ist
der entsprechende Eintrag mit $FF gekennzeichnet.
\ *** Block No. 77 Hexblock 4D
\ Prepare multi-event 24aug86we
Flag, ob Maus innerhalb oder au<EFBFBD>erhalb von Rechteck1
F<EFBFBD>r den Multi-Event m<EFBFBD>ssen 17 (!) Parameter <EFBFBD>bergeben werden.
timer, message, mouse, button + keyboard events zulassen.
1 Tastendruck auf linke Maustaste, event bei gedr<EFBFBD>ckter Taste
1, wenn Maus im Fensterbereich
Rechteck 1 (<28>nderung der Mausfunktion) umfa<EFBFBD>t Editor-Fenster
Rechteck 2 gibts nicht
Timer auf 0 Millisekunden (sonst kommt der Multi-Event nicht
zur<EFBFBD>ck)
Wenn nichts anderes zu tun ist, kann eine andere Task ran.
schaltet Flag um.
\ *** Block No. 78 Hexblock 4E
\ Button Event 17aug86we
Flag, das anzeigt, ob der Cursor sichtbar ist (1 = sichtbar)
schaltet Cursor ein, wenn er noch nicht eingeschaltet ist;
die Funktion arbeitet im EXOR-Modus, daher dieser Aufwand.
baut an der aktuellen Cursorposition ein schwarzes Rechteck
in der Gr<EFBFBD><EFBFBD>e eines Zeichens.
kann curon benutzen wegen EXOR-Modus, mu<EFBFBD> aber das Flag setzen.
Mausknopfereignis dann, wenn die Maus im Editorfenster steht.
die Position der Maus (in Pixel) wird in Zeile und Spalte umge-
rechnet und nach r# gespeichert. Maus abschalten und alten
Cursor l<EFBFBD>schen (in dieser Reihenfolge!)
\ *** Block No. 79 Hexblock 4F
\ Key event 17aug86we
Steuertasten erzeugen keinen ASCII-Code, sondern eine Null.
gibt ein Zeichen auf dem Bildschirm aus und schreibt es in den
Blockbuffer. Abbruch, wenn kein druckbares Zeichen vorliegt.
Auf Insert-Modus pr<EFBFBD>fen und Zeichen ausgeben.
ermittelt die Adresse der zu einer Taste geh<EFBFBD>renden Funktion.
d_key enth<EFBFBD>lt im oberen Wort den Status von Shift, Control usw.
putchar ist voreingestellt, keytable wird auf d_key abgesucht
wenn gefunden, wird die Adresse von putchar entfernt und statt-
dessen die zugeh<EFBFBD>rige Adresse aus actiontable hinterlegt.
\ *** Block No. 80 Hexblock 50
\ Key event 17aug86we
Flag f<EFBFBD>r Fehlerpiep
Flag, ob die Maus sichtbar ist
positioniert den Cursor auf die Position in r#.
Tasten-Event schaltet Mausflag ab
Tastencode holen und Maus und Cursor abschalten.
Status der Sondertasten aufbereiten und Tastenfunktion ausf<EFBFBD>h-
ren, Fehlerpiep erm<EFBFBD>glichen, Status ausgeben
und - darauf bin ich ganz stolz - alle weiteren Tastendr<EFBFBD>cke
l<EFBFBD>schen!! Dadurch l<EFBFBD>uft auch bei schnellem Tastenrepeat keine
Funktion 'nach', wird aber trotzdem schnellstm<EFBFBD>lich ausgef<EFBFBD>hrt.
Funktioniert allerdings dann nicht, wenn das lahme GEM was zu
tun hat, also beim Screenwechsel (CTRL-B und CTRL-N)
\ *** Block No. 81 Hexblock 51
\ Message events for window 30aug86we
holt Wort n aus dem AES-message Buffer.
bei Anklicken des Sliders oder der Pfeile
wird der n<EFBFBD>chste oder vorherige Screen aufgerufen.
beim Verschieben des Sliders
wird aus der Position die Screennummer berechnet.
beim Verschieben des ganzen Fensters
wird die vom User gew<EFBFBD>nschte Position berechnet
und in ganze Zeile bzw. Spalten umgewandelt; au<EFBFBD>erhalb des
Screens kann nicht positioniert werden, sonst k<EFBFBD>nnte man
ohne Sichtkontrolle weiter editieren. <EFBFBD>ber den Sinn dieser
Funktion kann man streiten, aber ich wollte zeigen, da<EFBFBD> es geht
\ *** Block No. 82 Hexblock 52
\ Message events (the menuline) 17aug86we
Flag f<EFBFBD>r Dauerhilfe bei jeder Men<EFBFBD>funktion
Hilfsbox Nr. n ausgeben
passende Hilfsbox aus Tabelle suchen und anzeigen, bei OK Ende.
sonst Funktion abbrechen.
Es folgen die Funktionen, die nicht in der helptable auftauchen.
Info-, Werbe- und Prunk-Box
braucht nur angezeigt zu werden, spricht f<EFBFBD>r sich selbst.
Dauerhilfe-Box anzeigen; je nach gew<EFBFBD>hltem Knopf
H<EFBFBD>kchen bei Menu Help setzen oder l<EFBFBD>schen
dito f<EFBFBD>r Flag
\ *** Block No. 83 Hexblock 53
\ Message events from menuline 24aug86we
Funktion, die nicht in actiontable steht, ausf<EFBFBD>hren
mit case? die passende Funktion ausw<EFBFBD>hlen
Tabelle lohnt hier nicht.
Men<EFBFBD>auswahl verarbeiten
Men<EFBFBD>titel von revers auf normal schalten
voreingestellt ist do_other, Nummer des angeklickten Items
holen, menutable wird auf Item-Nr. abgesucht
wenn gefunden, wird die Adresse von do_other entfernt und
stattdessen die zugeh<EFBFBD>rige Adresse aus actiontable hinterlegt.
Funktion ausf<EFBFBD>hren, Fehlerpiep erm<EFBFBD>glichen und Status ausgeben.
\ *** Block No. 84 Hexblock 54
\ Handle message-event 24aug86we
hier werden die Messages ausgewertet, die AES zur<EFBFBD>ckgibt.
wenn ein Men<EFBFBD>punkt angeklickt wird, menu-message ausf<EFBFBD>hren.
alle anderen Messages betreffen die Window-Attribute und
werden entsprechend ausgef<EFBFBD>hrt.
Wenn ein Desk-Accessory ausgef<EFBFBD>hrt wurde, erh<EFBFBD>lt man lediglich
die Meldung, da<EFBFBD> neu gezeichnet werden mu<EFBFBD>, und dies auch nur
dann, wenn ein Fenster aktiv ist.
\ *** Block No. 85 Hexblock 55
\ Handle all events 24aug86we
Tabelle der m<EFBFBD>glichen Events (werden als gesetztes Bit gemeldet)
in der Reihenfolge ihrer Priorit<EFBFBD>t, sonst kommt z.B. der Timer
immer
und der zugeh<EFBFBD>rigen Funktionen
Das ist der Event-Handler
gemeldeter Event wird mit Liste verglichen (Priorit<69>t !!)
und die entsprechende Event-Aktion ausgef<EFBFBD>hrt.
\ *** Block No. 86 Hexblock 56
\ Change mouse-movement Vector 17aug86we
Variable, um den alten Mausvektor zu speichern.
Die neue Mausroutine soll zus<EFBFBD>tzlich das Flag ?mouse setzen,
wenn die Maus bewegt wurde. So wird die Maus bei jedem Tasten-
druck ausgeschaltet und erst wieder eingeschaltet bei Bewegung.
Schick, gell?!
Aus Geschwindigkeitsgr<EFBFBD>nden in Assembler
<EFBFBD>ndert den Mausvektor.
Mausvektor auf neuen Wert, alter Wert nach savevec.
Mausvektor auf alten Wert (mu<6D> unbedingt ausgef<EFBFBD>hrt werden, das
Betriebssystem erledigt das beim Verlassen von FORTH nicht !!
resetmousevec l<EFBFBD>st das deffered word in done auf.
\ *** Block No. 87 Hexblock 57
\ The Editor's LOOP 30aug86we
ediloop r<EFBFBD>umt den Returnstack auf, falls mit abort" abgebrochen.
Das ist die Endlos-Schleife, die erst verlassen wird, wenn
das Flag f<EFBFBD>r UNTIL durch done gesetzt wird.
Fehlerpiep, nur einmal ausf<EFBFBD>hren, sonst klingelts dauernd.
Errorhandler f<EFBFBD>r Editor
falls Fehlermeldung bereits erfolgt, sofort nach ediloop
piepen, 'work vorbereiten
in der Statuszeile rechts Fehlertext ausgeben, soweit Platz ist
und R<EFBFBD>cksprung in ediloop ;
\ *** Block No. 88 Hexblock 58
\ Installing the Editor 26oct86we
Alle Routinen in der GEM-Library sind so geschrieben, da<EFBFBD> sie
implizit auf eine Variable grhandle zur<EFBFBD>ckgreifen. Dies
vereinfacht die Parameter<EFBFBD>bergabe erheblich.
Sollen verschiedene Grafik-Applikationen aktiviert werden, darf
trotzdem nur eine Appliktion angemeldet werden. Dies geschieht
bereits beim Laden des FORTH-Systems.
Beim Laden eines Resource-Files mit rsrc_load wird die Adresse
der zugeh<EFBFBD>rigen Baumstruktur im Global-Array unter ap_ptree
abgelegt. Diese Adresse kann man zum Umschalten auf verschie-
dene Resources benutzen.
Wenn PAD sich ver<EFBFBD>ndert hat (durch neue Worte oder forget)
sind Find- und Insert-Buffer verschoben und m<EFBFBD>ssen neu initia-
lisiert werden. Ebenso Zeichen und Zeilenbuffer.
(findbox wird gel<EFBFBD>scht, damit die Findbox initialisiert wird.
\ *** Block No. 89 Hexblock 59
\ Installing the Editor 26oct86we
initialisiert den Editor beim Aufruf.
Abbruch, wenn kein Platz f<EFBFBD>r die Editor-Buffer ist (s.u...)
aktuelle Cursorposition merken, Mausvector initialisieren
Buffer bei Bedarf initialisieren
Editor-Resource und Grafik-Handle installieren.
Fenster <EFBFBD>ffnen und Men<EFBFBD>zeile ausgeben
Errorhandler auf Editor umschalten, alten merken.
...das Dictionary ist zu voll. Entweder man 'vergi<67>t' einige
Worte oder schafft mit z.B. 'save 4 buffers' mehr Raum. Mit
BUFFERS l<EFBFBD><EFBFBD>t sich die Anzahl der Diskbuffer festlegen. Dabei
steht mehr Platz im Dictionary gegen Arbeitskomfort beim Edi-
tieren. Beachten Sie auch, da<EFBFBD> BUFFERS ein COLD ausf<EFBFBD>hrt.
\ *** Block No. 90 Hexblock 5A
\ Entering the Editor 17aug86we
Es folgen die Forth-Worte zum Aufruf des Editors.
Flag entscheidet, ob compiliert werden soll (ldone).
Screen mit Nummer in scr und Cursor in r# wird aufgerufen.
Diese Systemvariablen werden auch bei Fehlern gesetzt, also
kann man bei einem Compilationsfehler auf den richtigen Screen
gelangen; Cursor steht dann hinter dem Wort, das den Fehler
ausgel<EFBFBD>st hat.
l editiert Screen-Nr. n
view erwartet ein Wort und editiert den Screen, auf dem das
Wort definiert wurde (s.a. >view)
\ *** Block No. 91 Hexblock 5B
\ savesystem for Editor 17aug86we
Damit der Editor auf Schwarz-Wei<65> und Farbmonitoren l<EFBFBD>uft,
m<EFBFBD>ssen die entsprechenden Parameter ermittelt und in die
beiden Arrays, die f<EFBFBD>r die Zwischenspeicherung des Bildschirms
verantwortlich sind, gepatched werden.
F<EFBFBD>r die Zwischenspeicherung werden 2 Buffer benutzt, die ober-
halb des Systems liegen. Nur dadurch kann der Bildschirminhalt
so schnell restauriert werden, wenn Alertboxen oder andere
aufgerufen wurden.
\ *** Block No. 92 Hexblock 5C
\ savesystem for Editor 30aug86we
Diese Routine mu<EFBFBD> beim Start des Systems (!) ausgef<EFBFBD>hrt werden,
setzt die Variablen f<EFBFBD>r die GEM-Routinen des Editors
und f<EFBFBD>r die beiden Speicherdefinitions-Arrays
wird daher nach drvinit gepatched, klinkt sich selbst aus.
savesystem mu<EFBFBD> eine Reihe von Variablen zur<EFBFBD>cksetzen, damit
das System mit 'vern<72>nftigen' Werten hochkommt.
drvinit wird mit edistart gepatched.
FORTH-83.SCR als File f<EFBFBD>r markierten Screen.
ge<EFBFBD>nderte Bl<EFBFBD>cke auf Diskette zur<EFBFBD>ckschreiben
und altes savesystem ausf<EFBFBD>hren.
Neues bye mu<EFBFBD> zus<EFBFBD>tzlich ein GREXIT ausf<EFBFBD>hren. GRINIT bei
Neukompilation n<EFBFBD>tig wegen GREXIT in BYE .
\ *** Block No. 93 Hexblock 5D
\ savesystem for Editor 17aug86we
Damit der Editor auf Schwarz-Wei<65> und Farbmonitoren l<EFBFBD>uft,
m<EFBFBD>ssen die entsprechenden Parameter ermittelt und in die
beiden Arrays, die f<EFBFBD>r die Zwischenspeicherung des Bildschirms
verantwortlich sind, gepatched werden.
F<EFBFBD>r die Zwischenspeicherung werden 2 Buffer benutzt, die ober-
halb des Systems liegen. Nur dadurch kann der Bildschirminhalt
Reference in New Issue Copy Permalink