home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 01 / sprites / sp_edit.bas < prev    next >
Encoding:
BASIC Source File  |  1988-10-30  |  7.6 KB  |  315 lines
  1. REM -------------------------------------------------------
  2. REM                    SP-EDIT.BAS
  3. REM        Sprite-Editor für Turbo Basic (v1.0e)
  4. REM           (c) 1988 by M. Köthe & TOOLBOX
  5. REM -------------------------------------------------------
  6.  
  7. $INCLUDE "EGA.INC"
  8. $INCLUDE "VERG.INC"
  9. $INCLUDE "GRB.INC"
  10.  
  11. REM -------------------------------------------------------
  12.  
  13. SUB tastatur
  14.   SHARED taste, taste$
  15.   WHILE NOT INSTAT: WEND
  16.   taste$ = inkey$
  17.   taste = ASC(taste$)
  18.   IF taste = 0 THEN
  19.     taste = ASC(MID$(taste$,2))
  20.     IF taste = 81 THEN taste = 0
  21.   END IF
  22. END SUB
  23.  
  24. REM -------------------------------------------------------
  25.  
  26. SUB tauschen
  27.   SHARED feld(), waag, senk, taste
  28.   LOCATE 25,1: PRINT "Fuellfarbe ? ";
  29.   DO
  30.     CALL tastatur
  31.   LOOP UNTIL (taste > (%tabz - 1) and taste < %tende)
  32.   v = taste - %tabz
  33.   LOCATE 25,1: PRINT "Zu aendernde Farbe        ";
  34.   DO
  35.     CALL tastatur
  36.   LOOP UNTIL (taste > (%tabz - 1) and taste < %tende)
  37.   LOCATE 25,1: PRINT space$(26);
  38.   IF v + %tabz = taste THEN EXIT SUB
  39.   CALL cursor(waag, senk)
  40.   FOR i% = 0 TO %fd
  41.     FOR x% = 0 TO %fd
  42.       IF feld(i%, x%) = taste - %tabz THEN
  43.         feld(i%,x%) = v
  44.         LINE (i% * %xbr + %po1, x% * %ybr + %po1)-_
  45.             (i% * %xbr + %po2, x% * %ybr + %po3), v, BF
  46.         PSET (i% + %po4, x% + %po5), v
  47.       END IF
  48.     NEXT x%
  49.   NEXT i%
  50.   CALL cursor(waag, senk)
  51. END SUB
  52.  
  53. REM -------------------------------------------------------
  54.  
  55. SUB punktsetzen(i, x)
  56.   SHARED feld(), taste, anfang
  57.   IF anfang THEN anfang = %false
  58.   feld(i, x) = taste - %tabz
  59.   LINE (i * %xbr + %po1, x * %ybr + %po1)-_
  60.        (i * %xbr + %po2, x * %ybr + %po3), feld(i, x), BF
  61.   PSET (i + %po4, x + %po5), feld(i, x)
  62.   CALL cursor(i,x)
  63. END SUB
  64.  
  65. REM -------------------------------------------------------
  66.  
  67. SUB feld
  68.   SHARED anfang, feld(), waag, senk
  69.   IF NOT anfang THEN
  70.     FOR i% = 0 TO %fd
  71.       FOR x% = 0 TO %fd
  72.         LINE (i% * %xbr + %po1, x% * %ybr + %po1)-_
  73.      (i% * %xbr + %po2, x% * %ybr + %po3), feld(i%, x%), BF
  74.         PSET (i% + %po4, x% + %po5), feld(i%, x%)
  75.       NEXT x%
  76.     NEXT i%
  77.   END IF
  78.   CALL cursor(waag, senk)
  79. END SUB
  80.  
  81. REM -------------------------------------------------------
  82.  
  83. SUB cursor(i, x)
  84.   SHARED cur%()
  85.   PUT(i * %xbr + %po1, x * %ybr + %po1), cur%, XOR
  86. END SUB
  87.  
  88. REM -------------------------------------------------------
  89.  
  90. SUB loeschen
  91.   SHARED waag, senk, feld()
  92.   waag=0: senk=0
  93.   view (%po4, %po5) - (%po4 + %fd, %po5 + %fd), 0
  94.   view (0, 0) - (%bw, %bs)
  95.   FOR i% = 0 TO %fd
  96.     FOR x% = 0 TO %fd
  97.       LINE (i% * %xbr + %po1, x% * %ybr + %po1)-_
  98.            (i% * %xbr + %po2, x% * %ybr + %po3), 0, BF
  99.       feld(i%, x%) = 0
  100.     NEXT x%
  101.   NEXT i%
  102.   CALL cursor(waag, senk)
  103. END SUB
  104.  
  105. REM -------------------------------------------------------
  106.  
  107. SUB laden
  108.   SHARED KeinEintrag, pal%(), f2(), dateiname$
  109.   KeinEintrag = %false
  110.   SCREEN 0: WIDTH 80: CLS
  111.   ON ERROR GOTO fehler2
  112.   PRINT "<LADEN>: Vorhandene Sprites:"
  113.   f$= "*.SPR": FILES f$
  114.   ON ERROR GOTO 0
  115.   IF KeinEintrag THEN EXIT SUB
  116.   DO
  117.     KeinEintrag = %false
  118.     PRINT: INPUT "Dateiname: "; dateiname$
  119.     IF dateiname$="" THEN EXIT SUB
  120.     z = instr(dateiname$,".")
  121.     IF z THEN dateiname$ = left$(dateiname$, z-1)
  122.     dateiname$ = dateiname$ + ".SPR"
  123.     ON ERROR GOTO fehler3
  124.     OPEN dateiname$ AS #1 LEN = 2
  125.     FIELD #1, 2 AS sp$
  126.     spzaehler% = 0
  127.     ON ERROR GOTO 0
  128.   LOOP UNTIL NOT KeinEintrag
  129.  
  130. REM -------------------------------------------------------
  131. REM  Bei Anpassung an Maschinen ohne EGA-Karte koennen die
  132. REM  eingerahmten Zeilen wegfallen
  133.  
  134.   IF %fd = 44 THEN
  135.     FOR i% = 0 TO 15
  136.       INCR spzaehler%
  137.       GET #1, spzaehler%
  138.       pal%(i%) = CVI(sp$)
  139.     NEXT i%
  140.   END IF
  141.  
  142. REM -------------------------------------------------------
  143.  
  144.   FOR i% = 0 TO %fd
  145.     FOR x% = 0 TO %fd
  146.       INCR spzaehler%
  147.       GET #1, spzaehler%
  148.       f2(i%, x%) = CVI(sp$)
  149.     NEXT x%
  150.   NEXT i%
  151.   CLOSE #1
  152. END SUB
  153.  
  154. REM -------------------------------------------------------
  155.  
  156. SUB datei
  157.   SHARED feld(), dateiname$, f2(), pal%()
  158.   OPEN dateiname$ AS #1 LEN = 2
  159.   FIELD #1, 2 AS sp$
  160.   spzaehler% = 0
  161.  
  162. REM -------------------------------------------------------
  163. REM  Bei Anpassung an Maschinen ohne EGA-Karte koennen die
  164. REM  eingerahmten Zeilen wegfallen
  165.  
  166.   IF %fd = 44 THEN
  167.     FOR i% = 0 TO 15
  168.       INCR spzaehler%
  169.       LSET sp$ = MKI$(pal%(i%))
  170.       PUT #1, spzaehler%
  171.     NEXT i%
  172.   END IF
  173.  
  174. REM -------------------------------------------------------
  175.  
  176.   FOR i% = 0 TO %fd
  177.     FOR x% = 0 TO %fd
  178.       INCR spzaehler%
  179.       LSET sp$ = MKI$(f2(i%, x%))
  180.       PUT #1, spzaehler%
  181.     NEXT x%
  182.   NEXT i%
  183.   CLOSE #1
  184. END SUB
  185.  
  186. REM -------------------------------------------------------
  187.  
  188. SUB speichern
  189.   SHARED spr%(), dateiname$, f2(), feld()
  190.   GET (%po4, %po5) - (%po4 + %fd, %po5 + %fd), spr%
  191.   SCREEN 0: WIDTH 80: CLS
  192.   ON ERROR GOTO fehler1
  193.   PRINT "<SPEICHERN>: Vorhandene Sprites:"
  194.   f$= "*.SPR": FILES f$
  195.   ON ERROR GOTO 0
  196.   FOR i% = 0 TO %fd
  197.     FOR x% = 0 TO %fd
  198.       f2(i%, x%) = feld(i%, x%)
  199.     NEXT x%
  200.   NEXT i%
  201.   PRINT: INPUT "Dateiname: "; dateiname$
  202.   IF dateiname$="" THEN
  203.     CALL bildschirm
  204.     EXIT SUB
  205.   END IF
  206.   z = instr(dateiname$, ".")
  207.   IF z THEN dateiname$ = left$(dateiname$, z-1)
  208.   dateiname$ = dateiname$ + ".SPR"
  209.   CALL datei
  210.   REM  CALL datagen
  211.   CALL bildschirm
  212. END SUB
  213.  
  214.  
  215.  
  216. REM--------------------------------------------------------
  217. REM Beginn des gemeinsamen Hauptprogramms
  218.  
  219. CALL bildschirm
  220. DO
  221.   sound 100, .25
  222.   CALL tastatur
  223.   SELECT CASE taste
  224.     CASE 80
  225.       CALL cursor(waag, senk)
  226.       INCR senk
  227.       IF senk > %fd THEN senk = 0
  228.       CALL cursor(waag, senk)
  229.     CASE 72
  230.       CALL cursor(waag, senk)
  231.       DECR senk
  232.       IF senk < 0 THEN senk = %fd
  233.       CALL cursor(waag, senk)
  234.     CASE 75
  235.       CALL cursor(waag, senk)
  236.       DECR waag
  237.       IF waag < 0 THEN waag = %fd
  238.       CALL cursor(waag, senk)
  239.     CASE 77
  240.       CALL cursor(waag, senk)
  241.       INCR waag
  242.       IF waag > %fd THEN waag = 0
  243.       CALL cursor(waag, senk)
  244.     CASE 67
  245.       CALL loeschen
  246.     CASE 68
  247.       ende = %true
  248.     CASE 63
  249.       CALL tauschen
  250.     CASE 62
  251.       CALL palwechsel
  252.     CASE 61
  253.       CALL farbe
  254.     CASE 60
  255.       ERASE spr%: DIM spr%(%sprgr)
  256.       CALL speichern
  257.     CASE 59
  258.       CALL laden
  259.       IF dateiname$ <> "" THEN
  260.         FOR i% = 0 TO %fd
  261.           FOR x% = 0 TO %fd
  262.             feld(i%, x%)= f2(i%, x%)
  263.           NEXT x%
  264.         NEXT i%
  265.         anfang = %false
  266.       END IF
  267.       CALL bildschirm
  268.     CASE 48, 49, 50, 51
  269.       IF %fd = 29 THEN CALL punktsetzen(waag, senk)
  270.     CASE 64
  271.     CALL vergroessern
  272.     CASE 66
  273.       ERASE spr%: DIM spr%(%sprgr)
  274.       CALL grossbild
  275.  
  276. REM -------------------------------------------------------
  277. REM  Bei Anpassung an Maschinen ohne EGA-Karte koennen die
  278. REM  eingerahmten Zeilen wegfallen
  279.  
  280.     CASE 97, 98, 99,100,101,102,103,104,_
  281.         105,106,107,108,109,110,111,112
  282.       IF %fd=44 THEN CALL punktsetzen(waag,senk)
  283. REM -------------------------------------------------------
  284.  
  285.   END SELECT
  286. LOOP UNTIL ende
  287. SCREEN 0
  288. END
  289.  
  290. REM--------------------------------------------------------
  291. REM               Ende des Hauptprogramms
  292. REM
  293. REM            Es folgen die Fehlerroutinen...
  294.  
  295. fehler1:
  296.   PRINT chr$(7);"Kein Sprite-File vorhanden !"
  297.   RESUME NEXT
  298.  
  299. fehler2:
  300.   PRINT chr$(7);"Kein Sprite-File vorhanden !"
  301.   keinEintrag = %true
  302.   RESUME NEXT
  303.  
  304. fehler3:
  305.   PRINT chr$(7);dateiname$" nicht vorhanden !"
  306.   KeinEintrag = %true
  307.   RESUME NEXT
  308.  
  309. REM -------------------------------------------------------
  310. REM                Ende von SP-EDIT.BAS
  311.  
  312.  
  313.  
  314.  
  315.