home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 401-425 / apd410 / director.amos / director.amosSourceCode
AMOS Source Code  |  1992-05-17  |  17KB  |  735 lines
  1. '  
  2. ' First AUTHOR EJBER OZKAN   
  3. ' PROJECT STARTED 1/5/91 
  4. '  
  5. '                director V1.2 
  6. '
  7. ' THE DIRECTORY HELPER....1991-92  
  8. '
  9. ' i hope someone can improve this for a new version....
  10. ' How about a workbench 2 look and feel?!!...
  11. ' Or a complete rewrite....
  12. ' When adding commands try to keep the commands in its own 
  13. ' separte PROCEDURE for other people to be able to use it, and for 
  14. ' next PIX n MIX 
  15. ' There are loads of REMS in the code so check it out!...
  16. ' HAVE FUN...
  17. ' Read Director Docs for more info...
  18. '
  19. 'STOP PRESS
  20. 'found late bug in compiled version! when loading iff files if an error
  21. 'occurs instead of showing error it ooesnt!, wierd???
  22. '
  23. ' /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ 
  24. '
  25. ' SETUP VARIABLES FOR USE IN ALL PROCEDURES
  26.    Screen Open 0,640,256,16,Hires
  27.    Cls 0 : Pen 2 : Paper 0 : Ink 2
  28.    Curs Off 
  29.    Colour 1,$0
  30.    Screen Display 0,140,40,640,256
  31. Global AX,DISKFREE,COUNT,FLAGUP,DRIV,TREE,EXNOT,Z
  32. AX=1 : DISKFREE=0 : COUNT=0 : URE=0 : FLAGUP=0 : TREE=0
  33. Dim F$(200),FILE$(200),CURDR$(10),SUB$(200),WE$(30),WE1$(30),WE2$(30)
  34. Dim WEA$(30),WE3$(30),WE4$(30),WE5$(30),WE6$(30),PAT$(30)
  35. Shared F$(),FILE$(),CURDR$(),SUB$(),PAT$()
  36. '
  37. SETUP
  38. GATOPT
  39. End 
  40. Procedure SETUP
  41. ' SHOW MOUSE POINTER AND SET MAIN DIRECTORY  
  42. '
  43.     Set Dir 30
  44.     Limit Mouse 130,40 To 430,270
  45.     Dir$="df0:"
  46. '
  47. ' OPENS MAIN MENU SCREEN 
  48. '
  49. '   Screen Open 0,640,256,16,Hires 
  50. '   Cls 0 : Pen 2 : Paper 0 : Ink 2
  51. '   Curs Off 
  52. '   Colour 1,$0
  53. '   Screen Display 0,140,40,640,256
  54. '
  55. ' OPENS MESSAGE SCREEN FOR OUTPUT
  56. '
  57.    Screen Open 1,640,10,8,Hires
  58.    Cls 0 : Pen 2 : Paper 0 : Ink 2
  59.    Curs Off 
  60.    Colour 1,$0
  61.    Screen Display 1,140,285,640,10
  62.    Cls 0 : Locate 0,0 : Print "The AMOS DIRECTORY HELPER -DIRECTOR- V1.2";
  63.    Screen 0
  64. '
  65. ' LIST COMMANDS AND DRAW BOXS AROUND THEM FOR NEATNESS...  
  66. '
  67.    Locate 5,5 : Print "COPY "
  68.    Locate 5,7 : Print "DELETE"
  69.    Locate 5,9 : Print "RENAME"
  70.    Locate 5,11 : Print "MAKEDIR"
  71.    Locate 5,13 : Print "SHOW ASCII"
  72.    Locate 5,15 : Print "SHOW IFF"
  73.    Locate 5,17 : Print "PARENT"
  74.    Locate 5,19 : Print "DF0:"
  75.    Locate 5,25 : Print "QUIT"
  76.    Box 36,38 To 98,48
  77.    Box 36,54 To 98,64
  78.    Box 36,70 To 108,80
  79.    Box 36,86 To 108,96
  80.    Box 36,102 To 120,112
  81.    Box 36,118 To 108,128
  82.    Box 36,134 To 98,144
  83.    Box 36,150 To 98,160
  84.    Box 36,166 To 98,176
  85.    Box 36,182 To 98,192
  86.    Box 36,198 To 98,208
  87. '
  88. ' CHECK IF SECOND DRIVE OR DRIVES EXISTS!
  89. '
  90.    If Exist("df1:") Then Locate 5,21 : Print "DF1:" : EXNOT=1 : Else EXNOT=0
  91.    Locate 5,23 : Print "PATH:"
  92. '
  93. ' OPEN WINDOWS FOR PRINTING TEXT ABOUT DRIVES ON!  
  94. ' AND SETUP REQUIRED ZONES ON SCREEN FOR INPUT!    
  95. '
  96.    Reserve Zone 15
  97.    Set Zone 1,36,38 To 98,48
  98.    Set Zone 2,36,54 To 98,64
  99.    Set Zone 3,36,70 To 108,80
  100.    Set Zone 4,36,86 To 108,96
  101.    Set Zone 5,36,102 To 120,112
  102.    Set Zone 6,36,118 To 108,128
  103.    Set Zone 7,36,134 To 98,144
  104.    Set Zone 8,36,150 To 98,160
  105.    Set Zone 9,36,166 To 98,176
  106.    Set Zone 10,36,182 To 98,192
  107.    Set Zone 11,133,5 To 600,120
  108.    Set Zone 12,133,125 To 600,230
  109.    Set Zone 13,36,198 To 98,209
  110.    Screen 0
  111.    Locate 5,1 : Print Border$(Zone$("UP",14),1)
  112.    Locate 9,1 : Print Border$(Zone$("DOWN",15),1)
  113.    Locate 5,28 : Print Border$("STORM 1992",1)
  114.    Wind Open 1,130,5,59,15,1
  115.    Wind Open 2,130,125,59,15,1
  116.    Window AX
  117.    Clw 
  118.    Curs Off 
  119. End Proc
  120. Procedure GATOPT
  121. '
  122. ' If an error occurs then switch error detection 
  123. ' To the program so the program can deal with it.  
  124. '
  125. On Error Goto CERROR
  126. BEGIN:
  127. '
  128. ' The Main Loop
  129. '
  130.    Do 
  131. '
  132. ' CHECKS TO SEE IF THE POINTER HAS ENTERED A DEFINED ZONE ON SCREEN! 
  133. ' IF IT HAS AND THE LEFT MOUSE BUTTON IS PRESSED THEN EXECUTE COMMAND! 
  134. '
  135.       QED=Mouse Zone
  136.       If QED=1 and Mouse Key=1 Then C0PYFILES : Screen 0
  137.       If QED=2 and Mouse Key=1 Then DELETE : Screen 0
  138.       If QED=3 and Mouse Key=1 Then AMOSRENAME : Screen 0
  139.       If QED=4 and Mouse Key=1 Then MAKDIR : Screen 0
  140.       If QED=5 and Mouse Key=1 Then TXTPRINT : Screen 0
  141.       If QED=6 and Mouse Key=1 Then PICT : Screen 0
  142.       If QED=7 and Mouse Key=1 Then GUARDIAN : Screen 0
  143.       If QED=8 and Mouse Key=1 Then SDIRDF0 : Screen 0
  144.       If QED=9 and Mouse Key=1 and EXNOT=1 Then SDIRDF1 : Screen 0
  145.       If QED=9 and Mouse Key=1 and EXNOT=0 Then Screen 0
  146.       If QED=10 and Mouse Key=1 Then SDIRPATH : Screen 0
  147.       If QED=11 and Mouse Key=1 Then Window 1 : AX=1 : Screen 0
  148.       If QED=12 and Mouse Key=1 Then Window 2 : AX=2 : Screen 0
  149.       If QED=13 and Mouse Key=1 Then QUIT : Screen 0
  150.       If QED=14 and Mouse Key=1 Then Gosub SCR0LLUP
  151.       If QED=15 and Mouse Key=1 Then Gosub SCR0LLDOWN
  152.       If Key State(76)=True Then Gosub SCR0LLUP
  153.       If Key State(77)=True Then Gosub SCR0LLDOWN
  154.       If Key State(78)=True Then Bell 63
  155.       If Key State(79)=True Then Bell 63
  156.       SW1=COUNT
  157.    Loop 
  158. '
  159. ' If available move up through the list of filenames 
  160. ' In memory
  161. '
  162.    SCR0LLUP:
  163.    If AX=1 Then Window 2
  164.    If AX=2 Then Window 1
  165.    Clw 
  166.    Home : Curs Off 
  167.    If FLAGUP=<0 Then Return 
  168.    FLAGUP=FLAGUP-1
  169.    Print F$(FLAGUP);"<< - CURRENT FILE!"
  170.    Return 
  171. '
  172. ' If available move down through the list of filenames 
  173. ' In memory
  174. '
  175.    SCR0LLDOWN:
  176.    If AX=1 Then Window 2
  177.    If AX=2 Then Window 1
  178.    Clw 
  179.    Home : Curs Off 
  180.    If FLAGUP=>COUNT Then Return 
  181.    FLAGUP=FLAGUP+1
  182.    Print F$(FLAGUP);"<< - CURRENT FILE!"
  183.    Return 
  184. '
  185. ' If an error does occur then zoom to the procedure  
  186. ' For Error Reports! 
  187. '
  188. CERROR:
  189. DISKERROR
  190. Goto BEGIN
  191. End Proc
  192. Procedure SDIRDF0
  193. '
  194. ' Clears windows and sets up dir 
  195. '
  196.    Clw 
  197.    Screen 1 : Pen 2 : Cls 0
  198.    Cls 0 : Locate 0,0 : Print "Listing The Directory!";
  199.    Screen 0 : Pen 2
  200.    Window AX
  201.    CURDR$="df0:" : DRIV=0
  202.    PAT$=Dir$
  203. '
  204. ' check if user has ejected a disk from the drive! 
  205. '
  206.    If Exist(PAT$)=False Then ERRO1 : Pop Proc
  207. '
  208. ' Fetch the first dir using basic  
  209. '
  210.    FILE$=Dir First$(CURDR$)
  211.    COUNT=-1
  212. '
  213. ' Fetch the next until no more filenames are 
  214. ' received from the disk 
  215. '
  216.    While FILE$<>""
  217.       Add COUNT,1
  218. '
  219. ' put filename into a safe memory area 
  220. '
  221.       F$(COUNT)=FILE$
  222. '
  223. ' fetch next filename
  224. '  
  225.       FILE$=Dir Next$
  226.    Wend 
  227. '
  228. ' Retrieve And List from memory all dirsand filenames
  229. '
  230.    For WEARE=0 To COUNT
  231.       Print F$(WEARE)
  232.    Next WEARE
  233.    Screen 1 : Pen 2
  234.    Dir$=CURDR$
  235. '
  236. ' Get current space left on drive from basic 
  237. '
  238.    DISKFREE=Dfree
  239.    Locate 0,0 : Print "SPACE LEFT ON DRIVE 0 is ";DISKFREE;
  240.    Screen 0
  241. End Proc
  242. Procedure SDIRDF1
  243. '
  244. ' This Procedure Does the Same "thing" 
  245. ' As "SDIRDF0" Execpt that it works with the second
  246. ' disk drive.
  247. '
  248.    Clw 
  249.    Screen 1 : Pen 2
  250.    Cls 0 : Locate 0,0 : Print "Listing The Directory!              ";
  251.    Screen 0 : Pen 2
  252.    Window AX
  253.    PAT$=Dir$
  254.    If Exist(PAT$)=False Then ERRO1 : Pop Proc
  255.    CURDR$="df1:" : DRIV=1
  256.    FILE$=Dir First$(CURDR$)
  257.    COUNT=-1
  258.    While FILE$<>""
  259.       Add COUNT,1
  260.       F$(COUNT)=FILE$
  261.       FILE$=Dir Next$
  262.    Wend 
  263.    For WEARE=0 To COUNT
  264.       Print F$(WEARE)
  265.    Next WEARE
  266.    Screen 1 : Pen 2
  267.    Dir$=CURDR$
  268.    DISKFREE=Dfree
  269.    Locate 0,0 : Print "SPACE LEFT ON DRIVE 1 is ";DISKFREE;
  270.    Screen 0
  271. End Proc
  272. Procedure SDIRPATH
  273. '
  274. ' AMOS LOADS MEMORY WITH THE NAME OF ALL THE FILES ON A DISK 
  275. ' BUT STORES THEM ON MEMORY WITH LOTS OF SPACES AND '*' ABOUT
  276. ' THESE HAVE TO BE "TAKEN OUT" IN ORDER FOR AMOS TO READ THE FILE! 
  277. '
  278. ' Check fif disk is still there! 
  279. '
  280.    If Exist(Dir$)=False Then ERRO1 : Pop Proc
  281.    PAT$=Dir$
  282. '
  283. ' LOADS WE$ WITH THE CURRENT FILE NAME IN FULL 
  284. '
  285.    WE$=F$(FLAGUP)
  286. '
  287. ' IDENTIFIES IF ITS A DIRECTORY OR A FILE!   
  288. ' AMOS PUTS AN '*' IN FRONT OF EVERY DIRECTORY 
  289. '
  290.    WERROR$=Mid$(WE$,1,1)
  291.    If WERROR$<>"*" Then ERRO1 : Pop Proc : Screen 0
  292. '
  293. ' GETS THE POSITION IN THE STRING WE$ WHERE A SPACE OCCURS!
  294. ' AND GETS RID OF SPACES TO MAKE A NEW STRING CALLED WE3$  
  295. '
  296.    P=Instr(WE$," ")
  297.    WE3$=Mid$(WE$,2,P-2)
  298. '
  299. ' PATCHES THE CURRENT DRIVE STRING AND THE FILE "TOGETHER" 
  300. ' AND CALLS IT WE5$
  301. '
  302.    WE5$=PAT$+WE3$
  303.    If Exist(WE5$)=False Then ERRO1 : Pop Proc
  304.    Dir$=WE5$
  305.    FILE$=Dir First$(WE5$)
  306.    COUNT=-1
  307. '
  308. ' Clean previous directory From memory 
  309. '
  310.    For ERSE=0 To 200 : F$(ERSE)="" : Next ERSE
  311.    While FILE$<>""
  312.       Add COUNT,1
  313.       F$(COUNT)=FILE$
  314.       FILE$=Dir Next$
  315.    Wend 
  316.    For WEARE=0 To COUNT
  317.       Print F$(WEARE)
  318.    Next WEARE
  319. End Proc
  320. Procedure GUARDIAN
  321. '
  322. ' An unused Procedure fore later development!
  323. '
  324.    Parent 
  325.    Clw 
  326.    If DRIV=0 Then SDIRDF0
  327.    If DRIV=1 Then SDIRDF1
  328. End Proc
  329. Procedure DELETE
  330. '
  331. ' Use the same teqnique to retreieve the filename
  332. ' from main memory 
  333. '
  334.    If DRIV=0 Then CURDR$="df0:"
  335.    If DRIV=1 Then CURDR$="df1:"
  336.    WE$=F$(FLAGUP)
  337.    WERROR$=Mid$(WE$,1,1)
  338.    If WERROR$<>" " Then ERRO1 : Pop Proc : Screen 0
  339.    P=Instr(WE$," ",2)
  340.    WE3$=Mid$(WE$,2,P-2)
  341.    WE5$=PAT$+WE3$
  342.    Paper 1 : Print WE5$ : Paper 1
  343. '
  344. ' get input using requestor procedure
  345. '
  346.    REQ["     ARE YOU SURE ? ","  DELETE "+WE5$+"","CONTINUE","CANCEL"]
  347. '
  348. ' if the user select cancel then return (POP PROC) else continue   
  349. '
  350.    If Z=2 Then Pop Proc
  351. '
  352. ' KILL CHOOSEN FILE    
  353. '
  354. DELETEIT:
  355. '
  356. ' EASY COMMAD COMING HERE! 
  357. '
  358.   If Exist(WE5$)=False Then ERRO1 : Pop Proc
  359. '
  360. ' just make sure the file is there and then delete it. 
  361. '
  362.    Kill WE5$
  363.    Screen 1
  364.    Locate 0,0
  365.    Print "File is deleted!...Check directory to be sure!?";
  366. End Proc
  367. Procedure ERRO1
  368. '
  369. ' Error check type one 
  370. '
  371.    REQ[" ERROR ERROR ERROR ERROR!","   YOU CANT DO THAT!","CONTINUE",""]
  372. End Proc
  373. Procedure ERRO2
  374. '
  375. ' Error Check Type two 
  376. '
  377. Auto View On 
  378.    REQ["  ERROR FORMAT OF FILE IS ","  NOT OF REQUIRED TYPE!","CONTINUE",""]
  379. End Proc
  380. Procedure C0PYFILES
  381. '
  382. ' GET ACTUAL NAME OF FILE AGAIN  
  383. '
  384.    PAT$=Dir$
  385.    If DRIV=0 Then CURDR$="df0:"
  386.    If DRIV=1 Then CURDR$="df1:"
  387.    WE$=F$(FLAGUP)
  388.    WERROR$=Mid$(WE$,1,1)
  389.    If WERROR$<>" " Then ERRO1 : Pop Proc : Screen 0
  390.    P=Instr(WE$," ",2)
  391.    WE3$=Mid$(WE$,2,P-2)
  392.    WE5$=PAT$+WE3$
  393. '
  394.    REQ["     OKAY TO COPY?",WE5$,"CONTINUE"," CANCEL"]
  395. '
  396. '  Check If 2 IS return FROM THE REQ Proc Then End 
  397. '
  398.    If Z=2 Then Pop Proc
  399.    Wait 30
  400.    Screen 1
  401.    Cls 0
  402.    Locate 0,0 : Curs Off 
  403. '
  404. ' now get form the user which drive to copy to...  
  405. '
  406.    REQ["  COPYFILE TO TARGET DRIVE",WE5$,"  DF0:","  DF1:"]
  407. '
  408.    If Z=1 Then PAT$="DF0:" : AN$=PAT$+WE3$
  409.    If Z=2 Then PAT$="DF1:" : AN$=PAT$+WE3$
  410. '
  411. ' COPY THAT FILE MAN!  
  412. '
  413. FLEM:
  414. Screen 1 : Cls 0 : Locate 0,0
  415. Print "Enter path ";PAT$; : Input PAN$
  416. '
  417. '
  418. '
  419.    AN$=PAT$+PAN$+WE3$
  420.    If Exist(WE5$) Then Screen 1 : Cls 0 : Locate 0,0 : Print "Copying ";WE5$;" To ";CURDR$;
  421. '
  422. ' Open the file, get its length(size),close the file 
  423. ' Erase memory bank 5 and then create bank five of required size 
  424. '
  425.    Open In 1,WE5$ : L=Lof(1) : Close 1 : Erase 5 : Reserve As Work 5,L
  426. '
  427. ' Binary Load the file in to Memory bank 5 
  428. '
  429.    Bload WE5$,Start(5)
  430. '
  431. ' Binary Save from memory bank 5 to the new filename 
  432. '
  433.    Bsave AN$,Start(5) To Start(5)+L : Erase 5
  434.    Screen 1 : Cls 0 : Locate 0,0 : Print "Finished Copying....";
  435. End Proc
  436. Procedure AMOSRENAME
  437. '
  438. ' GET ACTUAL NAME OF FILE AGAIN    
  439. '
  440.    PAT$=Dir$
  441.    If DRIV=0 Then CURDR$="df0:"
  442.    If DRIV=1 Then CURDR$="df1:"
  443.    WE$=F$(FLAGUP)
  444.    WERROR$=Mid$(WE$,1,1)
  445.    If WERROR$<>" " Then ERRO1 : Pop Proc : Screen 0
  446.    P=Instr(WE$," ",2)
  447.    WE3$=Mid$(WE$,2,P-2)
  448.    WE5$=WE3$
  449.    Print PAT$+WE5$;" <<- File choosen!"
  450.    Screen 1
  451.    Curs Off 
  452.    Cls 0
  453.    Locate 0,0
  454.    Line Input "ENTER NEW NAME OF CURRENT FILE (exact please!)-";AN$
  455. '
  456. ' Check file and rename to new then exit procedure 
  457. '
  458.    If Exist(PAT$+WE5$) Then Rename PAT$+WE5$ To PAT$+AN$ : Pop Proc
  459. '
  460. ' If procedure is not exited then call error proc 1
  461. '
  462.    ERRO1
  463. End Proc
  464. Procedure MAKDIR
  465.    PAT$=Dir$
  466.    Screen 1
  467.    Curs Off 
  468.    Cls 0
  469.    Locate 0,0
  470. '
  471. ' Get name for new directory 
  472. '
  473.    Line Input "Name of new directory -";AN$
  474. '
  475. ' does it already exist? then POP proc else continue 
  476. '
  477.    If Exist(PAT$+AN$)=True Then Cls 0 : Locate 0,0 : Print "ALREADY ON THE DISK!" : Pop Proc
  478. '
  479. ' Call Mkdir from basic
  480. '
  481.    Mkdir PAT$+AN$
  482.    Cls 0
  483.    Locate 0,0
  484.    Print "DONE !!!...";
  485. End Proc
  486. Procedure PICT
  487.    PAT$=Dir$
  488.    If DRIV=0 Then CURDR$="df0:"
  489.    If DRIV=1 Then CURDR$="df1:"
  490.    WE$=F$(FLAGUP)
  491.    WERROR$=Mid$(WE$,1,1)
  492.    If WERROR$<>" " Then ERRO1 : Pop Proc : Screen 0
  493.    P=Instr(WE$," ",2)
  494.    WE3$=Mid$(WE$,2,P-2)
  495.    WE5$=WE3$
  496.    Print PAT$+WE5$;" <<- File choosen!"
  497.    If Exist(PAT$+WE5$)=False Then Pop Proc
  498. '
  499. ' turns Off amoses automatic viewing for reasons of  
  500. ' tideness 
  501. '
  502.    Auto View Off 
  503. '
  504. ' load and create screen 2 for picture file  
  505. '
  506.    Load Iff PAT$+WE5$,2
  507. '
  508. ' get registors if any for resolution and X,Y of file  
  509. '
  510.    A=Screen Base+72
  511.    SCX=Deek(A+4)
  512.    SCY=Deek(A+6)
  513.    REZ=1
  514.    If Btst(Deek(A),15)
  515.       REZ=2
  516.    End If 
  517. ' get current screen it SHOULD be screen 2 if it is not  
  518. ' then report error otherwise show screen
  519. ' sorry for natty little goto!(structured programs hurrah!)  
  520. ' the program falls over if i dont do this! wierd! 
  521.    S=Screen
  522.    If S=0 Then Screen Hide S : ERRO2 : Pop Proc
  523.    If S=1 Then Screen Hide S : ERRO2 : Pop Proc
  524.    If S=2 Then Goto VEW
  525.    VEW:
  526.    Screen To Front 2
  527.    Auto View On 
  528.    View 
  529. '
  530. ' wait until users had enough and then close screen to svae memory 
  531. ' and exit procedure.
  532. ' infinte loop until mouse button is pushed  
  533. '  
  534.    Repeat 
  535.    Until Mouse Key=1
  536.    Screen Close 2
  537.    Screen 0
  538. End Proc
  539. Procedure TXTPRINT
  540. '
  541. ' GET ACTUAL NAME OF FILE AGAIN  
  542. '
  543. '   PAT$=Dir$
  544.    If DRIV=0 Then CURDR$="df0:"
  545.    If DRIV=1 Then CURDR$="df1:"
  546.    WE$=F$(FLAGUP)
  547.    WERROR$=Mid$(WE$,1,1)
  548.    If WERROR$<>" " Then ERRO1 : Pop Proc : Screen 0
  549.    P=Instr(WE$," ",2)
  550.    WE3$=Mid$(WE$,2,P-2)
  551.    WE5$=WE3$
  552.    Print WE5$;" <<- File choosen!"
  553. '
  554. ' Open a HIRES screen for text file  
  555. '
  556.    Screen Open 2,640,256,4,Hires
  557.    Curs Off : Pen 2 : Paper 0 : Flash Off : Cls 0
  558.    Home 
  559. '
  560. ' Open file for output 
  561. '
  562.    Open In 1,WE5$
  563. '
  564. ' get length of choosen file 
  565. '
  566. LGTH=Lof(1)
  567. CNT=0 : TAL=0
  568. '
  569. CHAR$=""
  570. '
  571. Repeat 
  572.    Add CNT,1 : Add TAL,1
  573. '
  574. ' get first character from file
  575. '
  576.       CHAR$=Input$(1,1)
  577.    AI=Asc(CHAR$)
  578. If AI=>128 Then DISKERROR : Screen Close 2 : Close 1 : Pop Proc
  579. '
  580. ' get cursor position on screen so as to prevent the text  
  581. ' disapearing before its read! 
  582. '
  583.    YC=Y Curs : XC=X Curs
  584. '
  585. '  The following lines check for control characters
  586. '  in the ASCII file 
  587. '  if a carraige return (ASCII = 13) is detected then print a new line 
  588. '
  589.   If CHAR$=Chr$(13) Then Print ""; : Locate 0,
  590. '
  591. '  now check for end of line character (10)  
  592. '
  593.    If CHAR$=Chr$(10) Then Print ""; : Locate 0,
  594. '
  595. '  and now a check for a tab character (9) 
  596. '
  597.    If CHAR$=Chr$(9) Then Print Tab$
  598. '
  599. ' if the bottom of screen is reached 
  600. ' dont scroll! instead wait for the user to push 
  601. ' mouse button before proceeding.  
  602. '
  603.    If YC=>29 Then Gosub NXTPAGE : CNT=0
  604.       Print CHAR$;
  605.    CHAR$=""
  606. Until TAL=LGTH
  607. '
  608. ' Finished reading text
  609. '
  610. Locate 0,29 : Inverse On : Print "press mouse to continue"
  611. Inverse Off 
  612. Repeat 
  613. Until Mouse Key=1
  614. Screen Close 2
  615. Close 1
  616. Screen 0
  617. Pop Proc
  618. '
  619. ' Waits for user to read file and
  620. ' Clears screen for some more text   
  621. '  
  622. NXTPAGE:
  623. Locate 0,29 : Inverse On : Print "press mouse for next page"
  624. Inverse Off 
  625. Repeat 
  626. Until Mouse Key=1
  627. Cls 0
  628. Home 
  629. Return 
  630. End Proc
  631. Procedure QUIT
  632. '
  633. ' first check if they want to quit or not
  634. '
  635.   Screen 1
  636.    Cls 0
  637.    Locate 0,0
  638. '
  639. ' get input using the requestor procedure
  640. '
  641.    REQ["  ARE YOU SURE YOU WANT TO QUIT? ","","CONTINUE","CANCEL"]
  642. '
  643. ' If the user select cancel then return (POP PROC) else continue   
  644. '
  645.    If Z=2 Then Pop Proc
  646. '
  647. '
  648.    CLEARUPSYSTEM:
  649. '
  650. ' Clear message text and say byebye! 
  651. '
  652.   Cls 0
  653.    Print "Thanx For using ADHDOS!... Ejber Ozkan @1991";
  654. '
  655. ' Wait a bit for end message to be read
  656. '
  657.    For I=0 To 100 : Wait Vbl : Next I
  658. '
  659. ' End program here 
  660. '
  661.    Screen Close 0
  662.    Screen Close 1
  663.    End 
  664. End Proc
  665. Procedure DISKERROR
  666. ERR=Errn
  667. REQ["OH NO! MAJOR ERROR REPORT","ERROR NO"+Str$(ERR)+"","CONTINUE","CONTINUE"]
  668. End Proc
  669. ' Requester Procedure v1 Amiga Shopper 
  670. Procedure REQ[T1$,T2$,B1$,B2$]
  671. Shared Z
  672. '
  673. ' opens a nice new screen on top of old screen 
  674. '
  675. Screen Open 7,640,60,4,Hires
  676. Screen Display 7,130,110,,
  677. Screen To Front 7
  678. Screen 7
  679. Limit Mouse 215,110 To 350,155
  680. Show 
  681. Flash Off 
  682. Paper 0 : Cls : Curs Off 
  683. Palette $0,$444,$777,$FFF
  684. View 
  685. Reserve Zone 2
  686. '
  687. ' checks to see if the text is longer than 33 characters 
  688. ' so that it can print it in the boxe without OVERFLOW 
  689. '
  690. If Len(T1$)>33 Then T1$=Left$(T1$,33)
  691. If Len(T2$)>33 Then T2$=Left$(T2$,33)
  692. If Len(B1$)>8 Then B1$=Left$(B1$,8)
  693. If Len(B2$)>8 Then B2$=Left$(B2$,8)
  694. '
  695. ' draws pretty boxs to write on! 
  696. '
  697. Ink 1 : Bar 170,0 To 470,52
  698. Ink 3 : Bar 171,1 To 470,59
  699. Ink 2 : Bar 171,1 To 468,58
  700. Ink 0 : Box 180,10 To 458,30
  701. Ink 3 : Draw 180,30 To 458,30
  702. Ink 3 : Draw 458,30 To 458,10
  703. If Len(B1$)>0
  704. Ink 3 : Box 200,37 To 270,52
  705. Ink 0 : Draw 200,52 To 270,52
  706. Ink 0 : Draw 270,52 To 270,37
  707. End If 
  708. If Len(B2$)>0
  709. Ink 3 : Box 360,37 To 430,52
  710. Ink 0 : Draw 360,52 To 430,52
  711. Ink 0 : Draw 430,52 To 430,37
  712. End If 
  713. Ink 0,2
  714. '
  715. ' Prints text required from the params 
  716. '
  717. Text 184,19,T1$
  718. Text 184,27,T2$
  719. Text 204,47,B1$
  720. Text 364,47,B2$
  721. '
  722. ' Sets up zones for mouse input  
  723. '
  724. If Len(B1$)>0 Then Set Zone 1,200,37 To 270,52
  725. If Len(B2$)>0 Then Set Zone 2,360,37 To 430,52
  726. '
  727. ' Repeats loop below until the user selects an option    
  728. '
  729. Screen To Front 7
  730. Do 
  731. Z=Mouse Zone
  732. If Z=1 and Mouse Key=1 Then Ink 0 : Box 200,37 To 270,52 : Ink 3 : Draw 200,52 To 270,52 : Ink 3 : Draw 270,52 To 270,37 : Wait 10 : Screen Close 7 : Screen 0 : Limit Mouse : Pop Proc
  733. If Z=2 and Mouse Key=1 Then Ink 0 : Box 360,37 To 430,52 : Ink 3 : Draw 360,52 To 430,52 : Ink 3 : Draw 430,52 To 430,37 : Wait 10 : Screen Close 7 : Screen 0 : Limit Mouse : Pop Proc
  734. Loop 
  735. End Proc