home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 051-075 / scopedisk59 / sbasic / sb.asc < prev    next >
Encoding:
Text File  |  1995-03-19  |  21.2 KB  |  664 lines
  1. '
  2. '    SUPERBASIC  V1.0
  3. '    AmigaBASIC OS Expansion Routines
  4. '    January 15, 1989
  5. '
  6. '
  7. '    © Copyright 1988, 1989  Robert Salesas
  8. '
  9. '    2354 Cote St. Catherine
  10. '    Montreal, Quebec
  11. '    H3T 1A9
  12. '
  13. '    These routines are Public Domain.  You may distribute them as you
  14. '    wish as long as this file is untouched in ANY way.  Additions and
  15. '    modifications should be appended and sent to me at the above
  16. '    adress.  I welcome comments and suggestions, either by mail
  17. '    on PLink or on Compuserve.
  18. '
  19. '    PLINK: Robinette
  20. '    Compuserve: 76625,1320
  21. '
  22. '
  23.  
  24.  
  25.  
  26.   Init:
  27.     DEFLNG A-Z
  28.     DIM SHARED CW, RP, Scrn, Response
  29.     DIM SHARED AddKey(11,10), SizeKey(11,10), RememberKey
  30.     DIM SHARED CHIP, FAST, PUBLIC, NULL, NULL%, NilFh
  31.     DIM SHARED Structure$, StructFlags
  32.     DIM SHARED BYTE, DBYTE, DWORD, WORD, LONG, APTR
  33.     DIM SHARED GCNT, GadgetInfo(10,4)
  34.     CHIP=2:FAST=4:PUBLIC=0:NULL=0:NULL%=0:RememberKey=11
  35.     BYTE=1:DBYTE=2:DWORD=3:WORD=16:LONG=17:APTR=17
  36.     GCNT=10  ' Maximum amount of gadgets you will be using at one time
  37.  
  38.     LIBRARY "LIBS:exec.library"
  39.     LIBRARY "LIBS:graphics.library"
  40.     LIBRARY "LIBS:dos.library"
  41.     LIBRARY "LIBS:diskfont.library"
  42.     LIBRARY "LIBS:intuition.library"
  43.     DECLARE FUNCTION xOpen() LIBRARY
  44.     DECLARE FUNCTION xRead() LIBRARY
  45.     DECLARE FUNCTION xWrite() LIBRARY
  46.     DECLARE FUNCTION CreateDir() LIBRARY
  47.     DECLARE FUNCTION SetProtection() LIBRARY
  48.     DECLARE FUNCTION xInput() LIBRARY
  49.     DECLARE FUNCTION xOutput() LIBRARY
  50.     DECLARE FUNCTION Execute() LIBRARY
  51.     DECLARE FUNCTION IoErr() LIBRARY
  52.     DECLARE FUNCTION Examine() LIBRARY
  53.     DECLARE FUNCTION ExNext() LIBRARY
  54.     DECLARE FUNCTION Lock() LIBRARY
  55.     DECLARE FUNCTION SetComment() LIBRARY
  56.     DECLARE FUNCTION OpenFont() LIBRARY
  57.     DECLARE FUNCTION OpenDiskFont() LIBRARY
  58.     DECLARE FUNCTION DisplayAlert() LIBRARY
  59.     DECLARE FUNCTION AllocMem() LIBRARY
  60.     DECLARE FUNCTION AvailMem() LIBRARY
  61.     DECLARE FUNCTION AutoRequest() LIBRARY
  62.     DECLARE FUNCTION WindowLimits() LIBRARY
  63.     DECLARE FUNCTION OpenWorkBench() LIBRARY
  64.     DECLARE FUNCTION CloseWorkBench() LIBRARY
  65.     DECLARE FUNCTION WBenchToBack() LIBRARY
  66.     DECLARE FUNCTION WBenchToFront() LIBRARY
  67.  
  68.   
  69.   SubStart:                
  70.     SUB PROPGADGET (Wind%,Num%,Le%,Top%,Wi%,He%,Border%,Mov%,Hp%,Vp%,Hb%,Vb%) STATIC
  71.     ' Mov% 1=Hor, 2=Ver
  72.       WINFO Wind%:Flags=1:TI=0     
  73.       IF Border%=0 THEN Flags=9
  74.       IF Mov%=1 THEN Flags=Flags+2
  75.       IF Mov%=2 THEN Flags=Flags+4
  76.       IF Mov%=3 THEN Flags=Flags+6
  77.    
  78.       GadgetInfo(Num%,0)=AllocMem(48,CHIP+65537&)             'Gadget Structure
  79.       GadgetInfo(Num%,1)=AllocMem(48,CHIP+65537&)             'String Info
  80.  
  81.       STRUCT GadgetInfo(Num%,0)
  82.         STR APTR,NULL                                            'Next Gadget
  83.         STR WORD,CLNG(Le%):STR WORD,CLNG(Top%)                   'Left & Top
  84.         STR WORD,CLNG(Wi%):STR WORD,CLNG(He%)                    'Width & Height
  85.         STR WORD,1&:STR WORD,3&:STR WORD,3&                      'Flags & Activation Flags, Type
  86.         STR APTR,NULL:STR APTR,NULL:STR APTR,NULL:STR LONG,NULL  'Gadget Stuff
  87.         STR LONG,GadgetInfo(Num%,1)                              'Prop Info Structure
  88.         STR WORD,CLNG(Num%):STR LONG,NULL                        'Our Gadget Number & UserData
  89.       ENDSTRUCT GadgetInfo(Num%,0),NULL,NULL
  90.     
  91.       STRUCT GadgetInfo(Num%,1)
  92.         STR WORD,Flags:STR WORD,CLNG(Hp):STR WORD,CLNG(Vp)
  93.         STR WORD,CLNG(Hb):STR WORD,CLNG(Vb)
  94.         STR WORD,NULL:STR WORD,NULL:STR WORD,NULL
  95.         STR WORD,NULL:STR WORD,NULL
  96.       ENDSTRUCT GadgetInfo(Num%,1),NULL,NULL
  97.     
  98.       ADDGADGET CW,GadgetInfo(Num%,0),-1    
  99.     END SUB  
  100.     
  101.     SUB GADGET (Wind%,Num%,Le%,Top%,Wi%,He%,Type%,High%,SPos%,VChar%,MChar%,IVal$) STATIC
  102.     ' Type 1=Boolean, 2=Toggle Boolean, 3=String Left, 4= Integer Left
  103.     ' High 0=Complement, 1=Box, 3=None 
  104.     ' SPos 1=String Right, 2=String Center  
  105.       WINFO Wind%:Flags=0:AFlags=0:TI=0     
  106.       GadgetInfo(Num%,0)=AllocMem(48,CHIP+65537&)             'Gadget Structure
  107.       IF Type%>2 THEN
  108.         GadgetInfo(Num%,1)=AllocMem(64,CHIP+65537&)           'String Info
  109.         GadgetInfo(Num%,2)=AllocMem(MChar%+1,CHIP+65537&)     'Buffer
  110.         FOR Loop=1 TO LEN(IVal$)
  111.           GadgetInfo(Num%,2)=ASC(MID$(IVal$,Loop,1))
  112.         NEXT Loop
  113.         GadgetInfo(Num%,2,)=GadgetInfo(Num%,2,)+CHR$(NULL)
  114.         GadgetInfo(Num%,3)=MChar%
  115.         IF SPos%=1 THEN
  116.           AFlags=1024
  117.         ELSEIF SPos%=2 THEN
  118.           AFlags=512
  119.         END IF
  120.         IF Type%=4 THEN AFlags=AFlags+2048:TI=1
  121.         Type%=4
  122.       END IF   
  123.       Flags=Flags+High%
  124.       IF Type%=2 THEN Type%=1:AFlags=AFlags+256
  125.       STRUCT GadgetInfo(Num%,0)
  126.         STR APTR,NULL                                            'Next Gadget
  127.         STR WORD,CLNG(Le%):STR WORD,CLNG(Top%)                   'Left & Top
  128.         STR WORD,CLNG(Wi%):STR WORD,CLNG(He%)                    'Width & Height
  129.         STR WORD,Flags:STR WORD,AFlags+3:STR WORD,CLNG(Type%)    'Flags & Activation Flags, Type
  130.         STR APTR,NULL:STR APTR,NULL:STR APTR,NULL:STR LONG,NULL  'Gadget Stuff
  131.         STR LONG,GadgetInfo(Num%,1)                              'String Info Structure
  132.         STR WORD,CLNG(Num%):STR LONG,NULL                        'Our Gadget Number & UserData
  133.       ENDSTRUCT GadgetInfo(Num%,0),NULL,NULL
  134.       
  135.       IF Type%=4 THEN
  136.       STRUCT GadgetInfo(Num%,1)
  137.         STR APTR,GadgetInfo(Num%,2):STR APTR,NULL                'Buffer & Undo Buffer
  138.         STR WORD,NULL:STR WORD,1&+MChar%:STR WORD,NULL           'Character information
  139.         STR WORD,NULL:STR WORD,LEN(IVal$):STR WORD,CLNG(VChar%)
  140.         STR WORD,NULL:STR WORD,NULL:STR LONG,NULL:STR LONG,NULL
  141.         STR APTR,NULL
  142.       ENDSTRUCT GadgetInfo(Num%,1),NULL,NULL
  143.       END IF
  144.       
  145.       ADDGADGET CW,GadgetInfo(Num%,0),-1
  146.     END SUB
  147.     
  148.     SUB ULTRASORT (Array$(1),LArray%,UArray%) STATIC
  149.       FOR Loop=LArray%+1 TO UArray%
  150.         APos=Loop:DT$=Array$(APos):Again=1
  151.         WHILE Again
  152.           IF APos=LArray% THEN
  153.             Array$(APos)=DT$:Again=0
  154.           ELSEIF Array$(APos-1)<=DT$ THEN
  155.             Array$(APos)=DT$:Again=0
  156.           ELSE 
  157.             Array$(APos)=Array$(APos-1):APos=APos-1
  158.           END IF
  159.         WEND
  160.       NEXT Loop
  161.     END SUB
  162.  
  163.     SUB BUBBLESORT (Array$(1),LArray%,UArray%) STATIC
  164.       FOR L1=LArray% TO UArray%
  165.         FOR L2=L1+1 TO UArray%
  166.           IF Array$(L2) < Array$(L1) AND Array$(L1) = "" THEN
  167.             SWAP Array$(L2),Array$(L1)          
  168.           END IF
  169.         NEXT L2
  170.       NEXT L1 
  171.     END SUB
  172.     
  173.     SUB COPYARRAY (AFrom$(1),ATo$(1)) STATIC
  174.       IF LBOUND(AFrom$)<>LBOUND(ATo$) OR UBOUND(ATo$)<UBOUND(AFrom$) THEN ERROR 9
  175.       FOR Loop=LBOUND(AFrom$) TO UBOUND(AFrom$)
  176.         ATo$(Loop)=AFrom$(Loop)
  177.       NEXT Loop    
  178.     END SUB
  179.     
  180.     SUB SUBSTRING (VStr$,SStr$,SFrom%,STo%) STATIC
  181.       SStr$=MID$(VStr$,SFrom%,STo%-SFrom%)              
  182.     END SUB
  183.     
  184.     SUB FROMCLI (Inp,Out) STATIC
  185.     ' If Inp, Out=0 then program was started from WorkBench
  186.     ' else returns Filehandler to a console window (not necc. CLI)
  187.       Inp=xInput(0):Out=xOutput(0)
  188.     END SUB
  189.     
  190.     SUB EXEC (Command$,Parameters$,Mode%) STATIC
  191.     '  Mode 1 = Run, 0 = Execute Normally
  192.       IF NOT Called THEN
  193.         NilFh=xOpen(SADD("NIL:"+CHR$(NULL)),1005)
  194.         IF NilFh=NULL THEN ERROR 57        
  195.         Called=1
  196.       END IF
  197.       IF Mode%=1 THEN
  198.         Command$="RUN >NIL: <NIL: "+Command$+" >NIL: <NIL: "+Parameters$+CHR$(NULL)
  199.       ELSE
  200.         Command$=Command$+" >NIL: <NIL: "+Parameters$+CHR$(NULL)
  201.       END IF
  202.       Io=Execute(SADD(Command$),NilFh,NilFh)
  203.       IF Io=NULL THEN ERROR 57
  204.     END SUB    
  205.     
  206.     SUB DIR (DirName$,Buff$(1),FBytes(1)) STATIC
  207.     '  Type FBytes  -1 = Directory, 0 >= File
  208.       MFiles=UBOUND(Buff$)
  209.       FLock=Lock(SADD(DirName$+CHR$(NULL)),-2):IF FLock=NULL THEN ERROR 57
  210.       ALLOCMEMORY 256&,CHIP,Fib,RememberKey
  211.       Io=Examine(FLock,Fib):IF Io=NULL THEN ERROR 57
  212.       File=-1:GOSUB GetFileName
  213.       IF PEEKL(Fib+4)<1 THEN
  214.         FREEMEMORY RememberKey
  215.         UNLOCK FLock
  216.         EXIT SUB
  217.       END IF
  218.       WHILE Io<>NULL AND File<>MFiles
  219.         GOSUB GetFileName
  220.       WEND
  221.       FREEMEMORY RememberKey
  222.       UNLOCK FLock
  223.       EXIT SUB
  224.     GetFileName:  
  225.       File=File+1:Offset=8:FChar=PEEK(Fib+Offset)
  226.       WHILE FChar<>NULL
  227.         Buff$(File)=Buff$(File)+CHR$(FChar)
  228.         Offset=Offset+1:FChar=PEEK(Fib+Offset)
  229.       WEND
  230.       IF PEEKL(Fib+4)>0 THEN FBytes(File)=-1 ELSE FBytes(File)=PEEKL(Fib+124)
  231.       Io=ExNext(FLock,Fib)
  232.       RETURN
  233.     END SUB
  234.         
  235.     SUB FILECOMMENT (FileName$,Comment$) STATIC
  236.       Io=SetComment(SADD(FileName$+CHR$(NULL)),SADD(Comment$+CHR$(NULL)))
  237.       IF Io=NULL THEN ERROR 57    
  238.     END SUB 
  239.  
  240.     SUB PROTECT (FileName$,Flag%) STATIC
  241.     ' Flag  0 = RWED, 1 = RWE-, 2 = RW-D, 4 = R-ED, 8 = -WED
  242.       Io=SetProtection(SADD(FileName$+CHR$(NULL)),Flag%)
  243.       IF Io=NULL THEN ERROR 57
  244.     END SUB
  245.     
  246.     SUB COPY (FromFile$,ToFile$) STATIC
  247.       OPEN FromFile$ FOR INPUT AS 255:Size=LOF(255):CLOSE 255:Badd=0:Buff=Size:TSize=0
  248.       Fh1=xOpen(SADD(FromFile$+CHR$(NULL)),1005):IF Fh1=NULL THEN ERROR 57
  249.       Fh2=xOpen(SADD(ToFile$+CHR$(NULL)),1006):IF Fh2=NULL THEN ERROR 57
  250.       WHILE Badd=0
  251.         ALLOCMEMORY Buff,FAST,Badd,RememberKey
  252.         IF Badd=0 THEN Buff=Buff-512:IF Buff<512 THEN ERROR 7        
  253.       WEND
  254.       WHILE TSize<>Size
  255.         RSize=xRead(Fh1,Badd,Buff):IF RSize=NULL THEN ERROR 57
  256.         WSize=xWrite(Fh2,Badd,RSize):IF WSize=NULL THEN ERROR 57
  257.         TSize=TSize+RSize
  258.       WEND
  259.       FREEMEMORY RememberKey
  260.       xCLOSE Fh1:xCLOSE Fh2       
  261.     END SUB
  262.     
  263.     SUB MAKEDIR (FileName$) STATIC
  264.       Io=CreateDir(SADD(FileName$+CHR$(NULL)))
  265.       IF Io=NULL THEN ERROR 57
  266.     END SUB
  267.     
  268.     SUB BLOAD (FileName$,Badd,Type,Key) STATIC
  269.       OPEN FileName$ FOR INPUT AS 255:Size=LOF(255):CLOSE 255
  270.       ALLOCMEMORY Size,Type,Badd,Key:IF Badd=NULL THEN ERROR 7
  271.       Fh=xOpen(SADD(FileName$+CHR$(NULL)),1005):IF Fh=NULL THEN ERROR 57
  272.       Io=xRead(Fh,Badd,Size):IF Io=NULL THEN ERROR 57
  273.       FREEMEMORY Key
  274.       xCLOSE Fh      
  275.     END SUB
  276.     
  277.     SUB BSAVE (FileName$,Badd,Size) STATIC
  278.       Fh=xOpen(SADD(FileName$+CHR$(NULL)),1006):IF Fh=NULL THEN ERROR 57
  279.       Io=xWrite(Fh,Badd,Size):IF Io=NULL THEN ERROR 57
  280.       xCLOSE Fh      
  281.     END SUB
  282.     
  283.     SUB CLIP (Wind%,Px%,Py%,Wind2%,Px2%,Py2%,Sx%,Sy%) STATIC
  284.       OldW=WINDOW (1)
  285.       WINDOW OUTPUT (Wind%):RP1=WINDOW (8)
  286.       WINDOW OUTPUT (Wind2%):RP2=WINDOW (8)
  287.       CLIPBLIT RP1,Px%,Py%,RP2,Px2%,Py2%,Sx%,Sy%,192
  288.       WINDOW OUTPUT (OldW)    
  289.     END SUB
  290.     
  291.     SUB BORDER (Badd,LOffset%,TOffset%) STATIC
  292.     '  Badd = Pointer to a Border Structure
  293.       WINFO 0
  294.       DRAWBORDER RP,Badd,LOffset%,TOffset%
  295.     END SUB
  296.     
  297.     SUB MATDRAW (Pts(1),Col%,Mode%) STATIC
  298.       WINFO 0
  299.       SETDRMD RP,Mode%
  300.       COLOR Col%,0
  301.       POLYDRAW RP,VARPTR(Pts),Padd+2       
  302.       SETDRMD RP,1
  303.     END SUB
  304.     
  305.     SUB FLOODFILL (Px%,Py%,Col%) STATIC
  306.       WINFO 0
  307.       POKE RP+27,Col%:POKEW RP+32,PEEKW(RP+32) OR 8
  308.       FLOOD RP,NULL,Px%,Py%
  309.     END SUB    
  310.     
  311.     SUB SETOPEN (Col%) STATIC
  312.       WINFO 0
  313.       POKE RP+27,Col%:POKEW RP+32,PEEKW(RP+32) OR 8
  314.     END SUB    
  315.     
  316.     SUB POINTEROFF (Wind%) STATIC
  317.       WINFO Wind%
  318.       CLEARPOINTER CW
  319.     END SUB    
  320.     
  321.     SUB POINTERON (Wind%,Padd) STATIC      
  322.       WINFO Wind%
  323.       XOffset=PEEKW(Padd+76):YOffset=PEEKW(Padd+78)
  324.       SETPOINTER CW,Padd,16,16,XOffset,YOffset    
  325.     END SUB
  326.     
  327.     SUB SYSREQUESTER (Wind%,Rx%,Ry%,TLines%,Col%,PText$(1),Flags%) STATIC
  328.     '  Flags 1=Normal, 2=Disk Inserted, 3=Disk Removed, 4=Both
  329.       IF Wind%>0 THEN
  330.         WINFO Wind%
  331.       ELSE
  332.         CW=NULL
  333.       END IF
  334.       TLines%=TLines%+1:NextText=0
  335.       FOR Loop=TLines% TO 0 STEP -1
  336.         PText$(Loop)=PText$(Loop)+CHR$(NULL)
  337.         STRUCT IText(Loop)                                          'IntuiText Structure
  338.           STR  BYTE,CLNG(Col%):STR BYTE,1&:STR  BYTE,1&             'FPen, BPen, Drawmode
  339.           STR  WORD,6&:STR  WORD,3&+(8*Loop)*ABS(Loop<TLines%-1)    'Top
  340.           STR  APTR,NULL                                            'Fontdef
  341.           STR  APTR,SADD(PText$(Loop)):STR  APTR,NextText           'Text & Next Text
  342.         ENDSTRUCT IText(Loop),CHIP,RememberKey  
  343.         NextText=IText(Loop)*ABS(Loop<TLines%-1)           'Determine Next Text
  344.       NEXT Loop
  345.       
  346.       PText=IText(TLines%-1):NText=IText(TLines%)
  347.       IDCMP=(32768&*ABS(Flags%=2))+(65536&*ABS(Flags%=3))+(98304&*ABS(Flags%=4))
  348.       IF PText$(TLines%-1)=CHR$(NULL) THEN PText=NULL:IDCMP=NULL
  349.       Response=AutoRequest(CW,IText(0),PText,NText,IDCMP,NULL,Rx%,Ry%)
  350.       FREEMEMORY RememberKey
  351.     END SUB
  352.     
  353.     SUB ALERT (Text1$,Text2$,TLeft$,TRight$) STATIC     
  354.       Px=320-LEN(Text1$)*4:Px2=320-LEN(Text2$)*4:Sp=31-(LEN(TLeft$)+LEN(TRight$))
  355.       Text3$="Left Mouse Button To "+TLeft$+SPACE$(Sp)+"Right Mouse Button To "+TRight$
  356.       
  357.       STRUCT AlertText
  358.         STR  DBYTE,Px:STR  BYTE,15&:NSTR Text1$:STR  BYTE,1&
  359.         STR  DBYTE,Px2:STR  BYTE,25&:NSTR Text2$:STR  BYTE,1&
  360.         STR  DBYTE,24&:STR  BYTE,41&:NSTR Text3$:STR  BYTE,0&
  361.       ENDSTRUCT AlertText,CHIP,RememberKey
  362.             
  363.       Response=DisplayAlert(NULL,AlertText,53&)
  364.       FREEMEMORY RememberKey
  365.     END SUB
  366.     
  367.     SUB DRAWMODE (Mode%) STATIC
  368.       WINFO 0
  369.       SETDRMD RP,Mode%
  370.     END SUB    
  371.     
  372.     SUB PRINTAT (Px%,Py%,SText$) STATIC
  373.       WINFO 0
  374.       MOVE RP,Px%,Py%
  375.       TEXT RP,SADD(SText$),LEN(SText$)
  376.     END SUB
  377.     
  378.     SUB SHADOW (TCol%,ShCol%,Px%,Py%,SText$) STATIC
  379.       WINFO 0
  380.       SETDRMD RP,1:COLOR ShCol%
  381.       MOVE RP,Px%+1,Py%+1:TEXT RP,SADD(SText$),LEN(SText$)
  382.       SETDRMD RP,0:COLOR TCol%     
  383.       MOVE RP,Px%,Py%:TEXT RP,SADD(SText$),LEN(SText$)
  384.       SETDRMD RP,1
  385.     END SUB
  386.   
  387.     SUB STYLESET (Style%) STATIC
  388.       '  0=Norm. 1=Under. 2=Bold 3=Italic
  389.       WINFO 0
  390.       SETSOFTSTYLE RP,Style%,255
  391.     END SUB
  392.         
  393.     SUB FONTOPEN (Font$,Sz%,FontDef) STATIC
  394.       Attribute(0)=SADD(Font$+".font"+CHR$(0))
  395.       Attribute(1)=65536&*Sz%
  396.       FontDef=OpenFont(VARPTR(Attribute(0)))
  397.       IF FontDef=NULL THEN FontDef=OpenDiskFont(VARPTR(Attribute(0)))
  398.       IF FontDef=NULL THEN ERROR 53    
  399.     END SUB
  400.     
  401.     SUB FONTSET (FontDef) STATIC
  402.       WINFO 0
  403.       SETFONT RP,FontDef
  404.     END SUB
  405.     
  406.     SUB FONTCLOSE (FontDef) STATIC
  407.       CLOSEFONT FontDef
  408.       REMFONT FontDef    
  409.     END SUB
  410.     
  411.     SUB GETLINE (SText$,Length%,Row%,Col%,Clrs%,Box%,BClrs%) STATIC
  412.       IF Box%>0 THEN
  413.         Px%=Col%*8-11:Py%=Row%*8-10:LP%=Length%*8+13
  414.         LINE (Px%,Py%)-STEP(LP%,10),0,BF
  415.         LINE (Px%,Py%)-STEP(LP%,10),BClrs%,b
  416.       END IF
  417.       SText$=""
  418.       LOCATE Row%,Col%
  419.       WHILE Key%<>13
  420.         Key$="":Key%=0
  421.         WHILE Key$=""
  422.           COLOR 0,2:PRINT CHR$(32);CHR$(8);:COLOR Clrs%,0
  423.           SLEEP
  424.           Key$=INKEY$
  425.         WEND
  426.         Key%=ASC(Key$)
  427.         IF Key%>31 THEN
  428.           IF LEN(SText$)<Length% THEN
  429.             SText$=SText$+CHR$(Key%)
  430.             PRINT CHR$(Key%);
  431.           ELSE
  432.             BEEP
  433.           END IF
  434.         ELSE
  435.           IF Key%=8 AND LEN(SText$)=1 THEN 
  436.             SText$=""
  437.             PRINT CHR$(32);CHR$(8);CHR$(8);
  438.           ELSEIF Key%=8 AND LEN(SText$)>1 THEN                     
  439.             SText$=LEFT$(SText$,LEN(SText$)-1)
  440.             PRINT CHR$(32);CHR$(8);CHR$(8);
  441.         END IF
  442.         IF Key%=27 THEN          
  443.             LOCATE Row%,Col%
  444.             PRINT SPACE$(LEN(SText$)+1);
  445.             LOCATE Row%,Col%
  446.             SText$=""
  447.           END IF
  448.         END IF
  449.       WEND
  450.     PRINT CHR$(32);CHR$(8);
  451.     END SUB    
  452.     
  453.     SUB CLEARMENU (Wind%) STATIC
  454.       WINFO Wind%
  455.       CLEARMENUSTRIP CW
  456.     END SUB
  457.  
  458.     SUB MENUOFF STATIC
  459.       FOR Loop=1 TO 10
  460.         MENU Loop,0,0,""
  461.       NEXT Loop
  462.     END SUB
  463.  
  464.     SUB CHECKMENU (MenuNum%,Item%,State%) STATIC
  465.       WINFO 0:MENUPOS MenuNum%,Item%,Head,Command,Flags
  466.       FlagSet=PEEKW(Flags):State%=0
  467.       IF (FlagSet OR 256) = FlagSet THEN State%=1
  468.     END SUB
  469.     
  470.     SUB SUPERMENU (MenuNum%,Item%,State%,High%,MenuText$,KeyComm$) STATIC
  471.       WINFO 0
  472.       IF KeyComm$="" THEN Comm=0:FlagSet=0 ELSE Comm=ASC(MID$(KeyComm$,1,1)):FlagSet=4
  473.       IF State%=2 THEN
  474.         FlagSet=8
  475.       ELSEIF State%=3 THEN
  476.         State%=1:FlagSet=9
  477.       END IF
  478.       IF High%=0 THEN FlagSet=FlagSet+192 ELSE FlagSet=FlagSet+64
  479.       MENU MenuNum%,Item%,State%,MenuText$:IF Item%=0 THEN EXIT SUB
  480.       T!=TIMER:WHILE T!+.1>TIMER:WEND
  481.       MENUPOS MenuNum%,Item%,Head,Command,Flags
  482.       POKE Command,Comm:POKEW Flags,PEEKW(Flags) OR FlagSet
  483.       CLEARMENUSTRIP CW:SETMENUSTRIP CW,Head
  484.     END SUB    
  485.  
  486.     SUB MENUPOS (MenuNum%,Item%,Head,Command,Flags) STATIC
  487.     MenuData:
  488.       Head=PEEKL(CW+28):Menu1=Head
  489.       IF MenuNum%>1 THEN
  490.         FOR Loop=1 TO MenuNum%-1
  491.           Menu1=PEEKL(Menu1) 
  492.         NEXT Loop
  493.       END IF
  494.       MenuItem=PEEKL(Menu1+18):temp=MenuItem 
  495.       IF Item%>1 THEN
  496.         FOR Loop=1 TO Item%-1
  497.           MenuItem=PEEKL(MenuItem)
  498.         NEXT Loop
  499.       END IF
  500.       IF MenuItem<0 OR MenuItem>9216000& THEN MenuData
  501.       Command=MenuItem+26:Flags=MenuItem+12      
  502.     END SUB      
  503.     
  504.     SUB SETTITLE (Wind%,WTitle$,STitle$) STATIC
  505.     ' WTitle = Window title,  STitle = Screen Title 
  506.     ' "" = No title, "=" = No change
  507.       WINFO Wind%
  508.       WTadd=SADD(WTitle$+CHR$(NULL))
  509.       STadd=SADD(STitle$+CHR$(NULL))
  510.       IF WTitle$="" THEN WTadd=0
  511.       IF WTitle$="=" THEN WTadd=-1
  512.       IF STitle$="" THEN STadd=0
  513.       IF STitle$="=" THEN STadd=-1
  514.       SETWINDOWTITLES CW,WTadd,STadd
  515.     END SUB
  516.     
  517.     SUB WINFO (Wind%) STATIC
  518.       IF Wind%>0 THEN
  519.         OldW=WINDOW (1)
  520.         WINDOW OUTPUT (Wind%)
  521.       END IF
  522.       CW=WINDOW(7):RP=WINDOW(8):Scrn=PEEKL(CW+46)
  523.       IF Wind%>0 THEN WINDOW OUTPUT (OldW)
  524.     END SUB    
  525.     
  526.     SUB REFRESHFRAME (Wind%) STATIC
  527.       WINFO Wind%
  528.       REFRESHWINDOWFRAME CW
  529.     END SUB
  530.    
  531.     SUB WINDOWACT (Wind%) STATIC
  532.       WINFO Wind%
  533.       WINDOW Wind%
  534.       ACTIVATEWINDOW CW
  535.     END SUB
  536.     
  537.     SUB WINDOWTO (Wind%,Mode%) STATIC
  538.     ' Mode 1 = Front, -1 = Back
  539.       WINFO Wind%
  540.       IF Mode%=-1 THEN
  541.         WINDOWTOBACK CW
  542.       ELSEIF Mode%=1 THEN
  543.         WINDOWTOFRONT CW
  544.       END IF
  545.     END SUB
  546.     
  547.     SUB WINDOWMOVE (Wind%,Px%,Py%) STATIC
  548.     ' Moves from current position + Px,Py
  549.       WINFO Wind%
  550.       MOVEWINDOW CW,Px%,Py%
  551.     END SUB
  552.     
  553.     SUB WINDOWSIZE (Wind%,Px%,Py%) STATIC
  554.     ' Sizes from current size + Px,Py
  555.       WINFO Wind%
  556.       SIZEWINDOW CW,Px%,Py%
  557.     END SUB
  558.  
  559.     SUB SETWINDOWLIMITS (Wind%,Minx%,Miny%,Maxx%,Maxy%) STATIC
  560.     '  Absolute values
  561.       WINFO Wind%
  562.       Response=WindowLimits(CW,Minx%,Miny%,Maxx%,Maxy%)
  563.     END SUB
  564.  
  565.     SUB WORKBENCH (Mode%) STATIC
  566.     '  Mode = 1 Open WorkBench, -1 Close WorkBench
  567.       IF Mode%=1 THEN
  568.         Response=OpenWorkBench(0)
  569.       ELSEIF Mode%=-1 THEN
  570.         Response=CloseWorkBench(0)
  571.       END IF
  572.     END SUB
  573.  
  574.     SUB WORKBENCHTO (Mode%) STATIC
  575.     '  Mode = 1 WorkBench to front, -1 WorkBench to back
  576.       IF Mode%=1 THEN
  577.         Response=WBenchToFront(0)
  578.       ELSEIF Mode%=-1 THEN
  579.         Response=WBenchToBack(0)
  580.       END IF
  581.     END SUB
  582.     
  583.     SUB SCREENTO (Wind%,Mode%) STATIC
  584.     '  Wind = Window attached to Screen, Mode = 1 Screen to front, -1 Screen to back
  585.       WINFO Wind%
  586.       IF Mode%=1 THEN
  587.         SCREENTOFRONT Scrn
  588.       ELSEIF Mode%=-1 THEN
  589.         SCREENTOBACK Scrn
  590.       END IF
  591.     END SUB
  592.  
  593.     SUB SCREENMOVE (Wind%,Px%,Py%) STATIC
  594.     '  Wind = Window attached to Screen, Moves from current position + Px,Py
  595.       WINFO Wind%
  596.       MOVESCREEN Scrn,Px%,Py%
  597.     END SUB
  598.     
  599.     SUB MOUSECLICK STATIC
  600.       WHILE MOUSE(0)<>NULL:WEND
  601.       WHILE MOUSE(0)=NULL:SLEEP:WEND
  602.     END SUB
  603.     
  604.     SUB STRUCT (StrAdd) STATIC
  605.       StructFlags=NULL:Structure$=""
  606.     END SUB    
  607.  
  608.     SUB STR (Mode, Value) STATIC
  609.     '  Byte=1, DByte=2, DWord=3, Word=16, Long=17, Aptr=17
  610.     '  Value holds amount to insert in structure
  611.       IF Mode>15 AND StructFlags=1 THEN Structure$=Structure$+CHR$(NULL):StructFlags=NULL
  612.       
  613.       IF Mode=1 THEN                                ' Byte
  614.         StructFlags=StructFlags XOR 1
  615.         Structure$=Structure$+CHR$(Value)
  616.       ELSEIF Mode=2 OR Mode=16 THEN                 ' DByte  Word
  617.         Structure$=Structure$+MKI$(Value)
  618.       ELSEIF Mode=3 OR Mode=17 THEN                 ' DWord, Long,  Pointer
  619.         Structure$=Structure$+MKL$(Value)      
  620.       END IF
  621.     END SUB
  622.     
  623.     SUB NSTR (Value$) STATIC
  624.       Structure$=Structure$+Value$+CHR$(NULL)
  625.     END SUB  
  626.     
  627.     SUB ENDSTRUCT (StrAdd,Type,Key) STATIC
  628.     '  Type is either CHIP(2) or FAST(4)
  629.     '  StructKey contains Key with which to free memory
  630.       Size=LEN(Structure$)
  631.       IF StrAdd=0 THEN
  632.         ALLOCMEMORY Size,Type,StrAdd,Key
  633.         IF StrAdd=NULL THEN ERROR 7
  634.       END IF
  635.       FOR Loop=1 TO Size
  636.         POKE StrAdd+Loop-1,ASC(MID$(Structure$,Loop,1))
  637.       NEXT Loop
  638.       Structure$=""
  639.     END SUB
  640.  
  641.     SUB MEMORY (Type,Amount) STATIC
  642.       Amount=AvailMem(Type+65537&)
  643.     END SUB  
  644.     
  645.     SUB ALLOCMEMORY (Size,Type,Add,Key) STATIC
  646.       Add=AllocMem(Size,65537&+Type):IF Add=0 THEN EXIT SUB
  647.       Loop=LBOUND(AddKey,2)
  648.       WHILE AddKey(Key,Loop)<>Add  
  649.         IF AddKey(Key,Loop)=NULL THEN
  650.         AddKey(Key,Loop)=Add:SizeKey(Key,Loop)=Size:Loop=Loop-1
  651.         END IF
  652.         Loop=Loop+1
  653.       WEND
  654.     END SUB      
  655.     
  656.     SUB FREEMEMORY (Key) STATIC
  657.       FOR Loop=LBOUND(AddKey,2) TO UBOUND(AddKey,2) 
  658.         IF AddKey(Key,Loop)>NULL THEN
  659.           FREEMEM AddKey(Key,Loop),SizeKey(Key,Loop)
  660.           AddKey(Key,Loop)=NULL:SizeKey(Key,Loop)=NULL
  661.         END IF
  662.       NEXT Loop
  663.     END SUB
  664.