NNNNNNNp NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNONNNNNNNNNNNNNNNNNNNNNNF`  @! #@%')-/3@5`79=?A C@EGIKMQ S@UWY[]_a ce`gikmq Ou`wy{}/@` @ ` @ @ ` @ ` ǀ / @ ` ׀ /@` @`/o  !Ao!!#A%a'+-/1!3A5a79;=?A!CAEaGIKMOQ!SAUaWY[]_a!cAeagikmoq!sAuawy{}!Aa!Aa!Aa!Aa!Aaǁɡ!Aaׁ١!Aa!Aa " B b `  @! #@%')-/3@5`79=?A C@EGIKMQ S@UWY[]_a ce`gikmq Ou`wy{}/@` @ ` @ @ ` @ ` ǀ / @ ` ׀ /@` @`/o  !Ao!!#A%a'+-/1!3A5a79;=?A!CAEaGIKMOQ!SAUaWY[]_a!cAeagikmoq!sAuawy{}!Aa!Aa!Aa!Aa!Aaǁɡ!Aaׁ١!Aa!Aa " B b GFAXPERTLIB*S INLINE ǼS START S GFAXPERTDOCS )vREAD ME S . * S.. * SAAAPROG GFA,S AABLOCK1LST.S AABLOCK2LST/S AABLOCK3LST1S ARRAYSTRLST 2S .ARRAYWRDLST 6S CHOICE LST :S >COLOR LST @S &zDEBUG LSTDS +DEFFN LSTGS /DISK LST JS 1'FILE LSTNS ;(FUNCTIONLSTRS FGRAPH1 LST US HGRAPH2 LSTYS OINITIO LST]S V6INPUT LSTdS d KEY LST gS hLLIST LST kS nMATH LST nS oMESSAGE LST qS sMIDI LST uS xMODEM LST xS MUSIC LST {S c&PRINTER LSTS 1SCREEN LSTS SCROLL LSTS &SORTINT LSTS > SORTSTR LSTS SOUND LSTS ,GFA-BASIC3' ******************** ' *** ARRAYSTR.LST *** ' ******************** ' *** important : element with index 0 is ignored !! ' DEFWRD "a-z" ' > PROCEDURE freq.string.array(elem$,VAR proc$(),freq) ' *** returns frequency of elem$ in string array LOCAL last,n last=DIM?(proc$())-1 freq=0 FOR n=1 TO last IF proc$(n)=elem$ INC freq ENDIF NEXT n RETURN ' ********** ' > PROCEDURE trim.string.array(VAR proc$()) ' *** remove spaces from beginning and end of all strings LOCAL n FOR n=1 TO DIM?(proc$())-1 proc$(n)=TRIM$(proc$(n)) NEXT n RETURN ' ********** ' > PROCEDURE show.text(title$,VAR proc$()) ' *** show text in array proc$() on screen (20 lines/screen) ' *** ETX (CHR$(3) may be used in array as marker for end of text ' *** empty lines at end of text are ignored, unless ETX follows ' *** use in High or Medium resolution ' ' *** uses Procedures Message.on, Message.off, Scroll.text.up,Scroll.text.down ' *** uses Standard-Globals & Standard-Functions ! ' LOCAL line.up$,line.dwn$,page.up$,page.dwn$,first.page$,last.page$ LOCAL last,command$,n,empty,etx!,total$,in$ LOCAL screen$,first.line,show!,regel last=DIM?(proc$())-1 line.up$=CHR$(0)+CHR$(72) ! down arrow line.dwn$=CHR$(0)+CHR$(80) ! up arrow page.up$=CHR$(56) ! up arrow page.dwn$=CHR$(50) ! down arrow first.page$=CHR$(0)+CHR$(59) ! last.page$=CHR$(0)+CHR$(68) ! command$=esc$+line.up$+line.dwn$+page.up$+page.dwn$+first.page$+last.page$ FOR n=1 TO last IF proc$(n)<>"" empty=n ! possibly blank lines from empty+1 ENDIF etx!=TRUE EXIT IF proc$(n)=CHR$(3) ! ETX (End Of Text) found in array etx!=FALSE NEXT n IF etx! last=n-1 ELSE IF empty "; OUT 5,1 PRINT " = page up"; PRINT AT(20,25);" "; OUT 5,2 PRINT " = page down"; PRINT AT(45,24);" = first page"; PRINT AT(45,25);" = exit"; ' SGET screen$ first.line=1 show!=TRUE DO IF show! regel=1 n=first.line WHILE regel<=20 AND n<=last IF LEN(proc$(n))>80 PRINT AT(1,2+regel);LEFT$(proc$(n),79); OUT 5,3 ELSE PRINT AT(1,2+regel);proc$(n) ENDIF INC regel INC n WEND DEC n PRINT AT(7,1);first.line;" - ";n ENDIF ' REPEAT in$=INKEY$ UNTIL INSTR(command$,in$) EXIT IF in$=esc$ ' IF in$=line.up$ IF first.line=1 PRINT bel$; @message.on("first line !") PAUSE 50 @message.off show!=FALSE ELSE DEC first.line show!=FALSE @scroll.text.down(3,21) PRINT AT(1,3);STRING$(80," "); IF LEN(proc$(first.line))>80 PRINT AT(1,3);LEFT$(proc$(first.line),79); OUT 5,3 ELSE PRINT AT(1,3);proc$(first.line) ENDIF n=first.line+19 PRINT AT(7,1);first.line;" - ";n;" " ENDIF ENDIF ' IF in$=line.dwn$ IF n=last OR first.line+20>last PRINT bel$; @message.on("last line !") PAUSE 50 @message.off show!=FALSE ELSE INC first.line show!=FALSE @scroll.text.up(4,22) n=first.line+19 PRINT AT(1,22);STRING$(80," "); IF LEN(proc$(n))>80 PRINT AT(1,22);LEFT$(proc$(n),79); OUT 5,3 ELSE PRINT AT(1,22);proc$(n) ENDIF PRINT AT(7,1);first.line;" - ";n;" " ENDIF ENDIF ' IF in$=page.up$ IF first.line=1 PRINT bel$; @message.on("first line !") PAUSE 50 @message.off show!=FALSE ELSE IF first.line>20 SUB first.line,20 ELSE first.line=1 ENDIF SPUT screen$ show!=TRUE ENDIF ENDIF ' IF in$=page.dwn$ IF n>=last PRINT bel$; @message.on("last line !") PAUSE 50 @message.off show!=FALSE ELSE IF first.line+20 PROCEDURE show.text.page(VAR proc$()) ' *** show text in array proc$() on screen (20 lines/screen) ' *** ETX (CHR$(3) may be used in array as marker for end of text ' *** empty lines at end of text are ignored, unless ETX follows ' *** use in High or Medium resolution ' ' *** uses Standard-Globals ' LOCAL last,n,empty,etx!,total$,in$,block,gap,y1,y2,x1,x2,x3 LOCAL t1$,t2$,t3$,screen$,first.line,show!,regel,x,y,k,key$ last=DIM?(proc$())-1 FOR n=1 TO last IF proc$(n)<>"" empty=n ! possibly blank lines from empty+1 ENDIF etx!=TRUE EXIT IF proc$(n)=CHR$(3) ! ETX (End Of Text) found in array etx!=FALSE NEXT n IF etx! last=n-1 ELSE IF empty80 PRINT AT(1,1+regel);LEFT$(proc$(n),79); OUT 5,3 ELSE PRINT AT(1,1+regel);proc$(n) ENDIF INC regel INC n WEND DEC n ENDIF ' CLR page.dwn!,page.up!,exit! REPEAT MOUSE x,y,k key$=INKEY$ IF y>23*char.height AND k=1 IF x>=x1 AND x<=x1+block page.dwn!=TRUE PUT x1,y1,t1$,10 ENDIF IF x>=x2 AND x<=x2+block page.up!=TRUE PUT x2,y1,t2$,10 ENDIF IF x>=x3 AND x<=x3+block exit!=TRUE PUT x3,y1,t3$,10 ENDIF ENDIF SELECT ASC(RIGHT$(key$)) CASE 80 page.dwn!=TRUE PUT x1,y1,t1$,10 CASE 72 page.up!=TRUE PUT x2,y1,t2$,10 CASE 27 exit!=TRUE PUT x3,y1,t3$,10 ENDSELECT UNTIL page.dwn! OR page.up! OR exit! PAUSE 10 ' EXIT IF exit! ' IF page.up! IF first.line=1 PRINT bel$; PUT x2,y1,t2$,10 show!=FALSE ELSE IF first.line>20 SUB first.line,20 ELSE first.line=1 ENDIF SPUT screen$ show!=TRUE ENDIF ENDIF ' IF page.dwn! IF n>=last PRINT bel$; PUT x1,y1,t1$,10 show!=FALSE ELSE IF first.line+20 PROCEDURE initio.text.array ' *** fill text-array with DATA-lines ' *** end of text indicated with *** ' *** use in High or Medium resolution ' *** global : TEXT$() LOCAL lines,line$,n lines=0 RESTORE txt.data READ line$ REPEAT INC lines READ line$ UNTIL line$="***" ERASE text$() DIM text$(lines) RESTORE txt.data FOR n=1 TO lines READ text$ text$(n)=SPACE$(5)+text$ ! left margin of 5 spaces !! NEXT n ' ' *** switch editor to Overwrite-mode before entering text ' *** 70 characters/line txt.data: DATA "1234567890123456789012345678901234567890123456789012345678901234567890" DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA "1234567890123456789012345678901234567890123456789012345678901234567890" DATA *** RETURN ' ********** ' > PROCEDURE initio.text.array.low ' *** fill text-array with DATA-lines ' *** end of text indicated with *** ' *** use in Low resolution ' *** global : TEXT$() LOCAL lines,line$,n lines=0 RESTORE txt.low.data READ line$ REPEAT INC lines READ line$ UNTIL line$="***" ERASE text$() DIM text$(lines) RESTORE txt.data FOR n=1 TO lines READ text$ text$(n)=text$ NEXT n ' ' *** switch editor to Overwrite-mode before entering text ' *** 40 characters/line txt.low.data: DATA "1234567890123456789012345678901234567890" DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA " " DATA "1234567890123456789012345678901234567890" DATA *** RETURN ' ********** ' ' ******************** ' *** ARRAYWRD.LST *** ' ******************** ' *** important : element with index 0 is ignored !! ' DEFWRD "a-z" ' > PROCEDURE max.array(VAR proc(),high) ' *** return highest value of array proc() LOCAL last,n last=DIM?(proc())-1 high=proc(1) FOR n=2 TO last high=MAX(high,proc(n)) NEXT n RETURN ' ********** ' > PROCEDURE min.array(VAR proc(),low) ' *** return lowest value of array proc() LOCAL last,n last=DIM?(proc())-1 low=proc(1) FOR n=2 TO last low=MIN(low,proc(n)) NEXT n RETURN ' ********** ' > PROCEDURE max.elem.array(VAR proc(),index,high) ' *** return index and value of highest element of array proc() LOCAL last,n last=DIM?(proc())-1 high=proc(1) FOR n=2 TO last high=MAX(high,proc(n)) NEXT n index=1 WHILE proc(index) PROCEDURE min.elem.array(VAR proc(),index,low) ' *** return index and value of lowest element of array proc() LOCAL last,n last=DIM?(proc())-1 low=proc(1) FOR n=2 TO last low=MIN(low,proc(n)) NEXT n index=1 WHILE proc(index)>low INC index WEND RETURN ' ********** ' > PROCEDURE max.min.array(VAR proc(),high,low) ' *** return highest and lowest value of array proc() LOCAL last,n last=DIM?(proc())-1 high=proc(1) low=proc(1) FOR n=2 TO last high=MAX(high,proc(n)) low=MIN(low,proc(n)) NEXT n RETURN ' ********** ' > PROCEDURE som.array(VAR proc(),som%) ' *** return sum of numbers in array proc() LOCAL last,n last=DIM?(proc())-1 som%=0 FOR n=1 TO last ADD som%,proc(n) NEXT n RETURN ' ********** ' > PROCEDURE middle.array(VAR proc(),middle) ' *** return middle value of array proc() LOCAL last,med,l,u,i,j,x last=DIM?(proc())-1 DIM hulp.proc(last) FOR i=1 TO last hulp.proc(i)=proc(i) NEXT i med=(last+1)/2 l=1 u=last WHILE l=med WHILE hulp.proc(i)x DEC j WEND SWAP hulp.proc(i),hulp.proc(j) INC i DEC j WEND IF jmed u=j ENDIF WEND mediaan=hulp.proc(med) ERASE hulp.proc() RETURN ' ********** ' > PROCEDURE average.array(zero!,VAR proc(),average#,deviation#) ' *** return average and standard deviation of array proc() ' *** zero!=TRUE : use value 0 ; zero!=FALSE : ignore value 0 LOCAL n,sum%,sum2%,i CLR sum%,sum2%,i IF zero! GOSUB zero.average ELSE GOSUB no.zero.average ENDIF RETURN ' *** > PROCEDURE no.zero.average ' *** ignore 0 in computation FOR n=1 TO DIM?(proc())-1 IF proc(n)<>0 ADD sum%,proc(n) ADD sum2%,proc(n)*proc(n) INC i ENDIF NEXT n average#=sum%/i deviation#=SQR((sum2%-sum%*sum%/i)/(i*(i-1))) RETURN ' *** > PROCEDURE zero.average ' *** use 0 in computation FOR n=1 TO DIM?(proc())-1 ADD sum%,proc(n) ADD sum2%,proc(n)*proc(n) INC i NEXT n average#=sum%/i deviation#=SQR((sum2%-sum%*sum%/i)/(i*(i-1))) RETURN ' ********** ' > PROCEDURE freq.array(elem,VAR proc(),freq) ' *** return frequency of value elem in array proc() LOCAL last,n last=DIM?(proc())-1 freq=0 FOR n=1 TO last IF proc(n)=elem INC freq ENDIF NEXT n RETURN ' ********** ' > PROCEDURE freq.limit.array(limit,VAR proc(),freq) ' *** return frequency of all numbers >= limit in array proc() LOCAL last,n last=DIM?(proc())-1 freq=0 FOR n=1 TO last IF proc(n)>=limit INC freq ENDIF NEXT n RETURN ' ********** ' > PROCEDURE all.freq.array(VAR proc(),freq()) ' *** return frequency of all integers in array proc() ' *** only integers >= 0 allowed in array proc() ' *** frequency-array must already exist ! ' *** integers must vary from 0 to last index of frequency-array ! LOCAL last,max,i,j last=DIM?(proc())-1 max=DIM?(freq())-1 FOR i=0 TO max FOR j=1 TO last IF proc(j)=i INC freq(i) ENDIF NEXT j NEXT i RETURN ' ********** ' > PROCEDURE step.freq.array(step,VAR proc(),freq()) ' *** return frequency of all integers in array proc() ' *** array proc() contains multiples of step only ! ' *** example with step=5 : 0,5,15,20,25,....95,100 ' *** remember, freq(3) contains frequency of value 3*step ! LOCAL last,max,i,j last=DIM?(proc())-1 max=(DIM?(freq())-1)*step FOR i=0 TO max STEP step FOR j=1 TO last IF proc(j)=i INC freq(DIV(i,step)) ENDIF NEXT j NEXT i RETURN ' ********** ' > PROCEDURE shuffle.array(VAR proc()) ' *** shuffle integers in array proc() LOCAL n,j FOR n=DIM?(proc())-1 DOWNTO 2 j=RAND(n)+1 ! random number (1 - n) SWAP proc(j),proc(n) NEXT n RETURN ' ********** ' > PROCEDURE compress.array(VAR proc()) ' *** remove duplicates from sorted array proc() ' *** dimension of array will be changed after deletions ! LOCAL last,i,j last=DIM?(proc())-1 i=2 WHILE proc(i-1)<>proc(i) AND iproc(i) INC i ENDIF j=i-1 WHILE iproc(i) INC j proc(j)=proc(i) ENDIF WEND DIM new.proc(j) FOR i=1 TO j new.proc(i)=proc(i) NEXT i SWAP proc(),new.proc() ERASE new.proc() RETURN ' ********** ' > PROCEDURE reverse.array(VAR proc()) ' *** reverse array proc() LOCAL last,half,n last=DIM?(proc())-1 half=last/2 FOR n=1 TO half SWAP proc(n),proc(last+1-n) NEXT n RETURN ' ********** ' ' ****************** ' *** CHOICE.LST *** ' ****************** ' DEFWRD "a-z" ' > PROCEDURE choice.2(line,txt$,choice1$,choice2$,VAR choice) ' *** click on choice1 or choice2 ' *** 12 characters allowed in line ' *** only High and Medium resolution ' *** uses Standard-Globals and Standard-Functions LOCAL txt.col,choice1.col,choice2.col,x,y,k,clicked! txt.col=scrn.col.max-(LEN(txt$)+50) choice1.col=36 choice2.col=51 choice1$=" "+choice1$+" " ! nicer with spaces choice2$=" "+choice2$+" " PRINT AT(txt.col,line);txt$; PRINT AT(choice1.col,line);choice1$; PRINT AT(choice2.col,line);choice2$; BOX (choice1.col-1)*8,(line-1)*char.height,(choice1.col+LEN(choice1$)-1)*8,line*char.height BOX (choice2.col-1)*8,(line-1)*char.height,(choice2.col+LEN(choice2$)-1)*8,line*char.height SHOWM clicked!=FALSE REPEAT MOUSE x,y,k IF y>(line-1)*char.height AND y PROCEDURE switch(line,txt$,VAR switch!) ' *** choice between ON and OFF ' *** only High or Medium resolution ' *** uses Standard-Globals and -Functions LOCAL txt.col,choice1.col,choice2.col,x,y,k,clicked! txt.col=scrn.col.max-(LEN(txt$)+50) choice1$=" ON " choice2$=" OFF " choice1.col=36 choice2.col=51 PRINT AT(txt.col,line);txt$; PRINT AT(choice1.col,line);choice1$; PRINT AT(choice2.col,line);choice2$; BOX (choice1.col-1)*8,(line-1)*char.height,(choice1.col+LEN(choice1$)-1)*8,line*char.height BOX (choice2.col-1)*8,(line-1)*char.height,(choice2.col+LEN(choice2$)-1)*8,line*char.height SHOWM clicked!=FALSE REPEAT MOUSE x,y,k IF y>(line-1)*char.height AND y PROCEDURE choice.3(line,txt$,choice1$,choice2$,choice3$,VAR choice) ' *** click on choice1, choice2 or choice3 ' *** 12 characters allowed on line ' *** only High or Medium resolution ' *** uses Standard-Globals and -Functions LOCAL txt.col,choice1.col,choice2.col,choice3.col,x,y,k,clicked! txt.col=scrn.col.max-(LEN(txt$)+50) choice1.col=36 choice2.col=51 choice3.col=66 choice1$=" "+choice1$+" " ! nicer with spaces choice2$=" "+choice2$+" " choice3$=" "+choice3$+" " PRINT AT(txt.col,line);txt$; PRINT AT(choice1.col,line);choice1$; PRINT AT(choice2.col,line);choice2$; PRINT AT(choice3.col,line);choice3$; BOX (choice1.col-1)*8,(line-1)*char.height,(choice1.col+LEN(choice1$)-1)*8,line*char.height BOX (choice2.col-1)*8,(line-1)*char.height,(choice2.col+LEN(choice2$)-1)*8,line*char.height BOX (choice3.col-1)*8,(line-1)*char.height,(choice3.col+LEN(choice3$)-1)*8,line*char.height SHOWM clicked!=FALSE REPEAT MOUSE x,y,k IF y>(line-1)*char.height AND y=50*8 AND x<65*8 PRINT AT(choice2.col,line);@rev$(choice2$); choice=2 ELSE PRINT AT(choice3.col,line);@rev$(choice3$); choice=3 ENDIF ENDIF ENDIF ENDIF UNTIL k=1 AND clicked! PAUSE 10 RETURN ' ********** ' > PROCEDURE choice.table(line,VAR proc.table$(),proc.choice()) ' *** first call Procedure Initio.table ' *** click on choices in table ' *** only High or Medium resolution ' *** uses Standard-Globals and -Functions LOCAL n,lines,choice1.col,choice2.col,choice3.col,txt.col,default LOCAL clicked!,ok!,nummer,choice1$,choice2$,choice3$,x,y,k,reg lines=DIM?(proc.choice())-1 choice1.col=36 choice2.col=51 choice3.col=66 FOR n=1 TO lines reg=line+2*(n-1) txt$=proc.table$(n,0) choice1$=" "+proc.table$(n,1)+" " ! nicer with spaces choice2$=" "+proc.table$(n,2)+" " choice3$=" "+proc.table$(n,3)+" " txt.col=scrn.col.max-(LEN(txt$)+50) default=proc.choice(n) PRINT AT(txt.col,reg);txt$; PRINT AT(choice1.col,reg);choice1$; PRINT AT(choice2.col,reg);choice2$; BOX (choice1.col-1)*8,(reg-1)*char.height,(choice1.col+LEN(choice1$)-1)*8,reg*char.height BOX (choice2.col-1)*8,(reg-1)*char.height,(choice2.col+LEN(choice2$)-1)*8,reg*char.height IF proc.table$(n,3)>"" PRINT AT(choice3.col,reg);choice3$; BOX (choice3.col-1)*8,(reg-1)*char.height,(choice3.col+LEN(choice3$)-1)*8,reg*char.height ENDIF IF default>0 PRINT AT(choice1.col+(default-1)*15,reg);@rev$(" "+proc.table$(n,default)+" "); ENDIF NEXT n PRINT AT(38,24);" OK "; DEFLINE 1,3 BOX 37*8,23*char.height,41*8,24*char.height DEFLINE 1,1 SHOWM clicked!=FALSE ok!=FALSE REPEAT REPEAT MOUSE x,y,k in$=INKEY$ IF in$=return$ ok!=TRUE PRINT AT(38,24);@rev$(" OK "); ENDIF EXIT IF ok! IF y>(line-1)*char.height AND y<(line+2*lines)*char.height IF k=1 clicked!=TRUE nummer=(y/char.height+1-line)/2+1 choice1$=" "+proc.table$(nummer,1)+" " choice2$=" "+proc.table$(nummer,2)+" " choice3$=" "+proc.table$(nummer,3)+" " reg=line+2*(nummer-1) IF x<50*8 PRINT AT(choice1.col,reg);@rev$(choice1$); PRINT AT(choice2.col,reg);choice2$; BOX (choice2.col-1)*8,(reg-1)*char.height,(choice2.col+LEN(choice2$)-1)*8,reg*char.height IF proc.table$(nummer,3)>"" PRINT AT(choice3.col,reg);choice3$; BOX (choice3.col-1)*8,(reg-1)*char.height,(choice3.col+LEN(choice3$)-1)*8,reg*char.height ENDIF proc.choice(nummer)=1 ELSE IF (x>=50*8 AND x<65*8 AND choice3$>"") OR (x>=50*8 AND choice3$="") PRINT AT(choice1.col,reg);choice1$; BOX (choice1.col-1)*8,(reg-1)*char.height,(choice1.col+LEN(choice1$)-1)*8,reg*char.height PRINT AT(choice2.col,reg);@rev$(choice2$); IF proc.table$(nummer,3)>"" PRINT AT(choice3.col,reg);choice3$; BOX (choice3.col-1)*8,(reg-1)*char.height,(choice3.col+LEN(choice3$)-1)*8,reg*char.height ENDIF proc.choice(nummer)=2 ELSE PRINT AT(choice1.col,reg);choice1$; BOX (choice1.col-1)*8,(reg-1)*char.height,(choice1.col+LEN(choice1$)-1)*8,reg*char.height PRINT AT(choice2.col,reg);choice2$; BOX (choice2.col-1)*8,(reg-1)*char.height,(choice2.col+LEN(choice2$)-1)*8,reg*char.height PRINT AT(choice3.col,reg);@rev$(choice3$); proc.choice(nummer)=3 ENDIF ENDIF ENDIF ENDIF IF y>23*char.height IF k=1 PRINT AT(38,24);@rev$(" OK "); ok!=TRUE ENDIF ENDIF UNTIL k=1 AND (clicked! OR ok!) PAUSE 10 UNTIL ok! RETURN ' *** > PROCEDURE initio.table ' *** global : TABLE$() CHOICE() ' *** 1e DATA-line : number of lines ' *** following DATA-lines : 1st choice,2nd choice,[3rd choice],*,0/1/2/3 ' *** 3rd choice optional; last number is default choice ' *** 12 characters allowed on one line LOCAL n,i,lines,x$,default initio.table: DATA 3 DATA 1st line,1st choice,2nd choice,*,1 DATA 2nd question,first,second,third,*,0 DATA 3rd possibility,on,off,*,2 RESTORE initio.table READ lines ERASE table$(),choice() DIM table$(lines,3),choice(lines) FOR n=1 TO lines i=0 DO READ x$ EXIT IF x$="*" table$(n,i)=x$ INC i LOOP READ default choice(n)=default NEXT n RETURN ' ********** ' > PROCEDURE dial.number(line,txt$,default,min,max,step1,step2,cycle!,VAR choice) ' *** choose number with mouse ' *** after pressing , a short description appears ' *** only High or Medium resolution ' *** uses Standard-Globals and -Procedures LOCAL c,txt.col,fld,tot.fld,fld$,clr.fld$,dwn.col,num.col,up.col LOCAL x.lft,x.rgt,x,y,k,in$,dial!,delta c=char.height txt.col=scrn.col.max-(LEN(txt$)+50) PRINT AT(txt.col,line);txt$; fld=LEN(STR$(max)) tot.fld=fld+6 fld$=STRING$(fld,"#") LET clr.fld$=SPACE$(LEN(fld$)) dwn.col=37 x.lft=(dwn.col+1)*8 x.rgt=(dwn.col+tot.fld-3)*8 num.col=dwn.col+3 up.col=dwn.col+fld+5 PRINT AT(dwn.col-1,line);" "; OUT 5,2 PRINT AT(up.col-1,line);" "; OUT 5,1 PRINT AT(num.col,line);USING fld$,default; BOX (dwn.col-2)*8,(line-1)*c-1,(dwn.col+tot.fld)*8,line*c LINE x.lft,(line-1)*c,x.lft,line*c LINE x.rgt,(line-1)*c,x.rgt,line*c DEFMOUSE 0 SHOWM choice=default dial!=FALSE DO MOUSE x,y,k in$=INKEY$ IF in$=return$ dial!=TRUE ENDIF IF in$=help$ @help.dial.number ENDIF IF y>(line-1)*c AND y<(line)*c+1 IF k=1 OR k=2 IF x>x.lft AND x<(dwn.col+tot.fld-3)*8 dial!=TRUE ENDIF IF xx.rgt delta=-step1*(k=1)-step2*(k=2) ENDIF IF NOT dial! choice=choice+delta IF choice>max IF NOT cycle! choice=max PRINT bel$; ELSE choice=min+(choice-max) ENDIF ENDIF IF choice PROCEDURE help.dial.number LOCAL screen$ SGET screen$ CLS PRINT AT(1,4);" "; OUT 5,2 PRINT " = decrease number with mouse-click (lowest value = ";min;")" PRINT PRINT " "; OUT 5,1 PRINT " = increase number with mouse-click (highest value = ";max;")" PRINT PRINT " left button : 1 click = ";step1 PRINT PRINT " right button : 1 click = ";step2 PRINT IF cycle! PRINT " cycles from highest value to lowest value (and back)" PRINT ENDIF PRINT " choose number by mouse-click or by pressing " @return.key SPUT screen$ RETURN ' ********** ' > PROCEDURE pop.choice(x,y,VAR pop.choice!()) ' *** first call Procedure Initio.pop.choice ' *** pop=up menu appears at (x,y) ' *** High resolution only ' *** after pressing , a short description appears ' *** you can click one or more lines ' *** original screen is restored LOCAL n,xb2%,lines,height,width,i,r$,m0,m1,y_pos,c,f,top,f_pos,mx,my,mk LOCAL screen$,in$ n=DIM?(pop.choice$())-1 ERASE pop.choice!() DIM pop.choice!(n) xb2%=XBIOS(2) ' IF n>10 ! width, height and position of box height=260 lines=13 ELSE height=n*20+20 lines=n ENDIF width=LEN(pop.choice$(0)) FOR i=1 TO n width=MAX(LEN(pop.choice$(i)),width) NEXT i width=(width+4)*8 x=MIN(x,639-width-16) y=MIN(y,125) x=MAX(x,10) y=MAX(y,20) ' GET x-3,y-3,x+width+3,y+height+3,r$ ' ACLIP 1,0,0,639,399 ! box + text m1=-1 ARECT x-3,y-2,x+width+3,y+height+2,1,0,V:m1,0 m0=0 ARECT x,SUCC(y),x+width,PRED(y+height),1,0,V:m0,0 y_pos=y+20 FOR i=1 TO lines HLINE x,y_pos,x+width,1,0,V:m1,0 ADD y_pos,20 NEXT i c=width/8-2 IF lines=13 y_pos=y+42 ATEXT x+8,y+22,2,STRING$(c,1) ATEXT x+8,y+242,2,STRING$(c,2) ELSE y_pos=y+22 ENDIF ATEXT x+8+(c-LEN(pop.choice$(0)))*4,y+7,1,pop.choice$(0) FOR i=1 TO MIN(lines,10) ATEXT x+8+(c-LEN(pop.choice$(i)))*4,y_pos,2,pop.choice$(i) ADD y_pos,20 NEXT i ' top=0 f=-1 REPEAT UNTIL INKEY$="" REPEAT ! menu-selection loop MOUSE mx,my,mk ' in$=INKEY$ IF in$=help$ SGET screen$ CLS PRINT AT(1,6);" click left mouse-button to make (or undo) choice" PRINT IF lines>10 PRINT " scroll one line with left mouse-button" PRINT PRINT " scroll to begin or end with right mouse-button" PRINT ENDIF PRINT PRINT PRINT " press right button outside box to leave menu" ~INP(2) SPUT screen$ in$="" ENDIF ' IF mx>x AND mxy+20 AND myf IF f<>-1 ARECT SUCC(x),y+f*20+2,PRED(x+width),y+f*20+18,1,2,V:m1,0 ENDIF f=TRUNC((my-y)/20) ARECT SUCC(x),y+f*20+2,PRED(x+width),y+f*20+18,1,2,V:m1,0 ENDIF ELSE IF f<>-1 ARECT SUCC(x),y+f*20+2,PRED(x+width),y+f*20+18,1,2,V:m1,0 ENDIF f=-1 ENDIF ' IF mk=1 IF (f>1 AND f<12 AND lines=13) OR (f>0 AND f<11 AND lines<>13) f_pos=f+top ! choice clicked IF lines=13 DEC f_pos ENDIF pop.choice!(f_pos)=NOT pop.choice!(f_pos) IF pop.choice!(f_pos) ARECT SUCC(x),y+f*20+2,PRED(x+width),y+f*20+18,1,2,V:m1,0 ATEXT PRED(x+width)-8,y+f*20+2,2,CHR$(8) ARECT SUCC(x),y+f*20+2,PRED(x+width),y+f*20+18,1,2,V:m1,0 ELSE ARECT PRED(x+width)-8,y+f*20+2,PRED(x+width),y+f*20+18,1,0,V:m1,0 ENDIF WHILE MOUSEK WEND MOUSE mx,my,mk ENDIF ENDIF ' IF lines=13 AND (f=1 OR f=12) AND mk ! scroll IF f=1 ! scroll down IF top>0 RC_COPY xb2%,SUCC(x),y+40,PRED(width),height-80 TO xb2%,SUCC(x),y+60 ARECT SUCC(x),y+41,PRED(x+width),y+59,1,0,V:m0,0 ATEXT x+8+(c-LEN(pop.choice$(top)))*4,y+42,2,pop.choice$(top) IF pop.choice!(top) ATEXT PRED(x+width)-8,y+42,2,CHR$(8) ENDIF DEC top ENDIF ELSE IF top+11<=n ! scroll up RC_COPY xb2%,SUCC(x),y+60,PRED(width),height-80 TO xb2%,SUCC(x),y+40 ARECT SUCC(x),y+221,PRED(x+width),y+239,1,0,V:m0,0 ATEXT x+8+(c-LEN(pop.choice$(top+11)))*4,y+222,2,pop.choice$(top+11) IF pop.choice!(top+11) ATEXT PRED(x+width)-8,y+222,2,CHR$(8) ENDIF INC top ENDIF ENDIF WHILE MOUSEK=1 WEND mk=0 ENDIF ' UNTIL mk=2 AND f=-1 ! quit menu PUT x-3,y-3,r$ ACLIP 0,0,0,639,399 RETURN ' *** > PROCEDURE initio.pop.choice ' *** global : POP.CHOICE$() LOCAL n,i,pop$ RESTORE pop.data n=-1 REPEAT READ pop$ INC n UNTIL pop$="***" DEC n DIM pop.choice$(n) RESTORE pop.data FOR i=0 TO n READ pop.choice$(i) NEXT i ' pop.data: DATA menu-title DATA 1st choice,2nd choice,3rd choice DATA *** RETURN ' ********** ' ' ***************** ' *** COLOR.LST *** ' ***************** ' DEFWRD "a-z" ' > PROCEDURE new.low.colors ' *** new palette (Low resolution) ' *** please,please,please, restore original palette before exiting program LOCAL n,r,g,b,col$ RESTORE low.new.col.data FOR n=0 TO 15 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' ' *** rgb-values of new palette (switch to Overwrite-mode of editor) low.new.col.data: DATA 777,000,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX,XXX RETURN ' ********** ' > PROCEDURE new.med.colors ' *** new palette (Medium resolution) ' *** please,please,please, restore original palette before exiting program LOCAL n,r,g,b,col$ RESTORE med.new.col.data FOR n=0 TO 3 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' ' *** rgb-values of new palette (switch to Overwrite-mode of editor) med.new.col.data: DATA 777,000,XXX,XXX RETURN ' ********** ' > PROCEDURE save.palette ' *** save current palette in integer-array ' *** global : OLD.PALETTE%() LOCAL i ERASE old.palette%() DIM old.palette%(15) FOR i=0 TO 15 old.palette%(i)=XBIOS(7,i,-1) NEXT i RETURN ' *** > PROCEDURE restore.palette ' *** restore original palette LOCAL i FOR i=0 TO 15 VOID XBIOS(7,i,old.palette%(i)) NEXT i RETURN ' ********** ' > PROCEDURE make.palette.string(VAR pal$) ' *** save current palette in (Degas-compatible) string LOCAL n pal$="" FOR n=0 TO 15 pal$=pal$+MKI$(XBIOS(7,n,-1)) NEXT n RETURN ' ********** ' > PROCEDURE change.palette(pal.string$) ' *** change palette with (Degas-compatible) string VOID XBIOS(6,L:VARPTR(pal.string$)) RETURN ' ********** ' > PROCEDURE rgb.value(index,VAR rgb$) ' *** returns RGB-string of color-index ' *** uses Standard Array color.index() LOCAL col% col%=XBIOS(7,color.index(index),-1) rgb$=RIGHT$(HEX$(col%),3) RETURN ' ********** ' > PROCEDURE screen(txt.col$,back.col$) ' *** change color of all PRINTed text and color of background (TOS-screen !) ' *** use RGB-strings (e.g. "777" for white) ' *** uses Standard Array Color.index ' *** saves old colors in global variables ' *** global : OLD.TEXT.COL$ OLD.BACK.COL$ old.text.col$=RIGHT$(HEX$(XBIOS(7,color.index(1),-1)),3) old.back.col$=RIGHT$(HEX$(XBIOS(7,color.index(0),-1)),3) VSETCOLOR 1,VAL(LEFT$(txt.col$)),VAL(MID$(txt.col$,2,1)),VAL(RIGHT$(txt.col$)) VSETCOLOR 0,VAL(LEFT$(back.col$)),VAL(MID$(back.col$,2,1)),VAL(RIGHT$(back.col$)) RETURN ' ********** ' > PROCEDURE palette.box(x,y,h,w) ' *** show palette in rectangle (spectrum) ' *** left upper corner of rectangle at x,y ' *** rectangle-height h; width of one color-box w ' *** uses Standard Array color.index() and Standard Global black LOCAL arect.fill,fill.adr%,i,x1,x2 x2=x+16*w+2 COLOR black BOX x,y,x2,y+h arect.fill=-1 fill.adr%=V:arect.fill IF low.res! FOR i=0 TO 15 x1=ADD(SUCC(x),MUL(i,w)) ARECT x1,SUCC(y),ADD(x1,w),PRED(ADD(y,h)),color.index(i),0,fill.adr%,0 NEXT i ELSE IF med.res! FOR i=0 TO 3 x1=ADD(SUCC(x),MUL(i,w)) ARECT x1,SUCC(y),ADD(x1,w),PRED(ADD(y,h)),color.index(i),0,fill.adr%,0 NEXT i ENDIF RETURN ' ********** ' > PROCEDURE dim.colors(reg1,reg2,val) ' *** dim colors from VDI color-index reg1 to reg2 with val ' *** for val=1 color 254 (rgb) will become 143 ' *** use this Procedure to darken the screen temporarily ' *** Procedure can also be used instead of CLS : ' *** FOR i=0 TO 7 ' *** @dim.colors(0,15,1) ' *** PAUSE 3 ' *** NEXT i ' *** uses Standard Array color.index() and Procedure Rgb.value LOCAL i,r,g,b FOR i=reg1 TO reg2 @rgb.value(i,rgb$) r=MAX(PRED(VAL(LEFT$(rgb$))),0) g=MAX(PRED(VAL(MID$(rgb$,2,1))),0) b=MAX(PRED(VAL(RIGHT$(rgb$))),0) VSETCOLOR i,r,g,b NEXT i RETURN ' ********** ' > PROCEDURE color.cycle(reg1,reg2,time) ' *** cycles colors from from VDI color-index reg1 to reg2 ' *** cycles every time*0.005 seconds with EVERY (time=200 : 1 second) ' *** call again to stop the color-cycling : @color.cycle(0,0,0) ' *** uses Standard Array color.index() ' *** global : COLOR.CYCLE! COL.REG1 COL.REG2 ' IF NOT color.cycle! col.reg1=reg1 col.reg2=reg2 color.cycle!=TRUE EVERY time GOSUB cycle.once ELSE color.cycle!=FALSE EVERY STOP ENDIF RETURN ' *** > PROCEDURE cycle.once LOCAL col1%,col2% col1%=XBIOS(7,color.index(col.reg2),-1) FOR reg=col.reg1 TO PRED(col.reg2) col2%=XBIOS(7,color.index(reg),-1) ~XBIOS(7,color.index(reg),col1%) SWAP col1%,col2% NEXT reg ~XBIOS(7,color.index(col.reg2),col1%) RETURN ' ********** ' ' ***************** ' *** DEBUG.LST *** ' ***************** ' DEFWRD "a-z" ' > PROCEDURE debug ' *** Merge (temporarily) with a program if you need help with debugging ' *** activate Procedure Debug in main program with : TRON debug ' *** run program, press for debug-menu ' *** uses VT52-commands (on TOS-screen, not in window) ' *** uses Standard Globals ' *** Global : DEBUG.SPEED DEBUG.TRON! DEBUG.LINE$ DEBUG.LINES LOCAL screen$,dump.par$,scr%,sy,dy IF BIOS(11,-1)=13 OR INSTR(TRACE$,debug.line$) PRINT CHR$(27)+"j"; ! save current cursor-position SGET screen$ ! save screen DO IF debug.lines<1 debug.lines=4 ENDIF CLS PRINT AT(1,2);" *** GFA-BASIC DEBUGGER ***" PRINT PRINT " Stop program (Command mode)" PRINT PRINT " Change TRON-delay" PRINT " TRON-lines on screen" IF debug.tron! PRINT " Switch TRON off" ELSE PRINT " Switch TRON on" ENDIF PRINT PRINT " Dump variables to screen" PRINT "

Dump procedures/functions" PRINT " Dump labels" PRINT PRINT " Wait for string (breakpoint)" PRINT PRINT " Continue with main program" PRINT PRINT " Quit program, go to editor" PRINT AT(1,20);" Delay = ";debug.speed;"/50 s TRON = "; IF debug.tron! PRINT "on (";debug.lines;" lines)" ELSE PRINT "off" ENDIF IF debug.line$<>"" PRINT " Search-string: ";debug.line$ ENDIF ' IF INSTR(TRACE$,debug.line$) PRINT AT(1,23);"String found:" ELSE PRINT AT(1,23);"Current line:" ENDIF OUT 5,3 PRINT " ";TRACE$; ' SELECT UPPER$(CHR$(INP(2))) CASE "S" KEYPRESS &H1C000D STOP CASE "D" PRINT AT(1,21);SPACE$(80); PRINT AT(1,21);" Delay (in 1/50 s): "; INPUT "",debug.speed CASE "L" PRINT AT(1,21);SPACE$(80); PRINT AT(1,21);" TRON-lines (1): "; INPUT "",debug.lines CASE "T" debug.tron!=NOT debug.tron! CASE "V" PRINT AT(1,21);SPACE$(80); PRINT AT(1,21);" DUMP-Parameter: "; INPUT "",dump.par$ CLS PRINT " *** Use or right ***" PRINT DUMP dump.par$ PRINT PRINT " (Press any key to continue)"; ~INP(2) CASE "P" CLS PRINT " *** Use or right ***" PRINT DUMP "@" PRINT PRINT " (Press any key to continue)"; ~INP(2) CASE "B" CLS PRINT " *** Use or right ***" PRINT DUMP ":" PRINT PRINT " (Press any key to continue)"; ~INP(2) CASE "W" PRINT AT(1,21);SPACE$(80); PRINT AT(1,21);" Search-string: "; INPUT "",debug.line$ CASE "C" EXIT IF TRUE CASE "Q" EDIT ENDSELECT LOOP SPUT screen$ ! restore screen PRINT CHR$(27)+"k"; ! restore cursor ENDIF ' PAUSE debug.speed ' IF debug.tron! IF debug.lines>1 scr%=XBIOS(2) ! physical screen sy=MUL(SUCC(SUB(scrn.lin.max,debug.lines)),char.height) dy=SUB(sy,char.height) RC_COPY scr%,0,sy,scrn.x.max,MUL(PRED(debug.lines),char.height) TO scr%,0,dy PRINT AT(1,scrn.lin.max);"jwK";TRACE$;"kv"; ELSE PRINT AT(1,scrn.lin.max);"jwK";TRACE$;"kv"; ENDIF ENDIF RETURN ' ********** ' ' ***************** ' *** DEFFN.LST *** ' ***************** ' DEFWRD "a-z" ' DEFFN digit(number,place)=VAL(MID$(STR$(number),place,1)) DEFFN div(number,divisor)=(MOD(number,divisor)=0) ' DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$ DEFFN flush.r$(text$)=SPACE$(scrn.col.max-LEN(text$))+text$ DEFFN clear$(line)=CHR$(27)+"Y"+CHR$(33)+CHR$(32+line)+CHR$(27)+"l" ' DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" DEFFN txt.color$(txt$,letter.col,back.col)=CHR$(27)+"b"+CHR$(color.index(letter.col))+CHR$(27)+"c"+CHR$(color.index(back.col))+" "+txt$+" " DEFFN ink$(color)=CHR$(27)+"b"+CHR$(color.index(color)) DEFFN paper$(color)=CHR$(27)+"c"+CHR$(color.index(color)) ' DEFFN last.record(buffer,field.len)=LOF(#buffer)/field.len ' DEFFN fun.key$(n)=CHR$(0)+CHR$(n+58) DEFFN s.fun.key$(n)=CHR$(0)+CHR$(n+83) ' DEFFN log(grondgetal,x#)=LOG(x#)/LOG(grondgetal) ' DEFFN arccot(x#)=ATN(-x#)+PI/2 DEFFN sinh(x#)=(EXP(x#)-EXP(-x#))/2 DEFFN cosh(x#)=(EXP(x#)+EXP(-x#))/2 DEFFN tanh(x#)=(EXP(x#)-EXP(-x#))/(EXP(x#)+EXP(-x#)) DEFFN coth(x#)=1/FN tanh(x#) DEFFN arsinh(x#)=LOG(x#+SQR(x#*x#+1)) DEFFN arcosh(x#)=LOG(x#+SQR(x#*x#-1)) DEFFN artanh(x#)=LOG((1+x#)/(1-x#))/2 DEFFN arcoth(x#)=LOG((x#+1)/(x#-1))/2 ' DEFFN word(adr%)=ADD(BYTE{SUCC(adr%)},MUL(256,BYTE{adr%})) ' **************** ' *** DISK.LST *** ' **************** ' DEFWRD "a-z" ' > PROCEDURE disk.name(drive$,VAR disk.name$) ' *** search for name of disk on drive$ (usually "A") LOCAL dta.adres%,stat,k dta.adres%=FGETDTA() stat=FSFIRST(drive$+":\*.*",8) ! disk-name only (bit 3) IF stat=0 disk.name$=CHAR{dta.adres%+30} ELSE IF stat=-33 disk.name$="" ! no name on disk ELSE ALERT 3,"*** ERROR ***| |after FSFIRST",1,"EXIT",k @exit ENDIF RETURN ' ********** ' > PROCEDURE dir.folders ' *** put folders in main directory in array dir.folders$() ' *** folders should not have an extension !! ' *** (FSFIRST and FSNEXT find both folders and files with bit 4 set) ' *** global : DIR.FOLDERS$() LAST.FOLDER LOCAL n,dta.adres%,stat n=0 ERASE dir.folders$() DIM dir.folders$(20) ! not more than 20 folders dta.adres%=FGETDTA() stat=FSFIRST("*",16) ! 1st folder (bit 4 set) IF stat=0 LET dir.folders$(1)=CHAR{dta.adres%+30} n=1 ENDIF REPEAT stat=FSNEXT() ! next folder IF stat=0 INC n LET dir.folders$(n)=CHAR{dta.adres%+30} ENDIF UNTIL stat<>0 last.folder=n RETURN ' ********** ' > PROCEDURE dir.files(path$,ext$) ' *** put all files with path path$ and extension ext$ in array dir.files$() ' *** global : DIR.FILES$() LAST.FILE LOCAL n,search$,dta.adres%,stat n=0 ERASE dir.files$() DIM dir.files$(50) ! not more than 50 files IF RIGHT$(path$)="\" search$=path$+"*."+ext$ ELSE search$=path$+"\*."+ext$ ENDIF dta.adres%=FGETDTA() stat=FSFIRST(search$,0) ! 1st file IF stat=0 LET dir.files$(1)=CHAR{dta.adres%+30} n=1 ENDIF REPEAT stat=FSNEXT() ! next file IF stat=0 INC n LET dir.files$(n)=CHAR{dta.adres%+30} ENDIF UNTIL stat<>0 last.file=n RETURN ' ********** ' > PROCEDURE disk.space(drive) ' *** return data about disk-format from GEMDOS 54 (Dfree) ' *** global : TOTAL.CLUSTERS FREE.CLUSTERS USED.CLUSTERS FREE.BYTES ' *** USED.BYTES SECTOR.BYTES CLUSTER.BYTES CLUSTER.SECTORS ' *** TOTAL.SECTORS LOCAL buffer$,buffer% buffer$=SPACE$(16) buffer%=VARPTR(buffer$) VOID GEMDOS(&H36,L:buffer%,drive) free.clusters=LPEEK(buffer%) total.clusters=LPEEK(buffer%+4) used.clusters=total.clusters-free.clusters sector.bytes=LPEEK(buffer%+8) cluster.sectors=LPEEK(buffer%+12) total.sectors=total.clusters*cluster.sectors cluster.bytes=sector.bytes*cluster.sectors free.bytes=free.clusters*cluster.bytes ! same as DFREE(0) used.bytes=used.clusters*cluster.bytes RETURN ' ********** ' > PROCEDURE disk.parameter.block(drive) ' *** return data about disk-format from DPB-buffer ' *** global : SECTOR.BYTES CLUSTER.SECTORS CLUSTER.BYTES ' *** DIR.SECTORS FAT.SECTORS FAT2.START.SECTOR ' *** DATA.START.SECTOR DIR.START.SECTOR DATA.CLUSTERS LOCAL dpb.adres% dpb.adres%=BIOS(7,drive) sector.bytes=DPEEK(dpb.adres%) cluster.sectors=DPEEK(dpb.adres%+2) cluster.bytes=DPEEK(dpb.adres%+4) LET dir.sectors=DPEEK(dpb.adres%+6) fat.sectors=DPEEK(dpb.adres%+8) fat2.start.sector=DPEEK(dpb.adres%+10) LET data.start.sector=DPEEK(dpb.adres%+12) LET dir.start.sector=2*fat.sectors+1 LET data.clusters=DPEEK(dpb.adres%+14) RETURN ' ********** ' > PROCEDURE boot.sector(drive) ' *** return data about disk-format from Boot-sector ' *** global : ' BOOT.BRANCH% DISK.NR% SECTOR.BYTES% CLUSTER.SECTORS% RESERVED.SECTORS% ' FATS% DIR.MAX% DISK.SECTORS% FAT.SECTORS% TRACK.SECTORS% DISK.SIDES% ' DISK.TRACKS% COMMAND.FLAG% LOAD.MODE% FIRST.LOAD.SECTOR% LOAD.SECTORS% ' LOAD.ADDRESS% FAT.ADDRESS% LOAD.FILE$ BOOT.CHECKSUM% ' (all number-variables are 4-byte integers !) LOCAL buffer$,buffer%,desktop.format!,p,sum%,n buffer$=SPACE$(512) buffer%=VARPTR(buffer$) ~BIOS(4,0,L:buffer%,1,0,drive) ! Boot-sector (0) in buffer ' @word(buffer%,*boot.branch%) ! branch to boot-code disk.nr%=PEEK(buffer%+8)+256*PEEK(buffer%+9)+65536*PEEK(buffer%+10) ! serial no. @word(buffer%+11,*sector.bytes%) ! bytes/sector (512) cluster.sectors%=PEEK(buffer%+13) ! sectors/cluster (2) @word(buffer%+14,*reserved.sectors%) ! reserved sectors (1) fats%=PEEK(buffer%+16) ! number of FATS (2) @word(buffer%+17,*dir.max%) ! maximum files in directory @word(buffer%+19,*disk.sectors%) ! total sectors @word(buffer%+22,*fat.sectors%) ! sectors/FAT @word(buffer%+24,*track.sectors%) ! sectors/track @word(buffer%+26,*disk.sides%) ! 1- of 2-sided disk disk.tracks%=INT(disk.sectors%/(track.sectors%*disk.sides%)) ! tracks/disk IF MID$(buffer$,31,30)=STRING$(30,"N") desktop.format!=TRUE ! disk formatted from Desktop ENDIF IF desktop.format! CLR command.flag%,load.mode%,first.load.sector%,load.sectors% CLR load.address%,fat.address%,load.file$ ELSE @word(buffer%+30,*command.flag%) ! flag @word(buffer%+32,*load.mode%) ! 0 = load file ; or sectors @word(buffer%+34,*first.load.sector%) ! 1st sector (load.mode <> 0) @word(buffer%+36,*load.sectors%) ! number of sectors @long.word(buffer%+38,*load.address%) ! load-address for file or sectors @long.word(buffer%+42,*fat.address%) ! address for FAT-buffer ' LET load.file$=MID$(buffer$,47,11) IF LEFT$(load.file$)<>CHR$(0) AND load.mode%=0 p=INSTR(load.file$," ") IF p=0 p=9 ENDIF LET load.file$=LEFT$(load.file$,p-1)+"."+RIGHT$(load.file$,3) ELSE LET load.file$="" ENDIF ENDIF sum%=0 FOR n=0 TO 255 ADD sum%,CARD{buffer%+n*2} NEXT n boot.checksum%=sum% AND &HFFFF ! checksum = &H1234 : bootsector executable RETURN ' *** > PROCEDURE word(adres%,p.word%) *p.word%=PEEK(adres%)+256*PEEK(adres%+1) RETURN ' *** > PROCEDURE long.word(adres%,p.long%) *p.long%=PEEK(adres%)+256*PEEK(adres%+1)+65536*PEEK(adres%+2)+16777216*PEEK(adres%+3) RETURN ' ********** ' > PROCEDURE read.sector(drive,sector) ' *** put disk-sector in buffer sector$ ' *** global : SECTOR$ OK! LOCAL buffer%,flag,k sector$=SPACE$(512) buffer%=VARPTR(sector$) flag=BIOS(4,0,L:buffer%,1,sector,drive) IF flag<>0 ALERT 3,"sector is| |NOT loaded !!",1," OK ",k ok!=FALSE ELSE ok!=TRUE ENDIF RETURN ' ********** ' > PROCEDURE get.cluster.pointers ' *** put cluster- and sector-pointers in arrays ' *** uses Procedures Disk.space and Disk.parameter.block ' *** global : CLUSTER.POINTER() SECTOR.POINTER() LOCAL drive,fat.buffer$,fat.buffer%,n,data.clus,cluster.byte.nr,cluster.byte LOCAL cluster.byte$,previous.byte,previous.byte$,back.nibble$,clus.pointer$ LOCAL next.byte,next.byte$,front.nibble$,clus.pointer drive=GEMDOS(&H19) @disk.space(drive) ERASE cluster.pointer(),sector.pointer() DIM cluster.pointer(total.clusters),sector.pointer(total.clusters) @disk.parameter.block(drive) fat.buffer$=SPACE$(fat.sectors*512) fat.buffer%=VARPTR(fat.buffer$) FOR n=0 TO fat.sectors-1 VOID BIOS(4,0,L:fat.buffer%+n*512,1,n+1,drive) NEXT n FOR data.clus=1 TO total.clusters cluster.byte.nr=TRUNC(data.clus*1.5)+3 cluster.byte=PEEK(fat.buffer%+cluster.byte.nr-1) cluster.byte$=HEX$(cluster.byte) IF LEN(cluster.byte$)=1 cluster.byte$="0"+cluster.byte$ ENDIF IF EVEN(data.clus) previous.byte=PEEK(fat.buffer%+cluster.byte.nr-2) previous.byte$=HEX$(previous.byte) IF LEN(previous.byte$)=1 previous.byte$="0"+previous.byte$ ENDIF back.nibble$=LEFT$(previous.byte$) clus.pointer$=cluster.byte$+back.nibble$ ELSE LET next.byte=PEEK(fat.buffer%+cluster.byte.nr) LET next.byte$=HEX$(next.byte) IF LEN(next.byte$)=1 LET next.byte$="0"+next.byte$ ENDIF front.nibble$=RIGHT$(next.byte$) clus.pointer$=front.nibble$+cluster.byte$ ENDIF clus.pointer=VAL("&H"+clus.pointer$) cluster.pointer(data.clus)=clus.pointer sector.pointer(data.clus)=(clus.pointer-2)*2+data.start.sector NEXT data.clus RETURN ' ********** ' > PROCEDURE get.file.sectors(fat.cluster) ' *** call Procedure Get.cluster.pointers first ' *** first FAT-pointer has to be extracted from directory !! ' *** prints sectors of file ' *** first FAT-cluster is no. 2 (pointer of "data-cluster" no. 1 !) cluster=cluster.pointer(fat.cluster-1) IF cluster<=&HFF8 sector=sector.pointer(fat.cluster-1) PRINT sector'sector+1'; @get.file.sectors(cluster) ENDIF RETURN ' ********** ' > PROCEDURE force.mediach ' *** a disk-change is not always noticed by GEMDOS ' *** use this Procedure if in doubt ' *** after (X)BIOS read-routines not necessary after pause of 1.5 second ' *** (use PAUSE 75 before GEMDOS reads disk again) LOCAL x$,old.vector%,a% x$=SPACE$(12) old.vector%=LPEEK(&H47E) a%=V:x$ DPOKE a%,&H2B7C LPOKE a%+2,old.vector% DPOKE a%+6,&H47E DPOKE a%+8,&H7002 DPOKE a%+10,&H4E75 SLPOKE &H47E,a% ~DFREE(0) ! current drive RETURN ' ********** ' > PROCEDURE check.boot ' *** compute checksum of bootsector and warn user if bootsector executable LOCAL drive,buffer$,buffer%,sum%,n,m$ PRINT " Checking boot-sector ..." drive=GEMDOS(&H19) buffer$=SPACE$(512) buffer%=VARPTR(buffer$) ~BIOS(4,0,L:buffer%,1,0,drive) ! bootsector (0) of current drive in buffer sum%=0 FOR n=0 TO 255 ADD sum%,CARD{buffer%+n*2} NEXT n sum%=sum% AND &HFFFF IF sum%=&H1234 m$="Bootsector|executable :|this could be|a boot-virus" ALERT 3,m$,2," OK |STOP",k ENDIF RETURN ' ********** ' ' **************** ' *** FILE.LST *** ' **************** ' DEFWRD "a-z" ' > PROCEDURE file.length(file$,VAR length%) ' *** length of file (bytes) OPEN "I",#99,file$ length%=LOF(#99) CLOSE #99 RETURN ' ********** ' > PROCEDURE parse.filename(parse.name$,VAR drive$,path$,file$,ext$) ' *** return drive, path, filename (without extension !) and extension ' *** no checking for correct syntax ' *** example : "A:\GAMES\PLAY.GFA" returned as : A \GAMES\ PLAY GFA ' *** "A:\PLAY.GFA" returned as : A \ PLAY GFA LOCAL pos,first,last,last!,search,parse.file$ ' parse.name$=UPPER$(parse.name$) IF MID$(parse.name$,2,1)=":" drive$=LEFT$(parse.name$,1) ELSE drive$=CHR$(65+GEMDOS(&H19)) ! current drive ENDIF ' pos=1 last!=FALSE last=0 first=INSTR(1,parse.name$,"\") REPEAT search=INSTR(pos,parse.name$,"\") IF search>0 pos=search+1 last=search ELSE last!=TRUE ENDIF UNTIL last! IF last>0 ! backslash discovered path$=MID$(parse.name$,first,last-first+1) parse.file$=MID$(parse.name$,last+1) ELSE ! no '\' path$="" pos=INSTR(1,parse.name$,":") IF pos>0 parse.file$=MID$(parse.name$,pos+1) ELSE parse.file$=parse.name$ ENDIF ENDIF pos=INSTR(parse.file$,".") IF pos>0 ! name with extension ext$=MID$(parse.file$,pos+1) file$=LEFT$(parse.file$,pos-1) ELSE ! name without extension ext$="" file$=parse.file$ ENDIF RETURN ' ********** ' > PROCEDURE get.path(VAR default.path$) ' *** return default path (current drive and folder) ' *** example - A:\GAMES\ ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\ ' *** (even if program not in main directory !!) LOCAL default.drive,default.drive$ CLR default.path$ default.drive=GEMDOS(&H19) default.drive$=CHR$(default.drive+65) default.path$=DIR$(default.drive+1) IF default.path$<>"" default.path$=default.drive$+":"+default.path$+"\" ELSE default.path$=default.drive$+":\" ENDIF RETURN ' ********** ' > PROCEDURE file.copy(source$,dest$) ' *** copy file source$ to dest$ ' *** global : FILE.COPY! LOCAL m$,k,p,file$,block% IF source$=dest$ ! protect user against disaster m$="File-copy|aborted|(source =|destination)" ALERT 3,m$,1,"OK",k file.copy!=FALSE ELSE IF EXIST(dest$) m$=UPPER$(dest$)+"|already exists:|Kill file, or|Rename as *.BAK" ALERT 3,m$,0,"KILL|BAK",k IF k=1 KILL dest$ ELSE p=INSTR(dest$,".") IF p>0 file$=LEFT$(dest$,p)+"BAK" ELSE file$=dest$+".BAK" ENDIF RENAME dest$ AS file$ ENDIF ENDIF OPEN "I",#90,source$ OPEN "O",#91,dest$ block%=LOF(#90) WHILE block%>32000 PRINT #91,INPUT$(32000,#90); SUB block%,32000 WEND PRINT #91,INPUT$(block%,#90); CLOSE #90 CLOSE #91 file.copy!=TRUE ENDIF RETURN ' ********** ' > PROCEDURE file.move(source$,dest$) ' *** move file source$ to dest$ (source$ is killed after copy) ' *** global : FILE.MOVE! LOCAL m$,k,p,file$,block% IF source$=dest$ ! protect user against disaster m$="File-move|aborted|(source =|destination)" ALERT 3,m$,1," OK ",k file.move!=FALSE ELSE IF EXIST(dest$) m$=UPPER$(dest$)+"|already exists:|Kill file, or|Rename as *.BAK" ALERT 3,m$,0,"KILL|BAK",k IF k=1 KILL dest$ ELSE p=INSTR(dest$,".") IF p>0 file$=LEFT$(dest$,p)+"BAK" ELSE file$=dest$+".BAK" ENDIF RENAME dest$ AS file$ ENDIF ENDIF OPEN "I",#90,source$ OPEN "O",#91,dest$ block%=LOF(#90) WHILE block%>32000 PRINT #91,INPUT$(32000,#90); SUB block%,32000 WEND PRINT #91,INPUT$(block%,#90); CLOSE #90 CLOSE #91 KILL source$ file.move!=TRUE ENDIF RETURN ' ********** ' > PROCEDURE execute.prg(file$,bytes%,cmd$) ' *** reserve memory and start program file$ LOCAL free%,m$,k IF cmd$<>"" cmd$=CHR$(LEN(cmd$)+1)+cmd$ ! special commandline-format ENDIF free%=FRE() IF bytes%>free% m$="Sorry, insufficient|memory for running|"+file$+"|available" ALERT 3,m$,1,"EDIT",k EDIT ELSE RESERVE -bytes% SHOWM EXEC 0,file$,cmd$,"" ! start program RESERVE ! back to GFA-Basic ; return memory to GFA ENDIF RETURN ' ********** ' > PROCEDURE load.file(file$) ' *** put file in RAM ' *** don't forget to release memory again with RESERVE !! LOCAL bytes%,free%,adres%,m$,k OPEN "I",#90,file$ bytes%=LOF(#90) CLOSE #90 free%=FRE() IF free%>bytes% RESERVE -bytes% adres%=HIMEM ! should adres% be even ?? BLOAD file$,adres% ELSE m$="not enough memory|for loading|"+file$ ALERT 3,m$,1,"EDIT",k EDIT ENDIF RETURN ' ********** ' > PROCEDURE activate.accessory ' *** activate accessory by changing extension .ACX into .ACC ' *** accessories have to be in main directory ' *** uses Procedure Fileselect LOCAL file$,acc$,m$,k DO CLS @fileselect("\*.ACX","","Activate accessories ( = Stop)",file$) EXIT IF file$="" OR RIGHT$(file$)="\" acc$=LEFT$(file$,INSTR(file$,".")-1) NAME file$ AS acc$+".ACC" LOOP m$="|reset computer ?" ALERT 3,m$,0,"YES| NO",k IF k=1 VOID XBIOS(38,L:LPEEK(4)) ENDIF RETURN ' *** > PROCEDURE remove.accessory ' *** deactivate accessory by changing extension .ACC into .ACX ' *** uses Procedure Fileselect LOCAL file$,acc$,m$,k DO CLS PRINT " Deactivate accessories ( = Stop)" FILESELECT "\*.ACC","",file$ @fileselect("\*.ACC","","Deactivate accessories ( = Stop)",file$) EXIT IF file$="" OR RIGHT$(file$)="\" acc$=LEFT$(file$,INSTR(file$,".")-1) NAME file$ AS acc$+".ACX" LOOP m$="|reset computer ?" ALERT 3,m$,0,"YES| NO",k IF k=1 VOID XBIOS(38,L:LPEEK(4)) ENDIF RETURN ' ********** ' > PROCEDURE get.archive(arch$,VAR set!) ' *** examine archive-bit of file arch$ LOCAL flag flag=FSFIRST(arch$,32) IF flag=0 set!=TRUE ELSE set!=FALSE ENDIF RETURN ' ********** ' > PROCEDURE get.file.attributes(get.file$) ' *** return file-attributes of file ' *** global : ATTR.READ.ONLY! ATTR.HIDDEN! ATTR.SYSTEM! ATTR.LABEL! ' *** ATTR.FOLDER! ATTR.ARCHIVE! LOCAL path$,path%,attr%,k path$=get.file$+CHR$(0) path%=V:path$ attr%=GEMDOS(&H43,L:path%,0,0) IF attr%=-33 ALERT 3," *** file-error ***| |"+get.file$+"|not found",1," OK ",k ELSE IF attr%=-34 ALERT 3," *** path-error ***| |"+get.file$+"|not found",1," OK ",k ENDIF CLR attr.read.only!,attr.hidden!,attr.system!,attr.label!,attr.folder!,attr.archive! IF attr%<>-33 AND attr%<>-34 IF BTST(attr%,0) attr.read.only!=TRUE ENDIF IF BTST(attr%,1) attr.hidden!=TRUE ENDIF IF BTST(attr%,2) attr.system!=TRUE ENDIF IF BTST(attr%,3) attr.label!=TRUE ENDIF IF BTST(attr%,4) attr.folder!=TRUE ENDIF IF BTST(attr%,5) attr.archive!=TRUE ENDIF ENDIF RETURN ' ********** ' > PROCEDURE set.file.attributes(set.file$,read.only!,hidden!,system!,archive!) ' *** set file-attributes of file LOCAL path$,path%,attr,a%,k path$=set.file$+CHR$(0) attr=0 IF read.only! attr=BSET(attr,0) ENDIF IF hidden! attr=BSET(attr,1) ENDIF IF system! attr=BSET(attr,2) ENDIF IF archive! attr=BSET(attr,5) ENDIF a%=GEMDOS(&H43,L:path%,1,attr) IF a%=-33 ALERT 3," *** file-error ***| |"+set.file$+"|not found",1," OK ",k ELSE IF a%=-34 ALERT 3," *** path-error ***| |"+set.file$+"|not found",1," OK ",k ENDIF RETURN ' ********** ' > PROCEDURE scrap.write(txt$) ' *** send message (<160 bytes) through scrap-library ' *** receiving program uses Procedure Scrap.read LOCAL buffer$,r%,m$,k buffer$=SPACE$(160) txt$=txt$+CHR$(0) LSET buffer$=txt$ r%=SCRP_WRITE(buffer$) IF r%=0 m$="scrap-library| |*** error ***" ALERT 3,m$,1,"EDIT",k EDIT ENDIF RETURN ' *********** ' > PROCEDURE scrap.read(VAR txt$) ' *** read scrap-library LOCAL buffer$,r%,m$,k buffer$=SPACE$(160) r%=SCRP_READ(buffer$) IF r%=0 m$="scrap-library| |*** error ***" ALERT 3,m$,1,"EDIT",k EDIT ENDIF txt$=CHAR{V:buffer$} RETURN ' ********** ' > PROCEDURE fileselect(path$,default$,txt$,left$,right$,VAR file$) ' *** use Fileselector with comment-line in High or Medium resolution ' *** print optional title (light text) to the left and right of Fileselector ' *** comment-line max. 38 characters ' *** uses Standard Function and Globals LOCAL screen$,y.fac SGET screen$ ! delete if not necessary CLS IF high.res! y.fac=1 ELSE y.fac=2 ENDIF DEFTEXT black,2,900,32 TEXT 100,350/y.fac,300/y.fac,left$ DEFTEXT ,,2700 TEXT 540,50/y.fac,300/y.fac,right$ DEFTEXT ,0,0,13 PRINT AT(1,3);@center$(txt$) GRAPHMODE 3 DEFFILL 1,1 ! black BOUNDARY 0 IF high.res! BOX 157,25,482,54 PLOT 157,25 PBOX 159,27,480,52 ELSE BOX 157,12,482,27 PLOT 157,12 PBOX 160,14,479,24 ENDIF BOUNDARY 1 GRAPHMODE 1 FILESELECT path$,default$,file$ SPUT screen$ ! delete if not necessary RETURN ' ********** ' > PROCEDURE fileselect.low(path$,default$,txt$,VAR file$) ' *** use Fileselector with comment-line in Low-resolution ' *** comment-line max. 38 characters ' *** uses Standard Function and Globals LOCAL screen$ SGET screen$ ! delete if not necessary CLS PRINT AT(1,3);@center$(txt$) GRAPHMODE 3 DEFFILL 1,1 ! black BOUNDARY 0 BOX 0,12,319,27 PLOT 0,12 PBOX 2,14,317,24 BOUNDARY 1 GRAPHMODE 1 FILESELECT path$,default$,file$ SPUT screen$ ! delete if not necessary RETURN ' ********** ' ' ******************** ' *** FUNCTION.LST *** ' ******************** ' DEFWRD "a-z" ' FUNCTION before$(source$,target$) ' *** returns part of source$ before target$ ' *** returns complete source$ if no target$ found LOCAL p p=INSTR(source$,target$) IF p=0 RETURN source$ ELSE RETURN LEFT$(source$,p-1) ENDIF ENDFUNC ' ********** ' FUNCTION after$(source$,target$) ' *** returns part of source$ after target$ ' *** returns nullstring if no target$ found LOCAL p p=INSTR(source$,target$) IF p=0 RETURN "" ELSE RETURN MID$(source$,p+LEN(target$)) ENDIF ENDFUNC ' ********** ' FUNCTION intel.word(x%) ' *** swap low byte and high byte of word (to/from Intel-format) RETURN CARD(ROR&(x%,8)) ENDFUNC ' ********** ' FUNCTION digital$(number$) ' *** return number with LCD-digits (ASCII-codes 16-25) ' *** use as : TEXT x,y,@digital$("1237") LOCAL dig$,i CLR dig$ FOR i=1 TO LEN(number$) dig$=dig$+CHR$(BCLR(ASC(MID$(number$,i,1)),5)) NEXT i RETURN dig$ ENDFUNC ' ********** ' FUNCTION multiple(n%,fac) ' *** returns smallest multiple of fac n% (n%>0) LOCAL m m=MOD(n%,fac) IF m>0 RETURN n%+fac-m ELSE RETURN n% ENDIF ENDFUNC ' ********** ' FUNCTION lower$(t$) ' *** converts all upper case letters in t$ to lower case LOCAL i,a%,c| adr%=V:t$ FOR i=0 TO PRED(LEN(t$)) a%=ADD(adr%,i) c|=BYTE{a%} IF c|>=65 AND c|<=90 BYTE{a%}=BSET(c|,5) ENDIF NEXT i RETURN t$ ENDFUNC ' ****************** ' *** GRAPH1.LST *** ' ****************** ' DEFWRD "a-z" ' > PROCEDURE click.point(txt$,VAR x,y) ' *** choose point (x,y) with mouse-click ' *** uses Procedure Message.on and Message.off LOCAL x1,y1,x2,y2,k DEFMOUSE 3 SHOWM @message.on(txt$) x1=MOUSEX y1=MOUSEY REPEAT MOUSE x2,y2,k UNTIL x2<>x1 OR y2<>y1 @message.off REPEAT UNTIL MOUSEK ! wait for click x=MOUSEX y=MOUSEY HIDEM DEFMOUSE 0 PAUSE 10 ! short pause for release of button RETURN ' ********** ' > PROCEDURE rubber.line(x,y,VAR x2,y2) ' *** draw line from point (x,y) to position of mouse (x2,y2) ' *** confirm with mouse-click ' *** uses Procedure Message.on and Message.off LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k GRAPHMODE 3 @message.on("draw line (confirm with click)") DEFMOUSE 3 SHOWM mx1=MOUSEX my1=MOUSEY REPEAT MOUSE mx2,my2,k UNTIL mx2<>mx1 OR my2<>my1 @message.off MOUSE x1,y1,k REPEAT LINE x,y,x1,y1 REPEAT MOUSE x2,y2,k UNTIL x2<>x1 OR y2<>y1 OR k>0 LINE x,y,x1,y1 x1=x2 y1=y2 UNTIL k>0 GRAPHMODE 1 LINE x,y,x2,y2 HIDEM DEFMOUSE 0 PAUSE 10 RETURN ' ********** ' > PROCEDURE draw.line(VAR x1,y1,x2,y2) ' *** draw line ' *** uses Procedure Click.point and Rubber.line @click.point("click on starting point of line",x1,y1) @rubber.line(x1,y1,x2,y2) RETURN ' ********** ' > PROCEDURE rubber.box(x,y,VAR width,heigth) ' *** draw rectangle (left upper corner already chosen) ' *** uses Procedure Message.on and Message.off LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k GRAPHMODE 3 @message.on("draw rectangle (confirm with click)") mx1=MOUSEX my1=MOUSEY REPEAT MOUSE mx2,my2,k UNTIL mx2<>mx1 OR my2<>my1 @message.off MOUSE x1,y1,k REPEAT BOX x,y,x1,y1 PLOT x,y REPEAT MOUSE x2,y2,k UNTIL (x2<>x1 AND x2>x) OR (y2<>y1 AND y2>y) OR k>0 BOX x,y,x1,y1 PLOT x,y x1=x2 y1=y2 UNTIL k>0 GRAPHMODE 1 BOX x,y,x2,y2 width=x2-x height=y2-y PAUSE 10 RETURN ' ********** ' > PROCEDURE draw.box(VAR x,y,width,height) ' *** draw rectangle ' *** uses Procedure Click.point and Rubber.box LOCAL x1,y1,width,height @click.point("click on left upper corner of rectangle",x,y) @rubber.box(x,y,width,height) RETURN ' ********** ' > PROCEDURE rubber.square(x,y,VAR width) ' *** draw square (left upper corner already chosen) ' *** uses Procedure Message.on and Message.off LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k,side GRAPHMODE 3 HIDEM @message.on("draw square (confirm with click)") mx1=MOUSEX my1=MOUSEY REPEAT MOUSE mx2,my2,k UNTIL mx2<>mx1 OR my2<>my1 @message.off MOUSE x1,y1,k REPEAT IF (x1-x)>(y1-y) side=x1-x ELSE side=y1-y ENDIF BOX x,y,x+side,y+side PLOT x,y REPEAT MOUSE x2,y2,k UNTIL (x2<>x1 AND x2>x) OR (y2<>y1 AND y2>y) OR k>0 BOX x,y,x+side,y+side PLOT x,y x1=x2 y1=y2 UNTIL k>0 GRAPHMODE 1 BOX x,y,x+side,y+side width=side PAUSE 10 RETURN ' ********** ' > PROCEDURE draw.square(VAR x,y,width) ' *** draw square ' *** uses Procedure Click.point and Rubber.square @click.point("click on left upper corner of square",x,y) @rubber.square(x,y,width) RETURN ' ********** ' > PROCEDURE drag.box(width,height,VAR x,y) ' *** drag rectangle ' *** place rectangle after mouse-click ' *** uses Procedure Message.on and Message.off LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k GRAPHMODE 3 HIDEM @message.on("drag rectangle (place with click)") mx1=MOUSEX my1=MOUSEY REPEAT MOUSE mx2,my2,k UNTIL mx2<>mx1 OR my2<>my1 @message.off MOUSE x1,y1,k REPEAT BOX x1,y1,x1+width,y1+height PLOT x1,y1 REPEAT MOUSE x2,y2,k UNTIL x2<>x1 OR y2<>y1 OR k>0 BOX x1,y1,x1+width,y1+height PLOT x1,y1 x1=x2 y1=y2 UNTIL k>0 GRAPHMODE 1 BOX x2,y2,x2+width,y2+height x=x2 y=y2 PAUSE 10 RETURN ' ********** ' > PROCEDURE move.box(width,height,x1,y1,x2,y2) ' *** move rectangle from x1,y1 to x2,y2 LOCAL x,y GRAPHMODE 3 IF x1=y2 @p2 ELSE IF x1>=x2 AND y1 PROCEDURE p1 FOR x=x1 TO x2 BOX x,y1,x+width,y1+height BOX x,y1,x+width,y1+height NEXT x FOR y=y1 TO y2 BOX x,y,x+width,y+height BOX x,y,x+width,y+height NEXT y RETURN ' *** > PROCEDURE p2 FOR x=x1 TO x2 BOX x,y1,x+width,y1+height BOX x,y1,x+width,y1+height NEXT x FOR y=y1 DOWNTO y2 BOX x,y,x+width,y+height BOX x,y,x+width,y+height NEXT y RETURN ' *** > PROCEDURE p3 FOR x=x1 DOWNTO x2 BOX x,y1,x+width,y1+height BOX x,y1,x+width,y1+height NEXT x FOR y=y1 TO y2 BOX x,y,x+width,y+height BOX x,y,x+width,y+height NEXT y RETURN ' *** > PROCEDURE p4 FOR x=x1 DOWNTO x2 BOX x,y1,x+width,y1+height BOX x,y1,x+width,y1+height NEXT x FOR y=y1 DOWNTO y2 BOX x,y,x+width,y+height BOX x,y,x+width,y+height NEXT y RETURN ' ********** ' > PROCEDURE grow.box(width,height,x,y,pause) ' *** draw 'growing' rectangle ' *** pause determines grow-speed LOCAL x1,y1,l,step.x,step.y,n,delta.x,delta.y GRAPHMODE 3 x1=x+width/2 y1=y+height/2 l=MIN(height/2,width/2) step.x=(width/2)/l step.y=(height/2)/l FOR n=1 TO l delta.x=n*step.x delta.y=n*step.y BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y PLOT x1-delta.x,y1-delta.y PAUSE pause BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y PLOT x1-delta.x,y1-delta.y NEXT n GRAPHMODE 1 BOX x,y,x+width,y+height RETURN ' ********** ' > PROCEDURE shrink.box(width,height,x,y,pause) ' *** draw 'shrinking' rectangle ' *** pause determines shrink-speed LOCAL x1,y1,l,step.x,step.y,n,delta.x,delta.y GRAPHMODE 3 x1=x+width/2 y1=y+height/2 l=MIN(height/2,width/2) step.x=(width/2)/l step.y=(height/2)/l BOX x,y,x+width,y+height PLOT x,y BOX x,y,x+width,y+height PLOT x,y FOR n=l DOWNTO 1 delta.x=n*step.x delta.y=n*step.y BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y PLOT x1-delta.x,y1-delta.y PAUSE pause BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y PLOT x1-delta.x,y1-delta.y NEXT n GRAPHMODE 1 RETURN ' ********** ' ' ****************** ' *** GRAPH2.LST *** ' ****************** ' DEFWRD "a-z" ' > PROCEDURE clip.rectangle(VAR rectangle$,x,y) ' *** cut rectangle (GET-string) from screen ' *** returns left upper corner (x,y) as well ' *** uses Procedure Click.point, Message.on and Message.off LOCAL clp.x2,clp.y2,x1,y1,mx,my,x2,y2,k @click.point("click on left upper corner of rectangle",x,y) @message.on("choose rectangle (confirm with click)") x1=MOUSEX y1=MOUSEY REPEAT MOUSE mx,my,k UNTIL mx<>x1 OR my<>y1 @message.off GRAPHMODE 3 MOUSE x2,y2,k REPEAT BOX x,y,x2,y2 PLOT x,y REPEAT MOUSE clp.x2,clp.y2,k UNTIL (clp.x2<>x2 AND clp.x2>x) OR (clp.y2<>y2 AND clp.y2>y) OR k>0 BOX x,y,x2,y2 PLOT x,y x2=clp.x2 y2=clp.y2 UNTIL k>0 GRAPHMODE 1 GET x,y,clp.x2,clp.y2,rectangle$ PAUSE 10 ! short pause for release of button RETURN ' ********** ' > PROCEDURE drag.clip ' *** drag GET-rectangle on screen ' *** original rectangle is not erased ' *** uses Procedure Clip.rectangle, Click.point, Message.on and Message.off LOCAL dx1,dy1,k,dx2,dy2,clip$ @clip.rectangle(clip$,dx1,dy1) @message.on("move rectangle (place with click)") SETMOUSE dx1,dy1 REPEAT MOUSE dx,dy,k UNTIL dx<>dx1 OR dy<>dy1 @message.off HIDEM MOUSE dx1,dy1,k REPEAT PUT dx1,dy1,clip$,6 REPEAT MOUSE dx2,dy2,k UNTIL dx2<>dx1 OR dy2<>dy1 OR k>0 PUT dx1,dy1,clip$,6 dx1=dx2 dy1=dy2 UNTIL k>0 PUT dx1,dy1,clip$,3 PAUSE 10 RETURN ' ********** ' > PROCEDURE load.clip(clip.file$,VAR clip$) ' *** load GET-rectangle from file and PUT on screen ' *** GET-rectangle saved with : BSAVE file$,V:pic$,LEN(pic$) ' *** use extension .PUT for these files ' *** uses Standard Global Variables LOCAL bytes,bit.planes,m$,k IF EXIST(clip.file$) OPEN "I",#90,clip.file$ bytes=LOF(#90) CLOSE #90 clip$=SPACE$(bytes) BLOAD clip.file$,VARPTR(clip$) bit.planes=DPEEK(VARPTR(clip$)+4) SELECT bit.planes CASE 1 IF NOT high.res! m$="PUT-picture|suitable for|High resolution|only ???" ALERT 3,m$,1,"EDIT",k EDIT ENDIF CASE 2 IF NOT med.res! m$="PUT-picture|suitable for|Medium resolution|only ???" ALERT 3,m$,1,"EDIT",k EDIT ENDIF CASE 4 IF NOT low.res! m$="PUT-picture|suitable for|Low resolution|only ???" ALERT 3,m$,1,"EDIT",k EDIT ENDIF ENDSELECT ELSE m$=clip.file$+"| |not found !?" ALERT 3,m$,1,"EDIT",k EDIT ENDIF RETURN ' ********** ' > PROCEDURE initio.picture ' *** draw picture on invisible logical screen and save in GET-string ' *** you probably should draw in a BOX ' *** the origin (left upper corner) is the point 0,0 ' *** the following commands (with parameters) are allowed in DATA-lines : ' *** DEFLINE , DEFTEXT , LINE , DRAW , BOX , RBOX , TEXT , END ' *** DRAW-format : DATA DRAW,number_of_points,x1,y1,x2,y2,x3,y3,etc. ' *** last DATA-line : END ' *** normal picture on screen : PUT x,y,picture$,3 ' *** reverse picture on screen : PUT x,y,picture$,12 (don't use RBOX)) ' ' *** uses Procedure Initio.logical.screen etc. ' @initio.logical.screen ' ' *** here is an example of the different commands test.picture: DATA BOX,0,0,100,50 DATA DEFTEXT,1,0,900,8 DATA TEXT,9,45,test DATA DEFTEXT,1,0,2700,8 DATA TEXT,90,5,test DATA LINE,0,0,100,50 DATA DRAW,4,50,10,75,45,25,45,50,10 DATA END RESTORE test.picture @initio.draw.picture(test.picture$) ' @restore.physical.screen RETURN ' *** > PROCEDURE initio.draw.picture(VAR pic$) ' *** draw on invisible logical screen and put in GET-string LOCAL command$,s,w,b,e,c,s,angle,h,x1,y1,x2,y2 LOCAL points,n,x,y,txt$,max.width,max.height CLS REPEAT READ command$ command$=UPPER$(command$) IF command$="DEFLINE" READ s,w,b,e DEFLINE s,w,b,e ENDIF IF command$="DEFTEXT" READ c,s,angle,h DEFTEXT c,s,angle,h ENDIF IF command$="LINE" READ x1,y1,x2,y2 LINE x1,y1,x2,y2 @max.width.height ENDIF IF command$="DRAW" READ points,x1,y1 PLOT x1,y1 @max.width.height FOR n=1 TO points-1 READ x2,y2 DRAW TO x2,y2 @max.width.height NEXT n ENDIF IF command$="BOX" READ x1,y1,x2,y2 BOX x1,y1,x2,y2 @max.width.height ENDIF IF command$="RBOX" READ x1,y1,x2,y2 RBOX x1,y1,x2,y2 @max.width.height ENDIF IF command$="TEXT" ' *** correct size of text is not tested ! READ x,y,txt$ TEXT x,y,txt$ IF angle=0 x2=x+LEN(txt$)*h/2 y2=y ENDIF IF angle=900 x2=x y2=y ENDIF IF angle=2700 x2=x+h y2=y+LEN(txt$)*h/2 ENDIF @max.width.height ENDIF UNTIL command$="END" GET 0,0,width.max,height.max,pic$ RETURN ' *** > PROCEDURE max.width.height width.max=MAX(width.max,x1) height.max=MAX(height.max,y1) width.max=MAX(width.max,x2) height.max=MAX(height.max,y2) RETURN ' ********** ' > PROCEDURE cube(x,y,w,color,fill) ' *** draw cube (left upper corner x,y; fill=fillpattern) ' *** color of edges and pattern is the same LOCAL d,e d=w/3 e=w+d ERASE cube.x(),cube.y() DIM cube.x(6),cube.y(6) cube.x(0)=x cube.x(1)=x cube.x(2)=x+d cube.x(3)=x+e cube.x(4)=x+e cube.x(5)=x+w cube.x(6)=x cube.y(0)=y cube.y(1)=y+w cube.y(2)=y+e cube.y(3)=y+e cube.y(4)=y+d cube.y(5)=y cube.y(6)=y DEFFILL color,2,fill POLYFILL 7,cube.x(),cube.y() COLOR color DRAW x,y+w TO x+w,y+w TO x+w,y DRAW x+w,y+w TO x+e,y+e RETURN ' ********** ' > PROCEDURE mirror(get.pic$,mode,VAR mir.pic$) ' *** make mirror-image of GET-string ' *** mode : 0=vertical 1=horizontal LOCAL adr%,pic1%,pic2%,w,h,words,bit_rest ' ' *** load MIRROR.INL (238 bytes) here INLINE mirror%,238 ' IF DIM?(mir%())=0 DIM mir%(16) ENDIF mir.pic$=get.pic$ pic2%=ADD(V:mir.pic$,6) adr%=V:get.pic$ pic1%=ADD(adr%,6) w=SUCC(WORD{adr%}) ! width (pixels) words=INT(ADD(w,15)/16) ! width (words) bit_rest=SUB(MUL(words,16),w) ! ignore these bits of last word of line mir%(0)=words mir%(1)=SUCC(WORD{ADD(adr%,2)}) ! height mir%(2)=bit_rest mir%(3)=mode mir%(8)=pic1% ! source mir%(9)=pic2% ! destination RCALL mirror%,mir%() RETURN ' ********** ' ' ****************** ' *** INITIO.LST *** ' ****************** ' DEFWRD "a-z" ' > PROCEDURE coldstart ' *** cold (= hard) reset ' *** same as turning your computer off and on, but faster SLPOKE &H420,0 SLPOKE &H426,0 ! probably not necessary SLPOKE &H43A,0 ~XBIOS(38,L:LPEEK(4)) RETURN ' ********** ' > PROCEDURE warmstart ' *** warm (= soft) reset, probably only suitable after switching resolutions ' *** tables in low memory (< &H93A) are not cleared ' *** same as pressing Reset-button on your computer ~XBIOS(38,L:LPEEK(4)) RETURN ' ********** ' > PROCEDURE initio.system ' *** initialise global system-variables ' *** global : START.OS% DISK.TOS! NORMAL.ST! MEGA.ST! DRIVE!() FLOPS ' *** WRITE.PROTECTED!() RAM.END% RAM.520! RAM.1M! RAM.2M! RAM.4M! ' *** ST.512! ST.1040! HARD.DISK! DRIVE DRIVE$ FREE.BYTES% LOCAL d,n,st.type ' start.os%=LPEEK(&H4F2) ' IF PEEK(start.os%)<>&H60 disk.tos!=TRUE ENDIF IF DPEEK(start.os%)=&H601E normal.st!=TRUE ELSE mega.st!=TRUE ENDIF ' DIM drive!(16) ! Drive!(1) = drive A, etc. SELECT DPEEK(&H4A6) ! first check if two drives connected CASE 1 drive!(1)=TRUE CASE 2 drive!(1)=TRUE drive!(2)=TRUE ENDSELECT FOR n=2 TO 15 IF BTST(BIOS(10),n) drive!(n+1)=TRUE ENDIF NEXT n ' flops=PEEK(&H4A6) ! number of floppy drives (0-2); RAM-disks not counted ' DIM write.protected!(15) ! (only checked for drive A) FOR n=0 TO 15 IF drive!(n+1) IF normal.st! LET write.protected!(n)=(PEEK(&H9B2+n)=255) ELSE LET write.protected!(n)=(PEEK(&H9F8+n)=255) ENDIF ENDIF NEXT n ' ram.end%=LPEEK(&H42E)-1 IF ram.end%=&H7FFFF ram.520!=TRUE ENDIF IF ram.end%=&HFFFFF ram.1m!=TRUE ENDIF IF ram.end%=&H1FFFFF ram.2m!=TRUE ENDIF IF ram.end%=&H3FFFFF ram.4m!=TRUE ENDIF ' st.type=PEEK(&H424) IF st.type=4 st.512!=TRUE ENDIF IF st.type=5 st.1040!=TRUE ENDIF ' IF PEEK(&H472)<>0 hard.disk!=TRUE ENDIF ' drive=GEMDOS(&H19) drive$=CHR$(65+drive) ' free.bytes%=FRE(0) ' RETURN ' ********** ' > PROCEDURE keyboard.version ' *** examines keyboard-version, returns country ' *** global : USA.KEYBRD! ENGLISH.KEYBRD! GERMAN.KEYBRD! FRENCH.KEYBRD! SELECT PEEK(LPEEK(XBIOS(16,L:-1,L:-1,L:-1))+&H2B) CASE &H5C usa.keybrd!=TRUE CASE &H23 english.keybrd!=TRUE CASE &H7E german.keybrd!=TRUE CASE &H40 french.keybrd!=TRUE ENDSELECT RETURN ' ********** ' > PROCEDURE initio.cursor ' *** VT52 control codes (for TOS-screen, not to be used in a window !) ' *** see also DEFFN.LST cur.up$=CHR$(27)+"A" ! cursor up cur.dwn$=CHR$(27)+"B" ! cursor down cur.rgt$=CHR$(27)+"C" ! cursor right cur.lft$=CHR$(27)+"D" ! cursor left cur.home$=CHR$(27)+"H" ! home cursor (1,1) scroll.dwn$=CHR$(27)+"I" ! scroll screen 1 line down cur.cls$=CHR$(27)+"J" ! clear screen from position of cursor cls.cur$=CHR$(27)+"d" ! clear screen to position of cursor cll$=CHR$(27)+"l" ! clear line (cursor to start of cleared line) del.line$=CHR$(27)+"M" ! delete line (add new line at bottom of screen) ins.line$=CHR$(27)+"L" ! insert line cur.cll$=CHR$(27)+"K" ! clear line from position of cursor cll.cur$=CHR$(27)+"o" ! clear line to position of cursor cur.on$=CHR$(27)+"e" ! cursor visible cur.off$=CHR$(27)+"f" ! cursor invisible (still controllable) get.cur$=CHR$(27)+"j" ! save cursor-position put.cur$=CHR$(27)+"k" ! put cursor on saved position rev.on$=CHR$(27)+"p" ! reverse on rev.off$=CHR$(27)+"q" ! reverse off wrap.on$=CHR$(27)+"v" ! wrap on wrap.off$=CHR$(27)+"w" ! wrap off (chop off lines longer than screen-width) RETURN ' ********** ' > PROCEDURE initio.ascii.code ' *** ASCII-codes ' bel$=CHR$(7) lf$=CHR$(10) vt$=CHR$(11) ff$=CHR$(12) qt$=CHR$(34) ' return$=CHR$(13) enter$=CHR$(13) esc$=CHR$(27) delete$=CHR$(127) backspace$=CHR$(8) bs$=CHR$(8) tab$=CHR$(9) ' help$=CHR$(0)+CHR$(98) undo$=CHR$(0)+CHR$(97) insert$=CHR$(0)+CHR$(82) clr.home$=CHR$(0)+CHR$(71) arr.lft$=CHR$(0)+CHR$(75) arr.rgt$=CHR$(0)+CHR$(77) arr.up$=CHR$(0)+CHR$(72) arr.dwn$=CHR$(0)+CHR$(80) ' ' function-keys : see DEFFN.LST ' RETURN ' ********** ' > PROCEDURE initio.sprite1 ' *** make sprite Sprite1$ (use Initio.sprite2 with DATA for Sprite2$, etc.) ' *** global : SPRITE1$ ' *** uses Standard-Array color.index() ' RESTORE pattern.sprite1 @make.sprite(sprite1$) ' pattern.sprite1: ' *** x,y,mode(0=normal;1=XOR),mask-color,sprite-color DATA 0,0,0,0,1 ' *** mask-pattern (1 = pixel on , 0 = pixel off) DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 ' *** sprite-pattern DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN ' *** > PROCEDURE make.sprite(VAR s$) ' *** construct sprite-string from DATA LOCAL x,y,mode,msk.color,spr.color,n,msk%,spr%,msk.pat$,spr.pat$ LOCAL msk$,spr$,pat$ CLR msk.pat$,spr.pat$,pat$ READ x,y,mode,msk.color,spr.color FOR n=1 TO 16 READ msk$ msk%=VAL("&X"+msk$) msk.pat$=msk.pat$+MKI$(msk%) NEXT n FOR n=1 TO 16 READ spr$ spr%=VAL("&X"+spr$) spr.pat$=spr.pat$+MKI$(spr%) NEXT n FOR n=1 TO 16 pat$=pat$+MID$(msk.pat$,n*2-1,2)+MID$(spr.pat$,n*2-1,2) NEXT n s$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color)) s$=s$+MKI$(color.index(spr.color))+pat$ RETURN ' ********** ' > PROCEDURE initio.mouse1 ' *** make mouse-cursor Mouse1$ (use Initio.mouse2 with DATA for Mouse2$,etc.) ' *** uses Standard-Array color.index() ' *** global : MOUSE1$ ' RESTORE pattern.mouse1 @make.mouse(mouse1$) ' pattern.mouse1: ' *** x,y,mode(0=normal;1=XOR),mask-color,mouse-color DATA 0,0,0,0,1 ' *** mask-pattern (1 = pixel on , 0 = pixel off) DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 ' *** mouse-pattern DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN ' *** > PROCEDURE make.mouse(VAR m$) ' *** construct mouse-string from DATA LOCAL x,y,mode,msk.color,mouse.color,n,msk%,mouse%,msk.pat$,mouse.pat$ LOCAL msk$,mouse$,pat$ CLR msk.pat$,mouse.pat$,pat$ READ x,y,mode,msk.color,mouse.color FOR n=1 TO 16 READ msk$ msk%=VAL("&X"+msk$) msk.pat$=msk.pat$+MKI$(msk%) NEXT n FOR n=1 TO 16 READ mouse$ LET mouse%=VAL("&X"+mouse$) LET mouse.pat$=mouse.pat$+MKI$(mouse%) NEXT n m$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color)) m$=m$+MKI$(color.index(mouse.color))+msk.pat$+mouse.pat$ RETURN ' ********** ' > PROCEDURE initio.mouse ' *** mouse-cursor arrow.mouse=0 x.mouse=1 bee.mouse=2 finger.mouse=3 hand.mouse=4 thin.cross.mouse=5 fat.cross.mouse=6 LET open.cross.mouse=7 l.button=1 ! mouse-buttons r.button=2 both.buttons=3 no.button=0 RETURN ' ********** ' > PROCEDURE initio.fill1(VAR pattern$) ' *** FILL-pattern for High (32 bytes), Medium (64) or Low (128) resolution LOCAL bytes bytes=32 ! 32 bytes for High resolution ' ' *** load Fill-pattern (32 bytes for High resolution) here INLINE fill1%,32 ' pattern$=STRING$(bytes,0) BMOVE fill1%,V:pattern$,bytes DEFFILL ,pattern$ RETURN ' ********** ' > PROCEDURE initio.high.fill1 ' *** fill-pattern for High-resolution (also suitable for Medium and Low) ' *** patterns always have a format of 16x16 pixels ' *** global : FILL1$ ' RESTORE high.fill1 @make.high.fill(fill1$) ' high.fill1: ' *** use index 0 or 1 (0=background) ; switch editor to Overwrite-mode DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN ' *** > PROCEDURE make.high.fill(VAR fill$) LOCAL i,pat$,pat% CLR fill$ FOR i=1 TO 16 READ pat$ pat%=VAL("&X"+pat$) fill$=fill$+MKI$(pat%) NEXT i RETURN ' ********** ' > PROCEDURE initio.med.fill1 ' *** fill-pattern for Medium resolution (also suitable for Low resolution) ' *** global : FILL1$ ' RESTORE med.fill1 @make.med.fill(fill1$) ' med.fill1: ' *** use index 0-3 (0=background-color) ; switch editor to Overwrite-mode ' *** (this index is the 'SETCOLOR'-index, not the VDI color-index !!) DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN ' *** > PROCEDURE make.med.fill(VAR fill$) LOCAL i,j,pat$,plane0%,plane1%,plane0$,plane1$ CLR fill$,plane0$,plane1$ FOR i=1 TO 16 READ pat$ CLR plane0%,plane1% FOR j=1 TO 16 SELECT VAL(MID$(pat$,j,1)) CASE 1 plane0%=BSET(plane0%,SUB(16,j)) CASE 2 plane1%=BSET(plane1%,SUB(16,j)) CASE 3 plane0%=BSET(plane0%,SUB(16,j)) plane1%=BSET(plane1%,SUB(16,j)) ENDSELECT NEXT j plane0$=plane0$+MKI$(plane0%) plane1$=plane1$+MKI$(plane1%) NEXT i fill$=plane0$+plane1$ RETURN ' ********** ' > PROCEDURE initio.low.fill1 ' *** fill-pattern for Low resolution only ' *** global : FILL1$ ' RESTORE low.fill1 @make.low.fill(fill1$) ' low.fill1: ' *** use index 0-F (0=background-color) ; switch editor to Overwrite-mode ' *** (this index is the 'SETCOLOR'-index, not the VDI color-index !!) ' *** 0-F means you can use : 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F (16 colors) DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN ' *** > PROCEDURE make.low.fill(VAR fill$) LOCAL i,j,pat$,plane0%,plane1%,plane2%,plane3%,byte| LOCAL plane0$,plane1$,plane2$,plane3$ CLR fill$,plane0$,plane1$,plane2$,plane3$ FOR i=1 TO 16 READ pat$ CLR plane0%,plane1%,plane2%,plane3% FOR j=1 TO 16 byte|=VAL("&H"+MID$(pat$,j,1)) IF BTST(byte|,0) plane0%=BSET(plane0%,SUB(16,j)) ENDIF IF BTST(byte|,1) plane1%=BSET(plane1%,SUB(16,j)) ENDIF IF BTST(byte|,2) plane2%=BSET(plane2%,SUB(16,j)) ENDIF IF BTST(byte|,3) plane3%=BSET(plane3%,SUB(16,j)) ENDIF NEXT j plane0$=plane0$+MKI$(plane0%) plane1$=plane1$+MKI$(plane1%) plane2$=plane2$+MKI$(plane2%) plane3$=plane3$+MKI$(plane3%) NEXT i fill$=plane0$+plane1$+plane2$+plane3$ RETURN ' ********** ' > PROCEDURE initio.pattern ' *** fill-pattterns hollow.fill=0 solid.fill=1 pattern.fill=2 hatch.fill=3 RETURN ' ********** ' > PROCEDURE initio.line ' *** start/end of lines ; lines normal.line.end=0 arrow.line.end=1 rounded.line.end=2 ' *** normal.line=1 dash.line=2 point.line=3 RETURN ' ********** ' > PROCEDURE initio.mark ' *** mark-symbols point.mark=1 plus.mark=2 star.mark=3 rectangle.mark=4 cross.mark=5 diamond.mark=6 RETURN ' ********** ' > PROCEDURE initio.txt ' *** text-stiles ; text-rotation txt.normal=0 txt.bold=1 txt.light=2 txt.ital=4 txt.uline=8 txt.outline=16 ' *** txt.0=0 txt.90=900 txt.180=1800 txt.270=2700 RETURN ' ********** ' > PROCEDURE initio.graph ' *** GRAPHMODE-modes graph.replace=1 graph.transp=2 graph.xor=3 graph.rev.tr=4 RETURN ' ********** ' > PROCEDURE initio.alert ' *** Alert-symbols empty.alert=0 note.alert=1 wait.alert=2 stop.alert=3 RETURN ' ********** ' ' ***************** ' *** INPUT.LST *** ' ***************** ' DEFWRD "a-z" ' > PROCEDURE yes.no.input ' *** choose between YES and NO ' *** YES = of of or left mouse-button ' *** NO = of of right mouse-button ' *** global : YES! NO! LOCAL x,y,in$,w1$,w2$,k CLR yes!,no!,in$,k HIDEM x=CRSCOL y=CRSLIN w1$="(y/n)" w2$=SPACE$(5) REPEAT ! clear key-buffer in$=INKEY$ UNTIL in$="" PRINT AT(x,y);w1$; REPEAT PAUSE 30 SWAP w1$,w2$ PRINT AT(x,y);w1$; k=MOUSEK in$=INKEY$ UNTIL INSTR("yYnN"+CHR$(13),in$) OR k>0 IF INSTR("yY"+CHR$(13),in$) OR k=1 yes!=TRUE PRINT AT(x,y);"YES "; ELSE no!=TRUE PRINT AT(x,y);"NO "; ENDIF PAUSE 10 ! short pause for release of button RETURN ' ********** ' > PROCEDURE pos.number.input(len,VAR number#) ' *** geformatteerde input van positieve getallen LOCAL x,y,in$,txt$,enter! HIDEM x=CRSCOL y=CRSLIN LET field$=STRING$(len,".") PRINT LEFT$("_"+field$,len); REPEAT REPEAT in$=INKEY$ UNTIL LEN(in$)=1 IF in$=CHR$(13) enter!=TRUE ENDIF IF in$=backspace$ IF LEN(txt$)>0 txt$=LEFT$(txt$,LEN(txt$)-1) ELSE OUT 2,7 ENDIF ENDIF IF LEN(txt$) PROCEDURE pos.integer.input(len,VAR number%) ' *** geformatteerde input van positieve integers LOCAL x,y,in$,txt$,enter! HIDEM x=CRSCOL y=CRSLIN LET field$=STRING$(len,".") PRINT LEFT$("_"+field$,len); REPEAT REPEAT in$=INKEY$ UNTIL LEN(in$)=1 IF in$=CHR$(13) enter!=TRUE ENDIF IF in$=backspace$ IF LEN(txt$)>0 txt$=LEFT$(txt$,LEN(txt$)-1) ELSE OUT 2,7 ENDIF ENDIF IF LEN(txt$) PROCEDURE text.input(default$,len,VAR txt$) ' *** geformatteerde input van tekst LOCAL x,y,in$,code$,enter! HIDEM x=CRSCOL y=CRSLIN LET field$=STRING$(len,".") txt$=default$ PRINT AT(x,y);LEFT$(txt$+"_"+field$,len); GRAPHMODE 3 BOX (x-1)*8-2,(y-1)*char.height-2,(x-1)*8+len*8+2,y*char.height+2 PLOT (x-1)*8-2,(y-1)*char.height-2 GRAPHMODE 1 DO REPEAT in$=INKEY$ UNTIL in$<>"" EXIT IF in$=CHR$(13) IF in$=backspace$ IF LEN(txt$)>0 txt$=LEFT$(txt$,LEN(txt$)-1) ELSE OUT 2,7 ENDIF ENDIF IF in$=esc$ txt$="" ENDIF IF ASC(in$)=1 ! voor invoer speciale karakters code$=INPUT$(3) ! ASCII-code (3 cijfers !!) in$=CHR$(VAL(code$)) ENDIF IF LEN(txt$)=CHR$(32) AND LEN(in$)=1 txt$=txt$+in$ ELSE IF in$<>esc$ AND in$<>backspace$ OUT 2,7 ENDIF ENDIF PRINT AT(x,y);LEFT$(txt$+"_"+field$,len); LOOP GRAPHMODE 3 BOX (x-1)*8-2,(y-1)*char.height-2,(x-1)*8+len*8+2,y*char.height+2 PLOT (x-1)*8-2,(y-1)*char.height-2 GRAPHMODE 1 PRINT AT(x,y);txt$;SPACE$(len-LEN(txt$)); RETURN ' ********** ' ' *************** ' *** KEY.LST *** ' *************** ' DEFWRD "a-z" ' > PROCEDURE return.key ' *** wait for ' *** after pressing any other key, flashing 'RETURN' is turned off ' *** uses Standard-Globals LOCAL w1$,w2$,temp$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 ! restore screen WHILE in$<>return$ ! wait for in$=INKEY$ WEND RETURN ' ********** ' > PROCEDURE bell.return.key ' *** same as Procedure Return.key, but with bell-sound ' *** bell turned off after pressing any key ' *** uses Standard-Globals and Procedure Return.key LOCAL w1$,w2$,temp$,b1$,b2$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) b1$=bel$ b2$="" PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$;b1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ SWAP b1$,b2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$;b1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 IF in$<>return$ @return.key ! switch bell off, but wait for ENDIF RETURN ' ********** ' > PROCEDURE key.click(switch!) ' *** switch key-click on/off IF switch! SPOKE &H484,BSET(PEEK(&H484),0) ! keyclick on ELSE SPOKE &H484,BCLR(PEEK(&H484),0) ! keyclick off ENDIF RETURN ' ********** ' > PROCEDURE key.repeat(switch!) ' *** switch key-repeat on/off IF switch! SPOKE &H484,BSET(PEEK(&H484),1) ! key-repeat on ELSE SPOKE &H484,BCLR(PEEK(&H484),1) ! key-repeat off ENDIF RETURN ' ********** ' > PROCEDURE caps(switch!) ' *** switch CapsLock on/off IF switch! ~BIOS(11,BSET(BIOS(11,-1),4)) ! CapsLock on ELSE ~BIOS(11,BCLR(BIOS(11,-1),4)) ! CapsLock off ENDIF RETURN ' ********** ' > PROCEDURE stop.key ' *** temporarily stop program after : , of ' *** continue program after any keypress or click ' *** use in loop where this Procedure is called regularly LOCAL in$ in$=INKEY$ IF INSTR("Ss"+CHR$(19),in$)>0 REPEAT UNTIL INKEY$="" PAUSE 10 REPEAT UNTIL INKEY$<>"" OR MOUSEK ENDIF RETURN ' ********** ' > PROCEDURE break.key ' *** this Procedure is called after : ' *** activate with : On Break Gosub Break.key ' *** after activating, you can't enter the GFA-editor from the program ! LOCAL m$,b$,k ON BREAK CONT m$=" abort this| program| or| continue ?" b$="STOP|CONT" ALERT 3,m$,2,b$,k IF k=1 IF EXIST("\START.GFA") CHAIN "\START.GFA" ELSE IF EXIST("\STARTLOW.GFA") CHAIN "\STARTLOW.GFA" ELSE EDIT ENDIF ENDIF ON BREAK GOSUB break.key RETURN ' ********** ' > PROCEDURE initio.keyget ' *** flexible processing of any keypress ' *** in program : DO ' KEYGET get.code% ' @keyget ! process keypress there ' LOOP ' ABSOLUTE ascii|,V:get.code%+3 ! ASCII-code of key ABSOLUTE scan|,V:get.code%+1 ! scan-code of key ABSOLUTE status|,V:get.code% ! bit 0 = Right , 1 = Left ' 2 = , 3 = , 4 = RETURN ' *** > PROCEDURE keyget ' *** process keypress here {XBIOS(14,1)+6}=0 ! empty keyboard-buffer before leaving RETURN ' ********** ' > PROCEDURE initio.macro ' *** install strings as macro for function-keys ' *** strings may not exceed 31 characters LOCAL i,macro$ KEYPAD &X10000 ! KEYDEF without activated; in editor you RESTORE initio.macro ! still have to press ! FOR i=1 TO 20 READ macro$ KEYDEF i,macro$ NEXT i ' initio.macro: ' *** switch to Overwrite-mode of GFA-editor before entering text ' *** function-keys - DATA "F1 " DATA "F2 " DATA "F3 " DATA "F4 " DATA "F5 " DATA "F6 " DATA "F7 " DATA "F8 " DATA "F9 " DATA "F10 " ' *** function-keys - DATA "S F1 " DATA "S F2 " DATA "S F3 " DATA "S F4 " DATA "S F5 " DATA "S F6 " DATA "S F7 " DATA "S F8 " DATA "S F9 " DATA "S F10 " RETURN ' ********** ' > PROCEDURE keypress(txt$) ' *** simulates input of txt$ by user (including ) ' *** call this Procedure before INPUT, FILESELECT, ALERT, etc. LOCAL i REPEAT UNTIL INKEY$="" ! clear keyboard-buffer FOR i=1 TO LEN(txt$) KEYPRESS ASC(MID$(txt$,i)) NEXT i KEYPRESS &H1C000D ! RETURN ' ********** ' .p- .n4 .lr3 .ll88 ' **************** ' *** MATH.LST *** ' **************** ' DEFWRD "a-z" ' > PROCEDURE factorial(number,VAR fac#) ' *** return factorial of number ' *** global : OVERFLOW! LOCAL m$,n,k IF number>449 PRINT CHR$(7); m$="overflow ...| |maximum 449!|("+STR$(number)+"! not possible)" ALERT 3,m$,1," OK ",k overflow!=TRUE fac#=0 ELSE fac#=1 overflow!=FALSE FOR n=1 TO number MUL fac#,n NEXT n ENDIF RETURN ' ********** ' > PROCEDURE binomial.chance(number,chance#,n,VAR n.chance#) ' *** two outcomes are possible (U1 en U2, e.g. heads and tails) ' *** outcomes are tested a number of times (e.g. 100 coin tosses) ' *** chance for outcome U1 is chance# (0-1; e.g. 0.5 for heads) ' *** return chance for n U1-outcomes (e.g. 60 times heads) ' *** uses Procedure Factorial LOCAL comb#,n1#,n2#,n3# @factorial(number,n1#) @factorial(n,n2#) @factorial(number-n,n3#) comb#=(n1#/n2#)/n3# n.chance#=comb#*((chance#)^n)*((1-chance#)^(number-n)) RETURN ' ********** ' > PROCEDURE correlate(number,VAR proc1#(),proc2#(),cor#,sign!,a#,b#) ' *** return correlation between numbers in arrays proc1#() and proc2#() ' *** use elements with index 1 to number ' *** also returns flag for significance of correlation and regression-line ' LOCAL n,sum_xy#,sum_x#,sum_y#,sum_x2#,sum_y2#,numerator#,denominator# CLR sum_xy#,sum_x#,sum_y#,sum_x2#,sum_y2# ' IF NOT DIM?(cor_a#()) DIM cor_a#(32),cor_r#(32) RESTORE cor_r_values FOR n=1 TO 32 READ cor_a#(n),cor_r#(n) NEXT n ENDIF ' FOR n=1 TO number sum_xy#=sum_xy#+proc1#(n)*proc2#(n) sum_x#=sum_x#+proc1#(n) sum_y#=sum_y#+proc2#(n) sum_x2#=sum_x2#+proc1#(n)*proc1#(n) sum_y2#=sum_y2#+proc2#(n)*proc2#(n) NEXT n numerator#=sum_xy#-(sum_x#*sum_y#)/number denominator#=SQR((sum_x2#-(sum_x#*sum_x#)/number)*(sum_y2#-(sum_y#*sum_y#)/number)) cor#=numerator#/denominator# ' FOR n=1 TO 32 EXIT IF number<=cor_a#(n) NEXT n IF ABS(correlatie#) PROCEDURE ggd(x%,y%,VAR ggd%) ' ** bepaal grootste gemene deler van twee getallen (algoritme van Euclides) LOCAL x2%,y2%,rest% x2%=x% y2%=y% REPEAT rest%=MOD(x2%,y2%) x2%=y2% y2%=rest% UNTIL rest%=0 ggd%=x2% RETURN ' ********** ' > PROCEDURE piechart(VAR n()) ' *** positive numbers in word-array are represented as percentage in piechart ' *** High resolution only ' *** uses Standard Globals LOCAL n.max,i,sum,p.end#,p.start#,ps#,pu#,psa# CLR sum,psa#,p.start# n.max=DIM?(n())-1 FOR i=1 TO n.max ADD sum,n(i) NEXT i ERASE n.fract#() DIM n.fract#(n.max) FOR i=1 TO n.max n.fract#(i)=n(i)/sum*2*PI ! 2*PI = 100 % NEXT i FOR i=1 TO n.max p.end#=p.start#+n.fract#(i)*57.3 DEFFILL 1,2,i ! new Fill-pattern (max. 24) PELLIPSE 320,180,300,150,10*p.start#+2700,10*p.end#+2700 p.start#=p.end# NEXT i DEFTEXT ,,,13 FOR i=1 TO n.max ps#=psa#+n.fract#(i) pu#=0.5*(ps#+psa#) x#=70*SIN(pu#)+54 y#=25*COS(pu#)+34 ' PRINT AT(x#/2+14,y#/3+1);n(i) TEXT (x#/2+12.5)*char.width,(y#/3)*char.height+4,STR$(n(i)) psa#=ps# NEXT i RETURN ' ********** ' ' ******************* ' *** MESSAGE.LST *** ' ******************* ' DEFWRD "a-z" ' > PROCEDURE message(text$) ' *** put message Text$ on bottom of screen and wait for ' *** uses Standard Globals LOCAL temp$,w1$,w2$ GET 0,scrn.y.max-2*char.height,scrn.x.max,scrn.y.max,temp$ PRINT CHR$(27);"Y";CHR$(31+scrn.lin.max-1);CHR$(31+1); PRINT CHR$(27);"J"; PRINT SPACE$(scrn.col.max/2-(LEN(text$)+2)/2); PRINT CHR$(27);"p"; PRINT " "+text$+" "; PRINT CHR$(27);"q"; w1$="" w2$=SPACE$(8) SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE INKEY$<>return$ PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WEND PUT 0,scrn.y.max-2*char.height,temp$,3 ! restore screen RETURN ' ********** ' > PROCEDURE warning(text$) ' *** put warning Text$ on bottom of screen and wait for or ' *** uses Standard Globals ' *** global : OK! LOCAL temp$,w1$,w2$ GET 0,scrn.y.max-2*char.height,scrn.x.max,scrn.y.max,temp$ PRINT CHR$(27);"Y";CHR$(31+scrn.lin.max-1);CHR$(31+1); PRINT CHR$(27);"J"; PRINT SPACE$(scrn.col.max/2-(LEN(text$)+2)/2); PRINT CHR$(27);"p"; PRINT " "+text$+" "; PRINT CHR$(27);"q"; w1$=" or " w2$=SPACE$(17) SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 PRINT AT(scrn.col.max/2-8,scrn.lin.max);w1$; REPEAT key$=INKEY$ PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-8,scrn.lin.max);w1$; UNTIL key$=return$ OR key$=esc$ IF key$=return$ ok!=TRUE ELSE ok!=FALSE ENDIF PUT 0,scrn.y.max-2*char.height,temp$,3 ! restore screen RETURN ' ********** ' > PROCEDURE message.on(text$) ' *** put message Text$ on bottom line of screen ' *** call Procedure Message.off to restore original screen ' *** uses Standard Globals ' *** global : MESSAGE.TEMP$ GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,message.temp$ PRINT CHR$(27);"Y";CHR$(31+scrn.lin.max);CHR$(31+1); PRINT CHR$(27);"J"; PRINT SPACE$(scrn.col.max/2-(LEN(text$)+2)/2); PRINT CHR$(27);"p"; PRINT " "+text$+" "; PRINT CHR$(27);"q"; RETURN ' *** > PROCEDURE message.off PUT 0,scrn.y.max-char.height,message.temp$,3 ! restore screen RETURN ' ********** ' > PROCEDURE achtung ' *** little joke for user who presses the wrong key ' *** High resolution only ! LOCAL screen$,i,n,in$ ON BREAK CONT SGET screen$ SOUND 1,15,1,8,5 WAVE 8,8,10,5,5 FOR n=1 TO 5 SETCOLOR 0,0 CLS ! black screen PAUSE 10 SETCOLOR 0,1 CLS ! white screen NEXT n WAVE 0,0 SETCOLOR 0,0 CLS PAUSE 100 SETMOUSE 639,399 DEFTEXT 1,1,0,32 TEXT 140,40,"!! A C H T U N G !!" FOR n=1 TO 5 FOR i=1 TO 8 SOUND 1,15,i,4,1 NEXT i PAUSE 5 FOR i=1 TO 8 SOUND 1,15,i,4,1 NEXT i PAUSE 5 NEXT n WAVE 0,0 DELAY 3 DEFTEXT ,0,,16 TEXT 230,70,"Alles Lookenpeepers" DELAY 1 TEXT 10,120,"Das Computenmachin is nicht fr Gefingerpoken und Mittengrabben." DELAY 6 TEXT 10,170,"Ist easy schnappen der Springenwerk, Blowenfusen und Poppen-" TEXT 10,220,"corken mit Spitzensparken !" DELAY 10 DEFTEXT ,4 TEXT 10,270,"Das ST-Computer ist nicht fr gewerken by das Dummkopfen !!" DELAY 4 DEFTEXT ,0 TEXT 10,320,"Das rubbernecken Sightseeren keepen Hands in das Pockets." TEXT 10,370,"Relaxen und next Time warten bis Computer Ready !" DELAY 6 DEFTEXT ,,,8 TEXT 10,397,"Fingerpoken any Key vor Returning to Programm ..." WHILE INKEY$<>"" in$=INKEY$ WEND WHILE INKEY$="" WEND SETCOLOR 0,1 SPUT screen$ ON BREAK RETURN ' ********** ' > PROCEDURE busy ' *** fill screen with the busy bee (High resolution only) LOCAL i SETMOUSE 8,8 DEFMOUSE 2 IF DIM?(busy.bee())=0 DIM busy.bee(15) ENDIF FOR i=0 TO 15 busy.bee(i)=INT{XBIOS(2)+i*80} NEXT i ACLIP 1,0,0,639,399 ARECT 0,0,639,399,1,0,V:busy.bee(0),15 PRINT AT(25,13);" Please wait, I am busy ... " ACLIP 0,0,0,639,399 DEFMOUSE 0 HIDEM RETURN ' ********** ' ' **************** ' *** MIDI.LST *** ' **************** ' DEFWRD "a-z" ' > PROCEDURE clear.midi.buffer ' *** clear MIDI-buffer LOCAL buffer$ buffer$=INPMID$ RETURN ' ********** ' > PROCEDURE change.midi.buffer(size%) ' *** change size of MIDI-buffer (default 128 bytes) ' *** global : MIDI.BUFFER.ADR% LOCAL ptr% ptr%=XBIOS(14,2) IF midi.buffer.adr%=0 midi.buffer.adr%=LPEEK(ptr%) ! address of original buffer ENDIF ERASE buffer|() DIM buffer|(size%-1) LPOKE ptr%,VARPTR(buffer|(0)) ! start-address new buffer DPOKE ptr%+4,size% ! size DPOKE ptr%+6,0 ! buffer-head DPOKE ptr%+8,0 ! buffer-tail DPOKE ptr%+10,0 ! low mark (not used) DPOKE ptr%+12,size%-1 ! high mark (not used) RETURN ' *** > PROCEDURE restore.midi.buffer ' *** restore default MIDI-buffer (128 bytes) LOCAL adres%,m$,k IF midi.buffer.adr%<>0 adres%=XBIOS(14,2) LPOKE adres%,midi.buffer.adr% ! start-address default buffer DPOKE adres%+4,128 ! size DPOKE adres%+6,0 ! buffer-head DPOKE adres%+8,0 ! buffer-tail DPOKE adres%+10,0 ! low mark (not used) DPOKE adres%+12,127 ! high mark (not used) ELSE m$="default MIDI-buffer|(size 128 bytes) is|still active, so|" m$=m$+"Restore is superfluous" ALERT 3,m$,1," OK ",k ENDIF RETURN ' ********** ' > PROCEDURE all.midi.off ' *** switch everything off on all channels LOCAL channel FOR channel=0 TO 15 OUT 3,&HB0+channel,123,0 ! all notes off OUT 3,&HB0+channel,64,0 ! sustain off OUT 3,&HB0+channel,1,0 ! modulation off OUT 3,&HE0+channel,0,0 ! pitch bend off NEXT channel RETURN ' ********** ' > PROCEDURE midi.off(channel) ' *** switch everything off on this channel (1-16) OUT 3,&HB0+channel-1,123,0 ! all notes off OUT 3,&HB0+channel-1,64,0 ! sustain off OUT 3,&HB0+channel-1,1,0 ! modulation off OUT 3,&HE0+channel-1,0,0 ! pitch bend off RETURN ' ********** ' > PROCEDURE play.midi(VAR midi.byte|(),midi.time%()) ' *** play music (see also Procedure Record.midi) ' *** byte-array for notes and integer-array for time ' *** uses Procedure All.midi.off LOCAL m$,k,i%,t%,time% m$="record of "+STR$(INT(midi.time%(last.midi.byte%)/200))+" seconds| |" m$=m$+"(stop by pressing space)" ALERT 3,m$,1,"PLAY",k REPEAT UNTIL INKEY$="" i%=1 t%=TIMER REPEAT time%=SUB(TIMER,t%) IF midi.time%(i%)<=time% OUT 3,midi.byte|(i%) INC i% ENDIF UNTIL i%=last.midi.byte% OR INKEY$=" " @all.midi.off RETURN ' ********** ' > PROCEDURE record.midi(VAR midi.byte|(),midi.time%()) ' *** record music ' *** byte-array for notes and integer-array for time ' *** active sensing message ignored ' *** uses Procedure All.midi.off ' *** global : LAST.MIDI.BYTE% LOCAL last%,buffer$,i%,t%,time%,byte|,delay%,j%,m$,k ARRAYFILL midi.byte|(),0 ARRAYFILL midi.time%(),0 last%=DIM?(midi.byte|())-1 m$=STR$(last%)+" bytes available ;| |stop recording|" m$=m$+"by pressing space" ALERT 3,m$,1,"RECORD",k REPEAT UNTIL INKEY$="" buffer$=INPMID$ ! clear MIDI-buffer i%=1 t%=TIMER REPEAT IF INP?(3) byte|=INP(3) IF byte|<>254 time%=SUB(TIMER,t%) midi.byte|(i%)=byte| midi.time%(i%)=time% INC i% ENDIF ENDIF UNTIL i%=last% OR INKEY$=" " last.midi.byte%=i%-1 @all.midi.off delay%=midi.time%(1) ! subtract time for first note FOR j%=1 TO i% SUB midi.time%(j%),delay% NEXT j% m$="|"+STR$(i%)+" bytes recorded" ALERT 3,m$,1," OK ",k RETURN ' ********** ' > PROCEDURE midi.monitor ' *** simple monitor LOCAL m$,k,byte|,byte$,hex$,bin$,buffer$,key$ byte$=SPACE$(3) hex$=SPACE$(2) bin$=SPACE$(8) m$="all incoming bytes|(except 254) are|printed on screen ;|" m$=m$+"stop by pressing space" ALERT 1,m$,1,"START",k m$="press||for CLS" ALERT 1,m$,1," OK ",k REPEAT UNTIL INKEY$="" buffer$=INPMID$ ! clear MIDI-buffer CLS PRINT TAB(10);"dec";TAB(20);"hex";TAB(30);"binary" REPEAT REPEAT key$=INKEY$ IF INP?(3) byte|=INP(3) IF byte|<>254 IF TIMER-t%>200 PRINT ENDIF t%=TIMER RSET byte$=STR$(byte|) RSET hex$=HEX$(byte|) RSET bin$=BIN$(byte|) PRINT TAB(10);byte$;TAB(20);hex$;TAB(30);bin$ ENDIF ENDIF UNTIL key$=" " OR key$=CHR$(13) IF key$=CHR$(13) CLS ENDIF UNTIL key$=" " @all.midi.off REPEAT UNTIL INKEY$="" PRINT " (press any key)" ~INP(2) RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** MIDI control commands *** ' ' *** all Procedures : channel 1-16, other parameters 0-127 ' > PROCEDURE note.off(channel,note,velocity) OUT 3,&H80+channel-1,note,velocity RETURN ' *** > PROCEDURE note.on(channel,note,velocity) ' *** note off : velocity=0 OUT 3,&H90+channel-1,note,velocity RETURN ' *** > PROCEDURE key.pressure(channel,note,pressure) OUT 3,&HA0+channel-1,note,pressure RETURN ' *** > PROCEDURE control.change(channel,number,value) OUT 3,&HB0+channel-1,number,value RETURN ' *** > PROCEDURE program.change(channel,number) OUT 3,&HC0+channel-1,number RETURN ' *** > PROCEDURE channel.pressure(channel,pressure) OUT 3,&HD0+channel-1,pressure RETURN ' *** > PROCEDURE pitch.bend(channel,bend) ' *** bend 0-255 LOCAL byte1|,byte2| IF BTST(bend,0) byte1|=64 ELSE byte1|=0 ENDIF byte2|=SHR|(BYTE(bend),1) OUT 3,&HE0+channel-1,byte1|,byte2| RETURN ' ------------------------------------------------------------------------------ ' ' ------------------------------------------------------------------------------ ' *** specific MIDI control change events *** ' > PROCEDURE modulate(channel,modulate) OUT 3,&HB0+channel-1,1,modulate RETURN ' *** > PROCEDURE data.entry(channel,data) OUT 3,&HB0+channel-1,6,data RETURN ' *** > PROCEDURE hold(channel,switch!) LOCAL hold| IF switch! hold|=127 ELSE hold|=0 ENDIF OUT 3,&HB0+channel-1,64,hold| RETURN ' *** > PROCEDURE all.notes.off(channel) OUT 3,&HB0+channel-1,123,0 RETURN ' *** > PROCEDURE main.volume(channel,volume) OUT 3,&HB0,7,volume RETURN ' *** > PROCEDURE omni(channel,switch!) ' *** switch for Omni (if on, channel will be ignored) IF switch! OUT 3,&HB0+channel-1,124,0 ! on ELSE OUT 3,&HB0+channel-1,125,0 ! off ENDIF RETURN ' ------------------------------------------------------------------------------ ' > PROCEDURE kawai.k1.exclusive(channel,function,sub1,sub2,VAR data|()) ' *** send system exclusive data to Kawai K1 ' *** data in byte-array LOCAL last,i OUT 3,&HF0,&H40,channel-1,function,&H0,&H3,sub1,sub2 last=DIM?(data|())-1 FOR i=0 TO last OUT 3,data|(i) NEXT i OUT 3,&HF7 RETURN ' ********** ' ' ***************** ' *** MODEM.LST *** ' ***************** ' DEFWRD "a-z" ' > PROCEDURE baud(rate%) ' *** change baudrate LOCAL bd% SELECT rate% CASE 19200 bd%=0 CASE 9600 bd%=1 CASE 4800 bd%=2 CASE 3600 bd%=3 CASE 2400 bd%=4 CASE 2000 bd%=5 CASE 1800 bd%=6 CASE 1200 bd%=7 CASE 600 bd%=8 CASE 300 bd%=9 CASE 200 bd%=10 CASE 150 bd%=11 CASE 134 bd%=12 CASE 110 bd%=13 CASE 75 bd%=14 ! old TOS (bug) : results in 120 baud instead of 75 baud !! CASE 50 bd%=15 ! old TOS (bug) : results in 80 baud instead of 50 baud !! ENDSELECT ~XBIOS(15,bd%,-1,-1,-1,-1,-1) RETURN ' ********** ' ' ***************** ' *** MUSIC.LST *** ' ***************** ' DEFWRD "a-z" ' > PROCEDURE play.song(play$) ' *** play song (XBIOS 32 - format) ' *** Keyclick temporarily switched off ' *** Song-file not larger than 32767 bytes ' *** global : PLAY.SONG! SONG.ADRES% LOCAL bytes,song$ IF EXIST(play$) play.song!=TRUE IF (PEEK(&H484) AND 1)=1 SPOKE &H484,(PEEK(&H484) XOR 1) ! key-click off ENDIF OPEN "I",#90,play$ bytes=LOF(#90) CLOSE #90 song$=SPACE$(bytes) song.adres%=VARPTR(song$) BLOAD play$,song.adres% VOID XBIOS(32,L:song.adres%) ELSE play.song!=FALSE ENDIF RETURN ' *** > PROCEDURE stop.song ' *** abort song, switch Keyclick on WAVE 0,0 IF (PEEK(&H484) AND 1)=0 SPOKE &H484,(PEEK(&H484) OR 1) ! key-click on ENDIF play.song!=FALSE RETURN ' ********** ' > PROCEDURE interrupt.song ' *** interrupt X32-song temporarily to do something important ' *** uses global variable song.adres% (Procedure Play.song) LOCAL i,adres% IF play.song! ERASE register() DIM register(15) adres%=XBIOS(32,L:-1) ! where are we ? FOR i=0 TO 15 register(i)=XBIOS(28,0,i) ! store registers NEXT i IF (PEEK(&H484) AND 1)=0 SPOKE &H484,(PEEK(&H484) OR 1) ! key-click on ENDIF ENDIF ' WAVE 0,0 ' *** do something important here ' PAUSE 100 ! just an example, not very important ' ' *** continue the interrupted song IF play.song! IF (PEEK(&H484) AND 1)=1 SPOKE &H484,(PEEK(&H484) XOR 1) ! key-click off ENDIF FOR i=0 TO 15 ~XBIOS(28,register(i),i OR 128) ! restore registers NEXT i IF adres%=0 adres%=song.adres% ENDIF ~XBIOS(32,L:adres%) ! music, maestro ... ENDIF RETURN ' ********** ' > PROCEDURE play.cont.song(play$) ' *** play song continuously (XBIOS 32 - format) ' *** uses EVERY to test every 1 second if song is finished ' *** remember, EVERY doesn't work during "long" commands (~INP(2),PAUSE,etc.) ' *** Keyclick temporarily switched off ' *** Song-file not larger than 32767 bytes (use MALLOC for larger songs) ' *** global : CONT.SONG! SONG.ADR% LOCAL bytes,song$ IF EXIST(play$) cont.song!=TRUE IF (PEEK(&H484) AND 1)=1 SPOKE &H484,(PEEK(&H484) XOR 1) ! key-click off ENDIF OPEN "I",#90,play$ bytes=LOF(#90) CLOSE #90 song$=SPACE$(bytes) song.adr%=VARPTR(song$) BLOAD play$,song.adr% EVERY 200 GOSUB check.song ~XBIOS(32,L:song.adr%) ELSE cont.song!=FALSE ENDIF RETURN ' *** > PROCEDURE check.song IF XBIOS(32,L:-1)=0 ~XBIOS(32,L:song.adr%) ENDIF RETURN ' *** > PROCEDURE stop.cont.song ' *** abort song, switch Keyclick on EVERY STOP WAVE 0,0 IF (PEEK(&H484) AND 1)=0 SPOKE &H484,(PEEK(&H484) OR 1) ! key-click on ENDIF cont.song!=FALSE RETURN ' ********** ' > PROCEDURE initio.soundmachine(file$) ' *** load and play Soundmachine-song file$ ' *** songs created by The Soundmachine ST (TommySoftware) ' *** song (*.SNG) compiled to Precode-file (*.DAT) ' *** program SMSOUND.EXE plays song; reset necessary because of RESERVE 3 ! ' *** global : SM.FLAG% LOCAL s$,cmd$,k s$=STRING$(4,0) RESERVE 50000 ! Soundmachine needs a lot of space cmd$=file$+" "+STR$(V:s$) cmd$=CHR$(LEN(cmd$)+1)+cmd$ EXEC 0,"SMSOUND.EXE",cmd$,"" ! load and start (change path if necessary) sm.flag%=CVL(s$) IF sm.flag%=0 ALERT 3,"Can't load| |SMSOUND.EXE",1,"EDIT",k RESERVE EDIT ENDIF RETURN ' *** > PROCEDURE soundmachine(flag!) ' *** if restart-flag is set in program, restart of song is possible : ' *** POKE sm.flag%+7,1 ! set restart-flag ' *** FOR t=1 TO 10000 ! wait ' *** NEXT t ' *** @soundmachine(on!) ! restart song ' *** abort song with @soundmachine(off!) ' IF flag! ! sound on SDPOKE &H452,0 ! no VBL SLPOKE &HFF8800,&H7007F00 ! load sound-register SPOKE &HFFFA1D,0 ! system-timer off (no click,menu,break,etc.) SPOKE &HFFFA17,64 ! MFP AEoI-mode SPOKE &HFFFA19,1 ! start timer A ELSE ! sound off SPOKE &HFFFA19,0 ! timer A off (2x !!) SPOKE &HFFFA19,0 SPOKE &HFFFA17,72 ! MFP SEoI-mode SPOKE &HFFFA1D,81 ! system-timer on (GEM alive again) SDPOKE &H452,1 ! VBL ENDIF RETURN ' ********** ' > PROCEDURE sm.initio(object$,buffer%) ' *** reserve space for object-file and load it ' *** also reserve space for buffer (if object-file contains compressed song) ' *** use @sm.exit to restore memory LOCAL object%,m$,k,res.mem%,bufp% IF EXIST(object$) OPEN "I",#90,object$ object%=LOF(#90) CLOSE #90 ELSE m$="Sorry, can't|find the file|"+object$ ALERT 3,m$,1,"QUIT",k @exit ENDIF res.mem%=object%+buffer%+256 ! 256 not necessary ? RESERVE -res.mem% ! reserve space for object-file + buffer sm.sam%=MALLOC(object%) ! space for object-file (see SAMLINK.PRG) sm.taon%=sm.sam%+&H186 ! special function (see Procedure Sm.space) sm.taoff%=sm.sam%+&H1B6 ! sm.flags%=sm.sam%+&HE76 ! address of the 8 Flags bufp%=sm.sam%+&HE7E ! points to a buffer (for the unpacked music) BLOAD object$,sm.sam% ! load object-file ~XBIOS(38,L:sm.sam%) ! call assembler-routine in Supervisor-mode ! SDPOKE &H452,0 ! disable VBL IF buffer%>0 sm.song%=MALLOC(buffer%) ! space for the buffer (see SAMLINK.PRG) LPOKE (bufp%),sm.song% ! tell buffer-address to SOUNDMACHINE ENDIF RETURN ' ***** > PROCEDURE sm.flag(flag,value) ' *** assign value (0-255) to flag (0-7) BYTE{sm.flags%+flag}=value RETURN ' ***** > PROCEDURE sm.start.x100 ' *** start Soundmachine song (compressed song will be decompressed first) ' *** use this for X100-mode only ' *** song can be stopped only () if Procedure Sm.space is switched on @sm.space(on!) SPOKE &HFFFA19,1 @sm.wait @sm.space(off!) RETURN ' ***** > PROCEDURE sm.wait ' *** wait until Restart recognized REPEAT UNTIL PEEK(&HFFFA19)=0 RETURN ' ***** > PROCEDURE sm.start.x66 ' *** start Soundmachine song (compressed song will be decompressed first) ' *** use this for X66-mode only SPOKE &HFFFA19,1 RETURN ' ***** > PROCEDURE sm.stop.x66 ' *** stop Soundmachine song ' *** this works only in X66-mode (Flag 7 is set to 1) @sm.flag(7,1) @sm.wait RETURN ' ***** > PROCEDURE sm.space(switch!) ' *** after @sm.space(TRUE) the song will stop playing after detecting ' *** this works in X100-mode ! ' *** this function uses XBIOS-calls to detect the keypress ' *** don't forget to disable this funcion with @sm.space(FALSE) !! IF switch! CALL sm.taon% ELSE CALL sm.taoff% ENDIF RETURN ' ***** > PROCEDURE sm.exit ' *** exit Soundmachine; restore memory (a few bytes are lost) LOCAL dummy%,m$,k IF sm.song%>0 dummy%=MFREE(sm.song%) ! return buffer to GEMDOS IF dummy%<>0 m$="*** WARNING ***| |MFREE-error with|Song-buffer" ALERT 3,m$,1," OK ",k ENDIF ENDIF SDPOKE &H452,1 ! VBL on SPOKE &HFFFA1D,80 ! Systemtimer on (200 Hz) dummy%=MFREE(sm.sam%) ! return memory to GEMDOS IF dummy%<>0 m$="*** WARNING ***| |MFREE-error with|Object-file" ALERT 3,m$,1," OK ",k ENDIF RESERVE ! return memory to GFA-Basic RETURN ' ********** ' > PROCEDURE msm.initio(object$) ' *** reserve space for object-file and load it ' *** use @msm.exit to restore memory LOCAL object%,m$,k IF EXIST(object$) OPEN "I",#90,object$ object%=LOF(#90) CLOSE #90 ELSE m$="Sorry, can't|find the file|"+object$ ALERT 3,m$,1,"QUIT",k @exit ENDIF res.mem%=object%+256 ! 256 not necessary ? RESERVE -res.mem% ! reserve space for object-file msm.chip%=MALLOC(object%) ! allocate space for object-file msm.flags%=msm.chip%+&HC64 ! address of the Flags msm.systim%=LPEEK(&H114) ! 200 Hz Systemtimer (Timer C) BLOAD object$,msm.chip% ! load object-file VOID XBIOS(38,L:msm.chip%) ! call assembler-routine in Supervisor-mode RETURN ' ***** > PROCEDURE msm.start ' *** start Mini-Soundmachine song SPOKE &HFFFA1D,16 RETURN ' ***** > PROCEDURE msm.stop ' *** stop Mini-Soundmachine song (set Flag 7 to 1) @msm.flag(7,1) REPEAT UNTIL PEEK(&HFFFA1D)=0 RETURN ' ***** > PROCEDURE msm.effect(effect,freq) ' *** play sound-effect from Mainsong ' *** frequency 245000/freq Hz (freq : 11-255) @msm.flag(9,freq) @msm.flag(8,effect) RETURN ' ***** > PROCEDURE msm.flag(flag,value) ' *** assign value to flag BYTE{msm.flags%+flag}=value RETURN ' ***** > PROCEDURE msm.exit ' *** exit Mini-Soundmachine; restore memory (a few bytes are lost) LOCAL dummy%,m$,k @msm.stop dummy%=MFREE(msm.chip%) ! return memory to GEMDOS IF dummy%<>0 m$="*** WARNING ***| |MFREE-error with|Object-file" ALERT 3,m$,1," OK ",k ENDIF VOID XBIOS(31,2,80,192,L:msm.systim%) ! switch back to Timer C RESERVE ! return memory to GFA-Basic RETURN ' ********** ' ' ******************* ' *** PRINTER.LST *** ' ******************* ' DEFWRD "a-z" ' > PROCEDURE printer.ready ' *** test if printer ready LOCAL k DO EXIT IF GEMDOS(&H11) SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 ALERT 3," printer| | not ready !!",1," OK ",k LOOP RETURN ' ********** ' > PROCEDURE initio.epson.fx80 ' *** initialize global printer-variables for Epson FX-80 ' lf$=CHR$(10) ff$=CHR$(12) bs$=CHR$(8) ' DEFFN right.margin$(n)=CHR$(27)+"Q"+CHR$(n) DEFFN left.margin$(n)=CHR$(27)+"l"+CHR$(n) DEFFN bit.image.8$(mode,dots)=CHR$(27)+"*"+CHR$(mode)+CHR$(dots MOD 256)+CHR$(dots\256) DEFFN line.space$(n)=CHR$(27)+"3"+CHR$(n) ! n/216 inch (default 32/216) ' elite$=CHR$(27)+"M" pica$=CHR$(27)+"P" proportional.on$=CHR$(27)+"p"+CHR$(1) proportional.off$=CHR$(27)+"p"+CHR$(0) enlarged.on$=CHR$(27)+"W"+CHR$(1) enlarged.off$=CHR$(27)+"W"+CHR$(0) condensed.on$=CHR$(15) condensed.off$=CHR$(18) emphasized.on$=CHR$(27)+"E" emphasized.off$=CHR$(27)+"F" italic.on$=CHR$(27)+"4" italic.off$=CHR$(27)+"5" underline.on$=CHR$(27)+"-"+CHR$(1) underline.off$=CHR$(27)+"-"+CHR$(0) ' unidirectional$=CHR$(27)+"U"+CHR$(1) bidirectional$=CHR$(27)+"U"+CHR$(0) ' initialize$=CHR$(27)+"@" ' RETURN ' ********** ' > PROCEDURE high.screendump.epson.fx80 ' *** screendump to Epson FX-80 (correct height/width ratio) ' *** High-resolution only ' *** uses Standard Globals LOCAL m$,b$,k,scrn.start%,col,b%,x,d%,p IF high.res! m$=" this screendump will| take about 2 minutes" m$=m$+"| (abort dump with )" b$=" OK | Abort " ALERT 1,m$,1,b$,k IF k=1 DO EXIT IF GEMDOS(&H11) m$=" printer| | not ready !!" b$=" OK " SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 ALERT 3,m$,1,b$,k LOOP HIDEM ' lf$=CHR$(10) ff$=CHR$(12) DEFFN bit.image.8$(mode,dots)=CHR$(27)+"*"+CHR$(mode)+CHR$(MOD(dots,256))+CHR$(dots/256) DEFFN line.space$(n)=CHR$(27)+"3"+CHR$(n) ! n/216 inch (default 32/216) initialize$=CHR$(27)+"@" scrn.start%=XBIOS(2) ' LPRINT initialize$; LPRINT lf$;lf$ FOR col=0 TO 79 b%=scrn.start%+col LPRINT SPC(12); LPRINT @line.space$(24); ! 8 dots/line LPRINT @bit.image.8$(5,400); ! 72 dots/inch ("plotter") ; 400 dots/line FOR x=399 TO 0 STEP -1 d%=ADD(b%,MUL(x,80)) p=BYTE{d%} OUT 0,p NEXT x LPRINT EXIT IF INKEY$=esc$ NEXT col LPRINT ff$; LPRINT initialize$; ENDIF ELSE m$="Sorry,|High rez|only !!" ALERT 3,m$,1," OK ",k ENDIF RETURN ' ********** ' > PROCEDURE download.epson.fx80 ' *** put original Epson ROM-characters in Download Character Set LPRINT CHR$(27);":";CHR$(0);CHR$(0);CHR$(0); ' *** select Download Character Set for printing LPRINT CHR$(27);"%";CHR$(1);CHR$(0); ' *** load new characters into RAM of Epson-printer ' *** download 32-126 (ASCII) or 160-254 ' *** in last case no italics possible ! ' *** attribute 139 if no descender; otherwise 11 ("lower" 8 dots of 9) RESTORE dwnload.characters READ code REPEAT READ attribute LPRINT CHR$(27);"&";CHR$(0);CHR$(code);CHR$(code);CHR$(attribute); FOR n=1 TO 11 READ bit.pattern LPRINT CHR$(bit.pattern); NEXT n READ code UNTIL code<0 ' ' *** ASCII-code, attribute, 11 bit-patterns; 12th bit-pattern always 0 dwnload.characters: DATA 160,139 DATA 0,4,10,32,10,96,138,32,28,2,0 DATA 161,139 DATA 0,0,18,0,94,128,2,0,0,0,0 DATA 162,139 DATA 0,28,34,0,34,64,162,0,34,28,0 DATA 163,139 DATA 0,60,2,0,66,128,2,0,60,2,0 DATA 171,139 DATA 0,0,248,2,12,48,194,20,34,8,50 DATA 172,139 DATA 0,0,248,2,12,48,204,16,36,75,4 DATA 189,139 DATA 0,56,68,0,186,68,170,0,68,56,0 DATA 221,139 DATA 0,0,80,170,0,170,0,170,20,0,0 DATA 222,139 DATA 0,8,0,16,0,32,0,16,0,8,0 DATA 223,139 DATA 0,16,40,0,32,16,8,0,40,16,0 DATA 227,139 DATA 0,32,64,62,64,32,0,62,64,0,0 DATA 228,139 DATA 0,130,68,170,16,130,0,130,0,130,0 DATA 240,139 DATA 0,73,0,73,0,73,0,73,0,73,0 DATA 241,139 DATA 0,17,0,17,0,125,0,17,0,17,0 DATA 242,139 DATA 0,0,131,0,69,0,41,0,17,0,0 DATA 243,139 DATA 0,0,17,0,41,0,69,0,131,0,0 DATA 247,139 DATA 0,36,72,0,72,36,18,0,18,36,0 DATA 248,139 DATA 0,0,0,64,160,0,160,64,0,0,0 DATA 251,139 DATA 0,0,32,16,8,16,32,64,128,0,128 DATA 253,139 DATA 0,0,0,72,144,8,160,8,192,8,0 DATA 254,139 DATA 0,0,16,136,0,168,0,168,80,0,0 DATA -1 RETURN ' ********** ' > PROCEDURE initio.star24 ' *** initializes global printer-variables for Star LC24-10 ' *** consult your printer-manual for the following (and other) commands ' *** DIP-switch settings : ' 1-1 OFF 2-1 ON ' 1-2 ON 2-2 ON ' 1-3 OFF 2-3 ON ' 1-4 ON 2-4 ON ' 1-5 ON 2-5 OFF ' 1-6 ON 2-6 OFF ' 1-7 ON 2-7 ON ' 1-8 ON 2-8 ON ' LOCAL c$,f$ ' c$=CHR$(27) f$=CHR$(28) ' draft.char$=c$+"x0" lq.char$=c$+"x1" ' courier.style$=c$+"k0"+lq.char$ prestige.style$=c$+"k2"+lq.char$ orator.style$=c$+"k3"+lq.char$ script.style$=c$+"k4"+lq.char$ ' normal.char$=c$+"q0" outlined.char$=c$+"q1" shadow.char$=c$+"q2" outlined.shadow.char$=c$+"q3" ' italic.on$=c$+"4" italic.off$=c$+"5" ' emphasized.on$=c$+"E" emphasized.off$=c$+"F" ' LET double.on$=c$+"G" LET double.off$=c$+"H" ' underline.on$=c$+"-1" underline.off$=c$+"-0" overline.on$=c$+"_1" overline.off$=c$+"_0" ' bold.draft$=draft.char$+emphasized.on$+double.on$ bold.lq$=lq$+double.on$ bold.off$=emphasized.off$+double.off$ ' superscript.on$=c$+"S0" superscript.off$=c$+"T" subscript.on$=c$+"S1" subscript.off$=c$+"T" ' DEFFN international.set$(n)=c$+"R"+CHR$(n) usa.set=0 france.set=1 germany.set=2 england.set=3 denmark1.set=4 sweden.set=5 italy.set=6 spain1.set=7 japan.set=8 norway.set=9 denmark2.set=10 spain2.set=11 latin.set=12 denmark.norway.set=13 ' epson.set$=c$+"t0" ibm.set$=c$+"t1"+c$+"6" DEFFN special.on$(n)=c$+"\"+CHR$(MOD(n,256))+CHR$(DIV(n,256)) DEFFN ibm.special$(n)=c$+"^"+CHR$(n) DEFFN epson.special$(n)=ibm.set$+@ibm.special$(n)+epson.set$ ! 0 n 32 ' slash.zero$=c$+"~1" normal.zero$=c$+"~0" ' pica$=c$+"P" ' elite$=c$+"M" high.speed.elite$=draft.char$+elite$+f$+"S1" high.density.elite$=draft.char$+elite$+f$+"S0" ' semi.condensed$=c$+"g" condensed.on$=CHR$(15) condensed.off$=CHR$(18) ' large.on$=c$+"W1" large.off$=c$+"W0" large.line$=CHR$(14) ' courier.proportional$=courier.style$+c$+"p1" prestige.proportional$=prestige.style$+c$+"p1" proportional.off$=c$+"p0" ' DEFFN master.mode$(n)=c$+"!"+CHR$(n) underline=128 italic=64 expanded=32 LET double.strike=16 emphasized=8 condensed=4 proportional=2 elite=1 ' DEFFN increase.space$(n)=c$+" "+CHR$(n) ' normal.size$=c$+"h"+CHR$(0) LET double.size$=c$+"h"+CHR$(1) quad.size$=c$+"h"+CHR$(2) LET double.height$=c$+"w1" normal.height$=c$+"w0" normal.width$=f$+"E"+CHR$(0) LET double.width$=f$+"E"+CHR$(1) triple.width$=f$+"E"+CHR$(2) ' lf$=CHR$(10) DEFFN lf$(n)=c$+"f1"+CHR$(n) rev.lf$=c$+CHR$(10) ' ff$=CHR$(12) rev.ff$=c$+CHR$(12) ' DEFFN top.margin$(t)=c$+"c"+CHR$(t) DEFFN bottom.margin$(b)=c$+"N"+CHR$(b) cancel.tb.margins$=c$+"O" ' DEFFN set.margins$(l,r)=c$+"X"+CHR$(l)+CHR$(r) DEFFN all.margins$(t,b,l,r)=@top.margin$(t)+@bottom.margin$(b)+@set.margins$(l,r) ' justify.left$=c$+"a0" justify.right$=c$+"a2" justify.full$=c$+"a3" center$=c$+"a1" ' immediate.on$=c$+"i1" immediate.off$=c$+"i0" ' off.line$=CHR$(19) on.line$=CHR$(17) ' bidirectional$=c$+"U0" unidirectional$=c$+"U1" ' reset$=c$+"@" ' RETURN ' ********** ' > PROCEDURE high.screendump.star24 ' *** screendump to Star LC24-10 (actually larger than screen !) ' *** each byte 'enlarged' to 3 bytes (1 set bit -> 3 bits) ' *** High-resolution only ' *** uses Standard Globals LOCAL m$,b$,k,scrn.start%,col,b%,x,d%,p|,b1|,b2|,b3|,n IF high.res! m$=" screendump| will last| several minutes" m$=m$+"| (abort dump with )" b$=" OK | Abort " ALERT 1,m$,1,b$,k IF k=1 DO EXIT IF GEMDOS(&H11) m$=" printer| | not ready !!" b$=" OK " SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 ALERT 3,m$,1,b$,k LOOP HIDEM ' lf$=CHR$(10) ff$=CHR$(12) DEFFN bit.image$(mode,dots)=CHR$(27)+"*"+CHR$(mode)+CHR$(MOD(dots,256))+CHR$(dots/256) DEFFN line.space$(n)=CHR$(27)+"3"+CHR$(n) ! n/216 inch (default 32/216) initialize$=CHR$(27)+"@" scrn.start%=XBIOS(2) ' LPRINT initialize$; FOR col=0 TO 79 b%=scrn.start%+col LPRINT SPC(8); ! Elite-mode !! LPRINT @line.space$(24); ! 24 dots/line LPRINT @bit.image$(33,800); ! 120 dots/inch (double) ; 2x400 dots/line FOR x=399 TO 0 STEP -1 d%=ADD(b%,MUL(x,80)) p|=BYTE{d%} IF p|=0 OUT 0,0,0,0,0,0,0 ELSE CLR b1|,b2|,b3| IF BTST(p|,0) b1|=7 ENDIF IF BTST(p|,1) ADD b1|,56 ENDIF IF BTST(p|,2) ADD b1|,192 b2|=1 ENDIF IF BTST(p|,3) ADD b2|,14 ENDIF IF BTST(p|,4) ADD b2|,112 ENDIF IF BTST(p|,5) ADD b2|,128 b3|=3 ENDIF IF BTST(p|,6) ADD b3|,28 ENDIF IF BTST(p|,7) ADD b3|,224 ENDIF OUT 0,b3|,b2|,b1|,b3|,b2|,b1| ENDIF NEXT x LPRINT EXIT IF INKEY$=esc$ NEXT col LPRINT ff$; LPRINT initialize$; ENDIF ELSE m$="Sorry,|High rez|only !!" ALERT 3,m$,1," OK ",k ENDIF RETURN ' ********** ' > PROCEDURE degas.screendump.star24 ' *** use Degas printer-driver for screendump of logical screen ' *** drivers (2000 bytes) have to be loaded into INLINE-lines ' *** this Procedure uses drivers for the Star LC24-10 printer ' *** uses Procedures Make.palette.string and Printer.ready LOCAL buffer%,palet$,palet%,rez,screen%,command,r%,m$,k,large! ' ' *** load LARGE.INL here INLINE star24.large.driver%,2000 ' ' *** load SMALL.INL here INLINE star24.small.driver%,2000 ' ERASE buffer|() DIM buffer|(1279) buffer%=V:buffer|(0) @make.palette.string(palet$) palet%=V:palet$ rez=XBIOS(4) screen%=XBIOS(3) command=0 @printer.ready m$="screendump| |1 - LARGE|2 - SMALL" ALERT 3,m$,0," 1 | 2 ",k IF k=1 large!=TRUE m$="|for 18x11 cm,|default size|is 27x17 cm" ALERT 3,m$,1," OK ",k r%=C:star24.large.driver%(command,rez,L:screen%,L:palet%,L:buffer%) ELSE large!=FALSE m$="|for 9x5.5 cm,|default size|is 13.5x8.5 cm" ALERT 3,m$,1," OK ",k r%=C:star24.small.driver%(command,rez,L:screen%,L:palet%,L:buffer%) ENDIF SELECT BYTE(r%) CASE 0 m$="Sorry, can't|initialize|printer driver| ???" ALERT 3,m$,1,"EDIT",k EDIT CASE 1 m$="Abort this|screendump|with " ALERT 1,m$,1," OK ",k command=1 IF large! r%=C:star24.large.driver%(command,rez,L:screen%,L:palet%,L:buffer%) ELSE r%=C:star24.small.driver%(command,rez,L:screen%,L:palet%,L:buffer%) ENDIF DEFAULT m$="Printer driver|does not|function| ???" ALERT 3,m$,1,"EDIT",k EDIT ENDSELECT RETURN ' ********** ' > PROCEDURE screendump ' *** printer-parameters changed with Xbios 33 (Setprt) ' *** set for : matrixprinter, monochrome, 960 dots/line, draft, ' *** parallel, fanfold paper ' *** height/width ratio of screendump does not correspond with screen ! ~XBIOS(33,&X100) HARDCOPY RETURN ' ********** ' ' ****************** ' *** SCREEN.LST *** ' ****************** ' DEFWRD "a-z" ' > PROCEDURE initio.logical.screen ' *** install second screen as logical screen ' *** if necessary, move original screen to logical screen (last line) ' *** all graphical commands go to logical screen (screen.2) ' *** PRINT always goes to physical screen (monitor) !! ' *** uses Standard Global physbase% ' *** global : SCREEN.1% SCREEN.2% DIM screen.2|(32256) ! reserve room for second screen screen.2%=VARPTR(screen.2|(0)) screen.2%=screen.2%+256-(screen.2% MOD 256) ! screen on 256-byte border screen.1%=physbase% ~XBIOS(5,L:screen.2%,L:-1,-1) ! invisible screen.2 is now active ' BMOVE screen.1%,screen.2%,32000 ! move original screen to screen.2 RETURN ' *** > PROCEDURE swap.screen ' *** call this Procedure if drawing-screen is finished ' *** physical and logical screen are swapped ' *** continue with drawing on the invisible logical screen ' *** if necessary, move fresh screen to new logical screen (last line) SWAP screen.1%,screen.2% VSYNC ! necessary to avoid flashes ~XBIOS(5,L:screen.2%,L:screen.1%,-1) ! swap the screens ' BMOVE screen.1%,screen.2%,32000 ! move fresh screen to screen.2 RETURN ' *** > PROCEDURE restore.physical.screen ' *** restore default situation (logical screen = physical screen) ~XBIOS(5,L:physbase%,L:physbase%,-1) RETURN ' ********** ' > PROCEDURE screen.black.out ' *** clear screen with shrinking black rectangle ' *** uses Standard Globals LOCAL i COLOR black FOR i=0 TO scrn.y.max/2 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR white FOR i=scrn.y.max/2 DOWNTO 0 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR black RETURN ' ********** ' > PROCEDURE screen.dimmer ' *** dimm screen (during some action) ' *** High resolution only ' *** global : DIMMER.SCREEN$ DIMMER.SWITCH! IF dimmer.switch! SPUT dimmer.screen$ ' CLR dimmer.screen$ ! if you need space dimmer.switch!=FALSE ELSE SGET dimmer.screen$ GRAPHMODE 4 DEFFILL 1,2,4 PBOX 0,0,639,399 dimmer.switch!=TRUE ENDIF RETURN ' ********** ' > PROCEDURE screen.black.lines ' *** clear screen with lines ' *** uses Standard Globals LOCAL i,j COLOR black FOR j=0 TO 9 FOR i=j TO SUCC(scrn.y.max) STEP 10 LINE 0,i,scrn.x.max,i NEXT i PAUSE 1 NEXT j CLS RETURN ' ********** ' > PROCEDURE screen.black.scroll ' *** clear screen with upwards scrolling black rectangle ' *** uses Standard Globals LOCAL i COLOR black FOR i=scrn.y.max DOWNTO 0 LINE 0,i,scrn.x.max,i NEXT i COLOR white PAUSE 10 FOR i=scrn.y.max DOWNTO 0 LINE 0,i,scrn.x.max,i NEXT i COLOR black RETURN ' ********** ' > PROCEDURE invert.block(x1,y1,x2,y2,color) ' *** invert block (e.g. to acknowledge user's choice) ' *** call Procedure second time (with same parameters) to restore block GRAPHMODE 3 DEFFILL color,1 BOUNDARY 0 PBOX x1,y1,x2,y2 BOUNDARY 1 GRAPHMODE 1 RETURN ' ********** ' > PROCEDURE block.dimmer(x1,y1,x2,y2,color) ' *** dimm block (e.g. for selection that is temporarily not available) ' *** call Procedure second time (with same parameters) to restore block GRAPHMODE 3 DEFFILL color,2,2 BOUNDARY 0 PBOX x1,y1,x2,y2 BOUNDARY 1 GRAPHMODE 1 RETURN ' ********** ' > PROCEDURE show.degas(degas$) ' *** put Degas-picture on screen (and use picture-palette) ' *** uses Standard Globals ' *** global : SHOW.DEGAS! LOCAL r$,degas.picture$,degas.picture%,degas.palette$,degas.palette% r$=UPPER$(RIGHT$(degas$,3)) IF (high.res! AND r$="PI3") OR (med.res! AND r$="PI2") OR (low.res! AND r$="PI1") degas.picture$=SPACE$(32000) degas.picture%=VARPTR(degas.picture$) degas.palette$=SPACE$(32) degas.palette%=VARPTR(degas.palette$) OPEN "I",#90,degas$ SEEK #90,2 BGET #90,degas.palette%,32 ! load palette of picture SEEK #90,34 BGET #90,degas.picture%,32000 ! load actual picture CLOSE #90 ~XBIOS(6,L:degas.palette%) ! change palette SPUT degas.picture$ ! show the picture show.degas!=TRUE ! success ELSE show.degas!=FALSE ! failure ENDIF RETURN ' ********** ' > PROCEDURE save.degas(file$) ' *** save current screen as Degas-picture ' *** use correct extension (PI1=Low, PI2=Medium, PI3=High) ' *** uses Standard Globals and Standard Procedure Exit LOCAL screen$,degas.palette$,n%,degas$,res$,m$,k SGET screen$ file$=UPPER$(file$) degas.palette$="" FOR n%=0 TO 15 degas.palette$=degas.palette$+MKI$(XBIOS(7,n%,-1)) NEXT n% IF high.res! AND RIGHT$(file$,3)="PI3" res$=MKI$(2) ELSE IF med.res! AND RIGHT$(file$,3)="PI2" res$=MKI$(1) ELSE IF low.res! AND RIGHT$(file$,3)="PI1" res$=MKI$(0) ELSE m$="wrong extension|for Degas|in this|resolution" ALERT 3,m$,1," OK ",k @exit ENDIF degas$=res$+degas.palette$+screen$ BSAVE file$,VARPTR(degas$),LEN(degas$) RETURN ' ********** ' > PROCEDURE show.comp.degas(degas.file$) ' *** put compressed Degas-picture on screen (and use picture-palette) ' *** original routine by Jim Kent ' *** uses Standard Globals ' *** global : SHOW.COMP.DEGAS! LOCAL r$,temp$,p%,temp2$,b%,i%,k%,p%,q%,scr%,screen% show.comp.degas!=FALSE ' ' *** load UNPAC.INL (60 bytes) here INLINE unpac%,60 ' ' *** load UNRAV.INL (40 bytes) here INLINE unrav%,40 ' IF degas.file$<>"" r$=UPPER$(RIGHT$(degas.file$,3)) IF EXIST(degas.file$) AND MID$(r$,2,1)="C" temp$=SPACE$(32760) p%=VARPTR(temp$) BLOAD degas.file$,p% screen%=physbase% ! picture appears on screen while decompressing temp2$=SPACE$(40) b%=VARPTR(temp2$) p%=p%+2 FOR i%=0 TO 15 SETCOLOR i%,DPEEK(p%) ADD p%,2 NEXT i% IF high.res! AND r$="PC3" FOR k%=1 TO 400 scr%=screen% p%=C:unpac%(L:p%,L:b%,80) q%=C:unrav%(L:b%,L:scr%,80,2) ADD screen%,80 NEXT k% show.comp.degas!=TRUE ELSE IF med.res! AND r$="PC2" FOR k%=1 TO 200 scr%=screen% FOR c%=1 TO 2 p%=C:unpac%(L:p%,L:b%,80) q%=C:unrav%(L:b%,L:scr%,80,4) ADD scr%,2 NEXT c% ADD screen%,160 NEXT k% show.comp.degas!=TRUE ELSE IF low.res! AND r$="PC1" FOR k%=1 TO 200 scr%=screen% FOR c%=1 TO 4 p%=C:unpac%(L:p%,L:b%,40) q%=C:unrav%(L:b%,L:scr%,40,8) ADD scr%,2 NEXT c% ADD screen%,160 NEXT k% show.comp.degas!=TRUE ENDIF ELSE ALERT 1,"Can't find|compressed|Degas-file|"+degas.file$,1,"EDIT",button EDIT ENDIF ENDIF RETURN ' ********** ' > PROCEDURE blend(scrn.adr%,mode%,delay) ' *** fade-over of current screen with other screen (e.g. picture) ' *** mode% determines effect (= stepsize; 1, 32000) ' *** try mode% 1,7,8 or 9 ' *** delay determines time ( 0) ' ' *** load BLEND.INL (68 bytes) here INLINE blend%,68 ' VOID C:blend%(L:scrn.adr%,L:mode%,delay) RETURN ' ********** ' > PROCEDURE full.fill(fill$) ' *** fill screen extremely fast with Fill-pattern fill$ ' *** use Procedure Initio.fill or Initio.high.fill1 to create fill$ ' *** High resolution only LOCAL fill% fill%=V:fill$ CLS ACLIP 1,0,0,639,399 ARECT 0,0,639,399,1,0,fill%,15 ACLIP 0,0,0,639,399 RETURN ' ********** ' ' ****************** ' *** SCROLL.LST *** ' ****************** ' DEFWRD "a-z" ' > PROCEDURE initio.scroll ' *** install second screen as logical screen for scrolling ' *** prepare (invisible) logical screen ' *** then call any of the following scroll-Procedures ' *** Procedures use Standard Global physbase% ' *** global : SCROLL.SCREEN% SCROLL! IF NOT scroll! ! create logical screen if necessary scroll!=TRUE DIM scroll.screen|(32256) scroll.screen%=V:scroll.screen|(0) scroll.screen%=scroll.screen%+256-(scroll.screen% MOD 256) ENDIF ~XBIOS(5,L:scroll.screen%,L:-1,-1) ! scroll-screen is now logical screen RETURN ' ***** > PROCEDURE up.scroll(scroll.lines) ' *** scroll-screen scrolled upwards ' *** slow scroll : 1 or 2 lines (interference on 1/3 and 2/3 of height ??) ' *** fast scroll : 8 (Low) or 16 (High/Med) lines ' *** after actual scroll, a dummy scroll follows for constant scroll-speed ' *** uses Standard Globals LOCAL bytes,n,end%,offset% IF high.res! LET bytes=80*scroll.lines ELSE LET bytes=160*scroll.lines ENDIF end%=physbase%+32000 offset%=32000+bytes FOR n=1 TO scrn.y.max/scroll.lines n.bytes%=MUL(n,bytes) BMOVE scroll.screen%,SUB(end%,n.bytes%),n.bytes% BMOVE scroll.screen%,scroll.screen%,SUB(offset%,n.bytes%) NEXT n BMOVE scroll.screen%,physbase%,32000 ! tidy up ~XBIOS(5,L:physical.screen%,L:-1,-1) ! back to normal RETURN ' ***** > PROCEDURE slider.scroll ' *** fade-over with slider-effect ' *** High resolution only LOCAL y,y2 FOR y=4 TO 400 STEP 2 y2=SUB(400,y) RC_COPY scroll.screen%,0,y2,160,y TO physbase%,0,0 RC_COPY scroll.screen%,160,0,160,y TO physbase%,160,y2 RC_COPY scroll.screen%,320,y2,160,y TO physbase%,320,0 RC_COPY scroll.screen%,480,0,160,y TO physbase%,480,y2 NEXT y ~XBIOS(5,L:physbase%,L:-1,-1) ! back to normal RETURN ' ***** > PROCEDURE stripes.scroll(n) ' *** fade-over with luxaflex-effect ' *** High resolution only ' *** try n=3 LOCAL i,j,x,y FOR i=0 TO 39 x=MUL(i,80) FOR j=0 TO 9 y=ADD(MUL(j,3200),x) BMOVE ADD(scroll.screen%,y),ADD(physbase%,y),80 NEXT j PAUSE n NEXT i ~XBIOS(5,L:physbase%,L:-1,-1) ! back to normal RETURN ' ***** > PROCEDURE random.scroll(n) ' *** fade-over with random lines ' *** High resolution only ' *** try n=0 or n=1 LOCAL i,j,z DIM ran.scroll(399) FOR i=0 TO 399 ran.scroll(i)=i NEXT i FOR i=399 DOWNTO 0 j=RAND(SUCC(i)) ! integer 0-i SWAP ran.scroll(i),ran.scroll(j) NEXT i FOR i=0 TO 399 z=ran.scroll(i)*80 BMOVE ADD(scroll.screen%,z),ADD(physbase%,z),80 PAUSE n NEXT i ERASE ran.scroll() ~XBIOS(5,L:physbase%,L:-1,-1) ! back to normal RETURN ' ***** > PROCEDURE middle.scroll(n) ' *** fade-over with zoom from center ' *** High resolution only ' *** try n=1 LOCAL x,y,xp,yp FOR y=5 TO 400 STEP 5 x=y*1.6 xp=SHR(SUB(640,x),1) yp=SHR(SUB(400,y),1) RC_COPY scroll.screen%,xp,yp,x,y TO physbase%,xp,yp PAUSE n NEXT y ~XBIOS(5,L:physbase%,L:-1,-1) ! back to normal RETURN ' ***** > PROCEDURE dropline.scroll(n) ' *** fade-over with dropping lines *** BUG *** ' *** High resolution only ' *** try n=1 LOCAL i,j,adr2% FOR i=396 TO 0 STEP -4 adr2%=ADD(scroll.screen%,MUL(i,80)) PAUSE n FOR j=0 TO i STEP 4 BMOVE adr2%,ADD(physbase%,MUL(j,80)),320 NEXT j NEXT i ~XBIOS(5,L:physbase%,L:-1,-1) ! back to normal RETURN ' ***** > PROCEDURE spiral.scroll(n) ' *** fade-over with spirals ' *** High resolution only ' *** try n=1 LOCAL x,y,c,m,i x=320 y=200 c=0 m=1 REPEAT FOR i=1 TO m RC_COPY scroll.screen%,x,y,64,40 TO physbase%,x,y PAUSE n SELECT c MOD 4 CASE 0 SUB x,64 CASE 1 SUB y,40 CASE 2 ADD x,64 CASE 3 ADD y,40 ENDSELECT NEXT i INC c IF EVEN(c) INC m ENDIF UNTIL c=19 ~XBIOS(5,L:physbase%,L:-1,-1) ! back to normal RETURN ' ********** ' > PROCEDURE scroll.up(scroll.lines,scroll.color) ' *** scroll screen upwards ' *** for reasonably smooth scrolling, use 2 or 3 lines ' *** for fast scroll, use 8 (Low rez) or 16 (High/Med rez) lines ' *** uses Standard Globals LOCAL n,bytes,move.bytes,source% IF high.res! LET bytes=80*scroll.lines ELSE LET bytes=160*scroll.lines ENDIF move.bytes=32000-bytes source%=physbase%+bytes VSYNC BMOVE source%,physbase%,move.bytes ! 1st scroll DEFFILL scroll.color PBOX 0,scrn.y.max-scroll.lines+1,scrn.x.max,scrn.y.max ! clear bottom, FOR n=1 TO DIV(scrn.y.max,scroll.lines) ! here we go VSYNC BMOVE source%,physbase%,move.bytes NEXT n RETURN ' ********** ' > PROCEDURE scroll.down(scroll.lines,scroll.color) ' *** scroll screen downwards ' *** for reasonably smooth scrolling, use 2 or 3 lines ' *** for fast scroll, use 8 (Low rez) or 16 (High/Med rez) lines ' *** (interference line on 1/3 and 2/3 of screenheight, why ??) ' *** uses Standard Globals LOCAL n,bytes,move.bytes,dest% IF high.res! LET bytes=80*scroll.lines ELSE LET bytes=160*scroll.lines ENDIF move.bytes=32000-bytes dest%=physbase%+bytes VSYNC BMOVE physbase%,dest%,move.bytes ! 1st scroll DEFFILL scroll.color PBOX 0,0,scrn.x.max,scroll.lines-1 ! clear top, FOR n=1 TO DIV(scrn.y.max,scroll.lines) ! here we go VSYNC BMOVE physbase%,dest%,move.bytes NEXT n RETURN ' ********** ' ' ******************* ' *** SORTINT.LST *** ' ******************* ' DEFWRD "a-z" ' > PROCEDURE quick.sort.int(VAR proc%()) ' *** sort integer array by recursive Quick Sort LOCAL last,dummy% last=DIM?(proc%())-1 @quick.int(1,last) RETURN ' *** > PROCEDURE quick.int(l,r) LOCAL ll,rr,i,x,j ll=l rr=r dummy%=proc%(DIV(ADD(l,r),2)) REPEAT WHILE proc%(l)dummy% DEC r WEND IF l<=r SWAP proc%(l),proc%(r) INC l DEC r ENDIF UNTIL l>r IF ll PROCEDURE shell.sort.int(VAR proc%()) ' *** sort integer array by Shell Sort LOCAL inc,last,j,k,inserted!,x%,current,previous last=DIM?(proc%())-1 LET inc=last WHILE inc>1 DIV inc,2 FOR j=1 TO inc k=ADD(j,inc) WHILE k<=last inserted!=FALSE x%=proc%(k) current=k previous=SUB(current,inc) WHILE previous>=j AND NOT inserted! IF x% PROCEDURE bin.search.int(element%,VAR proc%(),index) ' *** find element% in sorted integer array (binary search) ' *** global : FOUND! LOCAL first,last,middle first=1 last=DIM?(proc%())-1 WHILE firstproc%(middle) first=ADD(middle,1) ELSE last=middle ENDIF WEND found!=(proc%(first)=element%) IF found! index=first ELSE index=0 ENDIF RETURN ' ********** ' > PROCEDURE bin.search.word(element,VAR proc(),index) ' *** find element in sorted word array (binary search) ' *** global : FOUND! LOCAL first,last,middle first=1 last=DIM?(proc())-1 WHILE firstproc(middle) first=ADD(middle,1) ELSE last=middle ENDIF WEND found!=(proc(first)=element) IF found! index=first ELSE index=0 ENDIF RETURN ' ********** ' ' ******************* ' *** SORTSTR.LST *** ' ******************* ' DEFWRD "a-z" ' > PROCEDURE bin.search.string(element$,VAR proc$(),index) ' *** find element$ in sorted string array (binary search) ' *** global : FOUND! LOCAL first,last,middle first=1 last=DIM?(proc$())-1 WHILE firstproc$(middle) first=ADD(middle,1) ELSE last=middle ENDIF WEND found!=(proc$(first)=element$) IF found! index=first ELSE index=0 ENDIF RETURN ' ********** ' > PROCEDURE ascii.qsort(VAR txt$()) ' *** 'true' alphabetical sorting of string-array IF DIM?(ascii|())=0 @initio.ascii.array ENDIF QSORT txt$() WITH ascii|() RETURN ' *** > PROCEDURE initio.ascii.array ' *** ASCII byte-array to be used with QSORT (or SSORT) ' *** global : ASCII|() LOCAL i,code1,code2 DIM ascii|(255) ARRAYFILL ascii(),32 ! fill with space-character FOR i=48 TO 57 ascii|(i)=i ! 0 - 9 NEXT i FOR i=65 TO 90 ascii|(i)=i ! A - Z NEXT i FOR i=97 TO 122 ascii|(i)=SUB(i,32) ! a - z, converted to A - Z NEXT i RESTORE ascii.data REPEAT READ code1,code2 ascii|(code1)=code2 UNTIL code1=0 ' ascii.data: ' *** format : ASCII-code,replacement DATA 128,67,129,85,130,69,131,65,132,65,133,65,134,65,135,67,136,69,137,69 DATA 138,69,139,73,140,73,141,73,142,65,143,65,144,69,145,65,146,65,147,79 DATA 148,79,149,79,150,85,151,85,152,121,153,79,154,85,155,67,158,83,160,65 DATA 161,73,162,79,163,85,164,78,165,78,166,65,167,79,176,65,177,79,178,79 DATA 179,79,180,79,181,79,182,65,183,65,184,79,192,121,193,121,225,83,0,0 RETURN ' ********** ' > PROCEDURE string.index.qsort(switch!,VAR txt$(),index%()) ' *** fills index-array with index-numbers of sorted string-array ' *** string-array txt$() is not changed ! ' *** the index-array has to exist already (DIM before calling this Procedure) ' *** if switch!=TRUE, array ascii|() is used for 'true' alphabetical sorting ' *** all elements (0 - last) are sorted, element txt$(0) is NOT ignored !! ' *** index-array should be used like this : ' FOR i=0 TO last ' PRINT txt$(index%(i)) ' NEXT i LOCAL last,i last=DIM?(txt$())-1 ! index of last element DIM temp$(last) FOR i=0 TO last temp$(i)=txt$(i) NEXT i FOR i=0 TO last index%(i)=i NEXT i IF switch! IF DIM?(ascii|())=0 @initio.ascii.array ENDIF QSORT temp$() WITH ascii|(),last+1,index%() ELSE QSORT temp$(),last+1,index%() ENDIF ERASE temp$() RETURN ' ********** ' ' ***************** ' *** SOUND.LST *** ' ***************** ' DEFWRD "a-z" ' > PROCEDURE beep(number) LOCAL i FOR i=1 TO number PRINT CHR$(7); PAUSE 10 NEXT i RETURN ' ********** ' > PROCEDURE alarm.sound ' *** ta-ti-ta sound (warning) SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 RETURN ' ********** ' > PROCEDURE siren1.sound(number) ' *** siren (length determined by number) LOCAL n,i FOR n=1 TO number FOR i=1 TO 8 SOUND 1,15,i,4,1 NEXT i PAUSE 5 FOR i=1 TO 8 SOUND 1,15,i,4,1 NEXT i PAUSE 5 NEXT n WAVE 0,0 RETURN ' ********** ' > PROCEDURE tideli.sound SOUND 0,15,2,3,5 SOUND 0,15,2,4,5 SOUND 0,15,2,3,5 SOUND 0,15,2,5,5 SOUND 0,15,2,3,5 SOUND 0,15,2,6,10 SOUND 0,0 RETURN ' ********** ' > PROCEDURE bounce1.sound(pause) LOCAL n FOR n=15 DOWNTO 0 SOUND 1,n,5,1 SOUND 2,n,12,2 SOUND 3,n,5,4 WAVE 7 PAUSE pause SOUND 3,n,5,5 PAUSE pause NEXT n WAVE 0,0 RETURN ' ********** ' > PROCEDURE bounce2.sound(pause) LOCAL n FOR n=15 DOWNTO 0 SOUND 1,n,1,3 SOUND 2,n,5,3 SOUND 3,n,1,4 WAVE 7 PAUSE pause SOUND 3,n,1,5 PAUSE pause NEXT n WAVE 0,0 RETURN ' ********** ' > PROCEDURE tong.sound SOUND 1,10,1,5 WAVE 1,1,3,6000,10 RETURN ' ********** ' > PROCEDURE poof.sound WAVE 56,7,0,20000,0 RETURN ' ********** ' > PROCEDURE clang.sound SOUND 1,14,1,5 SOUND 2,14,5,7 SOUND 3,14,8,6 WAVE 7,7,9,17391 RETURN ' ********** ' > PROCEDURE heartbeat.sound SOUND 1,9,1,4 SOUND 2,7,1,4 SOUND 3,10,1,1 WAVE 7739,3,8,4964 RETURN ' ********** ' > PROCEDURE ting.sound SOUND 1,15,10,6 SOUND 2,0,1,1 SOUND 3,0,12,1 WAVE 1,1,9,12085 RETURN ' ********** ' > PROCEDURE pompom.sound ' *** play Pompom-tune (XBIOS 32 format) ' ' *** load POMPOM.INL (384 bytes) here INLINE pompom.snd%,384 ' ~XBIOS(32,L:pompom.snd%) PAUSE 400 WAVE 0,0 RETURN ' ********** ' > PROCEDURE initio.sound ' *** put sound-data in string (XBIOS 32 format) ' *** commands in DATA-lines : ' *** REG = 14 parameters for registers 0-13 ' *** END = end of sound-string ' *** PAUSE = pause (followed by time in 1/50 seconds) ' *** VAR = decrease/increase tone : channel,start,+/-step,end-value ' *** 'WAVE 0,0' terminates all sounds ' *** if Keyclick is on, any keypress will terminate sound ' *** uses Procedure Sound.string ' *** use soundstring : @do.sound(sound$) ' bounce3.sound: DATA REG,0,0,0,0,0,0,27,248,16,16,16,35,95,0 DATA VAR,3,255,-1,116 DATA PAUSE,255,END RESTORE bounce3.sound @sound.string(bounce3$) ' bounce4.sound: DATA REG,0,216,4,219,5,0,0,254,16,0,0,223,118,0 DATA VAR,0,0,22,0,END RESTORE bounce4.sound @sound.string(bounce4$) ' bounce5.sound: DATA REG,82,2,251,13,34,0,0,248,16,0,0,0,86,0 DATA VAR,0,0,11,0,END RESTORE bounce5.sound @sound.string(bounce5$) ' bounce6.sound: DATA REG,0,0,0,0,0,0,0,252,16,0,0,20,70,0 DATA VAR,1,0,1,255,END RESTORE bounce6.sound @sound.string(bounce6$) ' tingeling.sound: DATA REG,0,0,0,0,0,0,23,248,16,16,16,130,62,0 DATA VAR,0,255,-106,116 DATA PAUSE,255,END RESTORE tingeling.sound @sound.string(tingeling$) ' tingeling2.sound: DATA REG,0,0,0,0,0,0,0,254,16,0,0,207,88,0 DATA VAR,0,0,41,0,END RESTORE tingeling2.sound @sound.string(tingeling2$) ' siren2.sound: DATA REG,0,1,0,0,0,0,0,8,15,0,0,0,0,0,0,10 DATA VAR,0,1,10,0,END RESTORE siren2.sound @sound.string(siren2$) ' chopper.sound: DATA REG,176,0,238,1,119,12,26,227,16,11,14,111,2,12,END RESTORE chopper.sound @sound.string(chopper$) ' surf.sound: DATA REG,0,0,0,0,0,0,31,199,16,16,16,0,32,14,END RESTORE surf.sound @sound.string(surf$) ' ting2.sound: DATA REG,200,0,201,0,100,0,0,248,16,16,16,0,20,0,END RESTORE ting2.sound @sound.string(ting2$) ' ding.sound: DATA REG,64,1,56,1,0,0,0,252,16,16,0,20,20,0,END RESTORE ding.sound @sound.string(ding$) ' ploink.sound: DATA REG,2,15,2,15,0,0,0,252,16,16,0,20,20,10 DATA VAR,1,240,-16,0 DATA PAUSE,10 DATA REG,2,15,2,15,0,0,0,252,0,0,0,20,20,10,END RESTORE ploink.sound @sound.string(ploink$) ' toing.sound: DATA REG,140,1,216,4,219,5,0,254,16,0,0,207,88,0 DATA VAR 0,0,41,0,END RESTORE toing.sound @sound.string(toing$) ' bell.sound: DATA REG,64,0,120,0,0,0,0,252,16,16,0,20,20,0,END RESTORE bell.sound @sound.string(bell$) ' gong.sound: DATA REG,1,5,0,5,2,5,0,248,16,16,16,0,20,1,END RESTORE gong.sound @sound.string(gong$) ' gong2.sound: DATA REG,210,3,232,3,209,7,0,248,16,16,16,111,163,0,END RESTORE gong2.sound @sound.string(gong2$) ' gong3.sound: DATA REG,0,13,0,12,0,15,0,248,16,16,16,200,200,2 DATA PAUSE,250,END RESTORE gong3.sound @sound.string(gong3$) ' dingdong.sound: DATA REG,65,1,64,1,66,1,0,248,16,16,16,255,70,1 DATA PAUSE,40 DATA REG,65,1,242,0,127,1,0,248,16,16,16,255,100,1,END RESTORE dingdong.sound @sound.string(dingdong$) ' pieuw.sound: DATA REG,1,0,0,0,0,0,0,254,16,0,0,0,35,1 DATA VAR,0,50,1,100,END RESTORE pieuw.sound @sound.string(pieuw$) ' poing.sound: DATA REG,1,0,0,0,0,0,0,254,16,0,0,0,35,1 DATA VAR,0,100,-1,50,END RESTORE poing.sound @sound.string(poing$) ' zap.sound: DATA REG,0,16,0,0,0,0,0,252,15,0,0,20,0,4 DATA VAR,1,0,1,15 DATA PAUSE,1 DATA REG,0,16,0,0,0,0,0,252,0,0,0,20,0,4,END RESTORE zap.sound @sound.string(zap$) ' dlink.sound: DATA REG,8,2,12,4,0,0,0,252,16,16,0,20,20,9 DATA VAR,0,200,-20,0 DATA PAUSE,1 DATA REG,8,2,12,4,0,0,0,252,0,0,0,20,20,9,END RESTORE dlink.sound @sound.string(dlink$) ' shot.sound: DATA REG,0,0,0,0,0,0,15,199,16,16,16,0,16,0 DATA PAUSE,25 DATA REG,0,0,0,0,0,0,15,199,0,0,0,0,16,0,END RESTORE shot.sound @sound.string(shot$) ' explosion1.sound: DATA REG,0,0,0,0,0,0,31,199,16,16,16,0,50,9,END RESTORE explosion1.sound @sound.string(explosion1$) ' explosion2.sound: DATA REG,0,0,100,0,200,0,31,198,16,16,16,207,88,0 DATA VAR,6,255,0,0,END RESTORE explosion2.sound @sound.string(explosion2$) ' laser.sound: DATA REG,100,0,200,0,50,0,31,220,16,0,16,127,37,0 DATA VAR,0,0,137,200 DATA PAUSE,128,END RESTORE laser.sound @sound.string(laser$) ' fft.sound: DATA REG,42,2,88,4,164,8,0,199,16,16,16,106,10,4 DATA VAR 4,124,54,164,END RESTORE fft.sound @sound.string(fft$) ' steam.sound: DATA REG,0,0,0,0,0,0,10,199,16,16,16,0,80,0 DATA PAUSE,20 DATA REG,0,0,0,0,0,0,10,255,0,0,0,0,80,100,END RESTORE steam.sound @sound.string(steam$) ' thrill.sound: DATA REG,86,0,86,0,0,0,0,252,16,15,0,50,1,10 DATA VAR,9,16,-1,0 DATA PAUSE,0 DATA REG,86,0,86,0,0,0,0,252,0,15,0,50,1,10,END RESTORE thrill.sound @sound.string(thrill$) ' jingle.sound: DATA REG,100,4,101,4,0,0,0,252,15,15,0,0,30,0 DATA PAUSE,5 DATA REG,100,3,101,3,0,0,0,252,15,15,0,0,30,0 DATA PAUSE,5 DATA REG,100,2,101,2,0,0,0,252,15,15,0,0,30,0 DATA PAUSE,5 DATA REG,100,1,101,1,0,0,0,252,15,15,0,0,30,0 DATA PAUSE,5 DATA REG,100,0,101,0,0,0,0,252,16,16,0,0,30,0,END RESTORE jingle.sound @sound.string(jingle$) ' RETURN ' *** > PROCEDURE sound.string(VAR s$) LOCAL n,snd$,snd,channel,begin,step,end s$="" DO READ snd$ snd$=UPPER$(snd$) EXIT IF snd$="END" IF snd$="REG" FOR n=0 TO 13 READ snd s$=s$+CHR$(n)+CHR$(snd) NEXT n ENDIF IF snd$="PAUSE" READ snd s$=s$+CHR$(130)+CHR$(snd) ENDIF IF snd$="VAR" READ channel,begin,step,end s$=s$+CHR$(128)+CHR$(begin)+CHR$(129)+CHR$(channel)+CHR$(step) s$=s$+CHR$(end) ENDIF LOOP s$=s$+CHR$(255)+CHR$(0) ! terminator RETURN ' *** > PROCEDURE do.sound(sound$) VOID XBIOS(32,L:VARPTR(sound$)) RETURN ' ********** ' > PROCEDURE initio.speech ' *** uses STSPEECH.TOS to speak ' *** RESERVE doesn't function, therefore reset necessary ' *** don't be surprised by a sudden freeze or some bombs ' *** routine by Dave Morrison ' *** uses Standard Procedure LOCAL i%,k%,bpage%,prg%,phoneme$,speech$,m$ file$="I:\HIGH_MED\SOUND\STSPEECH.TOS" ! or other path IF NOT EXIST(file$) ALERT 3,"Can't find| |STSPEECH.TOS|",1,"EXIT",button @exit ENDIF RESERVE FRE(0)-29000 bpage%=EXEC(3,file$,"","") IF bpage%>0 prg%=bpage%+&H100 POKE prg%+&HE,&H4E POKE prg%+&HF,&H75 POKE prg%+&H6C,&H4E POKE prg%+&H6D,&H75 speech_buf%=prg%+&H6EEE POKE speech_buf%,&HFE phoneme%=prg%+&H32 speech%=prg%+&H88 RESTORE speech_data FOR i%=1 TO 6 READ k% phoneme$=phoneme$+CHR$(k%) speech$=speech$+CHR$(k%) NEXT i% phoneme$=phoneme$+MKL$(phenome%) speech$=speech$+MKL$(speech%) FOR i%=1 TO 6 READ k% phoneme$=phoneme$+CHR$(k%) speech$=speech$+CHR$(k%) NEXT i% phoneme%=VARPTR(phoneme$) speech%=VARPTR(speech$) ELSE m$="*** ERROR ***| |EXEC 3 returns| "+STR$(bpage%) ALERT 3,m$,1,"EXIT",k @exit ENDIF ' speech_data: DATA &h48,&he7,&hff,&hfe,&h4e,&hb9,&h4c,&hdf,&h7f,&hff,&h4e,&h75 RETURN ' *** > PROCEDURE talk(txt$) ' *** use phonetic spelling to improve pronunciation POKE speech_buf%+1,LEN(txt$) txt$=txt$+CHR$(0) BMOVE VARPTR(txt$),speech_buf%+2,LEN(txt$) CALL phoneme% CALL speech% PAUSE 5 RETURN ' ********** ' > PROCEDURE load.sample(file$,VAR sample|()) ' *** load sample in byte-array LOCAL m$,length%,sample% IF EXIST(file$) OPEN "I",#90,file$ length%=LOF(#90) CLOSE #90 ERASE sample|() DIM sample|(length%-1) sample%=V:sample|(0) BLOAD file$,sample% ELSE m$="Can't find|sample-file|"+file$+"| !!??" ALERT 3,m$,1,"EDIT",k EDIT ENDIF RETURN ' *** > PROCEDURE play.sample(speed%,VAR sample|()) ' *** play sample (loaded with Procedure Load.sample) ' *** try speed% 0-10 LOCAL bascode%,length%,start% ' ' *** load BASCODE.INL (2794 bytes) here (= BASCODE.EXE from program Replay) ' *** don't worry about the message 'End of file reached' after loading INLINE bascode%,8000 ' length%=DIM?(sample|()) adres%=V:sample|(0) start%=bascode%+28 LONG{start%+2}=adres% LONG{start%+6}=length% LONG{start%+10}=speed% CALL start% RETURN ' ********** ' > PROCEDURE sample ' *** play sample (a short after this Procedure PAUSE may be necessary) LOCAL bascode%,sample%,start% ' ' *** load BASCODE.INL (2794 bytes) here (= BASCODE.EXE from program Replay) ' *** don't worry about the message 'end of file reached' after loading INLINE bascode%,8000 ' ' *** load sample here (change length, max. 32746 bytes) INLINE sample%,10000 ' start%=bascode%+28 LONG{start%+2}=sample% LONG{start%+6}=10000 ! change length here as well LONG{start%+10}=2 ! try speed 0-10 for best effect CALL start% RETURN ' ********** ' STANALL LSTS +#STANHIGHLSTS STANHIMELSTS STANLOW LSTS STANMED LSTS TEXT LSTS Y%TIME LST¼S :' *** STANALL.LST *** (delete this line) ' ' ============================================================================== ' ******************** ' *** .GFA *** ' ******************** ' *** this program runs in all resolutions ' ' ------------------------------------------------------------------------------ ' *** Initiation *** ' DEFWRD "a-z" ! word variables (-32768 to +32767) default !! @initio ' ' @title.screen("TITLE",".. .... 1990",32) ! activate in finished program ' ON BREAK GOSUB break ! activate in finished program ' ' ------------------------------------------------------------------------------ ' *** Main Program *** ' ' ' EDIT ! use this while developing program ' @exit ! use this in finished program ' ' ------------------------------------------------------------------------------ ' *** Standard Globals and Array *** ' > PROCEDURE initio LOCAL w,h,n ' CLS ' @get.path(default.path$) ' physbase%=XBIOS(2) ! physical screen logbase%=XBIOS(3) ! logical screen ' SELECT XBIOS(4) CASE 2 high.res!=TRUE scrn.x.max=WORK_OUT(0) ! 639 (regular monitor) scrn.y.max=WORK_OUT(1) ! 399 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x16 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 80 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 CASE 1 med.res!=TRUE scrn.x.max=WORK_OUT(0) ! 639 (regular monitor) scrn.y.max=WORK_OUT(1) ! 199 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x8 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 80 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 CASE 0 low.res!=TRUE scrn.x.max=WORK_OUT(0) ! 319 (regular monitor) scrn.y.max=WORK_OUT(1) ! 199 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x8 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 40 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 ENDSELECT ' IF high.res! white=0 black=1 red=black ! change red and green to black if in High resolution green=black DEFTEXT black,0,0,13 ELSE white=0 ! default Medium colors (avoid other colors) black=1 red=2 green=3 DEFTEXT black,0,0,6 ENDIF ' ' *** create Standard Array color.index() ' *** use this array to convert a VDI color-index into a 'SETCOLOR'-index ' *** try to avoid color-index 4-15 (black in High and Medium resolution) DIM color.index(15) IF high.res! RESTORE col.index.high col.index.high: DATA 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 ENDIF IF med.res! RESTORE col.index.med col.index.med: DATA 0,3,1,2,3,3,3,3,3,3,3,3,3,3,3,3 ENDIF IF low.res! RESTORE col.index.low col.index.low: DATA 0,15,1,2,4,6,3,5,7,8,9,10,12,14,11,13 ENDIF FOR n=0 TO 15 READ color.index(n) NEXT n ' ' *** default palette IF high.res! VSETCOLOR 1,0 ENDIF IF med.res! @standard.med.colors ENDIF IF low.res! @standard.low.colors ENDIF ' on!=TRUE off!=FALSE ' bel$=CHR$(7) ' return$=CHR$(13) esc$=CHR$(27) help$=CHR$(0)+CHR$(98) undo$=CHR$(0)+CHR$(97) ' interpreter$="\GFABASIC.PRG" ! change path if necessary run.only$="\GFABASRO.PRG" ! Run-Only Interpreter IF EXIST("\START.GFA") start.gfa$="\START.GFA" ! 'Shell' for GFA-programs (High or Medium rez) ELSE start.gfa$="\STARTLOW.GFA" ! 'Shell' for Low resolution ENDIF start.prg$="\GFASTART.PRG" ! 'Shell' for compiled GFA-programs ' RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Standard Functions *** ' DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$ DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" ' ' ------------------------------------------------------------------------------ ' *** Standard Procedures *** ' PROCEDURE get.path(VAR default.path$) ' *** return default path (current drive and folder) ' *** example - A:\GAMES\ ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\ ' *** (even if program not in main directory !!) LOCAL default.drive,default.drive$ CLR default.path$ default.drive=GEMDOS(&H19) default.drive$=CHR$(default.drive+65) default.path$=DIR$(default.drive+1) IF default.path$<>"" default.path$=default.drive$+":"+default.path$+"\" ELSE default.path$=default.drive$+":\" ENDIF RETURN ' ********** ' PROCEDURE standard.med.colors ' *** standard-colors for Medium resolution LOCAL n,col$,r,g,b RESTORE stand.med.col FOR n=0 TO 3 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' stand.med.col: DATA 777,000,700,060 RETURN ' ********** ' PROCEDURE standard.low.colors ' *** standard-colors for Low resolution LOCAL n,col$,r,g,b RESTORE stand.low.col FOR n=0 TO 15 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' stand.low.col: DATA 777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770 RETURN ' ********** ' PROCEDURE title.screen(title$,datum$,height) ' *** standard title-screen ' *** uses Standard Globals and Standard Procedure Return.key LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i CLS HIDEM DEFTEXT black,8,0,height x=(scrn.x.max-LEN(title$)*height/2)/2 y=scrn.y.max/2 TEXT x,y,title$ LET name$=" Han Kempen" ! that's me col=(scrn.col.max-12)/2 lin=scrn.lin.max/2+6 PRINT AT(col,lin);name$ x1=(col-2)*8 y1=(lin-1)*char.height-4 x2=x1+LEN(name$)*8+16 y2=y1+char.height+8 BOX x1,y1,x2,y2 DEFLINE 1,3 DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3 LINE x1+3,y2+1,x2+2,y2+1 PRINT AT(col,lin+2);datum$ @return.key COLOR black DEFLINE 1,1 FOR i=0 TO y BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR white FOR i=y DOWNTO 0 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR black CLS RETURN ' ********** ' PROCEDURE return.key ' *** wait for ' *** after pressing any other key, flashing 'RETURN' is turned off ' *** uses Standard Globals LOCAL w1$,w2$,temp$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 ! restore screen WHILE in$<>return$ ! wait for in$=INKEY$ WEND RETURN ' ********** ' PROCEDURE break ' *** activate in main program with : ON BREAK GOSUB break ' *** do not use while developing program ! LOCAL m$,k ON BREAK CONT m$="*** Break ***|Continue,|Run again|or Quit" ALERT 3,m$,1,"CONT|RUN|QUIT",k SELECT k CASE 1 ON BREAK ! true break possible for emergency m$="Freeze current|screen (press|any key to|continue)" ALERT 2,m$,2,"YES|NO",k IF k=1 REPEAT UNTIL LEN(INKEY$) OR MOUSEK ENDIF ON BREAK GOSUB break CASE 2 RUN CASE 3 @exit ENDSELECT RETURN ' ********** ' PROCEDURE exit ' *** exit program CLS IF EXIST(interpreter$) OR EXIST(run.only$) ' *** program was run from (Run-Only) Interpreter IF EXIST(start.gfa$) CHAIN start.gfa$ ! back to 'shell'-program ELSE EDIT ! no shell ENDIF ELSE IF EXIST(start.gfa$) ' *** can't find interpreter, but here is the 'shell'-program CHAIN start.gfa$ ELSE IF EXIST(start.prg$) ' *** compiled program started from shell CHAIN start.prg$ ! back to shell ELSE ' *** compiled program SYSTEM ! no shell ENDIF RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Procedures *** ' ' ' ' ' ------------------------------------------------------------------------------ ' *** The End *** ' ============================================================================== ' *** STANHIGH.LST *** (delete this line) ' ' ============================================================================== ' ******************** ' *** .GFA *** ' ******************** ' *** this program runs in High resolution only ' ' ------------------------------------------------------------------------------ ' *** Initiation *** ' DEFWRD "a-z" ! word variables (-32768 to +32767) default !! @initio ' ' @title.screen("TITLE",".. .... 1990",32) ! activate in finished program ' ON BREAK GOSUB break ! activate in finished program ' ' ------------------------------------------------------------------------------ ' *** Main Program *** ' ' ' EDIT ! use this while developing program ' @exit ! use this in finished program ' ' ------------------------------------------------------------------------------ ' *** Standard Globals *** ' > PROCEDURE initio LOCAL w,h ' CLS @high.mode ! test if High resolution high.res!=TRUE ! resolution-flag ' @get.path(default.path$) ! current folder ' physbase%=XBIOS(2) ! physical screen logbase%=XBIOS(3) ! logical screen ' scrn.x.max=WORK_OUT(0) ! x: 0-639 (regular monitor) scrn.y.max=WORK_OUT(1) ! y: 0-399 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x16 system-font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 80 columns scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 lines ' white=0 ! default colors black=1 VSETCOLOR 1,0 ! normal screen (black letters on white screen) DEFTEXT black,0,0,13 ! TEXT-font same as system-font ' ' *** create Standard Array color.index() DIM color.index(1) color.index(0)=0 color.index(1)=1 ' on!=TRUE ! switch-flags off!=FALSE ' bel$=CHR$(7) ! 'PRINT bel$;' for bell ' return$=CHR$(13) ! define some important keys esc$=CHR$(27) help$=CHR$(0)+CHR$(98) undo$=CHR$(0)+CHR$(97) ' interpreter$="\GFABASIC.PRG" ! change path if necessary run.only$="\GFABASRO.PRG" ! Run-Only Interpreter start.gfa$="\START.GFA" ! 'Shell' for GFA-programs start.prg$="\GFASTART.PRG" ! 'Shell' for compiled GFA-programs ' RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Standard Functions *** ' DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$ DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" ' ' ------------------------------------------------------------------------------ ' *** Standard Procedures *** ' > PROCEDURE high.mode ' *** uses Procedure Exit LOCAL m$,button IF XBIOS(4)<>2 SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 m$="Sorry, only|High resolution|for this|program !!" ALERT 3,m$,1," OK ",button @exit ENDIF RETURN ' ********** ' > PROCEDURE get.path(VAR default.path$) ' *** return default path (current drive and folder) ' *** example - A:\GAMES\ ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\ ' *** (even if program not in main directory !!) LOCAL default.drive,default.drive$ CLR default.path$ default.drive=GEMDOS(&H19) default.drive$=CHR$(default.drive+65) default.path$=DIR$(default.drive+1) IF default.path$<>"" default.path$=default.drive$+":"+default.path$+"\" ELSE default.path$=default.drive$+":\" ENDIF RETURN ' ********** ' > PROCEDURE title.screen(title$,datum$,height) ' *** standard title-screen ' *** uses Standard Globals and Standard Procedure Return.key LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i CLS HIDEM DEFTEXT black,8,0,height x=(scrn.x.max-LEN(title$)*height/2)/2 y=scrn.y.max/2 TEXT x,y,title$ LET name$=" Han Kempen" ! that's me col=(scrn.col.max-12)/2 lin=scrn.lin.max/2+6 PRINT AT(col,lin);name$ x1=(col-2)*8 y1=(lin-1)*char.height-4 x2=x1+LEN(name$)*8+16 y2=y1+char.height+8 BOX x1,y1,x2,y2 DEFLINE 1,3 DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3 LINE x1+3,y2+1,x2+2,y2+1 PRINT AT(col,lin+2);datum$ @return.key COLOR black DEFLINE 1,1 FOR i=0 TO y BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR white FOR i=y DOWNTO 0 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR black CLS RETURN ' ********** ' > PROCEDURE return.key ' *** wait for ' *** after pressing any other key, flashing 'RETURN' is turned off ' *** uses Standard Globals LOCAL w1$,w2$,temp$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 ! restore screen WHILE in$<>return$ ! wait for in$=INKEY$ WEND RETURN ' ********** ' > PROCEDURE break ' *** activate in main program with : ON BREAK GOSUB break ' *** do not use while developing program ! LOCAL m$,k ON BREAK CONT m$="*** Break ***|Continue,|Run again|or Quit" ALERT 3,m$,1,"CONT|RUN|QUIT",k SELECT k CASE 1 ON BREAK ! true break possible for emergency m$="Freeze current|screen (press|any key to|continue)" ALERT 2,m$,2,"YES|NO",k IF k=1 REPEAT UNTIL LEN(INKEY$) OR MOUSEK ENDIF ON BREAK GOSUB break CASE 2 RUN CASE 3 @exit ENDSELECT RETURN ' ********** ' > PROCEDURE exit ' *** exit program CLS IF EXIST(interpreter$) OR EXIST(run.only$) ' *** program was run from (Run-Only) Interpreter IF EXIST(start.gfa$) CHAIN start.gfa$ ! back to 'shell'-program ELSE EDIT ! no shell ENDIF ELSE IF EXIST(start.gfa$) ' *** can't find interpreter, but here is the 'shell'-program CHAIN start.gfa$ ELSE IF EXIST(start.prg$) ' *** compiled program started from shell CHAIN start.prg$ ! back to shell ELSE ' *** compiled program SYSTEM ! no shell ENDIF RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Procedures *** ' ' ' ' ' ------------------------------------------------------------------------------ ' *** The End *** ' ============================================================================== ' *** STANHIME.LST *** (delete this line) ' ' ============================================================================== ' ******************** ' *** .GFA *** ' ******************** ' *** this program runs in High or Medium resolution ' ' ------------------------------------------------------------------------------ ' *** Initiation *** ' DEFWRD "a-z" ! word variables (-32768 to +32767) default !! @initio ' ' @title.screen("TITLE",".. .... 1990",32) ! activate in finished program ' ON BREAK GOSUB break ! activate in finished program ' ' ------------------------------------------------------------------------------ ' *** Main Program *** ' ' ' EDIT ! use this while developing program ' @exit ! use this in finished program ' ' ------------------------------------------------------------------------------ ' *** Standard Globals and Array *** ' > PROCEDURE initio LOCAL w,h,n ' CLS @high.med.mode ' @get.path(default.path$) ' physbase%=XBIOS(2) ! physical screen logbase%=XBIOS(3) ! logical screen ' IF XBIOS(4)=2 high.res!=TRUE scrn.x.max=WORK_OUT(0) ! 639 (regular monitor) scrn.y.max=WORK_OUT(1) ! 399 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x16 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 80 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 ELSE med.res!=TRUE scrn.x.max=WORK_OUT(0) ! 639 (regular monitor) scrn.y.max=WORK_OUT(1) ! 199 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x8 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 80 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 ENDIF ' IF high.res! white=0 black=1 red=black ! change red and green to black if in High resolution green=black VSETCOLOR 1,0 DEFTEXT black,0,0,13 ELSE white=0 ! default Medium colors black=1 red=2 green=3 DEFTEXT black,0,0,6 ENDIF ' ' *** create Standard Array color.index() ' *** use this array to convert a VDI color-index into a 'SETCOLOR'-index DIM color.index(3) IF high.res! RESTORE col.index.high col.index.high: DATA 0,1,1,1 ENDIF IF med.res! RESTORE col.index.med col.index.med: DATA 0,3,1,2 ENDIF FOR n=0 TO 3 READ color.index(n) NEXT n ' ' *** default palette IF high.res! VSETCOLOR 1,0 ENDIF IF med.res! @standard.med.colors ENDIF ' on!=TRUE off!=FALSE ' bel$=CHR$(7) ' return$=CHR$(13) esc$=CHR$(27) help$=CHR$(0)+CHR$(98) undo$=CHR$(0)+CHR$(97) ' interpreter$="\GFABASIC.PRG" ! change path if necessary run.only$="\GFABASRO.PRG" ! Run-Only Interpreter start.gfa$="\START.GFA" ! 'Shell' for GFA-programs start.prg$="\GFASTART.PRG" ! 'Shell' for compiled GFA-programs ' RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Standard Functions *** ' DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$ DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" ' ' ------------------------------------------------------------------------------ ' *** Standard Procedures *** ' > PROCEDURE high.med.mode ' *** uses Procedure Exit LOCAL m$,button IF XBIOS(4)=0 SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 m$="Sorry, use|High or Medium|resolution for|this program" ALERT 3,m$,1," OK ",button @exit ENDIF RETURN ' ********** ' > PROCEDURE get.path(VAR default.path$) ' *** return default path (current drive and folder) ' *** example - A:\GAMES\ ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\ ' *** (even if program not in main directory !!) LOCAL default.drive,default.drive$ CLR default.path$ default.drive=GEMDOS(&H19) default.drive$=CHR$(default.drive+65) default.path$=DIR$(default.drive+1) IF default.path$<>"" default.path$=default.drive$+":"+default.path$+"\" ELSE default.path$=default.drive$+":\" ENDIF RETURN ' ********** ' > PROCEDURE standard.med.colors ' *** standard-colors for Medium resolution LOCAL n,col$,r,g,b RESTORE col.data FOR n=0 TO 3 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' col.data: DATA 777,000,700,060 RETURN ' ********** ' > PROCEDURE title.screen(title$,datum$,height) ' *** standard title-screen ' *** uses Standard Globals and Standard Procedure Return.key LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i CLS HIDEM DEFTEXT black,8,0,height x=(scrn.x.max-LEN(title$)*height/2)/2 y=scrn.y.max/2 TEXT x,y,title$ LET name$=" Han Kempen" ! that's me col=(scrn.col.max-12)/2 lin=scrn.lin.max/2+6 PRINT AT(col,lin);name$ x1=(col-2)*8 y1=(lin-1)*char.height-4 x2=x1+LEN(name$)*8+16 y2=y1+char.height+8 BOX x1,y1,x2,y2 DEFLINE 1,3 DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3 LINE x1+3,y2+1,x2+2,y2+1 PRINT AT(col,lin+2);datum$ @return.key COLOR black DEFLINE 1,1 FOR i=0 TO y BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR white FOR i=y DOWNTO 0 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR black CLS RETURN ' ********** ' > PROCEDURE return.key ' *** wait for ' *** after pressing any other key, flashing 'RETURN' is turned off ' *** uses Standard Globals LOCAL w1$,w2$,temp$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 ! restore screen WHILE in$<>return$ ! wait for in$=INKEY$ WEND RETURN ' ********** ' > PROCEDURE break ' *** activate in main program with : ON BREAK GOSUB break ' *** do not use while developing program ! LOCAL m$,k ON BREAK CONT m$="*** Break ***|Continue,|Run again|or Quit" ALERT 3,m$,1,"CONT|RUN|QUIT",k SELECT k CASE 1 ON BREAK ! true break possible for emergency m$="Freeze current|screen (press|any key to|continue)" ALERT 2,m$,2,"YES|NO",k IF k=1 REPEAT UNTIL LEN(INKEY$) OR MOUSEK ENDIF ON BREAK GOSUB break CASE 2 RUN CASE 3 @exit ENDSELECT RETURN ' ********** ' > PROCEDURE exit ' *** exit program CLS IF EXIST(interpreter$) OR EXIST(run.only$) ' *** program was run from (Run-Only) Interpreter IF EXIST(start.gfa$) CHAIN start.gfa$ ! back to 'shell'-program ELSE EDIT ! no shell ENDIF ELSE IF EXIST(start.gfa$) ' *** can't find interpreter, but here is the 'shell'-program CHAIN start.gfa$ ELSE IF EXIST(start.prg$) ' *** compiled program started from shell CHAIN start.prg$ ! back to shell ELSE ' *** compiled program SYSTEM ! no shell ENDIF RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Procedures *** ' ' ' ' ' ------------------------------------------------------------------------------ ' *** The End *** ' ============================================================================== ' *** STANLOW.LST *** (delete this line) ' ' ============================================================================== ' ******************** ' *** .GFA *** ' ******************** ' *** this program runs in Low resolution only ' ' ------------------------------------------------------------------------------ ' *** Initiation *** ' DEFWRD "a-z" ! word variables (-32768 to +32767) default !! @initio ' ' @title.screen("TITLE",".. .... 1990",32) ! activate in finished program ' ON BREAK GOSUB break ! activate in finished program ' ' ------------------------------------------------------------------------------ ' *** Main Program *** ' ' ' EDIT ! use this while developing program ' @exit ! use this in finished program ' ' ------------------------------------------------------------------------------ ' *** Standard Globals and Array *** ' > PROCEDURE initio LOCAL w,h,n ' CLS @low.mode ' @get.path(default.path$) ' physbase%=XBIOS(2) ! physical screen logbase%=XBIOS(3) ! logical screen ' low.res!=TRUE scrn.x.max=WORK_OUT(0) ! 319 (regular monitor) scrn.y.max=WORK_OUT(1) ! 199 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x8 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 40 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 ' white=0 ! default Low colors black=1 red=2 green=3 blue=4 d.blue=5 brown=6 d.green=7 grey=8 l.black=9 l.blue=10 bluegreen=11 l.purple=12 d.purple=13 d.yellow=14 l.yellow=15 DEFTEXT black,0,0,6 ' ' *** Standard Array color.index() ' *** use this array to convert a VDI color-index into a 'SETCOLOR'-index RESTORE col.index.low DIM color.index(15) FOR n=0 TO 15 READ color.index(n) NEXT n @standard.low.colors ' col.index.low: DATA 0,15,1,2,4,6,3,5,7,8,9,10,12,14,11,13 ' on!=TRUE off!=FALSE ' bel$=CHR$(7) ' return$=CHR$(13) esc$=CHR$(27) help$=CHR$(0)+CHR$(98) undo$=CHR$(0)+CHR$(97) ' interpreter$="\GFABASIC.PRG" ! change path if necessary run.only$="\GFABASRO.PRG" ! Run-Only Interpreter start.gfa$="\STARTLOW.GFA" ! 'Shell' for GFA-programs (Low rez) start.prg$="\GFASTART.PRG" ! 'Shell' for compiled GFA-programs ' RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Standard Functions *** ' DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$ DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" DEFFN ink$(color)=CHR$(27)+"b"+CHR$(color.index(color)) DEFFN paper$(color)=CHR$(27)+"c"+CHR$(color.index(color)) ' ' ------------------------------------------------------------------------------ ' *** Standard Procedures *** ' > PROCEDURE low.mode LOCAL m$,button IF XBIOS(4)<>0 SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 m$="Sorry, you should|use Low resolution|for this program" ALERT 3,m$,1," OK ",button @exit ENDIF RETURN ' ********** ' > PROCEDURE get.path(VAR default.path$) ' *** return default path (current drive and folder) ' *** example - A:\GAMES\ ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\ ' *** (even if program not in main directory !!) LOCAL default.drive,default.drive$ CLR default.path$ default.drive=GEMDOS(&H19) default.drive$=CHR$(default.drive+65) default.path$=DIR$(default.drive+1) IF default.path$<>"" default.path$=default.drive$+":"+default.path$+"\" ELSE default.path$=default.drive$+":\" ENDIF RETURN ' ********** ' > PROCEDURE standard.low.colors ' *** standard-colors for Low resolution LOCAL n,col$,r,g,b RESTORE col.data FOR n=0 TO 15 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' col.data: DATA 777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770 RETURN ' ********** ' > PROCEDURE title.screen(title$,datum$,height) ' *** standard title-screen ' *** uses Standard Globals and Standard Procedure Return.key LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i CLS HIDEM DEFTEXT black,8,0,height x=(scrn.x.max-LEN(title$)*height/2)/2 y=scrn.y.max/2 TEXT x,y,title$ LET name$=" Han Kempen" ! that's me col=(scrn.col.max-12)/2 lin=scrn.lin.max/2+6 PRINT AT(col,lin);name$ x1=(col-2)*8 y1=(lin-1)*char.height-4 x2=x1+LEN(name$)*8+16 y2=y1+char.height+8 BOX x1,y1,x2,y2 DEFLINE 1,3 DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3 LINE x1+3,y2+1,x2+2,y2+1 PRINT AT(col,lin+2);datum$ @return.key COLOR black DEFLINE 1,1 FOR i=0 TO y BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR white FOR i=y DOWNTO 0 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR black CLS RETURN ' ********** ' > PROCEDURE return.key ' *** wait for ' *** after pressing any other key, flashing 'RETURN' is turned off ' *** uses Standard Globals LOCAL w1$,w2$,temp$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 ! restore screen WHILE in$<>return$ ! wait for in$=INKEY$ WEND RETURN ' ********** ' > PROCEDURE break ' *** activate in main program with : ON BREAK GOSUB break ' *** do not use while developing program ! LOCAL m$,k ON BREAK CONT m$="*** Break ***|Continue,|Run again|or Quit" ALERT 3,m$,1,"CONT|RUN|QUIT",k SELECT k CASE 1 ON BREAK ! true break possible for emergency m$="Freeze current|screen (press|any key to|continue)" ALERT 2,m$,2,"YES|NO",k IF k=1 REPEAT UNTIL LEN(INKEY$) OR MOUSEK ENDIF ON BREAK GOSUB break CASE 2 RUN CASE 3 @exit ENDSELECT RETURN ' ********** ' > PROCEDURE exit ' *** exit program CLS IF EXIST(interpreter$) OR EXIST(run.only$) ' *** program was run from (Run-Only) Interpreter IF EXIST(start.gfa$) CHAIN start.gfa$ ! back to 'shell'-program ELSE EDIT ! no shell ENDIF ELSE IF EXIST(start.gfa$) ' *** can't find interpreter, but here is the 'shell'-program CHAIN start.gfa$ ELSE IF EXIST(start.prg$) ' *** compiled program started from shell CHAIN start.prg$ ! back to shell ELSE ' *** compiled program SYSTEM ! no shell ENDIF RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Procedures *** ' ' ' ' ' ------------------------------------------------------------------------------ ' *** The End *** ' ============================================================================== ' *** STANMED.LST *** (delete this line) ' ' ============================================================================== ' ******************** ' *** .GFA *** ' ******************** ' *** this program runs in Medium resolution only ' ' ------------------------------------------------------------------------------ ' *** Initiation *** ' DEFWRD "a-z" ! word variables (-32768 to +32767) default !! @initio ' ' @title.screen("TITLE",".. .... 1990",32) ! activate in finished program ' ON BREAK GOSUB break ! activate in finished program ' ' ------------------------------------------------------------------------------ ' *** Main Program *** ' ' ' EDIT ! use this while developing program ' @exit ! use this in finished program ' ' ------------------------------------------------------------------------------ ' *** Standard Globals and Array *** ' > PROCEDURE initio LOCAL w,h,n ' CLS @med.mode ' @get.path(default.path$) ' physbase%=XBIOS(2) ! physical screen logbase%=XBIOS(3) ! logical screen ' med.res!=TRUE scrn.x.max=WORK_OUT(0) ! 639 (regular monitor) scrn.y.max=WORK_OUT(1) ! 199 ~GRAF_HANDLE(char.width,char.height,w,h) ! 8x8 font scrn.col.max=DIV(SUCC(scrn.x.max),char.width) ! 80 scrn.lin.max=DIV(SUCC(scrn.y.max),char.height) ! 25 ' white=0 ! default Medium colors black=1 red=2 green=3 DEFTEXT black,0,0,6 ' ' *** Standard Array color.index() ' *** use this array to convert a VDI color-index into a 'SETCOLOR'-index RESTORE col.index.med DIM color.index(3) FOR n=0 TO 3 READ color.index(n) NEXT n @standard.med.colors ' col.index.med: DATA 0,3,1,2 ' on!=TRUE off!=FALSE ' bel$=CHR$(7) ' return$=CHR$(13) esc$=CHR$(27) help$=CHR$(0)+CHR$(98) undo$=CHR$(0)+CHR$(97) ' interpreter$="\GFABASIC.PRG" ! change path if necessary run.only$="\GFABASRO.PRG" ! Run-Only Interpreter start.gfa$="\START.GFA" ! 'Shell' for GFA-programs start.prg$="\GFASTART.PRG" ! 'Shell' for compiled GFA-programs ' RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Standard Functions *** ' DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$ DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" DEFFN ink$(color)=CHR$(27)+"b"+CHR$(color.index(color)) DEFFN paper$(color)=CHR$(27)+"c"+CHR$(color.index(color)) ' ' ------------------------------------------------------------------------------ ' *** Standard Procedures *** ' > PROCEDURE med.mode ' *** uses Procedure Exit LOCAL m$,button IF XBIOS(4)<>1 SOUND 1,10,12,4,25 SOUND 1,10,6,4,25 SOUND 1,10,12,4,50 SOUND 1,0 m$="Sorry, this|program runs in|Medium rez only" ALERT 3,m$,1," OK ",button @exit ENDIF RETURN ' ********** ' > PROCEDURE get.path(VAR default.path$) ' *** return default path (current drive and folder) ' *** example - A:\GAMES\ ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\ ' *** (even if program not in main directory !!) LOCAL default.drive,default.drive$ CLR default.path$ default.drive=GEMDOS(&H19) default.drive$=CHR$(default.drive+65) default.path$=DIR$(default.drive+1) IF default.path$<>"" default.path$=default.drive$+":"+default.path$+"\" ELSE default.path$=default.drive$+":\" ENDIF RETURN ' ********** ' > PROCEDURE standard.med.colors ' *** standard-colors for Medium resolution LOCAL n,col$,r,g,b RESTORE col.data FOR n=0 TO 3 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLOR n,r,g,b NEXT n ' col.data: DATA 777,000,700,060 RETURN ' ********** ' > PROCEDURE title.screen(title$,datum$,height) ' *** standard title-screen ' *** uses Standard Globals and Standard Procedure Return.key LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i CLS HIDEM DEFTEXT black,8,0,height x=(scrn.x.max-LEN(title$)*height/2)/2 y=scrn.y.max/2 TEXT x,y,title$ LET name$=" Han Kempen" ! that's me col=(scrn.col.max-12)/2 lin=scrn.lin.max/2+6 PRINT AT(col,lin);name$ x1=(col-2)*8 y1=(lin-1)*char.height-4 x2=x1+LEN(name$)*8+16 y2=y1+char.height+8 BOX x1,y1,x2,y2 DEFLINE 1,3 DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3 LINE x1+3,y2+1,x2+2,y2+1 PRINT AT(col,lin+2);datum$ @return.key COLOR black DEFLINE 1,1 FOR i=0 TO y BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR white FOR i=y DOWNTO 0 BOX i,i,scrn.x.max-i,scrn.y.max-i NEXT i COLOR black CLS RETURN ' ********** ' > PROCEDURE return.key ' *** wait for ' *** after pressing any other key, flashing 'RETURN' is turned off ' *** uses Standard Globals LOCAL w1$,w2$,temp$,in$ CLR in$ REPEAT UNTIL INKEY$="" GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$ w1$="" w2$=SPACE$(8) PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; WHILE in$="" ! wait for any key PAUSE 30 SWAP w1$,w2$ PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$; in$=INKEY$ WEND PUT 0,scrn.y.max-char.height,temp$,3 ! restore screen WHILE in$<>return$ ! wait for in$=INKEY$ WEND RETURN ' ********** ' > PROCEDURE break ' *** activate in main program with : ON BREAK GOSUB break ' *** do not use while developing program ! LOCAL m$,k ON BREAK CONT m$="*** Break ***|Continue,|Run again|or Quit" ALERT 3,m$,1,"CONT|RUN|QUIT",k SELECT k CASE 1 ON BREAK ! true break possible for emergency m$="Freeze current|screen (press|any key to|continue)" ALERT 2,m$,2,"YES|NO",k IF k=1 REPEAT UNTIL LEN(INKEY$) OR MOUSEK ENDIF ON BREAK GOSUB break CASE 2 RUN CASE 3 @exit ENDSELECT RETURN ' ********** ' > PROCEDURE exit ' *** exit program CLS IF EXIST(interpreter$) OR EXIST(run.only$) ' *** program was run from (Run-Only) Interpreter IF EXIST(start.gfa$) CHAIN start.gfa$ ! back to 'shell'-program ELSE EDIT ! no shell ENDIF ELSE IF EXIST(start.gfa$) ' *** can't find interpreter, but here is the 'shell'-program CHAIN start.gfa$ ELSE IF EXIST(start.prg$) ' *** compiled program started from shell CHAIN start.prg$ ! back to shell ELSE ' *** compiled program SYSTEM ! no shell ENDIF RETURN ' ********** ' ' ------------------------------------------------------------------------------ ' *** Procedures *** ' ' ' ' ' ------------------------------------------------------------------------------ ' *** The End *** ' ============================================================================== ' **************** ' *** TEXT.LST *** ' **************** ' DEFWRD "a-z" ' > PROCEDURE font.8x16 ' *** 8x16 font (width 8 pixels, height 16 pixels) for PRINT-command ' *** equals DEFTEXT ,,,13 for TEXT-command ' *** this is the default system-font in High resolution ' *** uses/changes Standard Globals LOCAL a$,adr% a$=MKI$(&HA000)+MKI$(&H2009)+MKI$(&H4E75) ! MOVE.L A1,D0 RTS adr%=VARPTR(a$) adr%=C:adr%() ! address of font-table {INTIN}={adr%+8} ! pointer to 8x16 system-font (3rd pointer) VDISYS 5,2,0,102 ! Init System Font (VDI 5, Escape 102 ; undocumented ?) char.height=16 scrn.lin.max=(scrn.y.max+1)/char.height RETURN ' *** > PROCEDURE font.8x8 ' *** 8x8 font for PRINT-command ' *** equals DEFTEXT ,,,6 for TEXT-command ' *** this is the default system-font in Low and Medium resolution ' *** uses/changes Standard Globals LOCAL a$,adr% a$=MKI$(&HA000)+MKI$(&H2009)+MKI$(&H4E75) ! MOVE.L A1,D0 RTS adr%=VARPTR(a$) adr%=C:adr%() ! address of font-table {INTIN}={adr%+4} ! pointer to 8x8 system-font (2nd pointer) VDISYS 5,2,0,102 ! Init System Font (VDI 5, Escape 102 ; undocumented ?) char.height=8 scrn.lin.max=(scrn.y.max+1)/char.height RETURN ' ********** ' > PROCEDURE change.font ' *** change PRINT-font for High resolution ' *** use A1_xxxxx.FON-files created with FONTKIT (by Jeremy Hughes) ' *** restore original system-font with @normal.font ' *** uses Standard Global ' *** global : NEW.FONT! NORMAL.FONT% LOCAL adr%,new.font% IF high.res! ' ' *** load A1_xxxxx.INL file (4114 bytes) from FONTS-folder here ' *** any regular Atari-font (4096 bytes) can be loaded as well ! INLINE new.font%,4114 ' adr%=L~A-22 normal.font%={adr%} SLPOKE adr%,new.font% new.font!=TRUE ENDIF RETURN ' *** > PROCEDURE normal.font ' *** restore default system-font IF new.font! SLPOKE L~A-22,normal.font% new.font!=FALSE ENDIF RETURN ' ********** ' > PROCEDURE scroll.print(txt$,col,lin,width) ' *** scroll text with PRINT in box (width in characters) ' *** quit after any keypress (complete string is printed before exit) ' *** uses Standard Global LOCAL a$,n,x1.box,y1.box,x2.box,y2.box x1.box=col*8-9 y1.box=lin*char.height-(char.height+2) x2.box=x1.box+width*8+1 y2.box=y1.box+char.height+3 BOX x1.box,y1.box,x2.box,y2.box a$=SPACE$(width-1)+txt$+" " REPEAT UNTIL INKEY$="" REPEAT FOR n=1 TO LEN(a$) PRINT AT(col,lin);MID$(a$,n,width); PAUSE 7 NEXT n UNTIL INKEY$<>"" RETURN ' ********** ' > PROCEDURE scroll.text(txt$,x,y,w,h) ' *** scroll text with TEXT in box with width w pixels and height h pixels ' *** uses Procedure Set.clip.rectangle and Txt.extent ' *** also uses Procedure Initio.logical.screen etc. LOCAL txt.y,width,height,screen$,n,in$ DEFFILL white,1 BOX x,y,x+w,y+h CLIP x+1,y+1 TO x+w-1,y+h-1 @text.extent(txt$,width,height) txt.y=y+(h-height)/2+height-2 SGET screen$ @initio.logical.screen CLS SPUT screen$ REPEAT FOR n=x+w TO x-width STEP -2 in$=INKEY$ EXIT IF in$<>"" TEXT n,txt.y,txt$ @swap.screen PBOX x+1,y+1,x+w-1,y+h-1 PAUSE 1 NEXT n UNTIL in$<>"" CLIP OFF @restore.physical.screen RETURN ' ********** ' > PROCEDURE sound.txt(txt$) ' *** play scale while text appears LOCAL octave,n octave=3 FOR n=1 TO LEN(txt$) PRINT MID$(txt$,n,1); IF n MOD 12=0 INC octave ENDIF SOUND 1,13,n MOD 12,octave,5 NEXT n SOUND 1,0,0,0,0 RETURN ' ********** ' > PROCEDURE bell.txt(txt$,number) ' *** flash text several times with bell-sound (at current cursor-position) LOCAL x,y,n x=CRSCOL y=CRSLIN FOR n=1 TO number PRINT AT(x,y);txt$; PRINT bel$; PAUSE 15 PRINT AT(x,y);SPACE$(LEN(txt$)); PAUSE 15 NEXT n PRINT AT(x,y);txt$; RETURN ' ********** ' > PROCEDURE text.parameters(VAR color,attr,angle,height) ' *** text-parameters : color, attribute, angle, height (as in DEFTEXT) ' *** I can't find attribute with Intout + 10 (bug in GEM ?) DPOKE CONTRL,38 DPOKE CONTRL+2,0 DPOKE CONTRL+4,2 DPOKE CONTRL+6,0 DPOKE CONTRL+8,6 VDISYS color=DPEEK(INTOUT+2) attr=WORD{L~A+90} ! find attribute somewhere else angle=DPEEK(INTOUT+4) height=DPEEK(PTSOUT+2) RETURN ' ********** ' > PROCEDURE text.extent(txt$,VAR width,height) ' *** calculate width and height of text-box (printed with TEXT) ' *** should make life easier if you want to enclose text in a rectangle ' *** you'll have to experiment a little, especially if angle <> 0 ' *** uses Procedure Text.parameters to determine angle LOCAL l,l$,n,x1,y1,x2,y2,x3,y3,x4,y4,k,angle,b,h ~VQT_EXTENT(txt$,x1,y1,x2,y2,x3,y3,x4,y4) @text.parameters(k,angle,b,h) IF angle=0 width=x2 height=y3 ELSE IF angle=900 width=x1 height=y2 ELSE IF angle=1800 width=x1 height=y2 ELSE IF angle=2700 width=x3 height=x4 ! bug in GEM (?) : y1,x4 and y4 wrong ENDIF ! (x4 and y4 are swapped) RETURN ' ********** ' > PROCEDURE shadow.box(x1,y1,x2,y2) ' *** box with shadow (looks nice around text) BOX x1,y1,x2,y2 DEFLINE 1,3 DRAW x1+3,y2+1 TO x2+2,y2+1 TO x2+2,y1+3 RETURN ' ********** ' > PROCEDURE shadow.text(x,y,txt$) ' *** print large 'shadowed' text with TEXT ' *** use spaces between characters ! ' *** uses Standard Globals GRAPHMODE 2 DEFTEXT black,0,0,32 TEXT x,y,txt$ TEXT x+2,y,txt$ FOR i=4 TO 6 TEXT x+i,y+i,txt$ NEXT i GRAPHMODE 3 DEFTEXT white TEXT x+1,y+1,txt$ GRAPHMODE 1 DEFTEXT black RETURN ' ********** ' > PROCEDURE flash(x1,y1,x2,y2,n) ' *** flash rectangle (with text) n times LOCAL flash$,i GET x1,y1,x2,y2,flash$ FOR i=1 TO n PUT x1,y1,flash$,12 PAUSE 25 PUT x1,y1,flash$ PAUSE 25 NEXT i RETURN ' ********** ' > PROCEDURE text.at(col,lin,txt$) ' *** equals PRINT AT if same font-size is used (DEFTEXT ,,,13 or 6) ' *** uses Standard Globals TEXT (col-1)*char.width,lin*char.height+3*high.res!+2*(NOT high.res!),txt$ RETURN ' ********** ' > PROCEDURE scroll.text.up(begin,end) ' *** scroll lines (begin-end) 1 line up ' *** this is much faster than PRINTing the lines again after CLS ' *** uses Standard Globals LOCAL screen%,sx,sy,w,h,dx,dy IF begin>1 AND end>=begin screen%=XBIOS(3) ! logical screen sx=0 sy=(begin-1)*char.height w=scrn.x.max h=(end-begin+1)*char.height dx=0 dy=sy-char.height RC_COPY screen%,sx,sy,w,h TO screen%,dx,dy ELSE PRINT bel$; ENDIF RETURN ' ********** ' > PROCEDURE scroll.text.down(begin,end) ' *** scroll lines begin-end 1 line down ' *** this is much faster than PRINTing the lines again after CLS ' *** uses Standard Globals LOCAL screen%,sx,sy,w,h,dx,dy IF end=begin screen%=XBIOS(3) ! logical screen sx=0 sy=(begin-1)*char.height w=scrn.x.max h=(end-begin+1)*char.height dx=0 dy=sy+char.height RC_COPY screen%,sx,sy,w,h TO screen%,dx,dy ELSE PRINT bel$; ENDIF RETURN ' ********** ' > PROCEDURE box.text(x1,y1,x2,y2,txt$) ' *** print inverted text (default system-font) in a box with TEXT ' *** use (at least one) space as first and last character of txt$ !! ' *** High resolution only GRAPHMODE 1 DEFFILL 1,2,8 PBOX x1,y1,x2,y2 COLOR 0 BOX x1+1,y1+1,x2-1,y2-1 DEFTEXT 1,0,0,13 GRAPHMODE 3 TEXT x1,y1+(y2-y1)/2+6,x2-x1,txt$ GRAPHMODE 1 RETURN ' ********** ' > PROCEDURE fast.print(line,txt$) ' *** PRINT txt$ at line (1-25); much faster than PRINT AT(1,line);txt$ ' *** High-resolution only !! ' *** no VT52-commands (e.g. reverse text) possible !! ' *** length of txt$ must not exceed 80 characters !! ' *** replace length with MIN(LEN(txt$)-1,79) if larger length possible ' *** use XBIOS(3) instead of XBIOS(2) for (invisible) logical screen ' *** routine by Peter Schapermeier ' ' *** load FASTPRT.INL (150 bytes) here INLINE fast.print%,150 ' VOID C:fast.print%(L:V:txt$,SUB(LEN(txt$),1),SUB(line,1),L:XBIOS(2)) RETURN ' ********** ' > PROCEDURE initio.fastprint ' *** PRINT txt$, but much faster than PRINT AT(1,line);txt$ ' *** High-resolution only !! ' *** no VT52-commands (e.g. reverse text) possible !! ' *** intitialize with @initio.fastprint, then use Procedure Fastprint ' *** routine by Peter Schapermeier, improved by Kees Roos ' ' *** load FASTPRT2.INL (192 bytes) here INLINE fastprint%,192 {fastprint%+2}={L~A-22} ! font-address {fastprint%+6}=XBIOS(2) ! use XBIOS(3) for (invisible) logical screen RETURN ' *** > PROCEDURE fastprint(col,lin,txt$) ~C:fastprint%(L:ARRPTR(txt$),W:col,lin) RETURN ' ********** ' > PROCEDURE nicebox.text(col,lin,txt$) ' *** print text with box at column,line with TEXT (8x16 system font) ' *** High resolution only LOCAL x1,y1,x2,y2,width x1=(col-1)*8-4 y1=(lin-1)*16-2 width=8*LEN(txt$) x2=x1+width+7 y2=y1+16+3 BOX x1,y1,x2,y2 BOX x1-1,y1-1,x2+1,y2+1 BOX x1-4,y1-4,x2+4,y2+4 DEFTEXT black,0,0,13 TEXT x1+4,y1+14,width,txt$ RETURN ' ********** ' ' **************** ' *** TIME.LST *** ' **************** ' DEFWRD "a-z" ' > PROCEDURE set.date ' *** input of new date (at current cursor-position) LOCAL inputdate$ REPEAT PRINT "date (dd.mm.yy) : "; FORM INPUT 8,inputdate$ UNTIL LEN(inputdate$)=8 SETTIME TIME$,inputdate$ RETURN ' ********** ' > PROCEDURE set.time ' *** input of new time (at current cursor-position) ' *** '.' is used as separator ! ' *** if user presses immediately, time will not be changed LOCAL x$,inputtime$ REPEAT PRINT "time (hh.mm.ss) : "; FORM INPUT 8,x$ UNTIL LEN(x$)=8 OR x$=CHR$(13) LET inputtime$=MID$(x$,1,2)+":"+MID$(x$,4,2)+":"+MID$(x$,7,2) SETTIME inputtime$,DATE$ RETURN ' ********** ' > PROCEDURE stopwatch ' *** 1st call : start stopwatch ' *** 2nd call : stop stopwatch ' *** global : STOP.SECONDS# STOP.H STOP.M STOP.S WATCH.ON! LOCAL s# IF watch.on! stop.watch#=TIMER stop.seconds#=(stop.watch#-start.watch#)/200 stop.h=stop.seconds#/3600 s#=stop.seconds#-stop.h*3600 stop.m=s#/60 stop.s=s#-stop.m*60 watch.on!=FALSE ELSE watch.on!=TRUE start.watch#=TIMER ENDIF RETURN ' *** > PROCEDURE print.stopwatch ' *** print elapsed time at current cursor-position IF stop.h>0 PRINT stop.h;" h ";stop.m;" m"; ELSE IF stop.m>0 PRINT stop.m;" m ";stop.s;" s"; ELSE IF stop.seconds#>=10 PRINT USING "##.# s",stop.seconds#; ELSE PRINT USING "#.## s",stop.seconds#; ENDIF ENDIF ENDIF RETURN ' ********** ' > PROCEDURE day.of.week(day.date$,VAR day$) ' *** return day of week, determined with Zeller's Congruence LOCAL day,mp,month,year,m,h,w,week$,n day=VAL(LEFT$(day.date$,2)) mp=INSTR(day.date$,".") month=VAL(MID$(day.date$,mp+1,2)) year=VAL(RIGHT$(day.date$,4)) IF month<=2 m=10+month year=year-1 ELSE m=month-2 ENDIF h=year/100 y=year-100*h w=(TRUNC(2.6*m-0.2)+day+y+TRUNC(y/4)+TRUNC(h/4)-2*h) MOD 7 RESTORE weekdays FOR n=0 TO w READ day$ NEXT n ' weekdays: DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday RETURN ' ********** ' > PROCEDURE print.date(print.date$) ' *** print date as : weekday day month year (e.g. Friday 8 January 1988) ' *** uses Procedure Day.of.week LOCAL day,year$,m$,mp,m,month$,n @day.of.week(print.date$,print.day$) day=VAL(LEFT$(print.date$,2)) year$=RIGHT$(print.date$,4) mp=INSTR(print.date$,".") m$=MID$(print.date$,mp+1,2) m=VAL(m$) RESTORE months FOR n=1 TO m READ month$ NEXT n PRINT print.day$;" ";day;" ";month$;" ";year$; ' months: DATA January,February,March,April,May,June,July DATA August,September,October,November,December RETURN ' ********** ' > PROCEDURE date.input(VAR datum$) ' *** invoer datum ' *** accepteert verschillende formaten, b.v. : ' *** 1-6-'88 02-11-88 3.6.88 2/1/88 12 juni 1988 9 aug 88 ' *** jaartallen 0 - 99 invoeren als YYY (3 cijfers); YY wordt n.l. 19YY ' LOCAL x,y,date.input$,ok!,day$,day,month.input$,month$ LOCAL n,month!,month,year$,year x=CRSCOL y=CRSLIN ON ERROR GOSUB date.input.error ' date.input: ' *** invoer datum ok!=TRUE FORM INPUT 18,date.input$ ' *** dag day.len=VAL?(date.input$) IF day.len>2 ! vanwege formaat 2.3.88 IF INSTR(date.input$,".")=2 day.len=1 ELSE IF INSTR(date.input$,".")=3 day.len=2 ELSE ok!=FALSE ENDIF ENDIF ENDIF day$=LEFT$(date.input$,day.len) day=VAL(day$) IF day>31 OR day<1 ok!=FALSE ENDIF ' *** maand month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len+1)) month.len=VAL?(month.input$) IF month.len=0 ! maand als naam (of afkorting) ingevoerd month$=LEFT$(month.input$,3) month$=UPPER$(month$) month.data: DATA JAN,1,FEB,2,MAA,3,MRT,3,APR,4,MEI,5,JUN,6,JUL,7 DATA AUG,8,SEP,9,OKT,10,OCT,10,NOV,11,DEC,12 DIM date.input.month$(14),date.input.month(14) RESTORE month.data FOR n=1 TO 14 READ date.input.month$(n),date.input.month(n) NEXT n FOR n=1 TO 14 IF date.input.month$(n)=month$ month!=TRUE month=date.input.month(n) ENDIF NEXT n ERASE date.input.month$() ERASE date.input.month() IF NOT month! ok!=FALSE ENDIF ELSE month=VAL(month.input$) ! maand als getal ingevoerd ENDIF IF month>12 OR month<1 ok!=FALSE ENDIF month$=STR$(month) IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30 ok!=FALSE ENDIF IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31 ok!=FALSE ENDIF ' *** jaar year$=RIGHT$(date.input$,4) IF VAL?(year$)<>4 OR INSTR(year$,".") year$=RIGHT$(date.input$,3) IF VAL?(year$)<>3 OR INSTR(year$,".") year$=RIGHT$(date.input$,2) IF VAL?(year$)<>2 OR INSTR(year$,".") ok!=FALSE ENDIF year$="19"+year$ ! jaar YY wordt 19YY ENDIF ENDIF WHILE LEFT$(year$,1)="0" ! nullen aan begin verwijderen year$=RIGHT$(year$,LEN(year$)-1) WEND year=VAL(year$) IF month=2 ! schrikkeljaar-controle voor maand februari IF day>28 IF (year MOD 400=0) AND day<>29 ok!=FALSE ELSE IF year MOD 100=0 AND (year MOD 400<>0) ok!=FALSE ELSE IF (year MOD 4=0) AND day<>29 ok!=FALSE ELSE IF (year MOD 4<>0) ok!=FALSE ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ' *** datum IF NOT ok! PRINT bel$; PRINT AT(x,y);STRING$(LEN(date.input$)," "); PRINT AT(x,y);"FOUTIEF FORMAAT !!"; PAUSE 50 PRINT AT(x,y);STRING$(18," "); PRINT AT(x,y);""; GOTO date.input ENDIF datum$=day$+"."+month$+"."+year$ ON ERROR RETURN ' *** > PROCEDURE date.input.error ' *** opvang onverwachte error ok!=FALSE ON ERROR GOSUB date.input.error RESUME NEXT RETURN ' ********** ' > PROCEDURE start.date.input ' *** invoer datum bij opstarten ' *** accepteert verschillende formaten, b.v. : ' *** 1-6-'88 02-11-88 3.6.88 2/1/88 12 juni 1988 9 aug 88 LOCAL x,y,date.input$,ok!,day$,day,month.input$,month$,n,month!,month,year$,year LOCAL new.date$ PRINT " datum (dag-maand-jaar) : "; x=CRSCOL y=CRSLIN ON ERROR GOSUB start.date.input.error ' start.date.input: ' *** invoer datum ok!=TRUE FORM INPUT 18,date.input$ ' *** dag day.len=VAL?(date.input$) IF day.len>2 ! vanwege formaat 2.3.88 IF INSTR(date.input$,".")=2 day.len=1 ELSE IF INSTR(date.input$,".")=3 day.len=2 ELSE ok!=FALSE ENDIF ENDIF ENDIF day$=LEFT$(date.input$,day.len) day=VAL(day$) IF day>31 OR day<1 ok!=FALSE ENDIF ' *** maand month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len+1)) month.len=VAL?(month.input$) IF month.len=0 ! maand als naam (of afkorting) ingevoerd month$=LEFT$(month.input$,3) month$=UPPER$(month$) start.month.data: DATA JAN,1,FEB,2,MAA,3,MRT,3,APR,4,MEI,5,JUN,6,JUL,7 DATA AUG,8,SEP,9,OKT,10,OCT,10,NOV,11,DEC,12 DIM date.input.month$(14),date.input.month(14) RESTORE start.month.data FOR n=1 TO 14 READ date.input.month$(n),date.input.month(n) NEXT n FOR n=1 TO 14 IF date.input.month$(n)=month$ month!=TRUE month=date.input.month(n) ENDIF NEXT n ERASE date.input.month$() ERASE date.input.month() IF NOT month! ok!=FALSE ENDIF ELSE month=VAL(month.input$) ! maand als getal ingevoerd ENDIF IF month>12 OR month<1 ok!=FALSE ENDIF month$=STR$(month) IF (month=4 OR month=6 OR month=9 OR month=11) AND day>30 ok!=FALSE ENDIF IF (month=1 OR month=3 OR month=5 OR month=7 OR month=8 OR month=10 OR month=12) AND day>31 ok!=FALSE ENDIF ' *** jaar year$=RIGHT$(date.input$,2) IF VAL?(year$)<>2 OR INSTR(year$,".") OR VAL(year$)<88 ok!=FALSE ENDIF year=VAL(year$) IF month=2 ! schrikkeljaar-controle voor maand februari IF day>28 IF (year MOD 400=0) AND day<>29 ok!=FALSE ELSE IF year MOD 100=0 AND (year MOD 400<>0) ok!=FALSE ELSE IF (year MOD 4=0) AND day<>29 ok!=FALSE ELSE IF (year MOD 4<>0) ok!=FALSE ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ' *** datum IF NOT ok! PRINT bel$; PRINT AT(x,y);STRING$(LEN(date.input$)," "); PRINT AT(x,y);"FOUTIEF FORMAAT !!"; PAUSE 50 PRINT AT(x,y);STRING$(18," "); PRINT AT(x,y);""; GOTO start.date.input ENDIF LET new.date$=day$+"."+month$+"."+year$ SETTIME TIME$,new.date$ ON ERROR RETURN ' *** > PROCEDURE start.date.input.error ' *** opvang onverwachte error ok!=FALSE ON ERROR GOSUB start.date.input.error RESUME NEXT RETURN ' ********** ' > PROCEDURE time.input(VAR tijd$) ' *** invoer tijd (seconden eventueel weglaten) ' *** accepteert verschillende formaten, b.v. : ' *** 12.40.10 1:30:25 20.45 ' LOCAL x,y,ok!,time.input$,hour.len,hour$,minute.input$,minute.len LOCAL minute$,second$,second.input$,second.len x=CRSCOL y=CRSLIN ON ERROR GOSUB time.input.error ' time.input: ' *** invoer tijd ok!=TRUE FORM INPUT 10,time.input$ ' *** uren hour.len=VAL?(time.input$) IF hour.len>2 ! vanwege formaat 12.30.00 IF INSTR(time.input$,".")=2 hour.len=1 ELSE IF INSTR(time.input$,".")=3 hour.len=2 ELSE ok!=FALSE ENDIF ENDIF ENDIF hour$=LEFT$(time.input$,hour.len) IF VAL(hour$)>23 ok!=FALSE ENDIF ' *** minuten LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len+1)) LET minute.len=VAL?(minute.input$) IF minute.len>2 ! vanwege formaat 12.30.00 IF INSTR(minute.input$,".")=2 LET minute.len=1 ELSE IF INSTR(minute.input$,".")=3 LET minute.len=2 ELSE ok!=FALSE ENDIF ENDIF ENDIF LET minute$=LEFT$(minute.input$,minute.len) IF VAL(minute$)>59 ok!=FALSE ENDIF ' *** seconden IF minute.len>=LEN(minute.input$)-1 second$="0" ELSE second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len+1)) second$=LEFT$(second.input$,2) IF VAL(second$)>59 ok!=FALSE ENDIF ENDIF ' *** tijd IF NOT ok! PRINT bel$; PRINT AT(x,y);STRING$(LEN(time.input$)," "); PRINT AT(x,y);"ONJUIST !!"; PAUSE 50 PRINT AT(x,y);STRING$(10," "); PRINT AT(x,y);""; GOTO time.input ENDIF tijd$=hour$+":"+minute$+":"+second$ ON ERROR RETURN ' *** > PROCEDURE time.input.error ' *** opvang onverwachte error ok!=FALSE ON ERROR GOSUB time.input.error RESUME NEXT RETURN ' ********** ' > PROCEDURE start.time.input ' *** invoer tijd bij opstarten (seconden eventueel weglaten) ' *** direct = 00:00:00 ' *** accepteert verschillende formaten, b.v. : ' *** 12.40.10 1:30:25 20.45 ' LOCAL x,y,ok!,time.input$,hour.len,hour$,minute.input$,minute.len LOCAL minute$,second$,second.input$,second.len,new.time$ PRINT " tijd (uur.min[.sec]) : "; x=CRSCOL y=CRSLIN ON ERROR GOSUB start.time.input.error ' start.time.input: ' *** invoer tijd ok!=TRUE FORM INPUT 10,time.input$ IF time.input$="" LET new.time$="00:00:00" GOTO start.time.exit ENDIF ' *** uren hour.len=VAL?(time.input$) IF hour.len>2 ! vanwege formaat 12.30.00 IF INSTR(time.input$,".")=2 hour.len=1 ELSE IF INSTR(time.input$,".")=3 hour.len=2 ELSE ok!=FALSE ENDIF ENDIF ENDIF hour$=LEFT$(time.input$,hour.len) IF VAL(hour$)>23 ok!=FALSE ENDIF ' *** minuten LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len+1)) LET minute.len=VAL?(minute.input$) IF minute.len>2 ! vanwege formaat 12.30.00 IF INSTR(minute.input$,".")=2 LET minute.len=1 ELSE IF INSTR(minute.input$,".")=3 LET minute.len=2 ELSE ok!=FALSE ENDIF ENDIF ENDIF LET minute$=LEFT$(minute.input$,minute.len) IF VAL(minute$)>59 ok!=FALSE ENDIF ' *** seconden IF minute.len>=LEN(minute.input$)-1 second$="0" ELSE second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len+1)) second$=LEFT$(second.input$,2) IF VAL(second$)>59 ok!=FALSE ENDIF ENDIF ' *** tijd IF NOT ok! PRINT bel$; PRINT AT(x,y);STRING$(LEN(time.input$)," "); PRINT AT(x,y);"ONJUIST !!"; PAUSE 50 PRINT AT(x,y);STRING$(10," "); PRINT AT(x,y);""; GOTO start.time.input ENDIF LET new.time$=hour$+":"+minute$+":"+second$ start.time.exit: SETTIME new.time$,DATE$ ON ERROR RETURN ' *** > PROCEDURE start.time.input.error ' *** opvang onverwachte error ok!=FALSE ON ERROR GOSUB start.time.input.error RESUME NEXT RETURN ' ********** ' > PROCEDURE initio.milli.timer ' *** speciale timer; kleinste gemeten tijdeenheid = timer.step# ' *** afhankelijk van o.a. accessories varieert deze tijdeenheid ' *** de maximaal haalbare nauwkeurigheid is minder dan 0.2 milliseconden ' *** out : TIMER.STEP# LOCAL t1#,t2#,i,k% REPEAT UNTIL INKEY$="" t1#=TIMER FOR i=1 TO 20000 KEYLOOK k% EXIT IF k%<>0 NEXT i t2#=TIMER timer.step#=(t2#-t1#)/4000000 ! tijdeenheid in seconden RETURN ' *** > PROCEDURE milli.timer ' *** eerst Procedure initio.milli.timer aanroepen ' *** reactietijd voor indrukken van een toets in milliseconden ' *** out : MILLI.SEC# LOCAL i,k% FOR i=1 TO 20000 KEYLOOK k% EXIT IF k%<>0 NEXT i milli.sec#=ROUND(i*timer.step#*1000,1) ! 1 cijfer achter komma RETURN ' ********** ' > PROCEDURE time ' *** PRINT time at right upper corner (change position if necessary) ' *** activate with : EVERY 200 GOSUB time ' *** TIME$ is updated every 2 (!) seconds, therefore little trick necessary ' *** cursor-position saved and restored ' *** uses Standard Global scrn.col.max ' *** global : TIMER$ LOCAL t$ t$=TIME$ IF t$=timer$ MID$(timer$,8)=SUCC(RIGHT$(timer$)) ELSE timer$=t$ ENDIF PRINT "j"; PRINT AT(SUB(scrn.col.max,7),1);timer$; PRINT "k"; RETURN ' ********** ' .  S..  SBASCODE INL ɼS BLEND INL ͼS DFASTPRT INL мS FASTPRT2INLҼS LARGE INL ռS MIRROR INLؼS POMPOM INL ۼS SMALL INL ݼS UNPAC INL S <UNRAV INL S (` ` HadB?< NA\E %@A%P%h%haF'Ava *a>a`aQaF%,j,ܪPAFaJ*fF'aa9g9`F E /*?< NA\LNuNsnNF'AaQF%NsGO*3p83p NsGO4pNs |hh h h h h hNu |jj j j j j jNu@F'#4FNuHz *`Hz &?<?<NNPNu"||@AH00@H@Nu || || | Nu |||||||||||||||||| || |Nu@F'QKt(|G"~FNu@F'PKr(|~FNu                                                                                                                                                                                                                                                                                                                                                   )?<NNT"@ o"/4/ BB8<}<Q&I$Hց |mR&QNuC",o2/4/ $o "zlBiPiii@iii0ii i  i pi i i`iRJQNu`HA&P$h o$6/(4/*o Bn2( PC AQo2<QCSSSB@CiOiii?iii/ii i i oi i i_iQLNu  oH"o$o Jof^NV>?< NMN^ o|1@h1oH1|1|1|1|1|1|1| 1|1|RJhhgf1|p1| r1|t1|v1|x1|z1||1|~ hHg1|x1|z1|~JhHfv1|t1|v1|@|`b1|p1| r1|t1|v1|x1|z1||1|~ hHg*1|t1|v1||JhHf1|x1|z1|@~aD4<Ha*j L @B@NuL @0<NuL @0<NuBh`Bh^BhFBhL1hF\1hLnBhDBhJap4(rHak0(D@f1hvT`1htT1hRb!|@Bd0(Fh\fJh^g1h^V`0(F@f1hzV`1hxVJhhg1hDj1hFl`0(|S@hD1@l1hFjaShVGH2(J¼A4(LļBJB4<jsg $(d@!Bd (@!@@RhLShbf80(Fh~k1|`1hVZ1hFXJhVf4RhX0(Xh~k&1|``JhVf8RhF0(Fh~k1|`RhJGd4<HakX1h\F1hnLShTfRhD0(Dh|kab4<HaHk aJ@f"Jh`f1hZ^1hXF0(nhR1@L`(a$4<Hgak`"<NU./ / //NVBW?<NMN^$"$_"_ _N]Jk Sj0Bg?<NMN^$"$_"_ _N]RSBfB@NuNU./ / //NV>?<NMN^J@gNV>?<NMN^af0<$"$_"_ _N]NuB@`NU./ / ///JhHg hHgJ0(lP2(j4Iļ<)g0*`0*|fB@`0<`B@6(lƼ2(j4I|6ļ2<iAg0<6)Ag`|`ZB@6(lƼ2(j4I|6ļ2<iAg0<6)Ag|6)Ag|6)Ag|2I024|2I|A2I|Aļ0&$"$_"_ _N]NuGNu@3\6*'\P*'  @ @ @|o|o |gN|gNu|o:<FƳfœFI8?02SDnSAfNuœF82SDnSAfNu<<|g<<BS@SA68TUTUTUTUTUTUTUTUTUTUTUTUTUTUTUTU?Q6 Bg8l:mE2QQNu2QQNu`Hz ?< NNBWNA8    (-(- (-(69JHK$q;t%HwK  oH"o$o Jof^NV>?< NMN^ o|1@h1oH1|1|1|1|1|1|1| 1|1|RJhhgf1| p1| r1|t1|v1|x1|z1||1|~ hHg1|x1|z1|~JhHfv1|t1|v1|@|`b1|p1| r1|t1|v1|x1|z1||1|~ hHg*1|t1|v1||JhHf1|x1|z1|@~aD4< Ha*j L @B@NuL @0<NuL @0<NuBh`Bh^BhFBhL1hF\1hLnBhDBhJap4(rHak0(D@f1hvT`1htT1hRb!|@Bd0(Fh\fJh^g1h^V`0(F@f1hzV`1hxVJhhg1hDj1hFl`0(|S@hD1@l1hFjaShVGH2(J¼A4(LļBJB4<jsg $(d@!Bd (@!@@RhLShbf80(Fh~k1|`1hVZ1hFXJhVf4RhX0(Xh~k&1|``JhVf8RhF0(Fh~k1|`RhJGd4<HakX1h\F1hnLShTfRhD0(Dh|kab4<HaHk aJ@f"Jh`f1hZ^1hXF0(nhR1@L`(a$4<Hgak`"<NU./ / //NVBW?<NMN^$"$_"_ _N]Jk Sj0Bg?<NMN^$"$_"_ _N]RSBfB@NuNU./ / //NV>?<NMN^J@gNV>?<NMN^af0<$"$_"_ _N]NuB@`NU./ / ///JhHg hHgJ0(lP2(j4Iļ<)g0*`0*|fB@`0<`B@6(lƼ2(j4I|6ļ2<iAg0<6)Ag`|`ZB@6(lƼ2(j4I|6ļ2<iAg0<6)Ag|6)Ag|6)Ag|2I024|2I|A2I|Aļ0&$"$_"_ _N]NuGNu@f13\ *'\*'X  @ @H@ o"o$IBAk Qm`DQm LNuH@ o"o0/2/H`2QLNu.  S ..  SSTART GFAS )STARTLOWGFAS .&GFASTARTGFAS |'GFA-BASIC3"6^^ppv  X"""**(()))))))***.*^*b*b*b*f++M DEFAULT.PATHFILE INTERPRETER DATE.INPUTDAY MONTH.INPUTMONTHYEARNEW.DATEBEL TIME.INPUTHOUR MINUTE.INPUTMINUTESECOND SECOND.INPUTNEW.TIME DEFAULT.DRIVEBUFFERCOLPATHDEFAULTTXTSCREENTEXT PARSE.NAMEDRIVEEXT PARSE.FILETDPFESTART CURRENT.DRIVECURRENTBOTTOMLEFTRIGHTBUFFERSUMRBYTESHIGH.RESMED.RESOKMONTHLOW.RESLASTDATE.INPUT.MONTHDRIVEKXYDAYNMONTHYEARDAY.LEN MONTH.LENHOUR.LEN MINUTE.LEN SECOND.LEN DEFAULT.DRIVEBUTTONRGBDRIVE SCRN.COL.MAXPOSLASTSEARCHFIRSTFACY.FACSTART.DATE.INPUTSTART.MONTH.DATASTART.TIME.INPUTSTART.TIME.EXITCOL.DATA CHECK.BOOT HIGH.MED.MODESTANDARD.MED.COLORSSTART.DATE.INPUTSTART.TIME.INPUT FILESELECTGET.PATHSTART.DATE.INPUT.ERRORSTART.TIME.INPUT.ERRORPARSE.FILENAME SCRAP.WRITE SCRAP.READDATE.INPUT.MONTHCENTER***************** *** START.GFA *** ***************** 8*** this program runs in High or Medium resolution P*** 'Shell'-program for running *.GFA-programs (must be in main directory) =:*** GFA-programs should exit with CHAIN "\START.GFA" "*** Han Kempen (22-4-1990)  a-zF ,4# \START.INFFF last path saved here r*@PFe screenwidth 80 characters  FFJ@check.boot ! check for boot-virus (not activated) .F check resolution : quit if Low rez  J4B߂W F  problem : this is the GFABASIC.PRG-drive !  @8S F slow on harddisk (unless FATSPEED installed) G*4%p  q   bytes freeFF  `T# F<$I!M!#F last accessed folder in file START.INF eM!F 0MF 8ގFT$4:\FF main directory o$F  V F0<F@FF 8F<F<@F half as many y-pixels in medium resolution $F jF6!Fa black letters on white background 8|FFF$F @  ?D F first time after reset ? (not perfect !) @FB !F * NOT * if you use a TV through a modulator ! LFF$L Vertical frequency now 60 HzF$F D!FrLFF&L Write Verify Test switched offF F 5=~! ߰Fy date not set ? (not perfect either) F! F)L START-SHELL FF!F)L GFA-BASIC 3.0 FFT!F4\߀!ߠ߀!߀!߀F! FF!F0F5 just press if you don't care T!FHF$F $F 80f@ F first check if two drives connected F 4A FFF4A B FF4FBdGFi now check other drives (harddisk, RAM-disk)  ,U ! F4B߂  F$F F FF4' START - SHELLFp!!! F!*Xd!߯!ݖ!'F4( GFA-BASIC 3.0Fp!! F *X!!ݖ!(Fp!!! F! 4&drives:  %FFLY! "& "FF 04&Choose *.GFA-file = QuitFFF*.GFA F* n< \=! .GFAFs FF < \Ft*** user wants to quit N  T# F4#F kill file START.INF $F$@!F84/|Go to GFA-editor| or|return to Desktop ?F$!!! EDIT|DESK!F ߀FEF 8FTF$F 8Fr *** user chose GFA-program p  !" Fc4: F$O!M!#F$PM!F remember last path 0MFF@F essential for Standard Procedure Get.path in file$ !!  F start the GFA-program $F T------------------------------------------------------------------------------  &# E#B ߀ F  F*N*** compute checksum of bootsector and warn user if bootsector executable !!!!!F L Checking boot-sector ...F@W F4 F 8л FTU!!!!! F  bootsector (0) of current drive in buffer 8FdGFsXF F8F Bܑ F<42Bootsector|executable :|this could be|a boot-virusFF$!!! OK |STOP!F$FF**********  F* ! F V F$! ! !!Ft$! !!!Ft$! ! !!2Ft!F>45Sorry, use|High or Medium|resolution for|this programF !!! OK ! Fm zT F F 8FTTF$F$FF********** . 2 F*8*** return default path (current drive and folder) =*** example - A:\GAMES\ !FF@ W F4B  F4  F F4:\F 8F4:\F$FF**********  F*.*** standard-colors for Medium resolution !!!!FfFdGFfF@5: FF@5?!! F @5< FF!!!F "F! |F777,000,700,060 F********** , F**** input of date <*** accepts different formats (day-month-year), e.g. : FH*** 1-6-'88 02-11-88 3.6.88 2/1/88 12 June 1988 9 Aug 88 v,!!!!!!!!!!!!F9 FL Date (dd.mm.yy) : "FF @9FF @8FFFF |F*** input of date <Fd!F *** day @I F ߀Fy bD!. ݀Fg@F. 8F D!. Fg@F. 8F<F$F$F$F4;! F @5 FF$ ݀Fa<F$F*** mmonth "4=!B # Fa @I F F 4;! F 4 FF|F.JAN,1,FEB,2,MAR,3,APR,4,MAY,5,JUN,6,JUL,7 &AUG,8,SEP,9,OCT,10,NOV,11,DEC,12 ,H ! FFdG F0 ! F FdG F0 X F<F @ F$F 2FF F F F<F$F 8F @5 FF$F$ ݀Fr<F$F 4 FFP F#݀ݐݰ F<F$Fz #݀ݠ݀ݠ F<F$F*** year 4=! F4 0I ݀D!. 5 F<F$F @5 FF \߀FF VF ( #   Ft<F 8PF(  #  F<F 8JF ( # ݀  Fl<F 8DF ># ݀ F<F$F$F$F$F$F$F*** print date dFLB "FFLY! "B ! "FF LY! "WRONG FORMAT !!"FF `2F"LY! "! "FFLY! ""F\߀!ߠ߀!߀!߀FF$F ..FF @8! FFF*** FF*** unexpected error T<FFFFF********** o F***** input of time (seconds optional) U*** = 00:00:00 **** accepts different formats, e.g. : &*** 12.40.10 1:30:25 20.45 a !!! ! ! ! ! F!!! !F!L Time (hh.mm[.ss]) : "FF @9FF @8FFFF |F*** input of time <Fd! F h F00:00:00FFF0$F*** hour @ I F  ߀F) D !. ݀Fg@ F. 8F D !. Fg@ F. 8F<F$F$F$F4 ; ! F R5 ߸F<F$F*** minutes " = !B #  Fa  I F , ߀F) D !. ݀Fg F. 8&F D !. Fg F. 8 F<F$F$F$F; ! F `5 F<F$F*** seconds   B ߀Fg 40F 8FF"4= !B #  Fa4;! F 5 F<F$F$F*** tijd FLB "FFLY! "B ! "FFLY! "WRONG !!"F `2F"LY! " ! "FFLY! ""F\߀!ߠ߀!߀!߀FF$F ::FF|F @!~FFF*** FF*** unexpected error F<FFFFF********** o !!!2 F,*** use Fileselector with comment-line a<*** comment-line max. 38 characters in all resolutions ,*** uses Standard Function and Globals aLY! " F XFt!F" black  F F|!!!6Fn`!F!!!4Fn @:F|! !!Fn`! F!!!Fn @F|! !?!Fn`! F!!=!Fn$F  F XF$!!F!F********** !  !2!!! FnJ*** return drive, path, filename (without extension !) and extension !(*** no checking for correct syntax iL*** example : "A:\GAMES\PLAY.GFA" returned as : A \GAMES\ PLAY GFA L*** "A:\PLAY.GFA" returned as : A \ PLAY GFA !!!!!F 4 FF V?!! :F4;! F 8F!,4B߂W F  current drive $F @F<F@F@E!!\ FF@E!!\ FF F@߀F @FF 8,FF<F$F F& F backslash discovered 4?!!߀ F4>!߀ F8F!# no '\' 4FF@E!!: Fs F!4>!߀ F 8 F! 4FF$F$F@D!. F$ zF  name with extension 4>!߀ F4;!߀ F$8F!# name without extension 4FF 4FF$FF********** e GFA-BASIC3*RRddd<%%&&&2&J&J&N&N&N&&&&&&&&(0(0M DEFAULT.PATHFILE INTERPRETER DATE.INPUTDAY MONTH.INPUTMONTHYEARNEW.DATEBEL TIME.INPUTHOUR MINUTE.INPUTMINUTESECOND SECOND.INPUTNEW.TIME DEFAULT.DRIVEBUFFERCOLPATHDEFAULTTXTSCREENTEXTSTART CURRENT.DRIVECURRENTBOTTOMDRIVEDPFE PARSE.NAMEEXT PARSE.FILESBUFFERSUMBYTESHIGH.RESMED.RESOKMONTHLOW.RESLASTDATE.INPUT.MONTHKXYDAYNMONTHYEARDAY.LEN MONTH.LENHOUR.LEN MINUTE.LEN SECOND.LEN DEFAULT.DRIVEBUTTONRGBDRIVE SCRN.COL.MAXPOSFIRSTLASTSEARCHSTART.DATE.INPUTSTART.MONTH.DATASTART.TIME.INPUTSTART.TIME.EXITCOL.DATA CHECK.BOOT HIGH.MED.MODESTANDARD.MED.COLORSSTART.DATE.INPUTSTART.TIME.INPUT FILESELECTGET.PATHSTART.DATE.INPUT.ERRORSTART.TIME.INPUT.ERRORLOW.MODESTANDARD.LOW.COLORSEXITPARSE.FILENAMEDATE.INPUT.MONTHCENTER******************** =*** STARTLOW.GFA *** =******************** =2*** this program runs in Low resolution only =F*** 'Shell'-program for running *.GFA-programs in Low resolution =<*** GFA-programs should exit with CHAIN "\STARTLOW.GFA" "*** Han Kempen (22-4-1990) w a-zF .4 \STARTLOW.INFF last path saved here *@(Fe screenwidth 40 characters  FFJ@check.boot ! check for boot-virus (not activated) 4 F check resolution : quit if High or Medium <F H4B߂W F  problem: this is the GFABASIC.PRG-drive !  >8S F slow on harddisk, unless FATSPEED installed *4p  q   bytes freeFF  T F:$I!M!F last accessed folder in STARTLOW.INF lM!F 0MF 8F 4:\F main directory d$F  F > ?D F first time after reset ? (not perfect) B !F * NOT * if you use a TV through a modulator ! LFF$L Vertical frequency now 60 HzFD!FrLFF&L Write Verify Test switched offF F 5=~! ߰Fy date not set ? (not perfect either) F! F LSTARTLOW-SHELL F!FWL GFA-BASIC 3.0 FFT!FIV߀!ߠ߀!ߘ߀!߀F! FF!F0F5 just press if you don't care T!FHF$F $F FF 4FF!FL "FF04&Choose *.GFA-file = QuitFFF*.GFA F* x< \=! .GFAFs FF < \F*** user wants to quit n T F"4F kill file STARTLOW.INF y$F!pF84/|Go to GFA-editor| or|return to Desktop ?F$!!! EDIT|DESK!F ߀FEF 8FTF$F 8Fr *** user chose GFA-program p  !" F4: F$O!M!F$PM!F remember last path 0MFF@F\ essential for Standard Procedure Get.path in file$ !!  F start the GFA-progam F$F T------------------------------------------------------------------------------  &# E#B ߀ F  F*N*** compute checksum of bootsector and warn user if bootsector executable !!!!!F L Checking boot-sector ...F@W F4 F 8л FTU!!!!! F  bootsector (0) of current drive in buffer 8FdGFsXF NF8F ܑ F<42Bootsector|executable :|this could be|a boot-virusFF$!!! OK |STOP!F$FF**********   F= ! F JV F$! ! !!F=$! !!!F=$! ! !!2F=!F<43Sorry, you should|use Low resolution|for this shellF !!! OK ! Fw 4T F F 8DFTTF$F$FF**********  2 F*8*** return default path (current drive and folder) r*** e.g. A:\GAMES\ e !!!FF@ W F4B  F4@ F 8л FWG!! F 4aXFF fF4:\F 8~F4:\F$FF**********   F*,*** standard-colors for Low resolution n!!!!FfFdGFfF@5: FF@5?!! F @5< FF!!!F F! |FD777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770 F********** , F**** input of date <*** accepts different formats (day-month-year), e.g. : FH*** 1-6-'88 02-11-88 3.6.88 2/1/88 12 June 1988 9 Aug 88 v,!!!!!!!!!!!!F9 FL Date (dd.mm.yy) : "FF @9FF @8FFFF |F*** input of date <Fd!F *** day @I F !߀Fy !tD!. ݀Fg@F. 8!F !D!. Fg@F. 8!F<F$F$F$F4;! F @5 FF$ "݀Fa<F$F*** mmonth "4=!B # Fa @I F #F 4;! F 4 FF|F.JAN,1,FEB,2,MAR,3,APR,4,MAY,5,JUN,6,JUL,7 &AUG,8,SEP,9,OCT,10,NOV,11,DEC,12 ,H ! FFdG F0 ! F #FdG F0 #j F<F @ F$F #DFF F F #F<F$F 8#F @5 FF$F$ #݀Fr<F$F 4 FFP $X#݀ݐݰ F<F$Fz $#݀ݠ݀ݠ F<F$F*** year 4=! F4 %BI ݀D!. 5 F<F$F @5 FF &n߀FF &hF ( %#   Ft<F 8&bF( % #  F<F 8&\F ( &$# ݀  Fl<F 8&VF &P# ݀ F<F$F$F$F$F$F$F*** print date 'FLB "FFLY! "B ! "FF LY! "WRONG FORMAT !!"FF `2F"LY! "! "FFLY! ""FF$F ..FF @8! FFF*** FF*** unexpected error T<FFFFF********** o F***** input of time (seconds optional) U*** = 00:00:00 **** accepts different formats, e.g. : &*** 12.40.10 1:30:25 20.45 a !!! ! ! ! ! F!!! !F!L Time (hh.mm[.ss]) : "FF @9FF @8FFFF |F*** input of time <Fd! F ) F00:00:00FFF0$F*** hour @ I F ) ߀F) )D !. ݀Fg@ F. 8)F )D !. Fg@ F. 8)F<F$F$F$F4 ; ! F *5 ߸F<F$F*** minutes " = !B #  Fa  I F * ߀F) *D !. ݀Fg F. 8*F *D !. Fg F. 8*F<F$F$F$F; ! F +5 F<F$F*** seconds  +R B ߀Fg 40F 8+FF"4= !B #  Fa4;! F +5 F<F$F$F*** tijd ,TFLB "FFLY! "B ! "FFLY! "WRONG !!"F `2F"LY! " ! "FFLY! ""FF$F ::FF|F @!~FFF*** FF*** unexpected error F<FFFFF********** o !!!2 F,*** use Fileselector with comment-line a<*** comment-line max. 38 characters in all resolutions ,*** uses Standard Function and Globals aLY! " F XFt!F" black  F .:F|!!!6Fn`!F!!!4Fn @.F|! !!Fn`! F!!!Fn @.F|! !?!Fn`! F!!=!Fn$F  F XF$!!F!F********** !  #!2!!!$ FnJ*** return drive, path, filename (without extension !) and extension !(*** no checking for correct syntax iL*** example : "A:\GAMES\PLAY.GFA" returned as : A \GAMES\ PLAY GFA L*** "A:\PLAY.GFA" returned as : A \ PLAY GFA !!!!!%F 4## FF ?#!! :F4;#! F 8F!,4B߂W F  current drive $F @F<F@F@E!#!\ FFF@E!#!\ FF F@߀F @FF 8FF<F$F F& F backslash discovered 4?#!!߀ F4%>#!߀ F8F!# no '\' 4FF@E!#!: F  F!4%>#!߀ F 8F! 4%#FF$F$F@D%!. F$ F  name with extension 4$>%!߀ F4;%!߀ F$8F!# name without extension 4$FF 4%FF$FF********** e GFA-BASIC3(PPbbbX$$$,,,&&'p'|'''''''((D(H(H(H(L)~)~M DEFAULT.PATHFILE INTERPRETER DATE.INPUTDAY MONTH.INPUTMONTHYEARNEW.DATEBEL TIME.INPUTHOUR MINUTE.INPUTMINUTESECOND SECOND.INPUTNEW.TIME DEFAULT.DRIVEBUFFERCOLPATHDEFAULTTXTSCREENTEXT CURRENT.DRIVECURRENTSTARTDRIVEBOTTOM PARSE.NAMEEXT PARSE.FILEDPFEBUFFERSUMBYTESHIGH.RESMED.RESOKMONTHLOW.RESLASTDATE.INPUT.MONTHKXYDAYNMONTHYEARDAY.LEN MONTH.LENHOUR.LEN MINUTE.LEN SECOND.LEN DEFAULT.DRIVEBUTTONRGBDRIVE SCRN.COL.MAXFACPOSFIRSTLASTSEARCHSTART.DATE.INPUTSTART.MONTH.DATASTART.TIME.INPUTSTART.TIME.EXITCOL.DATA COL.LOW.DATA COL.MED.DATA CHECK.BOOT HIGH.MED.MODESTANDARD.MED.COLORSSTART.DATE.INPUTSTART.TIME.INPUT FILESELECTGET.PATHSTART.DATE.INPUT.ERRORSTART.TIME.INPUT.ERRORSTANDARD.LOW.COLORSPARSE.FILENAMERNDIFDATE.INPUT.MONTHCENTER******************** <*** GFASTART.GFA *** compile as *** GFASTART.PRG *** ******************** .*** this program runs in all resolutions A:*** 'Shell'-program for running compiled GFA-programs 0*** put GFASTART.PRG in the main directory a8*** programs should exit with CHAIN "\GFASTART.PRG" *** Han Kempen (22-1-'90)  a-zF .4 \GFASTART.INFF last path saved here  FFJ@check.boot ! check for boot-virus (not activated)  ,4B߂W F  current drive  @8S F slow on harddisk (unless FATSPEED installed) "4:   bytes freeFF  T F:$I!M!F last accessed folder in GFASTART.INF lM!F 0MF 8F 4:\F main directory i$F (0V F examine resolution r .F<F@PF@Fu TF<F@PF@Fu zF<F@(F4F  F!F @ FFFF 8 F FF$F " ?D F not perfect  F@ !F NOT if you use a TV through a modulator !! LFF$L Vertical frequency now 60 HzF$F D!FrLFF&L Write Verify Test switched offF 6 5=~! ߰Fu not perfect either uF NF! F L START-SHELL FFT!FI\߀!ߠ߀!߀!߀F! FF!FFT!F 8F! FLSTARTLOW-SHELL FT!FIV߀!ߠ߀!ߘ߀!߀F! FF!FFT!F$FHF$F$F  F80@ F first check if two drives connected F 4A FFF4A B FF4F.dGF  now check other drives F ,U ! F4B߂  F$F F 4drives:  FF 8F 4FF$F FF!F L F ,4#Choose program = QuitFF*.PRG F* < \=! .PRGF FF D< \F*** user wants to quit s T F4F kill GFASTART.INF $FTF 8vFr*** user chose *.PRG-file  "#$% Fn4":#F$O!M!F$PM!F remember last path 0MF F\ start the program $F T------------------------------------------------------------------------------  &# E#B ߀ F  F*N*** compute checksum of bootsector and warn user if bootsector executable !!!!!F L Checking boot-sector ...F@W F4 F 8л FTU!!!!! F  bootsector (0) of current drive in buffer 8FdGFsXF 4F8F ܑ F<42Bootsector|executable :|this could be|a boot-virusFF$!!! OK |STOP!F$FF**********  2 F*8*** return default path (current drive and folder) r*** e.g. A:\GAMES\ e !!!FF@ W F4B  F4@ F 8л FWG!! F 4aXFF F4:\F 8F4:\F$FF**********  F*.*** standard-colors for Medium resolution !!!!FfF*dGFfF@5: FF@5?!! F @5< FF!!!F F! |F777,000,700,060 F********** ,  F*,*** standard-colors for Low resolution ,!!!!FfF*dGFfF@5: FF@5?!! F @5< FF!!!F F! |FD777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770 F********** , F**** input of date <*** accepts different formats (day-month-year), e.g. : FH*** 1-6-'88 02-11-88 3.6.88 2/1/88 12 June 1988 9 Aug 88 v,!!!!!!!!!!!!F9 FL Date (dd.mm.yy) : "FF @9FF @8FFFF |F*** input of date <Fd!F *** day @I F ߀Fy D!. ݀Fg@F. 8F D!. Fg@F. 8F<F$F$F$F4;! F @5 FF$ F݀Fa<F$F*** mmonth "4=!B # Fa @I F F 4;! F 4 FF|F.JAN,1,FEB,2,MAR,3,APR,4,MAY,5,JUN,6,JUL,7 &AUG,8,SEP,9,OCT,10,NOV,11,DEC,12 ,H ! FFdG F0 ! F FFdG F0  F<F @ F$F vFF F F F<F$F 8F @5 FF$F$  ݀Fr<F$F 4 FFP #݀ݐݰ F<F$Fz #݀ݠ݀ݠ F<F$F*** year 4=! F4 tI ݀D!. 5 F<F$F @5 FF ߀FF F ( #   Ft<F 8F(  #  F<F 8F ( V# ݀  Fl<F 8F # ݀ F<F$F$F$F$F$F$F*** print date LFLB "FFLY! "B ! "FF LY! "WRONG FORMAT !!"FF `2F"LY! "! "FFLY! ""FF$F ..FF @8! FFF*** FF*** unexpected error T<FFFFF********** o F***** input of time (seconds optional) U*** = 00:00:00 **** accepts different formats, e.g. : &*** 12.40.10 1:30:25 20.45 a !!! ! ! ! ! F!!! !F!L Time (hh.mm[.ss]) : "FF @9FF @8FFFF |F*** input of time <Fd! F  P F00:00:00FFF0$F*** hour @ I F ! ߀F)  D !. ݀Fg@ F. 8!F  D !. Fg@ F. 8 F<F$F$F$F4 ; ! F !:5 ߸F<F$F*** minutes " = !B #  Fa  I F " ߀F) !D !. ݀Fg F. 8"F !D !. Fg F. 8"F<F$F$F$F; ! F "H5 F<F$F*** seconds  " B ߀Fg 40F 8"FF"4= !B #  Fa4;! F "5 F<F$F$F*** tijd #FLB "FFLY! "B ! "FFLY! "WRONG !!"F `2F"LY! " ! "FFLY! ""FF$F ::FF|F @!~FFF*** FF*** unexpected error F<FFFFF********** o !!!2 F,*** use Fileselector with comment-line a<*** comment-line max. 38 characters in all resolutions ,*** uses Standard Function and Globals aLY! " F XFt!F" black  F %rF|!!!6Fn`!F!!!4Fn @%F|! !!Fn`! F!!!Fn @&&F|! !?!Fn`! F!!=!Fn$F  F XF$!!F!F********** !  !2!!! FnJ*** return drive, path, filename (without extension !) and extension !(*** no checking for correct syntax iL*** example : "A:\GAMES\PLAY.GFA" returned as : A \GAMES\ PLAY GFA L*** "A:\PLAY.GFA" returned as : A \ PLAY GFA !!!!!!F 4 FF ?!! :F4;! F 8F!,4B߂W F  current drive $F @F<F@F@E!!\ FFF@E!!\ FF F@߀F @FF 8FF<F$F F& F backslash discovered 4?!!߀ F4!>!߀ F8F!# no '\' 4FF@E!!: F  F!4!>!߀ F 8F! 4!FF$F$F@D!!. F$ F  name with extension 4 >!!߀ F4;!!߀ F$8F!# name without extension 4 FF 4!FF$FF********** e 066010303050000132002006006010000 11 2- # -1 F0110000001 R [................................................]0010 9[..........................................................]1010  9[..............................]3010 YourSecond GFA-BASIC3.0 Manual 9[..........................................................]1010 SecondEdition (c)HanKempen Coevorden,1990 Everythingyoualwayswantedtoknowabout GFA-Basic3.0,butwereafraidtoask 9[::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::]1010 CONTENTS  INTRODUCTION..........................7  1.GENERAL Start-up..............................9 Application...........................9 Monitor...............................10 Break.................................10 OperatingSystem......................10  2.THEEDITOR AbbreviatedCommands..................12 Syntax................................12 FoldedProcedures.....................13 Tab...................................13 CutandPaste.........................13 Load..................................13 Save..................................14 Llist.................................14 Insert-mode...........................15 Directmode...........................15 DEFLIST...............................15 SpecialCharacters....................16 3.VARIABLES VariableType.........................17 DEFWRD................................17 Boolean...............................17 Integer...............................18 FloatingPoint........................18 VAR...................................18 FUNCTION..............................19 CLEAR.................................19 ERASE.................................19 DUMP..................................19 TYPE..................................20 READ..................................20 SWAP..................................20 TIME$.................................21 TIMER.................................21 DATE$.................................22 4.MEMORY RAM...................................23 INT{}.................................23 RESERVE...............................23 INLINE................................24 MALLOC................................25  5.SORT QSORTv.SSORT........................26 QSORTofnumber-arrays................26 QSORTofstring-arrays................26  6.OPERATORSandNUMERICALFUNCTIONS \.....................................29 PREDandSUCC.........................29 MOD...................................29 BCLR..................................29 BSET..................................30 BCHG..................................30 LOG...................................30 SINQandCOSQ.........................30 EQV...................................31 CARDandSWAP.........................31 MAX...................................31 Correlation...........................31  7.STRINGS INSTR.................................32 LSETandRSET.........................32 Parser................................32  8.KEYBOARDINPUT INKEY$................................33 INPUT.................................34 INPUT$................................35 LINEINPUT............................35 KEYTEST...............................35 KEYGET................................35 KEYLOOK...............................36 KEYPRESS..............................37 KEYDEF................................37 Keyboard..............................37 Keyclick,KeyrepeatandCapsLock......38  9.SCREENOUTPUT PRINT.................................40 LOCATE................................41 PRINTTAB.............................42 Setscreen(XBIOS5)...................42 Font..................................43  10.PRINTER Printerready.........................45 HARDCOPY..............................45 Printer-commands......................47  11.FILES FloppyWriteTest.....................50 StepRate.............................50 RAM-disk..............................50 DIR$()................................50 DIRandFILES.........................51 FSFIRSTandFSNEXT....................52 EXIST.................................54 LOF...................................54 TOUCH.................................54 NAME..................................54 KILL..................................54 FileCopy.............................55 DiskFormat...........................55 FileAllocationTable(FAT)...........58 Sectors...............................59 Bootsector............................61 BLOAD.................................61 INPandOUT...........................62 INPUTandLINEINPUT..................62 STOREandRECALL......................62 FILESELECT............................63 12.MIDI INPMID$...............................67 INP...................................67 Midi-commands.........................67  13.MODEM INPAUX$...............................70 INP...................................70 Rsconf(XBIOS15)......................70  14.MOUSE Editor................................71 Fileselector..........................71 MOUSE.................................71 SETMOUSE..............................71 DEFMOUSE..............................72  15.JOYSTICK STRIGandSTICK.......................74  16.SOUND SOUNDandWAVE........................75 Dosound(XBIOS32)....................75 Samples...............................76 Speech................................77 Soundmachine..........................77  17.PROGRAMDECISIONS IF...ENDIF..........................78 SELECT................................78  18.PROGRAMLOOPS Calculations..........................79 FOR...NEXT..........................79 Loops.................................80 19.PROGRAMCONTROL GOSUB.................................82 ONBREAKGOSUB........................82 ERROR.................................82 EVERYandAFTER.......................82 GOTO..................................82 DELAY.................................83 CHAIN.................................83 EXEC..................................83  20.GRAPHICS SETCOLORandVSETCOLOR................84 Palette...............................84 DEFMARK...............................87 DEFFILL...............................87 DEFLINE...............................89 DEFTEXT...............................89 GRAPHMODE.............................90 PLOTandDRAW.........................91 PCIRCLE...............................92 CURVE.................................92 TEXT..................................92 SPRITE................................93 VQT_EXTENT............................95 Line-A................................95 HLINE.................................96 ACHARandATEXT.......................96 GETandPUT...........................96 Degas-Pictures........................97 Neochrome-Pictures....................98 VSYNC.................................98 Scroll................................98 ACLIP.................................99 Blitter...............................99 21.EVENTS MENU()................................101 ONMENUBUTTON........................101 ONMENUIBOX..........................102  22.PULLDOWNMENU OPENW0...............................103 Desk-submenu..........................103 File-submenu..........................103  23.WINDOWS GFA-windows...........................104 CLOSEW................................104 TITLEW................................105 CLEARW................................105 24.AES-LIBRARY ALERT.................................106 SHEL_GETandSHEL_PUT.................106 25.GFAXPERT-FILES GFAXPERT.DOC..........................108 GFAXPERT.LIB..........................108 INLINE................................108 STANxxxx.LST..........................108 START.................................112 smallprint...........................113 EPILOGUE..............................114 INDEX.................................115 9[..........................................................]1010 INTRODUCTION   RightnowyouarereadingthesecondeditionofthetextGFAXPERT.DOC. ThistextisnotmeanttobeareplacementofyourGFA-manual.Onthe contrary,IassumeyouarealreadyfamiliarwiththeGFA-manualandnow wanttoknoweverythingaboutGFA-Basic3.0thatisnotdescribedproperly inthemanual. Thistextisaboutthe(hidden)powerofGFA-Basic3.0.Youwillfind nothingaboutversion3.5,apartfromthissentence.Andthissentence, becauseIwouldliketomentionthatIdon'tunderstandwhyGFAlaunched version3.5.GFA-Basicisbecomingfartooexpensive. Allremarksinthistext,especiallyaboutbugs,arebasedonGFA-Basic 3.07.Istillhopeversion3.08willbecomeavailable(hownaive...), otherwiseI'llhavetowaitforversion4.Notversion4.00ofcourse, becauseIknowtherewillbeatleast200bugsinthefirstrelease. IwrotethistextbecauseIwasdisappointedbythecontentsofmostbooks aboutGFA-Basic3.0.Someauthorsusepageafterpagetodescribeaboring program.Othersdelvedeeplyintomenu's,windowsandRSC,butignorethe "regular"Basic-commands.Insteadofcomplaining,Idecidedtowritethe bookthatIwouldreallyliketoseemyself.Hereitis.Forgetallother booksaboutGFA-Basic,youneedonlytwothings:yourGFA-manualandthis text.Andtobehonest,perhapsagoodbookabouttheAES-library,because youwon'tfindmuchaboutthatsubjectinthistext. InthistextyouwillfindquiteafewProcedures.MostProceduresthat arelisted(ormentioned)inthistextcanbefoundinoneoftheLST- filesinthefolderGFAXPERT.LIB.Downloadersshouldlookforthefile GFAXPRT2.ARC. Istronglyadviseyoutoreadthechapter'GFAXPERT-FILES'thoroughly, beforeyoutrytousetheProcedure-libraryGFAXPERT.LIB.Especiallynote thefollowing: (1)word-variablesarethedefault (2)acoupleofvariablesaredeclaredasStandardGlobals (3)someStandardFunctionsaredefined (4)afewStandardProceduresarepresent (5)theStandardArraycolor.index()isdeclared AProcedurecoulduseanyoftheStandardGlobals,Functions,Procedures ortheStandardArray.Iusuallymentionthisincomment-linesinthe Procedure.IfyouMergesuchaProcedureintoanexistingprogram,you willhavetoadaptyourprogramortheProcedure. IstillbelieveinGFA-Basic3.0.AndIalsobelieveinsharingideas, Proceduresandprogramswithotherusers,startingwithyou.Ifyoufeel guiltyaboutreceivingallthesegoodiesfor(almost)nothing,youwill findafreeconsultinthechapter'EPILOGUE'. IcouldonlywritethistextbecausemanyGFA-userssharedtheir experiencewithothers.Idedicatethistexttothem.Specialthanksto everyonewhopointedoutbugs,mistakesandomissionsinthefirstedition ofGFAXPERT.DOC.Allmistakesinthesecondeditionaremadeby HanKempen 1.GENERAL  Start-up ProgramsinanAUTO-folderareexecutedautomaticallyafterareset.The interpreterGFABASIC.PRGisaGEM-program,andcannotbestartedinthis way.WithTOS1.4youcaninstallaGEM-programasauto-booting.With olderTOS-versionsyoucoulduseaprogramlikeHEADSTRT.PRGinyourAUTO- foldertostartGFABASIC.PRGautomatically.Youcan'tstartaGFA-program thisway(Ithink). Ifyouhavewrittena(compiled)programthatcanberuneitherfromthe AUTO-folderorfromthedesktop,youcandeterminewhichisthecase: IFPEEK(&H2C+4)=0 !4thbyteofLine-Fvector (...) !AUTO ELSE (...) !desktop ENDIF Thereareseveralwaysto(re)startyourcomputer.Theobviousoneisto switchtheSToff,waitafewseconds(15secondswitha1040ST!),and switchonagain.Thisiscalleda"cold"or"hard"reset.Yourcomputer suffersalittle,andittakessometime.Ifyouusethereset-buttonon yourST,youperforma"warm"or"soft"reset.Theoperatingsystem automaticallyperformsawarmresetifyouswitchbetweenLowandMedium resolutiononthedesktop.Ifyoususpectaprogramofchangingsystem variables,youshouldalwaysuseacoldreset.Afterawarmresetthe systemvariablesinlowmemoryarenotinitialisedagain.Garbagewill staythereandwillundoubtedlyleadtointerestingeffects.Youcan performbothawarmandacoldresetfromGFA-Basicwiththefollowing Procedures: PROCEDURE coldstart SLPOKE &H420,0 SLPOKE&H426,0 !probablynotnecessary SLPOKE &H43A,0 ~XBIOS(38,L:LPEEK(4)) RETURN ' PROCEDURE warmstart ~XBIOS(38,L:LPEEK(4)) RETURN Ifyouwouldliketobootfromyoursecond(external)driveB,try: SLPOKE&H446,1 !bootfromdriveBafternextreset @warmstart Application ItisconvenienttoinstalltheextensionGFAasanapplicationfor GFABASIC.PRG.ClickonceonGFABASIC.PRGandchooseInstallApplication fromtheOptions-menu.TypeGFAasDocumentType,clickonOKandsavethe desktop.Ifyoudouble-clickaGFA-program(extension.GFA)fromthe desktop,GFABASIC.PRGisautomaticallyloadedfirst.ChoosingInstall Applicationyouwillonlyseethemostrecentlyinstalledapplication.Use adisk-editortoexaminethefileDESKTOP.INFandyouwillfindall installedapplications(lookfor#G).Youcouldalsousethemethod describedintheparagraph'SHEL_GETandSHEL_PUT',ortheRECALL-method fromtheparagraph'STOREandRECALL'. Monitor TheAtaricolourmonitorSC1224workswithaverticalfrequencyofeither 50Hzor60Hz: SPOKE&HFF820A,254 !50Hz SPOKE&HFF820A,252 !60Hz For60Hz,bit1oftheSyncModeRegisteriscleared.Don'tchangebit0, orthevideocontrollerchipwillnotusetheso-calledsyncpulses.After areset,theoperatingsystemdefaultsto50Hz.Thescreenisalittle largerthanat60Hz,butthescreenflickersslightly.Ifyouconnect yourSTtoaTVthroughamodulator,youshoulduse50Hz.Otherwiseyou areadvisedtouse60Hz. Break It'snoteasytofindintheGFA-manual:youcanstoparunningprogramby pressingsimultaneously.Butifyou're readingthistext,youknowthisalready.It'simpossibletointerrupta programduringDELAY!StudytheStandardProcedureBreakinoneofthe STANxxxx.LST-filestoseehowIreactaftera'Break'. OperatingSystem IfyouprograminalanguagelikeGFA-Basic,youwon'tnoticemuchofthe actualworkhorseinsideyourST-computer:TheOperatingSystem(TOS).But evenGFA-BasicdoesnothaveaBasicequivalentforallTOS-functions, althoughyoucanusealmostallfunctionsfromGFA-Basic. TOScanbedividedintwomainparts:(GEM)DOSandGEM.Thefirstisa collectionof"lowerlevel"routinesforcommunicationwithkeyboard, screen,printer,etc.InGFA-Basicyoucancalltheseroutineswiththe commandsBIOS,XBIOSandGEMDOS.TheGraphicsEnvironmentManager(GEM) consistsoftwocollectionsofroutines:theVDI(VirtualDevice Interface)andtheAES(ApplicationEnvironmentServices).TheVDItakes careofregulargraphicsandshouldhaveincludedGDOS.Atarididn't includeGDOSintheVDI,soyouhavetoloaditifyouneedit.MostVDI- functionshaveaBasicequivalentinGFA.TheAEStakescareofthe communicationwiththeuserthroughmenu,Alert-box,window,etc.Most AES-functionscanbeaccessedthroughtheAES-libraryinGFA-Basic3.0. WithGEMDOS-function48(Sversion)youcanfindtheversionofyour GEMDOS.ForboththeoldTOSandtheBlitter-TOS&H1300(version0.19)is returned.TheFrenchTurbo-DOShasversion0.20andthenewRainbowTOSof 1988hasversion0.21. AnotherwaytofindouttheversionofTOSusesthesystemheaderofTOS (notnecessarilylocatedinROM!): adr%=LPEEK(&H4F2) version$=HEX$(DPEEK(adr%+2)) ThegoodoldROM-TOS(1986,actuallynotsogood)hasversion&H0100 (1.0),theMega-STBlitter-TOS(1987)version&H0102(1.2).Andofcourse thenewTOS('RainbowTOS')hasversion1.4.Youcouldalsoexaminethe dateofyourTOS-version: date$=HEX$(LPEEK(adr%+24)) MyancientTOS1.0has'11201985'asthedate. 2.THEEDITOR  AbbreviatedCommands  Theeditorrecognizesthefollowingabbreviations(notacompletelist): ALINE -ALI FILESELECT-FILE POLYMARK -POLYM ARECT -AR FILL -FI PRINT -Por? ARRAYFILL -ARR FUNCTION -FU PROCEDURE-PRO ATEXT -AT GOSUB -Gor@ PSET -PS BMOVE -B GRAPHMODE -GRA QUIT -Q BOUNDARY -BOU HIDEM -HI REPEAT -REP CASE -CA HLINE -HL RESTORE -RES CIRCLE -CI IF -I RETURN -RET CLOSE -CL INPUT -INP RSET -RS COLOR -C LINE -LI SELECT -S DATA -D LINEINPUT-LI SETCOLOR -SET DEFFILL -DEFF LOCAL -LOC SETMOUSE -SETM DEFLINE -DE LOOP -L SGET -SG DEFMARK -DEFMA LPRINT -LPR SHOWM -SH DEFMOUSE -DEFM LSET -LS SWAP -SW DEFTEXT -DEFT MID$(..)= -MI ..)= TEXT -T DELETE -DEL MOUSE -MOU UNTIL - U DRAW -DR NEXT -N VOID -V EDIT -ED OPEN -O VSYNC -VS ELLIPSE -ELL PAUSE -PA WAVE -WA ELSE -E PBOX -PB WEND -WE ENDFUNC -ENDF PCIRCLE -PC WHILE -W ENDIF -EN PELLIPSE -PE ENDSELECT -ENDS PLOT -PL ERASE -ERA POLYFILL -POLYF EXITIF -EX POLYLINE -POL Iftheabbreviatedcommandisfollowedbyanythingelse,youhaveto insertaspace(e.g.'C1'),exceptwith'@'and'?': @proc1 Gproc1 ' ?"hello" P"hello" Syntax  Theparserchecksforcorrectsyntaxafteryoupress.Manytypo- bugsarepreventedthisway.Theonlydisadvantageisthattheparser recognizessomevariablesascommands.It'simpossibletousethefollo wingnamesasthefirstwordonaline:data_byte|,dirty$,double, printer$,file%,quit!.Thelastoneisnasty,becausetheparserchanges theline'quit!=FALSE'into'QUIT!=FALSE'withoutwarningforasyntax- error.IfyounowruntheprogramyouwillreturntothedesktopwhenQUIT isencountered.Ofcourseyouhavenotlostyourvaluableprogram,because youalwaysSavebeforeyouRun.Doyoureally?Iftheparserrefusesthe nameofavariable,youcanuseLET(e.g.'LETquit!=FALSE').Butyouwill havetochangethenameifitisalabel(e.g.thelabel'data1:'couldbe changedinto'1data:'or'd.ata1:'). FoldedProcedures IfyoupressonaProcedure-line,allProceduresfollo wingandincludingthecurrentonearefolded/unfolded.Youcanunfoldall ProceduresatoncebyputtingthecursoronthefirstProcedure-lineand pressing.IsuggestyouleaveallProceduresinthe Procedure-LibraryGFAXPERT.LIBfolded,unlessyouwanttoexaminea Procedure.Theeditor-commands'Find'and'Replace'willskipfolded Procedures.NeverchangetheProcedure-lineofafoldedProcedure,always unfolditfirst. Tab  Ifyoupress,thecursorjumpstothenexttab-position,without alteringthecurrentline.Ifyouuse,thelineis filledwithspacesfromthecurrentcursor-positiontothenexttab- position.Pressingerasesallconsecutivespacesto theleftofthecurrentcursor-postition.Ifthecurrentcursor-position happenstobeaspace,thisspaceandallspacestotherightareerased aswell. CutandPaste Ifyoupress

,thecurrentlinefromthecursortotheendof thelineiscut,andsavedinaninternalbuffer.inserts thesavedlineatthecurrentcursor-position.Youcanusethismethodto "cutandpaste"apartofaline.Press

,then torestoretheoriginalline.Movethecursortothedesiredpositionand press.Block-operationsareonlypossiblewithcomplete lines. Load  YoucanuseLoadonlywith*.GFA-files,notwithASCII-files(suchasthe *.LST-files).ST-BasicfilesareASCII-files,soyoucanMergethem. MorerecentprogramsinGFA-Basic(from3.04)cannotbeloadedbyearlier interpreters(upto3.02).Ofcourseyoushouldhavethemostcurrent version(atleastversion3.07),butthefollowingmethodshouldalways work.Lengthentheprogramuntilyoucanloaditsuccessfully: OPEN"A",#1,file$ PRINT#1,STRING$(1000,0) CLOSE#1 Save After'Save'(*.GFA-file)or'Save,A'(*.LST-file)withanexistingfile, theoldfileisrenamedwithaBAK-extension.Niceprecaution,butyou shoulddeletethose*.BAK-fileseverynowandthen. Ifyoukillandsavefilesregularly,newfileswillbestoredina fragmentedway.Loadingafragmentedfiletakesmoretimethanloadinga filethatoccupiesconsecutivesectorsonthedisk.Youcancorrectthis asfollows.Firstmakeabackup-disk(yes,youshouldalreadyhaveone). CopyallfilestoaRAM-diskbyclickingonthedrive-iconanddraggingit tothewindowofthedestinationdrive.Youcan'tusedisk-copy(dragging drive-icontodrive-icon)becausethedestination-driveisaRAM-disk. Formatthesource-diskandcopyallfilesback(thismustbeafile-copy, notadisk-copy).Now,allfilesaresavedonconsecutivesectors.You couldspeedupthingsalittlebitmorebycopyingthemost-usedfiles first.Thedrive-headnowneedslesstimetoreachthesefiles. Don'ttryto'Save,A'anexistingfiletoafulldisk.Ihavetriedit onceandlostboththeoriginalfile(shouldhavebecomea*.BAK-file)and ofcoursethesavedfile.Also,theeditor(orTOS)haderasedtheprogram frommemory...Thankyou. Llist Therehasbeensomeconfusionaboutthefollowingpoint-commandsforthe printer: .p- -point-commandsarenotprinted .p+ -point-commandsareprintedagain .llxx -line-width .plxx -page-length .pa -formfeed Sometimesthecommands'.cp'and'.nu'arementioned,butIdon'tknowhow tousethese. Youcanonlyuseonepoint-commandinoneline.Iusethefollowinglines formyprinter(96characters/lineinElite-mode): .p- .n4 .lr3 .ll88 SavethisasLLIST.LSTandMergeitafterthelastlineofaprogram beforechoosing'Llist'.Theactuallistingisthenprintedwith80 characters/line,precededbytheline-numbers(4characters+space).If yourprogramislongerthan10000lines,youshoulduse'.n5',butinthat caseyouprobablydon'thavetimetoreadthis.Anicetouchisthe automaticexecutionofaformfeedafterprintingthelisting. Ifthelistingcontainsspecialcharacters(ASCII-code<32or>126), someofthosecharactersmightbeinterpretedasprinter-commands.My printerswitchestocondensedprintingafterreceivingtheAtari-symbol. Installingtheproperprinter-driver(e.g.PTEPSON.PRG)willpreventthat. ButIneverinstallaprinter-driverbecausetherearesomeserious disadvantages.Readmoreaboutitintheparagraph'HARDCOPY'. Youcanstoptheprintingprocessbypressingthe'Break'-combination ,unlessBreakhasbeendisabledwith 'ONBREAKCONT'.Yourprinterwillcontinueprintingthough,untilits input-bufferisempty,oruntilyouturntheprinteroff.  Insert-mode  Ifyoureturntotheeditor,you'llalwaysbeinInsert-mode,evenifyou lefttheeditorinOverwrite-mode.Bytheway,theeditorrestoresthe originalcolour-palette,soyouarenotbotheredbypalette-changesina program.IntheolddaysIwassometimescaughtbythedreadedphenomenon ofblackcharactersonablackbackground,butnowyoucanalwaysreadthe listingonyourscreen. Bythesecondway,thereisonlyonethingIdon'tlikeabouttheGFA- editor.It'snoteasytomergeaProcedurefromaLST-filewiththe programyou'reworkingon.Savetheprogram,clearmemorywith'New', 'Merge'theLST-file,marktheProcedureasablock,savetheblock, 'Load'theoriginalprogram,findthecorrectlineand'Merge'thesaved block.AnewcommandNMerge(New+Merge)wouldmakethelifeofaGFA- programmeralittleeasier.AbetterideawouldbethecommandBMerge (Block-Merge).ThenIcouldchoosethiscommand,clipaProcedure-block, andtheblockwouldbeinsertedinthelistingautomatically.Areyou readingthis,Frank?Ifyouare,howaboutafunctionforchangingupper caseintolowercase.IntheGFA-EDITORISOMETIMES(oops)forgetI pressedCapsLock.Andhowaboutafunctiontoclearalinefromthecursor tothenextspace-character.And... DirectMode EntertheDirectModebypressingorintheeditor. InDirectModeyoucanrestorethepreviouslyusedlinewith.With andyoucanevenrecallupto8ofthelastused lines.PresstoswitchbetweenInsert-modeandOverwrite-mode.As usualclearstheline,butifyoupressonanemptyline,you willreturntotheeditorimmediately.Youcanalsoreturntotheeditor with,evenwithoutfirstclearingthe command-line.YoucancallProceduresinyourprogramfromtheDirectMode (e.g.'@show').Ifyou(temporarily)mergesomespecialProcedureswith theprogramyouaredeveloping,youcouldusetheDirectModeasaCommand LineInterpreter. DEFLIST Thecommand'DEFLISTn'onlyworksinDirectMode,notinaprogram.You canalsochoose'Deflist'fromthedrop-downmenu,afterclickingonthe Atari-symbol. SpecialCharacters YoucanentercharacterswithASCII-code32-126directlyfromthekey board.ThesecharactersareusuallycalledASCII-characters.Thecodes 0-31and127areusedascontrol-codes,butadditionallyspecialcharac tershavebeenassignedtothesecodes.Thecharacterswithcode128-255 aresometimescalled"extendedASCII-characters"andarepartlyidentical totheIBM-characterswiththesamecodes.Ilooselyusetheexpression "ASCII-code"forallcodes0-255.  Youcanentercharacterswithcode0-31or127-255bypressing andthenenteringthecharactercode.Releasethe-keyandthe characterappearsonyourscreen.E.g.,youcouldentertheEscape- characterbyholdingdownandpressing<2>and<7>.Thisis muchfasterthanenteringCHR$(27),butLlistingafilewithEscape- charactersisprobablynotagoodidea(lessimportant,1stWordPlus couldgetconfusedtoo).LlistingCHR$(27)doesn'tbotheryourprinterat all.It'snotpossibletoenterCHR$(10)orCHR$(13)withthe'Alternate'- way.Youcanenterthefirstbypressingandthen<1><0> .Forcode13youhavetouseCHR$(13). Neverusecode4(EOT,visibleasleftarrow)inaLST-file.IfyouMerge aLST-file,theGFA-editorthinkstheendofthefileisreachedatthat point(&H04)andrefusestoloadanythingfollowingthiscode! 3.VARIABLES  Variable-type InGFA-Basicweusetheexpressions'Byte','Word'and'Integer'forthe threeinteger-variables.Becauseallthreeareintegers,theexpression 'Integer'forthe4-byteinteger-variableissligthlyconfusing.Inother languagesthisvariableiscalled'Longword'orsimply'Long'.Anaddress inRAMshouldalwaysbea4-byteinteger.  DEFWRD Iprefertodeclareword-variablesasthedefault(forvariableswithout postfix)with:DEFWRD"a-z" Irecommendtheuseofword-variables(2bytes)fortworeasons.In calculations,theuseofthespecialinteger-operators(ADD,SUB,INC, etc.)speedstheprogramupconsiderably.Ifyouinsistonusingthe regularoperators(+,-,etc.)youshouldusefloatingpointvariables instead.Usingtheregularoperators,theinterpreterhastoconvert integer-variablestofloatingpoint,doesthecalculationandconvertsthe resultbacktointegeragain.That'swhya#*b#iscalculatedfasterthan a&*b&.ButMUL(a&,b&)ismuchfasterthana#*b#.Ittakessometimeto recognizewhatanexpressionlikeDIV(a,MUL(ADD(a,b),SUB(b,c)))means.I suggestyouusetheregularoperatorsifthecalculation-timeisnot critical.Inloops,thegainincalculationtimereallycounts,soyou shouldusetheinteger-operators.ThatwayyouwilllearnPolishtoo.The secondreasonforusingword-variablesis,thatinacompiledprogram calculationswithword-integersareusuallythefastest. IMPORTANT:ifanumber-variablehasnopostfixinthistext,youshould assumeit'saword-variable.I'llusethepostfix|,%or#where appropriate.Pleasenotethattheinterpreterassumesanumber-variable withoutpostfixisafloatingpointvariable,unlessyouuseDEFWRD"a-z". Boolean Thefollowingfivelines: IFnumber>0 test!=TRUE ELSE test!=FALSE ENDIF canbeshortenedtojustoneline: test!=(number>0) Thisworks,becausethe'>'-operatorreturnsTRUEorFALSE(actually-1 or0). Anotherlittletrick: IFi=1 n=n*2 ELSEIFi=2 n=n*5 ELSE n=0 ENDIF Thiscouldbeshortenedto: n=n*-2*(i=1)+n*-5*(i=2) Theexampleisridiculous,buttheprincipleinvolvedcouldbeuseful.The expressions'i=1'and'i=2'areeither0(FALSE)or-1(TRUE). Itisnotnecessarytousesomethinglike: IFflag!=TRUE (...) ENDIF Youcansimplyuse: IFflag! (...) ENDIF Integer Youcan'tassign2^31toa4-byteinteger-variable.Althoughaninteger contains32bits,youcan'tusebit31.Thisbitisaflagforanegative integer.Thelargestpositivenumberyoucanassigntoaninteger-variable istherefore2^31-1(2147483647).Icouldhavewrittenananalogue paragraphaboutthe2-byteword-variables,butIdidn't.  FloatingPoint  Therangeoffloatingpointvariables(postfix#)is: -1.0E1000<x#<1.0E1000 Largerorsmallernumberscanbeusedincalculations,butnotprinted, becausetheexponentmaycontainnotmorethan3digits(1.0E1000is displayedas1.0E;00). VAR  IfyoucallaProcedureanduseVAR(callbyreference),allvariables and/orarraysafterVARarecalledbyreference.Anexampletoclarify this: @test(10,5,number%,array%()) (...) PROCEDUREtest(a,b,VARx%,y%()) 'nowa=10andb=5(callbyvalue) 'number%andarray%()cannowbeusedasx%andy%() x%=a+b !globalvariablenumber%isnow15 ARRAYFILLy%(),1 !allelementsofarray%()arenow1 RETURN InprehistoricdaysyoucouldhaveusedSWAP,butVARmakeslifeeasier: @test(*a%()) (...) PROCEDUREtest(ptr%) SWAP*ptr%,x%() !arraya%()temporarilyrenamedasx%() (...) !dosomethingwiththearray SWAP*ptr%,x%() !restorepointerbeforeleavingProcedure RETURN FUNCTION YoucanonlyleaveaFUNCTIONbyRETURNingavalueorastring.This value/stringisusuallyassignedtoavariable.IftheFUNCTIONreturnsa string,thefunction-namehastoendwith'$': FUNCTIONtest RETURN126 ENDFUNC ' FUNCTIONtest$ RETURN"thisisastring" ENDFUNC  CLEAR BecauseCLEARisautomaticallyexecutedwhenyourunaprogram,it'snot necessarytostartyouprogramwiththiscommand.  ERASE It'simpossibletoreDIMensionanexistingarray.YoufirsthavetoERASE theexistingarrayandthenyoucanDIMensionanewarray.Itisnot necessarytotestfortheexistenceofanarraywithDIM?()beforeyouuse ERASE.Inotherwords,youcanuseERASEevenifthearraydoesn'texist: ERASEarray$() !justincasethisarrayalreadyexists DIMarray$(200) AfterERASEinganarray,GFArearrangestheremainingarrays.Allarrays thathavebeenDIMensionedafterthedeletedarrayaremovedinorderto fillthegapofthedeletedarray.ThisisimportantifyouuseV:array(0) inyourprogram(readtheparagraph'RESERVE'). DUMP Examineallvariablesinyourprogrambytyping'DUMP'inDirectMode. Presstoslowdownthescrolling-speed,orpresstheright -keytotemporarilystopthescrolling.TheProcedureDebugenables youtouseDUMPduringdebugging.Thisisthebestwaytodiscoverthose nastytypo-bugsinavariable-name.You'llprobablybesurprisedtosee thenamesofdeletedvariablesaswell.Also,anyvariable-nameyouused inDirectModeappears.AllthesenamesareSAVEdwiththeprogram!Delete allunwantednamesasfollows(aRAM-diskwouldbeconvenient): -Loadthefile -Save,A(pressinFileselector) -New -Merge(pressagain) -Save(pressoncemore) Thefilecouldbemuchshorterafterthisoperation. TYPE ThecommandTYPEdoesnotseemtoworkproperlyifyouuselocal variables.Idon'tknowwhat'swrong. READ Asarule,IalwaysRESTOREtheappropriatelabelbeforeREADingDATA- lines.ThatwayIcanuseDATA-linesinProcedures: PROCEDUREread.data  RESTOREthese.data (...) !READtheDATAhere these.data: DATA1,2,3,4 RETURN SWAP The52cardsinbridge(oranothercard-game)canberepresentedbya byte-array.Filltheelements1-52ofthearraywiththevalue1-52.The values1-13wouldrepresenttheClub-cards(2,3,4,...,Q,K,A),values 14-26theDiamonds,values27-39theHeartsandvalues40-52theSpades. ShufflingthecardscannowbesimulatedwiththeProcedureShuffle: DIMdeck|(52) FORi=1TO52 !ignoreindex0 deck|(i)=i NEXTi @shuffle(deck|()) (...) PROCEDUREshuffle(VARproc|()) LOCALi,j FORi=DIM?(proc|())-1DOWNTO2 j=RAND(i)+1 SWAPproc|(j),proc|(i) NEXTi RETURN TIME$ YoucanuseTIME$toprintthecurrenttimeonthescreen.Inthe ProcedureTimeyou'llfindawaytoprintthetimeeverysecond,although TIME$isupdatedeverytwoseconds: PROCEDURE time ' *** activate with : EVERY 200 GOSUB time ' *** global : TIMER$ LOCAL t$ t$=TIME$ IF t$=timer$ MID$(timer$,8)=SUCC(RIGHT$(timer$)) ELSE timer$=t$ ENDIF PRINT AT(1,1);timer$ RETURN TIMER Ifyouneedastopwatch,youcanusethefollowingProcedures: PROCEDURE stopwatch ' *** global : STOP.SECONDS# STOP.H STOP.M STOP.S WATCH.ON! LOCAL s# IF watch.on! stop.watch#=TIMER stop.seconds#=(stop.watch#-start.watch#)/200 stop.h=stop.seconds#/3600 s#=stop.seconds#-stop.h*3600 stop.m=s#/60 stop.s=s#-stop.m*60 watch.on!=FALSE ELSE watch.on!=TRUE start.watch#=TIMER ENDIF RETURN ' PROCEDURE print.stopwatch IF stop.h>0 PRINT stop.h;" h ";stop.m;" m"; ELSE IF stop.m>0 PRINT stop.m;" m ";stop.s;" s"; ELSE IF stop.seconds#>=10 PRINT USING "##.# s",stop.seconds#; ELSE PRINT USING "#.## s",stop.seconds#; ENDIF ENDIF ENDIF RETURN YoustartthestopwatchbycallingtheProcedureStopwatch.Callingthis Procedureagainwillstopthestopwatch.ThenyoucanPRINTtheelapsed timeatthecurrentcursor-positionwiththeProcedurePrint.stopwatch,or youcoulduseoneoftheGlobalVariablesfromtheProcedureStopwatchto dosomethingelse. DATE$  FindthedayoftheweekwiththeProcedureDay.of.week: PROCEDURE day.of.week(day.date$,VAR day$) LOCAL day,mp,month,year,m,h,w,week$,n day=VAL(LEFT$(day.date$,2)) mp=INSTR(day.date$,".") month=VAL(MID$(day.date$,mp+1,2)) year=VAL(RIGHT$(day.date$,4)) IF month<=2 m=10+month year=year-1 ELSE m=month-2 ENDIF h=year/100 y=year-100*h w=(TRUNC(2.6*m-0.2)+day+y+TRUNC(y/4)+TRUNC(h/4)-2*h) MOD 7 RESTORE weekdays FOR n=0 TO w READ day$ NEXT n ' weekdays: DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday RETURN ThisProcedureusesZeller'sCongruencetodeterminethedayoftheweek. 4.MEMORY  RAM Anoverviewofthememoryofmy1040ST(startatthebottom): address &HFFFFFtopofmemoryof1040ST(1024K) &HFFD00 767unused(?)bytes XBIOS(2)=&HF8000screenmemory(32000bytes) HIMEM=&HF400016384unusedbytes(MALLOC(-1)) &H.....freememory(lengthFRE(0)bytes) &H388EAprogram+variables(lengthvaries) &H10C2EGFA-Basic3.07interpreter  BASEPAGE=&H10B2EBasepageGFA-Basic(256bytes) &HA100startofavailableRAM &H6100globalAES-variables &H29B4globalBIOS-andGEMDOS-variables L~A=&H293ALineAvariables &H93AlocalBIOS-variables+BIOS-stack &H400BIOSsystem-variables &H0exceptionvectors TheBIOSsystem-variables(&H400-&H4FF)are"castinconcrete"byAtari. Other(undocumented)variablesinRAMshouldbeavoided. INT{} YoucanuseeitherINT{adr%}orWORD{adr%}.Asyouknow,w=WORD{adr%}is fasterthanw=DPEEK(adr%),butyoucan'tuseWORD{}andtheotherrelated commandsinsupervisormode.Thismeansyoucan'taccessmemorybelow address&H800.OfcourseyoucanPEEK/DPEEK/LPEEKeverywhere(DPEEKand LPEEKonevenaddressesonly),andyoucanuseSPOKE/SDPOKE/SLPOKEto writeinsupervisormode. RESERVE ThecommandRESERVEcanbeusedinthreedifferentways: RESERVEn%:reserven%bytesforGFA-Basic,releaseRAMuptoHIMEM RESERVE-n%:reservelastn%bytesofRAMuptoHIMEM RESERVE:restoretooriginal Thesecondcommandismyfavourite.Youmustuseamultipleof256with RESERVE.After'RESERVE-400',only256bytesarereleasedtoGEMDOS.In thiscaseyouwouldhavetouse'RESERVE-512',althoughyouneedonly400 bytes!UsetheFunctionMultipleifarithmeticisnotyourstrongest point : RESERVE-@multiple(n%,256) Use'RESERVE-n%'onlyonceinyourprogram.IfyouRESERVEmemorya secondtimewith'RESERVE-m%',GFAreleasesm%bytes,notn%+m%. ThecommandRESERVE(restore)doesnotalwaysfunctionproperly.Especial lyafterEXEC3it'softenimpossibletorestorethememory.Isuspect thishassomethingtodowiththeuseofthemalloc-functionbythe operatingsystem.Youcouldtrythefollowing: RESERVE-n% !reserveasmuchasneeded(multipleof256) base%=EXEC(3,...) !load,butdon'tstart (...) ~MFREE(HIMEM) !memoryaboveGFA-Basic ~MFREE(base%) !memoryfromBasepageofloadedprogram RESERVE !hopeitworksnow Don'tbesurprisedbyhang-upsorbombsafterthisoperation... Thereareseveralwaystoreserveapartofmemoryforspecialpurposes suchasmusic,picturesorotherprograms.E.g.,youcoulduseastring- variabletostoreacompletescreenoraGET-picture.Don'tusestringsif garbagecollectionisaseriousrisk.Ifalargearrayisdeclared,the interpretersometimesmovesthestringsinmemorytocreatespaceforthe newarray.Ifyouassignanewstringtoanexistingstring-variable,the oldstringisnoterased.Duringgarbagecollectionallunusedstringsare deletedandtheactivestringsarerearranged.Thismeanstheaddressofa string(accessedthroughVARPTRorV:)isnotfixed.That'snotimportant foraGET-picture,because'PUTx,y,pic$'stillworksallright.Butif youswapscreenswith~XBIOS(5,L:adr%,-1,-1),orcallaroutinewith ~C:adr%(...),garbagecollectionwillbefatal.Onesolutionisnottouse avariablefortheaddress,buttouseVARPTRorV:.Adifferentapproach wouldbetheuseofabyte-array: OPEN"I",#1,file$ LETbytes%=LOF(#1) !howmuchspaceisneeded? CLOSE#1 DIMassembler|(bytes%-1)!createspaceforassembler-routine adr%=V:assembler|(0) BLOADfile$,adr% !loadtheroutine Youcanusethevariableadr%safely,becauseagarbagecollectionhasno influenceonarrays.However,afterERASEinganarray,allarraysthat havebeenDIMensionedafterthedeletedarrayaremovedinmemory.Sothe array-methodisnotreliableeither,unlessyouarecertainthatERASE willnotbeusedafteryouhavedeterminedtheaddressofthebyte-array. Anothersolutionwouldbetodeclarethebyte-arrayearlyinyourprogram, soitwillnotbemovedafterERASE.Theonlycompletesafewayistheuse ofINLINEorMALLOC. INLINE UseD(=DUMP)todumpanInline-fileinHex-codetotheprinter. Don'tuse'Save,A',becauseyouwilllosetheInline-code.Youcan'tuse INLINEinLST-files.IfyouwouldliketouseINLINEincombinationwitha LST-fileyoucouldproceedasfollows.First,createanINLINE-folderin themaindirectoryandSAVEtheInline-codeasafile(extensionINL)in thisfolder.MergetheLST-fileinyourprogramandloadtheInline-code intheINLINE-line.Theprogramshouldbesavedwith'Save'. TheonlylimitationwithINLINEisthemaximumlengthof32746bytes.If youneedmorespace,youhavetouseMALLOC. IfyouchangethelengthofanexistingINLINE-line,theeditorsometimes erasesafewlinesfromyourprogram.It'ssafertocompletelydeletethe oldINLINE-lineandthenenterthenewINLINE-line. MALLOC ThisishowyoucoulduseMALLOC: unused%=MALLOC(-1) !"unused"memoryaboveHIMEM(usedbyGEM) RESERVE-n% !releaselastn%bytestoGEMDOS max%=MALLOC(-1) IFmax%<>0 adr%=MALLOC(max%-unused%) !n%bytesnowavailabletoGFA-Basic ELSE 'error ENDIF (...) !dosomethinginteresting ~MFREE(adr%) !givebacktoGEMDOS... RESERVE !andbacktoGFA-Basic Atarirecommendsyouleaveatleast8KtoGEM,soyoucan'tgowrongif youleave16384bytestoGEM(seeparagraph'RAM'). DonotuseMALLOCtoallocatealotofsmallmemory-blocks,asGEMDOSwill getconfused.Thisproblemisrelatedtothe"40-folderlimit",because MALLOCusesthesamebufferthatisusedtostoreinformationabouta folder(seeparagraph'FILESELECT').Allocateonelargeareaandsplitit upinasmanypartsasyouneed.AlsoconsidertheuseofINLINE,strings orbyte-arraysinsteadofusingMALLOC(readtheparagraph'RESERVE').Do notuseMALLOCinanaccessory,ortheallocatedmemorymaybelostifthe userchangestheresolution. MALLOC(-1)returnsthesizeofthelargestavailablememory-block.Expect problemsifanotherprogramhasallocatedacoupleofseparatememory- blockstoGEMDOS.InthatcaseyouwouldhavetouseMALLOC(-1)again, untilareturnedvalueof'0'indicatestherearenomorememory-blocks available. 5.SORT  QSORTv.SSORT QSORTisfasterthanSSORT,unlessthearrayisalmostsortedalready.I understandQSORTusestherecursiveQuick-sortmethod,soyouneedmore memorythanwithSSORT(iterativeShell-sort).Sort-freakscanstudythe ProceduresQuick.sort.intandShell.sort.inttoseehowtheQuick-sortand Shell-sortcanbeimplementedwithordinaryGFA-Basiccommands(likethat dance:Quick,Shell,slow). QSORTofnumber-arrays Number-arrayscanbeQSORTedinthreedifferentways: QSORTx%() -sortsarray;alsowithx|(),x&()orx#() QSORTx%(),n -sortselements0throughn-1 QSORTx%(),n,y%() -elementsofy%()areswappedtoo Inallcasesx%(-1)resultsinsortingindecreasingorder. Thethirdmethodisinterestingifyouneedasortedoutput,butdon't wanttochangetheoriginalarray.Youcanaccomplishthisasfollows: -copyx%()totemporaryarraytemp%() -determineindexoflastelement:last=DIM?(temp%())-1 -createindexarray:DIMindex%(last) -fillindex-arraywithindex0throughlast -sortarray:QSORTtemp%(),last+1,index%() -ERASEtemp%() Theindex-arraymustbeaninteger-array(postfix%).Also,thenumberof elementsisnotoptionalifyousortwithanindex-array.Youcannow printthenumbersinarrayx%()inincreasingorder: FORi=0TOlast PRINTx%(index%(i)) NEXTi IhaveneverseenthecorrectsyntaxforQSORTinprint,sohereitis: QSORTx([s])[,n[,y%()]] QSORTofstring-arrays Astring-arraycanbesortedinthesamethreewaysasdescribedfor number-arrays.Ifyouhavecreatedanindex-arraywithlast_name$(),you couldprintanalphabeticallist: FORi=0TOlast PRINTfirst_name$(index%(i))'last_name$(index%(i)) NEXTi Therearetwoextrapossibilitieswithstring-arrays. Forthefirstpossibility,createabyte-arrayandfillwithappropriate ASCII-values: DIMascii|(255) ARRAYFILLascii|(),32!CHR$(32)isthespace-character FORi=48TO57 ascii|(i)=i !0-9 NEXTi FORi=65TO90 ascii|(i)=i !A-Z NEXTi FORi=97TO122 ascii|(i)=SUB(i,32) !a-zconvertedtoA-Z NEXTi Allcharactersthatarenotnumbersorletterswillbetreatedasaspace (ASCII-value32).Usethearrayascii|()forsortingastring-array: QSORTx$()WITHascii|() Now'Atari'and'ATARI'aretreatedexactlythesame,becausethe interpreterusesthearrayascii|()toconvertlowercaseletterstempora rilytouppercasebeforesorting.Youcaneventreattheinternational characters(ASCII-values>127)correctly,e.g.ascii|(129)=85.Useafew DATA-linestoaddthecorrectASCII-value,likethis: DATA128,67,129,85,130,69 Youcancombinethismethodwithanindex-arrayaswell.Thecorrect syntaxis: QSORTx$([s])WITHb|()[,n[y%()]] Ifyouhavedoneyourhomework,youshouldnowbeabletowriteaclever alphabeticalsorting-programyourself.Youwantedtobecomeanexpert, didn'tyou?CompareyourprogramwiththeProceduresAscii.qsortand String.index.qsort: PROCEDURE ascii.qsort(VAR txt$()) IF DIM?(ascii|())=0 @initio.ascii.array ENDIF QSORT txt$() WITH ascii|() RETURN ' PROCEDURE initio.ascii.array LOCAL i,code1,code2 DIM ascii|(255) ARRAYFILL ascii(),32 ! fill with space-character FOR i=48 TO 57 ascii|(i)=i ! 0 - 9 NEXT i FOR i=65 TO 90 ascii|(i)=i ! A - Z NEXT i FOR i=97 TO 122 ascii|(i)=SUB(i,32) ! a - z, converted to A - Z NEXT i RESTORE ascii.data REPEAT READ code1,code2 ascii|(code1)=code2 UNTIL code1=0  ' ascii.data: ' *** format : ASCII-code,replacement DATA 128,67,129,85,130,69,131,65,132,65,133,65,134,65,135,67 DATA 136,69,137,69,138,69,139,73,140,73,141,73,142,65,143,65 DATA 144,69,145,65,146,65,147,79,148,79,149,79,150,85,151,85 DATA 152,121,153,79,154,85,155,67,158,83,160,65,161,73,162,79 DATA 163,85,164,78,165,78,166,65,167,79,176,65,177,79,178,79 DATA179,79,180,79,181,79,182,65,183,65,184,79,192,121,193,121 DATA225,83,0,0 RETURN ' PROCEDURE string.index.qsort(switch!,VAR txt$(),index%()) ' *** the index-array has to exist already ' *** if switch!=TRUE, array ascii|() is used LOCAL last,i last=DIM?(txt$())-1 ! index of last element DIM temp$(last) FOR i=0 TO last temp$(i)=txt$(i) NEXT i FOR i=0 TO last index%(i)=i NEXT i IF switch! IF DIM?(ascii|())=0 @initio.ascii.array ENDIF QSORT temp$() WITH ascii|(),last+1,index%() ELSE QSORT temp$(),last+1,index%() ENDIF ERASE temp$() RETURN Thesecondextrapossibilitywithstring-arraysistheuseof'OFFSETo' toignorethefirst'o'charactersduringsorting.Supposeyouhave createdanarrayfiles$()withFILESandwouldliketosortthefilesby length: QSORTfiles$()OFFSET13,n Thefirstcharacter(eitheraspaceor'*')andthefilename(thenext12 characters)arenowignoredduringsorting. 6.OPERATORSandNUMERICALFUNCTIONS  \ Theoperator'\'(backslash)isidenticaltoDIV: a=b\c Integer-divisionisnotasusefulastheotherinteger-operations,because theresultisaninteger.Ofcourseitis,butthiscaneasilyresultin largeroundingerrors. PREDandSUCC PRED(i)isfasterthani-1andSUCC(i)isfasterthani+1.Bothfunctions canalsobeusedwithstrings.Notethecleveruse(ahem)ofSUCCinthe followinglinefromtheProcedureTime: MID$(timer$,8)=SUCC(RIGHT$(timer$)) Therightmostdigitoftimer$(alwayseven)isincreasedwithone. MOD Ifyouuseacounterinaloopinordertodosomethingeverytimethe counterreachesamultipleof10,youcoulddothisasfollows: IFcounterMOD10=0 !multipleof10? (...) !yes,dosomething ENDIF Youcouldalsouse: IFMOD(counter,10)=0 (...) ENDIF BCLR InGFA-Basicversion2.xyouusedANDtoclearabit: x|=x|AND&X11111011 !clearbit2ofthisbyte Remember,thefirst(rightmost)bitisbit0,soabytecontainsbit0-7 fromrighttoleft.InGFA-Basic3.0youclearabitsimplywith: x|=BCLR(x|,2) !clearbit2ofthisbyte Butifyouwanttoclearmorethanonebit,youshouldusetheAND-method: x|=x|AND&X11110000 !clearbit0-3ofthisbyte Inthiscaseyouuseaso-calledmasktoclearcertainbits.Youcanuse ANDalsoasafunction: y|=AND(x|,&X11110000) !evenfasterthanpreviousexample Thiswayyoucantestifabit-mask"fits"avariable: IFAND(x|,mask|) (...) ENDIF Anexampleofthismethod: IFAND(BIOS(11,-1),&X1001) (...) !userpressed+right ENDIF BSET InGFA-Basic2.xyouneededORtosetabit,butnowyouuseBSET: x|=BSET(x|,1) YoustillneedtheOR-methodifyouwanttosetmorethanonebitfast: x|=x|OR&X1010 !setbit1and3 Themask&X1010isusedtosetbits1and3.ComparethiswiththeAND- method,where0isusedtoclearabit,whilehere1isusedtosetabit. YoucanuseORnotonlyasanoperator,butalsoasafunction: y|=OR(x|,&X1010) BCHG InsteadofBCHGyoushouldusetheXOR-methodifyouwanttochangemore thanonebit(withamask): x|=x|XOR&X1110 !changebit1-3 XORcanbeusedasafunctionaswell. LOG Logarithmswithabaseotherthan10orearecomputedasfollows: LOG(x)/LOG(base) SINQandCOSQ IfyouaregoingtoconvertSIN(orCOS)intoSINQ(COSQ),you'llhaveto changefromradialstodegrees.Forexample,youwouldconvertSIN(x)to SINQ(DEG(x)).AlthoughSINQisaboutfivetimesfasterthanSIN,this extracomputationmakesthedifferencealittlelessspectacular.Ifyou arelucky,thevariablealreadyisindegrees,soyoucanuseSINQ immediately.SINQandCOSQshouldnotbeusedifyouneedveryaccurate results,onlyifyouplottheresultandarenotgoingtouseitfor furthercomputations.ExaminethedifferencebetweentheuseofSIN/COS andSINQ/COSQtoseeifthelessaccurateresultisacceptable.InHigh resolutiontrysomethinglikethis: fac#2*PI/639  DRAW0,200 FORx=0TO639 y#=SIN(x*fac#) DRAWTOx,200+y#*200 NEXTx ~INP(2) CLS ' DRAW0,200 FORx=0TO639 y#=SINQ(DEG(x*fac#)) DRAWTOx,200+y#*200 NEXTx ~INP(2) CLS  ' fac#=360/639  DRAW0,200 FORx=0TO639 y#=SINQ(x*fac#) DRAWTOx,200+y#*200 NEXTx ~INP(2) EQV EQVdoesn'tworkproperly.EQV(0,-1)shouldbe0,butequals-65536.The bits16-31arealwaysset:EQVseemstolookatthebits0-15only. CARDandSWAP Ifa4-byteinteger(postfix%)consistsoftwowords,youcanextract thesewith: low.word=CARD(x%) high.word=CARD(SWAP(x%)) Bothwordsareinterpretedaspositivenumbers. Unfortunately,thereisnoanaloguefunctiontoswapthelowandhigh byteofaword.Thatwouldbeusefulifyouwanttoconvertaword into/fromIntel-format(MS-DOS).Rotating8bitsshoulddothetrick: FUNCTIONintel.word(x%) RETURNCARD(ROR&(x%,8)) !swaplow/highbyte ENDFUNC Nowyoushouldbeabletoextractthelowandhighbyteofaword: low.byte|=BYTE(x) high.byte|=BYTE(@intel.word(x)) MAX Thisishowyoucouldfindthehighestvalueinaword-array: PROCEDURE max.array(VAR proc(),high) ' *** return highest value of array proc() LOCAL last,n last=DIM?(proc())-1 high=proc(1) !proc(0)ignored FOR n=2 TO last high=MAX(high,proc(n)) NEXT n RETURN Ioftenstorespecialinformationintheelementwithindex0. Correlation UsetheProcedureCorrelatetodeterminethecorrelationbetweentwo arrays. 7.STRINGS  INSTR ThecommandINSTR(a$,b$,i)alwaysreturns'1'ifa$=b$.Fori=1that's fine,butnotfori>1.Don'tblameme,I'mjustthemessenger. LSETandRSET IfyouuseLSETorRSET,thestringispaddedwithspaces: a$="345" LSETa$="12" PRINTa$ !theinterpreterprints"12",not"12345" YoucanuseRSETforrightjustificationofcolumns: f$=SPACE$(10) FORi=1TO10 RSETf$=text$(i) PRINTf$ NEXTi Parser Parsingastring,youwillfrequentlyhavetosplitthestringintothe target$,thestringbeforeandthestringafterthattarget$.The followingfunctionscouldbehelpful: FUNCTION before$(source$,target$) ' *** returns part of source$ before target$ ' *** returns complete source$ if no target$ found LOCAL p p=INSTR(source$,target$) IF p=0 RETURN source$ ELSE RETURN LEFT$(source$,p-1) ENDIF ENDFUNC ' FUNCTION after$(source$,target$) ' *** returns part of source$ after target$ ' *** returns nullstring if no target$ found LOCAL p p=INSTR(source$,target$) IF p=0 RETURN "" ELSE RETURN MID$(source$,p+LEN(target$)) ENDIF ENDFUNC 8.KEYBOARDINPUT  INKEY$ Allkeypressesaresavedinthekeyboard-buffer.Ifyoudon'twantINKEY$ toreadan"old"key,youshouldfirstclearthebuffer: REPEAT UNTILINKEY$="" !clearkeyboard-buffer key$="" REPEAT key$=INKEY$ !waitfornewkey UNTILkey$<>"" Inthefollowingtableyou'llfindafewusefuldecimalASCII-codesyou canuseafter'key$=INKEY$'.Inthethirdcolumnthehexadecimalscan-code ofthekeyisalsomentioned(seeparagraph'KEYGET'). key  ASC(key$) scancode 8 &H0E 9 &H0F and  13 &H1Cand&H72 27 &H01  127 &H53 key ASC(RIGHT$(key$)) 59 &H3B 68 &H44  84 &H54  93 &H5D 98 &H62 97 &H61 82 &H52 71 &H47 75 &H4B 77 &H4D 72 &H48 80 &H50 Keysinthesecondpartofthistablereturna2-bytevalueafterINKEY$. Youonlyneedthelowbyte,thehighbyteis&H00.That'swhyaStandard Globallikehelp$isdefinedas'CHR$(0)+CHR$(98)'.Thenit'seasyto checkifwaspressed: IFkey$=help$ (...) ! ENDIF Otherwise,youhavetotestasfollows: IFASC(RIGHT$(key$))=98 (...) ! ENDIF However,readtheparagraph'KEYGET'fortheultimatekeypress-processor. Ifyouarejustwaitingforanykeypress,youcoulduseeitherofthe followingmethods(clearthekeyboard-bufferfirst): ~INP(2) !myfavourite ' KEYGETcode% !perhapsthisisclearerinalisting ' REPEAT !aloopisalsopossible UNTILLEN(INKEY$) Thelattermethodisneededifyouarewaitingforanykeypressorany mouse-click: REPEAT UNTILLEN(INKEY$)ORMOUSEK INPUT Ifyoudon'twantthequestionmarktoappearafterINPUT,use: LOCATEcol,lin INPUT"",txt$ Thenullstringandthecommaareessential.Mostofthetimeyou'llneed somethinglike: LOCATEcol,lin INPUT"Enteryourname:",name$ Butiftheinstruction-lineisnotthesameastheINPUT-line,use: PRINTAT(col1,lin1);"Enteryourname:" LOCATEcol2,lin2 INPUT"",name$ AfterINPUT,theusercanpresstoswitchbetweenInsert-modeand Overwrite-mode.Ihavenotbeenabletodiscoverhowtoinputcharacter- codes0-31afterINPUT.It'snotimportantanyway,butIreadsomewhere youcoulduseforthispurpose.TheAlternate-methodcanbe usedforcharacter-codes128-255(not127).Inthefollowingtableyou'll findsomeimportantcharacterswiththedecimalASCII-code:  character ASCII-code character ASCII-code character ASCII-code - 160 - 130  - 161 - 133 - 138  - 141 - 132 - 137  - 139 - 131 - 136  - 140 - 162  - 163  - 152 - 149  - 151 - 158 - 148  - 129 - 147  - 150 - 224  - 240  - 171 - 225  - 241  - 172 - 235  - 242  - 253 - 230  - 243 - 227  - 246 - 231  - 247  - 155  - 189 - 156  - 221 - 159 IfyouwanttouseoneofthesecharactersafterINPUT,youshouldhold down,enterthecode,andrelease.Ihopeyour printer-drivercoulddigestthistable... Youcanuse,,andonan INPUT-line,butalso: -cursortostartofinput-line -cursortoendofline -eraseline Thefirsttwofeelslightlyunnatural,Iwouldpreferittheotherway:up toend,downtostart. BothINPUTandLINEINPUTuseaspecialcursor,soitdoesn'tmakemuch sensetouseXBIOS21(Curscon)todosomethinginterestingwiththeTOS- cursor. INPUT$  Fortheinputofasecretpassword,youcouldusesomethinglike: PRINT"typepassword(5characters):"; code$=INPUT$(5) Thepassworddoesnotappearonthescreen.  LINEINPUT LINEINPUTusestheunderscore(_)asthecursorinawindow.Afteryou press,theunderscoreisnotcompletelyerased.Therightmost pixelremainsvisible.IthinkthisisaGEM-bug. KEYTEST TheKEYTEST-functiondoesnotrespondtokeyssuchas,,etc. KEYGET KEYGETwaitsforakeypress,justlikeINP(2).ButKEYGETisfarmore flexible,becauseitreturnstheASCII-codeandthescan-codeofanykey andalsothestateofthespecialkeys,,and .ConsultyourmanualfortablesofASCII-codesandscan-codes (intheparagraph'INKEY$'youalreadyencounteredsomeimportantcodes). Studythefollowingexampletogetanimpressionoftheeasywayyoucan examineallkeypresseswithKEYGET:  @initio_keyget!assignvariablestothethreecodes ' DO KEYGETget_code% @keyget!processkeypressthere(notincluded) LOOP ' PROCEDUREinitio_keyget ABSOLUTEascii|,V:get_code%+3 ABSOLUTEscan|,V:get_code%+1 ABSOLUTEstatus|,V:get_code% RETURN YouwillhavetowriteyourownKeyget-Procedure.Youcancheckifanyof thespecialkeyshasbeenpressed,byusingBTST(status|,bit): bit0=Right bit1=Left bit2= bit3= bit4= Youcoulddiscoveriftheuserhadpressedwith: IFscan|=&H50ANDBTST(status|,2) (...) ENDIF Ifyouareonlyinterestedinmonitoringthefivespecialkeys,youcould useBIOS11(Kbshift)aswell: status|=BIOS(11,-1) Usethesametableasabovetotestifbit0-4isset. Youareadvisedtoclearthekeyboard-bufferbeforeleavingtheProcedure Keyget. Inmostcasesthescan-codeofakeyisthesame,whetheryoupresseda specialkeysimultaneouslyornot.Butwatchoutforthefollowing exceptions!Fortothescan-codes&H54to&H5D arereturned(not&H3Bto&H44).OnanMS-DOScomputerthesecodesare usedforthekeysF11toF20.Thecombinations (&H73)and(&H74)alsohavespecialcodes.Blame MS-DOS.Thecombinations<1>to<=>havethe specialcodes&H78to&H83.That'sALT1toALT=forMS-DOS. KEYLOOK Accordingtoanunconfirmedreport,KEYLOOKdoesnotfunctionproperly withthepre-BlitterTOS.  KEYPRESS KEYPRESSusesthesame4-byteformatasKEYGET:&Hccss00aa.Inityou willrecognizetheASCII-code(&Haa),thescan-code(&Hss)andthecode forthespecialkeys(&Hcc).Ifyouwanttosimulatethepressingofakey inanAlertbox,youwillhavetosendboththeASCII-codeandthescan- code.Use&H1C000Dtosimulatethepressingof.Or&H04620062for ,althoughthatcertainlywon'thelpinanAlertbox.If youdon'tneedthescan-code(e.g.withINPUT),youcanusejustKEYPRESS &Haa.  KEYDEF TheeditoralwaysusesKEYPAD&X101110,soyouwillhavetosetbit4 yourself(e.g.KEYPAD&X10000)beforeyouwillbeabletouseKEYDEFin yourprogram. Keyboard  AsfarasIknow,therearefourdifferentkeyboardsavailable:USA (QWERTY),English(QWERTY),German(QWERTZ)andFrench(AZERTY).Thekey withscan-code&H2B(totherightof)hasadifferentASCII-code ineachversion: version ASCII-code character USA &H5C (92)  \ English &H23 (35)  # German &H7E (126)  ~ French &H40 (64)  @ YoucoulduseXBIOS16(Keytbl)todeterminethekeyboard-version: PROCEDURE keyboard.version SELECT PEEK(LPEEK(XBIOS(16,L:-1,L:-1,L:-1))+&H2B) CASE &H5C usa.keybrd!=TRUE CASE &H23 english.keybrd!=TRUE CASE &H7E german.keybrd!=TRUE CASE &H40 french.keybrd!=TRUE ENDSELECT RETURN Youshouldtakeintoaccountthedifferencesbetweenthekeyboard-versions ifyouarewritingaprogramthatshouldrunsmoothlyinanycountry. InthefollowingtableIhavegatheredallkeysthathavenotthesame meaningonthefourkeyboard-versions: scancode USA English  German French  &H0C - - )  &H0D = = - '  &H10 Q Q Q A  &H11 W W W Z  &H15 Y Y Z Y  &H1A [ [ [  &H1B ] ] + ]  &H1E A A A Q  &H27 ; ; M  &H28 ' ' \  &H29 ` ` # `  &H2B \ # ~ @  &H2C Z Z Y W  &H32 M M M ,  &H33 , , , ;  &H34 . . . :  &H35 / / - =  &H60 none  \ < < Ifyouaregoingtouseanyscan-codefromthistable,youshouldbevery careful.It'snotnicetoaskaGermanusertopress,buttestfor scan-code&H15inyourprogram... Ifyouinsistondoingthingsthehardway,youcanfindtheASCII-value thatisassignedtoakeywithXBIOS16.Actuallytherearethreetables: oneforanormalkeypress,oneforashiftedkeyandoneforakeypress withCapsLockon: keytbl%=LPEEK(XBIOS(16,L:-1,L:-1,L:-1)) shift%=keytbl%+&H80 capslock%=shift%+&H80 NowyoucanfindtheASCII-codeforanyscan-code(<&H80): ascii=PEEK(keytbl%+scancode) !normalkey ascii=PEEK(shift%+scancode) !shiftedkey ascii=PEEK(capslock%+scancode) !CapsLockon Keyclick,KeyrepeatandCapsLock Normally,youneedtheKeyclickasanaudiblefeedback.Sometimesyouhave toswitchtheKeyclickoff,e.g.whileanXBIOS32songisplaying: PROCEDURE key.click(switch!) IF switch! SPOKE &H484,BSET(PEEK(&H484),0) ! keyclick on ELSE SPOKE &H484,BCLR(PEEK(&H484),0) ! keyclick off ENDIF RETURN Ifyourprogramreactsslowlyafterakeypress,youprobablyhaveto switchtheKeyrepeattemporarilyoff: PROCEDURE key.repeat(switch!) IF switch! SPOKE &H484,BSET(PEEK(&H484),1) ! key-repeat on ELSE SPOKE &H484,BCLR(PEEK(&H484),1) ! key-repeat off ENDIF RETURN YoucanswitchCapsLockonoroffwith: PROCEDURE caps(switch!) IF switch! ~BIOS(11,BSET(BIOS(11,-1),4)) ! CapsLock on ELSE ~BIOS(11,BCLR(BIOS(11,-1),4)) ! CapsLock off ENDIF RETURN 9.SCREENOUTPUT  PRINT ItisveryimportanttoknowifPRINTwillbeusedontheso-calledTOS- screen(nowindowsopened),orinawindow.TOSemulatestheVT52-terminal ofDigitalEquipment,soifyouPRINTontheTOS-screen,theVT52-codes willbeinterpretedascommands.Butinawindowthesecodesareprinted ascharacters! InbothHighandMediumresolutionyoucanPRINT25linesof80 characters,butinLowresolutionit's25linesof40charactersonly. Normallyyoucan'tPRINTacharacteratposition(80,25)inHighorMedium resolution,orat(40,25)inLowresolution.Trythefollowing: PRINTAT(80,25);"X"; andyouwillseethatalinefeedisexecutedautomatically,inspiteof thesemicolonafter"X".OntheTOS-screenyoucanputacharacteratthis positionbyusingtheVT52-command'wrapoff': PRINTAT(80,25);"*wX"; !usetheEscape-characterinsteadof* After'Escw'thelinefeedissuppressed.Theeasiestwaytoenterthe Escape-characterintheGFA-editoristoholddownandthento enter<2><7>.IfyouPRINTastringthatdoesn'tfitonthecurrentline, theremainingcharactersareeitherprintedonthenextline('Escv',the defaultintheinterpreter,notinacompiledprogram),ordiscarded ('Escw').Actually,after'Escw'allcharactersuptothefirstCHR$(10) orCHR$(13)arediscarded. It'simpossibletoPRINTcharacterswithASCII-code0-31ontheTOS- screen.However,youcanprintanycharacterwith: OUT5,code Ifnecessary,useLOCATEfirst. Afteropeningawindow(OPENWx)thecommandDEFTEXTwillchangesizeand colourofPRINTedtextaswell!OneadvantageisthatyoucannowPRINTin differentcoloursonthescreen. OntheTOS-screen,allPRINTedtexthasthesamecolour.Thiscolouris determinedbycolour-index1andisalsousedfortheAlert-boxandthe Fileselector.Thebackgroundonthescreenisdeterminedbycolour-index 0.ThiscolourisusedafterCLS. ItispossibletoPRINTindifferentcoloursontheTOS-screen,byusing theVT52-code'Escb'.ThebackgroundofPRINTedtextcanbechangedwith VT52-code'Escc'.Usethefollowingfunctionstoexperiment: DEFFNink$(color)=CHR$(27)+"b"+CHR$(color) DEFFNpaper$(color)=CHR$(27)+"c"+CHR$(color) Usethecolour-tablefromtheparagraph'SETCOLOR'orbepreparedto becomeveryfrustrated.IusetheStandardArraycolor.index()asthe colour-tableinmyprograms,soIchangethecolourofthePRINTedtextor theback-groundwiththeStandardFunctions: DEFFNink$(color)=CHR$(27)+"b"+CHR$(color.index(color)) DEFFNpaper$(color)=CHR$(27)+"c"+CHR$(color.index(color)) Remember,theVT52-codeshavetobePRINTedtobecomeeffective,like this : PRINT@ink$(red);@paper$(green);"thistextiseye-catching" Notethespacesatbeginningandendofthestringtoemphasizethetext- colouragainstthebackground-colour.Ofcourseyouhavetodeclarethe variablesredandgreenfirst(usuallycolour-index2and3;orifyou don'tusetheVDIcolour-index,trythenumbers1and2).Idefinethe defaultcoloursasStandardGlobalsinmyprograms.BeforeIforget,it won'tworkinHighresolution.Sorry,couldn'tresistthatone. InordertocatchtheeyeoftheuserinHighresolutionyoucanPRINT reverseontheTOS-screen: PRINT"thisis*pIMPORTANT*q" !enterEscinsteadof* EntertheEscape-characterintheusualway.Noteagaintheextraspace bothbeforeandafterthewordthatshouldstandout.Ofcourseyoucould alsouseCHR$(27): PRINT"thisis";CHR$(27);"pIMPORTANT";CHR$(27);"q" Moredifficulttoreadonthescreen,buteasiertoLlist.Iusethe StandardFunctionRev$inallprograms: DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q" IfyouuseacommawithPRINT,thecursorwilljumptothenexttabulator- stop.Tab-stopsareatposition1,17,33,49and65.Trythefollowingto seewhatImean(inHighorMediumresolution): PRINT"1","17","33","49","65","1","17" Ifyouusethecommaafterthelasttab-stop,alinefeedisexecutedand thecursorjumpstothefirsttab-stoponthenextline. Theeasiestwaytousedoublequotesisbyusingdoubledoublequotes (readthistwicetomakesureyouunderstandit): PRINT"doublequotesprintedthe""easy""way" InaDATA-lineasingledoublequotesuffices: DATA"lookMa,"doublequotes"again" Or,simply: DATAlookMa,"doublequotes"again TrytheProcedureFastprintinHighresolutionifyoufindPRINTtooslow. ThisProcedureprintsaboutfourtimesfaster!VT52-commandsareignored, becausecharactersarecopiedstraightfromthefont-tabletothescreen. LOCATE ThesyntaxofPRINTATandLOCATEisnowlessconfusing: PRINTAT(column,line) LOCATEcolumn,line InolderversionsofGFA-BasicitwasLOCATEline,column.Checkthisif yourunanoldprogramandtextisPRINTedonthewrongplace. PRINTTAB PRINTTABbehavesstrangelyifthepositionisgreaterthan80.Trythe followinginHighorMediumresolution: FORi=0TO30 PRINTTAB(i*20);i; NEXTi Onewaytosolvethisproblemis: PRINTTAB(MOD(i*20,80));i; !dousesemicolons ButIthinkthisisaGFA-bugthatprobablywillbecorrectedinfuture versions. YoucancombineTABwithPRINTATandwithPRINTUSING: PRINTAT(1,1);"1";TAB(40);"40" PRINTTAB(40);USING"##",40 Setscreen(XBIOS5) WithXBIOS5(Setscreen)itispossibletochangetheresolutionfromLow toMediumandfromMediumtoLow.Unfortunately,GEMignorestheswitch, soGEM-commands(e.g.ALERT,TEXT,MOUSE)donotworkproperly!Butyou couldchangefromLowtoMediumresolutiontoshowtextontheTOS-screen withPRINT(andVT52-commands).Mostuserswillbegratefulforthe improvedreadabilityofthetext: ~XBIOS(5,L:-1,L:-1,1) !switchfromLowtoMedium (...) !printtextinMediumresolution ~XBIOS(5,L:-1,L:-1,0) !andgobacktoLow Ifyouchangetheresolution,theVT52-emulatorisautomatically initialised.You'llprobablyhavetoadjustthepalettebeforeyoucan readthetextwithoutsun-glasses.Don'tforgettosaveandrestorethe oldpalette. XBIOS5isveryusefulifyouwouldliketodrawonascreenbefore showingittotheuser.Drawingonan"invisible"screenisindeed possible,becausetheoperatingsystemusestwoscreens:thephysical screen(visibleonyourmonitor)andthelogicalscreen(usually,butnot necessarily,thesameasthephysicalscreen).Allgraphical(GEM-)com- mands,includingtheTEXT-command,arealwayssenttothelogicalscreen. ButTOSwillsendPRINT-commandstothephysicalscreen,unlessyou've openedawindow!Iftheaddressoflogicalandphysicalscreenisnotthe same,youhaveyourinvisiblescreen(exceptforPRINTingontheTOS- screen).Theaddressofthelogicalscreenmustbeamultipleof256. StudytheProceduresInitio.logical.screen,Swap.screenand Restore.physical.screentoseehowyoucouldusethedescribedmethodfor animation: PROCEDURE initio.logical.screen ' *** global : SCREEN.1% SCREEN.2% DIM screen.2|(32256) screen.2%=VARPTR(screen.2|(0)) screen.2%=screen.2%+256-(screen.2% MOD 256) screen.1%=physbase% ~XBIOS(5,L:screen.2%,L:-1,-1) ! invisible screen.2 is now active RETURN  ' PROCEDURE swap.screen ' *** physical and logical screen are swapped SWAP screen.1%,screen.2% VSYNC ! avoid flash ~XBIOS(5,L:screen.2%,L:screen.1%,-1) ! swap the screens RETURN ' PROCEDURE restore.physical.screen ~XBIOS(5,L:physbase%,L:physbase%,-1) RETURN OnsomeST-computersXBIOS5doesnotfunctionproperlyafterinstallation ofaRAM-disk.Inthatcaseyoucouldchangetheaddressofthelogical screenwith: VSYNC  SLPOKE&H45E,adr% Font TOShasthreebuilt-insystem-fonts.ThedefaultPRINT-fontforHigh resolutionisthe8x16font(equalsDEFTEXT,,,13forTEXT),whilethe8x8 font(equalsDEFTEXT,,,6)isusedinMediumandLowresolution.Youcan switchbetweenthesetwofontswiththefollowingProcedures: PROCEDURE font.8x16 LOCAL a$,adr% a$=MKI$(&HA000)+MKI$(&H2009)+MKI$(&H4E75) adr%=VARPTR(a$) adr%=C:adr%() ! address of font-table {INTIN}={adr%+8} ! pointer to 8x16 system-font VDISYS 5,2,0,102 RETURN ' PROCEDURE font.8x8 LOCAL a$,adr% a$=MKI$(&HA000)+MKI$(&H2009)+MKI$(&H4E75) adr%=VARPTR(a$) adr%=C:adr%() ! address of font-table {INTIN}={adr%+4} ! pointer to 8x8 system-font VDISYS 5,2,0,102 RETURN BothProceduresseemtohaveproblemswiththeaccessoryQUICKST,butI neveruseitwithGFA-Basicbecausethereareotherproblems(INPUT)as well.IfIdon'tuseit,howdidIdiscoverthis?Goodquestion.Thethird fontisusedforicons,butforsomereasoncannotbecomethecurrent system-font.TheVDI-functionseemstoworkonlywithfontscontaining charactersofwidth8pixels.Thefunctionisnotofficiallydocumented byAtari(?). Youcanreplacethesystem-fontbyafontthathasbeencreatedwith FONTKITbyJeremyHughes(4114byteA1_xxxxx.FONfileforHigh resolution).UsetheProcedureChange.fontforthispurposeandcallthe ProcedureNormal.fonttorestoretheoriginalsystem-font: PROCEDURE change.font ' *** global : NEW.FONT! NORMAL.FONT% LOCAL adr%,new.font% ' ' *** load A1_xxxxx.FON file (4114 bytes) here INLINE new.font%,4114 ' adr%=L~A-22 normal.font%={adr%} SLPOKE adr%,new.font% new.font!=TRUE RETURN ' PROCEDURE normal.font IF new.font! SLPOKE L~A-22,normal.font% new.font!=FALSE ENDIF RETURN IhavenotyetdiscoveredhowtouseaFONTKIT-fontwithTEXT.Yes,I couldloadanewfontafterinstallingGDOS,butthat'snotwhatI'm lookingfor.Isthereaquickandnot-dirtywaytoconvinceGEMthatanew fonthasbeeninstalled? Afont-tableforthe8x16fontoccupies4096bytes(16bytes/character, 256characters).AFONTKIT-fontusuallyhasanameattachedattheend, that'swhyIreserve4114bytes.TOSignoresthenamecompletely,it's onlyusedbytheaccessoryFONSEL.ACC.Youcanloadany4096-bytefontin theProcedureChange.font,youdon'tevenhavetochange4114into4096. Althoughyoulose18bytesifyoudon't. 10.PRINTER  Printerready Ifyousenddatatoyourprinter(HARDCOPY,LPRINT,etc.),yourSTwill wait30looooooongsecondsiftheprinterhappenstobenotready.Always checkiftheprinterisreadybeforesendingdatatotheprinter,e.g.by callingthefollowingProcedure: PROCEDUREprinter.ready LOCALk DO EXITIFGEMDOS(17) ALERT3,"printer||notready!!",1,"OK",k LOOP RETURN HARDCOPY YoucansendascreendumptotheprinterbyusingthecommandHARDCOPYor bypressing.Inbothcasesyoucanabortthescreendump bypressing. YoucanuseCONTROL.ACCtochangetheprinter-parameters.Don'tforgetto savethedesktop,inordertostoretheseparametersinthefile DESKTOP.INF.Lookfor'#b'withyourdisk-editorifyou'recurious.The parameterswillonlybereadfromDESKTOP.INFifCONTROL.ACCisinstalled afterareset!IsuggesttheuseofXBIOS33(Setprt)inaprograminstead ofusingCONTROL.ACC.ForascreendumpfromtheHighresolutionscreento anEpson-compatibleprinter,clearbit1andsetbit2: PROCEDUREscreendump ~XBIOS(33,&X100) !screendumptoEpson(-compatible)printer HARDCOPY RETURN Ifyousetbit2,TOSassumesyouconnectedanEpson-printer(960 pixels/line).Clearbit2andTOSassumesyouhaveanAtari-printer(1280 pixels/line). IfyouuseHARDCOPY,thewidth/heightratiooftheprintoutdoesnot correspondwiththatofthescreen.Forareasonablyfast1:1screendump, studytheProcedureHigh.screendump.epson(EpsonFX-80,orother9-pin Epson-compatibleprinter)ortheProcedureHigh.screendump.star24(24-pin StarLC24-10): PROCEDURE high.screendump.star24 LOCAL m$,b$,k,scrn.start%,col,b%,x,d%,p|,b1|,b2|,b3|,n  lf$=CHR$(10)  ff$=CHR$(12)  DEFFN bit.image$(m,d)=CHR$(27)+"*"+CHR$(m)+CHR$(MOD(d,256))+ CHR$(d/256)  DEFFN line.space$(n)=CHR$(27)+"3"+CHR$(n)  initialize$=CHR$(27)+"@"  scrn.start%=XBIOS(2)  '   LPRINT initialize$;  FOR col=0 TO 79  b%=scrn.start%+col  LPRINT SPC(8);  LPRINT @line.space$(24);  LPRINT @bit.image$(33,800);  FOR x=399 TO 0 STEP -1  d%=ADD(b%,MUL(x,80))  p|=BYTE{d%}  IF p|=0  OUT 0,0,0,0,0,0,0  ELSE  CLR b1|,b2|,b3|  IF BTST(p|,0)  b1|=7  ENDIF  IF BTST(p|,1)  ADD b1|,56  ENDIF  IF BTST(p|,2)  ADD b1|,192  b2|=1  ENDIF  IF BTST(p|,3)  ADD b2|,14  ENDIF  IF BTST(p|,4)  ADD b2|,112  ENDIF  IF BTST(p|,5)  ADD b2|,128  b3|=3  ENDIF  IF BTST(p|,6)  ADD b3|,28  ENDIF  IF BTST(p|,7)  ADD b3|,224  ENDIF  OUT 0,b3|,b2|,b1|,b3|,b2|,b1|  ENDIF  NEXT x  LPRINT  EXIT IF INKEY$=esc$  NEXT col LPRINT ff$;  LPRINT initialize$; RETURN Foramoreflexibleapproach,studytheProcedureDegas.screendump(Star LC24-10,possibleformats:27x17,18x11,13.5x8.5or9x5.5cm). Itshouldbepossibletosendonlya(GET-)rectangletoyourprinterwith XBIOS36(Prtblk)orV_OUTPUT_WINDOW(VDI5,Escape21).Anybodyoutthere whoknowshow? Never,Irepeat,neverswapdisksduringascreendump,asthiscouldbe fatalforthenewdisk.TOSignoresthewrite-protectstateduringa screendump,soitwillmissthedisk-swapcompletely.TOSwillusetheold FATforthenewdisk,andthatusuallyisfatal(nopunintended). IfyouhaveinstalledaGFA-Basicprinter-driver(e.g.PTEPSON.PRG),a screendumpseemstobeimpossible.Thebit-imagemodeoftheprintercan't beusedafterthedriverhasbeeninstalled. Printer-commands Mostmatrix-printersrecognizeeitherIBM-orEpson-commands(orboth).I usethefollowingProceduretodefinethemostimportantprinter-commands formyStarLC24-10.Adaptthedefinitionstoyourownprinter,butstick tothenamesfortheglobalvariablesandfunctions.Otheruserscould thenuseyourprogramseasilyafterreplacingtheProcedureInitio.printer withtheirown: PROCEDURE initio.printer ' *** initializes global printer-variables for Star LC24-10 ' *** DIP-switch settings : ' 1-1 OFF 2-1 ON ' 1-2 ON 2-2 ON ' 1-3 OFF 2-3 ON ' 1-4 ON 2-4 ON ' 1-5 ON 2-5 OFF ' 1-6 ON 2-6 OFF ' 1-7 ON 2-7 ON ' 1-8 ON 2-8 ON ' LOCAL c$,f$ c$=CHR$(27) f$=CHR$(28) ' draft.char$=c$+"x0" lq.char$=c$+"x1" ' courier.style$=c$+"k0"+lq.char$ prestige.style$=c$+"k2"+lq.char$ orator.style$=c$+"k3"+lq.char$ script.style$=c$+"k4"+lq.char$ ' normal.char$=c$+"q0" outlined.char$=c$+"q1" shadow.char$=c$+"q2" outlined.shadow.char$=c$+"q3" ' italic.on$=c$+"4" italic.off$=c$+"5" '  emphasized.on$=c$+"E" emphasized.off$=c$+"F" ' underline.on$=c$+"-1" underline.off$=c$+"-0" ' bold.draft$=draft.char$+emphasized.on$+double.on$ bold.lq$=lq$+double.on$ bold.off$=emphasized.off$+double.off$ ' superscript.on$=c$+"S0" superscript.off$=c$+"T" subscript.on$=c$+"S1" subscript.off$=c$+"T" ' epson.set$=c$+"t0" ibm.set$=c$+"t1"+c$+"6" DEFFN special.on$(n)=c$+"\"+CHR$(MOD(n,256))+CHR$(DIV(n,256)) DEFFN ibm.special$(n)=c$+"^"+CHR$(n) DEFFN epson.special$(n)=ibm.set$+@ibm.special$(n)+epson.set$ ' pica$=c$+"P" ' elite$=c$+"M" ' condensed.on$=CHR$(15) condensed.off$=CHR$(18) ' large.on$=c$+"W1" large.off$=c$+"W0" large.line$=CHR$(14) ' courier.proportional$=courier.style$+c$+"p1" prestige.proportional$=prestige.style$+c$+"p1" proportional.off$=c$+"p0" ' DEFFN master.mode$(n)=c$+"!"+CHR$(n) underline=128 italic=64 expanded=32 LET double.strike=16 emphasized=8 condensed=4 proportional=2 elite=1 ' normal.size$=c$+"h"+CHR$(0) LET double.size$=c$+"h"+CHR$(1) quad.size$=c$+"h"+CHR$(2) LET double.height$=c$+"w1" normal.height$=c$+"w0" normal.width$=f$+"E"+CHR$(0) LET double.width$=f$+"E"+CHR$(1) triple.width$=f$+"E"+CHR$(2)  ' lf$=CHR$(10) DEFFN lf$(n)=c$+"f1"+CHR$(n) rev.lf$=c$+CHR$(10) ' ff$=CHR$(12) rev.ff$=c$+CHR$(12) ' justify.left$=c$+"a0" justify.right$=c$+"a2" justify.full$=c$+"a3" center$=c$+"a1" ' reset$=c$+"@" ' RETURN Ofcourseyoucoulddeleteallvariablesyoudon'tneedinyourprogram. Anditreallywouldbeniceifeveryoneusestheproposednames.Oneof thestrongpointsofPublicDomainGFA-programsisthatit'seasytoadapt aprogram.Orrather,itshouldbeeasy.UsingtheaboveProcedureisone stepintherightdirection. 11.FILES  FloppyWriteTest YouareadvisedtoswitchtheWriteVerifytestoff: SPOKE&H444,0 !testoff SPOKE&H444,1 !teston(default) AccordingtoexpertslikeDaveSmallandBillWilkinsontheVerifytestis acompletewasteofvaluabletimeifyouwritetoadisk. StepRate Youwillfindthecurrentstep-rateofyourdrivewith: PRINTDPEEK(&H440) Thefollowingvaluesarepossible: 0-6ms 1-12ms 2-2ms 3-3ms(default) Theoperatingsystemonlylooksatthisvalueafterareset(?).Foran external5.25"-driveyouprobablyhavetouse12ms. RAM-disk  DriveDisoftenreservedforaRAM-disk.GFAwillrecognizeaRAM-disk withDFREE(4)onlyifitwasalreadypresentatthetimetheinterpreter wasloaded. Afterswitchingoffyour1040STyoushouldwaitatleast15seconds beforeswitchingonagain.OtherwiseanoldRAM-disk(orsomethingelsein RAM,e.g.avirus...)maystillbepresentwhenyouswitchyourcomputer onagain. IfaRAM-diskisnotinstalledproperlyafterareset,thereasoncouldbe hiddeninthedrivebit-tableat&H4C2.TheoldTOSdoesnotclearthis tableandaRAM-diskcanonlybeinstalledasdriveDifbit3iscleared. Bytheway,usedriveC(bit2)onlyforaharddisk. DIR$() UseGEMDOS25(Dgetdrv)tofindthecurrentdriveandcombinethiswith DIR$(drive)tofindthecurrentpath: drive=GEMDOS(25) !drive0-15 drive$=CHR$(65+drive) !driveA-P p$=DIR$(drive+1) IFp$="" path$=drive$+":\" !maindirectory ELSE path$=drive$+":"+p$+"\" ENDIF WithDIR$(0)you'llfindthepathofthecurrentdrive,notnecessarily driveA.DIR$(1)returnsthepathofdriveA.GEMDOSremembersthelast usedpathforallavailabledrives.SeealsotheStandardProcedure Get.path. IfyourunGFA-BasicfromthemaindirectoryandloadaGFA-programfroma folder,DIR$(0)willreturnthenullstring(""),notthefolder.After usingCHDIRwiththefolder-name,thecorrectpathwillbereturned.Iuse CHDIRintheShell-programs,sotheStandardGlobaldefault.path$will containthepathoftheGFA-program.Thismakeslifeeasierifyouwantto loaddata-filesfromthesamefolder,butdon'tknowtheprecisepathwhen youwritetheprogram.Itwouldbeniceifyoucoulddeterminethepathof therunningGFA-programintheprogramitself. Youcanmakeanarray-tableofavailabledriveswiththeaidofBIOS10 (Drvmap): DIMdrive!(15) SELECTDPEEK(&H4A6) CASE1 drive!(0)=TRUE CASE2 drive!(0)=TRUE drive!(1)=TRUE ENDSELECT table%=BIOS(10) FORn=2TO15 IFBTST(table%,n) drive!(n)=TRUE ENDIF NEXTn Youcancheckifaharddiskisconnectedwith: IFPEEK(&H472)<>0 harddisk!=TRUE ENDIF DIRandFILES AfterDIR,FILES,TRONorDUMPyoucanslowdownthescrollingwith .Youcantemporarilystopthescrollingbyholdingdownthe right-key.TheoutputafterDIRfitsonanyscreen,buttheFILES- outputistoowideforLowresolution.DIRwillshowonlyfilesinthe currentdirectory.FILESwillalsoshowfolders(markedwith*).WithDIR (andFILESELECT)youwillnotbeabletosee"hidden"filesor"system" files,butFILESwillshowallfiles.Youcanalsosearchforhidden and/orsystemfileswithFSFIRSTandFSNEXTbysettingbit1and/orbit2 oftheattribute-byte. PerhapsyouhavenoticedthatafterthecommandFILESthefirsttwolines arepeculiarifyouhappentobeinafolder.Thefirst"name"inafolder isalways'.'(onedot)andthesecondalways'..'(twodots).Timeand dateareincorrect,becausetheauthorsof(theold)TOSforgottoconvert thesetoMS-DOSformat.Incaseofnestedfolders,theoperatingsystem findstheprecedingfolderthroughapointerofthe'..'-file.That'swhy youcanuse'CHDIR..'toreturntotheprecedingfolder.Don'ttrythis inthemaindirectory,oryou'llgetanerror. FSFIRSTandFSNEXT TheDTA-bufferisusuallyfoundatBASEPAGE+128(it'salwaysthereafter start-up),butyoushouldnotcountonit.UseFGETDTA()tofindthe currentaddress,beforeFSFIRST: dta.adr%=FGETDTA() e%=FSFIRST(format$,attr) FSFIRSTreturns-33ifnofilehasbeenfound.FSNEXTreturns-49ifno morefilesarefound. Inanaccessoryit'ssafertocreateanewDTA-buffer: old.dta%=FGETDTA() !oldbuffer dta$=STRING$(44,0) dta.adr%=V:dta$ ~FSETDTA(dta.adr%) !newbuffer (...) !FSFIRST/FSNEXT ~FSETDTA(old.dta%) !restoreoldbuffer TheDesktopwillappreciateallthisextrawork. The44byteDTA-buffer(DataTransferAddress)containsthefollowingdata afterasuccesfulFSFIRSTorFSNEXT: offset  0-20 -reserved  21 -attribute-byte 22-23 -time 24-25 -date 26-29 -file-length 30-43 -filename(includingtheextension,terminatedby&H00) Theattributesandthefilenamecanbereadfromthebufferwith: attr=BYTE{dta.adr%+21} file$=CHAR{dta.adr%+30} TheDTA-bufferisnotanexactcopyoftherelevantinformationinthe directoryofthedisk.Withadisk-editoryouwouldfindaslotof32 bytesforeachfileorfolder: offset  0-7 -file-orfolder-name(withoutextension) 8-10 -extension 11 -attribute-byte 12-21 -reserved 22-23 -time 24-25 -date 26-27 -FAT-pointer 28-31 -file-length Thefirstbyteofthefilenamehasaspecialmeaninginthefollowing cases: &H00 -freeslot,neverusedbefore &HE5 -erasedfile,nowfreeslot &H2E -subdirectory BothtimeanddatearestoredinMS-DOSformat.ConsultyourGFA-manual formoreinformation.TheFAT-pointer,alsoinanMS-DOSformat(Intel- format :firstlowbyte,thenhighbyte),pointstothefirstclusterof thefile.Ifyouarelookingatafolder,theFAT-pointerpointstothe clusterwhereyouwillfindthedirectoryofthisfolder(subdirectory). Ifyouarelookingatasubdirectory(i.e.youareinafolder),thefirst twoslotsarereservedforthefiles'.'and'..'(&H2Eand&H2E2E).This hasalreadybeenmentionedintheparagraph'DIRandFILES'.Finally,the file-lengthisstoredin,youguessedit,MS-DOSformat.Youmightwonder whatMS-DOShastodowithAtari-disks.Readtheparagraphs'DiskFormat' and'FileAllocationTable'fortheexplanation. Ifyouusetheattribute-byte&X10000youwillfindbothfoldersand files!Ifthefoldersinadirectorydon'thaveanextensionandallfiles dohaveanextension,youcouldfindallfoldersinthemaindirectoryas follows: e%=FSFIRST("\*",&X10000) !ande%=FSNEXT()fornextfolders Ifyoucan'tusethissimplemethod,you'llhavetocheckaftereach successfulFSFIRST/FSNEXTifit'safolderorafile: IFBTST(BYTE{dta.adr%+21},4) (...) !yes,it'safolder ENDIF Usetheattribute-byte0(i.e.nobitsset)tofindordinaryfilesonly. Useattribute-byte&X1000tofindthedisk-name: dta.adr%=FGETDTA() e%=FSFIRST("\*.*",&X1000) !findsdisk-nameonly,notfiles disk.name$=CHAR{dta.adr%+30} YoucanreadtheattributesofafileorfolderwithGEMDOS67(Fattrib): attr%=GEMDOS(67,L:V:filename$,0,0) Ifthefile(orfolder)isnotfound,attr%is-33(or-34),otherwise attr%containstheattributesintheusualformat.Youcanevenchangethe attributesoffileswith: r%=GEMDOS(67,L:V:filename$,1,attribute%) It'snotpossibletochangetheattributesoffoldersorthedisk-name withGEMDOS67.Onewaytodothatistochangethedirectory-sectorwith theaidofBIOS4(Rwabs).Ifyoureallyfeeltheurgetoexperiment,you shouldrealizethatonetinymistakecouldruinthedisk. EXIST YoucanuseEXISTtotestifafolderexists,butonlyifthefolder containsatleastonefile: IFEXIST("\FOLDER\*.*") (...) !folderfound ELSE (...) !foldernotfoundoremptyfolder ENDIF  LOF ThelengthofafileiseasilydeterminedwithLOF: OPEN"I",#1,file$ length%=LOF(#1) CLOSE#1 Todeterminethenumberofrecordsinarandomfileyoucoulddividethe file-lengthbythetotalFIELD-length. TOUCH UsethismethodwithTOUCH: OPEN"U",#1,file$ TOUCH#1 CLOSE#1 NAME WiththeoldTOSyoucanonlychangethenameoffiles,notoffolders. Evenfromthedesktopyoucan'tchangethenameofafolder,sochooseit carefully. KILL KILLingafiledoesnoteraseitfromthedisk.Thefirstbyteofthe filenameischangedto&HE5.Unfortunatelyyoucan'trestoreakilledfile bysimplychangingthisbytewithadisk-editor.Theoperatingsystemwill beabletofindthefirstclusteroftherestoredfile,becausethefirst FAT-pointerislocatedinthedirectory.Thenextclusterscanonlybe foundthroughtheFAT(FileAllocationTable),butafterKILLallpointers tothisfileareirreversiblyerased.Ifyouhavenotkilledanyfileon thediskbeforeyourfatalmistake,youareextremelyluckyandwillfind allclustershavebeenstoredconsecutively.Butaftersomekillingand savingonthedisk,thefilecouldbedispersedovertheentiredisk.Some programsareabletohelpyou,butyouwillhavetorecognizeclustersas belongingtothekilledfile.That'seasywithASCII-files,butalmost impossiblewithotherfiles.So,don'tKILLunlessyouhaveto. FileCopy Youcancopyafilesource$todest$(usecompletepathnames!)with: PROCEDURE file.copy(source$,dest$) LOCAL block% OPEN "I",#90,source$ OPEN "O",#91,dest$ block%=LOF(#90) WHILE block%>32000 PRINT #91,INPUT$(32000,#90); SUB block%,32000 WEND PRINT #91,INPUT$(block%,#90); CLOSE #90 CLOSE #91 RETURN Donotcopyafile"toitself"onaharddisk.Thankstoyetanotherbugin TOS,thisactioncouldcompletelywipeouttheharddisk.Orperhapsthis shouldbecalledafeatureofTOS,puttheretopunishthecrazyuserwho triestocopyafiletoitself.  DiskFormat Adiskcontains80concentrictracks(numbered0-79)ormore.Sometimes theexpression"cylinder"isusedinsteadof"track".Eachtrackis dividedinto9,10oreven11sectors.Onesectorcancontain512data- bytes.InordertobecompatiblewithMS-DOS,TOSformatsadiskwith80 tracksand9sectors/track.Actuallyit'seasytofit10sectorsinone track.Withalittlemoreeffortyoucancreateroomfor11sectors,but somedrivesrunslightlytoofastandarenotabletoreadthe11th sector! Withadisk-editoryoucanexaminethe512data-bytesofasector,but youcan'texaminethesector-layoutwithoutaccessingtheFloppyDisk Controller(FDC)directly.Inthatcaseyouwouldfindthefollowing layoutforeachsector: data-separator(GAP) -15bytes ID-Addressmark -1byte sector-header -4bytes(track,side,sector,size) CRCofsectorheader -2bytes dataseparator -37bytes Data-AddressMark -1byte databytes -512bytes CRCofdatabytes -2bytes dataseparator -40bytes ThedataseparatorbytesaretheretosynchronizetheFDCproperly.The FDCrecognizesthesector-headerbytheprecedingID-Addressmark.The sector-headeritselfcontainsinformationaboutthecurrenttrack,side andsectorandalsoaboutthesizeofthedata-field(usually512bytes). TheFDCchecksboththesector-headerandthedata-fieldforcorrupted bytesbycomparingacomputed"checksum"withthestoredCRC-value.The operatingsystemcannotread/writeonebytefrom/toasector,only completesectorsarereadorwritten.GFA-Basictakescareofallthe dirtywork. Firstsomebadnews.ACRC-errorisnotalwaysrecognizedbytheROMof 520ST'sand1040ST's(buginXBIOS8,Floprd).Ifyourpalmsarenow gettingsweatty,youcouldcheckyourmostpreciousdiskswithXBIOS19 (Flopver).Thisfunctionchecksfor'lostdata,RNF-orCRC-errors'. Createabufferof1024bytesandcallXBIOS19.Asector(512bytes)is loadedfromthediskindriveAorB(0or1)intothesecondpartofthe bufferandchecked.Ifabadsectorisfound,thesector-numberisstored asawordinthefirstpartofthebuffer.Aftercheckingallsectorsin onetrackyouhavetoexaminetheword-listinthebuffer.Hopeyouwill findonly&H0000there.Ileavethewritingofthisprogramasanexercise tothereader.NeverthoughtIwouldusethatphrasemyself.Allright, here'ssomethingtogetstarted: buffer$=STRING$(1024,0) adr%=V:buffer$ r%=XBIOS(19,L:adr%,L:0,drive,1,track,side,9) !if9sectors/track Youshouldnowbeabletofindoutifthetrackonthisside(0or1)is OK.Goodluck. YoucanuseBIOS7(Getbpb)toexaminethedisk-formatintheso-called BIOS-Parameter-Block(BPB)ofthedisk: bpb.adr%=BIOS(7,drive) !addressofBPB,or0(=error) In9wordsyou'llfindthefollowinginformationintheBPB: offset 0 -bytes/sector(usually512) 2 -sectors/cluster(usually2) 4 -bytes/cluster 6 -numberofdirectory-sectors 8 -lengthofFAT 10 -firstsectorofsecondFAT 12 -firstdata-sector 14 -totalclusters 16 -flag(notused) UseGEMDOS54(Dfree)tofindouthowmanyfreeclustersareavailable,or simplyuseDFREEifyouwanttoknowhowmanyfreebytesareavailableon adrive.Duetoabug,GEMDOSmissesthelasttwoclustersonadisk.You can'twritetotheseclusters(2048bytesdownthedrain...),butyoucan readtheseclustersiftheydocontaindata.Thatwouldbeamiracle,or anMS-DOSdisk. You'llprobablyuseXBIOS10(Flopfmt)toformatadiskfromGFA-Basic.If youdo,use&H0000asthevirgin-valueforthefirst18sectors,andthen &HE5E5foralldata-sectors.Youcanuseeither9or10sectors/track,not 11.Ifyouuse10sectors/track,youshouldfillthefirsttwotrackswith &H0000andfillsectors19and20with&HE5E5afterwards(readthe paragraph'Sectors').Idon'trecommendmorethan80tracks,certainlynot morethan82tracks.IfXBIOS10returnsavalueotherthan0,you'llfind alistofbadsectorsinthebufferyouused(terminatedwith&H00).If oneofthefirst18sectorsisbad,youcanthrowthediskaway. UsingXBIOS10,theinterleave-factorshouldbe1.Thismeansthesectors onatrackarenumberedconsecutively:1,2,3,4,etc.Idon'tunderstand whysomeprogrammersuseanothervalueandcallit'FastFormat'.TheFDC needsmoretimetoreadacompletetrackiftheinterleave-factorisnot 1.Perhapstheytrytocreatetheso-calledTwisted(orSkewed)format. TOSlosestimeiftheheadmovestothenexttrack.BecausetheSeekwith Verifyflagisset,theFDCfirstverifiesthetrack-numberandthenreads thesector-number.Whilecheckingthetrack-number,sector1waspassing, sowehavetowaitforonecompletespinofthedisk(200ms,yawn)until sector1canberead.OnesolutionistocleartheSeekwithVerifyflag, butthatcouldleadtonastyproblemsiftheheadstillrattlesslightly atthetimesector1isread.ThebestsolutionistheTwistedformat (adoptedbyAtarifromtheMegaSTonwards).Forasingle-sideddiskwith 9sectorsononetrackthismeans: track0:sector1,2,3,4,5,6,7,8,9 track1:sector8,9,1,2,3,4,5,6,7 track2:sector6,7,8,9,1,2,3,4,5 etc. Now,sector1isencounteredalmostimmediatelyafterthetrack-numberis verified.A1-sectoroffsetisnotpossible,buta2-sectoroffsetis enoughtosettletherattlinghead.Itisimpossibletoreaddatafaster fromadisk!ButI'mafraidyoucan'tformataTwisteddiskwithXBIOS10 ifyouhaveanoldTOS.Youhavetouseaspecialformat-program. Ifyouformatadiskfromthedesktop,badclustersareflaggedwitha specialvalueintheFAT.However,ifTOS1.4encountersabadsector, somethinggoeswrongandtheFATiscorrupted.Onemorereasontoquit smoking,becausesmoke-particlesdefinitelyconstituteaserioushazardto thehealthofyourdisks. YoucanuseXBIOS18(Protobt)tocreateabootsectorontheformatted disk.Don'tworryaboutthemedia-byte(disk-type),becauseTOSdoesn't useit.Douse&H1000000togeneratearandomserialnumber,becauseitis veryimportantthatdifferentdiskshavedifferentserialnumbers!Write thebootsectortothediskwithXBIOS9(Flopwr),notwithBIOS4(Rwabs): r%=XBIOS(9,L:buffer%,L:0,drive%,1,0,0,1) Whyaredifferentserialnumberssoimportant?IfTOSsuspectsadisk- swap,theserialnumberisreadfromthedisk.Adisk-swapcanonlybe recognizedifthenumberonthenewdiskisdifferentfromtheoldnumber. Ifthenewdiskcontainsthesameserialnumber,TOSusestheFATofthe previousdisk.Writingtoaswappeddiskwillprobablyzapit,ifyou followme.Disk-copierscopyeverything,includingserialnumbers.Be careful! AlthoughitispossibletoformatadiskfromGFA-Basic,Idon'trecommend it(nowhetellsus...).Myfavouriteformatis: 80tracks 10sectors/track Twistedformat IuseTWISTER.PRG(notPublicDomain,asfarasIknow),butyoucoulduse aPublicDomainprogramlikeDCOPY(actuallyShareware).TheDesktopcan't copyaTwisteddisk,butfile-copyisalwayspossible.DCOPYcopiesany format,includingTwistedformat. FileAllocationTable(FAT)  Thefirstsectoronadiskistheboot-sector.Thenextfivesectorsare reservedfortheFAT.AndthenextfiveforacopyoftheFAT(actually it'stheotherwayaround).Finally,themain(orroot)directoryoccupies thenext7sectors(32bytesforeachslot).Thismeansthatthefirst18 sectors(No.0-17)arereservedfortheoperatingsystem.Allother sectorsareavailableforstoringfiles. Thestorage-unitforfilesisacluster.Aclusterconsistsoftwo consecutivesectors(1024bytes).Afilethatcontainsonly1bytewill thereforestilloccupy1024bytes(1K)onthedisk.Whenafileissaved, theoperatingsystemlooksforthefirstemptycluster,thenthenext, etc.InformationaboutavailableclustersisstoredintheFATasa collectionofpointers.Duetoinefficientprogramming,thesearchfor freeclusterstakesalongtime.TryDFREEonaharddiskandyou'llagree. InstallaprogramlikeFATSPEED.PRG(PublicDomain,byUlrichKuebler)to speedthisup! ThefirstthreebytesoftheFATarenotusedbyTOS,butarethereto enableMS-DOStoreadanST-formatteddisk.TOSwrites&HF7FFFF,wherethe firstbyte(&HF7)issupposedtobethemedia-byte.UnfortunatelyMS-DOS doesn'tunderstandthisandrefusestoreadthedirectoryproperly.I'm notquitesurewhy,butchangingthefirstthreebytesto&H000000seems towork.Youcouldtry&HF8FFFF(80tracks,9sectors/track,singlesided disk)or&HF9FFFF(doublesideddisk)instead.Oryoucouldusethemedia- byteatoffset21fromthebootsector.TomakeyourMS-DOSfriends completelyhappy,youshouldchangethefirstthreebytesofthebootsec torto:&HEB3890.Sometimes(DOS4.0?)youhavetochangethenextthree bytesaswell:&H49424D(that'sIBMinASCII;pleasewatchyourlanguage). Betterstill,letthemusetheirowndiskeditorontheirMS-DOScomputer (e.g.NortonUtilities).Whyshouldyoudoallthework?Bytheway,your STshouldbeabletouseanMS-DOSdiskwithoutanymodifications. EachFAT-pointerconsistsofoneandahalvebyte(3nibbles,i.e.12 bits).Inhexadecimalnotationthismeansthreedigitsforonepointer. Thefirstpointer(No.0)pointstoclusterNo.0,thesecondtoNo.1, etc..Becausethefirsttwopointersdon'tcount,youhavetosubtract twotofindtheactualcluster(pointer2pointstoclusterNo.0,etc.). ThefirstclusterstartsatsectorNo.18(remember,sectors0-17are reservedforbookkeeping),soyoucouldfindthefirstsectorofacluster with: (pointer-2)*2+18 Thesecondsectorofthisclusterisofcoursethenextone. TOSreadsthepointersinapeculiar(MS-DOS)way.SupposetheFAT-sector startswith: F7FFFF034000FF0F00 Withoutfurtherexplanation,thistranslatesto: FAT-pointer0and1areignored FAT-pointer2=&H003(nextclusteronsector20+21) FAT-pointer3=&H004(nextclusteronsector22+23) FAT-pointer4=&HFFF(lastclusterofthisfile) FAT-pointer5=&H000(freecluster) Inordertounderstandthis,youhavetoconsultthefollowingtable: &H000 :clusterstillavailable &HFF1-&HFF7:badcluster,neveravailable &HFF8-&HFFF:lastclusterofthisfile(EndOfFile) &H002-&HFF0:pointertonextcluster AssumingtheFAT-pointer&H002atoffset26inthedirectory(you'llfind &H0200withadiskeditor,that'sIntelformatwithlowbytefirstagain), youshouldbeabletofigureoutthatthisfilewillbefoundinsectors 18through23.Sectors24/25areempty,sothisclusterisavailablefora newfile.Anyquestions?Theonebigadvantageofallthisiscompatibi litywithMS-DOSdisks.WithTOS1.4yourST-diskscanbemadecompletely compatible,soyoudon'tevenhavetochangeafewbytes. Right,youhavejustreadtheFatman-book.Themoviewillbereleased shortly,butyoucanNOWbuythosefabulousFatman-shirtsandfantastic Fatman-buttons.CallAtariforfurtherdetails. Sectors Therearetwodifferentmethodstoassignanumbertoasector.Thefirst oneistonumberthe"physical"sectorsineachtrackfrom1to9 (assuming9sectors/track).Thiswayyoucouldsaythebootsectoris sector1ontrack0(onside0ifthediskisdoublesided).ButGEMDOS doesn'tcareabouttracksorsides,itcounts"logical"sectorsfrom0to 719(80tracks,9sectors/track,onesideddisk)orfrom0to1439(double sideddisk).AccordingtoGEMDOS,thebootsectorisonsector0.Andona doublesideddisk,physicalsector1ontrack0ofside1(theotherside) wouldbesector9. WithBIOS4(Rwabs)youcanread(andwrite)completelogicalsectors: buffer$=SPACE$(512) !512bytesfor1sector buffer%=V:buffer$ !addressofbuffer r%=BIOS(4,0,L:buffer%,1,sector%,drive%) !loadthesucker YouwouldloadthebootsectorfromthediskindriveAwith: r%=BIOS(4,0,L:buffer%,1,0,0) YoucanuseBIOS4notonlywithfloppydisks,butalsowithaharddisk oraRAM-disk.Afterloadingasector,youcanreadonebytewith: b|=BYTE{buffer%+n}  !nfrom0to511 Youcanreadawordwith: w=WORD{buffer%+n} Butonlyifthewordstartsatanevenaddress.Otherwiseyouhavetouse: w=BYTE{buffer%+n+1}+256*BYTE{buffer%+n} Ifnecessary,youcanspeedthisupbyusingthespecialintegercommands foradditionandmultiplication.HowaboutthisPolishmonster: DEFFN word(adr%)=ADD(BYTE{SUCC(adr%)},MUL(256,BYTE{adr%})) Thenyouwoulduse: w=@word(ADD(buffer%,n)) IfyouuseBIOS4towriteasectorafterformattingadisk,youshould use'3'asaflag(not'1'): r%=BIOS(4,3,L:buffer%,1,sector%,drive%) YoucanalsoreadandwritephysicalsectorswithXBIOS8(Floprd)and XBIOS9(Flopwr).Withthesecommandsyoucouldevenread/writeall sectorsononetrack.Thisistheonlywaytoreadatrack,because readingacompletetrackisimpossibleduetoabugintheFDC. Ifyouswapadiskafterloading/writingasectoryoushouldbecareful. TestingwithBIOS9(Mediach)youcouldmissthedisk-swap.Thiscouldbe fatal,becauseTOSusestheFAToftheotherdisk!Ithinkyoucoulduse BIOS7(Getbpb)inmostcases,butusetheProcedureForce.mediachifin doubt: PROCEDUREforce.mediach LOCALx$,old.vector%,a% x$=SPACE$(12)  old.vector%=LPEEK(&H47E)  a%=V:x$ DPOKEa%,&H2B7C LPOKEa%+2,old.vector% DPOKEa%+6,&H47E  DPOKEa%+8,&H7002 DPOKEa%+10,&H4E75 SLPOKE&H47E,a% ~DFREE(0) !currentdrive RETURN Tobemoreprecise,BIOS7can'tbeusedinthefollowingsituation: -TOSreadsasector -youswapdisks -youuseBIOS7inyourprogram -TOSreadsasector NowTOSwillassumetherehasbeennodisk-swap,becausetherehasbeenno disk-swapafterthelastBIOS7call!YoudefinitelyneedtheProcedure Force.mediachinthiscase. Bythetrack,TOSalsoignoresdisk-swapsduringascreendump(HARDCOPY), orwhileusingDMA(harddisk,laserprinter).TOSdetectsadisk-swapby monitoringthewrite-protectstate.Toseethis,youshouldturnall lightsoffandthenwatchthedrive-lightclosely.Closer.Youcanturn thelightsonagain.Ifthedriveisempty,TOSgetsawrite-protect signalandassumestheusermighthaveswappeddisks.BIOS9shouldreturn '1'atthispoint.TOSchecksifyoureallydidswapdisksbyreadingthe serialnumberfromthebootsectorandcomparingitwiththecurrent number.Onlyifthesenumbersaredifferent,adisk-swapisrecognizedby TOS(BIOS9shouldreturn'2'now).YouprobablydeducedthatTOSwill readthebootsectoralsoifyouuseawrite-protecteddisk.Continuously readingthebootsectorisawasteoftime,soTOSwaits1.5secondsbefore lookingagain.Neverswapdiskswithin1.5secondsafteraread/write- operation.Thedrivekeepsspinningfor2seconds,soyoucan'tgowrong ifyouwaituntilthedrive-lightisoffbeforeswappingdisks. Bootsector Inthefollowingtableyou'llfindthelay-outofabootsector.Allwords areinIntel-format,exceptCHKSUM. offset length name 0 2 &H6038=branchtobootroutine 2  6 FILLER fill-bytes 8 3 SERIAL serial-numberofdisk 11 2 BPS bytes/sector(512) 13 1 SPC sectors/cluster(2) 14  2 RES reservedsectors(1,Bootsector) 16 1 NFATS numberofFAT's(2) 17 2 NDIRS max.entriesinmaindirectory 19 2 NSECTS totalsectors 21 1 MEDIA media-byte(notusedbyTOS) 22 2 SPF sectors/FAT(5) 24 2 SPT sectors/track 26 2 NSIDES sides(1or2;nojokethistime) 28 2 NHID hiddensectors(ignoredbyTOS) 30 2 EXECFLAG startofbootcode:flag 32 2 LDMODE 0=loadFNAME;<>0=loadsectors 34 2 SSECT firstsector(LDMODE<>0) 36 2 SECTCNT numberofsectors 38 4 LDADDR loadatthisRAM-address 42 4 FATBUF addressofFAT-buffer 46 11 FNAME filename(nnnnnnnneee)(LDMODE=0) 57 1 DUMMY fill-byte 58 boot-routine(couldbeaboot-virus) 510 2 CHKSUM TOSdeterminesifthebootsectorisexecutablebyaddingallbytes.If thissum(AND&HFFFF)equals&H1234,thebootsectorisexecutable.Ifyou useGFA-BasicthisprobablymeansyouhaveanancientSTwithTOSinRAM, oraboot-virus.AnormalGFA-diskhasonly&H00-or&HE5-bytesfromthe offset58. BLOAD BLOADneedsanaddress,unlessyouhaveusedBSAVEinthesameprogram before.InthatcasetheBSAVE-addressisusedautomaticallybyBLOADif youdon'tspecifyanewaddress. BLOAD(BSAVE)iseasiertousethanBGET(BPUT),becauseyoudon'thaveto openthefile.ButwithBLOADyoucanonlyloadtheentirefile,while BGETallowsyoutoloadanypartofthefile. INPandOUT BothINPandOUTcanalsobeusedwith2-byteand4-byteintegers: a|=INP(#n) a&=INP&(#n) a%=INP%(#n) OUT#n,a| OUT&#n,a& OUT%#n,a% INPUTandLINEINPUT BecauseGFAnowusesa4K-bufferforeachopenedfile(version3.07), readingdatafromafilewith(LINE)INPUTgoesmuchfaster. STOREandRECALL Forveryfastloadingandsavingofstring-arrays,youshoulduseRECALL andSTORE.Youcanalsostore(orrecall)apartofanarrayasfollows: STORE#1,txt$(),10 !storeelements0through9 STORE#1,txt$(),5TO10 !storeelements5through10 Thecorrectsyntaxis: STORE#i,x$()[,n[TOm]] RECALL#i,x$(),n[TOm],x% (usen=-1forcompletearray) Ofcourseyouhavetoopenthefilefirst. IfyouSTOREatext-array,GFAputs&H0D0A(CHR$(13);CHR$(10))aftereach element.Thisisthesameformatasusedby1stWordPlus(WPModeoff, i.e.ASCII-mode),Tempus,etc. Ifyou'regoingtoshowmorethanafewtext-lines,youcouldenterthe textasDATA-lines,e.g.withtheProceduresInitio.text.arrayand Initio.text.array.low(forLowresolution): PROCEDURE initio.text.array ' *** global : TEXT$() LOCAL lines,line$,n lines=0 RESTORE txt.data READ line$ REPEAT INC lines READ line$ UNTIL line$="***"  ERASE text$() DIM text$(lines) RESTORE txt.data FOR n=1 TO lines READ text$ text$(n)=SPACE$(5)+text$ ! left margin of 5 spaces !! NEXT n txt.data: DATAtext DATA *** RETURN Ifyouaregoingtoshowmoretext,Isuggestyouuse1stWordPlus,or anyotherwordprocessorortext-editorthatcansaveyourtextasan ASCII-file.With1stWordPlus,IuseaRulerlengthof70andthe followingPageLayoutForm: Paperlength 66 TOFmargin 19 Headmargin 4 Footmargin 4 BOFmargin 19 Lines/page 20 EnterthetextandsaveasanASCII-file(turnWPModeoffbeforesaving). InyourGFA-Basicprogramyouwouldfirstloadthetextinastring-array: DIMtext$(lines) OPEN"I",#1,file$ RECALL#1,text$(),-1,lines%!lines%lines+1 CLOSE#1 ThenyoucouldusetheProcedureShow.text.page(HighorMediumresolu tion)toshowthetextwith20lines/screen.TheProcedureusesaleftand rightmarginof5characters,sothat'swhyyouhavetouse70charac ters/lineinyourwordprocessor.Ifthetext-arrayisfull,youwon'tget anerrorifthefilecontainsmoretext-lines! Youcouldusea2-dimensionalstring-arraytostorefirstandlastnames: name$(i,0)=first_name$ name$(i,1)=last_name$ Again,STOREandRECALLareveryfast.Butitisnownecessarytouse exactlythesamedimensionswithRECALLthatyouusedwithSTORE.Ifthe dimensionsdon'tmatch,thearraywillbescrambledafterRECALL. FILESELECT Don'tusetheunderscore'_'inthepath-lineoftheFileselector,because abugintheoldTOSwillthencauseafewbombs.OwnersofaMegaSTor TOS-version1.4canuseasmanyunderscoresastheylike. ChangingdrivesintheFileselector(oldTOS)isnoteasy.Clickonthe path-lineandpresstocleartheline.Enterthedrive,e.g.'D:\', andclickonthebarunderthepath-lineinordertoreadthenew directory.Alsoclickonthisbarafterchangingdisks(inthiscaseyou wouldpressonthedesktop).SelectingdriveAiseasier:justclear thepath-lineandclickonthebar.TheTOS-codethattakescareofall thisworkisalsoknownasthebartender. Ifyouhavechangedtheextensioninthepath-line,youshouldclickjust belowthebar.Ifyouclickonthebar,thepath-lineisoverwrittenwith '*.*'!Thatsamebartenderstrikesagain. ThecorrectsyntaxforcallingtheFileselectoris: FILESELECT[#title$,]path$,default$,file$ ThetitleisonlyusedinTOS-version1.4andignoredinolderTOS- versions.Thedefault$usuallyisthenull-string(""),butdon'tusethe null-stringforpath$ortheFileselectorwillfreeze.Use"\*.*"aspath$ forallfilesinthemaindirectory.Dousethebackslashinthepathname (e.g."A:\*.*").DuetoabuginGEM,thewrongdriveissometimesusedif youforgetthebackslash("A:*.*").Iftheuserhasselectedafile,file$ willcontainthepathandfilename.Thefile$willbethenull-stringif theuserselected.Athirdpossibilityiseasilyoverlooked:the usercouldhaveselectedwithoutchoosingafile.Inthatcasefile$ containsthecurrentpath,endingwithabackslash. Donotdespairifyouneedatitle,butdon'thaveTOS1.4.Trythe ProcedureFileselect(HighorMediumresolution)orFileselect.low: PROCEDURE fileselect(path$,default$,txt$,left$,right$,VAR file$) ' *** print optional title (light text) to left and right LOCAL screen$,y.fac SGET screen$ CLS IF high.res! y.fac=1 ELSE y.fac=2 ENDIF DEFTEXT black,2,900,32 TEXT 100,350/y.fac,300/y.fac,left$ DEFTEXT ,,2700 TEXT 540,50/y.fac,300/y.fac,right$ DEFTEXT ,0,0,13 PRINT AT(1,3);@center$(txt$) GRAPHMODE 3 DEFFILL black,1 BOUNDARY 0 IF high.res! BOX 157,25,482,54 PLOT 157,25 PBOX 159,27,480,52 ELSE BOX 157,12,482,27 PLOT 157,12 PBOX 160,14,479,24 ENDIF BOUNDARY 1 GRAPHMODE 1 FILESELECT path$,default$,file$ SPUT screen$ RETURN Asaprogrammer,youshouldtakeintoaccountthepossibilitythatauser mightstartyourprogramfromdriveA,aharddiskoraRAM-disk.Iusethe StandardGlobaldefault.path$torememberwheretheprogramwasstarted. Iftheuserchangesthe(default)pathintheFileselector,youshould notethechangeandusethenewpathiftheFileselectoriscalledagain. UsetheProcedureParse.filenameforthispurpose: PROCEDURE parse.filename(parse.name$,VAR drive$,path$,file$,ext$) LOCAL pos,first,last,last!,search,parse.file$ ' parse.name$=UPPER$(parse.name$) IF MID$(parse.name$,2,1)=":" drive$=LEFT$(parse.name$,1) ELSE drive$=CHR$(65+GEMDOS(&H19)) ! current drive ENDIF ' pos=1 last!=FALSE last=0 first=INSTR(1,parse.name$,"\") REPEAT search=INSTR(pos,parse.name$,"\") IF search>0 pos=search+1 last=search ELSE last!=TRUE ENDIF UNTIL last! IF last>0 ! backslash discovered path$=MID$(parse.name$,first,last-first+1) parse.file$=MID$(parse.name$,last+1) ELSE ! no '\' path$="" pos=INSTR(1,parse.name$,":") IF pos>0 parse.file$=MID$(parse.name$,pos+1) ELSE parse.file$=parse.name$ ENDIF ENDIF pos=INSTR(parse.file$,".") IF pos>0 ! name with extension ext$=MID$(parse.file$,pos+1) file$=LEFT$(parse.file$,pos-1) ELSE ! name without extension ext$="" file$=parse.file$ ENDIF RETURN IfyouhaveajoystickwithAuto-Fireon,youshouldswitchitoff.The Fileselectordoesn'tlikeAuto-Fire.NeitherdoI. TheFileselectorwillwarnyouwithamodest'ping'ifitcountsmorethan 100files/folders.Itwillshowonlythefirst100files/folders.Ithink 45filesinonefolderisreallythelimitforimpatientuserslike myself.Morethan100isacrimethatshouldbepunishedwithmorethana 'ping'.ThemaindirectoryofdriveAcan'tcontainmorethan112 files/folders,becausethe7directory-sectorscontain11232-byteslots. Everytimeyouopenafolder(intheFileselector,orotherwise),TOS storesinformationaboutthefolderinatable.Afteropening/accessing40 folders,TOSwilldeleteclusters,cross-linkclusters,anddoothernasty things.Yourdiskcouldbecompletelydestroyed,thankstothisbug.Atari enlargedthebufferinTOS1.2andfixedthebuginTOS1.4.Atarialso distributestheprogramFOLDRxxx.PRGtoextendthe40-folderlimitwith 100(FOLDR100.PRG)ormore.BecarefulwithSHOWINFO,it'seasytoexceed the40-folderlimit!Youcouldrecognizeadisasterbyoneofthe followingsymptoms: -unexpected'0bytesin0items'messageindirectory -folder-namestrashed(usuallylotsofGreekletters) -ShowInfocrashesorshowsweirdinformation Don'tbeafraidofanewvirus.It'sonlyaTOS-bug.Immediatelyreset yourST,trytosalvageasmanyfilesaspossibleandreformatthedisk. Ifallfilesarelost,youwillhavetouseyourback-upfiles.Ifyou don'thaveback-upfiles,youhavenothingleftbutmysympathy. 12.MIDI  INPMID$ WiththecommandINPMID$theinternalMidi-bufferisreadandatthesame timecleared.YoucanfindthebufferwithXBIOS14(Iorec): adr%=LPEEK(XBIOS(14,2)) Thedefaultsizeofthisbufferisonly128bytes,butyoucanusethe ProcedureChange.midi.buffertochangethesizeofthebuffer: PROCEDURE change.midi.buffer(size%) LOCAL ptr% ptr%=XBIOS(14,2) ERASE buffer|() DIM buffer|(size%-1) LPOKE ptr%,VARPTR(buffer|(0)) ! start-address ofnew buffer DPOKE ptr%+4,size% ! size DPOKE ptr%+6,0 ! buffer-head DPOKE ptr%+8,0 ! buffer-tail DPOKE ptr%+10,0 ! low mark (not used) DPOKE ptr%+12,size%-1 ! high mark (not used) RETURN BecausehandshakeisimpossiblewithMidi,youneedalargebufferif Midi-bytesarecominginfast. INP IfyouuseINP(3)toreadMidi-bytes,youshouldfirstcheckwithINP?(3) iftheMidi-buffercontainsdata.IfyouuseINP(3)andnobytesare available,yourSTwillfreeze.Untilyouresetthecomputer. Midi-commands StudytheProceduresinthefileMIDI.LSTtoseehowyoucanuseMidi- commandsinGFA-Basic.WiththeProceduresRecord.midiandPlay.midiyou couldwriteasimpleMidi-recorder.AndtheProcedureMidi.monitorcanbe usedtoexamineincomingMidi-messages. PROCEDURE record.midi(VAR midi.byte|(),midi.time%()) ' *** uses Procedure All.midi.off ' *** global : LAST.MIDI.BYTE% LOCAL last%,buffer$,i%,t%,time%,byte|,delay%,j%,m$,k ARRAYFILL midi.byte|(),0 ARRAYFILL midi.time%(),0 last%=DIM?(midi.byte|())-1 m$=STR$(last%)+" bytes available ;| |stop recording|" m$=m$+"by pressing space" ALERT 3,m$,1,"RECORD",k REPEAT UNTIL INKEY$="" buffer$=INPMID$ ! clear MIDI-buffer i%=1 t%=TIMER  REPEAT IF INP?(3) byte|=INP(3) IF byte|<>254 time%=SUB(TIMER,t%) midi.byte|(i%)=byte| midi.time%(i%)=time% INC i%  ENDIF ENDIF UNTIL i%=last% OR INKEY$=" " last.midi.byte%=i%-1 @all.midi.off delay%=midi.time%(1) ! subtract time for first note FOR j%=1 TO i% SUB midi.time%(j%),delay% NEXT j% m$="|"+STR$(i%)+" bytes recorded" ALERT 3,m$,1," OK ",k RETURN ' PROCEDURE play.midi(VAR midi.byte|(),midi.time%()) ' *** uses Procedure All.midi.off LOCAL m$,k,i%,t%,time% m$="record of "+STR$(INT(midi.time%(last.midi.byte%)/200))+ m$=m$+" seconds| |(stop by pressing space)" ALERT 3,m$,1,"PLAY",k REPEAT UNTIL INKEY$="" i%=1 t%=TIMER REPEAT time%=SUB(TIMER,t%) IF midi.time%(i%)<=time% OUT 3,midi.byte|(i%) INC i% ENDIF UNTIL i%=last.midi.byte% OR INKEY$=" " @all.midi.off RETURN ' PROCEDURE midi.monitor LOCAL m$,k,byte|,byte$,hex$,bin$,buffer$,key$ byte$=SPACE$(3) hex$=SPACE$(2) bin$=SPACE$(8) m$="all incoming bytes|(except 254) are|printed on screen ;|" m$=m$+"stop by pressing space" ALERT 1,m$,1,"START",k m$="press||for CLS" ALERT 1,m$,1," OK ",k REPEAT UNTIL INKEY$=""  buffer$=INPMID$ ! clear MIDI-buffer CLS PRINT TAB(10);"dec";TAB(20);"hex";TAB(30);"binary" REPEAT REPEAT key$=INKEY$ IF INP?(3) byte|=INP(3) IF byte|<>254 IF TIMER-t%>200 PRINT ENDIF t%=TIMER RSET byte$=STR$(byte|) RSET hex$=HEX$(byte|) RSET bin$=BIN$(byte|) PRINT TAB(10);byte$;TAB(20);hex$;TAB(30);bin$ ENDIF ENDIF UNTIL key$=" " OR key$=CHR$(13) IF key$=CHR$(13) CLS ENDIF UNTIL key$=" " @all.midi.off REPEAT UNTIL INKEY$="" PRINT " (press any key)" ~INP(2) RETURN 13.MODEM  INPAUX$ WiththecommandINPAUX$theinternalRS232-bufferisreadandatthesame timecleared.Youcanfindtheaddressoftheinput-bufferwith: adr.in%=LPEEK(XBIOS(14,0)) Theoutput-buffercanbelocatedwith: adr.out%=LPEEK(XBIOS(14,0)+14) INP IfyouuseINP(1)toreadincomingbytes,youshouldalwayscheckwith INP?(1)iftheRS232-buffercontainsdata. Rsconf(XBIOS15) WithXBIOS15(Rsconf)youcanchangetheRS232-parameters.Afew baudrates: 0-19200baud 1-9600baud 4-2400baud 7-1200baud 9-300baud 14-75baud Use-1forparametersyoudon'twanttochange.DuetoaTOS-bug,you can'tuse75baud,because'14'resultsin120baud.Also,theoldTOS (pre-Blitterage)can'thandlehardwarehandshakewithRTS/CTS-signals. Atarihasreleasedabug-fixthatshouldenableanyTOStouseRTS/CTS. Softwarehandshaking(XON/XOFF)functionsproperly.Thedefault afterpower-up isnohandshakeprotocol. 14.MOUSE  Editor Sometimestheeditorseemstofreezewhilethecursorisblinkingrapidly. Justmovethemouseandtheeditorcomesaliveagain. Fileselector SometimesthesameblinkingmouseappearsaftercallingtheFileselector oranAlert-box.I'vereadsomewherethiscouldbeduetothecombination ofaVDI-function(forthemouse)andanAES-function(forFileselectoror Alert-box).GFAtakescareofthefirstandGEMofthesecond,and sometimesthisseemstoresultinaconflict. MOUSE IfyourepeatedlycallaProcedureinwhichyoutestforamouse-click, youshouldincorporateashortpauseintheProcedure(e.g.PAUSE5). OtherwisetheProceduremightbecalledagainwhiletheuserisstill holdingthebuttondown.Youcouldalsowaituntiltheuserreleasesthe button: REPEAT UNTILMOUSEK=0 !waituntilbuttonisreleased Ifyoufinditdifficulttomovethemouseaccurately,youcoulduse tomovethemouse-cursoronepixelinthe desireddirection.Ifyoupressaswell,youcan"drag"something accuratelyasiftheleftmouse-buttonwaspressed. Youcanfindthemaximalx-andy-coordinatesofthemousewith: x=DPEEK(&H9862) y=DPEEK(&H9864) Butthere'snoguarantyyouwillfindthecoordinatesthere.Experiment withXBIOS0foramorereliablemethod.Don'taskmehow. MOUSEreturnsnegativecoordinatesifthemouseistotheleftoforabove thecurrentwindow(ortheoriginthathasbeenselectedwithCLIP OFFSET). SETMOUSE Amouseclickcanbesimulatedwith: SETMOUSEmx,my,mk IfyoutrythiswithanAlert-buttonyouhavetomovethemouseafter- wards,orthebuttonwon'tbeselected.Idon'tknowwhy,soIcan'ttell ifthisisabug. DEFMOUSE YoucanuseoneofthemanyPublicDomainmouse-editorstodesignyourown mouse-mutant.Butit'salsoeasytocreateanewmouse-cursorwiththe ProcedureInitio.mouse1: PROCEDURE initio.mouse1 ' *** global : MOUSE1$ RESTORE pattern.mouse1 @make.mouse(mouse1$) pattern.mouse1: ' *** x,y,mode(0=normal;1=XOR),mask-colour,mouse-colour DATA 0,0,0,0,1 ' *** mask-pattern (1 = pixel on , 0 = pixel off) DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 ' *** mouse-pattern DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN '  PROCEDURE make.mouse(VAR m$) LOCAL x,y,mode,msk.color,mouse.color,n,msk%,mouse%,msk.pat$ LOCAL mouse.pat$,msk$,mouse$,pat$ CLR msk.pat$,mouse.pat$,pat$ READ x,y,mode,msk.color,mouse.color FOR n=1 TO 16 READ msk$  msk%=VAL("&X"+msk$)  msk.pat$=msk.pat$+MKI$(msk%) NEXT n FOR n=1 TO 16 READ mouse$ LET mouse%=VAL("&X"+mouse$) LET mouse.pat$=mouse.pat$+MKI$(mouse%) NEXT n m$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color)) m$=m$+MKI$(color.index(mouse.color))+msk.pat$+mouse.pat$ RETURN Themaskshouldbeanexactcopyofthemouse-patternifyouneeda transparantmouse.Leavethemaskempty(all'0')andthemousewill disappearbehindobjectsonthescreen.Fillthemaskwith'1'andthe 16x16mousewillalwaysremainvisible.Switchmask-andmouse-colourin thefirstDATA-linetocreatea"reverse"mouse.OruseanyVDIcolour- indexthatisavailableinthecurrentresolution. 15.JOYSTICK  STRIGandSTICK HereisanexampleoftheuseofSTRIGandSTICKifyourjoystickis connectedtoPort1(yourmouseisconnectedtoPort0): STICK1 !joystick-mode(yourmouseisnowdead) REPEAT IFSTRIG(1) joy=3 ELSE joy=STICK(1) ENDIF ONjoyGOSUBn,s,fire,w,nw,sw,dummy,e,ne,se PAUSE5 (...) UNTILcondition! STICK0 !backtomouse-mode YouneedeightProceduresfortheeightpossibledirections(seebelow) andoneProcedurefortheFire-button.Thevalue7('dummy')neveroccurs. Ifyoudon'ttouchthejoystick,thevalueof'joy'willbe0,andthis meansnoProcedurewillbecalled.Ashortpauseisadvisable,because GFA-Basicistoofast.  519 \|/ directions:  4-0-8 /|\ 6210 Ifyoudesperatelyneedanactivemousewhileusingthejoystick,you couldtrythefollowing"dirty"method: REPEAT IF MOUSEK=2 joy=3 ELSE joy=BYTE{&HE09} ! forTOS-version1.0!! ENDIF ON joy GOSUB n,s,fire,w,nw,sw,dummy,e,ne,se PAUSE 5 UNTILcondition! 16.SOUND  SOUNDandWAVE AfteraSOUND-command,thesoundsometimescontinuesinspiteofthe elapsedtime.IfthecommandisfollowedbyanotherSOUND-oraWAVE- command,thetimeishandledcorrectly.ThiscertainlysoundslikeaGFA- bug. Theeasiestwaytostopallsoundis: WAVE0,0 !turnallsoundoff Soundofacertainfrequencycanbeproducedwith: SOUNDch,vol,#ROUND(125000/freq%),pause AlthoughourSTisnotfamousforitsbrilliantsound,youcanproduce nicesound-effectswiththesimplecommandsSOUNDandWAVE.Checkoutthe ProceduresSiren.sound,Tideli.sound,Bounce1.soundandBounce2.soundto hearwhatImean. Dosound(XBIOS32) XBIOS32(Dosound)canbeusedtoplaymusicinaspecialformat.I proposetousetheextension'X32'forsong-filesinthisformat.The operatingsystemtakescareofplayingthemusicduringinterrupts(every 1/50thsecond).TakealookattheProceduresPlay.songandStop.songto seehowyoucoulduseXBIOS32inyourprograms.Youcanevenplayasong continuouslywiththeProcedurePlay.cont.song.Temporarilystoppinga songispossiblewiththeProcedureInterrupt.song. IfyouuseXBIOS32toplaymusic,youareadvisedtoswitchthekey-click off.Otherwisethemusicwillstopassoonastheuserpressesakey. OnceIdiscoveredXBIOS32didnotworkduringtheinitialization(mainly thefillingofarrays)ofalargeprogram.Ihadconvertedtheprogram fromGFA-Basic2.0to3.0,butIdidnothavethepatiencetofindout whatcausedthisproblem. XBIOS32canalsobeusedforsound-effects.Ihavedevelopedthe ProcedureInitio.soundforbuildingsound-stringsfromafewDATA-lines. Iherebydeclarethisasthestandardmethodforcreatingsound-strings. After@do.sound(sound$)youcanhearthesound-effect.Inthefollowing examplethesound-stringbounce3$iscreated: PROCEDURE initio.sound ' *** commands in DATA-lines : ' *** REG = 14 parameters for registers 0-13 ' *** END = end of sound-string ' *** PAUSE = pause (followed by time in 1/50 seconds) ' *** VAR = decrease/increase tone : channel,start,+/-step, '***end-value  ' bounce3.sound: DATA REG,0,0,0,0,0,0,27,248,16,16,16,35,95,0 DATA VAR,3,255,-1,116 DATA PAUSE,255,END RESTORE bounce3.sound @sound.string(bounce3$) RETURN ' PROCEDURE sound.string(VAR s$) LOCAL n,snd$,snd,channel,begin,step,end s$="" DO READ snd$ snd$=UPPER$(snd$) EXIT IF snd$="END" IF snd$="REG" FOR n=0 TO 13 READ snd s$=s$+CHR$(n)+CHR$(snd) NEXT n ENDIF IF snd$="PAUSE" READ snd s$=s$+CHR$(130)+CHR$(snd) ENDIF IF snd$="VAR" READ channel,begin,step,end s$=s$+CHR$(128)+CHR$(begin)+CHR$(129)+CHR$(channel)+CHR$(step) s$=s$+CHR$(end) ENDIF LOOP s$=s$+CHR$(255)+CHR$(0) ! terminator RETURN ' PROCEDURE do.sound(sound$) VOID XBIOS(32,L:VARPTR(sound$)) RETURN Samples FromGFA-Basicyoucansurprisetheuserwithasampledsound.Examinethe ProceduresSample,Load.sampleandPlay.sampletoseehow.You'llhaveto findsuitablesamplesfirst.Lookoutforsound-effectsandspeech- samples.Personally,IjustlovethefamousPerfect-sample.  Speech YourSTcantalktoyouwithalittlehelp(STSPEECH.TOS).MycurrentGFA- version(3.07)refusestocooperatewiththeProceduresInitio.speechand Talk,butIhaveincludedtheseanyway.Perhapsyoucandiscoverthebug. InearlierversionsbothProceduresdidwork.Aresetisnecessarybecause EXEC3isused. Soundmachine Youcanplaysongs,createdwithSoundmachine(TommySoftware),fromGFA- Basic.You'llneedtheProceduresInitio.soundmachineandSoundmachine, andasong-file.You'llprobablywonderifit'sreallyyourSTthat's playingthesong.SoundmachineIIisout,andlooksevenbetter.Inthis newversionyoucanchoosebetweenplayingsongswithsamples,orwithout samples(orsamplesforoneofthethreechannels).You'llneedthe ProcedureSm.initioorMsm.initioandseveralothers.Trytofindthe PublicDomaindemo-programsSAMSOUND.GFA,CHIPSND.GFAandSND_PLAY.GFA. Endofcommercial,continuewithtext. 17.PROGRAMDECISIONS  IF...ENDIF Ifthevalueofacertainvariablemustfallintherangemin%-max%,you couldprogramthatasfollows: IFn%>max% n%=max% ENDIF IFn%keysfastenough: ONBREAKGOSUBbreak (...) PROCEDUREbreak ONBREAKCONT (...) ONBREAKGOSUBbreak RETURN InthiscasetheBreak-Procedureisactivatedagainbeforeleavingthe Procedure.StudytheStandardProcedureBreak(inoneoftheSTANxxxx.LST- files)foranexampleofthismethod. ERROR YoucansimulateERRORswithvaluesfrom-127to127.ForGFA-errorsuse valuesfrom0to93,forbomb-errors102(2bombs)to109(9bombs)and forTOS-errors-1to-67. EVERYandAFTER It'snotpossibletouseEVERYandAFTERatthesametime.Bothcommands don'tworkduringalongPAUSEorDELAY(oranyothercommandthattakesa lotoftime).YoucanonlycallProcedureswithoutparameters.Don'tmake theProceduretoolong,oritmaybecalledwhilebeingprocessed! Inacompiledprogramyouhavetoincorporate'$I+U+',orEVERYandAFTER can'tbeused. GOTO Youcan'tuseGOTOinaProcedure,aFunctionoraFOR...NEXTloop. DELAY TheDELAY-commanddoesnotoperatecorrectlyinversion3.07ofGFA-Basic. DuringDELAYaBreakisimpossible.Anastierbugistheappearanceofthe mouse-cursorduringDELAY,evenafterHIDEM.YouareadvisedtousePAUSE instead. CHAIN InGFA-BasicallvariablesandarraysarelostafterCHAINingthenext program.However,youcouldusethe160-bytebufferofthescrap-library topassashortmessagetothenextprogram: buffer$=SPACE$(160) !160bytesmaximum?? message$="thismessagewassentbythepreviousprogram" message$=message$+CHR$(0) LSETbuffer$=message$ r%=SCRP_WRITE(buffer$) !r%=0iferror CHAINfile$ Readthemessagewith: buffer$=SPACE$(160) r%=SCRP_READ(buffer$) message$=CHAR{V:buffer$} Theuseofthisbufferiscompletelyillegal,butwhocaresifyoudon't useascrap-library?UnfortunatelytheGFA-editorseemstothinksotoo, soyoushouldexperimentalittlebeforetrustingthismethod. EXEC Ifyouaregoingtorunanotherprogrammorethanonce,you'llhavetouse EXEC3: base%=EXEC(3,file$,"","") !load,butdon'tstartyet base$=STR$(base%) cmdl$=CHR$(LEN(base$)+1)+base$ !createcommandline (...) r%=EXEC(4,"",cmdl$,"") !nowrunit Thevariabler%containsavaluereturnedbytheprogram(or-39ifnot enoughmemorywasavailable).Repeatthelastlineifyouwanttorunthe loadedprogramagain.OfcourseyoushoulduseEXEC0ifyou'regoingto runtheprogramonetimeonly.Readtheparagraph'RESERVE'ifyouare goingtouseEXEC3. Ifyoucalla'*.PRG'-programwithEXEC0,youpassthenull-string("") asthecommand-line.Youneedthecommand-lineonlyifyoucalla'*.TTP'- program.Thecommand-lineisconvertedtouppercaseandcan'texceed125 bytes.Thefirstbyteofthecommand-line(usually)determinesthelength oftheline,sothecommand-linecan'tcontainmorethan124characters. YoucanusethisinaTTP-program(compiledGFA-Basicprogram,extension changedtoTTP),butit'seasiertoreadthecommand-linewith: cmdl$=CHAR{BASEPAGE+&H81} 20.GRAPHICS  SETCOLORandVSETCOLOR WithcommandslikeCOLOR,DEFTEXT,DEFFILL,etc.,youuseaVDIcolour- index.UnfortunatelySETCOLORusesadifferenttable: VDIcolour-index :0123456789101112131415 SETCOLOR(Lowrez) :0151246357891012141113 SETCOLOR(Medrez) :0312 Fromthistableitfollowsyouwouldhavetouse'SETCOLOR2,r,g,b'to changecolour-index3.Bytheway,allLine-AcommandsusetheSETCOLOR- tableaswell!Thisisnota"bug",butaconsequenceoftwodifferent colour-tablesthatareusedbyGEMDOSandGEM.Youareadvisedtouse: VSETCOLORindex,r,g,b Thisindexisexactlythesameasthecolour-index,soyouwoulduse 'VSETCOLOR2,r,g,b'inordertochangecolour-index2.Ifyoulike,you couldusethehexadecimal3-bytemix-value: VSETCOLORindex,&Hrgb Butyouwon'tlikeitatall,becausethisdoesn'tworkproperly.GFA- Basicswapsther-andg-byte,soyouwouldhavetouse: VSETCOLORindex,&Hbgr Betteravoidthismethod,oryou'llexperiencecolour-changesifGFA correctsthisbuginafutureversion. InHighresolutionyoucaninvertthescreen-colourswith: VSETCOLOR0,0 !reverseHigh-screen(blackbackground) VSETCOLOR1,0 !normalHigh-screen(blackletters) Aninvertedscreenisperhapsslightlylesssuitablefortext,but graphicslooksuperb. Colour-index0determinesthecolourofthebackgroundinLowandMedium resolution.Thisindexalsodeterminesthecolouroftheborderonyour screen.Youcanchangethiscolour,althoughyoucan'tdraworPRINTon thescreen-borderofyourcolourmonitor.ThecolourofallPRINTedtext isdeterminedbycolour-index1,unlessyouusethe'Escb'command(read theparagraph'PRINT'againifyourlong-termmemoryistooshort): VSETCOLOR0,r,g,b !changecolourofbackground VSETCOLOR1,r,g,b !changecolourofallPRINTedtext Palette Beforechangingcolours,youshouldalwayssavethecurrentpalette.And dorestoretheoldpalettebeforetheuserexitstheprogram.Ihate programsthatreturntoapinkoryellowdesktop.Youcanstorethe paletteeitherinanintegerarrayorinastring,usingXBIOS7 (Setcolor):  PROCEDURE save.palette LOCAL i ERASE old.palette%() DIM old.palette%(15) FOR i=0 TO 15 old.palette%(i)=XBIOS(7,i,-1) NEXT i RETURN ' PROCEDURE make.palette.string(VAR pal$) LOCAL n pal$="" FOR n=0 TO 15 pal$=pal$+MKI$(XBIOS(7,n,-1)) NEXT n RETURN Thestring-methodiscompatiblewithDegas.Restoretheoldpalettewith thecorrespondingProcedures: PROCEDURE restore.palette LOCAL i FOR i=0 TO 15 VOID XBIOS(7,i,old.palette%(i)) NEXT i RETURN ' PROCEDURE change.palette(pal.string$) VOID XBIOS(6,L:VARPTR(pal.string$)) RETURN YoucouldalsousetheStandardProcedureStandard.low.colorsor Standard.med.colorstorestorethedefaultpalette.Youcanfindthese ProceduresintheSTANxxxx.LST-files. Youcanexaminethergb-valueofacertainVDIcolour-indexwith: PROCEDURE rgb.value(index,VAR rgb$) LOCAL col% col%=XBIOS(7,color.index(index),-1) rgb$=RIGHT$(HEX$(col%),3) RETURN TheStandardArraycolor.index()isusedtoconverttheVDIcolour-index. AcompletelynewpaletteforMediumresolutioncanbeinstalledwith: PROCEDURE new.med.colors LOCAL n,r,g,b,col$ RESTORE med.new.col.data FOR n=0 TO 3 READ col$ r=VAL(LEFT$(col$)) g=VAL(MID$(col$,2,1)) b=VAL(RIGHT$(col$)) VSETCOLORn,r,g,b NEXT n med.new.col.data DATA000,000,000,000 RETURN YoucanshowthecurrentpaletteonthescreenwiththeProcedure Palette.box: PROCEDURE palette.box(x,y,h,w) ' *** left upper corner of rectangle at x,y ' *** rectangle-height h; width of one colour-box w LOCAL arect.fill,fill.adr%,i,x1,x2 x2=x+16*w+2 COLOR black BOX x,y,x2,y+h arect.fill=-1 f%=V:arect.fill IF low.res! FOR i=0 TO 15 x1=ADD(SUCC(x),MUL(i,w)) ARECT x1,SUCC(y),ADD(x1,w),PRED(ADD(y,h)),color.index(i),0,f%,0 NEXT i ELSE IF med.res! FOR i=0 TO 3 x1=ADD(SUCC(x),MUL(i,w)) ARECT x1,SUCC(y),ADD(x1,w),PRED(ADD(y,h)),color.index(i),0,f%,0 NEXT i ENDIF RETURN Youcandarkenthescreenbydimmingallcolourssimultaneouslywiththe ProcedureDim.colors: PROCEDURE dim.colors(reg1,reg2,val) ' *** dim colours from VDI colour-index reg1 to reg2 with val ' *** for val=1 colour 254 (rgb) will become 143 LOCAL i,r,g,b FOR i=reg1 TO reg2 @rgb.value(i,rgb$) r=MAX(PRED(VAL(LEFT$(rgb$))),0) g=MAX(PRED(VAL(MID$(rgb$,2,1))),0) b=MAX(PRED(VAL(RIGHT$(rgb$))),0) VSETCOLOR i,r,g,b NEXT i RETURN NothingisimpossibleinGFA-Basic,evencolour-cyclingiseasywith EVERY intheProcedureColor.cycle: PROCEDURE color.cycle(reg1,reg2,time) ' *** cycles colours from VDI colour-index reg1 to reg2 ' *** global : COLOR.CYCLE! COL.REG1 COL.REG2 IF NOT color.cycle! col.reg1=reg1 col.reg2=reg2 color.cycle!=TRUE EVERY time GOSUB cycle.once ELSE color.cycle!=FALSE EVERY STOP ENDIF RETURN  ' PROCEDURE cycle.once LOCAL col1%,col2% col1%=XBIOS(7,color.index(col.reg2),-1) FOR reg=col.reg1 TO PRED(col.reg2) col2%=XBIOS(7,color.index(reg),-1) ~XBIOS(7,color.index(reg),col1%) SWAP col1%,col2% NEXT reg ~XBIOS(7,color.index(col.reg2),col1%) RETURN CalltheProcedureColor.cycleagaintostopthecolour-cycling. DEFMARK Thepointasmark-symbol(No.1)cannotbeenlarged.Othermark-symbols canbeenlarged,butalllinesinthesymbolretainawidthofonepixel. Thesizeofasymbolmustbeamultipleof11plus6:0,17,28,39,50. Foravalueinbetween,thepriorallowedsizeischosen.Perhapsthereis somemagichiddenintheallowedsizes,oramImissingsomething? DEFFILL Ifyouhaven'tdefinedyourownFill-pattern,theAtari-symbolwillbe usedafterDEFFILL1,4,x.ThedesktopFill-patternisDEFFILL1,2,4. TheFill-patternstringcanconsistof16,32or64words(MKI$-format). Word1to16isneededforbitplane0(Highresolution),word17to32for bitplane1(Mediumresolution)andword33to64forthebitplanes2and3 (Lowresolution).Inallresolutions,thepatternoccupiesarectangleof 16x16pixelsonthescreen.Thesame16x16rectangleisalsousedforthe mouse-cursorandsprites.YoucanalwaysuseaFill-patterninalower resolution,e.g.aHigh-patterninMediumorLowresolution,butnotthe otherwayaround.ExaminethethreeProceduresInitio.high.fill1, Initio.med.fill1andInitio.low.fill1toseehoweasyyoucandesignyour ownFill-patterns.There'sgoldinthemtharFills.Youcouldsurprisethe userwithabomb-pattern: PROCEDURE initio.bomb.fill ' *** global : BOMB.FILL$ RESTORE bomb.fill @make.high.fill(bomb.fill$)  bomb.fill: DATA 0000011000000000 DATA0010100100000000 DATA0000000010000000 DATA0100100001000000 DATA 0001000111110000 DATA 0000000111110000 DATA 0000011111111100 DATA 0000111111111110 DATA 0000110111111110 DATA 0001111111111111  DATA 0001111111101111 DATA 0000111111101110 DATA 0000111111011110 DATA 0000011111111100 DATA 0000001111111000 DATA 0000000011100000 RETURN ' PROCEDURE make.high.fill(VAR fill$) LOCAL i,pat$,pat% CLR fill$ FOR i=1 TO 16 READ pat$ pat%=VAL("&X"+pat$) fill$=fill$+MKI$(pat%) NEXT i RETURN Becareful,ascreenfilledwiththispatternmightprovokeaheart- attack.Ifitdoesn't,youcouldtrythefollowingdirtytrick(High resolutiononly)withtheProceduresBusyandAchtung: @busy !lookslikethecomputerisverybusy ~INP(2) !butnothinghappens,untiltheuserpressesakey... @achtung PAUSE500 CLS PRINT"Thankyouforyourpatience,I'mnotbusyanymore..." PAUSE150 ManyFill-patternsareavailableasfiles.Youcanusethesewith somethinglikeProcedureInitio.fill1: PROCEDURE initio.fill1(VAR pattern$) LOCAL bytes bytes=32 ! 32 bytes for High resolution ' *** load Fill-pattern (32 bytes for High resolution) here INLINE fill1%,32 pattern$=STRING$(bytes,0) BMOVE fill1%,V:pattern$,bytes DEFFILL ,pattern$ RETURN FILLingascreenwithapatterntakessometime,especiallyinHigh resolution.Usethefollowingmethodforalmostimmediatefillingofthe entireHighresolutionscreen: PROCEDUREfull.fill(fill%)  ACLIP1,0,0,639,399  ARECT0,0,639,399,1,0,fill%,15  ACLIP0,0,0,639,399 RETURN Fill%istheaddressofaFILL-pattern(32bytes).Thisveryfast alternativeFill-methodworksinHighresolutiononly. DEFLINE After'DEFLINE,n'allhorizontallineshaveawidthofnpixels(nshould beodd),exceptinMediumresolution.Butifnislargerthan1,all verticallinesaren+2pixelswide!Ihavetroublecountingthepixels inMediumresolution.Ithinkthewidthofhorizontallinesis: n: 13579 width : 11335etc. Isthisdocumentedanywhere? YoudefineyourownLine-patternsbyusinganegative16-bitvalue(from -&X1to-&X1111111111111111).Eachsetbitcorrespondswithapixelinthe Line-pattern(Highresolution).Thehighestbit(15)correspondswiththe leftmostpixelofthepattern.Don'tgetconfusediftheeditorchanges thenegativebinarynumberyouenteredasapattern.Theeditorusesa specialnotationfornegativebinarynumbers. GFA-Basicrepresentsintegernumbersasbinarystringsof32bits.The mostsignificantbit(31)determinesthesignoftheinteger.Ifthisbit is0,theremaining31bitsrepresentan"ordinary"positivenumber.But ifthemostsignificantbitis1,theremainderisanegativenumberin 'two'scomplement'notation.Iwon'ttrytoexplainthat.Inanycase,the nexttimeyoutype-&X111andafriendiswatchingyou,don'tblinkyour eyes,butcasuallyremark"ofcoursetheeditorconvertsthisintotwo's complementnotation".That'salsothereasonGFA-Basiccanworkwith integersfrom-(2^31)to+(2^31)-1. DEFTEXT Insomepublicationsyoucanreadabout'shadowedtext'(style=32),but unfortunatelyourGEMdoesn'tknowthisstyle.Youcanevenfindthemask forshadowedtextwithWORD{L~A+92},butit's0. Ineversucceededinfindingthecurrenttext-stylewithVDISYS38 (vqt_attributes).EitherabuginGEMormymistake.Idon'twanttoknow, becausetheeasywayis: txt.style=WORD{L~A+90} ThiscouldbeimportantifyouintendtouseDEFTEXTinaProcedure,but wouldliketorestoretheoriginalDEFTEXT-settingsbeforeleavingthe Procedure. WithDEFTEXTyoucansettheheightofTEXT-letters.Aletteroccupies morespacethough,determinedbytheletter-box: letter-height letter-box system-font 4 6x6 icon 6 8x8 Medium&Lowrez 13 8x16 Highresolution Theletter-heightisthedistancefromDescent-LinetoAscent-Line,but theBottom-LineandTop-Linelieatleastonepixellower/higher.The heightoftheletter-boxisthedistancefromBottom-LinetoTop-Line.  MostlettersrestontheBase-Line,butletterswithadescender(g,j,p, etc.)restontheDescent-Line.Ifyouarestillwithme,fromtopto bottomwehavethefollowinglines: Top-Line Ascent-Line Base-Line Descent-Line Bottom-Line Dropmealineifyoudon'tunderstandthis. GRAPHMODE IfyoudrawarectanglewithBOXinGRAPHMODE3(Xor-mode),thepixelin theleftuppercornerisnotdrawn.Actuallythispixelisdrawntwice, andinGRAPHMODE3thismeansthepixeldisappears.UsePLOTtodrawthis pixel: GRAPHMODE3 BOXx1,y1,x2,y2 PLOTx1,y1 !andfillthegap WithPBOXinGRAPHMODE3you'llalsogettroubleinthesamecorner.Avoid thisbyusingthecommand'BOUNDARY0'first: GRAPHMODE3 BOUNDARY0 PBOX50,50,100,100 GRAPHMODE3isespeciallyusefulifyoumakeatemporarydrawing.Drawthe samepictureasecondtimetorestoretheoriginalscreen.ExamineProce- dureslikeRubber.line,Draw.boxandDrag.boxforexamplesofthismethod. TheProcedureRubber.lineisusedtodrawalinefrom(x,y)tothemouse- cursor: PROCEDURE rubber.line(x,y,VAR x2,y2) LOCAL x1,y1,x2,y2,k GRAPHMODE 3 DEFMOUSE 3 SHOWM MOUSE x1,y1,k REPEAT !mainloop LINE x,y,x1,y1 !drawline REPEAT MOUSE x2,y2,k UNTIL x2<>x1 OR y2<>y1 OR k>0 !mousemoved LINE x,y,x1,y1 !undrawline x1=x2 y1=y2 UNTIL k>0 !mouse-click:ready(x2andy2returned) GRAPHMODE 1 LINE x,y,x2,y2 !thisisit HIDEM DEFMOUSE 0 PAUSE 10 RETURN Youcouldalsousethe'GRAPHMODE3'-methodforanimation,buttheXBIOS5 (Setscreen)methodismoresuitable. Don'ttrytodrawinGRAPHMODE3withalinewidthgreaterthan1pixel. GEMwillsurpriseyouwithsomemodernartifyoucan'tresistthe temptation. Ifyouwanttoconfirmaparticularchoiceoftheuser,youcaninvertthe relevantpartofthescreenwiththeProcedureInvert.block.Callthis Procedureagainwiththesameparameterstorestoretheoriginalscreen: PROCEDURE invert.block(x1,y1,x2,y2,color) GRAPHMODE 3 DEFFILL color,1 BOUNDARY 0 PBOX x1,y1,x2,y2 BOUNDARY 1 GRAPHMODE 1 RETURN Youcan'greyout'anunavailableoptiononthescreenwith: PROCEDURE block.dimmer(x1,y1,x2,y2,color) GRAPHMODE 3 DEFFILL color,2,2 BOUNDARY 0 PBOX x1,y1,x2,y2 BOUNDARY 1 GRAPHMODE 1 RETURN CallthisProcedureagaintorestorethescreen. Theentire(Highresolution)screencanbedimmedwith: PROCEDURE screen.dimmer ' *** global : DIMMER.SCREEN$DIMMER.SWITCH! IF dimmer.switch!  SPUT dimmer.screen$ dimmer.switch!=FALSE ELSE SGET dimmer.screen$ GRAPHMODE 4 DEFFILL 1,2,4 PBOX 0,0,639,399 dimmer.switch!=TRUE ENDIF RETURN ThescreenwillberestoredifyoucalltheProcedureagain. PLOTandDRAW Youcanuseboth'PLOTx,y'and'DRAWx,y'tosetapointonthescreen. Thesizeofthepointcanbechanged: DEFLINE,size,2,2 !changesizeofpoints Buttheshapesyou'llseedon'tlooklikepointsanymore,duetothesame problemasdescribedintheparagraph'DEFLINE'.UsePCIRCLEforproper fatpoints. PCIRCLE WithCLIPon,aPCIRCLEtouchingtheupperscreen-borderisnotfilled properlyinHighresolution: CLIP0,0,640,400 PCIRCLE0,0,50 Idon'tknowifweshouldblameGFAorGEMfornotfillingthetwotop- linesinthecircle. CURVE WiththecommandCURVEyoucandrawaBezier-curve: CURVEx1,y1,x2,y2,x3,y3,x4,y4 TheBezier-curvestartsat(x1,y1)andendsat(x4,y4).Theothertwo pointsactlikelittlemagnets.Youcanalsousethiscommandtodrawa 'normal'curvebetweentwopointsbylettingthepoints(x3,y3)and (x4,y4)coincide.TrythefollowingtoseewhatImean: GRAPHMODE3 MOUSEx2,y2,k DO CURVE10,100,x2,y2,110,100,110,100 !drawcurve REPEAT MOUSEx,y,k UNTILx<>x2ORy<>y2 CURVE10,100,x2,y2,110,100,110,100 !erasecurve x2=x y2=y LOOP Thismethodcouldbeusedtodrawlargeletters. TEXT ThecoordinatesusedwithTEXTdeterminethestartoftheBase-Lineofthe text.Thedescendersofletterslike'g','j',and'p'liebelowtheBase- Line.Thisisespeciallyimportant,nottosayfrustrating,ifyouuse TEXTwithanangleof90,180or270degrees.Thetextrotatesanticlock wisearoundtheTEXT-coordinates! IfyouintendtocombinePRINTedtextwithTEXT,youprobablywilllike theProcedureText.atastheanalogueof'PRINTAT': PROCEDURE text.at(c,l,t$) TEXT (c-1)*char.width,l*char.height+3*high.res!+2*(NOT high.res!),t$ RETURN YoucanuseTEXTtoprint"digital"numbers(ASCII-code16-25): FUNCTION digital$(number$) LOCAL dig$,i CLR dig$ FOR i=1 TO LEN(number$) dig$=dig$+CHR$(BCLR(ASC(MID$(number$,i,1)),5)) NEXT i RETURN dig$ ENDFUNC UsethisFunctionasfollows: TEXT x,y,@digital$("1237") SPRITE YoucoulddesignandsavespritesinvitrowithoneofthemanySprite- editorsthatareavailable.OryoucanusesomethingliketheProcedure Initio.sprite1tocreateaspriteinvivo.ComparethisProcedurealso withtheProcedureInitio.mouse1: PROCEDURE initio.sprite1 ' *** global : SPRITE1$ RESTORE pattern.sprite1 @make.sprite(sprite1$) pattern.sprite1: ' *** x,y,mode(0=normal;1=XOR),mask-colour,sprite-colour DATA 0,0,0,0,1 ' *** mask-pattern (1 = pixel on , 0 = pixel off) DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 ' *** sprite-pattern DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000  DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 DATA 0000000000000000 RETURN ' PROCEDURE make.sprite(VAR s$) LOCAL x,y,mode,msk.color,spr.color,n,msk%,spr%,msk.pat$,spr.pat$ LOCALmsk$,spr$,pat$ CLR msk.pat$,spr.pat$,pat$ READ x,y,mode,msk.color,spr.color FOR n=1 TO 16 READ msk$ msk%=VAL("&X"+msk$) msk.pat$=msk.pat$+MKI$(msk%) NEXT n FOR n=1 TO 16 READ spr$ spr%=VAL("&X"+spr$) spr.pat$=spr.pat$+MKI$(spr%) NEXT n FOR n=1 TO 16 pat$=pat$+MID$(msk.pat$,n*2-1,2)+MID$(spr.pat$,n*2-1,2) NEXT n s$=MKI$(x)+MKI$(y)+MKI$(mode)+MKI$(color.index(msk.color)) s$=s$+MKI$(color.index(spr.color))+pat$ RETURN Themaskshouldbeanexactcopyofthesprite-patternifyouneeda transparantsprite.Leavethemaskempty(all'0')andthespritewill disappearbehindobjectsonthescreen.Fillthemaskwith'1'andthe 16x16spritewillalwaysremainvisible.Switchmask-andsprite-colourin thefirstDATA-linetocreatea"reverse"sprite.OruseanyVDIcolour- indexthatisavailableinthecurrentresolution. Ifyouputaspriteonthescreen,thebackground(16x16pixels)is temporarilysaved.Usingmorethanonespritesimultaneously,itis essentialyouremovespritesinreverseorder.Thisisnecessarybecausea spritecouldoverlapanothersprite.Removingthetopspritefirstensures thattheoriginalbackgroundwillreappearafterremovingthefirst sprite,e.g.: DO (...) SPRITEs2$ !removesprites... SPRITEs1$ VSYNC !preventsblinking,butslowsdown SPRITEs1$,x1,y1 !drawsprites... SPRITEs2$,x2,y2 (...) LOOP VQT_EXTENT ThefunctionVQT_EXTENTcanbeusedifyouwouldliketodrawarectangle aroundatext-string: ~VQT_EXTENT(txt$,x1,y1,x2,y2,x3,y3,x4,y4) Thecoordinatesofthefourcornersdependontheangleofthetext(0, 90,180or270degrees)andofcourseonthesizeofthetext.Thepoint (x1,y1)isthelowerleftcorneroftheimaginaryrectanglearoundthe textandtheotherpointsarearrangedanticlockwisearoundthetext- string.BecausethetextrotatesaroundtheTEXT-coordinates(startofthe Base-Line),itwilltakesometrialanderrortodeterminethecorrect positionoftherectangleiftheangleisnot0degrees.Inthefollowing tableyou'llfindthe"true"originoftherectangle,thewidthandthe heightoftherectangle,andalsotheactualpositionofthelowerleft cornerofthetext-block(x1,y1): angle position(x1,y1) origin width height 0 lowerleft x1,y1 x2 y4 900 lowerright x4,y4 x1 y3 1800 upperright x3,y3 x4 y2 2700 upperleft x2,y2 x3 x4 Thecoordinatesoftheoriginare(0,0),sowithanangleof0degrees bothx1andy1are0.Therectanglerestsonthex-axis,whiletheleft sidecoincideswiththey-axis.Thisisa"mathematical"y-axis,nota "screen"y-axis.Thismeansyougoupwardsforpositivey-values.Foran angleof0degreesthecoordinateswillbe: (x4,y4)..(x3,y3) .TEXTBLOCK. (x1,y1)(x2,y2) Ifyouunderstandthetable,youshouldbesurprisedbytheheight'x4' insteadof'y1'atanangleof270degrees.IthinkIdiscoveredabugin GEMhere.CorrectGEMbychangingthefollowingvariablesifanangleof 270degreesisused: y1=x4 SWAPx4,y4 Now,theheightis'y1'asyoususpected.Clever,aren'twe?Ihavenot beenabletoconfirmmydiscovery.Noneofmyreference-booksmentionthe bug. Line-A TheLine-AcommandsarefasterthanthecorrespondingVDI-commandsinGFA- Basic.ThedifferenceshouldbeevengreaterafterloadingGDOS(?).In thefollowingtableyoucanfindhowmanytimesfastertheLine-Acommand is: PSET/PLOT=3 PTST/POINT=2 HLINE/LINE=2 ARECT/PBOX=1.5 ThesyntaxofLine-Acommandsismorecomplicated,butthat'snoproblem forusGFA-experts.Line-Acommandsusethe'SETCOLOR-index',soyou'll probablyneedtheStandardArraycolor.index(). HLINE AnadditionaladvantageofthecommandsHLINE,ARECTandAPOLYisthatyou don'thavetochangetheDEFFILL-parametersinthemainprogram.Forsolid horizontallines,use: pattern=-1 adr%=V:pattern HLINEx1,y,x2,color,mode,adr%,0 Youcan'tuse&X1111111111111111(16bits)forthepattern,becausebit15 ofaword-variableisaflagforanegativenumber.Yes,that'swhythe largestpositivewordis2^15-1(32767).Thesolutiontothislittle problemistoassign-1totheword-variable.Youhavemyword,nowall16 bitsare1.UseBIN$ifyoudon'tbelieveme. Forverycomplicatedpatternsyoucoulduseaword-array: DIMpattern(i) adr%=V:pattern(0) (...) !putfill-patterninpattern(0)topattern(i) HLINEx1,y,x2,color,mode,adr%,i ACHARandATEXT It'sdifficulttocombinetheLine-AcommandsACHARandATEXTwithTEXT. ThecoordinatesusedwithACHARandATEXTdeterminethepositionofthe leftuppercornerofthe(first)letter-box.That'stheTop-Line,notthe Base-Line. Youcan'tusethetext-styleunderlined(8)withACHARandATEXT.Probably aGFA-bug. GETandPUT Youcouldsavearectangularpartofthescreenasfollows: GETx1,y1,x2,y2,pic$ BSAVEfile$,V:pic$,LEN(pic$) !usetheextensionPUTinthefilename Later,youcouldputthesavedpicturebackonthescreenwith: OPEN"I",#1,file$ LETbytes%=LOF(#1) !howmanybytesneeded? CLOSE#1 picture$=SPACE$(bytes%) !reservesomespace, BLOADfile$,V:picture$ !loadthepicture PUTx,y,picture$ !andlookatit TheProceduresMessage,Warning,Message.onandMessage.offuseGETand PUTtosaveandlaterrestorethepartofthescreenthatisusedfor text. AGET-stringstartswiththreewordsforwidth,heightandnumberof bitplanes.Thenumberofbitplanesisdeterminedbytheresolution:1for High,2forMediumand4forLow.Afterthesethreewordsfollowsthe actualpictureasalistofwords.Asthepicture-widthisnotnecessarily amultipleof16,anybitsbeyondtherightborderwillbeignoredbythe PUT-command. HereistheconnectionbetweenGRAPHMODEandPUT-mode: GRAPHMODE PUT-mode 1 3(default) 2 7 3 6 4 13  IhaveencounteredafewprogramsinGFA-Basic2.0wherePUTwasused justoutsidethescreen.InGFA-Basic3.0theprogramdidn'twork.The sameoccurredinaprogramwhereapicturewasBLOADedafewbytesbefore thescreen-RAM.Idon'tunderstandwhyGFA-Basic3.0doesn'tacceptthis, asthereissomeunusedspacethere(readtheparagraph'RAM'),butI've learnedtocorrectthiswhenIconvertaprogramfromGFA-Basic2.0to version3.0. Degas-Pictures ADegaspicture-filecontainsnotonlytheactualpicture(sameformatas SGET-picture),butalsothecolour-palette.UsetheProcedureShow.degas toloadandshowaDegas-picture: PROCEDURE show.degas(degas$) LOCAL degas.picture$,degas.picture%,degas.palette$ LOCALdegas.palette% degas.picture$=SPACE$(32000) degas.picture%=VARPTR(degas.picture$) degas.palette$=SPACE$(32) degas.palette%=VARPTR(degas.palette$) OPEN "I",#90,degas$ SEEK #90,2 !skipresolution BGET #90,degas.palette%,32 ! load palette of picture SEEK #90,34 BGET #90,degas.picture%,32000 ! load actual picture CLOSE #90 ~XBIOS(6,L:degas.palette%) ! change palette SPUT degas.picture$ ! show the picture RETURN TheoriginalDegas-fileshavealengthof32034bytes: 1word -resolution 16words -palette 16000words -picturedata YoucanuseBTSTtochecktheresolution(bit0=Low,bit1=Medium,bit 2=High),butyoucouldalsolookattheextensionofthefilename (PI1/PI2/PI3forLow/Medium/High).InthesecondDegas-version(Degas Elite),16wordsfor"colour-animation"canbeaddedafterthepicture data. ADegasElitepicturecan(andreallyshould!)besavedinacompressed format.TheextensionsPC1/PC2/PC3areusedforLow/Medium/High resolution.Also,thehighestbitoftheresolution-wordissetasaflag foracompressedpicture.WiththeProcedureShow.comp.degasyoucanload andshowacompressedDegas-picture. Neochrome-Pictures Sometimesthe"Neochrome"-formatisusedforpictures(32128bytes): 1integer -resolution(0/1/2forLow/Medium/High) 16words -palette 12bytes -filename(nnnnnnnn.eee) 4bytes+1word -colouranimationdata 18integers -reserved 16000words -picturedata VSYNC TheVSYNC-commandisusefulifyouwanttopreventirritatingblinking duringanimation.AlwaysVSYNCbeforedrawinganewpictureinan animationsequence(includingSPRITE-animation).Theprogramisslowed downofcourse,becauseitwaitsforaverticalblankinterruptbefore startingtodraw.Butitlooksmuchnicer. Scroll WithBMOVEandRC_COPYyoucanaccomplishprettysmoothscrolling.GET/PUT istooslow,andonlyworksonthelogicalscreen.BITBLTismore flexible,butalsomorecomplicated.Andnotfaster(?).Studythe ProceduresScroll.upandScroll.downtoseehowyoucouldscrollthe entirescreenupordown: PROCEDURE scroll.up(scroll.lines,scroll.color) LOCAL n,bytes,move.bytes,source% IF high.res! LET bytes=80*scroll.lines ELSE LET bytes=160*scroll.lines ENDIF move.bytes=32000-bytes source%=physbase%+bytes VSYNC BMOVE source%,physbase%,move.bytes DEFFILL scroll.color PBOX 0,scrn.y.max-scroll.lines+1,scrn.x.max,scrn.y.max FOR n=1 TO DIV(scrn.y.max,scroll.lines) VSYNC BMOVE source%,physbase%,move.bytes NEXT n RETURN Cananybodyexplaintheinterferencelinesthatsometimesappearduring thescrolling? Severalfade-overeffectscanbefoundintheProceduresUp.scroll, Slider.scroll,etc.MostProcedurescanonlybeusedinHighresolution. Forscrollingofoneormoretext-linesyoucouldusetheProcedures Scroll.text.upandScroll.text.down: PROCEDURE scroll.text.up(begin,end) LOCAL screen%,sx,sy,w,h,dx,dy IF begin>1 AND end>=begin screen%=XBIOS(3) ! logical screen sx=0 sy=(begin-1)*char.height w=scrn.x.max h=(end-begin+1)*char.height dx=0 dy=sy-char.height RC_COPY screen%,sx,sy,w,h TO screen%,dx,dy ELSE PRINT bel$; ENDIF RETURN ThismethodisalsousedintheProcedureDebug. ACLIP Line-Acommandsare'CLIP-sensitive',soyoushouldalwaysuseanappro priateACLIP-commandbeforeaLine-Acommand.ThefollowingLine-A commandsarenotinfluencedbyACLIP:ALINE,HLINE,PSET,PTSTand BITBLT. Blitter TheBlitter-TOS(1987)allowsyoutoswitchtheBlitteron/off.Icouldn't testthefollowingProcedure,becauseIdon'thaveaBlitter.ButifI understandthefunctionXBIOS64(Blitmode)correctly,youcouldswitch theBlitteronandofffromGFA-Basic: PROCEDUREblitter(switch!) LOCALstatus status=XBIOS(64,-1) IFBTST(status,1) !Blitteravailable? IFswitch! status=BSET(status,0) !Blitteron ELSE status=BCLR(status,0) !Blitteroff ENDIF ~XBIOS(64,status) !doit ENDIF RETURN Bytheway,LineAcommandsdonotusetheBlitter.TheBlitter-chip containsahardware-routinethatreplacestheLineABitBlt-function (BITBLTinGFA-Basic).AllMegaST'shaveaBlitterinstalled. 21.EVENTS  MENU() Thereisnoeasywaytotestinaprogramifanaccessoryhasbeen selectedbytheuser.MENU(1)lookspromising,butthevalue40(select accessory)or41(closeaccessory)isonlysenttotheaccessory!It wouldhavebeennicetobeabletodetermineifanaccessoryhasbeen closed,becauseGEMwillcleartheaccessory-windowandwillfillthe spacewiththedesktop-pattern.Noeasysolutionforthisone,sorry.The bestideaprobablyistotestfrequentlywith'IFMENU(1)=20'ifaredraw isnecessary,e.g.: ONMENUMESSAGEGOSUBredraw (...) PROCEDUREredraw IFMENU(1)=20 (...) !redrawscreen ENDIF RETURN Thismethodonlyworksifyouhaveopenedawindow. ONMENUBUTTON ThesyntaxforONMENUBUTTONis: ONMENUBUTTONclicks,button,eventGOSUBproc Forboth'button'and'event'youcanusethenumbers0-3.Thevariable 'clicks'standsforthemaximalnumberofclicksyouwanttoregister.If youchoose'2',theProcedurewillbecallediftheuserclicksonceor twice: ONMENUBUTTON2,1,1GOSUBproc It'snotpossibletowaitforadouble-click,unlesstheprogamisreally waiting,andnotdoinganythingelse: SELECTEVNT_BUTTON(2,1,1) CASE1 'clickedonce CASE2 'clickedtwice ENDSELECT Butyoucan'tcombinethiswithanONMENUloop. Ifyouusethedescribedmethod: ONMENUBUTTON2,1,1GOSUBproc youcoulduseMENU(15)inthecalledProceduretocheckiftheuser clickedtwice.ThesameProcedurewouldbecalledafterasingleclick, butyoucouldignorethat.Fastenyourseatbeltsnow.Ifyourunsucha programthefirsttime,adoubleclickisnotregisteredinMENU(15).If yoususpectabugandruntheprogramagain,MENU(15)worksallright. Nasty. Anotherbug,butthistimeaGEM-bug(Ithink),after: ONMENUBUTTON1,2,2GOSUBproc TheProcedureiscalledimmediately,whethertherightmouse-buttonwas pressedornot. IfyouwanttoswitchONMENUBUTTONtemporarilyoff,use: ONMENUBUTTONclicks,button,eventGOSUBdummy TheProcedureDummyshouldbeempty.Usethesamemethodtoswitchother ONMENUcommandstemporarilyoff. ONMENUIBOX YoucandefinetwoindependentrectangleswithONMENUIBOXand/orONMENU OBOX,either: -oneIBOXandoneOBOX -twoIBOXes -twoOBOXes 22.PULLDOWNMENU  OPENW0 Evenifyoudon'tneedawindow,youcould'OPENW0'ifyouusea pulldownmenu.Thetopline(y-coordinates0to18inHighresolution, that'swhereyourmenuis)isnowprotectedagainstaccidentaldrawing. After'OPENW0'19isalwaysaddedtothey-coordinate,sowith'PLOT0,0' thepointisactuallydrawnat(0,19). Desk-submenu ThefirstsubmenuinapulldownmenushouldbetheDesk-submenu('Desk'), usuallywiththefollowinglay-out: Info ------------ Accessory1 Accessory2 (...) IftheuserchoosestheInfo-item,youshouldshowsomeinformationabout theprogram.TheAEStakescareoftheaccessory-items,yousimplyuse '1,2,3,4,5,6'inthecorrespondingDATA-line.Ifyouuse'-,-,-,-,-,-'the userwon'tbeabletochooseanaccessoryfromyourprogram,butall loadedaccessoriesstilloccupymemory. File-submenu Mostpulldown-menu'scontainaFile-submenu('File')asthesecond submenu.Thefollowinglay-outismoreorlessstandard: Newfile ^N Openfile... ^O ----------------- Close ^C Save ^S Saveas... ^M Abort ^A ----------------- Quit ^Q With'...'youannouncethatfurtherinputfromtheuserwillbe requested.Ifatallpossible,youshouldofferoptionalkeyboard- alternativesfortheexperienceduser.With'^N'youremindtheuserof thealternative.ThecharacterwithASCII-code7isusedas thesymbolfor.Bygeneralagreement,theQuit-choicealways isthelastitemoftheFile-submenu. Bytheway,neverleavethelast(rightmost)submenuwithoutoptions,e.g. duringdevelopmentofaprogram.Theremustbeatleastoneoptioninthe lastsubmenu,orit'sreset-timeagain. 23.WINDOWS  GFA-windows You'llnoticethatthischapterisrathershort.Thisreflectsmy reservationsabouttheuseofwindows.Iknowveryfewprogramsthatuse windowssensibly.FortheseprogramsGEM-windowsindeedareablessing. Butmostprogramsarebetteroffwithoutwindows.GEMjustslowsthe screen-outputdown.CoveryourTOS-screenwithwindowsonlyifyoureally needthem. GFA-Basichasfour"easy"windowsfornottoocomplicatedjobs.Drawan imaginarycrossonthescreen.Theintersectionofthetwolinesis determinedbythecoordinatesin'OPENWn,x,y'.Ifyoushowmorethanone windowonthescreen,youshouldrealizethatresizingonewindowauto- maticallychangesthesizeoftheotherthreewindowsaswell(remember thecross?).UsetheAESwindow-commandsifyouneedindependentwindows. ThefourGFA-windowsreservethetoplineforapulldownmenu.Ifyouuse yourownAES-windows,youshouldprotectthetoplineyourself,e.g.with 'OPENW0'. Astandard-methodfortheuseofGFA-windowslookslikethis: TITLEW#1,"title" !automaticallycentered INFOW#1,"information" !leftjustified OPENW1 !oruseFULLW#1 CLEARW1 (...) CLOSEW1 CLOSEW0 Idon'tknowhowtouse'#'properly.Theeditordoesnotaccept'#'in 'OPEN#1',youhavetouse'OPENW1'.IfyouuseFULLWinsteadofOPENW, youhavetouse'FULLW#1'.Inthiscasethe'#'hastobeused,orthe commanddoesn'tworkatall!TheGFA-editoralwaysinsertsa'#'after TITLEWandINFOW,evenifyoudidn'ttypeone.Whatthe#isgoingon?  CLOSEW Ifyouhaveopenedawindowinyourprogram,alwaysuse'CLOSEW0'before returningtotheeditor.Ifyoudon't,youcan'tworknormallyinDirect Mode.Ifyoudidforget,youcantype'CLOSEW0'inDirectModeand everythingworksfineagain. IfyouusetheAESwindow-commands,alwayscallWIND_CLOSE(handle)before WIND_DELETE(handle). TITLEW  Youcanclearatitlewith: TITLEW#n,"" Don'tuse""insteadof"",oryouwon'tbeabletomovethewindow afterwards! CLEARW After'CLEARW#n'allvisibleareasofthewindowarecleared,without activatingthewindow.GFAusesWIND_UPDATEandWIND_GETforthiscommand. 'CLEARWn'bothclearsandactivatesthewindow. 24.AES-LIBRARY  ALERT IfyouneedanemptylineinanAlert-box,use: ALERT,3,"...||...",1,"...",k Notethespacebetweenthetwoverticalrules. GFA-Basicallows4linesof30characters(High/Mediumrez)ifyouuse ALERT,butwithFORM_ALERTyoucanuse5lines.Inbothcasesyoucanuse notmorethan3buttons,eachatmost8characters(High/Mediumrez)wide: m$="line1|line2|line3|line4" ALERT3,m$,1,"OK",k ' m$="[3][line1|line2|line3|line4|line5][OK]" k=FORM_ALERT(1,m$) InLowresolutionyoucanuseonlyhalfthenumberofcharactersyouuse inHigh/Mediumresolution. Ifsomecharactersarenotvisibleinabutton,trybroadeningtheAlert- boxbyaddingspacestothewidesttext-line. Ifyouhavepressedtheleftmouse-buttonontheveryspotwhereanAlert- buttonisabouttoappear,somethinggoeswrong.GEMappearstoremember yourlastmouse-click,anderroneouslyassumesyoupressedthebutton aftertheAlert-boxappeared.GEMonlyselectsthebuttonifthemouse- clickoccurredintheexactareaoftheAlert-button.Toavoidthis problemyoushouldmakesuretheuserhasreleasedthemouse-buttonbefore youcalltheAlert-box: REPEAT UNTILMOUSEK=0 !waituntilmousereleased Bytheway,theAESusesan8Kbuffertosavethepartofthescreenwhere theAlert-boxappears.Dittoforamenu. SHEL_GETandSHEL_PUT GFA-Basicisrunfroma'Shell-Program',usuallytheDesktop.Inthatcase thefileDESKTOP.INFcanbefoundintheEnvironment-Buffer.Youcan examinethisfilebytransferringittoastring: d$=STRING$(1024,0) r%=SHEL_GET(1024,d$) PRINTingthisstringismucheasierthanusingadisk-editortoexamine DESKTOP.INF. Afterchangingthestring,youcouldputitbackinthebufferwith: r%=SHEL_PUT(1024,d$) Thiswayyoucouldchangethelay-outofthedesktop.Ifyouchangethe string,youshouldknowthattheDesktoprecognizestheendofDESKTOP.INF bythebyte&H1A.Sodon'tforgettoputCHR$(26)attheend.Ifyouwant tosavethenewbuffer,try: OPEN"O",#1,"\DESKTOP.INF" PRINT#1,LEFT$(d$,INSTR(d$,CHR$(26))) CLOSE#1 IsthatallthereistotellabouttheAES-library?Certainlynot,soat thispointyouwillprobablybebitterlydisappointed.IavoidtheAES- LibrarywheneverIcan.Anyway,thisisasubjectthatisthoroughly coveredinmostbooksaboutGFA-Basic3.0.Everyoneisentitledtohisown opinionabouttheusefulnessofRSC-filesandotherexoticsubjects. Betterstill,writethischapteryourself.Andthesametoyoutoo! 25.GFAXPERT-FILES  Takeyourtimetoreadthischaptercarefully,beforeusingtheGFAXPERT- Proceduresorprograms.Theparagraph'STANxxxx.LST'isessentialreading. Don'tforgettoreadthe'smallprint'inthelastparagraph. GFAXPERT.DOC You'rereadingit. GFAXPERT.LIB Thisfolder(inGFAXPRT2.ARCfordownloaders)containsalargecollection ofProceduresinseveralLST-files.EachLST-filecontainsoneormore foldedProcedures.MostProceduresarealsolistedinthistext,orareat leastmentioned.IsuggestyouLlistalltheLST-fileswithunfolded Proceduresforeasyreference.YoucouldalsoLlistallLST-filesagain withfoldedProcedures,soyouwillbeabletolocateaProcedurequickly. Alwaysreadthecomment-lines('***)inaProcedurebeforeusingit.You willfindthereifotherProceduresareused,orStandardGlobals(see paragraph'STANxxxx.LST').SometimesaProcedurereturnsaglobal variable.MostvariablesaredeclaredasLOCAL.Anddoreadtherelevant chapterofthistextbeforeusingaProcedure. GFAhasreleasedalibraryofgraphics-andsound-routines.Iamcurious aboutthequalityoftheseroutines,butIcertainlydonotintendtopay DM148.-forthelibrary.Myadvicewouldbetousethelibrary GFAXPERT.LIBandpayDM148.-tome. INLINE TheINLINE-folder(inGFAXPRT2.ARCfordownloaders)containsINLINE-files thatyouwillhavetoloadafterMergingcertainProcedures.Thisis clearlyindicatedinsuchProcedures. STANxxxx.LST Beforewritingaprogram,Idecideinwhichresolutiontheprogramwill run.ThenIMergethecorrespondingSTANxxx.LST-file(inthefolder GFAXPERT.LIB)andusethatasthestandardframeworkformyprogram: STANHIGH.LST -Highresolution STANMED.LST -Mediumresolution STANLOW.LST -Lowresolution STANHIME.LST -HighorMediumresolution STANALL.LST -allresolutions Afterdeletingthefirsttwolinesandenteringthenameoftheprogram (e.g.TEST.GFA),ISavetheprogramasAAPROG.GFAintheProcedure- library.InthisfolderIhaveafewLST-filesreadyforeasyMergingof Proceduresintotheprogram(AABLOCK1.LST,AABLOCK2.LST,etc.). Beforeyoucontinue,youshouldLlistthefiveSTANxxxx.LST-files.Merge STANHIGH.LST,unfoldallProcedures,thenLlist.Intheotherfilesyou couldrestrictunfoldingtotheProcedureInitio(andperhapsthe Proceduresxxx.modeandStandard.xxx.colors).I'llwaituntilyouhavethe listingsoftheSTAN-filesinfrontofyou... Right,firstI'lldiscussSTANHIGH.LSTthoroughly.LaterI'llpointout someimportantfeaturesintheotherSTAN-files.Youwillnotbecomean expertinstructuredprogrammingimmediately,butusingtheSTAN-files shouldhelp. (1)Thefirstline('STANHIGH.LST')istheretoremindyouhowto'Save,A' thisfileafteryouhavechangedit.Deleteitifyouaregoingtodevelop anewprogram. (2)Enterthenameofyournewprogram(e.g.TEST.GFA)andimmediately savetheprogramasAAPROG.GFAintheProcedure-library. (3)Word-variablesaredefinedasthedefault. (4)TheProcedureInitioiscalled.InthisProcedurethecurrent resolutionischecked,andafterthat,afewimportantglobalvariables aredefined(StandardGlobals).ThefollowingStandardGlobalsaredefined (readthecommentsinthelistingformoreinformation): high.res! scrn.col.max return$ scrn.lin.max esc$ default.path$ help$ white undo$ physbase% black logbase% interpreter$ on! run.only$ scrn.x.max off! start.gfa$ scrn.y.max start.prg$ bel$ char.width char.height Also,theStandardArraycolor.index()iscreated,althoughyou'llonly needitforafewProcedures(e.g.Initio.sprite1). (5)TheProcedureTitle.screenisnotactivatedyet.You'llprobablywant tochangethatProcedure. (6)Anormalshouldbepossiblewhiledevelopingaprogram.Inthe finishedprogramyoucouldactivatetheProcedureBreak,ordeleteit.Be verycarefulwithiftheprogramusesRESERVEorhaschangedthe addressofthephysical/logicalscreen. (7)ThemainprogramusuallyisnotmuchmorethanalistofProcedure- calls,e.g.: @start.game @play.game @score (8)TrytoleavetheprogrambycallingtheProcedureExit.During developmentit'smoreconvenienttoleavewith'EDIT'. (9)TwoStandardFunctionsaredefined:Center$forcenteringtextand Rev$forPRINTingreverse.ThelastfunctionusesVT52-codes,souseiton theTOS-screenonly. (10)TheStandardProcedureHigh.mode(calledfromInitio)checksthe currentresolutionandabortswithanappropriatemessageiftheprogram isruninthewrongresolution. (11)TheStandardProcedureGet.path(calledfromInitio)returnsthe currentpath.Usingtheinterpreter,GEMDOSreturnsthepathofthe interpreter(e.g.'A:\'),notoftherunningprogram!That'swhyIuse CHDRIVE+CHDIRintheshell-programs.InthatcasetheStandardGlobal default.path$doescontainthepathoftherunningGFA-program.Ifyou developtheprogram,youshoulduseCHDRIVE/CHDIRinDirectModeif necessary.Iamnothappywiththismethod,butIknownoothersolution forGFA-programs.IfIdon'tusethismethod,Ialwaysdefinethepathin theInitiation-part,e.g.: path$="A:\GAMES\" !wherearethedata-files? NowanotherGFA-useronlyhastochangethepathandtheprogramcanfind thenecessaryfiles.ForownersoftheRun-Onlyinterpreteryoushould describetheproperconfigurationinaREAD.ME-file.WithcompiledGFA- programsthereisnoproblem,becauseGEMDOSwillreturnthepathofthe runningprogram. (12)Iliketobegineveryprogramwithatitle-screen.Changethe StandardProcedureTitle.screen,ordeleteitifyoudon'tliketitle- screensinyourprograms. (13)TheStandardProcedureReturnisusedbyTitle.screen. (14)TheStandardProcedureBreakcanbedeletedifyoudon'tneedit. Don'tuse'ONBREAKCONT'inyourprogram,unlessyouhaveaverygood reasontodoso.NotethatIhavemadeitpossibletousethe normalwayiftheuserchooseswhilepressingthe- combination. (15)TheStandardProcedureExitshouldalwaysbeused.ThisProcedure triestogobacktooneoftheshell-programs.Ifthat'simpossible,the Proceduredecidestoendwith'EDIT'or'SYSTEM'.Isitpossibletotest inaprogramifitisrunbytheinterpreterorifitisacompiled program?Iftheanswerisyes,thisProcedurecouldbeimproved. (16)OtherProcedurescanbeinsertedafter'***Procedures***'.Merge ProceduresfromthelibraryGFAXPERT.LIB(oryourownlibrary)here.Iuse thefollowingmethod: -New,somemoryisclear -MergerelevantLST-filefromlibrary -choose(folded)ProcedureandWriteasblocktoAABLOCKx.LST -repeatpreviousstepsforotherProcedure(s) -LoadAAPROG.GFA -MergeAABLOCKx.LSTatappropriateposition(s)  -Saveprogram(pressinFileselector) Ofcourse,you'llhavetowriteafewProceduresfromscratch.Beforeyou knowit,you'llhavereachedTheEnd.It'ssoeasytowriteaprogramin GFA-Basic3.0,thatIactuallyenjoyprogramming. (17)Debuggingisperhapslessfunthanprogramming.MergetheProcedure Debugtemporarilyinyourprogramifyouneedsomehelp.Anddosaveyour programregularly!FallbacktotheprogramAAPROG.BAKifyourlatest improvementswerefatal.Ifyouarecompletelysatisfied,savetheprogram underitspropername(TEST.GFA).Alsosaveaback-uponanotherdisk, justincasesomethingterribleshouldhappentoyouroriginalprogram. (18)InSTANALL.LSTyou'llnoticeintheProcedureInitiothatIalways startwiththedefaultpalette(ProceduresStandard.med.colorsand Standard.low.colors).NewStandardGlobalsinSTANALL.LSTare: red med.res! green low.res! TheStandardArraycolor.index()isveryimportantinMediumorLow resolution. (19)InSTANHIME.LST(myfavourite)theonlyimportantdifferenceisthe ProcedureHigh.med.mode,wherethecurrentresolutionischecked. (20)InSTANLOW.LSTall16default-coloursarenowdefinedasStandard Globals : white blue grey l.purple black d.blue l.black d.purple red brown l.blue d.yellow green d.green bluegreen l.yellow WithtwonewStandardFunctionsyoucanchangethecolourofPRINTedtext (Ink$)orthecolourofthebackground(Paper$).Bothfunctionsworkon theTOS-screenonly.ThecurrentresolutionischeckedintheProcedure Low.mode. (21)NothingnewinSTANMED.LST,excepttheProcedureMed.modetocheck theresolution. Perhapsyoufindallthistalkabouta"standard"program-structurevery boring.Ifyouwriteaprogram,whycareaboutstructure?Becauseit's mucheasiertochangeastructuredprogram,especiallyifyoudidn'twrite theprogramyourself.Changeanunstructuredprogram,andyou'regoingto besurprisedbysome(hidden)unwantedside-effects.Makeotherusers happy,spreadyourbeautifulprogramsonlyiftheyarestructuredandwell commented.Dospreadthe(listable)sourceofyourprogram,sootherusers canlearnfromyou.Anddon'tbeinsultedifothersimproveyourprogram. Icertainlywillnotbeinsultedifyousendmeyourownthoughtsabout structuredprogramminginGFA-Basic3.0. START  IntheSTART-folder(inGFAXPRT2.ARCfordownloaders)youwillfindthe followingprograms: START.GFA -HighorMediumresolution STARTLOW.GFA -Lowresolution GFASTART.GFA -allresolutions IusetwodifferentdisksformyGFA-programs.Oneforprogramsthatrun inHighand/orMediumresolution(savethedesktopinMediumresolution!). AndoneforprogramsthatruninLowresolution. START.GFAandSTARTLOW.GFAareusedasakindofshelltoruntheGFA- programsonthesedisks.Notatrueshell,butit"feels"likeallGFA- programsarerunfromSTART.GFAandSTARTLOW.GFA.IstartaGFA-session bydouble-clickingtheshell-programonthedesktop('GFA'hasbeen installedasapplicationforGFABASIC.PRG). AllmyprogramstrytoCHAINoneoftheshell-programswhentheuserexits theprogram.Twoimportantremarksifyoudecidetousetheseshell- programs: -verticalfrequencyisswitchedto60HzinMediumorLowresolu tion;notagoodideaifyouuseaTVthroughamodulator! -WriteVerifyTestisswitchedoff Ifyoulike,youcanactivatethecheckforaboot-virusintheshell- programs.Theshell-programandGFABASIC.PRG(orGFABASRO.PRG)shouldbe inthemaindirectory! GFASTART.PRGisusedinthesamewaywithcompiledGFA-programs.Allmy compiledGFA-programstrytoCHAINthisshell-programwhenexiting.The sourceforthisprogramisGFASTART.GFA.CompilethisasGFASTART.PRGand putitinthemaindirectory. AllthreeSTART-programscontainplentycomments,soyoushouldbeableto understandhowtheprogramsworkbystudyingthelistings.Theshell- programscertainlycanbeimproved,I'mnotyetsatisfiedwiththecurrent programs. smallprint Readthisparagraphcarefully,beforeusingtheGFAXPERT-files.Thefiles arenotPublicDomain! YouarefreetouseandchangeallGFAXPERT-files,butonlyforpersonal use.Certainlynotforcommercialuse. YouareinvitedtocopytheoriginalGFAXPERT-diskortheGFAXPRTx.ARC- filesandgivethesetoyourfriends.Butyouarenotallowedtochange anythingonthediskorinthefiles.Ifyoufeeltheurgetochange something,don'tdoit,butwritetome(readthechapter'EPILOGUE'). Youarenotallowedtosell(filesfrom)theGFAXPERT-diskoroneofthe GFAXPRTx.ARC-files.ThediskGFAXPERTmayonlybesoldbyso-calledPublic DomainClubsiftheyhavemywrittenpermissiontodoso.BBS'sarefree tomaketheoriginalGFAXPRTx.ARC-filesavailablefordownloading. AnypartfromthetextGFAXPERT.DOCortheProcedure-libraryGFAXPERT.LIB maybequotedinnewslettersormagazines,ifaccompaniedbyareference like: fromGFAXPERT(2nded.)byHanKempen Icannotbeheldresponsibleforanydamagethatmayresultfromrunninga GFAXPERT-program,usingaProcedurefromthelibraryGFAXPERT.LIB,or usinginformationfromthistext. (c)HanKempen,3July1990 EPILOGUE  Well,that'sallfolks.I'mquitecertaintherearestillafewbugstobe foundinthistextandintheProcedure-LibraryGFAXPERT.LIB.Bynowyou shouldhavebecomeanexpertinGFA-Basic3.0,soyouwillbeabletospot thembugsimmediately.Pleaseletmeknowifyoufindone. PerhapsyoustillhavesomeunansweredquestionsaboutGFA-Basic.Oran answertooneofmyownquestionsinthistext.OrsomeneatProcedures. Orabrilliantprogram.Iwouldappreciateitverymuchifyouwouldsend yourletterand/ordiskto: HanKempen Rubensstraat12 7741ARCoevorden theNetherlands Doshareyourideas,Proceduresandprogramswithothers,startingwith me.ConsideritasmallpaymentfortheGFAXPERT-files.Thanks. WishingyoumanyhappyhourswithGFA-Basic3.0, HanKempen INDEX  (#) = Procedure or Function \ ..................................... 29 " ..................................... 41 1st Word Plus ......................... 62 40-folder limit ....................... 66 abbreviated commands .................. 12 accessory ............................. 25,101 ACHAR ................................. 96 ACLIP ................................. 99 After$ (#) ............................ 32 AFTER ................................. 82 ALERT ................................. 106 application ........................... 9 ARECT ................................. 88 ASCII-code ............................ 33,34,36,37 Ascii.qsort (#) ....................... 27 ATEXT ................................. 96 attribute ............................. 53 AUTO .................................. 9 BCHG .................................. 30 BCLR .................................. 29 Before$ (#) ........................... 32 Bezier-curve .......................... 92 BGET .................................. 62 BIOS 4 (Rwabs) ....................... 59 BIOS 7 (Getbpb) ...................... 56,60 BIOS 9 (Mediach) ..................... 60 BIOS 10 (Drvmap) ...................... 51 BIOS 11 (Kbshift) ..................... 36 bit-mask .............................. 29 Blitter (#) ........................... 99 BLOAD ................................. 61 Block.dimmer (#) ...................... 91 Boolean ............................... 17 boot .................................. 9,61 BPB ................................... 56 BPUT .................................. 62 break ................................. 10 Break (#) ............................. 110 BSAVE ................................. 61 BSET .................................. 30,79 bug (GFA) ............................. 12,20,24,25,31,32,36,42,80,83, 84,92,96,97,101 bug (TOS) ............................. 25,35,55,56,63,64,66,70,95,102 calculations .......................... 79 Caps (#) .............................. 39 CapsLock .............................. 38 CARD .................................. 31 CHAIN ................................. 83 Change.font (#) ....................... 44 Change.midi.buffer (#) ................ 67 Change.palette (#) .................... 85 characters ............................ 16,34 CHDIR ................................. 51,110 CLEAR ................................. 19 CLEARW ................................ 105 CLIP .................................. 92 CLOSEW ................................ 104 cluster ............................... 58 Coldstart (#) ......................... 9 color ................................. 40 Color.cycle (#) ....................... 86 correlation ........................... 31 COSQ .................................. 30 CURVE ................................. 92 Cut and Paste ......................... 13 Cycle.once (#) ........................ 87 DATE$ ................................. 22 Day.of.week (#) ....................... 22 Debug (#) ............................. 19,111 DEFFILL ............................... 87 DEFLINE ............................... 89 DEFLIST ............................... 15 DEFMARK ............................... 87 DEFMOUSE .............................. 72 DEFTEXT ............................... 89 DEFWRD ................................ 17 Degas-Pictures ........................ 97 Degas.screendump (#) .................. 46 DELAY ................................. 83 Desk-submenu .......................... 103 DESKTOP.INF ........................... 106 DFREE ................................. 56,58 Digital$ (#) .......................... 93 DIM ................................... 19 Dim.colors (#) ........................ 86 DIR$() ................................ 50 DIR ................................... 51 Direct mode ........................... 15 disk format ........................... 55 disk-swap ............................. 60 Do.sound (#) .......................... 76 DRAW .................................. 91 DTA-buffer ............................ 52 DUMP .................................. 19 Editor ................................ 71 EQV ................................... 31 ERASE ................................. 19,24 ERROR ................................. 82 EVERY ................................. 82 EXEC .................................. 24,83 EXIST ................................. 54 Exit (#) .............................. 110 fade-over ............................. 99 Fastprint (#) ......................... 41 FAT ................................... 58 FDC ................................... 55 FGETDTA ............................... 52 File Allocation Table ................. 58 File.copy (#) ......................... 55 File-submenu .......................... 103 FILES ................................. 51 FILESELECT ............................ 63 Fileselect (#) ........................ 64 Fileselector .......................... 63,71 floating point ........................ 18 Floppy Write Test ..................... 50 Folded Procedures ..................... 13 font .................................. 43,89 Font.8x16 (#) ......................... 43 Font.8x8 (#) .......................... 43 FONTKIT ............................... 44 FOR ... NEXT .......................... 79 Force.mediach (#) ..................... 60 FORM_ALERT ............................ 106 FSETDTA ............................... 52 FSFIRST ............................... 52 FSNEXT ................................ 52 Full.fill (#) ......................... 88 FULLW ................................. 104 FUNCTION .............................. 19 GEMDOS 17 (Cprnos) .................... 45 GEMDOS 25 (Dgetdrv) ................... 50 GEMDOS 48 (Sversion) .................. 10 GEMDOS 54 (Dfree) ..................... 56 GEMDOS 67 (Fattrb) .................... 53 GET ................................... 96 Get.path (#) .......................... 110 GFA-windows ........................... 104 GFAXPERT.DOC .......................... 7,108 GFAXPERT.LIB .......................... 7,108 GOSUB ................................. 82 GOTO .................................. 82 GRAPHMODE ............................. 90 HARDCOPY .............................. 45 harddisk .............................. 51,55,58,59 High.screendump.epson (#) ............. 45 High.screendump.star24 (#) ............ 45 HLINE ................................. 96 IBOX .................................. 102 IF ... ENDIF .......................... 78 INFOW ................................. 194 Initio (#) ............................ 109 Initio.fill1 (#) ...................... 88 Initio.high.fill1 (#) ................. 87 Initio.keyget (#) ..................... 36 Initio.logical.screen (#) ............. 42 Initio.mouse1 (#) ..................... 72 Initio.printer (#) .................... 47 Initio.sound (#) ...................... 75 Initio.sprite1 (#) .................... 93 Initio.text.array (#) ................. 62 Ink$ (#) .............................. 40 INKEY$ ................................ 33 INLINE ................................ 24,108 INP ................................... 62,67,70 INPAUX$ ............................... 70 INPMID$ ............................... 67 INPUT ................................. 34,62 INPUT$ ................................ 35 Insert-mode ........................... 15 INSTR ................................. 32 INT{} ................................. 23 integer ............................... 18 Intel.word (#) ........................ 31 interleave ............................ 57 Invert.block (#) ...................... 91 joystick .............................. 74 Key.click (#) ......................... 38 Key.repeat (#) ........................ 39 keyboard .............................. 37 keyboard-buffer ....................... 33 Keyboard.version (#) .................. 37 KEYDEF ................................ 37 KEYGET ................................ 35 KEYLOOK ............................... 36 KEYPAD ................................ 37 KEYPRESS .............................. 37 KEYTEST ............................... 35 KILL .................................. 54 Line-A ................................ 95 LINE INPUT ............................ 35,62 Llist ................................. 14 Load .................................. 13 LOCATE ................................ 41 LOF ................................... 54 LOG ................................... 30 logical screen ........................ 42 loops ................................. 80,119 LSET .................................. 32 Make.high.fill (#) .................... 88 Make.mouse (#) ........................ 73 Make.palette.string (#) ............... 85 Make.sprite (#) ....................... 94 MALLOC ................................ 25 MAX ................................... 31,78 Max.array (#) ......................... 31 memory ................................ 23,24,25 MENU() ................................ 101 Midi-buffer ........................... 67 Midi-commands ......................... 67 Midi.monitor (#) ...................... 68 MIN ................................... 78 MOD ................................... 29 monitor ............................... 10 MOUSE ................................. 71 MS-DOS disk ........................... 58 NAME .................................. 54 Neochrome-Pictures .................... 98 New.med.colors (#) .................... 85 Normal.font (#) ....................... 44 NOT ................................... 81 OBOX .................................. 102 ON BREAK GOSUB ........................ 82 ON MENU BUTTON ........................ 101 ON MENU IBOX .......................... 102 OPENW ................................. 104 OPENW 0 ............................... 103 Operating System ...................... 10 OUT ................................... 40,62 Overwrite-mode ........................ 15 palette ............................... 84,111 Palette.box (#) ....................... 86 Paper$ (#) ............................ 40 Parse.filename (#) .................... 65 parser ................................ 32 PCIRCLE ............................... 92 physical screen ....................... 42 Play.midi (#) ......................... 68 PLOT .................................. 91 point-commands ........................ 14 PRED .................................. 29 PRINT ................................. 40 Print.stopwatch (#) ................... 21 PRINT TAB ............................. 42 printer-commands ...................... 47 printer-driver ........................ 14 printer-parameters .................... 45 Printer.ready (#) ..................... 45 PUT ................................... 96 QSORT ................................. 26 RAM ................................... 23 RAM-disk .............................. 50 READ .................................. 20 RECALL ................................ 62 Record.midi (#) ....................... 67 RESERVE ............................... 23 reset ................................. 9,50 RESTORE ............................... 20 Restore.palette (#) ................... 85 Restore.physical.screen (#) ........... 43 Return (#) ............................ 110 reverse ............................... 41,84 Rgb.value (#) ......................... 85 right justification ................... 32 RS232-buffer .......................... 70 RSET .................................. 32 Rubber.line (#) ....................... 90 samples ............................... 76 Save .................................. 14 Save,A ................................ 14 Save.palette (#) ...................... 85 scan-code ............................. 33,36,37,38 scrap-library ......................... 83 Screen.dimmer (#) ..................... 91 Screendump (#) ........................ 45 Scroll.text.up (#) .................... 99 Scroll.up (#) ......................... 98 sectors ............................... 59 SELECT ................................ 78 serial number ......................... 57 SETCOLOR .............................. 84 SETMOUSE .............................. 71 SHEL_GET .............................. 106 SHEL_PUT .............................. 106 shell-program ......................... 112 SHL ................................... 79 Show.degas (#) ........................ 97 Show.text.page (#) .................... 63 Shuffle (#) ........................... 20 SINQ .................................. 30 SOUND ................................. 75 Soundmachine .......................... 77 special characters .................... 16 speech ................................ 77 SPRITE ................................ 93 SSORT ................................. 26 Standard .............................. 7 Standard Array ........................ 109,111 Standard Functions .................... 110,111 Standard Globals ...................... 109,111 STANxxxx.LST .......................... 108 START ................................. 112 start-up .............................. 9 Step Rate ............................. 50 STICK ................................. 74 Stopwatch (#) ......................... 21 STORE ................................. 62 STRIG ................................. 74 String.index.qsort (#) ................ 28 SUCC .................................. 29 supervisor mode ....................... 23 SWAP .................................. 20,31 Swap.screen (#) ....................... 43 syntax ................................ 12 system-font ........................... 43,89 Tab ................................... 13,41 TAB ................................... 42 TEXT .................................. 92 text-array ............................ 62 Text.at (#) ........................... 92 TIME$ ................................. 21 Time (#) .............................. 21 TIMER ................................. 21 Title.screen (#) ...................... 110 TITLEW ................................ 104,105 TOS ................................... 10 TOS-screen ............................ 40 TOUCH ................................. 54 twisted format ........................ 57 TYPE .................................. 20 VAR ................................... 18 variable type ......................... 17 VDISYS 38 (vqt_attributes) ............ 89 VQT_EXTENT ............................ 95 VSETCOLOR ............................. 84 VSYNC ................................. 98 VT52 .................................. 40 Warmstart (#) ......................... 9 WAVE .................................. 75 WIND_CLOSE ............................ 104 word .................................. 17,31 WORD .................................. 23,59 write-protect ......................... 60 XBIOS 0 (Initmous) ................... 71 XBIOS 5 (Setscreen) .................. 42 XBIOS 6 (Setpalette) ................. 85,97 XBIOS 7 (Setcolor) ................... 84 XBIOS 8 (Floprd) ..................... 60 XBIOS 10 (Flopfmt) .................... 56 XBIOS 15 (Rsconf) ..................... 70 XBIOS 16 (Keytbl) ..................... 37,38 XBIOS 18 (Protobt) .................... 57 XBIOS 19 (Flopver) .................... 56 XBIOS 32 (Dosound) .................... 75 XBIOS 33 (Setprt) ..................... 45 XBIOS 36 (Prtblk) ..................... 47 XBIOS 64 (Blitmode) ................... 99 READ.ME GFAXPERT-Disk The GFAXPERT-Disk is loaded with interesting files, but you should first concentrate on the text GFAXPERT.DOC. That text was written and saved with 1st Word Plus. Use this wordprocessor (or any other wordprocessor that can load this format) to read GFAXPERT.DOC before you do anything else. If you decide to print GFAXPERT.DOC, your printer will produce 122 pages. With 1st Word Plus I suggest a left margin offset of 10 and NLQ print-quality. Do print the text, it's worth the paper. A lot more, actually. If you don't have the GFA-Basic 3.x interpreter and 1st Word Plus (or compatible wordprocessor) you might as well start formatting the GFAXPERT-Disk right now. Sorry. In case of an emergency, you can write to the author: Han Kempen Rubensstraat 12 7741 AR Coevorden the Netherlands I offer no "money back" or "disk back" guaranty if this disk is faulty or if you don't have GFA-Basic 3.x or 1st Word Plus. But I would certainly like to hear from you if you encountered any problems with the GFAXPERT-Disk. Han Kempen