BorayLetter Source

Just for the purpose to show how much work it is to make a big program like BorayLetter or Selector, here is the program listing for BorayLetter. It's about 6500 lines of code (without the includes). And it's not just to write all those 6500 lines of code in! First you have to think it out and then you have to test it as well. This program is very reliable. It's probably 99.9% bug free...

The includes are not here so you can't compile it if you try to. It's written in Hisoft Basic 2 pro - a fast, compiling and system friendly basic for the Amiga. You are not allowed to use this source code (or any part of it) in any way. You are only allowed to look at it here.

When I started to make this program (in 1991), I came directly from the BASIC V2 on the C64. I wasn't familiar with structured programming at all, so you WILL find some GOTO statements in the program :-) But this version is from 1999, so it's a bit better - but where are all the comments? I can't find ONE comment....! Well, REAL programmers don't need them anyway, or? :-)

bletter6100016.bas

rem $array
rem $nowindow
rem $heapdynamic
rem $to C:BL

defint a-z


'rem $include borayletter.bh

'library declare "dos.library"
'DECLARE FUNCTION Execute& LIBRARY

dim shared dyn
dyn=300
cards=100
dim shared org$(dyn), ny$(dyn)


ver$="6.1 beta6"
'ver$="6.0"

cur$="New Letter"


bver$="*** BorayLetter "+ver$+" ***"
bpos=21-len(bver$)/2 : if bpos<1 then bpos=1




tempdir$="ram:BL"+ltrim$(rtrim$(str$(timer)))
tempdir2$=tempdir$+".2"
tempdir3$=tempdir$+".3"

tmf$=tempdir$+".s"

rem $include helpdata.bas
rem $include icons.bas


sub putfile(byval a$)
	read size
	
	read ylle
	r$=space$(ylle*4+8)
	for t=0 to ylle-1
		read a&
		xpokel sadd(r$)+t*4, a&
	next t
	
	i=freefile
	open a$ for output as #i
		print #i,left$(r$,size);
	close i
	
	r$=""

end sub





logo:
rem $include logo.bas

sub xpokew(byval a&,byval v%)
	p&=varptr(v%)
	pokeb a&,peekb(p&)
	pokeb a&+1,peekb(p&+1)
end sub

sub xpokel(byval a&,byval v&)
	p&=varptr(v&)
	pokeb a&,peekb(p&)
	pokeb a&+1,peekb(p&+1)
	pokeb a&+2,peekb(p&+2)
	pokeb a&+3,peekb(p&+3)
end sub

function xpeekw%(byval a&)
	static v%
	p&=varptr(v%)
	pokeb p&,peekb(a&)
	pokeb p&+1,peekb(a&+1)
	xpeekw%=v%
end function

function xpeekl&(byval a&)
	static v&
	p&=varptr(v&)
	pokeb p&,peekb(a&)
	pokeb p&+1,peekb(a&+1)
	pokeb p&+2,peekb(a&+2)
	pokeb p&+3,peekb(a&+3)
	xpeekl&=v&
end function


library open "exec.library"
library open "dos.library"
library open "intuition.library"
library open "asl.library"



	startdir$=space$(512)
	x=GetCurrentDirName(sadd(startdir$),500)
	startdir$=peek$(sadd(startdir$))


function sdir$(byval g$)
	static u$
	u$=g$

	if right$(u$,1)<>":" and right$(u$,1)<>"/" then u$=u$+"/"
	if left$(u$,9)=="RAM DISK:" then u$="RAM"+right$(u$,len(u$)-8)
	
	sdir$=u$
end function

function lha%(byval fil$)
	static ei%, a$

	ei%=freefile
	if not fexists(fil$) then lha%=0 : exit function
	if right$(fil$,1)=":" or right$(fil$,1)="/" or fil$="" then lha%=0 : exit function

	open fil$ for input as #ei%
	if lof(ei%)>=5 then
		a$=input$(5,ei%)
	else
		a$=""
	end if
	close ei%
	
	if right$(a$,3)=="-lh" then
		lha%=-1
	else
		lha%=0
	end if
end function

function samefile%(a$,b$)
	static aa$,bb$
	
	aa$=""
	bb$=""
	
	q=freefile
	if fexists(a$) then
		open a$ for input as #q
		aa$=input$(lof(q),q)
		close q
	end if
	if fexists(b$) then
		open b$ for input as #q
		bb$=input$(lof(q),q)
		close q
	end if
	
	if aa$=bb$ then
		samefile%=-1
	else
		samefile%=0
	end if
	
	aa$=""
	bb$=""
end function

katalog$=sdir$(startdir$)
make=0
install=0

if sluta=0 then

	kam$=command$
	chop kam$,y$
	if y$=="make" then
		make=1
		chop kam$,make$
		if make$<>"" and (not make$=="yam") then fullname make$
	elseif y$=="install" then
		install=1
	elseif y$="?" then
		print "Boray Letter "+ver$
		print "Copyright ©1991-1999 by Anders Persson"
		print
		print "Usage:"
		print "BL                  ;Normal start, goto main menu"
		print "BL        ;Read the file"
		print "BL make             ;Start in make mode"
		print "BL make   ;Start in make mode and save file"
		print "BL make yam         ;Start in make mode and send via YAM"
		print "BL install          ;Start in install mode"
		goto slutet
	else
		if command$<>"" then
			com$=command$
			if peekl(systab+8)<>0 then com$=""""+command$+""""
			chop com$,ms$
			if not fexists(ms$) then
				if peekl(systab+8)<>0 then make$=command$ : make=1 : fullname make$ : goto potta
				print "BL: "+ms$+" not found."
				goto slutet
			end if
			b$=ms$ : dir b$
			chdir b$
			if b$="" then
			elseif instr(b$,":")=0 then
				katalog$=sdir$(katalog$)+b$
			else
				katalog$=b$
			end if
			file ms$
			if not left$(ms$,6)=="YAMmsg" then cur$=ms$
			sluta=1
		end if
	end if
end if

potta:

SUB SHELL(byval cd$)
	shared tmf$
	ee=freefile
	open tmf$ for output as #ee
	print #ee,"Failat 21"
	print #ee,cd$
	close #ee
'	x&=Execute&(SADD("type "+tmf$+CHR$(0)), 0, 0)
	x&=Execute&(SADD("execute "+tmf$+CHR$(0)), 0, 0)
	x&=Execute&(SADD("delete >Nil: "+tmf$+CHR$(0)), 0, 0)
END SUB


poke systab+33,0

dim shared kickver%

kickver%=peekw(library("exec.library")+lib_version%)
'kickver=37

if kickver<37 then
	? "BL: This program requires Kickstart V37 or higher!"
	system
end if



dim shared cachemax%, cachemem&, cachemaxmod%

cachemax%=15
cachemaxmod%=cachemax%+1
cachemem&=65536

dim shared cache$(cachemax%), cachen$(cachemax%), cachepos%

gosub envdef

codes:
data 131,132,133,134,17,130,129,137,138,135,5,136,127,23,159,19,0,2,1,9,25,21,4
data 20,15,29,31,30,28,158,24,26,18,157,156,22,155,154,153,27
data 152,151,150,149,148,147,146,145,144,143,142,-1


restore codes
do
	read a
	if a<>-1 then codes$=codes$+chr$(a)
loop until a=-1

djup=3
only=0
med=2
wom$=""
rom$=""
romp&=1
roml&=0
rem on error goto programfel
mac&=54500
dim q%(50),w%(mac&),bw%(mac&), bb&(400)
dim irg!(31),g!(31),b!(31)
dim anim$(cards)
dim shared sm&(8)

dis$=cur$
maxx=32

if fexists("S:BLnew.config") then
	open "S:BLnew.config" for input as #8
	input #8, djup
	input #8, maxx
	input #8, med
	close 8
end if

if fexists("S:BLscreenmodes.config") and kickver>37 then
	open "S:BLscreenmodes.config" for input as #8
	for t=0 to 8
		input #8, sm&(t)
	next
	close 8
end if



function fileok%(fil$)
if fexists(fil$) then
	call yesno(a$,"Warning, the file:",left$(fil$,31),"exists!","Do you want to overwrite it?")
	if a$=="y" then
		fileok%=-1
	else
		fileok%=0
	end if
else
	fileok%=-1
	
end if
end function


LIBRARY "graphics.library"
declare sub WaitTOF library
declare sub WaitBlit library
DECLARE FUNCTION OpenFont& LIBRARY
goto wex
FONT:
IF pFont&<>0 THEN CALL CloseFont(pFont&)
fontName0$="topaz.font"+CHR$(0)
textAttr&(0)=SADD(fontName0$)
textAttr&(1)=8*65536& + 0*256 + 0
pFont&=OpenFont&(VARPTR(textAttr&(0)))
IF pFont& <> 0 THEN SetFont WINDOW(8),pFont&
return
WEX:

function GetFile%(fil$,title$,mode%,pat$,typ$)
	shared frsystem%, med, yllefis
	
	call GetFile_asl(ret%,fil$,title$,mode%,pat$,typ$)
	
	GetFile%=ret%
	
end function


sub screenmode(s&, byval a$, minx&, miny&)
	shared bb&()
	
	if kickver<38 then
'		messwait "Only available in V38+"
		s&=0
		exit sub
	end if
	
	sc&=xpeekl&(systab+12)
	tl&=varptr(bb&(0))
	if s&=0 then s&=167936

if sc&<>0 then
	taglist tl&, ASLSM_Screen&, sc&, _
	ASLSM_TitleText&, sadd(a$+chr$(0)), _
	ASLSM_InitialDisplayID&, s&, _
	TAG_END&
else
	taglist tl&, _
	ASLSM_TitleText&, sadd(a$+chr$(0)), _
	ASLSM_InitialDisplayID&, s&, _
	TAG_END&
end if

urgo:

requester& = AllocAslRequest&(ASL_ScreenModeRequest&,0)
res& = AslRequest&(requester&,tl&)

if res&=0 then FreeAslRequest&(requester&) : goto urgo
if peekl(requester&+sm_DisplayWidth%)"" then
		if fexists(typ$) then fil$=typ$
		if typ$=bl0$ then setext fil$,".bl"
	end if
	
	dir$=fil$
	dir dir$
	f$=right$(fil$,len(fil$)-len(dir$))
	tl&=varptr(bb&(0))
	
	sc&=xpeekl&(systab+12)


	y$=space$(60)
	
	if pat$="" then pat$="#?"
	
'	slask=ParsePatternNoCase(sadd(pat$+chr$(0)),sadd(y$),55)
	
	
if mode=-4 then
	taglist tl&, ASLFR_Screen&, sc&, _
	ASLFR_InitialDrawer&, sadd(dir$+chr$(0)), _
	ASLFR_InitialFile&, sadd(f$+chr$(0)), _
	ASLFR_TitleText&, sadd(title$+chr$(0)), _
	ASLFR_DrawersOnly&, 1, _
	TAG_END&
else
	taglist tl&, ASLFR_Screen&, sc&, _
	ASLFR_InitialDrawer&, sadd(dir$+chr$(0)), _
	ASLFR_InitialFile&, sadd(f$+chr$(0)), _
	ASLFR_TitleText&, sadd(title$+chr$(0)), _
	ASLFR_DoPatterns&, 1, _
	ASLFR_InitialPattern&, sadd(pat$+chr$(0)), _
	TAG_END&
end if

'ASLFR_RejectPattern& (UBYTE *)
'ASLFR_AcceptPattern&, sadd(y$+chr$(0)), _


	r&=AllocAslRequest&(ASL_FileRequest, 0)
	
	if r&<>0 then
		a&=AslRequest&(r&, tl&)
		if a&<>0 then
			ret%=1			
			x$=peek$(xpeekl&(r&+fr_File%))
			y$=peek$(xpeekl&(r&+fr_Drawer%))
			FreeAslRequest(r&)
			
			if y$<>"" and right$(y$,1)<>":" and right$(y$,1)<>"/" then y$=y$+"/"
			if mode=0 then
				fil$=y$+x$
				if x$="" then ret%=0 : fil$=""
			elseif mode=2 then
				fil$=y$+x$
			else
				fil$=y$
			end if
			typ$=fil$
			fullname typ$
		else
			ret%=0 : fil$=""
		end if
	else
		qetfile%=0 : fil$=""
	end if

end sub



'worked=GetFile(namn$,"Load Data:",1)

if fexists("S:Bletter.cache") then
	open "S:BLetter.cache" for input as #1
	input #1,cachemem& : close 1
end if

'if ms$="" then
'	if fexists(PD$+"Bletter.prefs")=-1 then
'		open PD$+"Bletter.prefs" for input as #1
'		line input #1,katalog$ : line input #1,ms$
'		close 1
'		if fexists(katalog$)=-1 then chdir katalog$
'	end if
'end if

shell "run >NIL: sys:System/RexxMast >nil:"
shell "run >NIL: Rexxmast >NIL:"
shell "run >NIL: SYS:rexxc/rx >nil: """""

rem $include scrolltext.bas

as$=" (990502)"+as$

if fexists("env:blmail") then
	open "env:blmail" for input as #8
	line input #8,mail$
	close 8
end if


dim men$(20), man$(20)

rem on error goto programfel
if fexists(ms$) then gosub loadrom : jepp=1

start:

if peekl(systab+12)<>0 then
	do : delay 1 : loop until mouse(0)=0
end if

viktor=0
womb$=""
med2=0
yam=0
'loadcopy$=""
iii=0
'incr opri
rem on error goto programfel

if spelar=1 then
	b$="n"
	if sluta=1 and spelarnu=1 and jepp=0 and plus$="" then yesno b$,"","End of letter...","Continue listening to music?",""
	if b$=="n" or sluta=0 then
		spelar=0
		spelarnu=0
		hip "quit"
	end if
end if

'cback$=""

if djup=1 then djup=2
stanna&=-1
anim=0 : animp=0 : gilbert=0
romp&=1
roml&=len(rom$)

gosub deltemp

menu0%=0
anim$(0)=""
for t=0 to cards
	anim$(t)=""
next t

randomize timer

if help=1 then help=0 : a$="a" : cn$=cnback$ : goto sen
if jepp=1 then da=1 : Oldmike=0 : goto ladda
if sluta=1 and plus$="" then slutet
if make=1 then sen

sluta=0
ppinsert=0
rest$=""

if backdir$<>"" then
	katalog$=backdir$
	chdir katalog$
	backdir$=""
end if

if Oldmike=0 then

if sm&(0)=0 and kickver>37 then
	screenmode sm&(0), "Choose 640x251 display", 640,200

	open "S:BLscreenmodes.config" for output as #8
	for t=0 to 8
		print #8, sm&(t)
	next
	close 8
end if


grest1:
rem on error goto programfel
grest=1
if kickver>37 then
	screen 1,640,251,3,5,sm&(0)
else
	screen 1,640,251,3,2
end if
grest=0
gosub screencenter
window 1,"",(0,4)-(640,247),128+16+256,1


menu reset

gosub font
Oldmike=1
gosub 13


end if
color 1,3,1 : cls
'cn$=PD$+"logo"
'gosub cload

restore logo
read ylle
for t=0 to ylle-1
	read w%(t)
next t

'line(0,0)-(320,60),1,bf
'put (18,7),w%,pset

i!=(27*6)/1000 : i!=i!*4.5 : palette 4,i!,i!,i!
palette 6,.5+i!/4, .5+i!/4, 0.8+i!/10
'palette 6,.5+i!/4, 0.8+i!/10, .5+i!/4
i!=1-i! : palette 5,i!,i!,i!

waitblit
put (0,0),w%,pset
line (0,243)-(640,250),2,bf


w%(0)=0 : w%(1)=0
jam=1

for t=0 to cachemax : cache$(t)="" : cachen$(t)="" : next t
ctot2&=0 : cloads2&=0 : dloads2&=0
if ctot3&>cachemem& then ctot3&=cachemem&

yllefis=0
locate 12,bpos
color 2,7
print bver$


'locate 28,48
color 7,3
'print right$(date$,4);"-";left$(date$,5)
locate 29,41
print " Copyright 1991-1999 by Anders Persson";

locate 2,45
color 7,3
print "Current File:"
color 0,7
locate 3,45
print dis$+plus$

oride=0
ori=0

 men$(0)="    Make A New Letter    [M]"
 man$(0)="m"
 men$(1)="       Read Letter       [R]" 'R
 man$(1)="r"
 men$(2)="   Continue Making (Add) [A]" 'A
 man$(2)="a"
 men$(3)=""
 men$(4)="   Load & Read Letter    [L]" 'L
 man$(4)="l"
 men$(5)="       Save Letter          "
 man$(5)="exp"
if mail$<>"" then
 men$(6)=" Send This Letter Via Email "
else
 men$(6)="  Send This Letter Via YAM  "
end if
 man$(6)="exp2"
 men$(7)=""
 man$(7)=""
 men$(8)="     Export Textfile        "
 man$(8)="txt"
 men$(9)="   Save Letter Data Only    "
 man$(9)="s"
 men$(10)=""
men$(11)="      Change Width       [V]" 'V
man$(11)="v"
men$(12)="      Change Height      [B]" 'B
man$(12)="b"
men$(13)=" Change Number of Colors [Z]" 'Z
man$(13)="z"
men$(14)=" Display-Mode for This Size "
man$(14)="dm"
men$(15)="      Save as Default       "
man$(15)="x2"
men$(16)=""
men$(17)="     Configure System       "
man$(17)="ins"
men$(18)="Choose Display for This Menu"
man$(18)="x"
men$(19)=""
men$(20)="           Quit          [Q]" 'Q
man$(20)="q"


aslen=len(as$) : asx=2
ascur=ascur-110
if ascur<1 then
	ascur=1
else
	ascur=instr(ascur,as$,". ")+1
end if

if ascur>aslen then ascur=1
if ascur<1 then ascur=1


line (350,31)-(608,216),0,bf
line (350,31)-(608,216),7,b

line (10,105)-(310,140),0,bf
line (10,105)-(310,140),7,b

line(0,56)-(320,80),0,bf

a=27*6
b=9

start5:
'line (0,100)-(320,256),3,bf

color 7,0
locate 15,4
if med=2 then print "     Screen Width:  632      " else print "     Screen Width:  312      "
locate 16,4
if maxx=25 then
	print            "    Screen Height:  200 (NTSC)  "
elseif maxx=31 then
	print "    Screen Height:  248 (PAL)    "
elseif maxx=29 then
	print "    Screen Height:  232 (NTSC+)  "
else
	print "    Screen Height:  256 (PAL+)   "
end if

	
locate 17,4
              print " Number of colors: ";int(2^djup);"    "

line (10,105)-(310,140),7,b

	do : delay 1 : loop until mouse(0)=0

3


do while window(0)=0
	waittof
	waittof
	waittof
	waittof
loop


a=a+b
if a>27*7 then b=-9 : goto 3
if a<30 then b=9 : goto 3
'color 7,3
'locate 28,65 : print time$
color 0,0
locate 10,1
waittof
scroll (20,56)-(300,80),0,-8 : color 4,5 : print ptab(a);"   Let"; : color 5,4 : print "ter   "; : color 1,1
i!=a/1000 : i!=i!*4.5

waittof

palette 4,i!,i!,i!
'palette 6,.5+i!/4, 0.8+i!/10, .5+i!/4
palette 6,.5+i!/4, .5+i!/4, 0.8+i!/10
i!=1-i! : palette 5,i!,i!,i!
waitTOF
yy%=((mouse(2)+4)/8)-6 : oo%=-1
for jj%=0 to 20
	locate jj%+6,47
	if yy%=jj% and mouse(1)>320 then color 5,4 : oo%=yy% else color 7,2
	print men$(jj%)
next jj%
	
waittof

color 1,3
aa$=mid$(as$,ascur,1)
if aa$=" " then
	if asx+(instr(ascur+1,as$," ")-ascur)>32 then
		locate 28,asx
		print " ";
		asx=2
		scroll(8,152)-(310,238),2,-9
	end if
end if

locate 28,asx
print aa$;
y=216
x=(asx*8)-1
line (x+1,y+1)-(x+7,y+6),1,b
incr asx
incr ascur : if ascur>aslen then ascur=1

if make$<>"" or install=1 then sen


a$=inkey$ : f=mouse(0)
if a$="" and f=0 then 3
if f<>0 then
	do : loop until mouse(0)=0
	if oo%=-1 then a$="" else a$=man$(oo%)
end if

if a$="" then 3

if a$=="v" then
	if med=2 then med=1 else med=2
	goto start5
end if

if ucase$(a$)="B" then
	if maxx=31 then
		maxx=25 : goto start5
	elseif maxx=25 then
		maxx=29 : goto start5
	elseif maxx=29 then
		maxx=32 : goto start5
	else
		maxx=31 : goto start5
	end if
goto 3
end if

if ucase$(a$)="Z" then
	incr djup : if djup=6 then djup=2
	goto start5
end if


'palette 4,1,1,1
'palette 5,0,0,0
'palette 6,0.4,1,.4

sen:

da=0 : pl=0
if ucase$(a$)="R" then
	if wom$="" then ladding
	da=1 : Oldmike=0 : rom$=wom$ : romp&=1 : roml&=len(rom$) : goto ladda
end if
if ucase$(a$)="M" or make=1 then make=0 : Oldmike=0 : goto illerutt
if ucase$(a$)="X2" then
	open "S:BLnew.config" for output as #8
	print #8, djup
	print #8, maxx
	print #8, med
	close 8
	messwait "Default display settings saved"
	goto start5
end if
if ucase$(a$)="A" then
	if wom$<>"" then
		oride=-2
		rom$=wom$ : romp&=1 : roml&=len(rom$) : Oldmike=0 : da=1 : pl=1 : goto ladda
	else
		Oldmike=0 : goto illerutt
	end if
end if


if a$=="exp2" or make$=="yam" then
	if mail$="" then
		yesno b$,"","  Send this letter via YAM?","    (YAM must be running)",""
	else
		yesno1 b$,"Send this letter via email?"
	end if
	if b$=="y" then yam=1 : goto exporting
	make$=""
end if


if ucase$(a$)=="exp" or make$<>"" then exporting

if a$=="ins" or install=1 then
	iii=1
	palette 4,1,1,1
	palette 5,0,0,0
	install=0
	d$=sdir$(startdir$)
	
	color 1,3
	cls

	
	?
	?
	?
	?
	?
	?
	?
	?
	color 4
	mp "      Install/Configuration Tool"
	color 1
	?
	mp "Boray Letter is unrestricted ShareWare!"
	?
	mp "      Please consider paying!!!"
	?
	mp "        Copyright © 1991-1999"
	mp "          by Anders Persson"
	
	yesno b$,"   Welcome to BorayLetter's","  install/configuration tool!","","Would you like to install now?"
	if b$=="y" then
	
		if fexists(d$+"bl") then
			color 1,3
			cls
			?
			?
			?
			?
			?
			?
			?
			?
			?
			color 4
			mp "BL program"
			color 1
			?
			mp "The BorayLetter program should be"
			mp "placed in your C: directory."
			mp "This is a must for the rest of"
			mp "the configuration to work."
			
			yesno b$,"     Copy the BorayLetter","         program (BL)","     to your C: directory?",""
			if b$=="y" then
				shell "copy >nil: """+d$+"bl"" C:"
			end if
		end if
		
		if fexists(d$+"blc") then
			color 1,3
			cls
			?
			?
			?
			?
			?
			?
			?
			?
			?
			color 4
			mp "BLC program"
			color 1
			?
			mp "This IFF -> BLC converter should"
			mp "be placed in your C: directory."
			mp "If it isn't there, then you can't"
			mp "use it from the brush menu when"
			mp "making letters."
			
			yesno b$,"","    Copy the BLC program","     to your C: directory?",""
			if b$=="y" then
				shell "copy >nil: """+d$+"blc"" C:"
			end if
		end if

		
		color 1,3
		cls
		
		?
		?
		?
		?
		?
		?
		?
		?
		color 4
		mp "BL Start Icons"
		color 1
		?
		mp "A drawer will be created called"
		mp """BorayLetter"" in the directory"
		mp "you choose. If you have downloaded"
		mp "BorayLetter's main archive, you can"
		mp "skip this part. You already have"
		mp "the start icons then."
		yesno b$,"","   Choose destination for","   the BorayLetter drawer",""
		if b$=="y" then

			ip$=katalog$
			katalog$=startdir$
			ful$=sdir$(startdir$)
			worked=GetFile%(ful$,"Destination Dir",-4,"",hop0$)
			if worked=0 then opw
			fullname ful$
			katalog$=ip$

			ful$=sdir$(ful$)
			
			shell "makedir >nil: """+ful$+"BorayLetter"""
			restore drawerinfo
			putfile ful$+"BorayLetter.info"
			
			ful$=ful$+"BorayLetter/"
			
			restore mainmenuinfo
			putfile ful$+"Main Menu.info"
			open ful$+"Main Menu" for output as #8
			print #8, "bl"
			close 8

			restore makeletterinfo
			putfile ful$+"Make Letter.info"
			open ful$+"Make Letter" for output as #8
			print #8, "bl make"
			close 8

			restore yaminfo
			putfile ful$+"Make For YAM.info"
			open ful$+"Make For YAM" for output as #8
			print #8, "bl make yam"
			close 8
			
			shell "makedir >nil: """+ful$+"Letters"""
			restore drawerinfo
			putfile ful$+"Letters.info"

			shell "makedir >nil: """+ful$+"Brushes"""
			restore drawerinfo
			putfile ful$+"Brushes.info"
			
		end if
		
		color 1,3
		cls
		color 4
		?
		mp "YAM Configuration"
		color 1
		mp "It's really easy to send a BL"
		mp "letter to someone via YAM from"
		mp "BorayLetter's main menu. But for"
		mp "you to be able to read BL letters"
		mp "just by double clicking on a YAM"
		mp "attachment, a configuration to YAM's"
		mp "MIME settings must be made."
		mp "Your old configuration file will be"
		mp "saved as .config.backup"
		mp "Press Yes to choose your config file."
		?
		mp2 "Note that you need YAM 2.0 or later"
		mp2 "for this to work. Also note that YAM"
		mp2 "is automatically terminated when"
		mp2 "making this configuration."
opta:
		yesno b$,"    Configure YAM to show","   BorayLetter attachments","   and be able to start BL","   from YAM's script menu?"
		if b$=="y" then
			ip$=katalog$
			katalog$=startdir$
			ful$="YAM:.config"
			yam0$=""
			worked=GetFile%(ful$,"Choose YAM:.config",2,"",yam0$)
			if worked=0 then opta
			fullname ful$
			katalog$=ip$
			
			if not fexists(ful$) then messwait ful$+" not found" : goto opta
			
			
			yam "quit"

			shell "copy >nil: "+ful$+" "+ful$+".backup"
			open ful$+".backup" for input as #9
			open ful$ for output as #8
			
			uxi=0
			
			do until eof(9)
				line input #9,b$
				if left$(b$,2)="MV" and uxi=0 then
					uxi=1
					gosub mime
				elseif left$(b$,11)=="Rexx08.Name" then
					print #8,"Rexx08.Name      = BorayLetter Make"
					line input #9,b$
					print #8,"Rexx08.Script    = bl make yam"
					line input #9,b$
					print #8,"Rexx08.IsAmigaDOS= Y"
					line input #9,b$
					print #8,"Rexx08.UseConsole= N"
					line input #9,b$
					print #8,"Rexx08.WaitTerm  = N"
					line input #9,b$
					print #8,"Rexx09.Name      = BorayLetter Menu"
					line input #9,b$
					print #8,"Rexx09.Script    = bl"
					line input #9,b$
					print #8,"Rexx09.IsAmigaDOS= Y"
					line input #9,b$
					print #8,"Rexx09.UseConsole= N"
					line input #9,b$
					print #8,"Rexx09.WaitTerm  = N"
					line input #9,b$
				end if
				print #8,b$
			loop
			close 8,9

		end if
		
		color 1,3
		cls
		?
		?
		?
		?
		?

		color 4
		mp "Music"
		color 1
		?
		mp "For music and sound effects, a player"
		mp "called ""HippoPlayer"" is used. If you"
		mp "don't have it, you have to get it."
		mp "You will find it on Aminet:"
		mp "mus/play/hippoplayer.lha"
		?
		mp "If you don't have your HippoPlayer"
		mp "program (HiP) in your path, then"
		mp "you have to ""choose"" your"
		mp "Hippoplayer right now."
opw:
		yesno1 b$,"     Choose your HiP?"
		if b$=="y" then
			ip$=katalog$
			
			katalog$=startdir$
			ful$=sdir$(startdir$)
			worked=GetFile%(ful$,"Choose HiP",2,"",hip0$)
			if worked=0 then opw
			fullname ful$
			katalog$=ip$
			
			open "env:blhip" for output as #8
			print #8,""""+ful$+""""
			close 8

			open "envarc:blhip" for output as #8
			print #8,""""+ful$+""""
			close 8
			
		end if

		color 1,3
		cls
		?
		?
		?
		?
		?
		?
		?
		?
		?
		?
		color 4
		mp "Graphics Cache"
		color 1
		?
		mp "You don't have to bother about"
		mp "this if you not are extremely"
		mp "low on memory."
		yesno1 b$,"Change graphics cache?"
if b$=="y" then
uttern:
	color 1,0
	cls
	print "This is an internal disk cache for the graphics"
	print "brushes/copies. The cache is cleared every time"
	print "you go to the main menu."
	print
	color 7
	print "Current cache is:";cint(cachemem&/1024);"K"
	print
	print
	color 1
	print "Cache statistics from the last letter(s):"
	print
	print "  Cache usage:";cint(ctot3&/1024);"K"
	print "  Number of loads from  disk:";dloads&
	print	"  Number of loads from cache:";cloads&
	print
	print
	print
	print "To change the cache, write the number of kilobytes"
	print "you want to use, else - just press return."
	print
	line input "-> ";aa$
	if aa$="" then balko
	
	cachemem&=val(aa$)*1024
	open "S:BLetter.cache" for output as #1
	? #1,cachemem& : close 1

	goto uttern
	
end if
		
balko:

		color 1,3
		cls
		?
		?
		?
		?
		?
		?
		for t=1 to 4
			mp "         Installation Ready."
			mp "             Have Fun!"
		next t
			mp "         Installation Ready."
		
		messwait "     Installation Ready."
	end if
'	window close 1
'	screen close 1
'	oldmike=0
	goto start

end if

if a$=="x" then
	if kickver<38 then messwait "Only available in V38+" : goto start5
	screenmode sm&(0), "Choose 640x251 display",640,200

	open "S:BLscreenmodes.config" for output as #8
	for t=0 to 8
		print #8, sm&(t)
	next
	close 8
	
'	messwait "You can change display again by pressing X"

'	window close 1
'	screen close 1
	oldmike=0
	goto start

end if



if ucase$(a$)="Q" then
	if wom$<>"" and plus$<>"" then
		call yesno(a$,"Warning, there is an unsaved","      letter in memory.","","Do you want to quit anyway?")
		if a$=="n" then start
	end if
	goto slutet
end if


if ucase$(a$)="L" then ladding
if a$=="dm" then
	gosub getmode	
end if
if a$=="txt" then

	txt$=sdir$(startdir$)+dis$

	setext txt$,".txt"
	worked=GetFile%(txt$,"Save Text File:",0,"",txt0$)
	if worked=0 then start
	setext txt$,".txt"

	gosub exptxt

	goto start
end if
if a$=="S" then

	fil$=""
	file bld0$
	setext fil$,".bld"
	worked=GetFile%(fil$,"Save Letter Data:",0,"",bld0$)
	if worked=0 then start
	setext fil$,".bld"

	if not fileok(fil$) then start
	
	if instr(fil$,":")<>0 or instr(fil$,"/")<>0 then
		yesno b$,"This is NOT advicable if you","have used external files. Then","these won't be found when you","load this file.     Continue?"
		if b$=="n" then start
	end if
	
	open fil$ for output as #2
	print #2,wom$;
	close #2
	cur$=fil$
	file cur$
	plus$=""
	if not fexists(fil$+".info")
		restore readletterinfo
		putfile fil$+".info"
	end if
						
	goto start

end if

goto start5

SUB DIR(a$) STATIC
	DO : if a$<>"" then b$=right$(a$,1) else exit sub
	if b$=":" or b$="/" then exit sub
	a$=left$(a$,len(a$)-1) : LOOP
END SUB



illerutt:
	gosub os
	yllefis=1
	gosub font
	gosub 13
	color mio,nio,1
	cls

t$=ms$
gosub memkoll

wom$=""
redo$=""
cur$="New Letter"
dis$=cur$
plus$=" +"

	gosub 13
	color mio,nio,1
	cls
	speed=3


	cback$=""


incr messy

select case messy

=1
	? "Hey, You!"
	?
	? "Try the menus!!!"
	
'	for t=1 to 40 : waittof : next
	
=2
	? "You can press the ""Help""-key"
	?
	? "to read some instructions."
	
'	for t=1 to 40 : waittof : next

=3
	? "Try my mod music!"
	?
	? "Aminet: mods/boray"

=4
	? "That is:"
	?
	? "Aminet: mods/boray"

=5,6
	? "BorayLetter is SHAREWARE!!!"
	?
	? "Press ""Help"" for more information"
	
	
=12,16,23
	? "I guess You really like this program..."

=33,54
	? "Hey You!"
	?
	? "Jesus loves You!"
	for t=1 to 50 : waittof : next
	
=Remainder
	? "Did you pay? This is SHAREWARE!"

end select

gosub makemenu



cls
wom$=""
zut "BLETTER "+ver$
zut "MODE"+str$(med)
zut "DJUP"+str$(djup)
if maxx>25 then zut "BIG"+str$(maxx)
'cback$=""

count&=1


keyboard:
ylleman&=len(wom$)

'color 1,3
'print
'print timer-tid!

drav=0

if mouse(0)<>0 then keyboard

if da=1 then nywait

y=csrlin-1
x=pos(0)-1

if x=40*med-1 then
	print
	y=csrlin-1 : x=pos(0)-1
end if
y=(y*8) : x=(x*8)-1
if x=-1 then x=0

88 if menu0%=0 then menu0%=menu(0)
if menu0%<>0 then
	call getmenu(a$) : if a$<>"" then marmor
end if

if lan$<>"" then a$=lan$ : lan$="" : goto marmor

if igge$<>"" then
	if instr(codes$,igge$)<>0 or igge$=chr$(16) or igge$=chr$(182) or igge$=chr$(223) _
	or igge$=chr$(139) or igge$=chr$(11) or igge$=chr$(12) or igge$=="®"  or igge$=chr$(20) then
		a$=igge$ : igge$="" : goto marmor
	end if
	igge$=""
end if
if cback$<>"" then
	if (cback$=chr$(5) or cback$=="drawcopy" or cback$=chr$(131)) and w%(0)=0 then
		if loadcopy$<>"" then
			if fexists(loadcopy$) then a$=cback$ : goto marmor2
		end if
		cback$="" : goto irlp
	end if
	a$=cback$ : goto marmor2
end if

irlp:
a$=inkey$: if a$<>"" then marmor

waitblit
get (x,y)-(x+8,y+7),q%
'color ,,2 : line (x,y)-(x+8,y+7),,bf : color ,,1

ella=20
if cursor=1 then ella=10
if sim=2 then ella=ella/2

if jam=4 or jam=5 then
	c1=nio
	c2=mio
else
	c1=mio
	c2=nio
end if


blinka:
if jam<>4 then line (x+1,y+1)-(x+7,y+6),c1,b
if jam<>0 then
	line (x,y)-(x+8,y+7),c2,b
	line (x+2,y+2)-(x+6,y+5),c2,b
end if

for t=1 to ella
	a$=inkey$: if a$<>"" then waitblit : put (x,y),q%,pset : goto marmor
	waittof
	menu0%=menu(0)
	if menu0%<>0 then
		call getmenu(a$) : if a$<>"" then waitblit : put (x,y),q%,pset : goto marmor
	end if
	if mouse(0)=-1 or mouse(0)=-2 then waitblit : put (x,y),q%,pset : goto nypos
next t
	
waittof
waitblit
put (x,y),q%,pset
for t=1 to ella
	a$=inkey$: if a$<>"" then marmor
	waittof
	menu0%=menu(0)
	if menu0%<>0 then
		call getmenu(a$) : if a$<>"" then marmor
	end if
	if mouse(0)=-1 or mouse(0)=-2 then nypos
next t

goto blinka

marmor:

if a$=chr$(135) or a$=chr$(5) or a$=="drawcopy" or a$=="drawlines" or a$=chr$(136) _
   or a$=chr$(134) or a$=chr$(133) or a$=chr$(132) or a$=chr$(17) then cback$=a$

'if a$=chr$(131) then cback$=chr$(5)

marmor2:

'print a$

if a$=="drawlines" then
	a$=chr$(135) : drav=1 : goto lin
elseif a$=="drawcopy" then
	a$=chr$(5) : drav=1 : goto ge
elseif a$=="pfg" then
	call firstcoord(2,mio,mio) : if menu0%<>0 then keyboard
	mio=point(xxx,yyy)
	zut chr$(129) : zutbyte mio
	goto keyboard
elseif a$=="pbg" then
	call firstcoord(2,mio,mio) : if menu0%<>0 then keyboard
	nio=point(xxx,yyy)
	zut chr$(153) : zutbyte nio
	goto keyboard
elseif a$=="text" or a$=chr$(20) then
	cback$="" : goto keyboard
elseif a$=="outline" then
	if only=0 then only=2 else if only=2 then only=0
	if only=1 then only=0
	gosub switch
	goto keyboard
elseif a$=="brush" then
	if only=1 then only=2 else if only=2 then only=1
	if only=0 then only=1
	gosub switch
	goto keyboard
elseif a$=="fsave" then
	gosub fsave : goto keyboard
elseif a$=="fload" then

popr:
	yesno1 b$,"Load color file (.col)?"
	if b$=="N" then keyboard

	b$=sdir$(startdir$)
	worked=GetFile%(b$,"Load colors from",0,"#?.col",col0$)
	if worked=0 then keyboard
	if not right$(b$,4)==".col" then messwait "You can only load a .col file" : goto popr

	ms$=b$
	gosub loadcolors
	goto keyboard
elseif a$=="toggle" then
	menu reset
	gosub toggle
	gosub makemenu
'	oride=-2
'	Oldmike=0 : rom$=wom$ : romp&=1 : roml&=len(rom$) : da=1 : pl=1 : ori=1 : goto ladda
	goto keyboard

elseif a$=="stopinsert" then
	yesno1 b$, "Really stop inserting?"
	if b$=="n" then keyboard
	gosub makemenu2
	da=1
	romp&=len(wom$)+1
	wom$=wom$+rest$ : rest$=""
	rom$=wom$ : roml&=len(rom$)
	oride=speed
	goto nylas
elseif a$=="memo" then
	yesno1 b$,"      Memorize letter?"
	if b$=="y" then redo$=wom$
	goto keyboard
elseif a$=="redo" then
	if redo$="" then messwait "Nothing to restore." : goto keyboard
	yesno b$,"    Get back the letter","that was in memory when you","made your last memorization?",""
	if b$=="n" then keyboard
	yesno0 b$,"","Swap with, or copy from","the back up memory?",""," Swap  "," Copy  "
	if b$=="y" then
		swap wom$,redo$
	else
		wom$=redo$
	end if

	oride=-2
	Oldmike=0 : rom$=wom$ : romp&=1 : roml&=len(rom$) : da=1 : pl=1 : ori=1 : goto ladda

elseif a$=="ß" then
	yesno1 b$, "Insert a delay of"+str$(dely)+" VBlanks?"
	if b$=="y" then zut chr$(22) : zutbyte dely
	goto keyboard
elseif a$=="colors" then

	xwindow
	palette 0,0,0,0
	palette 1,1,1,1
	color 1,0
	cls
	?
	? " Change number of colors."
	? " ------------------------"
	?
	? " Please note that this affects the whole letter!"
	?
	?
	? " You now have";2^djup;"colors."
	?
	? " How many would you like?"
	?
	? " A:  4 colors"
	? " B:  8 colors"
	? " C: 16 colors"
	? " D: 32 colors"
	?
	? " Press A, B, C or D on the keyboard."


	djupb=djup
upa:	
	do : sleep : b$=inkey$ : loop until b$<>""
	
	if b$=="a" then
		djup=2
	elseif b$=="b" then
		djup=3
	elseif b$=="c" then
		djup=4
	elseif b$=="d" then
		djup=5
	else
		goto upa
	end if

	xxclose
	if djup=djupb then keyboard
	
	gosub stopinsert
	
	a=instr(wom$,chr$(10)+"DJUP ")
	mid$(wom$,a+6,1)=rtrim$(ltrim$(str$(djup)))

	oride=-2
	rom$=wom$ : romp&=1 : roml&=len(rom$) : Oldmike=0 : da=1 : pl=1 : goto ladda

elseif a$=="blc" then

	b$=sdir$(startdir$)
	worked=GetFile%(b$,"Convert IFF brush",0,"#?",iff0$)
	if worked=0 then keyboard
	if not fexists(b$) then messwait b$+" not found" : goto keyboard
	
	a$=b$
	file b$

	setext b$,".blc"
	if not fexists(tempdir3$) then shell "makedir >nil: """+tempdir3$+""""
	
	do until not fexists(tempdir3$+"/"+b$)
		b$="_"+b$
	loop

	f$=b$
	setext f$,".col"

'	do until not fexists(tempdir3$+"/"+f$)
'		f$="_"+f$
'	loop

	b$=tempdir3$+"/"+b$
	f$=tempdir3$+"/"+f$
	
	gosub getsmpos
	
	tt!=timer
	shell "blc >nil: integration """+a$+""" """+b$+""" """+f$+""" "+str$(sm&(smpos))
	ScreenToFront(peekl(systab+12))

	if not fexists(b$) then
		if timer-tt!<3 then messwait "BLC program didn't succeed or wasn't found. (Put it in C:)"
		goto keyboard
	end if
	
curry:
	bb$=b$
	file bb$

	if left$(bb$,1)="_" then
		bb$=right$(bb$,len(bb$)-1)
		if fexists(tempdir3$+"/"+bb$) then
			if samefile(tempdir3$+"/"+bb$,b$) then
				shell "delete >nil: """+b$+""""
				b$=tempdir3$+"/"+bb$
				goto curry
			end if
		end if
	end if
	
	cn$=b$
	gosub cload
	loadcopy$=cn$
	a$=chr$(5)
	cback$=a$

	yesno1 x$,"Change the palette?"
	if x$=="y" then
		ms$=f$
		gosub loadcolors
	end if
	
	if w%(2)>djup then
	
		yesno j$,"Note that this brush has","more colors than your screen.","","Change screen to"+str$(2^w%(2))+" colors?"
		if j$=="y" then
			djup=w%(2)
	
			gosub stopinsert
	
			a=instr(wom$,chr$(10)+"DJUP ")
			mid$(wom$,a+6,1)=rtrim$(ltrim$(str$(djup)))

			oride=-2
			rom$=wom$ : romp&=1 : roml&=len(rom$) : Oldmike=0 : da=1 : pl=1
			loadcopy$=cn$
			a$=chr$(5)
			cback$=a$

			goto ladda
		end if
	end if	

	goto marmor

elseif a$=="search" then
	yesno b$,"Search and replace text?","Note that this also affects","filenames and all other","text strings in the letter."
	if b$=="N" then keyboard
	yesno1 b$,"Memorize letter before action?"
	if b$=="y" then redo$=wom$
	
		xwindow3
		svart svart,-1
		vit vit,-1
		line (0,0)-(640,26),svart,bf
		line (0,0)-(640,26),vit,b
		
		locate 2,2
		color vit,svart
		print "Search: ";
		line input aa$

		line (0,0)-(640,26),svart,bf
		line (0,0)-(640,26),vit,b
		
		locate 2,2
		color vit,svart
		print "Replace with: ";
		line input bb$
		xxclose

		if aa$=="BIG" or aa$=="DJUP" or aa$=="MODE" or aa$=="BLETTER" _
		or aa$=="BIG " or aa$=="DJUP " or aa$=="MODE " or aa$=="BLETTER " then
			yesno b$,"This is not advicable as the","search word is one of","BorayLetter's initial settings","commands. Go on anyway?"
			if b$=="n" then keyboard
		end if
		
		if len(aa$)<3
			yesno b$,"This is not advicable as the","search word is so short","that it can be one of the","internal commands. Continue?"
			if b$=="n" then keyboard
		end if
		
		yesno1 b$,"Replace all?"
		if b$="y" then
			yp&=0
			do until instr(ucase$(wom$),ucase$(aa$))=0
				i&=instr(ucase$(wom$),ucase$(aa$))
				wom$=left$(wom$,i&-1)+bb$+right$(wom$,len(wom$)-i&-len(aa$)+1)
				incr yp&
			loop
			messwait "Replaced"+str$(yp&)
			if yp&=0 then keyboard
		else

			yesno0 b$,"","Replace first or last","occurance?",""," First "," Last  "

			if b$=="y" then
				i&=instr(ucase$(wom$),ucase$(aa$))
			else
				i&=rinstr(ucase$(wom$),ucase$(aa$))
			end if
		
			if i&=0 then
				messwait aa$+" not found." : goto keyboard
			else
				wom$=left$(wom$,i&-1)+bb$+right$(wom$,len(wom$)-i&-len(aa$)+1)
			end if
		end if

		oride=-2
		rom$=wom$ : romp&=1 : roml&=len(rom$) : da=1 : pl=1
 		Oldmike=0 : ori=1 : goto ladda
	

elseif left$(a$,4)=="undo" or a$=chr$(12) then
	yesno1 b$,"Memorize letter before undo?"
	if b$=="y" then redo$=wom$

	if a$=chr$(12) then
		aa$="1"
	else
		chop a$,aa$
		chop a$,aa$
	end if

	if aa$=="x" then
		xwindow3
		svart svart,-1
		vit vit,-1
		line (0,0)-(320,26),svart,bf
		line (0,0)-(320,26),vit,b
		
		locate 2,2
		color vit,svart
		input "Undo how many";aa$

		xxclose
	
	end if
	
	if aa$=="all" then
		yesno1 b$,"Remove all from start to here?"
		if b$=="n" then keyboard
		stanna&=1
	else
		stanna&=count&-val(aa$)
	end if
	
	if stanna&<1 then stanna&=1

	rom$=wom$ : roml&=len(rom$) : romp&=1	
	Oldmike=0 : da=1 : pl=1 : oride=-2 : ori=1 : goto ladda
elseif a$=="menu" then
	yesno b$,"For this to work, you must have","waited for any key (or input)","first...","On inkey return to main menu?"
	if b$=="y" then
		xwindow
		input "Return On ";bb$
		zut chr$(15)
		zutbyte 0
		zut bb$
		zut "*main*menu*"
		xxclose
		goto keyboard
	end if
	goto keyboard
elseif a$=chr$(27) then
	gosub stopinsert : goto start
elseif a$=chr$(139) then
	gosub hjelp : goto 88
elseif a$=chr$(137) or a$="scopy" then
	goto scopy
elseif a$=chr$(134) then
	goto lin
elseif a$=chr$(133) then
	goto lin
elseif a$=chr$(132) then
	goto lin
elseif a$=chr$(135) then
	goto lin
elseif a$=chr$(131) then
	goto ge
elseif a$=chr$(130) then
	anim=0 : goto tag
elseif a$=chr$(5) then
	goto ge
elseif a$=chr$(17) then
	goto ring
elseif a$=chr$(9) then
	yesno1 b$,"Put user input here?"
	if b$=="y" then
		zut a$
		print "?"
		if ai=2 then locate ,xposse
	end if
	goto keyboard
elseif a$=chr$(1) then
	yesno1 b$,"Wait for any key / mouse click?"
	if b$=="y" then
		zut a$
		goto keyboard
	else
		goto keyboard
	end if
elseif a$=chr$(144) then
	yesno b$,"","Wait for any key / mouse click","with a timeout?",""
	if b$=="y" then
		xwindow3
		svart svart,-1
		vit vit,-1
		line (0,0)-(320,26),svart,bf
		line (0,0)-(320,26),vit,b
		
		locate 2,2
		color vit,svart

		input "Wait how many seconds";bb$
		xxclose
		
		bb!=val(bb$) : if bb!>255 then bb!=255
		if bb!<0 then bb!=0

		zut a$
		bb=bb!
		zutbyte bb
		goto keyboard
	else
		goto keyboard
	end if

elseif a$=chr$(127) then
	yesno1 b$,"     Clear screen? (Y/N)"
	if ucase$(b$)="Y" then zut a$ : color mio,nio,1 : cls
	goto keyboard
elseif a$=chr$(11) then
	gosub stopinsert : Oldmike=0 : rom$=wom$ : romp&=1 : roml&=len(rom$) : da=1 : pl=1 : ori=1 : goto ladda
elseif a$=chr$(138) then
	anim=0 : gosub lcopy
elseif a$=chr$(21) then
	yesno1 b$,"Start another letter from here?"
	if b$=="y" then
		b$=sdir$(startdir$)

		worked=GetFile%(b$,"What Letter?",0,"#?(.bl|.lha|.col|.bld)",bl0$)
		if b$<>"" then
			if not fexists(b$) then messwait b$+" not found" : goto keyboard
			zut a$
			gosub getkod
			zutbyte kod
			zut b$
			goto start
		end if
	end if
	goto keyboard
elseif a$=chr$(146) then
	yesno b$,"Restart the first calling","letter (if any)?","If there is no calling","letter then nothing will happen."
	if b$=="y" then
		zut a$
		gosub getkod
		zutbyte kod
		goto start
	end if
	goto keyboard


elseif a$=="hip" then
	yesno1 b$,"Play a mod?"
	if b$=="y" then
		b$=""
		worked=GetFile%(b$,"What mod?",0,"",mod0$)
		if b$<>"" then
			if not fexists(b$) then messwait b$+" not found" : goto keyboard
			zut chr$(152)
			zut b$
			fullname b$
			if spelar=0 then
				win&=window(7)
				hip "quit"
				delay 20
				open "env:blhip" for input as #8
				line input #8, o$
				close 8
				if left$(o$,1)<>"""" then o$=""""+o$+""""

				shell "run >NIL: "+o$+" >NIL: """+b$+""""
				delay 60
				ScreenToFront(peekl(systab+12))
				activatewindow win&
			else
				hip "play '"+b$+"'"
			end if
			spelar=1
			spelarnu=1
		end if
	end if
	goto keyboard

elseif a$=="view" then
	yesno b$, "Display someting?","","For example a text file,","a picture or a guide document"

	if b$=="y" then
		b$=sdir$(startdir$)
		worked=GetFile%(b$,"Select file?",0,"",any0$)
		if b$<>"" then
			if not fexists(b$) then messwait b$+" not found" : goto keyboard
			zut chr$(148)
			zut b$
			fullname b$
			open "env:blview" for input as #8
			line input #8, o$
			close 8
			'if left$(o$,1)<>"""" then o$=""""+o$+""""
			shell o$+" >NIL: """+b$+""""

			ScreenToFront(peekl(systab+12))
		end if
	end if
	goto keyboard

elseif a$=="stop" then
	yesno1 b$,"Stop playing?"
	if b$=="y" then
		zut chr$(151)
		hip "stop"
		spelarnu=0
	end if
	goto keyboard

elseif a$=="cont" then
	yesno1 b$,"Continue playing?"
	if b$=="y" then
		zut chr$(150)
		hip "continue"
		spelarnu=1
	end if
	goto keyboard
	
elseif a$=="song" then

	yesno1 b$,"Change song number?"
	if b$=="y" then
		zut chr$(149)
		xwindow3
		svart svart,-1
		vit vit,-1
		line (0,0)-(320,26),svart,bf
		line (0,0)-(320,26),vit,b
		
		locate 2,2
		color vit,svart
		input "Play what number";aa
		zutbyte aa

		xxclose
		hip "songplay "+str$(aa)
		spelarnu=1
	end if
	goto keyboard

elseif a$=="®" then
	incr handle
	if handle=5 then handle=0
	a$=chr$(5)
	if cback$=="drawcopy" then drav=1 else cback$=chr$(5)
	goto keyboard


elseif a$=="say" then


	yesno b$, "","Say something?","","(This will stop playing music)"
	if b$=="y" then
		zut chr$(147)
		xwindow3
		svart svart,-1
		vit vit,-1
		line (0,0)-(640,26),svart,bf
		line (0,0)-(640,26),vit,b
		
		locate 2,2
		color vit,svart
		print "Say what? ";
		line input aa$
		zut aa$
		xxclose
		spelarnu=0
		hip "clear"
		hip "eject"
		gosub sag
	end if
	goto keyboard



elseif a$=chr$(4) then
	yesno b$, "For this to work, you must have","waited for an input (or inkey)","first...","Run 'input' letter?"
	if b$=="y" then
		zut a$
		gosub getkod
		zutbyte kod
		goto start
	end if
	goto keyboard
elseif a$=chr$(25) then
	yesno b$, "Put","'run this letter again'","             here?",""
	if b$=="y" then
		zut a$
		gosub getkod
		zutbyte kod
		goto start
	end if
	goto keyboard
elseif a$=chr$(19) then
	goto farg
elseif a$=chr$(15) then
	yesno b$,"For this to work, you must have","waited for any key (or input)","first...","On inkey/input run letter?"
	if b$=="y" then
		xwindow3
		svart svart,-1
		vit vit,-1
		line (0,0)-(320,26),svart,bf
		line (0,0)-(320,26),vit,b
		
		locate 2,2
		color vit,svart

		input "On ";bb$
		xxclose
		b$=sdir$(startdir$)
		worked=GetFile%(b$,"Run Letter:",0,"#?(.bl|.lha|.col|.bld)",bl0$)
		if b$<>"" then
			if not fexists(b$) then messwait b$+" not found" : goto keyboard
			gosub getkod
			zut a$
			zutbyte kod
			zut bb$
			zut b$
		end if
		goto keyboard
	end if
	goto keyboard
elseif a$=chr$(145) then
	yesno b$,"For this to work, you must have","waited for any key/mouse click.","Press 'yes' to mark the area to","click in to run the letter."
	if b$=="y" then
		cback$=""

		call firstcoord(1,mio,mio) : if menu0%<>0 then keyboard

		do
			call coord(a,1,x,y,x2,y2)
			if a=1 then

				color ,,3
				line(x,y)-(x2,y2),1,bf
				color ,,jam

			end if
			igge$=inkey$
			menu0%=menu(0) : if menu0%<>0 or igge$<>"" then
				call undocoord
				goto keyboard
			end if
		loop until mouse(0)<>0
		do : waittof : loop while mouse(0)<>0
		
		waittof
		waittof
		waittof
		waittof
		call undocoord

		b$=sdir$(startdir$)
		worked=GetFile%(b$,"Run Letter:",0,"#?(.bl|.lha|.col|.bld)",bl0$)
		if b$<>"" then
			if not fexists(b$) then messwait b$+" not found" : goto keyboard
			gosub getkod
			zut chr$(145)
			zutbyte kod
			zutint x
			zutbyte y
			zutint x2
			zutbyte y2
			zut b$
		end if
		goto keyboard
	end if
	goto keyboard
elseif a$=chr$(143) then
	yesno b$,"For this to work, you must have","waited for any key/mouse click.","Press 'yes' to mark the area","to click in to open the URL."
	if b$=="y" then

		cback$=""

		call firstcoord(1,mio,mio) : if menu0%<>0 then keyboard

		do
			call coord(a,1,x,y,x2,y2)
			if a=1 then

				color ,,3
				line(x,y)-(x2,y2),1,bf
				color ,,jam

			end if
			igge$=inkey$
			menu0%=menu(0) : if menu0%<>0 or igge$<>"" then
				call undocoord
				goto keyboard
			end if
		loop until mouse(0)<>0
		do : waittof : loop while mouse(0)<>0
		
		waittof
		waittof
		waittof
		waittof
		call undocoord

		xwindow3

		svart svart,-1
		vit vit,-1
		line (0,0)-(640,26),svart,bf
		line (0,0)-(640,26),vit,b
		
		locate 2,2
		color vit,svart
		print "URL: ";
		line input aa$
		zut chr$(143)
		zut aa$
		zutint x
		zutbyte y
		zutint x2
		zutbyte y2
		xxclose
	end if

	goto keyboard

elseif a$=chr$(142) then
	yesno b$,"For this to work, you must have","waited for any key/mouse click.","Press 'yes' to mark the area","to continue making at end."
	if b$=="y" then

		cback$=""

		call firstcoord(1,mio,mio) : if menu0%<>0 then keyboard

		do
			call coord(a,1,x,y,x2,y2)
			if a=1 then

				color ,,3
				line(x,y)-(x2,y2),1,bf
				color ,,jam

			end if
			igge$=inkey$
			menu0%=menu(0) : if menu0%<>0 or igge$<>"" then
				call undocoord
				goto keyboard
			end if
		loop until mouse(0)<>0
		do : waittof : loop while mouse(0)<>0
		
		waittof
		waittof
		waittof
		waittof
		call undocoord

		zut chr$(142)
		zutint x
		zutbyte y
		zutint x2
		zutbyte y2
	end if

	goto keyboard



elseif a$="¶" then
	gosub Screendump : goto keyboard
elseif a$=chr$(18) then
	yesno b$,"This will reset colors,","palette and text settings.","","          Continue?"
	if b$=="n" then keyboard
elseif a$=chr$(16) then
	goto Import
elseif a$=="saveanim" then
	if anim$(0)="" then messwait "No animation specified" : goto keyboard
	yesno b$,"Save animation file list?","Only the filenames are","saved and this action is NOT","recorded into the letter."
	if b$=="n" then keyboard
	setext blam$,".blam"
	worked=GetFile%(blam$,"Save .blam",0,"",blam0$)
	if worked=0 then keyboard
	setext blam$,".blam"
	if not fileok(blam$) then keyboard
	open blam$ for output as #8
		for t=0 to cards : if anim$(t)<>"" then print #8,anim$(t)
		next t
	close 8
	goto keyboard
elseif a$=="loadanim" then
	setext blam$,".blam"
	worked=GetFile%(blam$,"Load .blam:",0,"#?.blam",blam0$)
	if worked=0 then keyboard
	
	if not fexists(blam$) then messwait blam$+" not found" : goto keyboard
	
	ee$=""
	open blam$ for input as #8
		for t=0 to cards
			if eof(8) then exit for
			line input#8, b$
			if left$(b$,1)=":" then b$="ram"+b$
			if b$<>"" then
				if not fexists(b$) then ee$=b$
			else
				exit for
			end if
		next t
	close 8
	if ee$<>"" then
		messwait ee$+" not found"
		goto keyboard
	end if
	if t=0 then
		messwait "No filenames in file"
		goto keyboard
	end if
	
	for t=0 to cards : anim$(t)="" : next t

	zut chr$(0)
	open blam$ for input as #8
		t=0
		do until eof(8)
			line input#8, anim$(t)
			if anim$(t)<>"" then
				zut anim$(t)
			else
				exit do
			end if
			incr t
			if t>=cards then cards=cards+100 : redim preserve anim$(cards)
		loop
	close 8
	anim$(cards)=""
	zut ""
	anim=1 : animp=0 : gilbert=0

	a$=chr$(5)
	if cback$=="drawcopy" then drav=1 else cback$=chr$(5)
	goto ge
	
elseif a$=chr$(0) then
	if anim$(0)<>"" then
		yesno1 b$,"Use old animation?(Y/N)"
		if b$=="Y" then
			zut chr$(2) : anim=1 : animp=0 : gilbert=0 : gosub tcarl : a$=chr$(5)
			if cback$=="drawcopy" then drav=1 else cback$=chr$(5)
			goto ge
		end if
	end if
	xwindow
	? "Pick Copies for animation."
	? "Cancel to End"
	p=-1
	do
		incr p : if p>=cards then cards=cards+100 : redim preserve anim$(cards)
		
		worked=GetFile%(cn$,"Pick Copy",0,"#?.blc",blc0$)
		anim$(p)=cn$
		if cn$<>"" then ? p;cn$
	loop until cn$=""
	if p=0 then ? "Anim Cancel!" : gosub tcarl : goto keyboard
	zut a$
	for r=0 to p : zut anim$(r) : next r
	anim=1 : animp=0 : gilbert=0
	gosub tcarl
	a$=chr$(5)
	if cback$=="drawcopy" then drav=1 else cback$=chr$(5)
	goto ge
elseif a$=chr$(136) then
	goto fill
end if

zut a$

if a$=chr$(129) or a$=chr$(153) then
	goto farg
elseif a$=chr$(29) then
	y=csrlin+1:x=pos(0) :goto board
elseif a$=chr$(31) then
	y=csrlin:x=pos(0)-1 :goto board
elseif a$=chr$(30) then
	y=csrlin:x=pos(0)+1 :goto board
elseif a$=chr$(28) then
	y=csrlin-1:x=pos(0) :goto board
elseif a$=chr$(158) then
	if cursor=1 then cursor=2 else cursor=1
	gosub switch
	goto keyboard
elseif a$=chr$(155) then
	if sim=1 then sim=2 else sim=1
	gosub switch
	goto keyboard
elseif a$=chr$(154) then
	if ai=1 then ai=2 else ai=1
	gosub switch
	goto keyboard
elseif a$=chr$(24) then
	if jam=4 then jam=5 : gosub switch : goto keyboard
	if jam=5 then jam=4 : gosub switch : goto keyboard
	if jam=1 then jam=0 : gosub switch : goto keyboard
	if jam=0 then jam=1 : gosub switch : goto keyboard
elseif a$=chr$(26) then
	if jam=0 then jam=4 : gosub switch : goto keyboard
	if jam=4 then jam=0 : gosub switch : goto keyboard
	if jam=1 then jam=5 : gosub switch : goto keyboard
	if jam=5 then jam=1 : gosub switch : goto keyboard
elseif a$=chr$(18) then
	gosub 13 : gosub switch : goto keyboard
elseif a$=chr$(157) and w%(2)<>1 then
	w%(2)=w%(2)-1 : goto keyboard
elseif a$=chr$(156) and w%(2)<>5 then
	w%(2)=w%(2)+1
	el&=6+((w%(1)+1)*2*int((w%(0)+16)/16))*w%(2)
	el&=el&/2
	if el&>mac& then w%(2)=w%(2)-1
	goto keyboard
elseif a$=chr$(157) then
	goto keyboard
elseif a$=chr$(156) then
	goto keyboard
elseif a$=chr$(159) then
	goto keyboard
elseif a$=chr$(23) then
	gosub setspeed : goto keyboard
elseif a$=chr$(22) then
	gosub setdelay : goto keyboard
end if
999
color mio, nio, jam
print a$;
color mio, nio, 1

if a$=chr$(13) and ai=2 then locate ,xposse


goto keyboard

board:
if x<1 then x=1
if y<1 then y=1
if y>maxx then y=maxx
locate y,x : goto keyboard




ladda:

if rom$="" then
	messwait "There is no letter in memory."
	jepp=0
	goto start
end if

anim=0 : animp=0 : gilbert=0
menu0%=0
for t=0 to cards
	anim$(t)=""
next t
w%(0)=0 : w%(1)=0
jam=1

gosub deltemp

djup=3
Ny=0
nyg=0
speed=3
if oride>-1 then oride=speed
maxx=31
zin a$
jepp=0


if left$(a$,7)=="BLETTER" then
	zin a$
	incr nyg
else
	gosub convert : goto ladda
end if

if left$(a$,4)=="MODE" then
	med=val(right$(a$,1))
	zin a$
	incr nyg
else
	med=1
end if

if left$(a$,4)=="DJUP" then
	djup=val(right$(a$,1))
	ny=1
	incr nyg
	if not romp&>roml& then zin a$ else a$=""
else
	djup=3
end if

if left$(a$,3)=="BIG" then
	incr nyg
	chop a$,b$
	chop a$,b$
	if b$="" then maxx=31 else maxx=val(b$)
else
	maxx=25
end if

romp&=1
for ylle=1 to nyg : zin a$ : next ylle


if ori=0 then
	gosub os
	yllefis=1
end if

	ori=0
	gosub font
	gosub 13
	color mio,nio,1
	cls
	
gosub makemenu2
count&=0
rr=40*med-1
'tid!=timer
'cback$=""

if oride>-2 then
	if spelar=1 then
		spelar=0
		spelarnu=0
		hip "clear"
		hip "eject"
	end if
end if

 
'------Nyläs

nywait:

	for t=1 to oride : waittof : next t

nylas:

incr count&

b$=inkey$ : menu0%=menu(0)
if b$<>"" or menu0%<>0 then a$="" : gosub muller

if pl=1 then
	if count&=stanna& then
		if ppinsert=2 then rest$=right$(rom$,len(rom$)-romp&+1) : ppinsert=1
		wom$=left$(rom$,romp&-1) : stanna&=-1 : da=0 : gosub makemenu : plus$=" +" : oride=0 : goto keyboard
	end if
   if romp&>roml& then da=0 : gosub makemenu : plus$=" +" : oride=0 : goto keyboard
end if
if romp&>roml& then start

zin a$


ullakofta:

select case a$

=chr$(131)
	zinint x : zinbyte y
	if anim=1 then
		cn$=anim$(animp)
		gosub cload : incr animp
		if anim$(animp)="" then animp=0 : gilbert=0
	end if
'	xe=(x and &b1010000000000000)
'	if xe=&b1000000000000000 or xe=&b0010000000000000 then y=y+256 : x=x xor &b0010000000000000

	xe=(x and &b1100000000000000)
	if xe=&b1000000000000000 or xe=&b0100000000000000 then y=-y : x=x xor &b0100000000000000
	waitblit
	put (x,y),w%,pset
	goto nywait

=chr$(132) : zinint x : zinbyte y :zinint n :zinbyte m : line (x,y)-(n,m),mio : goto nywait
=chr$(133) : zinint x :zinbyte y :zinint n :zinbyte m : line (x,y)-(n,m),mio,b : goto nywait
=chr$(134) : zinint x :zinbyte y :zinint n :zinbyte m : line (x,y)-(n,m),mio,bf : goto nywait
=chr$(17) : zinint x :zinbyte y :zinint r :zindec h! : circle (x,y),r,mio,,,h! : goto nywait
=chr$(130) : anim=0 : zinint x : zinbyte y :zinint n : zinbyte m : waitblit : get (x,y)-(n,m),w% : goto nylas
=chr$(129) : zinbyte mio : goto nylas
=chr$(153) : zinbyte nio : goto nylas
=chr$(137)
	zin cn$
	if left$(cn$,1)=":" then cn$="RAM"+cn$
	if not (left$(cn$,4)=="ram:" or left$(cn$,9)=="ram disk:") then
		yesno b$,"SECURITY ALERT!","This letter is trying write:",cn$,"    Is this okay???"
		if b$=="n" then start
	elseif fexists(cn$) and instr(tnames$,""""+cn$+"""")=0 then
		yesno b$,"SECURITY ALERT!","This letter is trying write:",cn$,"    Is this okay???"
		if b$=="n" then start
	end if
	if instr(tnames$,""""+cn$+"""")=0 then tnames$=tnames$+" """+cn$+""""
	gosub csave : goto nylas

=chr$(138) : anim=0 : zin cn$ : gosub cload : goto nylas
=chr$(135) : goto rita
=chr$(5) : goto rita2
=chr$(136) : zinint x :zinbyte y : paint (x,y),nio,mio : goto nywait
=chr$(127) : color mio,nio,1 : cls : goto nywait
=chr$(23)
	zinbyte speed : if oride>-1 then oride=speed
	goto nylas
=chr$(159) : zinbyte y : zinbyte xposse : locate y,xposse : goto nylas
=chr$(19)
	zinbyte y% :zinbyte x% : irg!(y%)=x%/255 : zinbyte x% : g!(y%)=x%/255 : zinbyte x% b!(y%)=x%/255 :palette y%,irg!(y%),g!(y%),b!(y%)
	if Ny=0 then zin c$
	goto nylas
=chr$(0)
	gilbert=0 : anim=1 : animp=0 : r=-1
	do
		incr r
		if r>=cards then cards=cards+100 : redim preserve anim$(cards)		
		zin anim$(r)
	loop until anim$(r)=""
	goto nylas

=chr$(2) : anim=1 : animp=0 : gilbert=0 : goto nylas


=chr$(1)
	if oride>-2 then gosub ntangent : goto nylas else in$="" : goto nylas

=chr$(144)
	zinbyte out
	timeout!=timer+out

	if oride>-2 then gosub ntangent2 : goto nylas else in$="" : goto nylas
		
=chr$(9)
	if oride>-2 then
		input in$
		in$=ucase$(in$)
	else
		in$=""
		print "?"
	end if
	if ai=2 then locate ,xposse
	goto nylas
=chr$(25)
	zinbyte kod
	if pl=0 then
		goto exkod
	else
		messwait "Here, the letter is run again."
	end if
	goto nylas
	
=chr$(21)
	zinbyte kod : zin b$
	if pl=0 then
		ms$=b$
		if backdir$="" then backdir$=katalog$
		gosub loadrom : goto exkod
	else
		messwait "Here, "+b$+" is run."
	end if
	goto nylas
	
=chr$(4)
	zinbyte kod
	if pl=0 then
		if backdir$="" then backdir$=katalog$
		ms$=in$ : gosub loadrom : goto exkod
	else
		messwait "Here, input letter is run."
	end if
	goto nylas

=chr$(146)
	zinbyte kod
	if pl=0 and backdir$<>"" then
		katalog$=backdir$
		backdir$=""
		chdir katalog$
		rom$=wom$
		romp&=1 : roml&=len(rom$)
		goto exkod
	elseif pl=1 then
		messwait "Here, the first calling letter is restarted (if any)"
	end if
	goto nylas
	
=chr$(142)

	zinint x : zinbyte y
	zinint x2 : zinbyte y2
	if not in$=="*mus*" then nylas

	if musxx>=x and musxx==y and musyy==x and musxx==y and musyy=NIL: ""address IBROWSE GotoURL '"+aa$+"'"""		
		shell "SYS:rexxc/rx >NIL: ""address VOYAGER OpenURL '"+aa$+"'"""		
		shell "SYS:rexxc/rx >NIL: ""address AWEB.1 Open '"+aa$+"'"""		
			
		gosub ntangent

		do : waittof : loop until mouse(0)=0
		waittof
		do : waittof : loop while mouse(0)<>0
		waittof
		do : waittof : loop until mouse(0)=0
		
		in$=""

		xxclose
	end if
	goto nylas
=chr$(20)
	goto nylas
	
=chr$(15)
	zinbyte kod
	zin b$ : zin c$
	if b$==in$ then
		if backdir$="" then backdir$=katalog$
		ms$=c$ : gosub loadrom : goto exkod 
	else
		goto nylas
	end if
=chr$(145)
	zinbyte kod
	zinint x : zinbyte y
	zinint x2 : zinbyte y2
	zin c$
	if not in$=="*mus*" then nylas
	
	if musxx>=x and musxx==y and musyy=1 then w%(2)=w%(2)-1
	goto nylas

=chr$(156)
	if w%(2)<>5 then
		w%(2)=w%(2)+1
		el&=6+((w%(1)+1)*2*int((w%(0)+16)/16))*w%(2)
		el&=el&/2
		if el&>mac& then w%(2)=w%(2)-1
	end if
	goto nylas

=	chr$(22)
	zinbyte dely
	if oride >-1 then
		for urp=1 to dely : waittof : next urp
	end if
	goto nylas

= chr$(152)
	zin b$
	if oride>-2 then
		fullname b$
		if not fexists(b$) then messwait b$+" not found." : goto nylas
		if spelar=0 then
			win&=window(7)
			hip "quit"
			delay 10
			open "env:blhip" for input as #8
			line input #8, o$
			close 8
			if left$(o$,1)<>"""" then o$=""""+o$+""""

			shell "run >NIL: "+o$+" >NIL: """+b$+""""
			delay 20
			ScreenToFront(peekl(systab+12))
			activatewindow win&
		else
			hip "play '"+b$+"'"
		end if

		spelarnu=1
		spelar=1
	end if
	goto nylas

= chr$(148)
	zin b$
	if oride>-2 then
		fullname b$
		if not fexists(b$) then messwait b$+" not found." : goto nylas
		open "env:blview" for input as #8
		line input #8, o$
		close 8
		'if left$(o$,1)<>"""" then o$=""""+o$+""""
		shell o$+" >NIL: """+b$+""""

		ScreenToFront(peekl(systab+12))
	end if
	goto nylas

	
= chr$(151)
	if oride>-2 then hip "stop" : spelarnu=0
	goto nylas
	
= chr$(150)
	if oride>-2 then hip "continue" : spelarnu=1
	goto nylas

= chr$(149)
	zinbyte aa
	if oride>-2 then hip "songplay "+str$(aa) : spelarnu=1
	goto nylas	

= chr$(147)
	zin aa$
	if oride>-1 then
		if spelarnu=1 or viktor=0 then
			spelarnu=0
			viktor=1
			hip "clear"
			hip "eject"
		end if
		gosub sag
	end if
	goto nylas	
	
end select


cx=pos(0)-1
color mio, nio, jam

yllegolv:
ja$=ja$+a$
lena=len(a$)

if a$=chr$(8) then
	if cx>1 then decr cx
elseif a$=chr$(13) then
	print left$(ja$,len(ja$)-1);
	yp=csrlin
	if yp"" or menu0%<>0 then
	print ja$;
	color mio, nio, 1
	ja$=""
	a$="" : gosub muller
	color mio, nio, jam
end if

if pl=1 then
	if count&=stanna& then
		print ja$;
		color mio, nio, 1
		ja$=""
		if ppinsert=2 then rest$=right$(rom$,len(rom$)-romp&+1) : ppinsert=1
		wom$=left$(rom$,romp&-1) : stanna&=-1 : da=0 : gosub makemenu : plus$=" +" : oride=0 : goto keyboard
	end if
   if romp&>roml& then
   	print ja$;
		color mio, nio, 1
		ja$=""
   	da=0 : gosub makemenu : plus$=" +" : oride=0 : goto keyboard
   end if
end if
if romp&>roml& then
  	print ja$;
	color mio, nio, 1
	ja$=""
	goto start
end if

zin a$


if oride>0 then
	if sim=2 then
		aride=oride-1
		if bobbe$=" " then dey=aride*2.4+rnd*6 else dey=aride+rnd*5+1
		if instr("-_/'\|+)=(/&%$£³£""@~`",bubbe$)<>0 then dey=aride*8+rnd*9
		if instr(",.;:?!",bebbe$)<>0 and bobbe$=" " then dey=aride*10+rnd*9
		if bobbe$=bubbe$ and a$=bubbe$ and bebbe$=a$ then dey=aride
		bebbe$=bobbe$
		bobbe$=bubbe$
		bubbe$=a$
		if instr(codes$,a$)<>0 then bebbe$="." : bobbe$=" "
	else
		dey=oride
	end if
	if cursor=2 then
		y=(csrlin-1)*8 : x=(pos(0)-1)*8-1
		if x=-1 then x=0
		waitblit
		get (x,y)-(x+8,y+7),q%
		if jam=4 or jam=5 then
			c1=nio
			c2=mio
		else
			c1=mio
			c2=nio
		end if

		color ,,1
		if jam<>4 then line (x+1,y+1)-(x+7,y+6),c1,b
		if jam<>0 then
			line (x,y)-(x+8,y+7),c2,b
			line (x+2,y+2)-(x+6,y+5),c2,b
		end if
		color ,,jam


		for t=1 to dey : waittof : next t

		waitblit
		put (x,y),q%,pset
	else
		for t=1 to dey : waittof : next t
	end if
elseif instr(codes$,a$)=0 then
	goto yllegolv
end if

print ja$;
color mio, nio, 1
ja$=""

goto ullakofta



nyboard:
if x<1 then x=1
if y<1 then y=1
if y>maxx then y=maxx
locate y,x : goto nylas


hjelp:
if da=1 then
	window 2,"Help-screen:  BorayLetter V"+ver$,(0,0)-(630,242),16,-1
	color 1,0
	gosub font
	cls
	?
	color 2
	? "BorayLetter is shareware!!!"
	color 1
	?
	? "And remember.... If you don't pay anything at all,"
	? "then you are not alowed to use the program at all..."
	color 2
	?
	? "                                                         Press any key...";
	color 1


	555
	do : sleep : c$=inkey$ : loop while c$=""



	window 1 : window close 2
	return
else

	cnback$=cn$
	restore
	read ylle
	rom$=space$(ylle*4+8)
	for t=0 to ylle-1
		read a&
		xpokel sadd(rom$)+t*4, a&
	next t
	
	help=1
	da=1 : Oldmike=0 : romp&=1 : roml&=len(rom$) : pl=0
	return ladda
	
end if

farg:
y%=djup
if y%=1 then y%=2
xwindow3
q=int(2^djup)-1
for t=0 to q
	palette t,irg!(t),g!(t),b!(t)
next t


svart svart,-1
vit vit,-1
color vit,svart

if djup=1 then
palette 2,1,1,1
palette 3,0,0,0
color 2,3
end if
line(0,0)-(320*med,65),svart,bf
line(0,65)-(320*med,65),vit,bf

q=int(2^djup)-1
w!=310*med/(q+1)
a!=0
for t=0 to q
line (a!,0)-(a!+w!,20),t,bf
a!=a!+w!
next
locate 4,1
print "Use mouse to:"
if a$=chr$(153) then
	print "Pick background/fill-color!"
	gosub asta
	nio=mixo
	line (280,25)-(310,50),nio,bf
end if
if a$=chr$(129) then
	print "Pick foreground/outline-color!"
	gosub asta
	mio=mixo
	line (290,30)-(300,45),mio,bf
end if
if a$=chr$(129) or a$=chr$(153) then
	fireon: waittof : if mouse(0)<>0 then fireon
	goto welling
end if
if a$=chr$(19) then
	print "Pick color to modify!"
	gosub asta
	
	xxclose
	xwindow2
	q=int(2^djup)-1
	for t=0 to q
		palette t,irg!(t),g!(t),b!(t)
	next t

	svart svart,mixo
	vit vit,mixo
	
	line(0,0)-(310,80),svart,bf
	line(0,0)-(310,80),vit,b
	
	line(10,60)-(70,70),vit,b
	line(80,60)-(140,70),vit,b

	color vit,svart
	print ptab(34,68);"OK"
	print ptab(87,68);"Cancel"

	y%=mixo
	p!(0)=irg!(y%) : p!(1)=g!(y%) : p!(2)=b!(y%)
	p$(0)=" Red "
	p$(1)="Green"
	p$(2)="Blue "
	print
	line (2,2)-(100,9),y,bf
	line (2,2)-(100,9),vit,b
	
	for t=0 to 2
		line (9,15+12*t)-(302,26+12*t),vit,b
	next t

	do : waittof : loop while mouse(0)<>0

	palette y,p!(0),p!(1),p!(2)
	
	color svart,vit
	for t=0 to 2
		print ptab(p!(t)*250+11,15+12*t+8);p$(t)
	next
		
urban:
	do : sleep : loop until mouse(0)<>0
	z=(mouse(2)-20)/12
	if z<0 or z>2 then
		qx=mouse(1)
		qy=mouse(2)
		if qx>10 and qy>60 and qx<70 and qy<70 then
			line(11,61)-(69,69),y,bf
			color vit,y
			print ptab(34,68);"OK"

			do : waittof : loop while mouse(0)<>0

			irg!(y%)=p!(0) : g!(y%)=p!(1) : b!(y%)=p!(2)
			xxclose
			palette y%,irg!(y%),g!(y%),b!(y%)
			zut chr$(19) : zutbyte y% : zutbyte 255*irg!(y%) : zutbyte 255*g!(y%) : zutbyte 255*b!(y%)
			goto keyboard
		end if
		if qx>80 and qy>60 and qx<140 and qy<70 then
			line(81,61)-(139,69),y,bf
			color vit,y
			print ptab(87,68);"Cancel"

			do : waittof : loop while mouse(0)<>0

			xxclose
			goto keyboard
		end if

	
		waittof
		goto urban	
	end if
	do while mouse(0)<>0
		p!(z)=(mouse(1)-34)/250
		if p!(z)>1 then p!(z)=1
		if p!(z)<0 then p!(z)=0
		if pb!(z)<>p!(z) then
			palette y,p!(0),p!(1),p!(2)
			waittof : waittof
			line (10,16+12*z)-(301,24+12*z),svart,bf
			print ptab(p!(z)*250+11,15+12*z+8);p$(z)
			pb!(z)=p!(z)
		else
			waittof : waittof
		end if
	loop
	goto urban

end if

asta: if mouse(0)<>0 then asta
tomteq: sleep : if mouse(0)=-1 or mouse(0)=-2 then
mixo=point(mouse(1),mouse(2))
return
else
goto tomteq
end if
return
welling:
xxclose
if a$=chr$(129) then zutbyte mio
if a$=chr$(153) then zutbyte nio
goto keyboard


tag:
rem on error goto fel
call firstcoord(2,mio,mio) : if menu0%<>0 then keyboard
do
	call coord(a,1,x,y,x2,y2)
	if a=1 then
		waitblit
		get (x,y)-(x2,y2),w%
		color ,,2
		line (x,y)-(x2,y2),,b
		color ,,1
	end if
	igge$=inkey$
	menu0%=menu(0) : if menu0%<>0 or igge$<>"" then
		call undocoord
		rem on error goto programfel
		goto keyboard
	end if
loop until mouse(0)<>0
do : waittof : loop while mouse(0)<>0

waitblit
put (x,y),w%,pset

if da=1 then scopy
zut a$ : zutint x : zutbyte y : zutint x2 : zutbyte y2
loadcopy$=""

rem on error goto programfel
a$=chr$(5)
if cback$=="drawcopy" then drav=1 else cback$=chr$(5)
goto ge
fel: beep
if err=82 then programfel
resume tag



ge:


if loadcopy$<>"" and w%(0)=0 then
	if fexists(loadcopy$) then
		cn$=loadcopy$
		gosub cload
	else
		loadcopy$=""
	end if
end if

	elon=1
do : waittof : loop while mouse(0)<>0

ox=-1
oy=-1


ge2:

if menu0%<>0 then keyboard


TOMTE:
if anim=1 and gilbert=0 then
	gilbert=1
	cn$=anim$(animp)
	gosub cload : incr animp
	if anim$(animp)="" then animp=0
end if


if w%(0)=0 then messwait "There is no copy to put..." : goto keyboard
gosub getxy
waitblit

' (320*med,8*maxx+4)

get (max(0,x),max(0,y))-(min(x+w%(0),320*med) ,min (y+w%(1),8*maxx+4)),bw%

if only=0 or only=2 then
	waitblit
	put (x,y),w%,pset
end if
if only=1 or only=2 then
	color ,,2
	line(x,y)-(x+w%(0)-1,y+w%(1)-1),,b
	color ,,1
end if

xx=x
yy=y

do
	lan$="" : menu0%=menu(0) : if menu0%<>0 then getmenu lan$

	if lan$=="outline" then
		if only=0 then only=2 else if only=2 then only=0
		if only=1 then only=0
		gosub switch
		lan$=""
	end if

	if lan$=="brush" then
		if only=1 then only=2 else if only=2 then only=1
		if only=0 then only=1
		gosub switch
		lan$=""
	end if

	mm=mouse(0) : lin$=inkey$ : igge$=lin$
	if (lin$<>"" or lan$<>"") and elon=0 and a$=chr$(5) then waitblit : put (max(0,xx),max(0,yy)),bw%,pset : zutint -1 : goto keyboard
	if (lin$<>"" or lan$<>"") then waitblit : put (max(0,xx),max(0,yy)),bw%,pset : goto keyboard

	gosub getxy

	if x=xx and y=yy then
		waittof
		waittof
	else
		waittof
		waittof
		waitblit
		put (max(0,xx),max(0,yy)),bw%,pset
		xx=x
		yy=y
		waitblit
		get (max(0,x),max(0,y))-(min(x+w%(0),320*med) ,min (y+w%(1),8*maxx+4)),bw%
				
		if only=0 or only=2 then
			waitblit
			put (x,y),w%,pset
		end if
		if only=1 or only=2 then
			color ,,2
			line(x,y)-(x+w%(0)-1,y+w%(1)-1),,b
			color ,,1
		end if

	end if
loop until mm<>0
if drav=0 then
	do : waittof : loop while mouse(0)<>0
end if

waitblit
put (max(0,x),max(0,y)),bw%,pset
waitblit
put (x,y),w%,pset
if elon=1 then
	if loadcopy$<>"" then
		if fexists(loadcopy$) then
			cn$=loadcopy$ : loadcopy$=""
			zut chr$(138)
			zut cn$
		else
			loadcopy$=""
		end if
	end if
	elon=0 : zut a$ : incr count&
end if

if anim=1 or (ox<>x or oy<>y) then
	if y<0 then
		xe=(x xor &b0100000000000000)
		ey=-y
	else
		xe=x
		ey=y
	end if
'	if ey>255 then ey=ey-256 : xe=(xe xor &b0010000000000000)
	zutint xe : zutbyte ey : gilbert=0

end if

ox=x
oy=y

if a$=chr$(5) then ge2
goto keyboard



fill: 
call firstcoord(1,nio,mio) : if menu0%<>0 then keyboard
paint (xxx,yyy),nio,mio
zut a$
zutint xxx : zutbyte yyy
goto keyboard


lin:

	elon=1
	lan$=""
	lin$=""
	oy=-1
	ox=-1

prutt:
	lan$=""
	call firstcoord(1,mio,mio)
	hupps=menu0%
	if menu0%<>0 then
		getmenu lan$ : drav=0
		if igge$=chr$(135) and lin$=chr$(135) then lan$=chr$(135) : drav=0
	end if
	if elon=0 then
		if hupps<>0 then
			if lan$=chr$(135) then prutt else zutint -1 : goto keyboard
		end if
		zutint -2
		zutint xxx : zutbyte yyy
		oy=-1
		ox=-1
		goto prutt2
	end if

	if hupps<>0 then keyboard
prutt2:


do
	lin$=inkey$ : igge$=lin$ : menu0%=menu(0) : if menu0%<>0 then getmenu lin$ : lan$=lin$ : drav=0
	if drav=1 and mouse(0)=0 then lin$=chr$(135)
	if a$=chr$(135) and lin$=chr$(135) and elon=0 then call undocoord : goto prutt
	if lin$<>"" then
		call undocoord
		if elon=0 then zutint -1
		goto keyboard
	end if
	
	lan$=""
	
	call coord(a,0,x,y,n,m)
	if a=1 then
		if a$=chr$(132) or a$=chr$(135) then line (x,y)-(n,m),mio
		if a$=chr$(133) then line (x,y)-(n,m),mio,b
		if a$=chr$(134) then line (x,y)-(n,m),mio,bf		
	end if
loop while mouse(0)=0

if elon=1 then
	zut a$
	zutint xxx : zutbyte yyy
	oy=-1 : ox=-1
	elon=0
end if

if ox<>n or oy<>m then
	zutint n : zutbyte m
end if
ox=n : oy=m

if a$=chr$(135) then
	call setcoord(n,m)
	x=n : y=m
	if drav=0 then
		do : waittof : loop until mouse(0)=0
	end if
	goto prutt2
end if
goto keyboard


exporting:
	if right$(dis$,4)==".bld" then
		yesno b$,"Really save .bl?","You have a .bld file","in memory.",""
		if b$=="n" then start5
	end if
	womb$=wom$

	if instr(katalog$,right$(tempdir$,6))>0 then
		swap tempdir$, tempdir2$
	end if

	if not fexists(tempdir$) then shell "makedir >nil: """+tempdir$+""""
	
	shell "delete >nil: "+tempdir$+"/#?"
	
   letters$=""""+cur$+""""
   for t=0 to dyn : org$(t)="" : ny$(t)="" : next t
   ny$(0)=""

	color 1,3
   cls
   print "Analysing files and saving brushes from:"
   print
   do
   
   	wom$=""
   	chop letters$,next$
   	if next$="" or next$=="ram:memory" or next$=="ram disk:memory" or next$=="*main*menu*" then urpo

   	newname 0,next$, nys$, ii
'   	if not ii=1 then urpo

   	if next$==cur$ then
   		rom$=womb$
   	else
   		if fexists(next$) then
	   		open next$ for input as #2
	   		rom$=input$(lof(2),2)
	   		if instr(next$,":")<>0 or instr(next$,"/")<>0 then
	   			nel$=next$
	   			dir nel$
	   			chdir nel$
	   		end if
	   	else
	   		messwait next$+" not found." : goto urp2
	   	end if
   	end if
   	
		romp&=1 : roml&=len(rom$) : lromp&=1
		
		print next$+" -> "+nys$

		do
			zin a$

			select case a$

			=chr$(131), chr$(136) : romp&=romp&+3
			=chr$(159) : romp&=romp&+2
			=chr$(19) : romp&=romp&+4
			=chr$(132),chr$(133),chr$(134),chr$(130) : romp&=romp&+6
			=chr$(17)  : romp&=romp&+9
			=chr$(144),chr$(129),chr$(4),chr$(146),chr$(22),chr$(25),chr$(23),chr$(153),chr$(149) : incr romp&
			=chr$(137)
				zin cn$ 'Skriv kopia
				newname 3,cn$, slask$, ii

			=chr$(135) : gosub ruta
			=chr$(5) : gosub ruta5
			=chr$(0)
				gosub conclude
				do
					zin cn$
					if cn$="" then
						zut ""
					else
						newname 1,cn$, ny$, ii
						zut ny$
						if ii=1 then
							print "        "+cn$+" -> "+ny$
							if not fexists(cn$) then messwait cn$+" not found." : goto urp2
							shell "copy >nil: """+cn$+""" to """+tempdir$+"/"+ny$+""""
						end if
					end if
				loop until cn$=""
				lromp&=romp&
			=chr$(138), chr$(152), chr$(148)
				gosub conclude
				zin cn$
				if a$=chr$(138) then
					newname 1,cn$, ny$, ii
				else
					newname -1,cn$, ny$, ii
				end if
				zut ny$
				if ii=1 then
					if not fexists(cn$) then messwait cn$+" not found." : goto urp2
					print "        "+cn$+" -> "+ny$
					fullname cn$

					shell "copy >nil: """+cn$+""" to """+tempdir$+"/"+ny$+""""
					if fexists(cn$+".info") then shell "copy >nil: """+cn$+".info"" to """+tempdir$+"/"+ny$+".info"""
				end if
				lromp&=romp&
			=chr$(21), chr$(15), chr$(145)
				incr romp&
				if a$=chr$(15) then zin b$
				if a$=chr$(145) then romp&=romp&+6
				gosub conclude
				zin cn$
				if lha(cn$) then
					newname -1,cn$, ny$, ii
					zut ny$
					if ii=1 then
						if not fexists(cn$) then messwait cn$+" not found." : goto urp2
						print "        "+cn$+" -> "+ny$
						fullname cn$
	
						shell "copy >nil: """+cn$+""" to """+tempdir$+"/"+ny$+""""
						if fexists(cn$+".info") then shell "copy >nil: """+cn$+".info"" to """+tempdir$+"/"+ny$+".info"""
					end if
					
				else
					newname 0,cn$, ny$, ii
					zut ny$
					if ii=1 then letters$=letters$+" """+cn$+""""
				end if
				lromp&=romp&
			=chr$(147)
				zin aa$
			=chr$(143)
				zin aa$
				romp&=romp&+6
			=chr$(142)
				romp&=romp&+6
			end select

		loop until romp&>roml&
		
		gosub conclude

		open tempdir$+"/"+nys$ for output as #2
		print #2,wom$;
		close 2

urpo:
	loop until letters$=""

'	chdir "RAM:"
'	chdir katalog$
	chdir startdir$
isk:

	chdir tempdir$
	
	tempfile$="ram:BL"+ltrim$(rtrim$(str$(timer)))+".lha"
	
	te$=".bl"


	if yam=0 then
		if make$="" then
			fil$=dis$
			setext fil$,".bl"
			worked=GetFile%(fil$,"Save .bl File:",0,"",bl0$)
			if worked=0 then urp2
			setext fil$,".bl"
		else
			fil$=make$
			yesno b$,"About to save the file:",fil$,"","     Is this okay?"
			if b$=="n" then make$="" : goto urp2
		end if
	
		epy$=fil$
		file epy$
'		if epy$=="firstletter.bl" then messwait "Filename not allowed!" : goto isk

		if make$="" then
			if not fileok(fil$) then isk
		end if
	
		shell "delete >nil: """+fil$+""""

		print
		print "Lha adding... to file: "+fil$+"   Please wait!"
	else
		print
		if mail$="" then
			print 		"Preparing Lha package for YAM...  Please wait!"
		else
			print 		"Preparing Lha package for email...  Please wait!"
		end if
	end if
	
	shell "lha >nil: -Ixq a """+tempfile$+""" #?"
	

	if yam=1 then
		if mail$="" then
			yesno bof$,"Do you also want to extract","the text from this letter and","put it into the e-mail message?",""
		else
			bof$="n"
		end if
		yesno b$, "","Send this letter to a new user?","    (Include BorayLetter","        executable?)"
		if b$=="y" then yesno b$, "Including the BL executable","will increase the attachment","size with about 100 K, so","Are you really sure?"
	
		if b$=="y" then		
			if not fexists(tempdir2$) then shell "makedir >nil: """+tempdir2$+""""
			shell "delete >nil: "+tempdir2$+"/#?"

			shell "copy >nil: """+tempfile$+""" """+tempdir2$+"/FirstLetter.bl"""
			shell "delete >nil: "+tempfile$
			print
			print "Adding the file C:BL and some start icons..."
			print
			print "Please wait!"
			
			chdir tempdir2$	
			shell "copy >nil: c:bl BL"
			restore readletterinfo
			putfile "FirstLetter.bl.info"
			
rem			open "Read Letter" for output as #8
rem			print #8, "bl FirstLetter.bl"
rem			close 8
			
			restore mainmenuinfo
			putfile "Main Menu.info"
			open "Main Menu" for output as #8
			print #8, "bl"
			close 8

			restore install
			putfile "Install.info"
			open "Install" for output as #8
			print #8, "bl install"
			close 8


			
			shell "lha >nil: -Ixq a """+tempfile$+""" #?"
			
			chdir tempdir$
			
			te$=".lha"
		end if
	end if


	chdir "RAM:"
	if yam=0 then
		shell "copy >nil: "+tempfile$+" """+fil$+""""
		if not fexists(fil$+".info")
			restore readletterinfo
			putfile fil$+".info"
		end if		
	else
		if not fexists(tempdir3$) then shell "makedir >nil: """+tempdir3$+""""

		epy$=dis$
		setext epy$, ".bl"
		epy$=tempdir3$+"/"+epy$
		epy$=left$(epy$,len(epy$)-3)
	
		do until instr(epy$," ")=0
			mid$(epy$,instr(epy$," "),1)="_"
		loop

		do until instr(epy$,"'")=0
			mid$(epy$,instr(epy$,"'"),1)="_"
		loop

		do until instr(epy$,"""")=0
			mid$(epy$,instr(epy$,""""),1)="_"
		loop
		
	
		do until not fexists(epy$+te$)
			epy$=epy$+"_"
		loop
		
		epy$=epy$+te$

		shell "copy >nil: "+tempfile$+" """+epy$+""""
		
		e$="b64"
		
		if te$==".bl" then
			mime$="application/x-bl"
		else
			mime$="application/x-lha"
		end if
		
		open epy$ for input as #7
		if lof(7)<3000 then e$="uu"
		close 7
		
		if mail$="" then
			yam "show"
			yam "screentofront"
			YAM "mailwrite"
			YAM "writeattach '"+epy$+"' 'BorayLetter' "+e$+" '"+mime$+"'"

			txt$=tempdir3$+"/"+ltrim$(rtrim$(str$(timer)))
			open txt$ for output as #8
			print #8,"Hello!"
			print #8,""
			print #8,"The attached file is a special Boray-Letter. You can"
			print #8,"easily make a BorayLetter that contains sound effects,"
			print #8,"music, graphics and cartoons and then send them via email."
			print #8,""
			
			if te$==".lha" then
				print #8,"The BorayLetter executable (BL) is included in this"
				print #8,"lha archive. Just unarchive it and double click"
				print #8,"on the 'Read' icon. For more info, letters and tips:"
				print #8,"visit http://www.odyssey.on.ca/~dhamilton/borayletter.html"
				print #8,"Here (or on Aminet) you can get the full BL archive."
			else
				print #8,"To be able to read the attached .bl file, you must have"
				print #8,"the BorayLetter executable installed. You can download"
				print #8,"it from Aminet or BorayLetter's official support site:"
				print #8,"http://www.odyssey.on.ca/~dhamilton/borayletter.html"
			end if
			
			if bof$=="y" then
				print #8,"------------------------------------------------"
				print #8,"Here follows the text extracted from the letter:"
				print #8,"------------------------------------------------"

				wom$=womb$
				gosub exptxt
			else
				close 8
			end if
			
			aa$=epy$
			file aa$
			
			yam "writeletter '"+txt$+"'"
			yam "writesubject '"+aa$+"'"
		else
			shell mail$+" "+epy$+" "+mime$
		end if
		
		fil$=dis$

	end if
	shell "delete >nil: "+tempfile$

	print
	print "Ready..."
	delay 70
	plus$=""
	
	if make$<>"" then
		make$=""
		if yam=0 then sluta=1
	end if

	dis$=fil$
	file dis$

urp2:
	katalog$=tempdir$+"/"
'	if fexists(katalog$) then chdir katalog$
	chdir katalog$
	cur$="LetterData.bld"
	

	if fexists(cur$) then
		open cur$ for input as #1
			wom$=input$(lof(1),1)
		close 1
	end if

	rom$=wom$
	
goto start

ruta:
	zinint n
	if n=-1 then return
	if n=-2 then ruta
	incr romp&
	goto ruta

ruta5:
	zinint n
	if n=-1 then return
	incr romp&
	goto ruta5



conclude:
	if romp&=lromp& then return
	wom$=wom$+mid$(rom$,lromp&,romp&-lromp&)
return


sub newname(byval s, byval ne$, ny$, uy)
			shared tempdir$, dyn
			next$=ne$
			uy=0
			vw=0

			if left$(next$,1)=":" then
				next$="RAM"+next$
			elseif left$(next$,9)=="RAM DISK:" then
				next$="RAM"+right$(next$,len(next$)-8)
			end if

			if next$=="RAM:Memory" then next$="*main*menu*"


	   	do until org$(vw)==next$ or org$(vw)=""
	   		incr vw
	   	loop
	   	if org$(vw)="" then
	   		uy=1
	   		if vw=0 then
	   			ny$="LetterData.bld"
	   		else
			   	ny$=next$
			   	if not s=3 then
			   		file ny$
			   		if s=1 then
			   			setext ny$,".blc"
			   		elseif s=-1 then
				   	elseif not ny$=="*main*menu*" then
'				   		setext ny$, ".col"
				   	end if
			   	end if
			   end if
	multum:
			  	for g=0 to vw
			  		if ny$(g)==ny$ then
			  			if samefile(tempdir$+"/"+ny$(g),next$) then slutasub
			  			ny$="_"+ny$
			  			goto multum
			  		end if
			  	next g
			  	org$(vw)=next$ 
	 		  	ny$(vw)=ny$
			 end if
 		  	 ny$=ny$(vw)
'			 print vw,next$,ny$

slutasub:

	if vw=dyn then dyn=dyn+200 : redim preserve org$(dyn), ny$(dyn)

end sub



ladding:
	gosub memkoll
'	worked=GetFile%(fil$,"Load File:",0)
'	if worked=0 then start

	cback$=""

	ful$=sdir$(startdir$)
	worked=GetFile%(ful$,"Load File",2,"#?(.bl|.lha|.col|.bld)",bl0$)
	if worked=0 then start
	
	dis$=ful$
	file dis$
	
	if lha(ful$) then
		if backdir$<>"" then
			if sdir$(backdir$)=sdir$(tempdir$) then swap tempdir$, tempdir2$
		elseif instr(katalog$,right$(tempdir$,6))>0 then
			swap tempdir$, tempdir2$
		end if

		tempfile$="ram:BL"+ltrim$(rtrim$(str$(timer)))+".lha"
		shell "copy >nil: """+ful$+""" "+tempfile$

		if not fexists(tempdir$) then shell "makedir >nil: """+tempdir$+""""
	
		shell "delete >nil: "+tempdir$+"/#?"

		shell "lha >nil: -Ixq x """+tempfile$+""" "+tempdir$+"/"
		shell "delete >nil: "+tempfile$
		
		ful$=tempdir$+"/LetterData.bld"
		if not fexists(ful$) then ful$=tempdir$+"/FirstLetter.bl"
		if not fexists(ful$) then ful$=tempdir$+"/FirstLetter.blr"
		if not fexists(ful$) then ful$=tempdir$+"/LetterData.info"
		if not fexists(ful$) then ful$=tempdir$+"/LetterData.bld"
	end if
	
	katalog$=ful$ : dir katalog$
	chdir katalog$ : fil$=right$(ful$,len(ful$)-len(katalog$))


'	mess0 "Please wait..."
	if fil$="" then start
	if not fexists(fil$) then messwait "No "+fil$+" in bl file." : goto start
	ms$=fil$
	gosub loadrom

	wom$=rom$
	redo$=""

	cur$=fil$
	file cur$
	plus$=""

	da=1 : Oldmike=0 : rom$=wom$ : romp&=1 : roml&=len(rom$)
	goto ladda

loadrom:

	if fexists(ms$) then
	
		if wom$="" then wom$=rom$
	
		if lha(ms$) then
			if backdir$<>"" then
				if sdir$(backdir$)=sdir$(tempdir$) then swap tempdir$, tempdir2$
			elseif instr(katalog$,right$(tempdir$,6))>0 then
				swap tempdir$, tempdir2$
			end if

			tempfile$="ram:BL"+ltrim$(rtrim$(str$(timer)))+".lha"
			shell "copy >nil: """+ms$+""" "+tempfile$

			if not fexists(tempdir$) then shell "makedir >nil: """+tempdir$+""""
		
			shell "delete >nil: "+tempdir$+"/#?"

			shell "lha >nil: -Ixq x """+tempfile$+""" "+tempdir$+"/"
			shell "delete >nil: "+tempfile$
			
			ms$="LetterData.bld"
			katalog$=tempdir$+"/"
			chdir katalog$
			
			if not fexists(ms$) then ms$="FirstLetter.bl"
			if not fexists(ms$) then ms$="FirstLetter.blr"
			if not fexists(ms$) then ms$="LetterData.info"
			if not fexists(ms$) then ms$="LetterData.bld"

		end if
		if not fexists(ms$) then messwait "No "+ms$+" in bl file." : return start
		
		if lha(ms$) then loadrom
		
		open ms$ for input as #1
		rom$=input$(lof(1),1)
rem		redo$=""

  		if instr(ms$,":")<>0 or instr(ms$,"/")<>0 then
			katalog$=ms$ : dir katalog$
			chdir katalog$ : ms$=right$(ms$,len(ms$)-len(katalog$))
  		end if


		close 1
		romp&=1 : roml&=len(rom$)
	else
		jepp=0
		if ms$=="ram:memory" or ms$=="ram disk:memory" or ms$=="*main*menu*" then return start
		messwait ms$+" not found."
		return start
	end if
return




rita:
zinint n
if n=-1 then
	goto nywait
elseif n=-2 then
	goto rita
end if
zinbyte m
'pset (n,m),mio

ritar:
for t=1 to oride : waittof : next t

b$=inkey$ : menu0%=menu(0)
if b$<>"" or menu0%<>0 then gosub muller

aa&=sadd(rom$)+romp&-1
pp&=varptr(x%)
pokeb pp&,peekb(aa&)
pokeb pp&+1,peekb(aa&+1)

	romp&=romp&+2

if x=-1 then
	goto nywait
elseif x=-2 then
	goto rita
end if

	y=peekb(sadd(rom$)+romp&-1)
	incr romp&

line (n,m)-(x,y),mio
n=x : m=y
goto ritar

rita2:
for t=1 to oride : waittof : next t

b$=inkey$ : menu0%=menu(0)
if b$<>"" or menu0%<>0 then gosub muller

	aa&=sadd(rom$)+romp&-1
	pp&=varptr(x%)
	pokeb pp&,peekb(aa&)
	pokeb pp&+1,peekb(aa&+1)

	romp&=romp&+2

if x=-1 then nywait

	y=peekb(sadd(rom$)+romp&-1)
	incr romp&

if anim=1 then
	cn$=anim$(animp)
	gosub cload : incr animp
	if anim$(animp)="" then animp=0
end if

'xe=(x and &b1010000000000000)
'if xe=&b1000000000000000 or xe=&b0010000000000000 then y=y+256 : x=x xor &b0010000000000000

xe=(x and &b1100000000000000)
if xe=&b1000000000000000 or xe=&b0100000000000000 then y=-y : x=x xor &b0100000000000000
waitblit
put (x,y),w%,pset

goto rita2

programfel:

if grest=1 then

	screenmode sm&(0), "Choose 640x251 display", 640,200

	open "S:BLscreenmodes.config" for output as #8
	for t=0 to 8
		print #8, sm&(t)
	next
	close 8

	resume grest1

end if

if grest=2 then
	if djup>4 then
		djupback=djup
		decr djup
		resume grest2
	elseif djupback>0 then
		djup=djupback
		djupback=0
	end if
	gosub getmode
	resume grest2
end if




if jepp=0 then
palette 5,0,0,0
palette 4,1,1,1
line (20,20)-(280,120),5,bf
line (20,20)-(280,120),4,b
color 4,5
if djup<3 and Oldmike=0 then
palette 0,1,1,1
palette 1,0,0,0
color 0,1
end if
locate 7,5
print "Error: ";err
if err=53 then print tab(5);"File not found"
if err=61 then print tab(5);"Disk full"
if err=64 then print tab(5);"Bad file name"
if err=68 then print tab(5);"Device unavailable"
if err=70 then print tab(5);"Disk write protected"
if err=82 then
	print tab(5);"Library not found"
end if
if err=9 then print tab(5);"File structure error"
end if
close #1
close #2
close #3
if jepp=0 then
print
print tab(5);"Press any key to resume!"
if err=0 then tegw
gosub tangent
end if
tegw: jepp=0
resume start
scopy:

if w%(0)=0 then
	messwait "There is no copy to save..."
	goto carl
end if

rem on error goto pfs
ick: rem on error goto pfs
if a$=chr$(137) then
	cn$="ram:"
elseif da=0 then
	yesno b$,"Please note that this action","is not recorded in the letter","","    Save anyway?"
	if b$=="n" then keyboard
end if
irmes:
setext cn$,".blc"
worked=GetFile%(cn$,"SaveName:",0,"",blc0$)
setext cn$,".blc"

if worked=0 then
	rem on error goto programfel
	goto carl
end if
if a$=chr$(137) then
	if instr(cn$,"/")<>0 then messwait "Must be saved directly on RAM:" : goto irmes

	if left$(cn$,1)=":" then cn$="RAM"+cn$
	if not (left$(cn$,4)=="ram:" or left$(cn$,9)=="ram disk:") then
		messwait "Temp. can only be saved to ram:"
		goto scopy
	end if
	if instr(tnames$,""""+cn$+"""")=0 then tnames$=tnames$+" """+cn$+""""
end if


if not fileok(cn$) then
	rem on error goto programfel
	goto carl
end if

gosub csave
rem on error goto programfel
if a$=chr$(137) then zut a$ : zut cn$
Carl: 
if da=1 then return
goto keyboard
pfs: beep
if err=82 then programfel
print "Error!!!!!"
close #3
beep : resume ick
lcopy:
icc: rem on error goto pfl
worked=GetFile%(cn$,"LoadName:",0,"#?.blc",blc0$)
if worked=0 then
	rem on error goto programfel
	goto Carl
end if
if not fexists(cn$) then
	messwait cn$+" not found"
	rem on error goto programfel
	goto Carl
end if

gosub cload
rem on error goto programfel
'zut a$
'zut cn$
loadcopy$=cn$
a$=chr$(5)
if cback$=="drawcopy" then drav=1 else cback$=chr$(5)
goto ge
pfl: beep
if err=82 then programfel
print "Error!!!!!"
close #3
beep : resume icc

element:
el&=6+((x+1)*2*int((y+16)/16))*q
el&=el&/2
if el&>mac& then el&=mac&
return

csave:
if left$(cn$,1)=":" then cn$="RAM"+cn$
y=w%(0) : x=w%(1) : q=w%(2) : gosub element
bsave cn$,varptr(w%(0)),(el&+1)*2

for cq=0 to cachemax
	if cachen$(cq)==cn$ then cachen$(cq)="" : cache$(cq)=""
next cq

return
cload:
if left$(cn$,1)=":" then cn$="RAM"+cn$

ja=-1
for cq=0 to cachemax
	if cachen$(cq)==cn$ then ja=cq ': locate 1,1 : color 1,0 : print cachen$(ja),len(cache$(ja))
next cq

if ja<>-1 then
	copymem sadd(cache$(ja)), varptr(w%(0)), len(cache$(ja))
	incr cloads2& : cloads&=cloads2&
else
	if not fexists(cn$) then
		messwait cn$+" not found."
		return start
	end if
	open cn$ for input as #3
	storl&=lof(3)
	incr cachepos : if cachepos>cachemax then cachepos=0
	ja=cachepos
	cache$(ja)=input$(storl&,#3)
	cachen$(ja)=cn$
	close #3

	copymem sadd(cache$(ja)), varptr(w%(0)), len(cache$(ja))
	incr dloads2& : dloads&=dloads2& : cloads&=cloads2&


	if storl&>cachemem& then
		cache$(cachepos)=""
		cachen$(cachepos)=""
		cachepos=(cachepos-1) mod cachemaxmod
		return
	end if
	
	ctot&=-1
	
	for cq=0 to cachemax
		ctot&=ctot&+len(cache$(cq))
	next cq
	
	zv=cachepos
	ctot4&=ctot&
	do until ctot&=5 or w%(2)<1 then

	cache$(ja)=""
	cachen$(ja)=""

	open cn$ for input as #3
	input #3,w%(0) : input #3,w%(1) : y=w%(0):x=w%(1)
	input #3,w%(2) : q=w%(2)
	gosub element
	for t&=3 to el&
		input #3,w%(t&)
	next t&
	close #3
end if

return

knapp: 
b$=inkey$ : menu0%=menu(0)
muller:
if menu0%<>0 then getmenu2 b$
if b$="" then return
if b$=chr$(27) then 
	if ppinsert=1 then
		ppinsert=0
		wom$=wom$+rest$
		rest$=""
	end if
	return start
end if

if b$="0" then speed=0 : oride=speed : gosub switch2 : return
if b$="1" then speed=1 : oride=speed : gosub switch2 : return
if b$="2" then speed=2 : oride=speed :gosub switch2 : return
if b$="3" then speed=3 : oride=speed :gosub switch2 : return
if b$="4" then speed=4 : oride=speed :gosub switch2 : return
if b$="5" then speed=5 : oride=speed :gosub switch2 : return
if b$="6" then speed=6 : oride=speed :gosub switch2 : return
if b$="7" then speed=7 : oride=speed :gosub switch2 : return
if b$="8" then speed=8 : oride=speed :gosub switch2 : return
if b$="9" then speed=9 : oride=speed :gosub switch2 : return

if b$="h" then
	if oride<0 then oride=speed else oride=-1
	gosub switch2
	return
end if


if b$=chr$(9) then gosub fsave : return
if ucase$(b$)="P" then gosub Screendump : return
if ucase$(b$)="T" then tag
if b$=="X" then
	menu reset
	gosub toggle
	gosub makemenu2	
	return
end if
if b$=="a" then
	if rom$<>wom$ and plus$<>"" then
		yesno bu$,"Really continue making at end?","You have an unsaved letter","in memory, this will be lost.","        Continue?"
	else
		yesno1 bu$,"Continue making at end?"
	end if
	if bu$=="y" then
		plus$=" +"
		help=0
		backdir$=""
		wom$=rom$
 		oride=-2
		Oldmike=0 : da=1 : pl=1 : ori=1
	end if
	return

end if
if b$=="c" then
	if rom$<>wom$ and plus$<>"" then
		yesno bu$,"Really continue making here?","You have an unsaved letter","in memory, this will be lost.","        Continue?"
	else
		yesno bu$,"Really continue making here?","    The rest of the letter","       will be lost.","        Continue?"
	end if
	if bu$=="y" then
		plus$=" +"
		help=0
		backdir$=""
		wom$=rom$
		if a$="" then
			wom$=left$(rom$,romp&-1) : stanna&=-1 : da=0 : gosub makemenu : plus$=" +" : oride=0 : return keyboard
		else
			menu0%=0 : roml&=len(rom$)
			oride=-2
			
			yesno0 bu$,"","Start making before", "or after the current event?", "","Before "," After "
			if bu$=="y" then
				stanna&=count& : romp&=1
				Oldmike=0 : da=1 : pl=1 : ori=1 : return ladda
			else
				pl=1
				stanna&=count&+1
			end if
		end if
	end if
	return
end if

if b$=="i" then
	if plus$<>"" and rom$<>wom$ then
		yesno bu$,"Really insert right here?","You have an unsaved letter","in memory, this will be lost.","        Continue?"
	else
		yesno1 bu$,"Really insert right here?"
	end if
	if bu$=="y" then
		plus$=" +"
		help=0
		backdir$=""
		wom$=rom$
		ppinsert=1
		if a$="" then
			rest$=right$(rom$,len(rom$)-romp&+1)
			wom$=left$(rom$,romp&-1) : stanna&=-1 : da=0 : gosub makemenu : plus$=" +" : oride=0 : return keyboard
		else
			ppinsert=2
			menu0%=0 : roml&=len(rom$)
			oride=-2
			
			yesno0 bu$,"","Start inserting before", "or after the current event?", "","Before "," After "
			if bu$=="y" then
				stanna&=count& : romp&=1
				Oldmike=0 : da=1 : pl=1 : ori=1 : return ladda
			else
				pl=1
				stanna&=count&+1
			end if			
		end if
	end if
	return
end if


if b$=chr$(255) then wom$=rom$ : sluta=0 : backdir$="" : return start


if b$=="s" then
	da=1 : Oldmike=0 : romp&=1 : ori=1 : return ladda
end if
if b$=chr$(137) then scopy
if b$=chr$(139) then gosub hjelp : return

tangent: sleep : menu0%=menu(0) : if inkey$="" and mouse(0)=0 and menu0%=0 then tangent
if menu0%<>0 then muller
do : waittof : loop while mouse(0)<>0
return

ntangent:
do : waittof : loop while mouse(0)<>0
ntangent3:

sleep : menu0%=menu(0) : in$=inkey$

if mouse(0)<>0 then in$="*mus*" : musxx=mouse(1) : musyy=mouse(2)

if in$="" and menu0%=0 then ntangent3
if menu0%<>0 then muller

in$=ucase$(in$)

if in$=chr$(27) then return start
return

ntangent2:
do : waittof : loop while mouse(0)<>0
ntangent4:

delay 8 : menu0%=menu(0) : in$=inkey$

if mouse(0)<>0 then in$="*mus*" : musxx=mouse(1) : musyy=mouse(2)

if timeout!0 then muller

in$=ucase$(in$)

if in$=chr$(27) then return start
return


13 palette 0,0.16,0,0.4
irg!(0) = 0.16 : g!(0)=0 : b!(0)=.4
palette 1,0.6,0.6,.9
irg!(1)=0.6 : g!(1)=0.6 : b!(1)=.9
if djup<3 and Oldmike=0 then
palette 1,1,1,1
irg!(1)=1 : g!(1)=1 : b!(1)=1
end if
palette 2,1,0.3,0.4
irg!(2)=1 : g!(2)=0.3 : b!(2)=0.4
palette 3,0,0.1,0.56
irg!(3)=0 : g!(3)=.1 : b!(3)=0.56
palette 4,1,1,1
irg!(4)=1 : g!(4)=1 : b!(4)=1
palette 5,0,0,0
irg!(5)=0 : g!(5)=0 : b!(5)=0
palette 6,0.5,.8,.4
irg!(6)=0.5 : g!(6)=.8 : b!(6)=0.4
palette 7,1,1,0
irg!(7)=1 : g!(7)=1 : b!(7)=0 
mio=1 : nio=3 : jam=1 : cursor=2 : sim=1 : ai=2
xposse=1

color mio,nio,jam
if djup=1 then mio=1 : nio=0 : color 0,1
randomize 3
for t=8 to 31
g!(t)=val(left$(str$(rnd),4)) : if g!(t)>1 then g!(t)=0
b!(t)=val(left$(str$(rnd),4)) : if b!(t)>1 then b!(t)=0
irg!(t)=val(left$(str$(rnd),4)) : if irg!(t)>1 then irg!(t)=0
palette t,irg!(t),g!(t),b!(t)
next t
randomize timer
return

ring: 
call firstcoord(1,mio,mio) : if menu0%<>0 then keyboard

do
	call coord(a,1,x,y,x2,y2)
	if a=1 then

		if x=x2 then incr x2
		if y=y2 then incr y2
		xt=int(x+((x2-x)/2))
		yt=int(y+((y2-y)/2))
		let r=xt-x
		if xt-x < yt-y then let r=yt-y
		if x2-x>0 then h!=(y2-y)/(x2-x) else h!=0
		circle (xt,yt),r,mio,,,h!

	end if
	igge$=inkey$
	menu0%=menu(0) : if menu0%<>0 or igge$<>"" then
		call undocoord
		goto keyboard
	end if
loop until mouse(0)<>0
do : waittof : loop while mouse(0)<>0

zut a$ : zutint xt : zutbyte yt : zutint r : zutdec h!
goto keyboard

fsave:
yesno1 b$,"Save color file (.col)?"
if b$=="N" then return

fil$=sdir$(startdir$)+dis$
setext fil$,".col"

worked=GetFile%(fil$,"SaveName:",0,"",col0$)
setext fil$,".col"

if worked=0 then return
if not fileok(fil$) then return

xwindow
tick: rem on error goto tpfs
q=int(2^djup)-1
input "First color (0)";f%
print "Last color (";q;")";
input s%
if s%<0 then s%=0
if s%>q then s%=q
if f%<0 then f%=0
if f%>q then f%=q
print "Save color ";f%;" as color? (0-31)";
input y%
if y%<0 then y%=0
if y%>31 then y%=31
open fil$ for output as #3

print #3,""
print #3,"BLETTER "+ver$

print #3,""
print #3,"MODE"+str$(med)

print #3,""
print #3,"DJUP"+str$(djup)

if maxx>25 then print #3, "" : print #3,"BIG"+str$(maxx)


for t=f% to s%
print #3,chr$(19);chr$(y%);chr$(255*irg!(t));chr$(255*g!(t));chr$(255*b!(t));
y%=y%+1
if y%=32 then trytte
next t
trytte: 
close #3

tCarl:
rem on error goto programfel
call xxclose
return

tpfs: beep
if err=82 then programfel
print "Error!!!!!"
close #3
goto tick

setspeed:
xwindow
palette 0,0,0,0
palette 1,1,1,1
palette 2,.45,.56,.64
palette 3,.9,.4,.2

color 1,0
cls
?
? " Use mouse (left button=OK)"
color 2
locate 12,2 : print "Last speed:";speed
locate 8,1
man$(0)="Warp Speed!"
man$(1)="Normal Drawing Speed"
man$(2)="Normal Drawing Speed"
man$(3)="Normal Text Speed"
man$(4)="Normal Text Speed"
man$(5)="Slow Text Speed"
man$(6)="Slow Text Speed"

print
do until mouse(0)=1
	ylle=mouse(1) : if ylle>320 then ylle=320
	speed=ylle/26
	color 1
	locate 7,2 : print "Playback delay:";speed;"vertical blanks  ";
	line(0,20)-(speed*26,40),3,bf
	line(speed*26+1,20)-(312,40),2,bf
	locate 9,2
	color 3
	if speed>6 then
		print "Slow...                   "
	else
		print man$(speed)+"              "
	end if
	
	waittof
	waittof
	waittof
	waittof
loop
do : waittof : loop until mouse(0)=0
xxclose

zutbyte speed
if oride>-1 then oride=speed

speed$="("+ltrim$(rtrim$(str$(speed)))+")"
if speed<10 then speed$=speed$+" "
menu 1,3,1,"Playback Speed "+speed$+"   [Ctrl W]"

return

setdelay:
xwindow
palette 0,0,0,0
palette 1,1,1,1
palette 2,.5,.5,.5
palette 3,.4,.8,.2

color 1,0
cls
print "Insert delay:"
? "Use mouse (left button=OK)"
print
do until mouse(0)=1
	ylle=mouse(1) : if ylle>320 then ylle=320
	if ylle<2 then ylle=2
	dely=ylle/2
	locate 7,1 : print "Insert single delay of:";dely;"vertical blanks  "
	print
	print "PAL:";dely/50;"seconds                       "
	print "NTSC:";dely/60;"seconds                      "
	line(0,20)-(dely*2,40),3,bf
	line(dely*2+1,20)-(320,40),2,bf
	waittof
	waittof
	waittof
	waittof
loop
do : waittof : loop until mouse(0)=0
xxclose

zutbyte dely
return



Smith:
if da=0 then start
goto start

nypos:
xposse=mouse(1) : y=mouse(2)
express: if mouse(0)<>0 then express
xposse=int(1+xposse/8)
y=int(1+y/8)
if y>maxx then y=maxx
if xposse>39*med then xposse=40*med-1
locate y,xposse
zut chr$(159)
zutbyte y
zutbyte xposse
goto keyboard

Import:
if jam<>1 then bq$= "(Warning: Some Autocolor is ON)" else bq$=""
yesno b$,"","Import text? (Y/N)","",bq$
if ucase$(b$)="N" then keyboard
xwindow
print
skur=1
na$=sdir$(startdir$)

worked=GetFile%(na$,"File to load:",0,"",txt0$)
if not fexists(na$) then call xxclose : messwait na$+" not found" : goto keyboard

input " Left margin";lm
input " Right margin";rm
input " Normal or FastFormat (N/F)";ff$
ff$=ucase$(ff$) : if ff$="F" then kruk
filt=0
input " FILTER: Remove unwanted CHR's? (Y/N)";b$
if ucase$(b$)="Y" then filt=1
kruk:
print
print "Return=Begin. Space=Next line."
print
rem on error goto mono
open na$ for input as #3
miao: line input #3,b$ : b=len(b$) : print b$
mioe: sleep : c$=ucase$(inkey$) : if c$="" then mioe
if c$<>chr$(13) then miao
print
print "P = Make Pause!  Return = Quit!"
print
print "Press any key!"
artop: sleep : if inkey$="" then artop
call xxclose
color ,,jam
skur=0

print : zut chr$(13) : incr count&
y=csrlin

zut chr$(159) : zutbyte y : zutbyte 1
xposse=1
incr count&

if ff$="F" then Dolly
if lm<1 then Dolly
locate ,lm+1
for v=1 to lm : zut chr$(30) : incr count& : next v
goto Dolly
stereo: line input #3,b$ : b=len(b$)
Dolly:
if ff$="F" then
for groda=1 to 4 : waittof : next groda
if b$="" then print : zut chr$(13) : incr count& : goto DINO
b$=string$(lm," ")+b$
zut left$(b$,40*med-rm-1) : incr count&
if len(b$)>40*med-rm-1 and rm<1 then Zita
zut chr$(13) : incr count&
Zita: print left$(b$,40*med-rm-1)
if len(b$)>40*med-rm-1 then b$=right$(b$,len(b$)-(40*med-rm-1)) : goto Dolly
goto DINO
end if


if b$="" then bada
for t=1 to b
c$=mid$(b$,t,1)
if filt=1 then
	if instr(codes$,c$)<>0 then c$=" "
end if
print c$;
zut c$ : incr count&
if pos(0)>40*med-rm-1 then
if t=b then bada
print : if rm>0 then zut chr$(13) : incr count&
if lm<1 then DUNO
locate ,lm+1
for v=1 to lm : zut chr$(30) : incr count& : next v
end if
DUNO:
next t
bada:
print : if pos(0)<40 then zut chr$(13) : incr count&
if lm<1 then DINO
locate ,lm+1
for v=1 to lm : zut chr$(30) : incr count& : next v

DINO:
tac$=ucase$(inkey$)
if tac$="P" then zut chr$(1) : incr count&
if tac$=chr$(13) then monne
if eof(3)=0 then stereo
goto monne
mono:
if err=82 then programfel
beep : beep
if skur=1 then
call xxclose
end if
resume monne
monne:
close #3 : rem on error goto programfel
color ,,jam
goto keyboard

memkoll:
if wom$<>"" and plus$<>"" then
	call yesno(a$,"Warning, there is an unsaved","      letter in memory.","","Do you want to overwrite it?")
	if a$=="n" then return start
end if
return


ScreenDump:
yesno1 ylw$,"Really print screen?"
if ylw$=="y" then pcopy
return



makemenu:

menu reset

if med=1 then menu 1,0,1,"M" else menu 1,0,1,"Misc"
menu 1,1,1,"Back to Main Menu        [Esc]"
menu 1,2,0,""

speed$="("+ltrim$(rtrim$(str$(speed)))+")"
if speed<10 then speed$=speed$+" "
menu 1,3,1,"Playback Speed "+speed$+"   [Ctrl W]"
menu 1,4,1,"Insert Delay          [Ctrl V]"
menu 1,5,1,"Insert Same Delay      [Alt S]"
menu 1,6,1,"Import ASCII-Textfile [Ctrl P]"
menu 1,7,1,"Print Screen           [Alt P]"
menu 1,8,1,"Change Display Mode           "
menu 1,9,1,"Help                    [Help]"
menu 1,10,0,""
menu 1,11,1,"Read From Start       [Ctrl K]"
menu 1,13,0,""
menu 1,14,1,"Undo One              [Ctrl L]"
menu 1,15,1,"Undo 5                        "
menu 1,16,1,"Undo X                        "
menu 1,17,1,"Undo All                      "
menu 1,18,1,"Memorize Letter               "
menu 1,19,1,"Restore Memorized Letter      "

if med=1 then menu 2,0,1,"T" else menu 2,0,1,"Text"
menu 2,1,1,"Write Text            [Ctrl T]"
menu 2,2,0,""

if med=1 then menu 3,0,1,"C" else menu 3,0,1,"Colors"
menu 3,1,1,"Choose Foreground Color   [F1]"
menu 3,2,1,"Choose Background Color       "
menu 3,3,0,""
menu 3,4,1,"Pick Foreground Color         "
menu 3,5,1,"Pick Background Color         "
menu 3,6,0,""
menu 3,7,1,"Color Palette         [Ctrl S]"
menu 3,8,0,""
menu 3,9,1,"Reset Colors & Text   [Ctrl R]"
menu 3,10,0,""
menu 3,11,1,"Save Colorfile                "
menu 3,12,1,"Load Colorfile                "
menu 3,13,0,""
menu 3,14,1,"Change the number of colors   "

if med=1 then menu 4,0,1,"G" else menu 4,0,1,"Graphics"
menu 4,1,1,"Line                  [F4]"
menu 4,2,1,"Lines                 [F7]"
menu 4,3,1,"Draw                      "
menu 4,4,1,"Box                   [F5]"
menu 4,5,1,"Filled Box            [F6]"
menu 4,6,1,"Circle            [Ctrl Q]"
menu 4,7,1,"Fill                  [F8]"
menu 4,8,1,"Clear Screen         [Del]"

if med=1 then menu 5,0,1,"B" else menu 5,0,1,"Brush"
menu 5,1,1,"Make Copy!          [F2]"
menu 5,2,1,"Put Single Copy     [F3]"
menu 5,3,1,"Put Many Copies [Ctrl E]"
menu 5,4,1,"Draw                    "
menu 5,5,0,""
menu 5,6,1,"Load Copy          [F10]"
menu 5,7,1,"Save Temporary Copy [F9]"
menu 5,8,1,"Save Copy to Disk       "
menu 5,9,1,"Load IFF Brush as Copy  "
menu 5,10,1,"Animate Copies  [Ctrl 2]"
menu 5,11,1,"Load Animation File List"
menu 5,12,1,"Save Animation File List"
menu 5,13,0,""
menu 5,14,1,"Change Bitplanes! -1    "
menu 5,15,1,"Change Bitplanes! +1    "
menu 5,16,0,""
menu 5,19,1,"Rotate Handle    [Alt R]"

if med=1 then menu 6,0,1,"I" else menu 6,0,1,"Interactive"
menu 6,1,1,"Wait For Any Key/Mouse Click [Ctrl A]" '601
menu 6,2,1,"Wait For Key/Mouse w. Timeout        "
menu 6,3,1,"Input String                    [TAB]" '602
menu 6,4,0,""
menu 6,5,1,"Run This Letter Again        [Ctrl Y]" '603
menu 6,6,1,"Run Another Letter           [Ctrl U]" '604
menu 6,7,1,"Run 'Input' Letter           [Ctrl D]" '605 
menu 6,8,1,"On Mouse Click Run a Letter          " '609
menu 6,9,1,"On Mouse Click Open URL              " '609
menu 6,10,1,"On Mouse Click Continue Making At End"
menu 6,11,1,"On Inkey Run a Letter        [Ctrl O]" '606
menu 6,12,1,"On Inkey Return to Main Menu         " '607
menu 6,13,0,""
menu 6,14,1,"Restart First Calling Letter         " '608


if med=1 then menu 7,0,1,"E" else menu 7,0,1,"External"
menu 7,1,1,"HiP - Load And Play MOD "
menu 7,2,1,"HiP - Stop Playing      "
menu 7,3,1,"HiP - Continue Playing  "
menu 7,4,1,"HiP - Choose Song Number"
menu 7,5,0,""
menu 7,6,1,"Multiview               "
menu 7,7,1,"Say (narrator.device)   "


gosub switch


return


switch2:
	if oride<0 then
		menu 2,12,2,"  Turbo [H]"
	else
		menu 2,12,1,"  Turbo [H]"
	end if
return


switch:

if da=0 then
	if jam=4 or jam=5 then
		menu 2,3,2,"   Inverse Text       [Ctrl Z]"
	else
		menu 2,3,1,"   Inverse Text       [Ctrl Z]"
	end if

	if jam=0 or jam=4 then
		menu 2,4,2,"   Print Foreground Only      "
	else
		menu 2,4,1,"   Print Foreground Only      "
	end if
	
  	menu 2,5,ai,    "   Auto-Indent                "
	menu 2,6,cursor,"   Show Playback Cursor       "
	menu 2,7,sim,   "   Simulate Real Writing      "
	menu 2,8,0,""
	menu 2,9,1,     "Search and Replace Text       "
	
	
	if only=1 or only=2 then
		menu 5,17,2,"   Show Outline         "
	else
		menu 5,17,1,"   Show Outline         "
	end if
	
	if only=0 or only=2 then
		menu 5,18,2,"   Show Brush           "
	else
		menu 5,18,1,"   Show Brush           "
	end if
	
	if ppinsert=1 then
		menu 1,12,1,"Stop Inserting, Continue Read "
	else
		menu 1,12,0,"Stop Inserting, Continue Read "
	end if


	
end if

return

makemenu2:

menu reset

menu 1,0,1,"Misc"
if help=1 then
	menu 1,1,1,"Exit Help                [Esc]"
	menu 1,2,0,""
elseif sluta=1 then
	menu 1,1,1,"Exit Reading             [Esc]"
	menu 1,2,1,"Go to Main Menu               "

else
	menu 1,1,1,"Back to Main Menu        [Esc]"
	menu 1,2,0,""
end if
menu 1,3,1,"Take Copy                  [T]"
menu 1,4,1,"Save Copy                 [F9]"
menu 1,5,1,"Save Colors              [TAB]"           
menu 1,6,1,"Print Screen               [P]"
menu 1,7,1,"Pause                  [Space]"
menu 1,8,1,"Change Display Mode        [X]"
menu 1,9,1,"Help                    [Help]"
menu 1,10,0,""
menu 1,11,1,"Continue Making Right Here [C]"
menu 1,12,1,"Insert Right Here          [I]"

menu 1,13,1,"Continue Making At End     [A]"
menu 1,14,1,"Read From Start            [S]"


menu 2,0,1,"Speed"
menu 2,1,1,"    0   [0]"
menu 2,2,1,"    1   [1]"
menu 2,3,1,"    2   [2]"
menu 2,4,1,"    3   [3]"
menu 2,5,1,"    4   [4]"
menu 2,6,1,"    5   [5]"
menu 2,7,1,"    6   [6]"
menu 2,8,1,"    7   [7]"
menu 2,9,1,"    8   [8]"
menu 2,10,1,"    9   [9]"
menu 2,11,0,""

gosub switch2

return

sub getmenu2(a$)
shared menu0%

meny%=menu0%*100+menu(1)

if menu0%<>0 then
	select case meny%
		=101 : men%=27
		=102 : men%=255
		=103 : men%=116
		=104 : men%=137
		=105 : men%=9
		=106 : men%=112
		=108 : men%=120
		=107 : men%=32
		=109 : men%=139
		=111 : men%=99
		=112 : men%=105
		=113 : men%=65
		=114 : men%=115

		=201 : men%=48
		=202 : men%=49
		=203 : men%=50
		=204 : men%=51
		=205 : men%=52
		=206 : men%=53
		=207 : men%=54
		=208 : men%=55
		=209 : men%=56
		=210 : men%=57
		=212 : men%=104

	end select	
	a$=chr$(men%)
	menu0%=0
end if

end sub

sub getmenu(a$)
shared menu0%, lin$

if menu0%=-8 then a$="" : menu0%=0 : exit sub

meny%=menu0%*100+menu(1)

if menu0%<>0 then
	select case meny%
		=101 : a$=chr$(27)
		=103 : a$=chr$(23)
		=104 : a$=chr$(22)
		=105 : a$="ß"
		=106 : a$=chr$(16)
		=107 : a$=chr$(182)
		=108 : a$="toggle"
		=109 : a$=chr$(139)
		=111 : a$=chr$(11)
		=112 : a$="stopinsert"
		=114 : a$="Undo 1"
		=115 : a$="Undo 5"
		=116 : a$="Undo X"
		=117 : a$="Undo All"
		=118 : a$="memo"
		=119 : a$="redo"

		=201 : a$="text"
		=203 : a$=chr$(26)
		=204 : a$=chr$(24)
		=205 : a$=chr$(154)
		=206 : a$=chr$(158)
		=207 : a$=chr$(155)
		=209 : a$="search"

		=301 : a$=chr$(129)
		=302 : a$=chr$(153)
		=304 : a$="pfg"
		=305 : a$="pbg"
		=307 : a$=chr$(19)
		=309 : a$=chr$(18)
		=311 : a$="fsave"
		=312 : a$="fload"
		=314 : a$="colors"

		=401 : a$=chr$(132)
		=402 : a$=chr$(135)
		=403 : a$="drawlines"
		=404 : a$=chr$(133)
		=405 : a$=chr$(134)
		=406 : a$=chr$(17)
		=407 : a$=chr$(136)
		=408 : a$=chr$(127)

		=501 : a$=chr$(130)
		=502 : a$=chr$(131)
		=503 : a$=chr$(5)
		=504 : a$="drawcopy"
		=506 : a$=chr$(138)
		=507 : a$=chr$(137)
		=508 : a$="scopy"
		=509 : a$="blc"
		=510 : a$=chr$(0)
		=511 : a$="loadanim"
		=512 : a$="saveanim"
		=514 : a$=chr$(157)
		=515 : a$=chr$(156)
		=517 : a$="outline"
		=518 : a$="brush"
		=519 : a$="®"
		
		=601 : a$=chr$(1)
		=602 : a$=chr$(144)
		=603 : a$=chr$(9)

		=605 : a$=chr$(25)
		=606 : a$=chr$(21)
		=607 : a$=chr$(4)
		=608 : a$=chr$(145)
		=609 : a$=chr$(143)
		=610 : a$=chr$(142)

		=611 : a$=chr$(15)
		=612 : a$="menu"
		=614 : a$=chr$(146)
		
		=701 : a$="hip"
		=702 : a$="stop"
		=703 : a$="cont"
		=704 : a$="song"
		=706 : a$="view"
		=707 : a$="say"
		=708 : a$="play"

	end select	
end if

menu0%=0

end sub


sub messwait(b$)
	shared cback$

	if peekl(systab+12)=0 then print b$ : exit sub

	cback$=""
	xwindow3
	mess0 b$
	for t=1 to 40
		waittof
		waittof
		waittof
		waittof
	next t
	
	xxclose
end sub

sub mess(b$)

	xwindow2
	mess0 b$
	xxclose
end sub

	

sub mess0(b$)

if window(2)>400 then plus=176-15 else plus=0



	svart f5,-1
	vit f4,-1

if plus=0 then
	line (15,103)-(295,128),f5,bf
	line (15,103)-(295,128),f4,b
	line (16,104)-(294,127),2,b
	line (17,105)-(293,126),f4,b
	color f4,f5
	print ptab(0,118);
	m rtrim$(ltrim$(left$(b$,31)))
else
	line (15,103)-(615,128),f5,bf
	line (15,103)-(615,128),f4,b
	line (16,104)-(614,127),2,b
	line (17,105)-(613,126),f4,b
	color f4,f5
	print ptab(0,118);
	m rtrim$(ltrim$(left$(b$,73)))
end if
		
end sub


sub yesno1(a$,b$)
	yesno a$,"","",b$,""
end sub


sub yesno(a$,b$,c$,d$,e$)
	yesno0 a$,b$,c$,d$,e$,"  Yes  ","  No.  "
end sub

SUB M(a$) STATIC
print ptab(-3+(window(2)-8*len(a$))/2);a$
END SUB


sub yesno0(a$,b$,c$,d$,e$,yes$,no$)
shared iii

if window(2)>400 and iii=0 then plus=176-15 else plus=0

do : waittof : loop until mouse(0)=0
waittof
do : waittof : loop while mouse(0)<>0
waittof
do : waittof : loop until mouse(0)=0

xwindow3

	svart f5,-1
	vit f4,-1
	vit b4, f4



line (15+plus,60)-(295+plus,170),f5,bf

line (15+plus,60)-(295+plus,170),f4,b
line (16+plus,61)-(294+plus,169),2,b
line (17+plus,62)-(293+plus,168),f4,b
color f4,f5,1
locate 10,3

if iii<>0 then
	print tab(5+plus\8);left$(b$,31)
	print 
	print tab(5+plus\8);left$(c$,31)
	print
	print tab(5+plus\8);left$(d$,31)
	print
	print tab(5+plus\8);left$(e$,31)
else
	m ltrim$(rtrim$(left$(b$,31)))
	print
	m ltrim$(rtrim$(left$(c$,31)))
	print
	m ltrim$(rtrim$(left$(d$,31)))
	print
	m ltrim$(rtrim$(left$(e$,31)))
end if


tbaka:
a$=""

do while a$=""
	do
		k=mouse(0)
		x=mouse(1)
		y=mouse(2)
		a$=""
		in$=inkey$

		waittof
		waittof
		waittof
		waittof
		
		if x>15+plus and x<140+plus and y>60 and y<170 then
			color f5,b4
			a$="y"
		else
			color f4,f5
		end if

		print ptab(50+plus,158);"       "
		print ptab(50+plus,150);yes$
		print ptab(50+plus,142);"       "

		if x>140+plus and x<295+plus and y>60 and y<170 then
			color f5,b4
			a$="n"
		else
			color f4,f5
		end if

		print ptab(200+plus,158);"       "
		print ptab(200+plus,150);no$
		print ptab(200+plus,142);"       "

	loop while k=0 and in$=""
	if in$<>"" then a$=in$

	do : waittof : loop while mouse(0)<>0
	
loop
	
color f5,b4

if a$=="y" then
	print ptab(50+plus,158);"       "
	print ptab(50+plus,150);yes$
	print ptab(50+plus,142);"       "
elseif a$=="n" then
	print ptab(200+plus,158);"       "
	print ptab(200+plus,150);no$
	print ptab(200+plus,142);"       "
else
	goto tbaka
end if

waittof
waittof
waittof
waittof
waittof

xxclose

end sub

sub firstcoord(byval jamme, byval farg, byval f2)
	shared xxx,yyy,bw%(),x3,y3, menu0%, med, maxx, bb&(), igge$, drav
	do : waittof : loop while mouse(0)<>0
	
	xxx= mouse(1) : yyy=mouse(2)
		if xxx>320*med-9 then xxx=320*med-9
		if yyy>8*maxx-1 then yyy=8*maxx-1

	waitblit
	get(0,yyy)-(320*med,yyy+1),bb&
	waitblit
	get(xxx,0)-(xxx+1,8*maxx+4),bw%

	color ,,jamme
	line(0,yyy)-(320*med,yyy),farg
	line(xxx,0)-(xxx,8*maxx+4),f2
	color ,,1
	x2=xxx : y2=yyy

	do
		xxx= mouse(1) : yyy=mouse(2)
		if xxx>320*med-9 then xxx=320*med-9
		if yyy>8*maxx-1 then yyy=8*maxx-1

		if xxx<>x2 or yyy <> y2 then
			waitblit
			put(0,y2),bb&,pset
			waitblit
			put(x2,0),bw%,pset
			
			waitblit
			get(0,yyy)-(320*med,yyy+1),bb&
			waitblit
			get(xxx,0)-(xxx+1,8*maxx+4),bw%

			eva=point(xxx,yyy)+1
			color ,,jamme
			line(0,yyy)-(320*med,yyy),farg
			line(xxx,0)-(xxx,8*maxx+4),f2
			color ,,1
			x2=xxx : y2=yyy
		end if
		waittof : waittof : waittof : menu0%=menu(0) : igge$=inkey$
		if igge$<>"" then menu0%=-8
	loop until menu0%<>0 or mouse(0)<>0


	waitblit
	put(0,y2),bb&,pset
	waitblit
	put(x2,0),bw%,pset
	waitblit
	get (xxx,yyy)-(xxx,yyy),bw%
	x3=xxx : y3=yyy
	if drav=0 then
		do : waittof : loop while mouse(0)<>0
	end if
end sub

sub setcoord(x,y)
	shared xxx,yyy,bw%(),x3,y3

	xxx=x : yyy=y
	waitblit
	get (xxx,yyy)-(xxx,yyy),bw%
	x3=xxx : y3=yyy
end sub


sub coord(a,m,x,y,x2,y2)
	static xx,yy
	shared bw%(),xxx,yyy,sy,sx,x3,y3,med,maxx
	
	sx=mouse(1)
	sy=mouse(2)
	if sx>320*med-9 then sx=320*med-9
	if sy>8*maxx-1 then sy=8*maxx-1

	if sx=xx and sy=yy then
		a=0
		waittof
		waittof
		waittof
	else
		a=1
		yy=sy
		xx=sx
		waittof
		waittof
		waittof
		waitblit
		put (x3,y3),bw%,pset
		x=min(xxx,sx) : x2=max(xxx,sx)
		y=min(yyy,sy) : y2=max(yyy,sy)
		waitblit			
		get (x,y)-(x2,y2),bw%
		x3=x : y3=y
		if m=0 then
			x=xxx : y=yyy
			x2=sx : y2=sy
		end if
	end if

end sub

sub undocoord
	shared bw%(),xxx,yyy,sy,sx,x3,y3
	waitblit
	put (x3,y3),bw%,pset
end sub


sub xwindow
	shared bw%(), maxx, xcsrlin, xpos
	if window(2)>400 then med=2 else med=1
	waitblit
	get (0,0)-(320*med,8*maxx+4),bw%
	xcsrlin=csrlin
	xpos=pos(0)

	palette 0,.2,.4,.7
	palette 1,.9,1,1

	color 1,0,1
	cls
end sub

sub xwindow2
	shared bw%(), maxx, xcsrlin, xpos
	if window(2)>400 then med=2 else med=1
	waitblit
	get (0,0)-(320*med,8*maxx+4),bw%
	xcsrlin=csrlin
	xpos=pos(0)

	palette 2,1,0.3,0.4
	palette 4,1,1,1
	palette 5,0,0,0
	palette 7,1,1,0
	color ,,1

end sub

sub xwindow3
	shared bw%(), maxx, xcsrlin, xpos
	shared irg!(),g!(),b!(),djup

	if window(2)>400 then med=2 else med=1
	waitblit
	get (0,0)-(320*med,8*maxx+4),bw%
	xcsrlin=csrlin
	xpos=pos(0)
	color ,,1

	for t=0 to window(6)
		palette t,irg!(t),g!(t),b!(t)
	next t
	
end sub


sub xxclose
	shared bw%(), irg!(), g!(), b!(), mio, nio, jam, xcsrlin, xpos, djup

q=int(2^djup)-1
for t=0 to q
	palette t,irg!(t),g!(t),b!(t)
next t

	waitblit
	put (0,0),bw%,pset
	color mio,nio,1
	locate xcsrlin,xpos

	
end sub


sub vit(a,c)
shared irg!(),g!(),b!(),djup

a=-1 : b=-10

q=window(6)
for t=0 to q
	x=irg!(t)+g!(t)+b!(t)
	if x>b and c<>t then b=x : a=t
next t
end sub

sub svart(a,c)
shared irg!(),g!(),b!(),djup

a=-1 : b=10

q=window(6)
for t=0 to q
	x=irg!(t)+g!(t)+b!(t)
	if x < b and c<>t then b=x : a=t
next t
end sub

sub ozin(a$)
	shared rom$, romp&, roml&
	static y&
	
	y&=instr(romp&,rom$,chr$(10))
	if y&=0 then a$="" : romp&=roml&+1 : exit sub
	a$=mid$(rom$,romp&,y&-romp&)
	romp&=y&+1
end sub

sub ozinint(a%)
	shared rom$, romp&, roml&
	static y&, a$
	
	y&=instr(romp&,rom$,chr$(10))
	yy&=instr(romp&,rom$,"     ")
	if yy&>0 then y&=min(y&,yy&)

	if y&=0 then a%=0 : romp&=roml&+1 : exit sub
	a$=mid$(rom$,romp&,y&-romp&)
	if y&=yy& then
		romp&=y&+1
		do until mid$(rom$,romp&,1)<>" "
			incr romp&
			if romp&=roml& then exit do
		loop
	else
		romp&=y&+1
	end if

	a%=val(a$)
end sub

sub ozindec(a!)
	shared rom$, romp&, roml&
	static y&, a$
	
	y&=instr(romp&,rom$,chr$(10))
	yy&=instr(romp&,rom$,"     ")
	if yy&>0 then y&=min(y&,yy&)

	if y&=0 then a!=0 : romp&=roml&+1 : exit sub
	a$=mid$(rom$,romp&,y&-romp&)
	if y&=yy& then
		romp&=y&+1
		do until mid$(rom$,romp&,1)<>" "
			incr romp&
			if romp&=roml& then exit do
		loop
	else
		romp&=y&+1
	end if


	a!=val(a$)
end sub

sub zin(a$)
	shared rom$, romp&
	static y&
	
	a$=mid$(rom$,romp&,1) : incr romp&
	if a$=chr$(10) then
		y&=instr(romp&,rom$,chr$(10))
		if y&=0 then a$="" : exit sub
		a$=mid$(rom$,romp&,y&-romp&)
		romp&=y&+1
	end if
end sub

sub zinone(a$)
	shared rom$, romp&
	a$=mid$(rom$,romp&,1) : incr romp&
end sub

sub zinint(x%)
	shared rom$, romp&
	static aa&, pp&
	
	aa&=sadd(rom$)+romp&-1
	pp&=varptr(x%)
	pokeb pp&,peekb(aa&)
	pokeb pp&+1,peekb(aa&+1)

	romp&=romp&+2
end sub

sub zinbyte(a%)
	shared rom$, romp&
	a%=peekb(sadd(rom$)+romp&-1)
	incr romp&
end sub


sub zindec(a!)
	shared rom$, romp&
	static p&,a&

	a&=sadd(rom$)+romp&-1
	p&=varptr(a!)
	pokeb p&,peekb(a&)
	pokeb p&+1,peekb(a&+1)
	pokeb p&+2,peekb(a&+2)
	pokeb p&+3,peekb(a&+3)
	romp&=romp&+4
end sub

sub zut(byval a$)
	shared wom$, ylleman&, count&
	
	if ylleman&=len(wom$) then incr count&
	
	if len(a$)<>1 then
		wom$=wom$+chr$(10)+a$+chr$(10)
	else
		wom$=wom$+a$
	end if
end sub

sub zutint(byval a%)
	shared wom$
	static a$
	
	a$="  "
	xpokew sadd(a$),a%
	wom$=wom$+a$
end sub

sub zutbyte(byval a%)
	shared wom$
	static a$
	
	a$=" "
	pokeb sadd(a$),a%
	wom$=wom$+a$
end sub


sub zutdec(a!)
	shared wom$
	static a$
	
	a$="    "
	xpokel sadd(a$),xpeekl&(varptr(a!))
	wom$=wom$+a$
end sub

sub fullname(d$)
	shared katalog$
	if instr(d$,":")=0 and instr(d$,"/")=0 then
		if katalog$="" then
		elseif right$(katalog$,1)=":" or right$(katalog$,1)="/" then
			d$=katalog$+d$
		else
			d$=katalog$+"/"+d$
		end if
	end if
end sub

sub file(a$)
	s=rinstr(a$,"/")
	k=rinstr(a$,":")
	a=max(s,k)
	if a<>0 and aroml& then ozin a$ else a$=""
else
	djup=3
end if

if left$(a$,3)=="BIG" then
	incr nyg
	chop a$,b$
	chop a$,b$
	if b$="" then maxx=31 else maxx=val(b$)
else
	maxx=25
end if


romp&=1
for ylle=1 to nyg : ozin a$ : next ylle

zut "BLETTER "+ver$
zut "MODE"+str$(med)
zut "DJUP"+str$(djup)
if maxx>25 then zut "BIG"+str$(maxx)

zut chr$(154) 'stäng av auto-indent

mio=1 : nio=3

king:
do until romp&>roml&
ozin a$
'write a$, romp&, roml&

select case a$

=chr$(129)
	ozinint x : ozinint y
	if x<>mio then zut chr$(129) : zutbyte x : mio=x
	if y<>nio then zut chr$(153) : zutbyte y : nio=y	
	goto king

=chr$(131), chr$(136)
	ozinint x : ozinint y
	zut a$ : zutint x : zutbyte y
	goto king

=chr$(132), chr$(133), chr$(134), chr$(130)
	ozinint x : ozinint y :ozinint n :ozinint m
	zut a$ : zutint x : zutbyte y : zutint n : zutbyte m
	goto king

=chr$(17)
	ozinint x :ozinint y :ozindec r! :ozindec h!
	rq=r!
	zut a$ : zutint x : zutbyte y : zutint rq : zutdec h!
	goto king

=chr$(137), chr$(138), chr$(9)
	ozin cn$
	zut a$ : zut cn$
	goto king

=chr$(135), chr$(5)
	zut a$
	hylla:
		ozinint x
		zutint x
		if x=-1 then king
		if x=-2 then hylla
		ozinint y
		zutbyte y
	goto hylla
	
=chr$(23)
	zut a$
	ozinint speed
	zutbyte speed/250
	goto king
	
="@"
	ozinint y : ozinint x
	zut chr$(159) : zutbyte y : zutbyte x
	goto king
	
=chr$(19)
	zut a$
	ozinint y
	zutbyte y
	ozindec rr!
	zutbyte rr!*255
	ozindec rr!
	zutbyte rr!*255
	ozindec rr!
	zutbyte rr!*255
	if Ny=0 then ozin c$
	goto king

=chr$(0)
	zut a$
	do
		ozin b$
		zut b$
	loop until b$=""
	goto king

=chr$(15)
	zut a$
	zutbyte 0
	ozin b$ : ozin c$
	zut b$ : zut c$
	goto king

=chr$(25), chr$(4)
	zut a$
	zutbyte 0
	goto king

=chr$(21)
	zut a$
	zutbyte 0
	ozin b$
	zut b$

=chr$(22)
	ozinint dely
	zut a$
	zutbyte dely
	goto king
	
=chr$(27)
	goto king

=chr$(18)
	mio=1 : nio=3

="¡" : a$ = " "
="µ" : a$=":"
="¬" : a$=","
="¥" : a$=chr$(34)
="¶" : a$ = chr$(13)
="" : a$ = chr$(13)
="`" : a$=chr$(157)
="~" : a$=chr$(156)

end select

zut a$

loop

rom$=wom$
if lika=0 then wom$=back$

romp&=1
roml&=len(rom$)

back$=""
if xpeekl&(systab+12)<>0 then
	xxclose
end if

return


stopinsert:
	if ppinsert=1 then
		romp&=len(wom$)
		wom$=wom$+rest$ : rest$=""
		rom$=wom$ : roml&=len(rom$)
		ppinsert=0
	end if
return


getkod:
	kod=0
	yesno0 t$,"","New or runtime merge???","","","  New  "," Merge "
	if t$=="n" then
		incr kod
		yesno1 t$,"Reset colors & text?"
		if t$=="y" then kod=kod+2
		yesno1 t$,"Reset speed?"
		if t$=="y" then kod=kod+4
		yesno1 t$,"Clear screen?"
		if t$=="y" then kod=kod+8
	end if
return

exkod:
	if kod=0 then
'		opri=0
		jepp=1 : pl=0 : goto start
	end if
	
	if (kod and 2) = 2 then gosub 13
	if (kod and 4) = 4 then
		speed=3
		if oride>-1 then oride=speed
	end if
	if (kod and 8) = 8 then cls
	
	yllo=0
	romp&=1
	pl=0
	jam=1
	
Ypper2: zin a$
	if left$(a$,3)=="BIG" or left$(a$,4)=="DJUP" or left$(a$,4)=="MODE" or left$(a$,7)=="BLETTER" then incr yllo : goto Ypper2
	romp&=1
	for s=1 to yllo : zin a$ : next
goto nylas		
	

Slutet:

'if spelar=1 then
'	spelar=0
'	hip "quit"
'end if

chdir startdir$
delay 20

if fexists(tempdir$) then
	shell "delete >Nil: "+tempdir$+"/#?"
	shell "delete >nil: "+tempdir$
end if

if fexists(tempdir2$) then
	shell "delete >Nil: "+tempdir2$+"/#?"
	shell "delete >nil: "+tempdir2$
end if

if fexists(tempdir3$) then
	shell "delete >Nil: "+tempdir3$+"/#?"
	shell "delete >nil: "+tempdir3$
end if


if fexists(tmf$) then kill tmf$


system

sub setext(a$,e$)
	a=rinstr(a$,".")
	if a>(len(a$)-6) and a>0 then
		a$=left$(a$,a-1)
	end if
	a$=a$+e$
end sub

envdef:
	if not fexists("env:blhip") then
		ei=freefile
		open "env:blhip" for output as ei
		print #ei,"HiP"
		close ei
	end if
	if not fexists("env:blview") then
		ei=freefile
		open "env:blview" for output as ei
		print #ei,"SYS:utilities/multiview SCREEN"
		close ei
	end if

return

sag:

	if snappe=0 then
		if fexists("devs:narrator.device") and fexists("libs:translator.library") then snappe=1 else snappe=2
	end if

	if snappe=1 then
		rem on error goto iskmond
		say translate$(aa$)
	else
		messwait aa$
	end if
	
iskmond2:
	rem on error goto programfel	
	return

iskmond:
	messwait aa$
	resume iskmond2



sub yam(a$)
	shell "SYS:rexxc/rx >NIL: ""address YAM "+a$+""""
end sub

'rx "address YAM writeattach 'dh2:frog3.bl' 'BorayLetter' b64 'application/x-bl'"


sub hip(a$)
	shell "SYS:rexxc/rx >NIL: ""address HIPPOPLAYER "+a$+""""
end sub

exptxt:
	rom$=wom$
	romp&=1
	roml&=len(rom$)
	nyg=0
	zin a$

	if left$(a$,7)=="BLETTER" then
		zin a$
		incr nyg
	else
		messwait "No BL 5+ file in memory!"
		return start
	end if

	if left$(a$,4)=="MODE" then
		med=val(right$(a$,1))
		zin a$
		incr nyg
	else
		med=1
	end if

	if left$(a$,4)=="DJUP" then
		djup=val(right$(a$,1))
		ny=1
		incr nyg
		if not romp&>roml& then zin a$ else a$=""
	else
		djup=3
	end if
	
	if left$(a$,3)=="BIG" then
		incr nyg
		chop a$,b$
		chop a$,b$
		if b$="" then maxx=31 else maxx=val(b$)
	else
		maxx=25
	end if


	romp&=1
	for ylle=1 to nyg : zin a$ : next ylle

	zz$=""

	color 1,3
	cls

	if yam=0 then open txt$ for output as #8

	do
		zin a$

		select case a$

		=chr$(131), chr$(136) : romp&=romp&+3
		=chr$(159) : romp&=romp&+2 : oo=1
		=chr$(19) : romp&=romp&+4
		=chr$(132),chr$(133),chr$(134),chr$(130) : romp&=romp&+6
		=chr$(17)  : romp&=romp&+9
		=chr$(144),chr$(129),chr$(4),chr$(146),chr$(22),chr$(25),chr$(23),chr$(153),chr$(149) : incr romp&
		=chr$(137)
			zin cn$
		=chr$(135) : gosub ruta
		=chr$(5) : gosub ruta5
		=chr$(0)
			do
				zin cn$
			loop until cn$=""
		=chr$(138), chr$(152), chr$(148)
			zin cn$
		=chr$(21), chr$(15), chr$(145)
			incr romp&
			if a$=chr$(145) then romp&=romp&+6
			if a$=chr$(15) then zin b$
			zin cn$
		=chr$(147)
			zin aa$
		=chr$(143)
			zin aa$
			romp&=romp&+6
		=chr$(142)
			romp&=romp&+6

		=chr$(29) : oo=1
		=chr$(31) : oo=1
		=chr$(30) : oo=1
		=chr$(28) : oo=1
		=chr$(2), chr$(1), chr$(9), chr$(158),chr$(155),chr$(154), chr$(27)
		=chr$(24), chr$(26), chr$(18), chr$(157), chr$(156), chr$(127)
		=chr$(13)
			print #8, zz$
			if yam=0 then print zz$
			zz$=""
		=chr$(8) : if len(zz$)>0 then zz$=left$(zz$,len(zz$)-1)

		=remainder
			if oo=1 then
				print #8,zz$
				if yam=0 then print zz$
				oo=0 : zz$=""
			end if
			zz$=zz$+a$
		end select

	loop until romp&>roml&

	print #8,zz$
	if yam=0 then print zz$

	close 8

return

mime:
	nr=val(mid$(b$,3,2))
	do
		if instr(b$,"application/x-bl")<>0 then
			nr=val(mid$(b$,3,2))
			nr$=right$("00"+ltrim$(rtrim$(str$(nr))),2)
			print #8,"MV"+nr$+".ContentType = application/x-bl"
			print #8,"MV"+nr$+".Extension   = bl"
			print #8,"MV"+nr$+".Command     = bl ""%s"""
			line input #9,b$
			line input #9,b$
			line input #9,b$
			return
		elseif left$(b$,2)<>"MV" then
			incr nr
			nr$=right$("00"+ltrim$(rtrim$(str$(nr))),2)
			print #8,"MV"+nr$+".ContentType = application/x-bl"
			print #8,"MV"+nr$+".Extension   = bl"
			print #8,"MV"+nr$+".Command     = bl ""%s"""
			return
		end if
		nr=val(mid$(b$,3,2))
		print #8,b$
		line input #9,b$
	loop			
return

sub mp(byval a$)
	y=csrlin
	for t=80 to 40 step -10
		locate y,t
		waitTof
		print a$+"                    ";
	next t
	print
	print
end sub

sub mp2(byval a$)
	y=csrlin
	for t=79 to 39 step -20
		locate y,t
		waitTof
		print a$+"                    ";
	next t
	print
end sub


getxy:

x=mouse(1)
y=mouse(2)
if x>320*med then x=320*med
if y>8*maxx+4 then y=8*maxx+4
if x<0 then x=0
if y<0 then y=0

if handle=0 then
	x=x-w%(0)/2
	y=y-w%(1)/2
elseif handle=1 then
	x=x
	y=y
elseif handle=2 then
	x=x-w%(0)
	y=y
elseif handle=3 then
	x=x-w%(0)
	y=y-w%(1)
else
	x=x
	y=y-w%(1)
end if

if x=-1 then x=0
if y<-255 then y=-255
if y>255 then y=255



return

loadcolors:
		bdir2$=katalog$
		gosub loadrom
		decr count&
		do until romp&>=roml&
			zin b$
			if b$=chr$(19) then
				zut b$ : incr count&
				zinbyte y% : zutbyte y%
				zinbyte x% : zutbyte x% : irg!(y%)=x%/255
				zinbyte x% : zutbyte x% : g!(y%)=x%/255
				zinbyte x% : zutbyte x% : b!(y%)=x%/255
				palette y%,irg!(y%),g!(y%),b!(y%)
			end if
		loop
		katalog$=bdir2$ : chdir katalog$
return

toggle:
	xwindow3
	
	
	py=csrlin
	px=pos(0)
	
	gosub getmode
	
'	window close 1
'	screen close 1
	
	gosub os

	xxclose
	
	locate py,px
	
return




os:
	gosub getsmpos
	if sm&(smpos)=0 then
		if maxx>29 then
			if med=2 then sm&(smpos)=167936 else sm&(smpos)=135168
		else
			if med=2 then sm&(smpos)=102400 else sm&(smpos)=69632
		end if

		gosub getmode
	end if
	djupback=0
	
grest2:
	rem on error goto programfel
	grest=2
	if kickver>37 then
		screen 1,320*med-8,8*maxx,djup,5,sm&(smpos)
	else
		screen 1,320*med-8,8*maxx,djup,med
	end if
	grest=0
	djupback=0
	gosub screencenter
	window 1,"",(0,0)-(320*med-8,8*maxx),16+256+128,1
	gosub font
	
return

getmode:
	gosub getsmpos
	med$=rtrim$(ltrim$(str$(med*320-8)))
	maxx$=rtrim$(ltrim$(str$(maxx*8)))

	if kickver<38 then return
	screenmode sm&(smpos), "Choose "+med$+"x"+maxx$+" display", 50,50
	open "S:BLscreenmodes.config" for output as #8
	for t=0 to 8
		print #8, sm&(t)
	next
	close 8

return

getsmpos:

if maxx=25 then
	smpos=1
elseif maxx=31 then
	smpos=2
elseif maxx=29 then
	smpos=3
else
	smpos=4
end if

if med=1 then smpos=smpos+4

return

screencenter:

MoveScreen peekl(systab+12), 31000, 0
MoveScreen peekl(systab+12), -peekw(peekl(systab+12)+ScreenLeftEdge%)/2, 0
return
Back to Boray's Amiga page