Another Snippet

I was thinking about the QL World magazine and about all the bits of SBASIC code published in that. Which bits were the best I wonder. Here is one snippet that I have used again and again.

23548 DEFine PROCedure EditFileName(y%,x%)
23556 fil$=INFO$(edch%,y%,x%,40,fil$)
23564 END DEFine EditFileName
23572 :
23580 DEFine FuNction INFO$(edch%,ypos%,xpos%,max%,default$)
23588 LOCal y$(36),loop,key
23596 IF default$="":default$=dest$
23604 y$=default$:xpos%=xpos%
23612 kx%=xpos%+(LEN(y$)*6)
23620 PAPER#edch%,white:REMark CLS#edch%
23628 STRIP#edch%,white:INK#edch%,black
23636 REPeat loop
23644 BLOCK#edch%,216,10,xpos%,ypos%,white
23652 REMark PRINT#edch%,FILL$(' ',max%);
23660 CURSOR#edch%,xpos%,ypos%;
23668 PRINT#edch%,y$;
23676 Kursen edch%,kx%,ypos%
23684 key=CODE(INKEY$(#edch%,-1))
23692 SELect ON key
23700 =9,10 :REMark ENTER/TAB
23708 IF LEN(y$)>0
23716 BLOCK#edch%,216,10,xpos%,ypos%,white
23724 Kursen edch%,kx%,ypos%
23732 CURSOR#edch%,xpos%,ypos%
23740 PRINT#edch%,y$
23748 RETurn y$
23756 END IF
23764 :
23772 =27 : REMark ESC
23780 Kursen edch%,kx%,ypos%
23788 RETurn INFO$(edch%,ypos%,xpos%,max%,fil$)
23796 :
23804 =194 : REMark backspace key
23812 letter=INT((kx%-xpos%)/6)
23836 IF LEN(y$)>1:y$=y$(1 TO LEN(y$)-1)
23844 IF LEN(y$)=1:y$="":kx%=kx%-6
23852 kx%=kx%-6 : IF kx%0 AND letter<=LEN(y$) AND letter>0
23884 IF letter>1:y$=y$(1 TO letter-1)&y$(letter+1 TO LEN(y$))
23892 IF letter=1 AND LEN(y$)>1 : y$=y$(2 TO LEN(y$))
23900 IF letter=1 AND LEN(y$)=1 : y$=""
23908 IF letter<=0:y$=""
23916 kx%=kx%-6 : IF kx%<=0:y$="":kx%=xpos%:REMark remove last charcter from string
23940 :
23948 =202 : REMark delete key
23956 letter=INT((kx%-xpos%)/6)
23964 IF LEN(y$)>0 AND letter<=LEN(y$) AND letter>0
23972 IF letter+2<=LEN(y$)
23980 y$=y$(1 TO letter)&y$(letter+2 TO LEN(y$))
23988 ELSE
23996 IF letter>0:y$=y$(1 TO letter)
24004 IF letter=0
24012 IF LEN(y$)<=1 : y$="" 24020 IF LEN(y$)>1 : y$=y$(2 TO LEN(y$))
24028 END IF
24036 END IF
24044 END IF
24052 IF letter<=0:y$="":kx%=xpos%:REMark remove last charcter from string
24060 :
24068 =33 TO 127 : REMark characters
24076 letter=INT((kx%-xpos%)/6):IF letter<=0:letter=0
24084 IF letter<0 24092="" if="">=LEN(y$)
24100 y$=y$&CHR$(key)
24108 kx%=kx%+6:IF kx%>=xpos%+(max%*6):kx%=xpos%+((max%-1)*6)
24116 END IF
24124 IF LEN(y$)>0 AND letter=1:y$=y$(1 TO letter)&CHR$(key)&y$(letter+1 TO LEN(y$))
24140 IF letter=0:y$=CHR$(key)&y$(1 TO LEN(y$)):kx%=kx%+6
24148 kx%=kx%+6
24156 END IF
24164 :
24172 =32 : REMark space
24180 y$="":kx%=xpos%
24188 :
24196 =192 :REMark move cursor left
24204 Kursen edch%,kx%,ypos%
24212 kx%=kx%-6 : IF kx%=xpos%+(max%*6) : kx%=xpos%+((max%-1)*6)
24260 END SELect
24268 END REPeat loop
24276 RETurn y$
24284 END DEFine INFO$
24292 :
24300 DEFine PROCedure Kursen(edch%,kx%,ky%)
24308 OVER#edch%,-1
24316 BLOCK#edch%,6,10,kx%,ky%,HEX("FF0000")
24324 OVER#edch%,0
24332 END DEFine Kursen
24340 :

Its a bit long. But it is a SBASIC equivalent of EDLINE$. Why bother with this then. Its easier to integrate into another program and removes one toolkit dependency.

Here is another little secrete as well. Notice line 24316. The colour number for the block command is given as HEX("FF0000"). SBASIC allows the 24 bit colour as $FF0000 but QLiberator written many years before the GD2 drivers does not accept this convention hence the use of TK2 HEX function. Drat thats another toolkit dependency but not so important as all expanded systems have toolkit2 and all 24 bit colour values require this format if QLiberated.