home *** CD-ROM | disk | FTP | other *** search
/ The CIA World Factbook 1992 / k3bimage.iso / sel / 09 / 0009 / hdircols.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1991-12-02  |  3.6 KB  |  101 lines
  1. 10  REM
  2. 20  REM   ***  (c) Copyright 1987 by Robert Woeger.  All rights reserved. ***
  3. 30  REM   ***  This program allows you to modify HDIR.COM to your favorite***
  4. 40  REM   ***  colors.  HDIR.COM must be in the current drive/directory.  ***
  5. 50  REM   ***  It will produce a file called H.COM which is the modified  ***
  6. 60  REM   ***  version of HotDIR.  Simply delete the old HDIR.COM and     ***
  7. 70  REM   ***  rename H.COM to HDIR.COM to get the updated version.       ***
  8. 80  REM   ***  You may modify this HDIRCOLS.BAS program to meet your      ***
  9. 90  REM   ***  customization needs.  This program was written to do the   ***
  10. 100  REM  ***  job of color customization of HotDIR in a fairly quick and ***
  11. 110  REM  ***  dirty fashion.  We are providing the BASIC source code so  ***
  12. 120  REM  ***  you can modify it and hopefully improve it.  We are having ***
  13. 130  REM  ***  a contest!  We are looking for a better HDIRCOLS.BAS!  If  ***
  14. 140  REM  ***  you have written a new or modified HDIRCOLS.BAS, please    ***
  15. 150  REM  ***  submit your program and we may use it in our next release  ***
  16. 160  REM  ***  of the Xanadu Utilities.  We will give you credit in the   ***
  17. 170  REM  ***  Xanadu Utilities documentation if we choose your program.  ***
  18. 180  REM  ***  Send to Rob Woeger, 911 Enfield St., Bryan, TX 77802.      ***
  19. 190  REM
  20. 200  KEY OFF:CLEAR 5000:DIM CL$(16)
  21. 210  FOR I=0 TO 15:READ CL$(I):NEXT I
  22. 220  OPEN "R",1,"HDIR.COM",128
  23. 230  OPEN "R",2,"H.COM",128
  24. 240  FIELD #1,128 AS A$
  25. 250  FIELD #2,128 AS B$
  26. 260  TOTAL = LOF(1):TOTAL = TOTAL/128+1
  27. 270  GET #1,1
  28. 280  LSET B$=A$
  29. 290  PUT #2,1
  30. 300  GET #1,2
  31. 310  C$=A$
  32. 320  CLS
  33. 330  PRINT"HotDIR Color Customization Program for HotDIR Version 2.1 Only."
  34. 340  PRINT
  35. 350  PRINT "Your current file extensions/colors are:"
  36. 360  PRINT
  37. 370  FOR I=1 TO 30
  38. 380  IF (I)/2=INT((I)/2) THEN PRINT TAB(40);
  39. 390  D$=MID$(C$,4*(I-1)+2,4)
  40. 400  IF LEFT$(D$,1)=CHR$(0) OR LEFT$(D$,1)="?" THEN 450
  41. 410  PRINT LEFT$(D$,3);" is ";
  42. 420  GOSUB 940
  43. 430  IF I/2=INT(I/2) THEN PRINT
  44. 440  NEXT I
  45. 450  PRINT:PRINT"Would you like to A)dd a new extension/color"
  46. 460  PRINT      "               or M)odify an existing extension/color"
  47. 470  PRINT      "               or S)ave the updated HotDIR? ";
  48. 480  LAST = I : REM * Save location of last empty extension *
  49. 490  LINE INPUT Q$
  50. 500  IF LEN(Q$)<>1 THEN 320
  51. 510  IF Q$="s" OR Q$="S" THEN 550
  52. 520  IF Q$="m" OR Q$="M" THEN 640
  53. 530  IF Q$="a" OR Q$="A" THEN 820
  54. 540  GOTO 320
  55. 550  REM * Save the entire HDIR.COM file and include modified sector, if any *
  56. 560  LSET B$=C$
  57. 570  PUT #2,2
  58. 580  FOR I=3 TO TOTAL
  59. 590  GET #1,I
  60. 600  LSET B$=A$
  61. 610  PUT #2,I
  62. 620  NEXT I
  63. 630  GOTO 930
  64. 640  REM * Modify an existing extension/color pair *
  65. 650  PRINT:PRINT"What extension would you like to modify";
  66. 660  INPUT N$
  67. 670  FOR I=1 TO 30
  68. 680  G$=MID$(C$,4*(I-1)+2,4):H$=LEFT$(G$,3)
  69. 690  IF H$<>N$ THEN NEXT I
  70. 700  IF H$<>N$ THEN PRINT:PRINT"Extension not found!  Hit enter to return to main menu.":LINE INPUT N$:GOTO 320
  71. 710  REM * Extension found - let's modify it if they want to *
  72. 720  PRINT"Extension: ";H$;" is currently ";
  73. 730  D$=G$:GOSUB 940
  74. 740  PRINT "."
  75. 750  PRINT"Enter new color number (0-15 recommended)";
  76. 760  C=-1
  77. 770  INPUT C
  78. 780  IF C=-1 THEN 810
  79. 790  IF C<0 OR C>255 THEN PRINT:PRINT"Invalid value (Must be 0-255).":GOTO 710
  80. 800  MID$(C$,4*(I-1)+2,4) = H$ + CHR$(C)
  81. 810  GOTO 320
  82. 820  REM * Add a new extension and color *
  83. 830  IF LAST >29 THEN PRINT:PRINT"Sorry, all extension slots are full.  Can't add a new one.:?"HIT ENTER TO CONTINUE.":line input q$:goto 90
  84. 840  PRINT:PRINT"What is the extension name you want to add";
  85. 850  INPUT E$
  86. 860  IF LEN(E$)=0 OR LEN(E$)>3 THEN GOTO 840
  87. 870  PRINT"What color for ";E$;" (Enter a color number between 0 and 255)";
  88. 880  INPUT C
  89. 890  IF C<0 OR C>255 THEN PRINT:PRINT"Invalid color value (Must be 0-255).":GOTO 870
  90. 900  MID$(C$,4*(LAST-1)+2,3) = E$
  91. 910  MID$(C$,4*(LAST-1)+5,1) = CHR$(C)
  92. 920  GOTO 320
  93. 930  END
  94. 940  A=ASC(RIGHT$(D$,1))
  95. 950  IF A<0 OR A>15 THEN PRINT "Color #";A;:GOTO 970
  96. 960  PRINT CL$(A);
  97. 970  RETURN
  98. 980  DATA "Black","Blue","Green","Cyan","Red","Magenta","Brown","White"
  99. 990  DATA "Gray","Light Blue","Light Green","Light Cyan","Light Red"
  100. 1000  DATA "Light Magenta","Yellow","Hi-intensity White"
  101.