;===========================================================================
;The word processor written entirely in FAST.
;Developed by Peter Campbell, from 24/9/1987 to ...
;===========================================================================

;wt doesn't use wt.err file anymore - uses built in messages.
;log file is optional - see config options
;wt.hlp not used - contained within wt.f - no missing wt.hlp errors now!
;
;29/06/91 Added CTRL-U and CTRL-I Uppercase line or Lowercase line
;	  WT now uses the default disk:directory to save/load the scrap file.
;
;14/08/91 Fix display when scrolled to right, tabs and line feed characters
;	  were mucking things up.
;
;21/09/92 Change colours
;	  Remove 'compile' option.
;
;19/10/92 Fixup the centre function + screen problems when using up arrow
;

#protect
#errors off
#window memory 4000
#include extinput.fi
#include fsort.fi
#inpend=0
ext_inpend=0

;Screen size !! Change this if setting say EGA 43 lines, probably still bugged.
;** This will not work yet! FAST must be modified to handle variable width.
const width=80,depth=25,lineb=160,width1=width-1    ;lineb=bytes per line.
;const width=80,depth=43,lineb=160,width1=width-1    ;lineb=bytes per line.

const dl=68,name_len=40
const cfglen=10
unsigned md,end_address,current_address,line_address,addl
unsigned block_start,block_end,editm,chkb
var current_column,xpos,ypos,insert,edit_line
var fseg,buffers,current_buffer,backups,last_ypos
var line_print,form_feed,edit_file,line_block,origin_blocka,origin_blockx
var column_block,stab

compile_line ? 128
info	     ? 16*dl
name_bak     ? name_len+6
buffer	     ? 260
sbuffer      ? 260
ebuffer      ? 260
block_type   ? 2
config	     ? cfglen
work	     ? 100

goto skip_undef

seperators:
datab ' !^*()-=+\|.,<>/?''":;[]'
sept_end:
const septs=sept_end-seperators

skip_undef:

proc print_to(ptm,ptn)
    {
    pokeb ptm,(ptn/10)+'0'
    pokeb ptm+1,(ptn mod 10)+'0'
    }

proc write_log(wlf)
    {
    open #10,logfile
    if error then
	{
	if error<>2 then return
	create #10,logfile
	write #10,185 from logtop
	}
    else
	{
	var32 wls
	reg bx=handle #10,cx=-1,dx=-1:dos 42(2)
	n=read #10,1 to work:if peekb work=26
	    then reg bx=handle #10,cx=-1,dx=-1:dos 42(2)
	}

    fill 16 from logline with 2020h
    m=wlf:n=logline
    while peekb m pokeb n,ucase peekb m:m++:n++
    dos 2a
    rday=low reg dx
    rmonth=high reg dx
    ryear=reg cx-1900
    print_to(logline+34,rday)
    print_to(logline+37,rmonth)
    print_to(logline+40,ryear)
    dos 2c
    rhour=high reg cx
    rminute=low reg cx
    print_to(logline+44,rhour)
    print_to(logline+47,rminute)

    write #10,51 from logline
    close #10
    }

proc bottoms
    {
    cursor depth-1,0
    print bios
    }

procedure abort
    {
    bottoms
    stop
    }

proc input_message(imc)
    {
    pokeb input_window+6,imc
    open window input_window
    colour imc
    locate 20,6
    }

on error
    {
    bottoms
    error msg "\dos.err"
    print bios "!"
    stop
    }

proc wt_error(we)	;not severe DOS errors also
    {
    open window severe	;*windows sets error#
    colour peekb (severe+6)
    locate 13,12
    if we<1000 then
	{
	loctocur
	error msg "\dos.err",we
	print bios "!"
	}
    else prints we,0
    beep
    wait for key=27
    close window
    return
    }

proc must_show
    {
    last_address=-1	;Force new page display.
    last_ypos=-1
    }

proc inx  xpos+=current_column:current_column=0

function yesno(default)
    {
    forever
	{
	c=ucase key
	if c='Y' then print bios "Y";:return 1
	if c='N' then print bios "N";:return 0
	if c=27  then return 2
	if c=13  then print bios chr 'N'+default*11;:return default
	}
    }

proc get_config
    {
    load config_name,config,cfglen
    if error then
	{
	moveb 10 from config_defaults to config
	}
    backups=peekb config
    stab=peekb (config+1)
    split_enter=peekb (config+2)
    comments=peekb (config+6)
    keep_tab=peekb (config+7)
    make_log=peekb (config+8)
    moveb 3 from config+3 to default_ext+2
    }

procedure print_name
    {
    colour 63
    locate 1,2
    repeat 40 print " ";
    locate 1,2
    nm=name+2	 ;Print name of file in ucase case with extension.
    while peekb nm
	{
	pokeb nm,ucase peekb nm
	print chr peekb nm;:nm++
	}
    }

function back_line(addl,nlines)
    {
    if nlines then
	{
	repeat nlines
	    {
	    #short
	    if addl=0 then return 0
	    addl--
	    if fseg[addl]b=10 then addl--
	    if fseg[addl]b=13 then addl--
	    if (addl=0) or (addl>65520) then return 0

	    back_loop:
	    b=fseg[addl]b

	    if (b<>13) and (addl>0) then addl--:goto back_loop

	    if b=13 then
		{
		addl++
		if fseg[addl]b=10 then addl++
		}
	    #long
	    }
	}
    return addl
    }

function forward_line(addl,nlines)
    {
    if nlines then
	{
	repeat nlines
	    {
	    na=addl
	    addl=searchb 256 from fseg|addl for 13
	    if not addl then
		{
		addl=na
		forward_loop:
		#short
		if addl>=end_address then return end_address
		if fseg[addl]b<>13 then addl++:goto forward_loop
		#long
		}
	    addl++
	    if fseg[addl]b=10 then addl++
	    if addl>end_address then return end_address
	    }
	}
    return addl
    }

function end_of_line
    {
    start=buffer+254
    while start>=buffer
	{
	#short
	if peekb start<>' ' then goto end_found
	#long
	start--
	}
    end_found:
    return 1+start-buffer
    }

function compress_buffer
    {
    cb_kt=keep_tab
    est=end_of_line+buffer
    st=buffer
    f=sbuffer
    x=0
    while st<est
	{
	b=peekb st
	if cb_kt and (b=' ') then
	    {
	    bl=(x and 248)+8
	    if (bl-x)=1 then goto spput
	    flag=1
	    for a=1 to bl-x
	      if peekb (st+a-1)<>' ' then goto spput
	    next a
	    b=9:st+=a-2:x=bl-1
	    }
	if (b=''') or (b='"') then cb_kt=0
	spput:
	pokeb f,b:f++
	x++:st++
	}
    poke f,0a0dh
    pokeb f+2,1ah
    return f+2-(sbuffer)
    }

proc put_line
    {
    line_dif=0:old_address=editm-300
    if (line_address<>-1) and edit_line then
	{
	line_len=compress_buffer
	next_address=forward_line(line_address,1)
	oldlen=next_address-line_address

	if (end_address-oldlen+line_len) above editm then
	    {
	    wt_error(8)
	    return
	    }

	move (end_address-next_address)/2+1 from fseg|next_address
	    to fseg|line_address+line_len
	moveb line_len from sbuffer to fseg|line_address

	line_dif=line_len-oldlen
	old_address=line_address
	if line_address<block_end then block_end+=line_dif
	if line_address<origin_blocka then origin_blocka+=line_dif
	if line_address<current_address then current_address+=line_dif
	end_address+=line_dif
	edit_file=1
	edit_line=0
	}
    }

procedure put_details
    {
    put_line
    pos=current_buffer*dl+info

    pokeb pos,xpos:pokeb pos+1,ypos
    poke pos+2,current_address
    poke pos+4,current_column
    poke pos+6,end_address
    poke pos+8,fseg
    poke pos+10,editm
    pokeb pos+12,edit_file
    moveb 55 from name+2 to pos+13
    }

procedure get_details
    {
    pos=current_buffer*dl+info

    xpos=peekb pos
    ypos=peekb (pos+1)
    current_address=peek (pos+2)
    current_column=peek (pos+4)
    end_address=peek (pos+6)
    fseg=peek (pos+8)
    editm=peek (pos+10)
    edit_file=peekb (pos+12)
    moveb 55 from pos+13 to name+2

    must_show
    line_address=-1
    print_name
    }

proc word_default
    {
    pokeb default_menu+1,0
    opt=1
    open window default_menu
    wd_back:
    colour peekb (default_menu+6)
    locate 4,58:m=default_ext+2:while peekb m print chr ucase peek m;:m++
    print "  ";
    locate 5,55:if backups then print "ON "; else print "OFF";
    locate 6,58:if split_enter then print "ON "; else print "OFF";
    locate 7,58:printb stab;"  ";
    locate 8,56:if comments then print "/*====*/ "; else print ";=======";
    locate 9,58:if keep_tab then print "YES"; else print "NO ";
    locate 10,58:if make_log then print "YES"; else print "NO ";
    pokeb default_menu+1,8

    opt=select default_menu,opt
    if not opt then close window:return
    if opt=1 then
	{
	open window def_input
	locate 10,69:colour 60h
	l=ext_input(default_ext)
	close window
	}
    if opt=2 then backups=not backups
    if opt=3 then split_enter=not split_enter
    if opt=4 then
	{
	open window tab_input
	push stab
	cursor 7,67
	stab=inputb
	if not stab then pop stab else pop x
	if stab>20 then stab=20
	if stab<1 then stab=1
	close window
	}
    if opt=5 then comments=not comments
    if opt=6 then keep_tab=not keep_tab
    if opt=7 then make_log=not make_log
    if opt=8 then
	{
	pokeb config,backups
	pokeb config+1,stab
	pokeb config+2,split_enter
	pokeb config+6,comments
	pokeb config+7,keep_tab
	pokeb config+8,make_log
	moveb 3 from default_ext+2 to config+3
	save config_name,config,cfglen
	if error then wt_error(error)
	}
    goto wd_back
    }

proc start_buffer
    {
    xpos=0:ypos=0
    current_address=0:current_column=0
    end_address=searchb 65535 from fseg|0 for 26

    editm=65520
    if end_address<40000 then editm=end_address+8000
    modify fseg to (editm/16)+1

    edit_file=0:edit_line=0
    must_show:line_address=-1
    put_details:print_name
    line_block=0:column_block=0
    }

function first_nonblank
    {
    fbx=0
    while (fbx<255) and (peekb (buffer+fbx)=' ') fbx++
    if fbx=255 then fbx=0
    return fbx
    }

procedure set_old
    {
    last_address=current_address
    last_column=current_column
    }

proc cline(cy)
    {
    m=cy*lineb+1
    repeat width video[m]b=31:m+=2
    }

proc fill_block(x1,y1,x2,y2,fc)
    {
    y1+=2:y2+=2
    if x1<0 then x1=0
    if x2<0 then x2=0
    if x1>width1 then x1=width1
    if x2>width1 then x2=width1

    y=2
    while y<y1 cline(y):y++

    while y<=y2
	{
	m=y*lineb+1
	x=0
	while x<x1 video[m]b=31:m+=2:x++
	while x<=x2 video[m]b=fc:m+=2:x++
	while x<width video[m]b=31:m+=2:x++
	y++
	}

    while y<depth cline(y):y++
    }

proc reset_block
    {
    column_block=0
    line_block=0
    fill_block(0,0,width1,depth-3,31)
    }

proc mark_columns(mcx)
    {
    put_line
    reset_block
    column_block=1
    origin_blocka=line_address
    origin_blockx=mcx
    }

proc draw_block
    {
    newx1=xpos:newy1=ypos
    if line_block then newx1=255

    newx2=origin_blockx-current_column
    newy2=0
    sa=current_address
    while (newy2<(depth-2)) and (sa below origin_blocka)
	{
	newy2++
	sa=forward_line(sa,1)
	}

    if newx1>newx2 then swap newx1,newx2
    if newy1>newy2 then swap newy1,newy2

    fill_block(newx1,newy1,newx2,newy2,78)
    }

proc home  current_column=0:xpos=0

proc top_of_file  current_address=0:ypos=0:home

proc put_char(pchr)
    {
    pcx=current_column+xpos
    if pcx<255 then
	{
	if insert then moveb 255-pcx from pcx+buffer to pcx+1+buffer
	pokeb buffer+pcx,pchr
	xpos++
	edit_line=1
	}
    }

function sept(sx)
    {
    sbyte=peekb (buffer+sx)
    return searchb septs from seperators for sbyte
    }

function word_left(wx)
    {
    x=wx
    if x then x--
    if sept(x) then
	{
	while x>=0
	    {
	    if not sept(x) then goto wl2
	    x--
	    }
	return 0
	}

    wl2:
    while x>=0
	{
	if sept(x) then return x+1
	x--
	}
    return 0
    }

function word_right(wx)
    {
    x=wx
    while x<256
	{
	if sept(x) then goto wr2
	x++
	}
    goto wr_end

    wr2:
    while x<256
	{
	if not sept(x) then return x
	x++
	}

    wr_end:
    if x>=end_of_line then return end_of_line
    return wx
    }


proc del(xd) moveb 255-xd from buffer+xd+1 to buffer+xd:edit_line=1

proc back(xd)
    {
    if xd then
	{
	moveb 256-xd from buffer+xd to buffer-1+xd
	xpos--
	}
    edit_line=1
    }

proc clear_line fill 130 from buffer with 2020h:home:edit_line=1

proc clear_eol
    {
    pcx=current_column+xpos
    fillb 256-pcx from buffer+pcx with 20h
    edit_line=1
    }

function make_memory
    {
    fseg=allocate 4096 ;64k
    if error then wt_error(error):return 0
    else fill 32768 from fseg|0 with 1a1ah  ;All end characters.
    return fseg
    }

procedure screen_display
    {
    colour 31:cls:locate 0,0
    colour 48
    print " WT v2.17 By Peter Campbell.      F1-Help   Files   Defaults                    "
    locate 1,0:repeat 80 print " ";
    }

proc parameters
    {
    colour 48
    locate 1,54:print "Col=";current_column+xpos+1;"  ";
    locate 1,63:print "Size=";end_address;"    ";
    }

function insert_block(s,bseg,e,l)
    {
    put_line
    if (end_address+l) > (editm-300) then wt_error(e_maxsize):return 0

    move (end_address-s)/2+1 from fseg|s to fseg|s+l
    moveb l from bseg|e to fseg|s

    if (s below origin_blocka) or (s=origin_blocka) then origin_blocka+=l
    end_address+=l
    edit_file=1:edit_line=0
    must_show:line_address=-1
    return 1
    }

proc split_line(sx,ss)
    {
    fill 128 from ebuffer with 2020h
    moveb 256-sx from buffer+sx to ebuffer+ss
    clear_eol:current_column=0:xpos=end_of_line

    push insert
    insert=1
    put_char(13):put_char(10)
    pop insert

    put_line
    line_address=forward_line(line_address,1)
    edit_line=1
    move 128 from ebuffer to buffer

    must_show
    }

proc centre_line
    {
    if ypos>11 then
	{
	current_address=forward_line(current_address,ypos-11)
	ypos=11
	}
    else
	{
	md=back_line(current_address,11-ypos)
	nd=md
	mc=0
	while mc<=11
	    {
	    if nd>=current_address then current_address=md:ypos+=mc:return
	    nd=forward_line(nd,1)
	    mc++
	    }
	}
    }

proc delete_block(ds,de)
    {
    put_line
    if ds above de then swap ds,de
    move (end_address-de)/2+1 from fseg|de to fseg|ds
    if ds below origin_blocka then
	origin_blocka-=de-ds:if carry then reset_block
    if current_address>ds then
	current_address-=de-ds:if carry then current_address=0
    end_address-=de-ds
    fseg[end_address]b=26
    must_show
    line_address=-1:edit_file=1
    }

proc delete_line
    {
    put_line
    ea=forward_line(line_address,1)
    delete_block(line_address,ea)
    }

function get_column(ea)
    {
    col=0:ga=current_address
    while col<255
	{
	if ga=ea then return col
	byte=fseg[ga]b:ga++
	if (byte=13) or (byte=26) then return col
	if byte=9 then col=(col and 248)+8
	else col++
	}
    wait for key=27
    return 0
    }

proc get_line(ga)
    {
    if line_address=ga then return
    put_line
    if ga above old_address then ga+=line_dif
    line_address=ga

    fill 130 from buffer with 2020h
    col=0
    edit_line=0

    while col<255
	{
	byte=fseg[ga]b:ga++
	if (byte=13) or (byte=26) then return
	if byte=9 then col=(col and 248)+8
	else
	    {
	    pokeb buffer+col,byte
	    col++
	    }
	}
    wt_error(e_ltrunc)
    }

function scrap(do)
    {
    put_line
    line_address=forward_line(current_address,ypos)
    input_message(49):print "Saving block...";

    if line_block or column_block then
	{
	block_start=origin_blocka
	block_end=line_address
	if block_start>block_end then swap block_start,block_end
	}
    else
	{
	block_start=line_address
	block_end=line_address
	}
    block_end=forward_line(block_end,1)

;#if 1
;   print " as: ";
;   ni=ext_input(block_name_i)
;   create #1,block_name_i+2
;#endif
    create #1,block_name:if error then wt_error(error):return

    if not column_block then
	{
	write #1,block_end-block_start from fseg|block_start
	if error then close #1:wt_error(error):return
	if do then
	    {
	    delete_block(block_start,block_end)
	    if block_start<current_address then current_address=block_start
	    }
	}

    if column_block then
	{
	x1=origin_blockx
	xc=xpos+current_column
	if xc<x1 then swap x1,xc
	scrap_len=1+xc-x1
	pokeb block_type,0:pokeb block_type+1,scrap_len
	write #1,2 from block_type
	if error then
	    {
	    wt_error(error)
	    close #1
	    return
	    }

	while block_start<block_end
	    {
	    get_line(block_start)
	    write #1,scrap_len from buffer+x1
	    if error then wt_error(error):close #1:return
	    if do then moveb 256-x1-scrap_len
		from buffer+x1+scrap_len to buffer+x1:edit_line=1
	    block_start=forward_line(line_address,1)
	    }
	put_line
	}

    close #1
    if do then must_show:line_address=-1
    close window
    reset_block
    return 1
    }

proc read_columns
    {
    inx
    scrap_len=peekb (block_type+1)
    scrap_ca=line_address
    if (scrap_len+xpos)>255 then wt_error(e_scrapwide):return

    forever
	{
	get_line(scrap_ca)
	moveb 256-xpos-scrap_len from xpos+buffer to xpos+scrap_len+buffer
	rlen=read #1,scrap_len to buffer+xpos:if error then return
	if rlen<>scrap_len then return
	edit_line=1
	put_line
	scrap_ca=forward_line(scrap_ca,1)
	}
    }

proc join_line(xj)
    {
    x=end_of_line
    if xj<x then xj=x
    ml=forward_line(line_address,1)
    move 128 from buffer to ebuffer
    push line_address
    get_line(ml)
    moveb 256-xj from buffer to ebuffer+xj
    delete_line
    pop line_address
    move 128 from ebuffer to buffer
    edit_line=1

    must_show
    }

proc shift_left
    {
    current_column=0
    xpos=first_nonblank
    xn=(xpos/stab)*stab-stab
    if xn<0 then xn=0
    if xpos then
	{
	moveb 256-xpos from buffer+xpos to buffer+xn
	edit_line=1
	}
    }

proc shift_right
    {
    current_column=0
    xpos=first_nonblank
    xn=((xpos+stab)/stab)*stab
    moveb 256-xn from buffer+xpos to buffer+xn
    fillb xn-xpos from buffer+xpos with ' '
    edit_line=1
    }

procedure page_display
    {
    set_old
    colour 31
    md=current_address

    for yp=2 to depth-1
    locate yp,0
    col=0
    while col<current_column
	{
	#short
	b=fseg[md]b
	if b=13 then goto line_loop2
	if b<>10 then
	    {
	    if b=9 then col=(col and 248)+8 else col++
	    }
	if md=end_address then goto page_end
	md++
	#long
	}

    line_loop:
    col-=current_column
    if col then repeat col print " ";

    line_loop2:
    md=printm fseg|md,width
    if md=end_address then goto page_end
    ffc=fseg[md-1]b
    if (ffc<>13) and (ffc<>10) then
	{
	md=searchb 256 from fseg|md for 13
	if md=0 then goto page_end
	md++
	if fseg[md]b=10 then md++
	if md>=end_address then goto page_end
	}

    page_nl:
    next yp
    return

    page_end:
    m=yp*lineb+lineb
    m2=lineb*depth
    if m<m2 then repeat (m2-m)/2 video[m]b=' ':m+=2
    }

proc print_buffer  ml=printm buffer+current_column,width,0

procedure print_line(py)
    {
    locate 2+py,0
    ma=forward_line(current_address,py)
    get_line(ma)
    last_ypos=py
    print_buffer
    }

function get_directory
    {
    dir_seg=allocate 1024:if error then wt_error(error):return 0
    dir name+2,dir_seg|0:files=dir_seg[0]
    if not files then
	{
	none_dir:
	wt_error(2)

	exit_dir:
	deallocate dir_seg
	return 0
	}

    if not sort(dir_seg,2,13,files) then goto none_dir
    x=0:lx=-1
    open window direct_window
    colour peekb (direct_window+6)
    locate 23,3:print " ";files;" file(s) ";

    forever
	{
	if (x/60)<>lx then
	    {
	    start=(x/60)*60
	    lx=x/60
	    px=2:py=11

	    while py<23
		{
		locate py,px:print "		";:locate py,px
		if start<files then
		    {
		    st=(start*13)+2
		    while dir_seg[st]b print chr dir_seg[st]b;:st++
		    start++
		    }
		px+=16:if px>75 then px=2:py++
		}
	    }

	py=(x mod 60)/5:px=x mod 5
	locate py+11,px*16+2:st=locpos+1:old=st
	repeat 12 video[st]b=27:st+=2

	wait for keypressed:s=scan
	if s=1 then close window:goto exit_dir
	if s=72 then x-=5
	if s=80 then x+=5
	if s=75 then x--
	if (s=77) or (s=15) then x++
	if s=73 then x-=60
	if s=81 then x+=60
	if (s=71) or (x<0) then x=0
	if (s=79) or (x>=files) then x=files-1

	st=old:repeat 12 video[st]b=peekb (direct_window+6):st+=2

	if s=28 then
	    {
	    move 7 from dir_seg|x*13+2 to name+2
	    close window
	    deallocate dir_seg
	    return 1
	    }
	}
    }

function load_buffer(use_command)
    {
    retry_load:
    if buffers=16 then wt_error(e_maxfiles):return 0
    open window input_load_name

    colour peekb (input_load_name+6)
    locate 13,62:print "[.";
    st=default_ext+2
    while peekb st print chr(ucase peek st);:st++
    print "]";

    locate 13,13
    l=1:if not use_command then l=ext_clean_input(name)
    if (peekb (name+2)=0) or (l=0) then close window:return 0

    nm=name+2
    while peekb nm<=' ' nm++
    moveb name_len from nm to name+2

    nm=name+2:cd=0
    while peekb nm cd+=peekb nm='.':nm++
    if not cd then
	{
	pokeb nm,'.'
	move 2 from default_ext+2 to nm+1
	}

    wild=0
    nm=name+2
    while peekb nm
	{
	b=peekb nm
	if (b='*') or (b='?') then wild=1
	nm++
	}
    if wild then if not get_directory then
	{
	close window:use_command=0
	goto retry_load
	}

    locate 13,13:nm=name+2
    while peekb nm print chr(ucase peek nm);:nm++

    fseg=make_memory
    if not fseg then close window:return 0
    fseg[65500]b=1ah
    load name+2,fseg|0,65501
    if error then
	{
	if error<>2 then wt_error(error):close window:return 0
	print "  (new file)"
	repeat 3 repeat 50000 {}
	}
    if fseg[65500]b<>1ah then wt_error(e_file64)

    close window
    current_buffer=buffers
    buffers++
    start_buffer
    return 1
    }

proc display_buffers
    {
    pokeb sel_buf+5,buffers+6 ;Only size for the number of buffers.
    poke sel_buf,1
    open window sel_buf
    start=info+13
    y=6
    colour peekb (sel_buf+6)
    repeat buffers
	{
	pos=start
	locate y,8
	while peekb pos print chr ucase peek pos;:pos++
	if peekb (start-1) then print " (save)";
	y++
	start+=dl
	}
    pokeb sel_buf,1:pokeb sel_buf+1,buffers
    }

function select_buffer
    {
    display_buffers
    y=select sel_buf,current_buffer+1
    close window
    if not y then get_details:return 0
    current_buffer=y-1
    get_details
    return 1
    }

proc set_positions
    {
    while xpos<0
	{
	xpos+=8
	current_column-=8
	if current_column<0 then current_column=0:xpos=0
	}
    while xpos>width1
	{
	xpos-=8
	current_column+=8
	if current_column>176 then current_column=176:xpos=width1
	}
    if ypos<0 then
	{
	ypos=0
	current_address=back_line(current_address,1)
	}
    if ypos>(depth-3) then ypos=depth-3:current_address=forward_line(current_address,1)
    if current_column<0 then current_column=0
    if current_column>176 then current_column=176
    if current_address above end_address then current_address=end_address

    if (current_address<>last_address) or (ypos<>last_ypos) then
	{
	ma=current_address
	yo=0
	if ypos then
	    {
	    repeat ypos
		{
		oldma=ma
		ma=forward_line(ma,1)
		if ma=oldma then ypos=yo:goto get_yo
		yo++
		}
	    }
	get_yo:
	get_line(ma)
	last_ypos=ypos
	}

    if (current_address<>last_address) or (current_column<>last_column) then
	{
	if keypressed then
	    {
	    last_address=-1
	    goto exe_key
	    }
	colour 31
	if current_address=last_address then goto page_all
	md=forward_line(current_address,1)
	if md=last_address then
	    {
	    scroll down 0,2,width1,depth-1,1
	    print_line(0)
	    goto edit_page
	    }
	md=back_line(current_address,1)
	if md=last_address then
	    {
	    scroll 0,2,width1,depth-1,1
	    print_line(depth-3)
	    goto edit_page
	    }

	page_all:
	page_display

	edit_page:
	set_old
	}

    exe_key:

    if (current_address<>last_address) or (ypos<>last_ypos) then
	{
	ma=forward_line(current_address,ypos)
	get_line(ma)
	last_ypos=ypos
	}

    if column_block or line_block then draw_block

    locate ypos+2,0
    print_buffer
    parameters
    if mono
	then cursor size 12-(insert*4),13
	else cursor size 6-(insert*2),7
    cursor ypos+2,xpos
    }

function finds(fs,fe,findseg)
    {
    flen=fe-fs
    while flen
	{
	f=searchb flen from findseg|fs for peekb (findstr+2)
	if f then
	    {
	    m=findstr+3
	    f2=f:fxadd=f
	    while peekb m
		{
		#short
		c=peekb m:m++:f2++
		if c='?' then goto fnchar
		if c<>findseg[f2]b then goto fnext
		fnchar:
		#long
		}
	    if findseg<>reg cs then
		{
		if (findseg[f2-1]b<>10) and (findseg[f2-1]b<>13)
		then current_address=back_line(f2,1)
		else current_address=f2
		}
	    return 1

	    fnext:
	    f++
	    flen=fe-f:fs=f
	    if f above fe then return 0
	    }
	else return 0
	}
    return 0
    }

function find_string
    {
    if finds(buffer+xpos+current_column,buffer+255,reg cs) then
	{
	xpos=f-buffer:current_column=0
	return 1
	}
    nl=forward_line(current_address,ypos+1)
    if finds(nl,end_address,fseg) then
	{
	current_column=0:xpos=get_column(fxadd)
	ypos=0:centre_line
	return 1
	}
    return 0
    }

proc input_find(first)
    {
    if first then
	{
	input_message(15)
	print "Find: ";
	findl=ext_input(findstr)
	c=0:if findl then c=peekb(findstr+2)
	if c=0 then close window:return 0
	findl--
	}
    else xpos++

    if find_string then
	{
	if first then close window
	return 1
	}
    if first then close window

    input_message(12)
    print "Text not found!"
    wait for keyscan
    close window
    if not first then xpos--
    return 0
    }

proc input_replace(first)
    {
    ir=input_find(first):if ir=0 then return
    if first then
	{
	input_message(14)
	print "Replace: ";
	replacel=ext_input(replacestr)
	c=0:if replacel then c=peekb(replacestr+2)
	close window
	if c=0 then return 0
	replacel--
	}

    replace_again:
    if ir then
	{
	last_address=-1:set_positions
	input_message(14)
	print "Replace Yes/No/All or ESC? ";
	wait for keypressed:rk=lcase key:print chr rk;
	replace=0		  ;Default: replace none.
	if rk='y' then replace=1     ;One only.
	if rk='a' then replace=32767	;Max.
	close window
	if rk=27 then return

	if replace=0 then xpos++:ir=find_string
	while (replace<>0) and (ir<>0)
	    {
	    moveb 256-xpos-findl from buffer+xpos+findl to buffer+xpos+replacel
	    moveb replacel from replacestr+2 to buffer+xpos
	    edit_line=1
	    replace--
	    xpos+=replacel:ir=find_string
	    if (replace<>0) and (ir<>0) then set_positions
	    }
	if replace then last_address=-1:set_positions
	goto replace_again
	}
    }

proc print_file
    {
    input_message(49):loctocur
    print bios "Print current Scrap or File? (s/f) ";
    wait for keypressed
    pk=lcase key
    print bios chr pk;" ... ESC aborts.";

    if pk='s' then
	{
	lps=allocate 4096:if error then wt_error(8):goto end_lprint
	fill 32768 from lps|0 with 1a1ah
	load block_name,lps|0
	if error then wt_error(error):goto lp_deall
	if lps[0]b then
	    {
	    m=0
	    while lps[m]b<>1ah
		{
		lprint chr lps[m]b;:m++
		if key=27 then goto lp_deall
		}
	    }
	else
	    {
	    scrap_len=lps[1]b
	    m=2:c=scrap_len
	    while lps[m]b<>1ah
		{
		lprint chr lps[m]b;
		m++
		c--
		if c=0 then lprint:c=scrap_len
		}
	    }
	lp_deall:
	deallocate lps
	}
    else if pk='f' then
	{
	m=0
	while fseg[m]b<>1ah
	    {
	    lprint chr fseg[m];:m++
	    if key=27 then goto end_lprint
	    }
	}

    end_lprint:
    close window
    }

proc load_file
    {
    x=load_buffer(0)
    if not x then
	{
	if not buffers then abort
	get_details
	}
    }

proc save_file(new_nameq)
    {
    put_line
    if new_nameq then
	{
	input_message(79)
	print "Save file as: ";
	l=ext_input(name)
	close window
	if not l then return
	print_name
	}

    moveb name_len+6 from name+2 to name_bak
    f=searchb name_len+6 from name_bak for '.'
    if not f then f=searchb name_len+6 from name_bak for 0
    if f then moveb 5 from bak_extension to f

    if backups then
	{
	delete name_bak ;If error then assume doesn't exist.
	rename name+2 to name_bak:if error>2 then wt_error(error):return
	}

    create #1,name+2:if error then wt_error(error):return
    write #1,end_address+1 from fseg|0
    if error then wt_error(error):close #1:return
    close #1

    if make_log then write_log(name+2)

    edit_file=0:edit_line=0
    put_details
    }

proc save_alter
    {
    if edit_file then
	{
	open window save_altered_file
	retry_yesno:
	cursor 12,51
	wait_yesno:
	byte=lcase key
	if byte=27 then close window:return
	if (byte<>'y') and (byte<>'n') then goto wait_yesno
	close window
	if byte='y' then save_file(0)
	if byte='n' then edit_file=0
	}
   }

proc exe(ad)
    {
    close windows
    colour 31:cls
    cursor 0,0

    poke exe_com+4,reg cs
    poke exe_com+8,reg cs
    poke exe_com+12,reg cs

    m=ad
    while peekb m print bios chr lcase peek m;:m++
    m=compile_line+1
    while peekb m<>13 print bios chr lcase peek m;:m++
    print bios

    execute ad,exe_com
    if error then wt_error(e_exeerr)
    }

proc exit_file(flag)
    {
    if flag then
	{
	if not select_buffer then return
	save_alter
	if edit_file then return
	}

    parameters
    deallocate fseg

    if current_buffer<>(buffers-1) then moveb ((buffers-1)-current_buffer)*dl
       from info+(1+current_buffer)*dl to current_buffer*dl+info

    buffers--
    current_buffer=0
    get_details
    if not buffers then load_file
    }

proc exit_wordq
    {
    eflag=0
    for file=0 to buffers-1
    current_buffer=file
    get_details
    if edit_file then
	{
	if eflag=0 then
	    {
	    eflag=1
	    pokeb wind_files+5,buffers+5
	    open window wind_files:y=4
	    }
	colour peekb (wind_files+6)
	locate y,2
	nm=name+2
	while peekb nm print chr ucase peek nm;:nm++
	y++
	}
    next file

    while eflag
	{
	eflag=0
	no=0
	locate y,2
	colour peekb (wind_files+6)
	print "Save file(s)? y/n ";
	no_againq:
	loctocur
	wait for keypressed
	r=ucase key
	if r='N' then
	    {
	    if no then abort
	    no=1:beep:goto no_againq
	    }
	close window
	if r<>'Y' then return
	for file=0 to buffers-1
	current_buffer=file
	get_details
	if edit_file then save_file(0):if edit_file then eflag=1
	next file
	}

    abort
    }

proc help_me
    {
    must_show
    colour 23
    scroll 0,2,79,24,0
    locate 3,0
    print "            WT HELP  --  WORD TURBO WRITTEN BY PETER CAMPBELL 1988."
    print
    print " FUNCTION KEYS    ALT-S  Split line               ALT-N  Edit next file"
    print "ÚÄÄÄÄÄÄÂÄÄÄÄÄÄ¿   ALT-J  Join lines               ALT-X  Exit WT (save?)"
    print "³  F1  ³  F2  ³   ALT-U  Undo changed line"
    print "³ HELP ³ EDIT ³   ALT-E  Erase line               ALT-B  Start block mark"
    print "ÃÄÄÄÄÄÄÅÄÄÄÄÄÄ´   ALT-K  Erase to end of line     ALT-A  Mark from beginning"
    print "³  F3  ³  F4  ³   ALT-G  Goto line                ALT-Z  Mark to end"
    print "³ SAVE ³ LOAD ³   ALT-1  Set place.               ALT-W  Mark word"
    print "ÃÄÄÄÄÄÄÅÄÄÄÄÄÄ´   ALT-2  Return to place.         ALT-L  Mark line"
    print "³  F5  ³  F6  ³   ALT-T  Join line (remove gap)   ALT-R  Repeat line"
    print "³ FIND ³ REPL ³"
    print "ÃÄÄÄÄÄÄÅÄÄÄÄÄÄ´   Shft-F5  Find next string       Shft-Minus  Delete to scrap"
    print "³  F7  ³  F8  ³   Shft-F6  Replace next string    Shft-Plus   Copy to scrap"
    print "³ LEFT ³ RGHT ³                                   Shft-Insert Insert scrap"
    print "ÃÄÄÄÄÄÄÅÄÄÄÄÄÄ´   Shft-F7  Move left then down"
    print "³  F9  ³  10  ³   Shft-F8  Move right then down   CTRL-T    Top of screen"
    print "³ PRNT ³ SPCE ³                                   CTRL-C    Centre screen"
    print "ÀÄÄÄÄÄÄÁÄÄÄÄÄÄÙ   ALF-F3   Save & remove file     CTRL-B    Bottom screen"
    print
    print "CTRL-U Uppercase  CTRL-E   Expand buffer (64K)    CTRL-Y    Delete line"
    print "CTRL-I Lowercase                                  CTRL-Bksp Delete Line";
    wait for keyscan
    return
    }

proc word_files
    {
    word_start:
    put_details
    sw=menu files_menu:goto word_files2
    forever
	{
	sw=select files_menu,sw
	word_files2:
	if not sw then close window:return
	if sw=1 then exit_file(1):if not buffers then abort
	if sw=2 then
	    {
	    poke compile_line,0d01h
	    exe(dos_shell)
	    goto entry
	    }
	if sw=3 then exit_wordq
	}
    }

;- main entry ---------------------------------------------------------------

get_config
buffers=0
screen_display
insert=1

nm=81h
while peekb nm<>13
    {
    if peekb nm>' ' then
	{
	pokeb name+1,peekb 80h-nm+81h
	moveb name_len from nm to name+2
	m=searchb name_len from name+2 for 13
	if m then pokeb m,0
	if not load_buffer(1) then abort
	goto entry
	}
    nm++
    }

if not load_buffer(0) then abort

entry:
screen_display
page_display
print_name
must_show
line_address=-1

edit:
set_positions

wait for keypressed
ks=keyscan
k=low ks:s=high ks

;Handle keypad cursor movement.
if ks=18688 then current_address=back_line(current_address,23):goto edit
if ks=20736 then current_address=forward_line(current_address,23):goto edit
if peekb 0|417h and 16 then
    {
    if ks=18432 then current_address=back_line(current_address,1):goto edit
    if ks=20480 then current_address=forward_line(current_address,1):goto edit
    if ks=19200 then current_column-=stab:goto edit
    if ks=19712 then current_column+=stab:goto edit
    }
else
    {
    if ks=18432 then ypos--
    if ks=20480 then ypos++
    if ks=19200 then xpos--
    if ks=19712 then xpos++
    }
if ks=18176 then home
if ks=20224 then current_column=0:xpos=end_of_line
if ks=30464 then ypos=0
if ks=29952 then ypos=depth-3
if ks=33792 then top_of_file
if ks=30208 then
    {
    current_address=back_line(end_address,depth-3)
    ypos=depth-3:home
    }
if ks=18231 then xpos=first_nonblank:goto edit
if ks=29440 then inx:xpos=word_left(xpos)
if ks=29696 then inx:xpos=word_right(xpos)

;Special character movement functions.
if ks=3840 then xpos=(xpos/stab)*stab-stab
if ks=3849 then
    {
    newx=((xpos+stab)/stab)*stab
    if insert then
	{
	if (newx+current_column)>255 then newx=0
	while newx>xpos
	    {
	    put_char(' ')
	    }
	}
    else xpos=newx
    goto edit
    }
if ks=20992 then insert=not insert
if ks=21248 then del(current_column+xpos)
if ks=3592 then back(current_column+xpos):goto edit
if ks=4608 then clear_line
if ks=9472 then clear_eol

;Line functions.
if k=13 then
    {
    enter_line:
    enx=first_nonblank
    if not split_enter then current_column=0:xpos=end_of_line
    split_line(xpos+current_column,enx)
    ypos++:xpos=enx:current_column=0
    goto edit
    }
if ks=17408 then
    {
    push insert
    insert=1
    put_char(' '):xpos--
    pop insert
    }
if ks=5632 then
    {
    line_address=-1
    ma=forward_line(current_address,ypos)
    get_line(ma)
    last_ypos=ypos
    home
    }
if (ks=5401) or (ks=3711) then
    {
    delete_line
    goto edit
    }
if ks=7936 then
    {
    split_line(xpos+current_column,0)
    ypos++:home
    }
if ks=9216 then join_line(xpos+current_column)
if ks=5120 then
    {
    atx=end_of_line+1
    join_line(atx)
    repeat 254
	{
	if peekb(buffer+atx)<>' ' then goto exit_at
	del(atx)
	}
    exit_at:
    }
if ks=16640 then shift_left
if ks=16896 then shift_right
if ks=23040 then shift_left:ypos++:must_show
if ks=23296 then shift_right:ypos++:must_show
if ks=27648 then
    {
    home
    push insert
    insert=1
    if comments
	then put_char('/'):put_char('*')
	else put_char(';')
    repeat 75 put_char('=')
    if comments then put_char('*'):put_char('/')
    pop insert
    split_line(xpos+current_column,0)
    ypos++:home
    }

;Pop-up menu keys.
if ks=8448 then word_files
if ks=8192 then word_default

;Special ALT/CTRL-key functions.
if (ks=12544) and (buffers>1) then
    {
    put_details
    current_buffer++
    if current_buffer=buffers then current_buffer=0
    get_details
    }
if ks=8704 then
    {
    input_message(113):loctocur
    print bios "Goto line: ";
    curtoloc
    gline=input
    n=video[locpos]b
    close window
    if n>='0' then
	{
	top_of_file
	if gline then gline--
	current_address=forward_line(current_address,gline)
	}
    }
if ks=5140 then
    {
    current_address=forward_line(current_address,ypos)
    ypos=0:goto edit
    }
if ks=12290 then
    {
    current_address=back_line(current_address,depth-3-ypos)
    ypos=depth-3:goto edit
    }
if ks=11779 then centre_line:goto edit
if ks=4613 then
    {
    if editm<>65520 then
	{
	fseg2=allocate 4096:if error then wt_error(error):goto edit
	moveb end_address+1 from fseg|0 to fseg2|0
	deallocate fseg
	fseg=fseg2:editm=65520
	}
    goto edit
    }
if ks=5653 then
    {
    for m=buffer to buffer+255
    pokeb m,ucase peekb m
    next m
    edit_line=1
    goto edit
    }
if ks=5897 then
    {
    for m=buffer to buffer+255
    pokeb m,lcase peekb m
    next m
    edit_line=1
    goto edit
    }

;File option keys.
if ks=15104 then help_me
if ks=15360 then put_details:b=select_buffer
if ks=15616 then save_file(1)
if ks=15872 then put_details:load_file
if ks=11520 then put_details:exit_wordq
if ks=17152 then put_details:print_file:must_show:line_address=-1
if ks=27136 then
    {
    put_details
    if edit_file then save_file(0)
    exit_file(0)
    goto edit
    }

;Find/replace options.
if ks=16128 then input_find(1)
if ks=16384 then input_replace(1)
if ks=22528 then input_find(0)
if ks=22784 then input_replace(0)

;Blocks
if ks=9728 then
    {
    if line_block then reset_block
    else
	{
	put_line
	reset_block
	line_block=1
	origin_blockx=0
	origin_blocka=line_address
	}
    }
if ks=12288 then
    {
    if column_block then reset_block
    else mark_columns(xpos+current_column)
    }
if ks=20011 then
    {
    if peekb 0|417h and 3 then n=scrap(0):goto edit
    }
if ks=18989 then
    {
    if peekb 0|417h and 3 then n=scrap(1):goto edit
    }
if ks=4864 then
    {
    put_line
    id=forward_line(line_address,1)
    if insert_block(line_address,fseg,id,id-line_address) then ypos++
    }
if ks=21040 then
    {
    put_line
    input_message(49):print "Inputting block..."
    open #1,block_name:if error then goto cs_error
    seek #1,eof:block_len=reg ax
    if carry then close #1:goto cs_error
    c=end_address+block_len:if carry then
	{
	wt_error(e_scraplong):close #1:close window:goto edit
	}
    seek #1,0
    two=read #1,2 to block_type
    if (two<>2) or (error<>0) then goto cs_error
    if not peekb block_type then read_columns:goto readi2
    ;Read lines.
    ola=line_address
    if insert_block(line_address,fseg,0,block_len) then
	{
	seek #1,0
	read_len=read #1,block_len to fseg|ola
	if read_len<>block_len then goto cs_error
	}
    readi2:
    close #1:close window
    reset_block:must_show:line_address=-1
    goto edit

    cs_error:
    wt_error(error)
    close window
    goto edit
    }
if ks=7680 then mark_columns(0)
if ks=11264 then mark_columns(end_of_line)
if ks=4352 then
    {
    inx:x=word_right(xpos):x=word_left(x):xpos=x:mark_columns(x)
    while xpos<256
	{
	if sept(xpos) then xpos--:goto edit
	xpos++
	}
    }

if k then if k<>26 then put_char(k)
goto edit

;== WT data ================================================================

dos_shell:	fname '\command.com'
block_name:	fname 'wt.ins'
logfile:	fname 'wt.log'
config_name:	fname 'wt.cfg'
bak_extension:	fname '.BAK'

comp_input:	string 50
itext:		string 30
block_name_i:	string 20

eol_code:	datab 13
default_ext:	datab 4,0,'F',0,0,0

exe_com:
data 0
data compile_line,0
data 5ch,0
data 6ch,0

direct_window:
datab 0,0,0,10,79,23,63,26

severe:
datab 0,0,10,11,70,16,4fh
datab 22,16,4,'Press ESC'
datab 26

name:
data name_len
space name_len+8

input_load_name:
datab 0,0,11,9,69,16,64
datab 22,2,2,'Enter exact file name or use wild cards for directory.'
datab 26

save_altered_file:
datab 0,0,24,10,55,14,1001111b
datab 22,2,2,'Save changed file? (Y/N)'
datab 26

save_errorw:
datab 0,0,16,7,65,12,1001110b
datab 22,16,2,'Error saving file!'
datab 22,2,3,'Press escape to abort, any other key to retry'
datab 26

files_menu:
datab 1,3,30,2,51,8,32
datab 22,6,1,	  'Files Menu'
datab 22,2,3,'Remove file'
datab 22,2,4,'DOS shell'
datab 22,2,5,'Exit editor  ALT-X'
datab 26

sel_buf:
datab 1,0,6,3,73,16,32
datab 22,28,1,'Select a File'
datab 26

def_input:
datab 0,0,52,8,75,12,60h
datab 22,3,2,'New default : '
datab 26

tab_input:
datab 0,0,55,5,74,9,15
datab 22,2,2,'New tab = '
datab 26

default_menu:
datab 1,0,45,1,70,12,47
datab 22,2,1,'WT Defaults'
datab 22,2,3,'Extension:'
datab 22,2,4,'Backups'
datab 22,2,5,'Line split'
datab 22,2,6,'Tab step = '
datab 22,2,7,'Comments'
datab 22,2,8,'Keeps tabs'
datab 22,2,9,'Create Log'
datab 22,2,10,'Save configuration'
datab 26

input_window:
datab 0,0,4,18,75,22,120
datab 26

config_defaults:
datab 1,4,0,'F',0,0
datab 0,1,0,0

findstr: string 30
replacestr: string 30
space 1

wind_files:
datab 0,0,0,3,40,1,79,26

logtop:
datab 'WT text editor log file: By Peter Campbell',13,10,13,10
datab 'Program				 Date	   Time   Notes',13,10
datab '-------------------------------------------------------------------------------',13,10
logline:
datab ' 				 ??/??/??  ??:??',13,10

e_maxsize:   fname 'Maximum file size exceeded, CTRL-Expand!'
e_ltrunc:    fname 'Line too long: truncated!'
e_scrapwide: fname 'Scrap to wide for line!'
e_maxfiles:  fname 'Maximum files (16) already loaded!'
e_exeerr:    fname 'Error executing program!'
e_scraplong: fname 'Scrap too long!'
e_file64:    fname 'File exceeds 64K, excess ignored (DONT SAVE)!'