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? :-)
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 https://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,"https://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