home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / STFORMAT / STF04.MSA / 2ND_SIDE_GFADEMOS_FORMAT.LST < prev    next >
File List  |  1989-09-27  |  9KB  |  284 lines
  1. ' ******************************************************************
  2. ' *                                                                *
  3. ' *                          FORMAT.LST                            *
  4. ' *                                                                *
  5. ' *                Written for ST FORMAT MAGAZINE                  *
  6. ' *                                                                *
  7. ' *          This program will run in GFA Basic V2 or V3           *
  8. ' *                                                                *
  9. ' *                                                                *
  10. ' ******************************************************************
  11. '
  12. '     This program formats a floppy disk, in drive A or B
  13. '     Single or double sided, standard tracks and sectors.
  14. '
  15. Dim Strip$(50)                  ! Set up space for the menu
  16. While A$<>"**"
  17.   Read A$                       ! Read data into the menu Strip$
  18.   Strip$(I%)=A$
  19.   Inc I%
  20. Wend
  21. Data " Desk  "," About Me ",---------------,1,2,3,4,5,6,""
  22. Data " File ","  Format Disk ","  Dive A ","  Drive B ","  Ssided ","  Dsided "
  23. Data ---------------,"  Quit ","",""
  24. Data **
  25. '
  26. Menu Strip$()                   ! put the menu on the screen
  27. On Menu  Gosub Evaluate_menu     ! turn on menu processing to go to the procedure
  28. '                               ! evaluate_menu, when you choose a menu entry
  29. Menu 12,1               ! set default to drive A
  30. Sides%=1                ! Single sided
  31. Menu 14,1               ! put a tick in front of menu items to indicate pre-selected
  32. '
  33. Do
  34.   On Menu               ! this is our program, sit in a loop, allowing the menu
  35. Loop                    ! to do all the work
  36. '
  37. Procedure Evaluate_menu         ! this procedure handles the menu events
  38.   Menu Off              ! turn menu back to white whilst processing command
  39.   Let Selected%=Menu(0) ! have to use LET here for V3 otherwise the editor splits it up into SELECT ed%
  40.   If Strip$(Selected%)=" About Me "
  41.     @Show_info          ! you selected About Me - process command
  42.   Endif
  43.   If Strip$(Selected%)="  Format Disk "
  44.     @Format_routine(Sides%,Drive%)     ! format disk. sides=1 or 2, drive=0 or 1
  45.   Endif                                ! pass these parameters to the procedure.
  46.   If Selected%=12 Or Selected%=13
  47.     @Change_disk                ! change disk drive
  48.   Endif
  49.   If Selected%=14 Or Selected%=15
  50.     @Change_sides               ! change number of sides
  51.   Endif
  52.   If Strip$(Selected%)="  Quit "
  53.     Menu Kill
  54.     End                         ! all done, kill menu and return to Basic
  55.   Endif
  56. Return
  57. '
  58. Procedure Change_disk   ! change default drive
  59.   If Drive%=0           !0=A
  60.     Drive%=1            !1=B
  61.     Menu 12,0           ! change ticks in menu from drive A to B
  62.     Menu 13,1
  63.   Else
  64.     Drive%=0
  65.     Menu 12,1
  66.     Menu 13,0
  67.   Endif
  68. Return
  69. '
  70. Procedure Change_sides  ! change default sides from 1 to 2
  71.   If Sides%=1
  72.     Sides%=2
  73.     Menu 14,0           ! menu 14 is Ssided (try Print Strip$(14) )
  74.     Menu 15,1
  75.   Else
  76.     Sides%=1
  77.     Menu 14,1           ! 1 places a tick in front of an entry
  78.     Menu 15,0           ! 0 removes the tick
  79.   Endif
  80. Return
  81. '
  82. Procedure Show_info     ! all about who wrote this wonderful program
  83.   Sget Temp$            ! get the screen into a temporary string
  84.   Rez%=Xbios(4)         ! get screen resolution
  85.   If Rez%=0             ! low res
  86.     Screen_x_max%=300   ! get the maximum screen sizes for each resolution
  87.     Screen_y_max%=200
  88.   Endif
  89.   If Rez%=1             ! medium res
  90.     Screen_x_max%=600
  91.     Screen_y_max%=200
  92.   Endif
  93.   If Rez%=2             ! high res
  94.     Screen_x_max%=600
  95.     Screen_y_max%=400
  96.   Endif
  97.   Center_of_screen_x%=Screen_x_max%/2   !get center of the screen
  98.   Center_of_screen_y%=Screen_y_max%/2
  99.   '
  100.   ' draw an expanding box, from the center of the screen
  101.   ' start size is 0, end size is 80*50 pixels
  102.   Dpoke Gintin,Center_of_screen_x%
  103.   Dpoke Gintin+2,Center_of_screen_y%
  104.   Dpoke Gintin+4,0
  105.   Dpoke Gintin+6,0
  106.   Dpoke Gintin+8,Center_of_screen_x%-80
  107.   Dpoke Gintin+10,Center_of_screen_y%-50
  108.   Dpoke Gintin+12,160
  109.   Dpoke Gintin+14,100
  110.   Gemsys 73  ! AES call - GRAF_GROWBOX
  111.   '
  112.   ' V3 Basic users could use the following call instead of all the DPOKE commands
  113.   ' ~GRAF_GROWBOX(center_of_screen_x%,center_of_screen_y%,0,0,center_of_screen_x%-80,center_of_screen_y%-50,160,100)
  114.   '
  115.   ' now draw a box, where the expanding box grew to.
  116.   Box Center_of_screen_x%-80,Center_of_screen_y%-50,Center_of_screen_x%+80,Center_of_screen_y%+50
  117.   '
  118.   ' next put our message in the box
  119.   Text Center_of_screen_x%-70,Center_of_screen_y%-34,"  I wrote this"
  120.   Text Center_of_screen_x%-70,Center_of_screen_y%-18," Press any Mouse"
  121.   Text Center_of_screen_x%-70,Center_of_screen_y%-2,"    Button to"
  122.   Text Center_of_screen_x%-70,Center_of_screen_y%+14,"     Carry on"
  123.   '
  124.   Repeat
  125.   Until Mousek  ! wait until a mouse button is pressed
  126.   '
  127.   Sput Temp$    ! restore the original screen
  128. Return          ! and return
  129. '
  130. Procedure Format_routine(Side%,Dev)     ! the parameters were passed to this routine
  131.   '
  132.   Sub Side%,1                   ! side needs to be 0 or 1 for the format routine
  133.   '
  134.   Dim V_buf%(8192/4)            ! set aside 8K of buffer space
  135.   Buf=Varptr(V_buf%(0))         ! buf is the address of the start of this buffer area
  136.   '
  137.   Defmouse 0
  138.   ' CHR$65 + drive% = either A or B
  139.   Al$="INSERT DISK TO FORMAT|INTO DISK DRIVE "+Chr$(65+Drive%)
  140.   Alert 1,Al$,2," DONE |CANCEL",V%
  141.   If V%=2
  142.     Goto Dend   !if you pressed on Cancel, don't do the format
  143.   Endif
  144.   '
  145.   ' if single sided format
  146.   If Side%=0
  147.     For I%=0 To 79      ! loop, formatting from track 0 to track 79
  148.       Print At(2,3);"Formatting Track ";I%;"  "
  149.       '
  150.       ' Xbios 10 does the format and returns an error code - 0 = no error
  151.       ' buf= buffer address
  152.       ' dev=device   0=A 1=B
  153.       ' 9 sectors per track
  154.       ' i%=track number
  155.       ' 0=side
  156.       ' 1=interleave
  157.       ' &h87654321=a magic number
  158.       ' &he5e5=what to format onto the disk
  159.       '
  160.       A=Xbios(10,L:Buf,L:0,Dev,9,I%,0,1,L:&H87654321,&HE5E5)
  161.       '
  162.       Gosub Errorcheck  ! check for an error
  163.       '
  164.       Exit If Abort     ! exit if a fatal error
  165.       '
  166.       Exit If Mousek And 2      ! also exit if right mouse button is pressed
  167.       '
  168.     Next I%     ! next track
  169.   Endif
  170.   '
  171.   ' if double sided format
  172.   If Side%=1
  173.     For I%=0 To 79
  174.       Print At(2,3);"Formatting Track ";I%;"  Side ";Side%-1;"  "
  175.       ' format side 0
  176.       A=Xbios(10,L:Buf,L:0,Dev,9,I%,Side%-1,1,L:&H87654321,&HE5E5)
  177.       Gosub Errorcheck
  178.       Exit If Abort
  179.       Exit If Mousek And 2
  180.       Print At(2,3);"Formatting Track ";I%;"  Side ";Side%;"  "
  181.       ' format side 1
  182.       A=Xbios(10,L:Buf,L:0,Dev,9,I%,Side%,1,L:&H87654321,&HE5E5)
  183.       Gosub Errorcheck
  184.       Exit If Abort
  185.     Next I%
  186.   Endif
  187.   '
  188.   If Mousek And 2
  189.     Goto Dend      ! abort format, pressed right mouse button
  190.   Endif
  191.   '
  192.   If Abort         ! error - abort
  193.     Goto Dend
  194.   Endif
  195.   '
  196.   For N%=Buf To Buf+(9*512)     ! clear the buffer
  197.     Poke N%,0          ! enough space for 9 sectors (512 bytes per sector)
  198.   Next N%
  199.   '
  200.   ' write 0's to the first 9 sectors of the disk
  201.   A=Xbios(9,L:Buf,L:0,Dev,1,0,0,9)
  202.   Gosub Errorcheck
  203.   '
  204.   If Side%=2
  205.     Type=3
  206.   Else
  207.     Type=2
  208.   Endif
  209.   ' produce a boot sector
  210.   ' this tells the disk what type it is
  211.   Void Xbios(18,L:Buf,L:&H1000000,Type,0)
  212.   '
  213.   ' write boot sector to disk
  214.   Se=((Side%+1)*(79+1))*9
  215.   Poke Buf+19,Se-256*Int(Se/256)
  216.   Poke Buf+20,Int(Se/256)
  217.   Poke Buf+24,9
  218.   Poke Buf+26,Side%+1
  219.   Print At(2,3);"Writing Boot Sector to Disk  "
  220.   A=Xbios(9,L:Buf,L:0,Dev,1,0,0,1)
  221.   '
  222.   If A=0            ! no error in writing boot sector
  223.     Df=Dfree(Dev+1)
  224.     Df$="|     | DISK FORMATTED OK|BYTES FREE - "+Str$(Df)
  225.     Defmouse 0
  226.     Alert 1,Df$,1,"THANKS!",B
  227.   Endif
  228.   '
  229.   Dend: !come here directly if error, or mouse pressed
  230.   '
  231.   If Abort  ! yes we had an error
  232.     Print At(2,3);"You had an error on Track ";I%
  233.     Out 2,7     ! ping
  234.     Pause 40
  235.   Endif
  236.   '
  237.   Erase V_buf%()                !clear the buffer
  238.   Print At(2,3);Space$(37)      ! clear our report messages
  239.   '
  240. Return  ! all done
  241. '
  242. Procedure Errorcheck    ! check for errors, error message in variable a
  243.   Abort=False           ! reset abort
  244.   '
  245.   If A=0                ! no error
  246.     Goto Errend
  247.   Endif
  248.   '
  249.   Er2$=" UNDETERMINED FAULT"    ! default message
  250.   '
  251.   ' TOS errors
  252.   If A=-2
  253.     Er2$="  DRIVE  NOT READY"
  254.   Endif
  255.   '
  256.   If A=-6
  257.     Er2$="  NO DISK IN DRIVE"
  258.   Endif
  259.   '
  260.   If A=-10
  261.     Er2$="    WRITE  ERROR"
  262.   Endif
  263.   '
  264.   If A=-11
  265.     Er2$="     READ ERROR"
  266.   Endif
  267.   '
  268.   If A=-13
  269.     Er2$="  WRITE  PROTECTED"
  270.   Endif
  271.   '
  272.   If A=-16
  273.     Er2$="  WRONG DRIVE TYPE"
  274.   Endif
  275.   '
  276.   Er1$=Er2$+" |  | DISK NOT FORMATTED|"
  277.   Defmouse 0
  278.   Alert 1,Er1$,1,"OK !",B
  279.   '
  280.   Abort=True    !yes we had an error
  281.   '
  282.   Errend:       !if you came directly here, then no error was detected
  283. Return
  284.