home *** CD-ROM | disk | FTP | other *** search
/ TopWare 18: Liquid / Image.iso / liquid / top1161 / gfxload.bas < prev    next >
BASIC Source File  |  1994-03-02  |  10KB  |  396 lines
  1. '
  2. '  GFX Load      V3.13
  3. '
  4. '  (c) 1993 by Magic Power-Ware!
  5. '
  6. '  Diese Routinen gehören zum Shareware-Programm
  7. '
  8. '  SpriteEditor 3.17
  9. '
  10. '  von Magic Power-Ware!
  11. '
  12.  
  13. DECLARE FUNCTION Exist (File$)
  14. DECLARE SUB GFXLoad (DateiName$, x, y)
  15. DECLARE SUB PalLoad (FileName$, lo, hi, PalMem%())
  16. DECLARE SUB FastGFXLoad (DateiName$, x, y)
  17.  
  18. DIM PalMem(255, 3) AS INTEGER
  19.  
  20.  
  21. SCREEN 13                               ' *** Auf Grafikmode  13 umschalten
  22.                                         ' *** VGA 320x200 Pixel, 256 Farben
  23.  
  24. GFXLoad "BUBBLE.GFX", 100, 100          ' *** Grafik BUBBLE.GFX (sollte bei
  25.                                         ' *** diesem  Paket  dabeisein)  an
  26.                                         ' *** Position x=100 : y=100 zeigen
  27.  
  28. a$ = "STINK.GFX"                        ' *** a$ auf Filename setzen
  29.  x = -13                                ' *** x  auf -13      setzen
  30.  y = 33                                 ' *** y  auf  33      setzen
  31.  
  32. GFXLoad a$, x, y                        ' *** Grafik  a$  an  Position x, y
  33.                                         ' *** zeigen. Das - bei x  gibt an,
  34.                                         ' *** daß der eingeles. Darstellungs-
  35.                                         ' *** Code in a$ abgelegt werden
  36.                                         ' *** soll.
  37.  
  38. LOCATE 1, 1
  39. PRINT "Bildhöhe:   "; y                 ' *** Werte darstellen
  40. PRINT "Bildbreite: "; x
  41. LOCATE 7
  42. PRINT "BildCode: "; a$
  43.  
  44. SOUND 1000, 1                           ' *** Auf Tastendruck warten.
  45. DO
  46. LOOP WHILE INKEY$ = ""
  47. CLS
  48.  
  49. FOR i = 1 TO 256                        ' *** Bild vervielfältigen
  50.   x = INT(RND * 320)                    ' *** Zufallspositionen
  51.   y = INT(RND * 200)
  52.   b$ = "C" + LTRIM$(STR$(INT(RND * 256))) + MID$(a$, 4)
  53.                                         ' *** Bearbeiten natürlich möglich.
  54.                                         ' *** in diesem Beispiel die Ersten
  55.                                         ' *** drei Zeichen (Farbe)
  56.   PSET (x, y), POINT(x, y)
  57.   DRAW b$                               ' *** Mit DRAW darstellen
  58. NEXT i
  59.  
  60. SOUND 1000, 1                           ' *** Auf Tastendruck warten.
  61. DO
  62. LOOP WHILE INKEY$ = ""
  63. CLS
  64.  
  65. GFXLoad "SMILE.GFX", 100, 100           ' *** Grafik  SMILE.GFX (sollte bei
  66.                                         ' *** diesem  Paket  dabeisein)  an
  67.                                         ' *** Position x=100 : y=100 zeigen
  68.                                         ' *** (Mehrfarbige Grafik!)
  69.  
  70. SOUND 1000, 1                           ' *** Auf Tastendruck warten.
  71. DO                                      ' *** Palette  des   Bildes  stimmt
  72. LOOP WHILE INKEY$ = ""                  ' *** noch nicht!
  73.  
  74. PalLoad "SMILE.PAL", 32, 64, PalMem()   ' *** Palette SMILE.PAL (sollte bei
  75.                                         ' *** diesem Paket  dabeisein) wird
  76.                                         ' *** eingeladen  und  dargestellt.
  77.                                         ' *** Die  eingelesenen   RGB-Werte
  78.                                         ' *** werden in  das  Array  PalMem
  79.                                         ' *** geschrieben (ggf. zum Weiter-
  80.                                         ' *** verwenden).   Beim   Einlesen
  81.                                         ' *** werden nur die  Farben 32 bis
  82.                                         ' *** 64 berücksichtigt.
  83.  
  84. SOUND 1000, 1                           ' *** Auf Tastendruck warten.
  85. DO
  86. LOOP WHILE INKEY$ = ""
  87.  
  88.  
  89. END                                     ' *** Beenden
  90.  
  91. ISError:                                ' *** Von EXIST (File$) benötigt!!!
  92.   RESUME NEXT
  93.  
  94. FUNCTION Exist (File$)
  95.  
  96. ON ERROR GOTO ISError:
  97.  
  98. aaa = FREEFILE
  99.  
  100. OPEN File$ FOR BINARY AS aaa
  101. abc = LOF(aaa)
  102. CLOSE aaa
  103.  
  104. IF abc > 1 THEN
  105.   Exist = abc
  106. ELSE
  107.   Exist = 0
  108.   KILL File$
  109. END IF
  110.  
  111. END FUNCTION
  112.  
  113. SUB FastGFXLoad (DateiName$, x, y)
  114.  
  115.   aaa = FREEFILE
  116.  
  117.   IF Exist(DateiName$) < 2 THEN
  118.     x = 0
  119.     y = 0
  120.     EXIT SUB
  121.   END IF
  122.  
  123.   OPEN DateiName$ FOR INPUT AS aaa
  124.  
  125.   PSET (x, y), POINT(x, y)
  126.  
  127.   DO
  128.     LINE INPUT #1, a$
  129.   LOOP WHILE a$ <> "[DATABLOCK]"
  130.  
  131.   DateiName$ = ""
  132.   DO
  133.     LINE INPUT #aaa, a$
  134.     IF a$ = "[DATAENDE]" THEN EXIT DO
  135.     DRAW a$
  136.   LOOP
  137.  
  138.   CLOSE aaa
  139.  
  140. END SUB
  141.  
  142. SUB GFXLoad (DateiName$, x, y)
  143.  
  144.   aaa = FREEFILE
  145.   IF Exist(DateiName$) < 2 THEN
  146.     x = 0
  147.     y = 0
  148.     EXIT SUB
  149.   END IF
  150.  
  151.   IF x < 0 THEN
  152.     Flag = -1
  153.     x = x * SGN(x)
  154.   END IF
  155.  
  156.   OPEN DateiName$ FOR INPUT AS aaa
  157.  
  158.   LINE INPUT #aaa, a$
  159.   PSET (x, y), POINT(x, y)
  160.   xp = x
  161.   yp = y
  162.  
  163.   IF LEFT$(a$, 6) = "CZ-GFX" THEN
  164.     GOTO newsystem:
  165.   END IF
  166.  
  167.   PSET (x - 1, y - 1), POINT(x - 1, y - 1)
  168.   xp = x - 1
  169.   yp = y - 1
  170.  
  171.  
  172.   LINE INPUT #aaa, b$
  173.   x = VAL(b$)
  174.   LINE INPUT #aaa, b$
  175.   y = VAL(b$)
  176.  
  177.   IF LEFT$(a$, 3) = "QBD" THEN
  178.     LINE INPUT #aaa, a$
  179.     DRAW a$
  180.   ELSEIF LEFT$(a$, 3) = "CZS" THEN
  181.     FOR i% = 1 TO y
  182.       LINE INPUT #aaa, a$
  183.       FOR m% = 1 TO x
  184.         PSET (xp + m%, yp + i%), ASC(MID$(a$, m%, 1)) - 16
  185.       NEXT m%
  186.     NEXT i%
  187.   ELSE
  188.     x = 0
  189.     y = 0
  190.   END IF
  191.  
  192.  
  193.   CLOSE aaa
  194. EXIT SUB
  195.  
  196. newsystem:
  197.   DO
  198.     LINE INPUT #1, a$
  199.     a$ = UCASE$(a$)
  200.   LOOP WHILE a$ <> "[INFOBLOCK]"
  201.   DO
  202.     LINE INPUT #1, a$
  203.     a$ = RTRIM$(LTRIM$(UCASE$(a$)))
  204.     IF LEFT$(a$, 5) = "MODE=" THEN
  205.       Mode$ = MID$(a$, 6)
  206.     ELSEIF LEFT$(a$, 8) = "VERSION=" THEN
  207.       Version$ = MID$(a$, 9)
  208.       IF Version$ > "3.00" THEN
  209.         x = 0
  210.         y = 0
  211.         EXIT SUB
  212.       END IF
  213.     ELSEIF LEFT$(a$, 6) = "WIDTH=" THEN
  214.       x = VAL(MID$(a$, 7))
  215.     ELSEIF LEFT$(a$, 7) = "HEIGHT=" THEN
  216.       y = VAL(MID$(a$, 8))
  217.     END IF
  218.   LOOP WHILE a$ <> ""
  219.  
  220.   DO
  221.     LINE INPUT #1, a$
  222.   LOOP WHILE a$ <> "[DATABLOCK]"
  223.  
  224.   IF Mode$ = "BITMAP" THEN
  225.     DO
  226.       LINE INPUT #aaa, a$
  227.       IF a$ = "[DATAENDE]" THEN EXIT DO
  228.       FOR m% = 0 TO LEN(a$) - 1
  229.         r = ASC(MID$(a$, m% + 1, 1))
  230.         IF r = 1 THEN r = 0
  231.         PSET (xp + m%, yp + i%), r
  232.       NEXT m%
  233.       i% = i% + 1
  234.     LOOP
  235.     CLOSE 1
  236.   ELSEIF Mode$ = "QBDRAW" THEN
  237.     DateiName$ = ""
  238.     DO
  239.       LINE INPUT #aaa, a$
  240.       IF a$ = "[DATAENDE]" THEN EXIT DO
  241.       IF Flag = -1 THEN
  242.         DateiName$ = DateiName$ + a$
  243.       END IF
  244.       DRAW a$
  245.     LOOP
  246.   END IF
  247.  
  248.   CLOSE aaa
  249.  
  250. END SUB
  251.  
  252. SUB PalLoad (FileName$, lo, hi, PalMem() AS INTEGER)
  253.  
  254.   aaa = FREEFILE
  255.  
  256.   IF Exist(FileName$) THEN
  257.     OPEN FileName$ FOR INPUT AS aaa
  258.     LINE INPUT #aaa, a$
  259.     IF a$ <> "CZ-PAL" THEN
  260.       CLOSE aaa
  261.       EXIT SUB
  262.     END IF
  263.     DO
  264.       LINE INPUT #aaa, a$
  265.     LOOP WHILE a$ <> "[INFOBLOCK]"
  266.     DO
  267.       LINE INPUT #aaa, a$
  268.       a$ = UCASE$(a$)
  269.       IF LEFT$(a$, 6) = "COUNT=" THEN
  270.         Count = VAL(MID$(a$, 7))
  271.       END IF
  272.       IF LEFT$(a$, 8) = "VERSION=" THEN
  273.         Version$ = MID$(a$, 9)
  274.         IF Version$ = "SPECIAL" THEN GOTO SpecialLoad:
  275.         IF Version$ > "3.13" THEN
  276.           CLOSE aaa
  277.           EXIT SUB
  278.         END IF
  279.       END IF
  280.     LOOP WHILE a$ <> "[DATABLOCK]"
  281.  
  282.     IF Version$ = "3.00" THEN
  283.  
  284.       DO
  285.         LINE INPUT #aaa, a$
  286.         IF a$ = "[DATAENDE]" THEN EXIT DO
  287.         IF INSTR(a$, "[") > 1 AND INSTR(a$, "]") > 1 AND INSTR(a$, "=") > 1 THEN
  288.           Farbe = VAL(a$)
  289.           RGB = VAL(MID$(a$, INSTR(a$, "[") + 1))
  290.           Wert = VAL(MID$(a$, INSTR(a$, "=") + 1))
  291.           IF Farbe <= hi AND Farbe >= lo AND RGB < 4 AND Wert < 64 THEN
  292.             PalMem(Farbe, RGB) = INT(Wert)
  293.           END IF
  294.         END IF
  295.       LOOP
  296.       CLOSE 1
  297.  
  298.       FOR i% = lo TO hi
  299.         PALETTE i%, PalMem(i%, 1) + PalMem(i%, 2) * 256 + PalMem(i%, 3) * 65536
  300.       NEXT i%
  301.  
  302.     ELSEIF Version$ = "3.01" THEN
  303.  
  304.       DO
  305.         LINE INPUT #aaa, a$
  306.         IF a$ = "[DATAENDE]" THEN EXIT DO
  307.         IF INSTR(a$, "r") > 1 AND INSTR(a$, "g") > 1 AND INSTR(a$, "b") > 1 AND INSTR(a$, "=") > 1 THEN
  308.           Farbe = VAL(a$)
  309.           r = VAL(MID$(a$, INSTR(a$, "r") + 1))
  310.           g = VAL(MID$(a$, INSTR(a$, "g") + 1))
  311.           b = VAL(MID$(a$, INSTR(a$, "b") + 1))
  312.           IF Farbe <= hi AND Farbe >= lo AND r < 64 AND g < 64 AND b < 64 THEN
  313.             PalMem(Farbe, 1) = INT(r)
  314.             PalMem(Farbe, 2) = INT(g)
  315.             PalMem(Farbe, 3) = INT(b)
  316.           END IF
  317.         END IF
  318.       LOOP
  319.       CLOSE aaa
  320.  
  321.       FOR i% = lo TO hi
  322.         PALETTE i%, PalMem(i%, 1) + PalMem(i%, 2) * 256 + PalMem(i%, 3) * 65536
  323.       NEXT i%
  324.  
  325.     ELSEIF Version$ = "3.12" THEN
  326.  
  327.       DO
  328.         LINE INPUT #aaa, a$
  329.         IF a$ = "[DATAENDE]" THEN EXIT DO
  330.         Farbe = VAL(a$)
  331.  
  332.         r = VAL(LTRIM$(MID$(a$, 7, 3)))
  333.         g = VAL(LTRIM$(MID$(a$, 10, 3)))
  334.         b = VAL(LTRIM$(MID$(a$, 14, 3)))
  335.         IF Farbe <= hi AND Farbe >= lo AND r < 64 AND g < 64 AND b < 64 THEN
  336.           PalMem(Farbe, 1) = INT(r)
  337.           PalMem(Farbe, 2) = INT(g)
  338.           PalMem(Farbe, 3) = INT(b)
  339.         END IF
  340.  
  341.       LOOP
  342.       CLOSE aaa
  343.  
  344.       FOR i% = lo TO hi
  345.         PALETTE i%, PalMem(i%, 1) + PalMem(i%, 2) * 256 + PalMem(i%, 3) * 65536
  346.       NEXT i%
  347.  
  348.     ELSEIF Version$ = "3.13" THEN
  349.  
  350.       DO
  351.         LINE INPUT #aaa, a$
  352.         IF a$ = "[DATAENDE]" THEN EXIT DO
  353.         Farbe = VAL(a$)
  354.  
  355.         r = ASC(MID$(a$, 5, 1)) - 64
  356.         g = ASC(MID$(a$, 6, 1)) - 64
  357.         b = ASC(MID$(a$, 7, 1)) - 64
  358.         IF Farbe <= hi AND Farbe >= lo AND r < 64 AND g < 64 AND b < 64 THEN
  359.           PalMem(Farbe, 1) = INT(r)
  360.           PalMem(Farbe, 2) = INT(g)
  361.           PalMem(Farbe, 3) = INT(b)
  362.         END IF
  363.  
  364.       LOOP
  365.       CLOSE aaa
  366.  
  367.       FOR i% = lo TO hi
  368.         PALETTE i%, PalMem(i%, 1) + PalMem(i%, 2) * 256 + PalMem(i%, 3) * 65536
  369.       NEXT i%
  370.  
  371.     END IF
  372.  
  373.  
  374.   END IF
  375.  
  376.   EXIT SUB
  377.  
  378. SpecialLoad:
  379.  
  380.     DO
  381.       LINE INPUT #aaa, a$
  382.       a$ = UCASE$(a$)
  383.     LOOP WHILE a$ <> "[DATABLOCK]"
  384.  
  385.     DO
  386.       LINE INPUT #aaa, a$
  387.       IF a$ <> "" THEN
  388.         PALETTE lo, VAL(a$)
  389.         lo = lo + 1
  390.       END IF
  391.     LOOP WHILE EOF(aaa) = 0
  392.  
  393.     CLOSE aaa
  394.  
  395. END SUB
  396.