home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b002 / 3.ddi / NEWMODS.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-03-10  |  9.1 KB  |  296 lines
  1. DECLARE SUB create.new.documentation.file ()
  2. DECLARE SUB read.documentation.file ()
  3. DECLARE SUB read.env.file ()
  4. REM QBasic program shell
  5.  
  6. COMMON SHARED ref.units$, val.units$, title$, ref.system$, flag.defn$
  7. COMMON SHARED val.recs&, rows&, cols&, legend%, data.format%, geo.type%
  8. COMMON SHARED old.data.type%, old.file.type%
  9. COMMON SHARED new.data.type%, new.file.type%
  10. COMMON SHARED wxmin!, wxmax!, wymin!, wymax!, unit.dist!
  11. COMMON SHARED flag.value!, resolution!, cellx!, celly!
  12. COMMON SHARED posn.error!, val.error!, min!, max!
  13. COMMON SHARED path$
  14. COMMON SHARED digi.port$, plot.port$, prn.port$
  15. COMMON SHARED drive$, units$
  16. COMMON SHARED old.image$, new.image$
  17. COMMON SHARED image.docfile.extension$
  18. COMMON SHARED image.file.extension$
  19. COMMON SHARED vector.docfile.extension$
  20. COMMON SHARED vector.file.extension$
  21. COMMON SHARED values.docfile.extension$
  22. COMMON SHARED values.file.extension$
  23. COMMON SHARED posn.error.flag%, resolution.flag%
  24. COMMON SHARED val.error.flag%, flag.flag%
  25.          
  26. DIM SHARED legend.text$(255)
  27.  
  28. REM ***************************************************************************
  29.  
  30.  
  31.     REM main program goes here
  32.  
  33.               
  34. REM ***************************************************************************
  35. REM this program contains three subroutines - to see them in the qbasic
  36. REM interpreted environment, choose VIEW from the menu bar, and choose
  37. REM SUBs from the displayed menu. A list of subroutines associated with this
  38. REM program will be displayed.
  39. REM ***************************************************************************
  40.  
  41. SUB create.new.documentation.file
  42. REM ***************************************************************************
  43.  
  44.   docname$ = drive$ + path$ + new.image$ + image.docfile.extension$
  45.   OPEN docname$ FOR OUTPUT AS #10
  46.     
  47.   IF ((new.data.type% = 0) AND (new.file.type% = 1)) THEN new.data.type% = 2
  48.  
  49.   PRINT #10, "file title  : ", title$
  50.  
  51.   SELECT CASE new.data.type%
  52.   CASE 0
  53.     PRINT #10, "data type   : integer"
  54.   CASE 1
  55.     PRINT #10, "data type   : real"
  56.   CASE 2
  57.     PRINT #10, "data type   : byte"
  58.   END SELECT
  59.  
  60.   SELECT CASE new.file.type%
  61.   CASE 0
  62.     PRINT #10, "file type   : ascii"
  63.   CASE 1
  64.     PRINT #10, "file type   : binary"
  65.   CASE 2
  66.     PRINT #10, "file type   : packed binary"
  67.   END SELECT
  68.  
  69.   PRINT #10, "columns     :"; cols&
  70.   PRINT #10, "rows        :"; rows&
  71.  
  72.   PRINT #10, "ref. system : "; ref.system$
  73.   PRINT #10, "ref. units  : "; ref.units$
  74.  
  75.   REM *** note that both ref.system$ and ref.units$ MUST be in LOWER CASE ***
  76.  
  77.   PRINT #10, "unit dist.  :"; unit.dist!
  78.   PRINT #10, "min. X      :"; wxmin!
  79.   PRINT #10, "max. X      :"; wxmax!
  80.   PRINT #10, "min. Y      :"; wymin!
  81.   PRINT #10, "max. Y      :"; wymax!
  82.  
  83.   IF posn.error.flag% THEN PRINT #10, "pos'n error : "; posn.error! ELSE PRINT #10, "pos'n error : unknown"
  84.   IF resolution.flag% THEN PRINT #10, "resolution  :"; resolution! ELSE PRINT #10, "resolution  : unknown"
  85.   IF new.data.type% = 1 THEN PRINT #10, "min. value  :"; min! ELSE PRINT #10, "min. value  :"; min!
  86.   IF new.data.type% = 1 THEN PRINT #10, "max. value  :"; max! ELSE PRINT #10, "max. value  :"; max!
  87.   IF val.units$ = "" THEN PRINT #10, "value units : unspecified" ELSE PRINT #10, "value units : "; val.units$
  88.  
  89.   REM *** note that val.units$ MUST be in LOWER SELECT CASE ***
  90.  
  91.   IF NOT val.error.flag% THEN PRINT #10, "value error : unknown" ELSE PRINT #10, "value error : "; val.error!; ""
  92.  
  93.   IF NOT flag.flag% THEN
  94.         PRINT #10, "flag value  : none"
  95.     ELSEIF new.data.type% = 1 THEN
  96.         PRINT #10, "flag value  :"; flag.value!
  97.     ELSE
  98.         PRINT #10, "flag value  :"; flag.value!
  99.     END IF
  100.  
  101.   IF flag.defn$ = "" THEN PRINT #10, "flag def'n  : none" ELSE PRINT #10, "flag def'n  : "; flag.defn$
  102.  
  103.   PRINT #10, "legend cats :"; legend%
  104.  
  105.   IF legend% <> 0 THEN
  106.     IF legend% > 255 THEN legend% = 255
  107.     FOR i = 0 TO (legend% - 1) STEP 1
  108.       temp$ = LEFT$(("category " + STR$(i)), 13) + ": " + legend.text$(i)
  109.       PRINT #10, temp$
  110.       NEXT
  111.     END IF
  112.  
  113.   CLOSE #10
  114. REM ***************************************************************************
  115.  
  116. END SUB
  117.  
  118. SUB read.documentation.file
  119. REM ***************************************************************************
  120.  
  121.  
  122.   docname$ = drive$ + path$ + old.image$ + image.docfile.extension$
  123.   OPEN docname$ FOR INPUT AS #15
  124.  
  125.   INPUT #15, temp$
  126.     title$ = RIGHT$(temp$, (LEN(temp$) - 14))
  127.   INPUT #15, temp$
  128.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  129.  
  130.   IF LEFT$(temp$, 7) = "integer" THEN
  131.         old.data.type% = 0
  132.   ELSEIF LEFT$(temp$, 4) = "real" THEN
  133.         old.data.type% = 1
  134.   ELSEIF LEFT$(temp$, 4) = "byte" THEN
  135.         old.data.type% = 2
  136.   ELSEIF LEFT$(temp$, 4) = "word" THEN
  137.         old.data.type% = 3
  138.   ELSE old.data.type% = 999
  139.   END IF
  140.        
  141.   IF old.data.type% > 3 THEN
  142.     PRINT "Error : The "; temp$; " data type is not supported by this module"
  143.     STOP
  144.     END IF
  145.  
  146.   INPUT #15, temp$
  147.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  148.   IF LEFT$(temp$, 5) = "ascii" THEN
  149.         old.file.type% = 0
  150.   ELSEIF LEFT$(temp$, 6) = "binary" THEN
  151.         old.file.type% = 1
  152.   ELSEIF LEFT$(temp$, 13) = "packed binary" THEN
  153.         old.file.type% = 1
  154.   ELSE old.file.type% = 999
  155.   END IF
  156.  
  157.   IF old.file.type% > 1 THEN
  158.     PRINT "Error : The ", temp$, " file type is not supported by this module"
  159.     STOP
  160.     END IF
  161.  
  162.   INPUT #15, temp$
  163.     cols& = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  164.   INPUT #15, temp$
  165.     rows& = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  166.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  167.   INPUT #15, temp$
  168.     ref.system$ = RIGHT$(temp$, (LEN(temp$) - 14))
  169.  
  170.   INPUT #15, temp$
  171.   temp$ = UCASE$(temp$)
  172.  
  173.   IF temp$ = "M" OR temp$ = "FT" OR temp$ = "MI" OR temp$ = "KM" OR temp$ = "DEG" OR temp$ = "RAD" THEN ref.units$ = temp$
  174.  
  175.   INPUT #15, temp$
  176.     unit.dist! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  177.   INPUT #15, temp$
  178.     wxmin! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  179.   INPUT #15, temp$
  180.     wxmax! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  181.   INPUT #15, temp$
  182.     wymin! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  183.   INPUT #15, temp$
  184.     wymax! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  185.   cellx! = (wxmax! - wxmin!) / cols&
  186.   celly! = (wymax! - wymin!) / rows&
  187.  
  188.   INPUT #15, temp$
  189.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  190.     posn.error.flag% = false
  191.     posn.error! = 0
  192.  
  193.     temp$ = RTRIM$(temp$)
  194.     posn.error! = VAL(temp$)
  195.     IF posn.error! <> 0 THEN posn.error.flag% = true
  196.  
  197.   INPUT #15, temp$
  198.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  199.     resolution.flag% = false
  200.     resolution! = 0
  201.     
  202.     temp$ = RTRIM$(temp$)
  203.     resolution! = VAL(temp$)
  204.     IF resolution! <> 0 THEN resolution.flag% = true
  205.  
  206.   INPUT #15, temp$
  207.     min! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  208.   INPUT #15, temp$
  209.     max! = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  210.   INPUT #15, temp$
  211.     val.units$ = RIGHT$(temp$, (LEN(temp$) - 14))
  212.  
  213.   INPUT #15, temp$
  214.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  215.     val.error.flag% = false
  216.     val.error! = 0
  217.     
  218.     temp$ = RTRIM$(temp$)
  219.     val.error! = VAL(temp$)
  220.     IF val.error <> 0 THEN val.error.flag% = true
  221.  
  222.   INPUT #15, temp$
  223.   temp$ = RIGHT$(temp$, (LEN(temp$) - 14))
  224.     flag.flag% = false
  225.     flag.value! = 0
  226.     
  227.     temp$ = RTRIM$(temp$)
  228.     flag.value! = VAL(temp$)
  229.     IF flag.value! <> 0 THEN flag.flag% = true
  230.  
  231.   INPUT #15, temp$
  232.      flag.defn$ = RIGHT$(temp$, (LEN(temp$) - 14))
  233.   INPUT #15, temp$
  234.      legend% = VAL(RIGHT$(temp$, (LEN(temp$) - 14)))
  235.  
  236.   IF legend% <> 0 THEN
  237.     IF legend% > 255 THEN legend% = 255
  238.     FOR i = 0 TO legend% - 1 STEP 1
  239.          INPUT #15, temp$
  240.          legend.text$(i) = RIGHT$(temp$, (LEN(temp$) - 14))
  241.          NEXT i
  242.     END IF
  243.  
  244.   CLOSE #15
  245. REM ***************************************************************************
  246.  
  247. END SUB
  248.  
  249. SUB read.env.file
  250. REM ***************************************************************************
  251.  
  252.   path$ = ""
  253.   drive$ = ""
  254.  
  255.   OPEN "idrisi.env" FOR INPUT AS #20
  256.  
  257.   INPUT #20, temp$
  258.   INPUT #20, temp$
  259.   INPUT #20, temp$
  260.     drive$ = RIGHT$(temp$, (LEN(temp$) - 40))
  261.  
  262.   INPUT #20, temp$
  263.     path$ = RIGHT$(temp$, (LEN(temp$) - 40))
  264.  
  265.   INPUT #20, temp$
  266.     image.file.extension$ = RIGHT$(temp$, (LEN(temp$) - 40))
  267.   INPUT #20, temp$
  268.     image.docfile.extension$ = RIGHT$(temp$, (LEN(temp$) - 40))
  269.   INPUT #20, temp$
  270.     vector.file.extension$ = RIGHT$(temp$, (LEN(temp$) - 40))
  271.   INPUT #20, temp$
  272.     vector.docfile.extension$ = RIGHT$(temp$, (LEN(temp$) - 40))
  273.   INPUT #20, temp$
  274.     values.file.extension$ = RIGHT$(temp$, (LEN(temp$) - 40))
  275.   INPUT #20, temp$
  276.     values.docfile.extension$ = RIGHT$(temp$, (LEN(temp$) - 40))
  277.  
  278.   INPUT #20, temp$
  279.     ref.units$ = RIGHT$(temp$, (LEN(temp$) - 40))
  280.   INPUT #20, temp$
  281.     digi.port$ = RIGHT$(temp$, (LEN(temp$) - 40))
  282.   INPUT #20, temp$
  283.     plot.port$ = RIGHT$(temp$, (LEN(temp$) - 40))
  284.   INPUT #20, temp$
  285.     prn.port$ = RIGHT$(temp$, (LEN(temp$) - 40))
  286.   
  287.   CLOSE #20
  288.  
  289.   IF path$ = "none" THEN path$ = ""
  290.   IF drive$ = "no" THEN drive$ = ""
  291.   IF MID$(drive$, 2) <> ":" THEN drive$ = ""
  292. REM ***************************************************************************
  293.  
  294. END SUB
  295.  
  296.